From fafd8a669df93da7db5624d5b3782dcc508b3447 Mon Sep 17 00:00:00 2001 From: jneira Date: Sun, 8 Mar 2020 22:10:06 +0100 Subject: [PATCH] Port hie changes of pull #1665 * Remove unused imports * Pass verbosity shake arg to build tools (cabal and stack) * Use custom cabal.project-${ghcVersion} if exists * I added cabal.project-ghc-8.8.2 that will be used by the script * Change targets to "hls" --- install/src/Cabal.hs | 70 +++++++++++++++++++++----------- install/src/Env.hs | 6 +-- install/src/Help.hs | 24 ++++++----- install/src/HieInstall.hs | 85 +++++++++++++++++---------------------- install/src/Print.hs | 12 +++--- install/src/Stack.hs | 79 +++++++++++++++++++++--------------- install/src/Version.hs | 1 - 7 files changed, 151 insertions(+), 126 deletions(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 46c97270f0..8f010c542d 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -1,27 +1,19 @@ {-# LANGUAGE CPP #-} - module Cabal where import Development.Shake -import Development.Shake.Command import Development.Shake.FilePath import Control.Monad -import Data.Maybe ( isNothing - , isJust - ) -import Control.Monad.Extra ( whenMaybe ) -import System.Directory ( findExecutable - , copyFile - ) +import System.Directory ( copyFile ) import Version import Print import Env -import Data.Functor.Identity #if RUN_FROM_STACK import Control.Exception ( throwIO ) #else import Cabal.Config +import Data.Functor.Identity #endif getInstallDir :: IO FilePath @@ -38,10 +30,10 @@ execCabal = command [] "cabal" execCabal_ :: [String] -> Action () execCabal_ = execCabal -cabalBuildData :: Action () -cabalBuildData = do - execCabal_ ["v2-build", "hoogle"] - execCabal_ ["v2-exec", "hoogle", "generate"] +cabalBuildData :: [String] -> Action () +cabalBuildData args = do + execCabal_ $ ["v2-build", "hoogle"] ++ args + execCabal_ $ ["v2-exec", "hoogle", "generate"] ++ args getGhcPathOfOrThrowError :: VersionNumber -> Action GhcPath getGhcPathOfOrThrowError versionNumber = @@ -51,10 +43,10 @@ getGhcPathOfOrThrowError versionNumber = error (ghcVersionNotFoundFailMsg versionNumber) Just p -> return p -cabalInstallHie :: VersionNumber -> Action () -cabalInstallHie versionNumber = do +cabalInstallHie :: VersionNumber -> [String] -> Action () +cabalInstallHie versionNumber args = do localBin <- liftIO $ getInstallDir - cabalVersion <- getCabalVersion + cabalVersion <- getCabalVersion args ghcPath <- getGhcPathOfOrThrowError versionNumber let isCabal3 = checkVersion [3,0,0,0] cabalVersion @@ -62,6 +54,9 @@ cabalInstallHie versionNumber = do | otherwise = "--symlink-bindir" installMethod | isWindowsSystem && isCabal3 = ["--install-method=copy"] | otherwise = [] + + projectFile <- getProjectFile versionNumber + execCabal_ $ [ "v2-install" , "exe:haskell-language-server" @@ -71,8 +66,10 @@ cabalInstallHie versionNumber = do , installDirOpt, localBin , "--max-backjumps=5000" , "--overwrite-policy=always" + , "--project-file=" ++ projectFile ] ++ installMethod + ++ args let minorVerExe = "haskell-language-server-" ++ versionNumber <.> exe majorVerExe = "haskell-language-server-" ++ dropExtension versionNumber <.> exe @@ -88,20 +85,27 @@ cabalInstallHie versionNumber = do ++ minorVerExe ++ " to " ++ localBin -checkCabal_ :: Action () -checkCabal_ = checkCabal >> return () +getProjectFile :: VersionNumber -> Action FilePath +getProjectFile ver = do + existFile <- doesFileExist $ "cabal.project-" ++ ver + return $ if existFile + then "cabal.project-" ++ ver + else "cabal.project" + +checkCabal_ :: [String] -> Action () +checkCabal_ args = checkCabal args >> return () -- | check `cabal` has the required version -checkCabal :: Action String -checkCabal = do - cabalVersion <- getCabalVersion +checkCabal :: [String] -> Action String +checkCabal args = do + cabalVersion <- getCabalVersion args unless (checkVersion requiredCabalVersion cabalVersion) $ do printInStars $ cabalInstallIsOldFailMsg cabalVersion error $ cabalInstallIsOldFailMsg cabalVersion return cabalVersion -getCabalVersion :: Action String -getCabalVersion = trimmedStdout <$> execCabal ["--numeric-version"] +getCabalVersion :: [String] -> Action String +getCabalVersion args = trimmedStdout <$> (execCabal $ ["--numeric-version"] ++ args) -- | Error message when the `cabal` binary is an older version cabalInstallIsOldFailMsg :: String -> String @@ -120,3 +124,21 @@ requiredCabalVersion | isWindowsSystem = requiredCabalVersionForWindows requiredCabalVersionForWindows :: RequiredVersion requiredCabalVersionForWindows = [3, 0, 0, 0] + +getVerbosityArg :: Verbosity -> String +getVerbosityArg v = "-v" ++ cabalVerbosity + where cabalVerbosity = case v of + Silent -> "0" +#if MIN_VERSION_shake(0,18,4) + Error -> "0" + Warn -> "1" + Info -> "1" + Verbose -> "2" +#else + Quiet -> "0" + Normal -> "1" + Loud -> "2" + Chatty -> "2" +#endif + Diagnostic -> "3" + diff --git a/install/src/Env.hs b/install/src/Env.hs index 6da957f568..5a6c44d96e 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -1,15 +1,11 @@ module Env where import Development.Shake -import Development.Shake.Command import Control.Monad.IO.Class import Control.Monad import Development.Shake.FilePath -import System.Info ( os - , arch - ) +import System.Info ( os ) import Data.Maybe ( isJust - , isNothing , mapMaybe ) import System.Directory ( findExecutable diff --git a/install/src/Help.hs b/install/src/Help.hs index 3372dc3bcf..885c520fc0 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -2,21 +2,18 @@ module Help where import Development.Shake -import Data.List ( intersperse - , intercalate - ) +import Data.List ( intercalate ) import Env import Print import Version import BuildSystem -import Cabal stackCommand :: TargetDescription -> String -stackCommand target = "stack install.hs " ++ fst target +stackCommand target = "stack install.hs " ++ fst target ++ " [options]" cabalCommand :: TargetDescription -> String -cabalCommand target = "cabal v2-run install.hs --project-file install/shake.project " ++ fst target +cabalCommand target = "cabal v2-run install.hs --project-file install/shake.project -- " ++ fst target ++ " [options]" buildCommand :: TargetDescription -> String buildCommand | isRunFromCabal = cabalCommand @@ -37,7 +34,7 @@ shortHelpMessage = do printUsage printLine "" printLine "Targets:" - mapM_ (printLineIndented . showTarget (spaces hieVersions)) (targets hieVersions) + mapM_ (printLineIndented . showHelpItem (spaces hieVersions)) (targets hieVersions) printLine "" where spaces hieVersions = space (targets hieVersions) @@ -68,7 +65,10 @@ helpMessage versions@BuildableVersions {..} = do printUsage printLine "" printLine "Targets:" - mapM_ (printLineIndented . showTarget spaces) targets + mapM_ (printLineIndented . showHelpItem spaces) targets + printLine "" + printLine "Options:" + mapM_ (printLineIndented . showHelpItem spaces) options printLine "" where spaces = space targets @@ -81,6 +81,10 @@ helpMessage versions@BuildableVersions {..} = do , if isRunFromCabal then [cabalGhcsTarget] else [stackDevTarget] , [macosIcuTarget] ] + options = [ ("-s, --silent", "Don't print anything.") + , ("-q, --quiet", "Print less (pass repeatedly for even less).") + , ("-V, --verbose", "Print more (pass repeatedly for even more).") + ] -- All targets with their respective help message. generalTargets = [helpTarget] @@ -97,10 +101,10 @@ templateTarget = ("", "") hieTarget :: String -> TargetDescription hieTarget version = - ("haskell-language-server-" ++ version, "Install haskell-language-server for GHC version " ++ version) + ("hls-" ++ version, "Install haskell-language-server for GHC version " ++ version) buildTarget :: TargetDescription -buildTarget = ("haskell-language-server", "Install haskell-language-server with the latest available GHC and the data files") +buildTarget = ("hls", "Install haskell-language-server with the latest available GHC and the data files") buildLatestTarget :: TargetDescription buildLatestTarget = ("latest", "Install haskell-language-server with the latest available GHC") diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index 87267de528..72652790bd 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -1,43 +1,13 @@ module HieInstall where import Development.Shake -import Development.Shake.Command -import Development.Shake.FilePath import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Extra ( unlessM - , mapMaybeM - ) -import Data.Maybe ( isJust ) -import System.Directory ( listDirectory ) import System.Environment ( unsetEnv ) -import System.Info ( os - , arch - ) - -import Data.Maybe ( isNothing - , mapMaybe - ) -import Data.List ( dropWhileEnd - , intersperse - , intercalate - , sort - , sortOn - ) -import qualified Data.Text as T -import Data.Char ( isSpace ) -import Data.Version ( parseVersion - , makeVersion - , showVersion - ) -import Data.Function ( (&) ) -import Text.ParserCombinators.ReadP ( readP_to_S ) import BuildSystem import Stack import Cabal import Version -import Print import Env import Help @@ -60,36 +30,54 @@ defaultMain = do let latestVersion = last versions shakeArgs shakeOptions { shakeFiles = "_build" } $ do + + shakeOptionsRules <- getShakeOptionsRules + + let verbosityArg = if isRunFromStack then Stack.getVerbosityArg else Cabal.getVerbosityArg + + let args = [verbosityArg (shakeVerbosity shakeOptionsRules)] + + phony "show-options" $ do + putNormal $ "Options:" + putNormal $ " Verbosity level: " ++ show (shakeVerbosity shakeOptionsRules) + want ["short-help"] -- general purpose targets phony "submodules" updateSubmodules phony "short-help" shortHelpMessage phony "help" (helpMessage toolsVersions) - phony "check" (if isRunFromStack then checkStack else checkCabal_) + phony "check" (if isRunFromStack then checkStack args else checkCabal_ args) phony "data" $ do + need ["show-options"] need ["submodules"] need ["check"] - if isRunFromStack then stackBuildData else cabalBuildData + if isRunFromStack then stackBuildData args else cabalBuildData args forM_ versions - (\version -> phony ("haskell-language-server-" ++ version) $ do + (\version -> phony ("hls-" ++ version) $ do + need ["show-options"] need ["submodules"] need ["check"] - if isRunFromStack then do - stackInstallHieWithErrMsg (Just version) + if isRunFromStack then + stackInstallHieWithErrMsg (Just version) args else - cabalInstallHie version + cabalInstallHie version args ) - phony "latest" (need ["haskell-language-server-" ++ latestVersion]) - phony "haskell-language-server" (need ["data", "latest"]) + unless (null versions) $ do + phony "latest" (need ["hls-" ++ latestVersion]) + phony "hls" (need ["data", "latest"]) -- stack specific targets - when isRunFromStack $ - phony "dev" $ stackInstallHieWithErrMsg Nothing + -- Default `stack.yaml` uses ghc-8.8.2 and we can't build hie in windows + -- TODO: Enable for windows when it uses ghc-8.8.3 + when (isRunFromStack && not isWindowsSystem) $ + phony "dev" $ do + need ["show-options"] + stackInstallHieWithErrMsg Nothing args -- cabal specific targets when isRunFromCabal $ do @@ -98,20 +86,23 @@ defaultMain = do phony "ghcs" $ showInstalledGhcs ghcPaths -- macos specific targets - phony "icu-macos-fix" - (need ["icu-macos-fix-install"] >> need ["icu-macos-fix-build"]) + phony "icu-macos-fix" $ do + need ["show-options"] + need ["icu-macos-fix-install"] + need ["icu-macos-fix-build"] + phony "icu-macos-fix-install" (command_ [] "brew" ["install", "icu4c"]) - phony "icu-macos-fix-build" $ mapM_ buildIcuMacosFix versions + phony "icu-macos-fix-build" $ mapM_ (flip buildIcuMacosFix $ args) versions -buildIcuMacosFix :: VersionNumber -> Action () -buildIcuMacosFix version = execStackWithGhc_ - version +buildIcuMacosFix :: VersionNumber -> [String] -> Action () +buildIcuMacosFix version args = execStackWithGhc_ + version $ [ "build" , "text-icu" , "--extra-lib-dirs=/usr/local/opt/icu4c/lib" , "--extra-include-dirs=/usr/local/opt/icu4c/include" - ] + ] ++ args -- | update the submodules that the project is in the state as required by the `stack.yaml` files updateSubmodules :: Action () diff --git a/install/src/Print.hs b/install/src/Print.hs index 41216022b5..063525e7ec 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -1,10 +1,8 @@ module Print where import Development.Shake -import Development.Shake.Command import Control.Monad.IO.Class import Data.List ( dropWhileEnd - , dropWhile ) import Data.Char ( isSpace ) @@ -37,11 +35,11 @@ type TargetDescription = (String, String) -- | Number of spaces the target name including whitespace should have. -- At least twenty, maybe more if target names are long. At most the length of the longest target plus five. -space :: [TargetDescription] -> Int -space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets) +space :: [(String,String)] -> Int +space helpItems = maximum (20 : map ((+ 5) . length . fst) helpItems) -- | Show a target. -- Concatenates the target with its help message and inserts whitespace between them. -showTarget :: Int -> TargetDescription -> String -showTarget spaces (target, msg) = - target ++ replicate (spaces - length target) ' ' ++ msg +showHelpItem :: Int -> (String,String) -> String +showHelpItem spaces (helpItemKey, msg) = + helpItemKey ++ replicate (spaces - length helpItemKey) ' ' ++ msg diff --git a/install/src/Stack.hs b/install/src/Stack.hs index b8d2dcebfe..4eb28c3720 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -1,70 +1,67 @@ +{-# LANGUAGE CPP #-} module Stack where import Development.Shake -import Development.Shake.Command import Development.Shake.FilePath -import Control.Exception import Control.Monad -import Data.List import System.Directory ( copyFile ) -import System.FilePath ( splitSearchPath, searchPathSeparator, () ) -import System.Environment ( lookupEnv, setEnv, getEnvironment ) -import System.IO.Error ( isDoesNotExistError ) -import BuildSystem +-- import System.FilePath ( () ) import Version import Print -import Env -stackInstallHieWithErrMsg :: Maybe VersionNumber -> Action () -stackInstallHieWithErrMsg mbVersionNumber = - stackInstallHie mbVersionNumber +stackInstallHieWithErrMsg :: Maybe VersionNumber -> [String] -> Action () +stackInstallHieWithErrMsg mbVersionNumber args = + stackInstallHie mbVersionNumber args `actionOnException` liftIO (putStrLn stackBuildFailMsg) -- | copy the built binaries into the localBinDir -stackInstallHie :: Maybe VersionNumber -> Action () -stackInstallHie mbVersionNumber = do +stackInstallHie :: Maybe VersionNumber -> [String] -> Action () +stackInstallHie mbVersionNumber args = do versionNumber <- case mbVersionNumber of Nothing -> do - execStackWithCfgFile_ "stack.yaml" ["install", "haskell-language-server"] - getGhcVersionOfCfgFile "stack.yaml" + execStackWithCfgFile_ "stack.yaml" $ + ["install" + , "haskell-language-server-wrapper" + , "haskell-language-server"] ++ args + getGhcVersionOfCfgFile "stack.yaml" args Just vn -> do - execStackWithGhc_ vn ["install", "haskell-language-server"] + execStackWithGhc_ vn $ ["install"] ++ args return vn - localBinDir <- getLocalBin - let hie = "haskell-language-server" <.> exe + localBinDir <- getLocalBin args + let hie = "hie" <.> exe liftIO $ do copyFile (localBinDir hie) (localBinDir "haskell-language-server-" ++ versionNumber <.> exe) copyFile (localBinDir hie) (localBinDir "haskell-language-server-" ++ dropExtension versionNumber <.> exe) -getGhcVersionOfCfgFile :: String -> Action VersionNumber -getGhcVersionOfCfgFile stackFile = do +getGhcVersionOfCfgFile :: String -> [String] -> Action VersionNumber +getGhcVersionOfCfgFile stackFile args = do Stdout ghcVersion <- - execStackWithCfgFile stackFile ["exec", "ghc", "--", "--numeric-version"] + execStackWithCfgFile stackFile $ ["exec", "ghc"] ++ args ++ ["--", "--numeric-version"] return $ trim ghcVersion -- | check `stack` has the required version -checkStack :: Action () -checkStack = do - stackVersion <- trimmedStdout <$> execStackShake ["--numeric-version"] +checkStack :: [String] -> Action () +checkStack args = do + stackVersion <- trimmedStdout <$> (execStackShake $ ["--numeric-version"] ++ args) unless (checkVersion requiredStackVersion stackVersion) $ do printInStars $ stackExeIsOldFailMsg stackVersion error $ stackExeIsOldFailMsg stackVersion -- | Get the local binary path of stack. -- Equal to the command `stack path --local-bin` -getLocalBin :: Action FilePath -getLocalBin = do - Stdout stackLocalDir' <- execStackShake ["path", "--local-bin"] +getLocalBin :: [String] -> Action FilePath +getLocalBin args = do + Stdout stackLocalDir' <- execStackShake $ ["path", "--local-bin"] ++ args return $ trim stackLocalDir' -stackBuildData :: Action () -stackBuildData = do - execStackShake_ ["build", "hoogle"] - execStackShake_ ["exec", "hoogle", "generate"] +stackBuildData :: [String] -> Action () +stackBuildData args = do + execStackShake_ $ ["build", "hoogle"] ++ args + execStackShake_ $ ["exec", "hoogle", "generate"] ++ args -- | Execute a stack command for a specified ghc, discarding the output execStackWithGhc_ :: VersionNumber -> [String] -> Action () @@ -116,4 +113,22 @@ stackBuildFailMsg = $ "Building failed, " ++ "Try running `stack clean` and restart the build\n" ++ "If this does not work, open an issue at \n" - ++ "\thttps://github.com/haskell/haskell-language-server-engine" + ++ "\thttps://github.com/haskell/haskell-language-engine" + +getVerbosityArg :: Verbosity -> String +getVerbosityArg v = "--verbosity=" ++ stackVerbosity + where stackVerbosity = case v of + Silent -> "silent" +#if MIN_VERSION_shake(0,18,4) + Error -> "error" + Warn -> "warn" + Info -> "info" + Verbose -> "info" +#else + Quiet -> "error" + Normal -> "warn" + Loud -> "info" + Chatty -> "info" +#endif + + Diagnostic -> "debug" \ No newline at end of file diff --git a/install/src/Version.hs b/install/src/Version.hs index 0d89b4b95d..4647004145 100644 --- a/install/src/Version.hs +++ b/install/src/Version.hs @@ -6,7 +6,6 @@ import Data.Version ( Version , showVersion ) import Text.ParserCombinators.ReadP ( readP_to_S ) -import Control.Monad.IO.Class type VersionNumber = String