From 84624187f2d1b68f44599cbf39a82432271a0e76 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Mon, 29 Apr 2019 22:26:46 +0200 Subject: [PATCH 01/22] add possibility to run `install.hs` from cabal additionally provide mechanism for detecting if run from stack or cabal. --- install.hs | 612 +------------------------------------- install/BuildSystem.hs | 11 + install/Install.hs | 592 ++++++++++++++++++++++++++++++++++++ install/Setup.hs | 2 + install/hie-install.cabal | 28 ++ shake.project | 2 + shake.yaml | 6 +- 7 files changed, 653 insertions(+), 600 deletions(-) create mode 100644 install/BuildSystem.hs create mode 100644 install/Install.hs create mode 100644 install/Setup.hs create mode 100644 install/hie-install.cabal create mode 100644 shake.project diff --git a/install.hs b/install.hs index c3ca1b0f1..782c4a5ed 100755 --- a/install.hs +++ b/install.hs @@ -1,606 +1,20 @@ #!/usr/bin/env stack {- stack runghc - --stack-yaml=shake.yaml - --package shake - --package directory - --package extra + --stack-yaml=install/shake.yaml + --package hie-install -} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TupleSections #-} -import Development.Shake -import Development.Shake.Command -import Development.Shake.FilePath -import Control.Monad -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Extra ( unlessM - , mapMaybeM - ) -import Data.Maybe ( isJust ) -import System.Directory ( findExecutable - , findExecutables - , listDirectory - ) -import System.Environment ( getProgName - , unsetEnv - ) -import System.Info ( os - , arch - ) - -import Data.Maybe ( isNothing - , mapMaybe - ) -import Data.List ( dropWhileEnd - , intersperse - , intercalate - , isInfixOf - , nubBy - , sort - ) -import qualified Data.Text as T -import Data.Char ( isSpace ) -import Data.Version ( parseVersion - , makeVersion - , showVersion - ) -import Data.Function ( (&) - , on - ) -import Text.ParserCombinators.ReadP ( readP_to_S ) - -type VersionNumber = String -type GhcPath = String - --- | Defines all different hie versions that are buildable. --- --- The current directory is scanned for `stack-*.yaml` files. --- On windows, `8.6.3` is excluded as this version of ghc does not work there -getHieVersions :: MonadIO m => m [VersionNumber] -getHieVersions = do - let stackYamlPrefix = T.pack "stack-" - let stackYamlSuffix = T.pack ".yaml" - files <- liftIO $ listDirectory "." - let hieVersions = files - & map T.pack - & mapMaybe - (T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix) - & map T.unpack - -- the following line excludes `8.6.3` on windows systems - & filter (\p -> not isWindowsSystem || p /= "8.6.3") - & sort - return hieVersions - --- | Most recent version of hie. --- Shown in the more concise help message. -mostRecentHieVersion :: MonadIO m => m VersionNumber -mostRecentHieVersion = last <$> getHieVersions - -main :: IO () -main = do - -- unset GHC_PACKAGE_PATH for cabal - unsetEnv "GHC_PACKAGE_PATH" - - ghcPaths <- findInstalledGhcs - let ghcVersions = map fst ghcPaths - - hieVersions <- getHieVersions - - shakeArgs shakeOptions { shakeFiles = "_build" } $ do - want ["short-help"] - -- general purpose targets - phony "submodules" updateSubmodules - phony "cabal" installCabal - phony "short-help" shortHelpMessage - phony "all" shortHelpMessage - phony "help" helpMessage - phony "check-stack" checkStack - - phony "cabal-ghcs" $ do - let - msg = - "Found the following GHC paths: \n" - ++ unlines - (map (\(version, path) -> "ghc-" ++ version ++ ": " ++ path) - ghcPaths - ) - liftIO $ putStrLn $ embedInStars msg - - -- stack specific targets - phony "build" (need (reverse $ map ("hie-" ++) hieVersions)) - phony "build-all" (need ["build-doc", "build"]) - phony "test" $ do - need ["submodules"] - need ["check-stack"] - need ["cabal"] - forM_ hieVersions stackTest - - phony "build-copy-compiler-tool" $ forM_ hieVersions buildCopyCompilerTool - - phony "build-doc" $ do - need ["submodules"] - need ["check-stack"] - stackBuildDoc - - -- main targets for building hie with `stack` - forM_ - hieVersions - (\version -> phony ("hie-" ++ version) $ do - need ["submodules"] - need ["check-stack"] - need ["cabal"] - stackBuildHie version - stackInstallHie version - ) - - -- cabal specific targets - phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) - phony "cabal-build-all" (need ["cabal-build-doc", "cabal-build"]) - phony "cabal-build-doc" $ do - need ["submodules"] - need ["cabal"] - cabalBuildDoc - - phony "cabal-test" $ do - need ["submodules"] - need ["cabal"] - forM_ ghcVersions cabalTest - - forM_ - ghcVersions - (\version -> phony ("cabal-hie-" ++ version) $ do - validateCabalNewInstallIsSupported - need ["submodules"] - need ["cabal"] - cabalBuildHie version - cabalInstallHie version - ) - - -- macos specific targets - phony "icu-macos-fix" - (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 hieVersions - - -buildIcuMacosFix :: VersionNumber -> Action () -buildIcuMacosFix version = execStackWithGhc_ - version - [ "build" - , "text-icu" - , "--extra-lib-dirs=/usr/local/opt/icu4c/lib" - , "--extra-include-dirs=/usr/local/opt/icu4c/include" - ] - --- | update the submodules that the project is in the state as required by the `stack.yaml` files -updateSubmodules :: Action () -updateSubmodules = do - command_ [] "git" ["submodule", "sync", "--recursive"] - command_ [] "git" ["submodule", "update", "--init", "--recursive"] - --- TODO: this restriction will be gone in the next release of cabal -validateCabalNewInstallIsSupported :: Action () -validateCabalNewInstallIsSupported = when isWindowsSystem $ do - liftIO $ putStrLn $ embedInStars cabalInstallNotSuportedFailMsg - error cabalInstallNotSuportedFailMsg - -configureCabal :: VersionNumber -> Action () -configureCabal versionNumber = do - ghcPath <- getGhcPathOf versionNumber >>= \case - Nothing -> do - liftIO $ putStrLn $ embedInStars (ghcVersionNotFoundFailMsg versionNumber) - error (ghcVersionNotFoundFailMsg versionNumber) - Just p -> return p - execCabal_ - ["new-configure", "-w", ghcPath, "--write-ghc-environment-files=never"] - -findInstalledGhcs :: IO [(VersionNumber, GhcPath)] -findInstalledGhcs = do - hieVersions <- getHieVersions :: IO [VersionNumber] - knownGhcs <- mapMaybeM - (\version -> getGhcPathOf version >>= \case - Nothing -> return Nothing - Just p -> return $ Just (version, p) - ) - (reverse hieVersions) - availableGhcs <- getGhcPaths - return - -- nub by version. knownGhcs takes precedence. - $ nubBy ((==) `on` fst) - -- filter out stack provided GHCs - $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs) - -cabalBuildHie :: VersionNumber -> Action () -cabalBuildHie versionNumber = do - configureCabal versionNumber - execCabal_ ["new-build", "--write-ghc-environment-files=never"] - -cabalInstallHie :: VersionNumber -> Action () -cabalInstallHie versionNumber = do - localBin <- getLocalBin - execCabal_ - [ "new-install" - , "--write-ghc-environment-files=never" - , "--symlink-bindir=" ++ localBin - , "exe:hie" - , "--overwrite-policy=always" - ] - copyFile' (localBin "hie" <.> exe) - (localBin "hie-" ++ versionNumber <.> exe) - copyFile' (localBin "hie" <.> exe) - (localBin "hie-" ++ dropExtension versionNumber <.> exe) - -cabalBuildDoc :: Action () -cabalBuildDoc = do - execCabal_ ["new-build", "hoogle"] - execCabal_ ["new-exec", "hoogle", "generate"] - -cabalTest :: VersionNumber -> Action () -cabalTest versionNumber = do - configureCabal versionNumber - execCabal_ ["new-test"] - -installCabal :: Action () -installCabal = do - -- try to find existing `cabal` executable with appropriate version - cabalExe <- liftIO (findExecutable "cabal") >>= \case - Nothing -> return Nothing - Just cabalExe -> do - Stdout cabalVersion <- execCabal ["--numeric-version"] - let (parsedVersion, "") : _ = - cabalVersion & trim & readP_to_S parseVersion & filter - (("" ==) . snd) - - return $ if parsedVersion >= makeVersion [2, 4, 1, 0] - then Just cabalExe - else Nothing - -- install `cabal-install` if not already installed - when (isNothing cabalExe) $ - execStackShake_ ["install", "cabal-install"] - execCabal_ ["v1-update"] - - -checkStack :: Action () -checkStack = do - Stdout stackVersion <- execStackShake ["--numeric-version"] - let (parsedVersion, "") : _ = - stackVersion & trim & readP_to_S parseVersion & filter - (("" ==) . snd) - unless (parsedVersion >= makeVersion requiredStackVersion) $ do - liftIO $ putStrLn $ embedInStars $ stackExeIsOldFailMsg $ trim stackVersion - error $ stackExeIsOldFailMsg $ trim stackVersion - - -stackBuildHie :: VersionNumber -> Action () -stackBuildHie versionNumber = - execStackWithGhc_ versionNumber ["build"] - `actionOnException` liftIO (putStrLn stackBuildFailMsg) - --- | copy the built binaries into the localBinDir -stackInstallHie :: VersionNumber -> Action () -stackInstallHie versionNumber = do - execStackWithGhc_ versionNumber ["install"] - localBinDir <- getLocalBin - localInstallRoot <- getLocalInstallRoot versionNumber - let hie = "hie" <.> exe - copyFile' (localInstallRoot "bin" hie) - (localBinDir "hie-" ++ versionNumber <.> exe) - copyFile' (localInstallRoot "bin" hie) - (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) - -buildCopyCompilerTool :: VersionNumber -> Action () -buildCopyCompilerTool versionNumber = - execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"] - -stackTest :: VersionNumber -> Action () -stackTest versionNumber = execStackWithGhc_ versionNumber ["test"] - -stackBuildDoc :: Action () -stackBuildDoc = do - execStackShake_ ["build", "hoogle"] - execStackShake_ ["exec", "hoogle", "generate"] - --- | short help message is printed by default -shortHelpMessage :: Action () -shortHelpMessage = do - hieVersions <- getHieVersions - let out = liftIO . putStrLn - scriptName <- liftIO getProgName - out "" - out "Usage:" - out' ("stack " <> scriptName <> " ") - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" - where - out = liftIO . putStrLn - out' = out . (" " ++) - - spaces hieVersions = space (targets hieVersions) - targets hieVersions = - [ ("help", "Show help message including all targets") - , emptyTarget - , ( "build" - , "Builds hie for all supported GHC versions (" - ++ allVersionMessage hieVersions - ++ ")" - ) - , stackBuildAllTarget - -- , stackHieTarget mostRecentHieVersion - , stackBuildDocTarget - , stackHieTarget (last hieVersions) - , emptyTarget - , ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." - ) - , cabalBuildTarget - , cabalBuildAllTarget - -- , cabalHieTarget mostRecentHieVersion - , cabalBuildDocTarget - , cabalHieTarget (last hieVersions) - ] - - -helpMessage :: Action () -helpMessage = do - - hieVersions <- getHieVersions - scriptName <- liftIO getProgName - out "" - out "Usage:" - out' ("stack " <> scriptName <> " ") - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" - where - out = liftIO . putStrLn - out' = out . (" " ++) - - spaces hieVersions = space (targets hieVersions) - -- All targets the shake file supports - targets :: [VersionNumber] -> [(String, String)] - targets hieVersions = intercalate - [emptyTarget] - [ generalTargets - , stackTargets hieVersions - , cabalTargets hieVersions - , macosTargets - ] - - -- All targets with their respective help message. - generalTargets = - [ ("help", "Show help message including all targets") - , ( "cabal" - , "Makes sure that Cabal the lib is available for cabal-helper-wapper, to speed up project start" - ) - ] - - macosTargets = [("icu-macos-fix", "Fixes icu related problems in MacOS")] - - stackTargets hieVersions = - [ ( "build" - , "Builds hie for all supported GHC versions (" - ++ allVersionMessage hieVersions - ++ ")" - ) - , stackBuildAllTarget - , stackBuildDocTarget - , ("test", "Runs hie tests with stack") - ] - ++ map stackHieTarget hieVersions - - cabalTargets hieVersions = - [ ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." - ) - , cabalBuildTarget - , cabalBuildAllTarget - , cabalBuildDocTarget - , ("cabal-test", "Runs hie tests with cabal") - ] - ++ map cabalHieTarget hieVersions - --- | Empty target. Purpose is to introduce a newline between the targets -emptyTarget :: (String, String) -emptyTarget = ("", "") - --- | 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 :: [(String, String)] -> Int -space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets) - --- | Show a target. --- Concatenates the target with its help message and inserts whitespace between them. -showTarget :: Int -> (String, String) -> String -showTarget spaces (target, msg) = - target ++ replicate (spaces - length target) ' ' ++ msg - --- | Target for a specific ghc version -stackHieTarget :: String -> (String, String) -stackHieTarget version = - ( "hie-" ++ version - , "Builds hie for GHC version " ++ version ++ " only with stack" - ) - --- | Target for a specific ghc version -cabalHieTarget :: String -> (String, String) -cabalHieTarget version = - ( "cabal-hie-" ++ version - , "Builds hie for GHC version " ++ version ++ " only with cabal new-build" - ) - -stackBuildDocTarget :: (String, String) -stackBuildDocTarget = ("build-doc", "Builds the Hoogle database") - -stackBuildAllTarget :: (String, String) -stackBuildAllTarget = - ( "build-all" - , "Builds hie for all supported GHC versions and the hoogle database" - ) - -cabalBuildTarget :: (String, String) -cabalBuildTarget = - ("cabal-build", "Builds hie with cabal with all installed GHCs.") - -cabalBuildDocTarget :: (String, String) -cabalBuildDocTarget = - ("cabal-build-doc", "Builds the Hoogle database with cabal") - -cabalBuildAllTarget :: (String, String) -cabalBuildAllTarget = - ( "cabal-build-all" - , "Builds hie for all installed GHC versions and the hoogle database with cabal" - ) - --- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. --- If there is no GHC in the list of `hieVersions` -allVersionMessage :: [String] -> String -allVersionMessage wordList = case wordList of - [] -> "" - [a] -> show a - (a : as) -> - let msg = intersperse ", " wordList - lastVersion = last msg - in concat $ (init $ init msg) ++ [" and ", lastVersion] - - --- RUN EXECUTABLES - --- | Execute a stack command for a specified ghc, discarding the output -execStackWithGhc_ :: VersionNumber -> [String] -> Action () -execStackWithGhc_ versionNumber args = do - let stackFile = "stack-" ++ versionNumber ++ ".yaml" - command_ [] "stack" (("--stack-yaml=" ++ stackFile) : args) - --- | Execute a stack command for a specified ghc -execStackWithGhc :: CmdResult r => VersionNumber -> [String] -> Action r -execStackWithGhc versionNumber args = do - let stackFile = "stack-" ++ versionNumber ++ ".yaml" - command [] "stack" (("--stack-yaml=" ++ stackFile) : args) - --- | Execute a stack command with the same resolver as the build script -execStackShake :: CmdResult r => [String] -> Action r -execStackShake args = - command [] "stack" ("--stack-yaml=shake.yaml" : args) - --- | Execute a stack command with the same resolver as the build script, discarding the output -execStackShake_ :: [String] -> Action () -execStackShake_ args = - command_ [] "stack" ("--stack-yaml=shake.yaml" : args) - -execCabal :: CmdResult r => [String] -> Action r -execCabal = - command [] "cabal" - -execCabal_ :: [String] -> Action () -execCabal_ = command_ [] "cabal" - -existsExecutable :: MonadIO m => String -> m Bool -existsExecutable executable = liftIO $ isJust <$> findExecutable executable - - --- QUERY ENVIRONMENT - --- |Check if the current system is windows -isWindowsSystem :: Bool -isWindowsSystem = os `elem` ["mingw32", "win32"] - --- | Get the path to the GHC compiler executable linked to the local `stack-$GHCVER.yaml`. --- Equal to the command `stack path --stack-yaml $stack-yaml --compiler-exe`. --- This might install a GHC if it is not already installed, thus, might fail if stack fails to install the GHC. -getStackGhcPath :: VersionNumber -> Action GhcPath -getStackGhcPath ghcVersion = do - Stdout ghc <- execStackWithGhc ghcVersion ["path", "--compiler-exe"] - return $ trim ghc - -getStackGhcPathShake :: Action GhcPath -getStackGhcPathShake = do - Stdout ghc <- execStackShake ["path", "--compiler-exe"] - return $ trim ghc - --- | Get the path to a GHC that has the version specified by `VersionNumber` --- If no such GHC can be found, Nothing is returned. --- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`. --- If this yields no result, it is checked, whether the numeric-version of the `ghc` --- command fits to the desired version. -getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath) -getGhcPathOf ghcVersion = - liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case - Nothing -> lookup ghcVersion <$> getGhcPaths - path -> return path - --- | Get a list of GHCs that are available in $PATH -getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)] -getGhcPaths = liftIO $ do - paths <- findExecutables "ghc" - forM paths $ \path -> do - Stdout version <- cmd path ["--numeric-version"] - return (trim version, path) - --- | Read the local install root of the stack project specified by the VersionNumber --- Returns the filepath of the local install root. --- Equal to the command `stack path --local-install-root` -getLocalInstallRoot :: VersionNumber -> Action FilePath -getLocalInstallRoot hieVersion = do - Stdout localInstallRoot' <- execStackWithGhc - hieVersion - ["path", "--local-install-root"] - return $ trim localInstallRoot' - --- | 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"] - return $ trim stackLocalDir' - --- | Trim the end of a string -trim :: String -> String -trim = dropWhileEnd isSpace - --- | Embed a string within two lines of stars to improve perceivability and, thus, readability. -embedInStars :: String -> String -embedInStars str = - let starsLine - = "\n******************************************************************\n" - in starsLine <> str <> starsLine - --- |Stack build fails message -stackBuildFailMsg :: String -stackBuildFailMsg = - embedInStars - $ "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-ide-engine" - --- | No suitable ghc version has been found. Show a message. -ghcVersionNotFoundFailMsg :: VersionNumber -> String -ghcVersionNotFoundFailMsg versionNumber = - "No GHC with version " - <> versionNumber - <> " has been found.\n" - <> "Either install a fitting GHC, use the stack targets or modify the PATH variable accordingly." +{- cabal: +build-depends: + base + , hie-install +-} +-- call as: +-- * `cabal v2-run install.hs --project-file install/shake.project ` +-- * `stack install.hs ` --- | Error message when a windows system tries to install HIE via `cabal new-install` -cabalInstallNotSuportedFailMsg :: String -cabalInstallNotSuportedFailMsg = - "This system has been identified as a windows system.\n" - ++ "Unfortunately, `cabal new-install` is currently not supported on windows.\n" - ++ "Please use one of the stack-based targets.\n\n" - ++ "If this system has been falsely identified, please open an issue at:\n\thttps://github.com/haskell/haskell-ide-engine\n" +-- TODO: set `shake.project` in cabal-config above, when supported --- | Error message when the `stack` binary is an older version -stackExeIsOldFailMsg :: String -> String -stackExeIsOldFailMsg stackVersion = - "The `stack` executable is outdated.\n" - ++ "found version is `" ++ stackVersion ++ "`.\n" - ++ "required version is `" ++ showVersion (makeVersion requiredStackVersion) ++ "`.\n" - ++ "Please run `stack upgrade` to upgrade your stack installation" +import Install (defaultMain) -requiredStackVersion :: [Int] -requiredStackVersion = [1, 9, 3] +main = defaultMain diff --git a/install/BuildSystem.hs b/install/BuildSystem.hs new file mode 100644 index 000000000..75d76ad79 --- /dev/null +++ b/install/BuildSystem.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE CPP #-} + +module BuildSystem where + +buildSystem :: String +buildSystem = +#if RUN_FROM_STACK + "stack" +#else + "cabal" +#endif diff --git a/install/Install.hs b/install/Install.hs new file mode 100644 index 000000000..8203e9cf8 --- /dev/null +++ b/install/Install.hs @@ -0,0 +1,592 @@ +module Install where + +{-# LANGUAGE TupleSections #-} +import Development.Shake +import Development.Shake.Command +import Development.Shake.FilePath +import Control.Monad +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Extra ( unlessM + , mapMaybeM + ) +import Data.Maybe ( isJust ) +import System.Directory ( findExecutable + , listDirectory + ) +import System.Environment ( getProgName + , 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 + +type VersionNumber = String +type GhcPath = String + +-- | Defines all different hie versions that are buildable. +-- +-- The current directory is scanned for `stack-*.yaml` files. +-- On windows, `8.6.3` is excluded as this version of ghc does not work there +getHieVersions :: MonadIO m => m [VersionNumber] +getHieVersions = do + let stackYamlPrefix = T.pack "stack-" + let stackYamlSuffix = T.pack ".yaml" + files <- liftIO $ listDirectory "." + let hieVersions = files + & map T.pack + & mapMaybe + (T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix) + & map T.unpack + -- the following line excludes `8.6.3` on windows systems + & filter (\p -> not isWindowsSystem || p /= "8.6.3") + & sort + return hieVersions + +-- | Most recent version of hie. +-- Shown in the more concise help message. +mostRecentHieVersion :: MonadIO m => m VersionNumber +mostRecentHieVersion = last <$> getHieVersions + +defaultMain :: IO () +defaultMain = do + putStrLn $ "run from build-system: " ++ buildSystem + + exitWith ExitSuccess + + -- unset GHC_PACKAGE_PATH for cabal + unsetEnv "GHC_PACKAGE_PATH" + + ghcPaths <- findInstalledGhcs + let ghcVersions = map fst ghcPaths + + hieVersions <- getHieVersions + + shakeArgs shakeOptions { shakeFiles = "_build" } $ do + want ["short-help"] + -- general purpose targets + phony "submodules" updateSubmodules + phony "cabal" installCabal + phony "short-help" shortHelpMessage + phony "all" shortHelpMessage + phony "help" helpMessage + phony "check-stack" checkStack + + phony "cabal-ghcs" $ do + let + msg = + "Found the following GHC paths: \n" + ++ unlines + (map (\(version, path) -> "ghc-" ++ version ++ ": " ++ path) + ghcPaths + ) + liftIO $ putStrLn $ embedInStars msg + + -- stack specific targets + phony "build" (need (reverse $ map ("hie-" ++) hieVersions)) + phony "build-all" (need ["build-doc", "build"]) + phony "test" $ do + need ["submodules"] + need ["check-stack"] + need ["cabal"] + forM_ hieVersions stackTest + + phony "build-copy-compiler-tool" $ forM_ hieVersions buildCopyCompilerTool + + phony "build-doc" $ do + need ["submodules"] + need ["check-stack"] + stackBuildDoc + + -- main targets for building hie with `stack` + forM_ + hieVersions + (\version -> phony ("hie-" ++ version) $ do + need ["submodules"] + need ["check-stack"] + need ["cabal"] + stackBuildHie version + stackInstallHie version + ) + + -- cabal specific targets + phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) + phony "cabal-build-all" (need ["cabal-build-doc", "cabal-build"]) + phony "cabal-build-doc" $ do + need ["submodules"] + need ["cabal"] + cabalBuildDoc + + phony "cabal-test" $ do + need ["submodules"] + need ["cabal"] + forM_ ghcVersions cabalTest + + forM_ + hieVersions + (\version -> phony ("cabal-hie-" ++ version) $ do + validateCabalNewInstallIsSupported + need ["submodules"] + need ["cabal"] + cabalBuildHie version + cabalInstallHie version + ) + + -- macos specific targets + phony "icu-macos-fix" + (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 hieVersions + + +buildIcuMacosFix :: VersionNumber -> Action () +buildIcuMacosFix version = execStackWithGhc_ + version + [ "build" + , "text-icu" + , "--extra-lib-dirs=/usr/local/opt/icu4c/lib" + , "--extra-include-dirs=/usr/local/opt/icu4c/include" + ] + +-- | update the submodules that the project is in the state as required by the `stack.yaml` files +updateSubmodules :: Action () +updateSubmodules = do + command_ [] "git" ["submodule", "sync", "--recursive"] + command_ [] "git" ["submodule", "update", "--init", "--recursive"] + +-- TODO: this restriction will be gone in the next release of cabal +validateCabalNewInstallIsSupported :: Action () +validateCabalNewInstallIsSupported = when isWindowsSystem $ do + liftIO $ putStrLn $ embedInStars cabalInstallNotSuportedFailMsg + error cabalInstallNotSuportedFailMsg + +configureCabal :: VersionNumber -> Action () +configureCabal versionNumber = do + ghcPath <- getGhcPath versionNumber >>= \case + Nothing -> do + liftIO $ putStrLn $ embedInStars (ghcVersionNotFoundFailMsg versionNumber) + error (ghcVersionNotFoundFailMsg versionNumber) + Just p -> return p + execCabal_ + ["new-configure", "-w", ghcPath, "--write-ghc-environment-files=never"] + +findInstalledGhcs :: IO [(VersionNumber, GhcPath)] +findInstalledGhcs = do + hieVersions <- getHieVersions :: IO [VersionNumber] + mapMaybeM + (\version -> getGhcPath version >>= \case + Nothing -> return Nothing + Just p -> return $ Just (version, p) + ) + (reverse hieVersions) + +cabalBuildHie :: VersionNumber -> Action () +cabalBuildHie versionNumber = do + configureCabal versionNumber + execCabal_ ["new-build", "--write-ghc-environment-files=never"] + +cabalInstallHie :: VersionNumber -> Action () +cabalInstallHie versionNumber = do + localBin <- getLocalBin + execCabal_ + [ "new-install" + , "--write-ghc-environment-files=never" + , "--symlink-bindir=" ++ localBin + , "exe:hie" + , "--overwrite-policy=always" + ] + copyFile' (localBin "hie" <.> exe) + (localBin "hie-" ++ versionNumber <.> exe) + copyFile' (localBin "hie" <.> exe) + (localBin "hie-" ++ dropExtension versionNumber <.> exe) + +cabalBuildDoc :: Action () +cabalBuildDoc = do + execCabal_ ["new-build", "hoogle", "generate"] + execCabal_ ["new-exec", "hoogle", "generate"] + +cabalTest :: VersionNumber -> Action () +cabalTest versionNumber = do + configureCabal versionNumber + execCabal_ ["new-test"] + +installCabal :: Action () +installCabal = do + -- try to find existing `cabal` executable with appropriate version + cabalExe <- liftIO (findExecutable "cabal") >>= \case + Nothing -> return Nothing + Just cabalExe -> do + Stdout cabalVersion <- execCabal ["--numeric-version"] + let (parsedVersion, "") : _ = + cabalVersion & trim & readP_to_S parseVersion & filter + (("" ==) . snd) + + return $ if parsedVersion >= makeVersion [2, 4, 1, 0] + then Just cabalExe + else Nothing + -- install `cabal-install` if not already installed + when (isNothing cabalExe) $ + execStackShake_ ["install", "cabal-install"] + execCabal_ ["update"] + + +checkStack :: Action () +checkStack = do + Stdout stackVersion <- execStackShake ["--numeric-version"] + let (parsedVersion, "") : _ = + stackVersion & trim & readP_to_S parseVersion & filter + (("" ==) . snd) + unless (parsedVersion >= makeVersion requiredStackVersion) $ do + liftIO $ putStrLn $ embedInStars $ stackExeIsOldFailMsg $ trim stackVersion + error $ stackExeIsOldFailMsg $ trim stackVersion + + +stackBuildHie :: VersionNumber -> Action () +stackBuildHie versionNumber = + execStackWithGhc_ versionNumber ["build"] + `actionOnException` liftIO (putStrLn stackBuildFailMsg) + +-- | copy the built binaries into the localBinDir +stackInstallHie :: VersionNumber -> Action () +stackInstallHie versionNumber = do + execStackWithGhc_ versionNumber ["install"] + localBinDir <- getLocalBin + localInstallRoot <- getLocalInstallRoot versionNumber + let hie = "hie" <.> exe + copyFile' (localInstallRoot "bin" hie) + (localBinDir "hie-" ++ versionNumber <.> exe) + copyFile' (localInstallRoot "bin" hie) + (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) + +buildCopyCompilerTool :: VersionNumber -> Action () +buildCopyCompilerTool versionNumber = + execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"] + +stackTest :: VersionNumber -> Action () +stackTest versionNumber = execStackWithGhc_ versionNumber ["test"] + +stackBuildDoc :: Action () +stackBuildDoc = do + execStackShake_ ["build", "hoogle"] + execStackShake_ ["exec", "hoogle", "generate"] + +-- | short help message is printed by default +shortHelpMessage :: Action () +shortHelpMessage = do + hieVersions <- getHieVersions + let out = liftIO . putStrLn + scriptName <- liftIO getProgName + out "" + out "Usage:" + out' ("stack " <> scriptName <> " ") + out "" + out "Targets:" + mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + out "" + where + out = liftIO . putStrLn + out' = out . (" " ++) + + spaces hieVersions = space (targets hieVersions) + targets hieVersions = + [ ("help", "Show help message including all targets") + , emptyTarget + , ( "build" + , "Builds hie for all supported GHC versions (" + ++ allVersionMessage hieVersions + ++ ")" + ) + , stackBuildAllTarget + -- , stackHieTarget mostRecentHieVersion + , stackBuildDocTarget + , stackHieTarget (last hieVersions) + , emptyTarget + , ( "cabal-ghcs" + , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + ) + , cabalBuildTarget + , cabalBuildAllTarget + -- , cabalHieTarget mostRecentHieVersion + , cabalBuildDocTarget + , cabalHieTarget (last hieVersions) + ] + + +helpMessage :: Action () +helpMessage = do + + hieVersions <- getHieVersions + scriptName <- liftIO getProgName + out "" + out "Usage:" + out' ("stack " <> scriptName <> " ") + out "" + out "Targets:" + mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + out "" + where + out = liftIO . putStrLn + out' = out . (" " ++) + + spaces hieVersions = space (targets hieVersions) + -- All targets the shake file supports + targets :: [VersionNumber] -> [(String, String)] + targets hieVersions = intercalate + [emptyTarget] + [ generalTargets + , stackTargets hieVersions + , cabalTargets hieVersions + , macosTargets + ] + + -- All targets with their respective help message. + generalTargets = + [ ("help", "Show help message including all targets") + , ( "cabal" + , "Makes sure that Cabal the lib is available for cabal-helper-wapper, to speed up project start" + ) + ] + + macosTargets = [("icu-macos-fix", "Fixes icu related problems in MacOS")] + + stackTargets hieVersions = + [ ( "build" + , "Builds hie for all supported GHC versions (" + ++ allVersionMessage hieVersions + ++ ")" + ) + , stackBuildAllTarget + , stackBuildDocTarget + , ("test", "Runs hie tests with stack") + ] + ++ map stackHieTarget hieVersions + + cabalTargets hieVersions = + [ ( "cabal-ghcs" + , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + ) + , cabalBuildTarget + , cabalBuildAllTarget + , cabalBuildDocTarget + , ("cabal-test", "Runs hie tests with cabal") + ] + ++ map cabalHieTarget hieVersions + +-- | Empty target. Purpose is to introduce a newline between the targets +emptyTarget :: (String, String) +emptyTarget = ("", "") + +-- | 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 :: [(String, String)] -> Int +space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets) + +-- | Show a target. +-- Concatenates the target with its help message and inserts whitespace between them. +showTarget :: Int -> (String, String) -> String +showTarget spaces (target, msg) = + target ++ replicate (spaces - length target) ' ' ++ msg + +-- | Target for a specific ghc version +stackHieTarget :: String -> (String, String) +stackHieTarget version = + ( "hie-" ++ version + , "Builds hie for GHC version " ++ version ++ " only with stack" + ) + +-- | Target for a specific ghc version +cabalHieTarget :: String -> (String, String) +cabalHieTarget version = + ( "cabal-hie-" ++ version + , "Builds hie for GHC version " ++ version ++ " only with cabal new-build" + ) + +stackBuildDocTarget :: (String, String) +stackBuildDocTarget = ("build-doc", "Builds the Hoogle database") + +stackBuildAllTarget :: (String, String) +stackBuildAllTarget = + ( "build-all" + , "Builds hie for all supported GHC versions and the hoogle database" + ) + +cabalBuildTarget :: (String, String) +cabalBuildTarget = + ("cabal-build", "Builds hie with cabal with all installed GHCs.") + +cabalBuildDocTarget :: (String, String) +cabalBuildDocTarget = + ("cabal-build-doc", "Builds the Hoogle database with cabal") + +cabalBuildAllTarget :: (String, String) +cabalBuildAllTarget = + ( "cabal-build-all" + , "Builds hie for all installed GHC versions and the hoogle database with cabal" + ) + +-- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. +-- If there is no GHC in the list of `hieVersions` +allVersionMessage :: [String] -> String +allVersionMessage wordList = case wordList of + [] -> "" + [a] -> show a + (a : as) -> + let msg = intersperse ", " wordList + lastVersion = last msg + in concat $ (init $ init msg) ++ [" and ", lastVersion] + + +-- RUN EXECUTABLES + +-- | Execute a stack command for a specified ghc, discarding the output +execStackWithGhc_ :: VersionNumber -> [String] -> Action () +execStackWithGhc_ versionNumber args = do + let stackFile = "stack-" ++ versionNumber ++ ".yaml" + command_ [] "stack" (("--stack-yaml=" ++ stackFile) : args) + +-- | Execute a stack command for a specified ghc +execStackWithGhc :: CmdResult r => VersionNumber -> [String] -> Action r +execStackWithGhc versionNumber args = do + let stackFile = "stack-" ++ versionNumber ++ ".yaml" + command [] "stack" (("--stack-yaml=" ++ stackFile) : args) + +-- | Execute a stack command with the same resolver as the build script +execStackShake :: CmdResult r => [String] -> Action r +execStackShake args = + command [] "stack" ("--stack-yaml=shake.yaml" : args) + +-- | Execute a stack command with the same resolver as the build script, discarding the output +execStackShake_ :: [String] -> Action () +execStackShake_ args = + command_ [] "stack" ("--stack-yaml=shake.yaml" : args) + +execCabal :: CmdResult r => [String] -> Action r +execCabal = + command [] "cabal" + +execCabal_ :: [String] -> Action () +execCabal_ = command_ [] "cabal" + +existsExecutable :: MonadIO m => String -> m Bool +existsExecutable executable = liftIO $ isJust <$> findExecutable executable + + +-- QUERY ENVIRONMENT + +-- |Check if the current system is windows +isWindowsSystem :: Bool +isWindowsSystem = os `elem` ["mingw32", "win32"] + +-- | Get the path to the GHC compiler executable linked to the local `stack-$GHCVER.yaml`. +-- Equal to the command `stack path --stack-yaml $stack-yaml --compiler-exe`. +-- This might install a GHC if it is not already installed, thus, might fail if stack fails to install the GHC. +getStackGhcPath :: VersionNumber -> Action GhcPath +getStackGhcPath ghcVersion = do + Stdout ghc <- execStackWithGhc ghcVersion ["path", "--compiler-exe"] + return $ trim ghc + +getStackGhcPathShake :: Action GhcPath +getStackGhcPathShake = do + Stdout ghc <- execStackShake ["path", "--compiler-exe"] + return $ trim ghc + +-- | Get the path to a GHC that has the version specified by `VersionNumber` +-- If no such GHC can be found, Nothing is returned. +-- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`. +-- If this yields no result, it is checked, whether the numeric-version of the `ghc` +-- command fits to the desired version. +getGhcPath :: MonadIO m => VersionNumber -> m (Maybe GhcPath) +getGhcPath ghcVersion = liftIO $ + findExecutable ("ghc-" ++ ghcVersion) >>= \case + Nothing -> do + findExecutable "ghc" >>= \case + Nothing -> return Nothing + Just p -> do + Stdout version <- cmd p ["--numeric-version"] :: IO (Stdout String) + if ghcVersion == trim version then return $ Just p else return Nothing + p -> return p + +-- | Read the local install root of the stack project specified by the VersionNumber +-- Returns the filepath of the local install root. +-- Equal to the command `stack path --local-install-root` +getLocalInstallRoot :: VersionNumber -> Action FilePath +getLocalInstallRoot hieVersion = do + Stdout localInstallRoot' <- execStackWithGhc + hieVersion + ["path", "--local-install-root"] + return $ trim localInstallRoot' + +-- | 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"] + return $ trim stackLocalDir' + +-- | Trim the end of a string +trim :: String -> String +trim = dropWhileEnd isSpace + +-- | Embed a string within two lines of stars to improve perceivability and, thus, readability. +embedInStars :: String -> String +embedInStars str = + let starsLine + = "\n******************************************************************\n" + in starsLine <> str <> starsLine + +-- |Stack build fails message +stackBuildFailMsg :: String +stackBuildFailMsg = + embedInStars + $ "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-ide-engine" + +-- | No suitable ghc version has been found. Show a message. +ghcVersionNotFoundFailMsg :: VersionNumber -> String +ghcVersionNotFoundFailMsg versionNumber = + "No GHC with version " + <> versionNumber + <> " has been found.\n" + <> "Either install a fitting GHC, use the stack targets or modify the PATH variable accordingly." + +-- | Error message when a windows system tries to install HIE via `cabal new-install` +cabalInstallNotSuportedFailMsg :: String +cabalInstallNotSuportedFailMsg = + "This system has been identified as a windows system.\n" + ++ "Unfortunately, `cabal new-install` is currently not supported on windows.\n" + ++ "Please use one of the stack-based targets.\n\n" + ++ "If this system has been falsely identified, please open an issue at:\n\thttps://github.com/haskell/haskell-ide-engine\n" + +-- | Error message when the `stack` binary is an older version +stackExeIsOldFailMsg :: String -> String +stackExeIsOldFailMsg stackVersion = + "The `stack` executable is outdated.\n" + ++ "found version is `" ++ stackVersion ++ "`.\n" + ++ "required version is `" ++ showVersion (makeVersion requiredStackVersion) ++ "`.\n" + ++ "Please run `stack upgrade` to upgrade your stack installation" + +requiredStackVersion :: [Int] +requiredStackVersion = [1, 9, 3] diff --git a/install/Setup.hs b/install/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/install/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/install/hie-install.cabal b/install/hie-install.cabal new file mode 100644 index 000000000..f4b28a7ea --- /dev/null +++ b/install/hie-install.cabal @@ -0,0 +1,28 @@ +name: hie-install +version: 0.8.0.0 +synopsis: Install the haskell-ide-engine +license: BSD3 +author: Many, TBD when we release +maintainer: samuel.pilz@posteo.net +copyright: 2019 +build-type: Simple +cabal-version: >=2.0 + +library + hs-source-dirs: . + exposed-modules: Install + other-modules: BuildSystem + build-depends: base >= 4.9 && < 5 + , shake == 0.17.3 + , directory + , extra + , text + default-extensions: LambdaCase + + if flag(run-from-stack) + cpp-options: -DRUN_FROM_STACK + +flag run-from-stack + description: Inform the application that it is run from stack + default: False + manual: True diff --git a/shake.project b/shake.project new file mode 100644 index 000000000..94f06ec7e --- /dev/null +++ b/shake.project @@ -0,0 +1,2 @@ +packages: + install diff --git a/shake.yaml b/shake.yaml index e89f45704..b77f32905 100644 --- a/shake.yaml +++ b/shake.yaml @@ -1,7 +1,11 @@ # Used to provide a different environment for the shake build script resolver: lts-13.18 # GHC 8.6.4 packages: -- . +- install nix: packages: [ zlib ] + +flags: + hie-install: + run-from-stack: true From 1cc4501a2dea6bf197d64ad6b1a5cfff709d898c Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Sat, 4 May 2019 23:27:28 +0200 Subject: [PATCH 02/22] refactor installer-code --- install/Install.hs | 592 ------------------------------- install/hie-install.cabal | 9 +- install/{ => src}/BuildSystem.hs | 6 + install/src/Cabal.hs | 122 +++++++ install/src/Env.hs | 91 +++++ install/src/Install.hs | 355 ++++++++++++++++++ install/src/Print.hs | 39 ++ install/src/Stack.hs | 60 ++++ install/src/Version.hs | 24 ++ 9 files changed, 705 insertions(+), 593 deletions(-) delete mode 100644 install/Install.hs rename install/{ => src}/BuildSystem.hs (51%) create mode 100644 install/src/Cabal.hs create mode 100644 install/src/Env.hs create mode 100644 install/src/Install.hs create mode 100644 install/src/Print.hs create mode 100644 install/src/Stack.hs create mode 100644 install/src/Version.hs diff --git a/install/Install.hs b/install/Install.hs deleted file mode 100644 index 8203e9cf8..000000000 --- a/install/Install.hs +++ /dev/null @@ -1,592 +0,0 @@ -module Install where - -{-# LANGUAGE TupleSections #-} -import Development.Shake -import Development.Shake.Command -import Development.Shake.FilePath -import Control.Monad -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Extra ( unlessM - , mapMaybeM - ) -import Data.Maybe ( isJust ) -import System.Directory ( findExecutable - , listDirectory - ) -import System.Environment ( getProgName - , 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 - -type VersionNumber = String -type GhcPath = String - --- | Defines all different hie versions that are buildable. --- --- The current directory is scanned for `stack-*.yaml` files. --- On windows, `8.6.3` is excluded as this version of ghc does not work there -getHieVersions :: MonadIO m => m [VersionNumber] -getHieVersions = do - let stackYamlPrefix = T.pack "stack-" - let stackYamlSuffix = T.pack ".yaml" - files <- liftIO $ listDirectory "." - let hieVersions = files - & map T.pack - & mapMaybe - (T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix) - & map T.unpack - -- the following line excludes `8.6.3` on windows systems - & filter (\p -> not isWindowsSystem || p /= "8.6.3") - & sort - return hieVersions - --- | Most recent version of hie. --- Shown in the more concise help message. -mostRecentHieVersion :: MonadIO m => m VersionNumber -mostRecentHieVersion = last <$> getHieVersions - -defaultMain :: IO () -defaultMain = do - putStrLn $ "run from build-system: " ++ buildSystem - - exitWith ExitSuccess - - -- unset GHC_PACKAGE_PATH for cabal - unsetEnv "GHC_PACKAGE_PATH" - - ghcPaths <- findInstalledGhcs - let ghcVersions = map fst ghcPaths - - hieVersions <- getHieVersions - - shakeArgs shakeOptions { shakeFiles = "_build" } $ do - want ["short-help"] - -- general purpose targets - phony "submodules" updateSubmodules - phony "cabal" installCabal - phony "short-help" shortHelpMessage - phony "all" shortHelpMessage - phony "help" helpMessage - phony "check-stack" checkStack - - phony "cabal-ghcs" $ do - let - msg = - "Found the following GHC paths: \n" - ++ unlines - (map (\(version, path) -> "ghc-" ++ version ++ ": " ++ path) - ghcPaths - ) - liftIO $ putStrLn $ embedInStars msg - - -- stack specific targets - phony "build" (need (reverse $ map ("hie-" ++) hieVersions)) - phony "build-all" (need ["build-doc", "build"]) - phony "test" $ do - need ["submodules"] - need ["check-stack"] - need ["cabal"] - forM_ hieVersions stackTest - - phony "build-copy-compiler-tool" $ forM_ hieVersions buildCopyCompilerTool - - phony "build-doc" $ do - need ["submodules"] - need ["check-stack"] - stackBuildDoc - - -- main targets for building hie with `stack` - forM_ - hieVersions - (\version -> phony ("hie-" ++ version) $ do - need ["submodules"] - need ["check-stack"] - need ["cabal"] - stackBuildHie version - stackInstallHie version - ) - - -- cabal specific targets - phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) - phony "cabal-build-all" (need ["cabal-build-doc", "cabal-build"]) - phony "cabal-build-doc" $ do - need ["submodules"] - need ["cabal"] - cabalBuildDoc - - phony "cabal-test" $ do - need ["submodules"] - need ["cabal"] - forM_ ghcVersions cabalTest - - forM_ - hieVersions - (\version -> phony ("cabal-hie-" ++ version) $ do - validateCabalNewInstallIsSupported - need ["submodules"] - need ["cabal"] - cabalBuildHie version - cabalInstallHie version - ) - - -- macos specific targets - phony "icu-macos-fix" - (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 hieVersions - - -buildIcuMacosFix :: VersionNumber -> Action () -buildIcuMacosFix version = execStackWithGhc_ - version - [ "build" - , "text-icu" - , "--extra-lib-dirs=/usr/local/opt/icu4c/lib" - , "--extra-include-dirs=/usr/local/opt/icu4c/include" - ] - --- | update the submodules that the project is in the state as required by the `stack.yaml` files -updateSubmodules :: Action () -updateSubmodules = do - command_ [] "git" ["submodule", "sync", "--recursive"] - command_ [] "git" ["submodule", "update", "--init", "--recursive"] - --- TODO: this restriction will be gone in the next release of cabal -validateCabalNewInstallIsSupported :: Action () -validateCabalNewInstallIsSupported = when isWindowsSystem $ do - liftIO $ putStrLn $ embedInStars cabalInstallNotSuportedFailMsg - error cabalInstallNotSuportedFailMsg - -configureCabal :: VersionNumber -> Action () -configureCabal versionNumber = do - ghcPath <- getGhcPath versionNumber >>= \case - Nothing -> do - liftIO $ putStrLn $ embedInStars (ghcVersionNotFoundFailMsg versionNumber) - error (ghcVersionNotFoundFailMsg versionNumber) - Just p -> return p - execCabal_ - ["new-configure", "-w", ghcPath, "--write-ghc-environment-files=never"] - -findInstalledGhcs :: IO [(VersionNumber, GhcPath)] -findInstalledGhcs = do - hieVersions <- getHieVersions :: IO [VersionNumber] - mapMaybeM - (\version -> getGhcPath version >>= \case - Nothing -> return Nothing - Just p -> return $ Just (version, p) - ) - (reverse hieVersions) - -cabalBuildHie :: VersionNumber -> Action () -cabalBuildHie versionNumber = do - configureCabal versionNumber - execCabal_ ["new-build", "--write-ghc-environment-files=never"] - -cabalInstallHie :: VersionNumber -> Action () -cabalInstallHie versionNumber = do - localBin <- getLocalBin - execCabal_ - [ "new-install" - , "--write-ghc-environment-files=never" - , "--symlink-bindir=" ++ localBin - , "exe:hie" - , "--overwrite-policy=always" - ] - copyFile' (localBin "hie" <.> exe) - (localBin "hie-" ++ versionNumber <.> exe) - copyFile' (localBin "hie" <.> exe) - (localBin "hie-" ++ dropExtension versionNumber <.> exe) - -cabalBuildDoc :: Action () -cabalBuildDoc = do - execCabal_ ["new-build", "hoogle", "generate"] - execCabal_ ["new-exec", "hoogle", "generate"] - -cabalTest :: VersionNumber -> Action () -cabalTest versionNumber = do - configureCabal versionNumber - execCabal_ ["new-test"] - -installCabal :: Action () -installCabal = do - -- try to find existing `cabal` executable with appropriate version - cabalExe <- liftIO (findExecutable "cabal") >>= \case - Nothing -> return Nothing - Just cabalExe -> do - Stdout cabalVersion <- execCabal ["--numeric-version"] - let (parsedVersion, "") : _ = - cabalVersion & trim & readP_to_S parseVersion & filter - (("" ==) . snd) - - return $ if parsedVersion >= makeVersion [2, 4, 1, 0] - then Just cabalExe - else Nothing - -- install `cabal-install` if not already installed - when (isNothing cabalExe) $ - execStackShake_ ["install", "cabal-install"] - execCabal_ ["update"] - - -checkStack :: Action () -checkStack = do - Stdout stackVersion <- execStackShake ["--numeric-version"] - let (parsedVersion, "") : _ = - stackVersion & trim & readP_to_S parseVersion & filter - (("" ==) . snd) - unless (parsedVersion >= makeVersion requiredStackVersion) $ do - liftIO $ putStrLn $ embedInStars $ stackExeIsOldFailMsg $ trim stackVersion - error $ stackExeIsOldFailMsg $ trim stackVersion - - -stackBuildHie :: VersionNumber -> Action () -stackBuildHie versionNumber = - execStackWithGhc_ versionNumber ["build"] - `actionOnException` liftIO (putStrLn stackBuildFailMsg) - --- | copy the built binaries into the localBinDir -stackInstallHie :: VersionNumber -> Action () -stackInstallHie versionNumber = do - execStackWithGhc_ versionNumber ["install"] - localBinDir <- getLocalBin - localInstallRoot <- getLocalInstallRoot versionNumber - let hie = "hie" <.> exe - copyFile' (localInstallRoot "bin" hie) - (localBinDir "hie-" ++ versionNumber <.> exe) - copyFile' (localInstallRoot "bin" hie) - (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) - -buildCopyCompilerTool :: VersionNumber -> Action () -buildCopyCompilerTool versionNumber = - execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"] - -stackTest :: VersionNumber -> Action () -stackTest versionNumber = execStackWithGhc_ versionNumber ["test"] - -stackBuildDoc :: Action () -stackBuildDoc = do - execStackShake_ ["build", "hoogle"] - execStackShake_ ["exec", "hoogle", "generate"] - --- | short help message is printed by default -shortHelpMessage :: Action () -shortHelpMessage = do - hieVersions <- getHieVersions - let out = liftIO . putStrLn - scriptName <- liftIO getProgName - out "" - out "Usage:" - out' ("stack " <> scriptName <> " ") - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" - where - out = liftIO . putStrLn - out' = out . (" " ++) - - spaces hieVersions = space (targets hieVersions) - targets hieVersions = - [ ("help", "Show help message including all targets") - , emptyTarget - , ( "build" - , "Builds hie for all supported GHC versions (" - ++ allVersionMessage hieVersions - ++ ")" - ) - , stackBuildAllTarget - -- , stackHieTarget mostRecentHieVersion - , stackBuildDocTarget - , stackHieTarget (last hieVersions) - , emptyTarget - , ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." - ) - , cabalBuildTarget - , cabalBuildAllTarget - -- , cabalHieTarget mostRecentHieVersion - , cabalBuildDocTarget - , cabalHieTarget (last hieVersions) - ] - - -helpMessage :: Action () -helpMessage = do - - hieVersions <- getHieVersions - scriptName <- liftIO getProgName - out "" - out "Usage:" - out' ("stack " <> scriptName <> " ") - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" - where - out = liftIO . putStrLn - out' = out . (" " ++) - - spaces hieVersions = space (targets hieVersions) - -- All targets the shake file supports - targets :: [VersionNumber] -> [(String, String)] - targets hieVersions = intercalate - [emptyTarget] - [ generalTargets - , stackTargets hieVersions - , cabalTargets hieVersions - , macosTargets - ] - - -- All targets with their respective help message. - generalTargets = - [ ("help", "Show help message including all targets") - , ( "cabal" - , "Makes sure that Cabal the lib is available for cabal-helper-wapper, to speed up project start" - ) - ] - - macosTargets = [("icu-macos-fix", "Fixes icu related problems in MacOS")] - - stackTargets hieVersions = - [ ( "build" - , "Builds hie for all supported GHC versions (" - ++ allVersionMessage hieVersions - ++ ")" - ) - , stackBuildAllTarget - , stackBuildDocTarget - , ("test", "Runs hie tests with stack") - ] - ++ map stackHieTarget hieVersions - - cabalTargets hieVersions = - [ ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." - ) - , cabalBuildTarget - , cabalBuildAllTarget - , cabalBuildDocTarget - , ("cabal-test", "Runs hie tests with cabal") - ] - ++ map cabalHieTarget hieVersions - --- | Empty target. Purpose is to introduce a newline between the targets -emptyTarget :: (String, String) -emptyTarget = ("", "") - --- | 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 :: [(String, String)] -> Int -space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets) - --- | Show a target. --- Concatenates the target with its help message and inserts whitespace between them. -showTarget :: Int -> (String, String) -> String -showTarget spaces (target, msg) = - target ++ replicate (spaces - length target) ' ' ++ msg - --- | Target for a specific ghc version -stackHieTarget :: String -> (String, String) -stackHieTarget version = - ( "hie-" ++ version - , "Builds hie for GHC version " ++ version ++ " only with stack" - ) - --- | Target for a specific ghc version -cabalHieTarget :: String -> (String, String) -cabalHieTarget version = - ( "cabal-hie-" ++ version - , "Builds hie for GHC version " ++ version ++ " only with cabal new-build" - ) - -stackBuildDocTarget :: (String, String) -stackBuildDocTarget = ("build-doc", "Builds the Hoogle database") - -stackBuildAllTarget :: (String, String) -stackBuildAllTarget = - ( "build-all" - , "Builds hie for all supported GHC versions and the hoogle database" - ) - -cabalBuildTarget :: (String, String) -cabalBuildTarget = - ("cabal-build", "Builds hie with cabal with all installed GHCs.") - -cabalBuildDocTarget :: (String, String) -cabalBuildDocTarget = - ("cabal-build-doc", "Builds the Hoogle database with cabal") - -cabalBuildAllTarget :: (String, String) -cabalBuildAllTarget = - ( "cabal-build-all" - , "Builds hie for all installed GHC versions and the hoogle database with cabal" - ) - --- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. --- If there is no GHC in the list of `hieVersions` -allVersionMessage :: [String] -> String -allVersionMessage wordList = case wordList of - [] -> "" - [a] -> show a - (a : as) -> - let msg = intersperse ", " wordList - lastVersion = last msg - in concat $ (init $ init msg) ++ [" and ", lastVersion] - - --- RUN EXECUTABLES - --- | Execute a stack command for a specified ghc, discarding the output -execStackWithGhc_ :: VersionNumber -> [String] -> Action () -execStackWithGhc_ versionNumber args = do - let stackFile = "stack-" ++ versionNumber ++ ".yaml" - command_ [] "stack" (("--stack-yaml=" ++ stackFile) : args) - --- | Execute a stack command for a specified ghc -execStackWithGhc :: CmdResult r => VersionNumber -> [String] -> Action r -execStackWithGhc versionNumber args = do - let stackFile = "stack-" ++ versionNumber ++ ".yaml" - command [] "stack" (("--stack-yaml=" ++ stackFile) : args) - --- | Execute a stack command with the same resolver as the build script -execStackShake :: CmdResult r => [String] -> Action r -execStackShake args = - command [] "stack" ("--stack-yaml=shake.yaml" : args) - --- | Execute a stack command with the same resolver as the build script, discarding the output -execStackShake_ :: [String] -> Action () -execStackShake_ args = - command_ [] "stack" ("--stack-yaml=shake.yaml" : args) - -execCabal :: CmdResult r => [String] -> Action r -execCabal = - command [] "cabal" - -execCabal_ :: [String] -> Action () -execCabal_ = command_ [] "cabal" - -existsExecutable :: MonadIO m => String -> m Bool -existsExecutable executable = liftIO $ isJust <$> findExecutable executable - - --- QUERY ENVIRONMENT - --- |Check if the current system is windows -isWindowsSystem :: Bool -isWindowsSystem = os `elem` ["mingw32", "win32"] - --- | Get the path to the GHC compiler executable linked to the local `stack-$GHCVER.yaml`. --- Equal to the command `stack path --stack-yaml $stack-yaml --compiler-exe`. --- This might install a GHC if it is not already installed, thus, might fail if stack fails to install the GHC. -getStackGhcPath :: VersionNumber -> Action GhcPath -getStackGhcPath ghcVersion = do - Stdout ghc <- execStackWithGhc ghcVersion ["path", "--compiler-exe"] - return $ trim ghc - -getStackGhcPathShake :: Action GhcPath -getStackGhcPathShake = do - Stdout ghc <- execStackShake ["path", "--compiler-exe"] - return $ trim ghc - --- | Get the path to a GHC that has the version specified by `VersionNumber` --- If no such GHC can be found, Nothing is returned. --- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`. --- If this yields no result, it is checked, whether the numeric-version of the `ghc` --- command fits to the desired version. -getGhcPath :: MonadIO m => VersionNumber -> m (Maybe GhcPath) -getGhcPath ghcVersion = liftIO $ - findExecutable ("ghc-" ++ ghcVersion) >>= \case - Nothing -> do - findExecutable "ghc" >>= \case - Nothing -> return Nothing - Just p -> do - Stdout version <- cmd p ["--numeric-version"] :: IO (Stdout String) - if ghcVersion == trim version then return $ Just p else return Nothing - p -> return p - --- | Read the local install root of the stack project specified by the VersionNumber --- Returns the filepath of the local install root. --- Equal to the command `stack path --local-install-root` -getLocalInstallRoot :: VersionNumber -> Action FilePath -getLocalInstallRoot hieVersion = do - Stdout localInstallRoot' <- execStackWithGhc - hieVersion - ["path", "--local-install-root"] - return $ trim localInstallRoot' - --- | 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"] - return $ trim stackLocalDir' - --- | Trim the end of a string -trim :: String -> String -trim = dropWhileEnd isSpace - --- | Embed a string within two lines of stars to improve perceivability and, thus, readability. -embedInStars :: String -> String -embedInStars str = - let starsLine - = "\n******************************************************************\n" - in starsLine <> str <> starsLine - --- |Stack build fails message -stackBuildFailMsg :: String -stackBuildFailMsg = - embedInStars - $ "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-ide-engine" - --- | No suitable ghc version has been found. Show a message. -ghcVersionNotFoundFailMsg :: VersionNumber -> String -ghcVersionNotFoundFailMsg versionNumber = - "No GHC with version " - <> versionNumber - <> " has been found.\n" - <> "Either install a fitting GHC, use the stack targets or modify the PATH variable accordingly." - --- | Error message when a windows system tries to install HIE via `cabal new-install` -cabalInstallNotSuportedFailMsg :: String -cabalInstallNotSuportedFailMsg = - "This system has been identified as a windows system.\n" - ++ "Unfortunately, `cabal new-install` is currently not supported on windows.\n" - ++ "Please use one of the stack-based targets.\n\n" - ++ "If this system has been falsely identified, please open an issue at:\n\thttps://github.com/haskell/haskell-ide-engine\n" - --- | Error message when the `stack` binary is an older version -stackExeIsOldFailMsg :: String -> String -stackExeIsOldFailMsg stackVersion = - "The `stack` executable is outdated.\n" - ++ "found version is `" ++ stackVersion ++ "`.\n" - ++ "required version is `" ++ showVersion (makeVersion requiredStackVersion) ++ "`.\n" - ++ "Please run `stack upgrade` to upgrade your stack installation" - -requiredStackVersion :: [Int] -requiredStackVersion = [1, 9, 3] diff --git a/install/hie-install.cabal b/install/hie-install.cabal index f4b28a7ea..0244a3bc5 100644 --- a/install/hie-install.cabal +++ b/install/hie-install.cabal @@ -9,15 +9,22 @@ build-type: Simple cabal-version: >=2.0 library - hs-source-dirs: . + hs-source-dirs: src exposed-modules: Install other-modules: BuildSystem + , Stack + , Version + , Cabal + , Print + , Env build-depends: base >= 4.9 && < 5 , shake == 0.17.3 , directory , extra , text default-extensions: LambdaCase + , TupleSections + default-language: Haskell2010 if flag(run-from-stack) cpp-options: -DRUN_FROM_STACK diff --git a/install/BuildSystem.hs b/install/src/BuildSystem.hs similarity index 51% rename from install/BuildSystem.hs rename to install/src/BuildSystem.hs index 75d76ad79..e75dc4ce4 100644 --- a/install/BuildSystem.hs +++ b/install/src/BuildSystem.hs @@ -9,3 +9,9 @@ buildSystem = #else "cabal" #endif + +isRunFromStack :: Bool +isRunFromStack = buildSystem == "stack" + +isRunFromCabal :: Bool +isRunFromCabal = buildSystem == "cabal" diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs new file mode 100644 index 000000000..105259568 --- /dev/null +++ b/install/src/Cabal.hs @@ -0,0 +1,122 @@ +module Cabal where + +import Development.Shake +import Development.Shake.Command +import Development.Shake.FilePath +import Control.Monad +import Data.Maybe ( isNothing ) +import Control.Monad.Extra ( whenMaybe ) +import System.Directory ( findExecutable ) + +import Version +import Print +import Env +import Stack + + +execCabal :: CmdResult r => [String] -> Action r +execCabal = command [] "cabal" + +execCabal_ :: [String] -> Action () +execCabal_ = command_ [] "cabal" + +-- TODO: review +installCabal :: Action () +installCabal = do + -- try to find existing `cabal` executable with appropriate version + cabalExe <- liftIO (findExecutable "cabal") >>= \case + Nothing -> return Nothing + Just cabalExe -> do + cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"] + whenMaybe (checkVersion requiredCabalVersion cabalVersion) + $ return cabalExe + + -- install `cabal-install` if not already installed + when (isNothing cabalExe) $ execStackShake_ ["install", "cabal-install"] + +-- | check `stack` has the required version +checkCabal :: Action () +checkCabal = do + cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"] + unless (checkVersion requiredCabalVersion cabalVersion) $ do + printInStars $ cabalInstallIsOldFailMsg cabalVersion + error $ stackExeIsOldFailMsg cabalVersion + + +getCabalVersion :: Action String +getCabalVersion = trimmedStdout <$> execCabal ["--numeric-version"] + + +-- | update the cabal index. This is required for ghc-mod. +-- +-- TODO: remove when ghc-mod supports new-style builds +updateCabal :: Action () +updateCabal = do + execCabal_ ["v1-update"] + + +cabalBuildDoc :: Action () +cabalBuildDoc = do + execCabal_ ["new-build", "hoogle", "generate"] + execCabal_ ["new-exec", "hoogle", "generate"] + +configureCabal :: VersionNumber -> Action () +configureCabal versionNumber = do + ghcPath <- getGhcPath versionNumber >>= \case + Nothing -> do + printInStars $ ghcVersionNotFoundFailMsg versionNumber + error (ghcVersionNotFoundFailMsg versionNumber) + Just p -> return p + execCabal_ + ["new-configure", "-w", ghcPath, "--write-ghc-environment-files=never"] + +cabalBuildHie :: VersionNumber -> Action () +cabalBuildHie versionNumber = do + configureCabal versionNumber + execCabal_ ["new-build", "--write-ghc-environment-files=never"] + +cabalInstallHie :: VersionNumber -> Action () +cabalInstallHie versionNumber = do + localBin <- getLocalBin + execCabal_ + [ "new-install" + , "--write-ghc-environment-files=never" + , "--symlink-bindir=" ++ localBin + , "exe:hie" + , "--overwrite-policy=always" + ] + copyFile' (localBin "hie" <.> exe) + (localBin "hie-" ++ versionNumber <.> exe) + copyFile' (localBin "hie" <.> exe) + (localBin "hie-" ++ dropExtension versionNumber <.> exe) + + +-- TODO: this restriction will be gone in the next release of cabal +validateCabalNewInstallIsSupported :: Action () +validateCabalNewInstallIsSupported = when isWindowsSystem $ do + printInStars cabalInstallNotSuportedFailMsg + error cabalInstallNotSuportedFailMsg + +-- | Error message when a windows system tries to install HIE via `cabal new-install` +cabalInstallNotSuportedFailMsg :: String +cabalInstallNotSuportedFailMsg = + "This system has been identified as a windows system.\n" + ++ "Unfortunately, `cabal new-install` is currently not supported on windows.\n" + ++ "Please use one of the stack-based targets.\n\n" + ++ "If this system has been falsely identified, please open an issue at:\n\thttps://github.com/haskell/haskell-ide-engine\n" + + +-- | Error message when the `stack` binary is an older version +cabalInstallIsOldFailMsg :: String -> String +cabalInstallIsOldFailMsg cabalVersion = + "The `cabal` executable is outdated.\n" + ++ "found version is `" + ++ cabalVersion + ++ "`.\n" + ++ "required version is `" + ++ versionToString requiredCabalVersion + ++ "`." + + +requiredCabalVersion :: RequiredVersion +requiredCabalVersion = [2, 4, 1, 0] diff --git a/install/src/Env.hs b/install/src/Env.hs new file mode 100644 index 000000000..9b7398d7d --- /dev/null +++ b/install/src/Env.hs @@ -0,0 +1,91 @@ +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 Data.Maybe ( isJust ) +import System.Directory ( findExecutable + , listDirectory + ) +import Data.Function ( (&) ) +import Data.List ( sort ) +import Control.Monad.Extra ( mapMaybeM ) +import Data.Maybe ( isNothing + , mapMaybe + ) +import qualified Data.Text as T + +import Version +import Print + + +type GhcPath = String + +existsExecutable :: MonadIO m => String -> m Bool +existsExecutable executable = liftIO $ isJust <$> findExecutable executable + + +-- | Check if the current system is windows +isWindowsSystem :: Bool +isWindowsSystem = os `elem` ["mingw32", "win32"] + +findInstalledGhcs :: IO [(VersionNumber, GhcPath)] +findInstalledGhcs = do + hieVersions <- getHieVersions :: IO [VersionNumber] + mapMaybeM + (\version -> getGhcPath version >>= \case + Nothing -> return Nothing + Just p -> return $ Just (version, p) + ) + (reverse hieVersions) + +-- | Get the path to a GHC that has the version specified by `VersionNumber` +-- If no such GHC can be found, Nothing is returned. +-- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`. +-- If this yields no result, it is checked, whether the numeric-version of the `ghc` +-- command fits to the desired version. +getGhcPath :: MonadIO m => VersionNumber -> m (Maybe GhcPath) +getGhcPath ghcVersion = + liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case + Nothing -> do + findExecutable "ghc" >>= \case + Nothing -> return Nothing + Just p -> do + Stdout version <- cmd p ["--numeric-version"] :: IO (Stdout String) + if ghcVersion == trim version then return $ Just p else return Nothing + p -> return p + + +-- | No suitable ghc version has been found. Show a message. +ghcVersionNotFoundFailMsg :: VersionNumber -> String +ghcVersionNotFoundFailMsg versionNumber = + "No GHC with version " + <> versionNumber + <> " has been found.\n" + <> "Either install a fitting GHC, use the stack targets or modify the PATH variable accordingly." + + +-- | Defines all different hie versions that are buildable. +-- +-- The current directory is scanned for `stack-*.yaml` files. +-- On windows, `8.6.3` is excluded as this version of ghc does not work there +getHieVersions :: MonadIO m => m [VersionNumber] +getHieVersions = do + let stackYamlPrefix = T.pack "stack-" + let stackYamlSuffix = T.pack ".yaml" + files <- liftIO $ listDirectory "." + let hieVersions = + files + & map T.pack + & mapMaybe + (T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix) + & map T.unpack + -- the following line excludes `8.6.3` on windows systems + & filter (\p -> not isWindowsSystem || p /= "8.6.3") + & sort + return hieVersions diff --git a/install/src/Install.hs b/install/src/Install.hs new file mode 100644 index 000000000..ee7078c90 --- /dev/null +++ b/install/src/Install.hs @@ -0,0 +1,355 @@ +module Install 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 ( getProgName + , 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 + +-- | Most recent version of hie. +-- Shown in the more concise help message. +mostRecentHieVersion :: MonadIO m => m VersionNumber +mostRecentHieVersion = last <$> getHieVersions + +defaultMain :: IO () +defaultMain = do + -- unset GHC_PACKAGE_PATH for cabal + unsetEnv "GHC_PACKAGE_PATH" + + ghcPaths <- findInstalledGhcs + let ghcVersions = map fst ghcPaths + + hieVersions <- getHieVersions + + putStrLn $ "run from: " ++ buildSystem + + shakeArgs shakeOptions { shakeFiles = "_build" } $ do + want ["short-help"] + -- general purpose targets + phony "submodules" updateSubmodules + phony "cabal" installCabal + phony "short-help" shortHelpMessage + phony "all" shortHelpMessage + phony "help" helpMessage + phony "check-stack" checkStack + phony "check-cabal" checkCabal + -- TODO: check-cabal + + phony "cabal-ghcs" $ do + let + msg = + "Found the following GHC paths: \n" + ++ unlines + (map (\(version, path) -> "ghc-" ++ version ++ ": " ++ path) + ghcPaths + ) + printInStars msg + + -- default-targets + phony "build" $ need [buildSystem ++ "-build"] + phony "build-all" $ need [buildSystem ++ "-build-all"] + phony "build-doc" $ need [buildSystem ++ "-build"] + forM_ + hieVersions + (\version -> + phony ("hie-" ++ version) $ need [buildSystem ++ "-hie-" ++ version] + ) + + -- stack specific targets + phony "stack-build" (need (reverse $ map ("hie-" ++) hieVersions)) + phony "stack-build-all" (need ["build-doc", "build"]) + phony "stack-build-doc" $ do + need ["submodules"] + need ["check-stack"] + stackBuildDoc + forM_ + hieVersions + (\version -> phony ("stack-hie-" ++ version) $ do + need ["submodules"] + need ["check-stack"] + need ["cabal"] + stackBuildHie version + stackInstallHie version + ) + + -- cabal specific targets + phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) + phony "cabal-build-all" (need ["cabal-build-doc", "cabal-build"]) + phony "cabal-build-doc" $ do + need ["submodules"] + need ["cabal"] + cabalBuildDoc + forM_ + hieVersions + (\version -> phony ("cabal-hie-" ++ version) $ do + validateCabalNewInstallIsSupported + need ["submodules"] + need ["cabal"] + cabalBuildHie version + cabalInstallHie version + ) + + -- macos specific targets + phony "icu-macos-fix" + (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 hieVersions + + +buildIcuMacosFix :: VersionNumber -> Action () +buildIcuMacosFix version = execStackWithGhc_ + version + [ "build" + , "text-icu" + , "--extra-lib-dirs=/usr/local/opt/icu4c/lib" + , "--extra-include-dirs=/usr/local/opt/icu4c/include" + ] + +-- | update the submodules that the project is in the state as required by the `stack.yaml` files +updateSubmodules :: Action () +updateSubmodules = do + command_ [] "git" ["submodule", "sync"] + command_ [] "git" ["submodule", "update", "--init"] + +stackBuildHie :: VersionNumber -> Action () +stackBuildHie versionNumber = execStackWithGhc_ versionNumber ["build"] + `actionOnException` liftIO (putStrLn stackBuildFailMsg) + +-- | copy the built binaries into the localBinDir +stackInstallHie :: VersionNumber -> Action () +stackInstallHie versionNumber = do + execStackWithGhc_ versionNumber ["install"] + localBinDir <- getLocalBin + localInstallRoot <- getLocalInstallRoot versionNumber + let hie = "hie" <.> exe + copyFile' (localInstallRoot "bin" hie) + (localBinDir "hie-" ++ versionNumber <.> exe) + copyFile' (localInstallRoot "bin" hie) + (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) + +buildCopyCompilerTool :: VersionNumber -> Action () +buildCopyCompilerTool versionNumber = + execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"] + +stackBuildDoc :: Action () +stackBuildDoc = do + execStackShake_ ["build", "hoogle"] + execStackShake_ ["exec", "hoogle", "generate"] + +-- | short help message is printed by default +shortHelpMessage :: Action () +shortHelpMessage = do + hieVersions <- getHieVersions + let out = liftIO . putStrLn + scriptName <- liftIO getProgName + out "" + out "Usage:" + out' ("stack " <> scriptName <> " ") + out "" + out "Targets:" + mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + out "" + where + out = liftIO . putStrLn + out' = out . (" " ++) + + spaces hieVersions = space (targets hieVersions) + targets hieVersions = + [ ("help", "Show help message including all targets") + , emptyTarget + , ( "build" + , "Builds hie for all supported GHC versions (" + ++ allVersionMessage hieVersions + ++ ")" + ) + , stackBuildAllTarget + -- , stackHieTarget mostRecentHieVersion + , stackBuildDocTarget + , stackHieTarget (last hieVersions) + , emptyTarget + , ( "cabal-ghcs" + , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + ) + , cabalBuildTarget + , cabalBuildAllTarget + -- , cabalHieTarget mostRecentHieVersion + , cabalBuildDocTarget + , cabalHieTarget (last hieVersions) + ] + + +helpMessage :: Action () +helpMessage = do + + hieVersions <- getHieVersions + scriptName <- liftIO getProgName + out "" + out "Usage:" + out' ("stack " <> scriptName <> " ") + out "" + out "Targets:" + mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + out "" + where + out = liftIO . putStrLn + out' = out . (" " ++) + + spaces hieVersions = space (targets hieVersions) + -- All targets the shake file supports + targets :: [VersionNumber] -> [(String, String)] + targets hieVersions = intercalate + [emptyTarget] + [ generalTargets + , stackTargets hieVersions + , cabalTargets hieVersions + , macosTargets + ] + + -- All targets with their respective help message. + generalTargets = + [ ("help", "Show help message including all targets") + , ( "cabal" + , "Makes sure that Cabal the lib is available for cabal-helper-wapper, to speed up project start" + ) + ] + + macosTargets = [("icu-macos-fix", "Fixes icu related problems in MacOS")] + + stackTargets hieVersions = + [ ( "build" + , "Builds hie for all supported GHC versions (" + ++ allVersionMessage hieVersions + ++ ")" + ) + , stackBuildAllTarget + , stackBuildDocTarget + , ("test", "Runs hie tests with stack") + ] + ++ map stackHieTarget hieVersions + + cabalTargets hieVersions = + [ ( "cabal-ghcs" + , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + ) + , cabalBuildTarget + , cabalBuildAllTarget + , cabalBuildDocTarget + , ("cabal-test", "Runs hie tests with cabal") + ] + ++ map cabalHieTarget hieVersions + +-- | Empty target. Purpose is to introduce a newline between the targets +emptyTarget :: (String, String) +emptyTarget = ("", "") + +-- | Target for a specific ghc version +stackHieTarget :: String -> TargetDescription +stackHieTarget version = + ( "hie-" ++ version + , "Builds hie for GHC version " ++ version ++ " only with stack" + ) + +-- | Target for a specific ghc version +cabalHieTarget :: String -> TargetDescription +cabalHieTarget version = + ( "cabal-hie-" ++ version + , "Builds hie for GHC version " ++ version ++ " only with cabal new-build" + ) + +stackBuildDocTarget :: TargetDescription +stackBuildDocTarget = ("build-doc", "Builds the Hoogle database") + +stackBuildAllTarget :: TargetDescription +stackBuildAllTarget = + ( "build-all" + , "Builds hie for all supported GHC versions and the hoogle database" + ) + +cabalBuildTarget :: TargetDescription +cabalBuildTarget = + ("cabal-build", "Builds hie with cabal with all installed GHCs.") + +cabalBuildDocTarget :: TargetDescription +cabalBuildDocTarget = + ("cabal-build-doc", "Builds the Hoogle database with cabal") + +cabalBuildAllTarget :: TargetDescription +cabalBuildAllTarget = + ( "cabal-build-all" + , "Builds hie for all installed GHC versions and the hoogle database with cabal" + ) + +-- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. +-- If there is no GHC in the list of `hieVersions` +allVersionMessage :: [String] -> String +allVersionMessage wordList = case wordList of + [] -> "" + [a] -> show a + (a : as) -> + let msg = intersperse ", " wordList + lastVersion = last msg + in concat $ init (init msg) ++ [" and ", lastVersion] + + +-- | Get the path to the GHC compiler executable linked to the local `stack-$GHCVER.yaml`. +-- Equal to the command `stack path --stack-yaml $stack-yaml --compiler-exe`. +-- This might install a GHC if it is not already installed, thus, might fail if stack fails to install the GHC. +getStackGhcPath :: VersionNumber -> Action GhcPath +getStackGhcPath ghcVersion = do + Stdout ghc <- execStackWithGhc ghcVersion ["path", "--compiler-exe"] + return $ trim ghc + +-- | Read the local install root of the stack project specified by the VersionNumber +-- Returns the filepath of the local install root. +-- Equal to the command `stack path --local-install-root` +getLocalInstallRoot :: VersionNumber -> Action FilePath +getLocalInstallRoot hieVersion = do + Stdout localInstallRoot' <- execStackWithGhc + hieVersion + ["path", "--local-install-root"] + return $ trim localInstallRoot' + +-- |Stack build fails message +stackBuildFailMsg :: String +stackBuildFailMsg = + embedInStars + $ "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-ide-engine" diff --git a/install/src/Print.hs b/install/src/Print.hs new file mode 100644 index 000000000..6fbb667dd --- /dev/null +++ b/install/src/Print.hs @@ -0,0 +1,39 @@ +module Print where + +import Development.Shake +import Development.Shake.Command +import Control.Monad.IO.Class +import Data.List ( dropWhileEnd + , dropWhile + ) +import Data.Char ( isSpace ) + +embedInStars :: String -> String +embedInStars str = + let starsLine = "\n" <> replicate 30 '*' <> "\n" + in starsLine <> str <> starsLine + +printInStars :: MonadIO m => String -> m () +printInStars = liftIO . putStrLn . embedInStars + + +-- | Trim whitespace of both ends of a string +trim :: String -> String +trim = dropWhileEnd isSpace . dropWhile isSpace + +-- | Trim the whitespace of the stdout of a command +trimmedStdout :: Stdout String -> String +trimmedStdout (Stdout s) = trim s + +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) + +-- | 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 diff --git a/install/src/Stack.hs b/install/src/Stack.hs new file mode 100644 index 000000000..74d00d8c1 --- /dev/null +++ b/install/src/Stack.hs @@ -0,0 +1,60 @@ +module Stack where + +import Development.Shake +import Development.Shake.Command +import Control.Monad + +import Version +import Print + +-- | check `stack` has the required version +checkStack :: Action () +checkStack = do + stackVersion <- trimmedStdout <$> execStackShake ["--numeric-version"] + 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"] + return $ trim stackLocalDir' + + +-- | Execute a stack command for a specified ghc, discarding the output +execStackWithGhc_ :: VersionNumber -> [String] -> Action () +execStackWithGhc_ versionNumber args = do + let stackFile = "stack-" ++ versionNumber ++ ".yaml" + command_ [] "stack" (("--stack-yaml=" ++ stackFile) : args) + +-- | Execute a stack command for a specified ghc +execStackWithGhc :: CmdResult r => VersionNumber -> [String] -> Action r +execStackWithGhc versionNumber args = do + let stackFile = "stack-" ++ versionNumber ++ ".yaml" + command [] "stack" (("--stack-yaml=" ++ stackFile) : args) + +-- | Execute a stack command with the same resolver as the build script +execStackShake :: CmdResult r => [String] -> Action r +execStackShake args = command [] "stack" ("--stack-yaml=shake.yaml" : args) + +-- | Execute a stack command with the same resolver as the build script, discarding the output +execStackShake_ :: [String] -> Action () +execStackShake_ args = command_ [] "stack" ("--stack-yaml=shake.yaml" : args) + + +-- | Error message when the `stack` binary is an older version +stackExeIsOldFailMsg :: String -> String +stackExeIsOldFailMsg stackVersion = + "The `stack` executable is outdated.\n" + ++ "found version is `" + ++ stackVersion + ++ "`.\n" + ++ "required version is `" + ++ versionToString requiredStackVersion + ++ "`.\n" + ++ "Please run `stack upgrade` to upgrade your stack installation" + +requiredStackVersion :: RequiredVersion +requiredStackVersion = [1, 9, 3] diff --git a/install/src/Version.hs b/install/src/Version.hs new file mode 100644 index 000000000..de9bfd019 --- /dev/null +++ b/install/src/Version.hs @@ -0,0 +1,24 @@ +module Version where + +import Data.Version ( Version + , parseVersion + , makeVersion + , showVersion + ) +import Text.ParserCombinators.ReadP ( readP_to_S ) +import Control.Monad.IO.Class + + +type VersionNumber = String +type RequiredVersion = [Int] + +versionToString :: RequiredVersion -> String +versionToString = showVersion . makeVersion + +-- | Parse a version-string into a version. Fails if the version-string is not valid +parseVersionEx :: String -> Version +parseVersionEx = fst . head . filter (("" ==) . snd) . readP_to_S parseVersion + + +checkVersion :: RequiredVersion -> String -> Bool +checkVersion required given = parseVersionEx given >= makeVersion required From b77e39beb1642abe75f8c4044819ba8e72792687 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Fri, 14 Jun 2019 16:03:38 +0200 Subject: [PATCH 03/22] refactor help messages and clean up cabal- and stack- targets --- install/hie-install.cabal | 1 + install/src/Cabal.hs | 76 +++++-------- install/src/Env.hs | 6 + install/src/Help.hs | 149 ++++++++++++++++++++++++ install/src/Install.hs | 231 ++------------------------------------ install/src/Print.hs | 6 + install/src/Stack.hs | 36 ++++++ 7 files changed, 237 insertions(+), 268 deletions(-) create mode 100644 install/src/Help.hs diff --git a/install/hie-install.cabal b/install/hie-install.cabal index 0244a3bc5..cf28c517e 100644 --- a/install/hie-install.cabal +++ b/install/hie-install.cabal @@ -17,6 +17,7 @@ library , Cabal , Print , Env + , Help build-depends: base >= 4.9 && < 5 , shake == 0.17.3 , directory diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 105259568..91acdc861 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -20,60 +20,20 @@ execCabal = command [] "cabal" execCabal_ :: [String] -> Action () execCabal_ = command_ [] "cabal" --- TODO: review -installCabal :: Action () -installCabal = do - -- try to find existing `cabal` executable with appropriate version - cabalExe <- liftIO (findExecutable "cabal") >>= \case - Nothing -> return Nothing - Just cabalExe -> do - cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"] - whenMaybe (checkVersion requiredCabalVersion cabalVersion) - $ return cabalExe - - -- install `cabal-install` if not already installed - when (isNothing cabalExe) $ execStackShake_ ["install", "cabal-install"] - --- | check `stack` has the required version -checkCabal :: Action () -checkCabal = do - cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"] - unless (checkVersion requiredCabalVersion cabalVersion) $ do - printInStars $ cabalInstallIsOldFailMsg cabalVersion - error $ stackExeIsOldFailMsg cabalVersion - - -getCabalVersion :: Action String -getCabalVersion = trimmedStdout <$> execCabal ["--numeric-version"] - - --- | update the cabal index. This is required for ghc-mod. --- --- TODO: remove when ghc-mod supports new-style builds -updateCabal :: Action () -updateCabal = do - execCabal_ ["v1-update"] - - -cabalBuildDoc :: Action () -cabalBuildDoc = do - execCabal_ ["new-build", "hoogle", "generate"] +cabalBuildData :: Action () +cabalBuildData = do + execCabal_ ["new-build", "hoogle"] execCabal_ ["new-exec", "hoogle", "generate"] -configureCabal :: VersionNumber -> Action () -configureCabal versionNumber = do +cabalBuildHie :: VersionNumber -> Action () +cabalBuildHie versionNumber = do ghcPath <- getGhcPath versionNumber >>= \case Nothing -> do printInStars $ ghcVersionNotFoundFailMsg versionNumber error (ghcVersionNotFoundFailMsg versionNumber) Just p -> return p execCabal_ - ["new-configure", "-w", ghcPath, "--write-ghc-environment-files=never"] - -cabalBuildHie :: VersionNumber -> Action () -cabalBuildHie versionNumber = do - configureCabal versionNumber - execCabal_ ["new-build", "--write-ghc-environment-files=never"] + ["new-build", "-w", ghcPath, "--write-ghc-environment-files=never"] cabalInstallHie :: VersionNumber -> Action () cabalInstallHie versionNumber = do @@ -90,6 +50,30 @@ cabalInstallHie versionNumber = do copyFile' (localBin "hie" <.> exe) (localBin "hie-" ++ dropExtension versionNumber <.> exe) +-- TODO: review +installCabal :: Action () +installCabal = do + -- try to find existing `cabal` executable with appropriate version + cabalExe <- liftIO (findExecutable "cabal") >>= \case + Nothing -> return Nothing + Just cabalExe -> do + cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"] + whenMaybe (checkVersion requiredCabalVersion cabalVersion) + $ return cabalExe + + -- install `cabal-install` if not already installed + when (isNothing cabalExe) $ execStackShake_ ["install", "cabal-install"] + +-- | check `stack` has the required version +checkCabal :: Action () +checkCabal = do + cabalVersion <- trimmedStdout <$> execCabal ["--numeric-version"] + unless (checkVersion requiredCabalVersion cabalVersion) $ do + printInStars $ cabalInstallIsOldFailMsg cabalVersion + error $ stackExeIsOldFailMsg cabalVersion + +getCabalVersion :: Action String +getCabalVersion = trimmedStdout <$> execCabal ["--numeric-version"] -- TODO: this restriction will be gone in the next release of cabal validateCabalNewInstallIsSupported :: Action () diff --git a/install/src/Env.hs b/install/src/Env.hs index 9b7398d7d..eca37ee62 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -89,3 +89,9 @@ getHieVersions = do & filter (\p -> not isWindowsSystem || p /= "8.6.3") & sort return hieVersions + + +-- | Most recent version of hie. +-- Shown in the more concise help message. +mostRecentHieVersion :: MonadIO m => m VersionNumber +mostRecentHieVersion = last <$> getHieVersions diff --git a/install/src/Help.hs b/install/src/Help.hs new file mode 100644 index 000000000..1cdcc58ec --- /dev/null +++ b/install/src/Help.hs @@ -0,0 +1,149 @@ +-- |Module for Help messages and traget descriptions +module Help where + +import Development.Shake +import Data.List ( intersperse + , intercalate + ) + +import Env +import Print +import Version + +printUsage :: Action () +printUsage = do + out "" + out "Usage:" + out' ("stack install.hs ") + out' "or" + out' ("cabal new-run install.hs --project-file shake.project ") + +-- | short help message is printed by default +shortHelpMessage :: Action () +shortHelpMessage = do + hieVersions <- getHieVersions + printUsage + out "" + out "Targets:" + mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + out "" + where + spaces hieVersions = space (targets hieVersions) + targets hieVersions = + [ ("help", "Show help message including all targets") + , emptyTarget + , buildTarget + , buildAllTarget + , hieTarget $ last hieVersions + , buildDataTarget + , cabalGhcsTarget + ] + + + +helpMessage :: Action () +helpMessage = do + hieVersions <- getHieVersions + printUsage + out "" + out "Targets:" + mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + out "" + where + spaces hieVersions = space (targets hieVersions) + -- All targets the shake file supports + targets :: [VersionNumber] -> [(String, String)] + targets hieVersions = intercalate + [emptyTarget] + [ generalTargets + , defaultTargets hieVersions + , stackTargets hieVersions + , cabalTargets hieVersions + , [macosIcuTarget] + ] + + -- All targets with their respective help message. + generalTargets = + [ helpTarget + ] + + defaultTargets hieVersions = + [ buildTarget + , buildAllTarget + , buildDataTarget + ] + ++ map hieTarget hieVersions + + stackTargets hieVersions = + [ stackTarget buildTarget + , stackTarget buildAllTarget + , stackTarget buildDataTarget + ] + ++ map (stackTarget . hieTarget) hieVersions + + cabalTargets hieVersions = + [ cabalGhcsTarget + , cabalTarget buildTarget + , cabalTarget buildAllTarget + , cabalTarget buildDataTarget + ] + ++ map (cabalTarget . hieTarget) hieVersions + +-- | Empty target. Purpose is to introduce a newline between the targets +emptyTarget :: (String, String) +emptyTarget = ("", "") + +targetWithBuildSystem :: String -> TargetDescription -> TargetDescription +targetWithBuildSystem system (target, description) = + (system ++ "-" ++ target, description ++ "; with " ++ system) + +stackTarget :: TargetDescription -> TargetDescription +stackTarget = targetWithBuildSystem "stack" + +cabalTarget :: TargetDescription -> TargetDescription +cabalTarget = targetWithBuildSystem "cabal" + +hieTarget :: String -> TargetDescription +hieTarget version = + ( "hie-" ++ version + , "Builds hie for GHC version " ++ version + ) + +buildTarget :: TargetDescription +buildTarget = + ("build", "Builds hie with all installed GHCs") + +buildDataTarget :: TargetDescription +buildDataTarget = + ("build-data", "Get the required data-files for `hie` (Hoogle DB)") + +buildAllTarget :: TargetDescription +buildAllTarget = + ( "build-all" + , "Builds hie for all installed GHC versions and the data files" + ) + +-- speical targets + +macosIcuTarget :: TargetDescription +macosIcuTarget = ("icu-macos-fix", "Fixes icu related problems in MacOS") + +helpTarget :: TargetDescription +helpTarget = ("help", "Show help message including all targets") + +cabalGhcsTarget :: TargetDescription +cabalGhcsTarget = + ( "cabal-ghcs" + , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + ) + +-- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. +-- If there is no GHC in the list of `hieVersions` +allVersionMessage :: [String] -> String +allVersionMessage wordList = case wordList of + [] -> "" + [a] -> show a + (a : as) -> + let msg = intersperse ", " wordList + lastVersion = last msg + in concat $ init (init msg) ++ [" and ", lastVersion] diff --git a/install/src/Install.hs b/install/src/Install.hs index ee7078c90..46f1e0da9 100644 --- a/install/src/Install.hs +++ b/install/src/Install.hs @@ -10,8 +10,7 @@ import Control.Monad.Extra ( unlessM ) import Data.Maybe ( isJust ) import System.Directory ( listDirectory ) -import System.Environment ( getProgName - , unsetEnv +import System.Environment ( unsetEnv ) import System.Info ( os , arch @@ -41,11 +40,7 @@ import Cabal import Version import Print import Env - --- | Most recent version of hie. --- Shown in the more concise help message. -mostRecentHieVersion :: MonadIO m => m VersionNumber -mostRecentHieVersion = last <$> getHieVersions +import Help defaultMain :: IO () defaultMain = do @@ -69,7 +64,6 @@ defaultMain = do phony "help" helpMessage phony "check-stack" checkStack phony "check-cabal" checkCabal - -- TODO: check-cabal phony "cabal-ghcs" $ do let @@ -84,7 +78,7 @@ defaultMain = do -- default-targets phony "build" $ need [buildSystem ++ "-build"] phony "build-all" $ need [buildSystem ++ "-build-all"] - phony "build-doc" $ need [buildSystem ++ "-build"] + phony "build-data" $ need [buildSystem ++ "-build-data"] forM_ hieVersions (\version -> @@ -93,11 +87,11 @@ defaultMain = do -- stack specific targets phony "stack-build" (need (reverse $ map ("hie-" ++) hieVersions)) - phony "stack-build-all" (need ["build-doc", "build"]) - phony "stack-build-doc" $ do + phony "stack-build-all" (need ["build-data", "build"]) + phony "stack-build-data" $ do need ["submodules"] need ["check-stack"] - stackBuildDoc + stackBuildData forM_ hieVersions (\version -> phony ("stack-hie-" ++ version) $ do @@ -110,11 +104,11 @@ defaultMain = do -- cabal specific targets phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) - phony "cabal-build-all" (need ["cabal-build-doc", "cabal-build"]) - phony "cabal-build-doc" $ do + phony "cabal-build-all" (need ["cabal-build-data", "cabal-build"]) + phony "cabal-build-data" $ do need ["submodules"] need ["cabal"] - cabalBuildDoc + cabalBuildData forM_ hieVersions (\version -> phony ("cabal-hie-" ++ version) $ do @@ -146,210 +140,3 @@ updateSubmodules :: Action () updateSubmodules = do command_ [] "git" ["submodule", "sync"] command_ [] "git" ["submodule", "update", "--init"] - -stackBuildHie :: VersionNumber -> Action () -stackBuildHie versionNumber = execStackWithGhc_ versionNumber ["build"] - `actionOnException` liftIO (putStrLn stackBuildFailMsg) - --- | copy the built binaries into the localBinDir -stackInstallHie :: VersionNumber -> Action () -stackInstallHie versionNumber = do - execStackWithGhc_ versionNumber ["install"] - localBinDir <- getLocalBin - localInstallRoot <- getLocalInstallRoot versionNumber - let hie = "hie" <.> exe - copyFile' (localInstallRoot "bin" hie) - (localBinDir "hie-" ++ versionNumber <.> exe) - copyFile' (localInstallRoot "bin" hie) - (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) - -buildCopyCompilerTool :: VersionNumber -> Action () -buildCopyCompilerTool versionNumber = - execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"] - -stackBuildDoc :: Action () -stackBuildDoc = do - execStackShake_ ["build", "hoogle"] - execStackShake_ ["exec", "hoogle", "generate"] - --- | short help message is printed by default -shortHelpMessage :: Action () -shortHelpMessage = do - hieVersions <- getHieVersions - let out = liftIO . putStrLn - scriptName <- liftIO getProgName - out "" - out "Usage:" - out' ("stack " <> scriptName <> " ") - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" - where - out = liftIO . putStrLn - out' = out . (" " ++) - - spaces hieVersions = space (targets hieVersions) - targets hieVersions = - [ ("help", "Show help message including all targets") - , emptyTarget - , ( "build" - , "Builds hie for all supported GHC versions (" - ++ allVersionMessage hieVersions - ++ ")" - ) - , stackBuildAllTarget - -- , stackHieTarget mostRecentHieVersion - , stackBuildDocTarget - , stackHieTarget (last hieVersions) - , emptyTarget - , ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." - ) - , cabalBuildTarget - , cabalBuildAllTarget - -- , cabalHieTarget mostRecentHieVersion - , cabalBuildDocTarget - , cabalHieTarget (last hieVersions) - ] - - -helpMessage :: Action () -helpMessage = do - - hieVersions <- getHieVersions - scriptName <- liftIO getProgName - out "" - out "Usage:" - out' ("stack " <> scriptName <> " ") - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" - where - out = liftIO . putStrLn - out' = out . (" " ++) - - spaces hieVersions = space (targets hieVersions) - -- All targets the shake file supports - targets :: [VersionNumber] -> [(String, String)] - targets hieVersions = intercalate - [emptyTarget] - [ generalTargets - , stackTargets hieVersions - , cabalTargets hieVersions - , macosTargets - ] - - -- All targets with their respective help message. - generalTargets = - [ ("help", "Show help message including all targets") - , ( "cabal" - , "Makes sure that Cabal the lib is available for cabal-helper-wapper, to speed up project start" - ) - ] - - macosTargets = [("icu-macos-fix", "Fixes icu related problems in MacOS")] - - stackTargets hieVersions = - [ ( "build" - , "Builds hie for all supported GHC versions (" - ++ allVersionMessage hieVersions - ++ ")" - ) - , stackBuildAllTarget - , stackBuildDocTarget - , ("test", "Runs hie tests with stack") - ] - ++ map stackHieTarget hieVersions - - cabalTargets hieVersions = - [ ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." - ) - , cabalBuildTarget - , cabalBuildAllTarget - , cabalBuildDocTarget - , ("cabal-test", "Runs hie tests with cabal") - ] - ++ map cabalHieTarget hieVersions - --- | Empty target. Purpose is to introduce a newline between the targets -emptyTarget :: (String, String) -emptyTarget = ("", "") - --- | Target for a specific ghc version -stackHieTarget :: String -> TargetDescription -stackHieTarget version = - ( "hie-" ++ version - , "Builds hie for GHC version " ++ version ++ " only with stack" - ) - --- | Target for a specific ghc version -cabalHieTarget :: String -> TargetDescription -cabalHieTarget version = - ( "cabal-hie-" ++ version - , "Builds hie for GHC version " ++ version ++ " only with cabal new-build" - ) - -stackBuildDocTarget :: TargetDescription -stackBuildDocTarget = ("build-doc", "Builds the Hoogle database") - -stackBuildAllTarget :: TargetDescription -stackBuildAllTarget = - ( "build-all" - , "Builds hie for all supported GHC versions and the hoogle database" - ) - -cabalBuildTarget :: TargetDescription -cabalBuildTarget = - ("cabal-build", "Builds hie with cabal with all installed GHCs.") - -cabalBuildDocTarget :: TargetDescription -cabalBuildDocTarget = - ("cabal-build-doc", "Builds the Hoogle database with cabal") - -cabalBuildAllTarget :: TargetDescription -cabalBuildAllTarget = - ( "cabal-build-all" - , "Builds hie for all installed GHC versions and the hoogle database with cabal" - ) - --- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. --- If there is no GHC in the list of `hieVersions` -allVersionMessage :: [String] -> String -allVersionMessage wordList = case wordList of - [] -> "" - [a] -> show a - (a : as) -> - let msg = intersperse ", " wordList - lastVersion = last msg - in concat $ init (init msg) ++ [" and ", lastVersion] - - --- | Get the path to the GHC compiler executable linked to the local `stack-$GHCVER.yaml`. --- Equal to the command `stack path --stack-yaml $stack-yaml --compiler-exe`. --- This might install a GHC if it is not already installed, thus, might fail if stack fails to install the GHC. -getStackGhcPath :: VersionNumber -> Action GhcPath -getStackGhcPath ghcVersion = do - Stdout ghc <- execStackWithGhc ghcVersion ["path", "--compiler-exe"] - return $ trim ghc - --- | Read the local install root of the stack project specified by the VersionNumber --- Returns the filepath of the local install root. --- Equal to the command `stack path --local-install-root` -getLocalInstallRoot :: VersionNumber -> Action FilePath -getLocalInstallRoot hieVersion = do - Stdout localInstallRoot' <- execStackWithGhc - hieVersion - ["path", "--local-install-root"] - return $ trim localInstallRoot' - --- |Stack build fails message -stackBuildFailMsg :: String -stackBuildFailMsg = - embedInStars - $ "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-ide-engine" diff --git a/install/src/Print.hs b/install/src/Print.hs index 6fbb667dd..6ae7c4946 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -8,6 +8,12 @@ import Data.List ( dropWhileEnd ) import Data.Char ( isSpace ) +out :: MonadIO m => String -> m () +out = liftIO . putStrLn + +out' :: MonadIO m => String -> m () +out' = out . (" " ++) + embedInStars :: String -> String embedInStars str = let starsLine = "\n" <> replicate 30 '*' <> "\n" diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 74d00d8c1..292b5a18b 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -2,10 +2,33 @@ module Stack where import Development.Shake import Development.Shake.Command +import Development.Shake.FilePath import Control.Monad import Version import Print +import Env + + +stackBuildHie :: VersionNumber -> Action () +stackBuildHie versionNumber = execStackWithGhc_ versionNumber ["build"] + `actionOnException` liftIO (putStrLn stackBuildFailMsg) + +-- | copy the built binaries into the localBinDir +stackInstallHie :: VersionNumber -> Action () +stackInstallHie versionNumber = do + execStackWithGhc_ versionNumber ["install"] + localBinDir <- getLocalBin + let hie = "hie" <.> exe + copyFile' (localBinDir hie) + (localBinDir "hie-" ++ versionNumber <.> exe) + copyFile' (localBinDir hie) + (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) + +buildCopyCompilerTool :: VersionNumber -> Action () +buildCopyCompilerTool versionNumber = + execStackWithGhc_ versionNumber ["build", "--copy-compiler-tool"] + -- | check `stack` has the required version checkStack :: Action () @@ -22,6 +45,10 @@ getLocalBin = do Stdout stackLocalDir' <- execStackShake ["path", "--local-bin"] return $ trim stackLocalDir' +stackBuildData :: Action () +stackBuildData = do + execStackShake_ ["build", "hoogle"] + execStackShake_ ["exec", "hoogle", "generate"] -- | Execute a stack command for a specified ghc, discarding the output execStackWithGhc_ :: VersionNumber -> [String] -> Action () @@ -58,3 +85,12 @@ stackExeIsOldFailMsg stackVersion = requiredStackVersion :: RequiredVersion requiredStackVersion = [1, 9, 3] + +-- |Stack build fails message +stackBuildFailMsg :: String +stackBuildFailMsg = + embedInStars + $ "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-ide-engine" From e0e8a07afdde2198a072de2428909ee95f1a2402 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Sun, 16 Jun 2019 22:46:08 +0200 Subject: [PATCH 04/22] upgrade shake --- install/hie-install.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/hie-install.cabal b/install/hie-install.cabal index cf28c517e..87983ec57 100644 --- a/install/hie-install.cabal +++ b/install/hie-install.cabal @@ -19,7 +19,7 @@ library , Env , Help build-depends: base >= 4.9 && < 5 - , shake == 0.17.3 + , shake == 0.17.8 , directory , extra , text From 4167153509c7babab4678b945c3dcce27a01dbbb Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Tue, 25 Jun 2019 18:08:29 +0200 Subject: [PATCH 05/22] include work of #1297 into this project --- install/src/Cabal.hs | 2 +- install/src/Env.hs | 40 +++++++++++++++++++++++++++------------- install/src/Install.hs | 4 +++- 3 files changed, 31 insertions(+), 15 deletions(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 91acdc861..db6bf1b3a 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -27,7 +27,7 @@ cabalBuildData = do cabalBuildHie :: VersionNumber -> Action () cabalBuildHie versionNumber = do - ghcPath <- getGhcPath versionNumber >>= \case + ghcPath <- getGhcPathOf versionNumber >>= \case Nothing -> do printInStars $ ghcVersionNotFoundFailMsg versionNumber error (ghcVersionNotFoundFailMsg versionNumber) diff --git a/install/src/Env.hs b/install/src/Env.hs index eca37ee62..b7d232c37 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -10,10 +10,16 @@ import System.Info ( os ) import Data.Maybe ( isJust ) import System.Directory ( findExecutable + , findExecutables , listDirectory ) -import Data.Function ( (&) ) -import Data.List ( sort ) +import Data.Function ( (&) + , on + ) +import Data.List ( sort + , isInfixOf + , nubBy + ) import Control.Monad.Extra ( mapMaybeM ) import Data.Maybe ( isNothing , mapMaybe @@ -37,29 +43,37 @@ isWindowsSystem = os `elem` ["mingw32", "win32"] findInstalledGhcs :: IO [(VersionNumber, GhcPath)] findInstalledGhcs = do hieVersions <- getHieVersions :: IO [VersionNumber] - mapMaybeM - (\version -> getGhcPath version >>= \case + knownGhcs <- mapMaybeM + (\version -> getGhcPathOf version >>= \case Nothing -> return Nothing Just p -> return $ Just (version, p) ) (reverse hieVersions) + availableGhcs <- getGhcPaths + return + -- nub by version. knownGhcs takes precedence. + $ nubBy ((==) `on` fst) + -- filter out stack provided GHCs + $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs) -- | Get the path to a GHC that has the version specified by `VersionNumber` -- If no such GHC can be found, Nothing is returned. -- First, it is checked whether there is a GHC with the name `ghc-$VersionNumber`. -- If this yields no result, it is checked, whether the numeric-version of the `ghc` -- command fits to the desired version. -getGhcPath :: MonadIO m => VersionNumber -> m (Maybe GhcPath) -getGhcPath ghcVersion = +getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath) +getGhcPathOf ghcVersion = liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case - Nothing -> do - findExecutable "ghc" >>= \case - Nothing -> return Nothing - Just p -> do - Stdout version <- cmd p ["--numeric-version"] :: IO (Stdout String) - if ghcVersion == trim version then return $ Just p else return Nothing - p -> return p + Nothing -> lookup ghcVersion <$> getGhcPaths + path -> return path +-- | Get a list of GHCs that are available in $PATH +getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)] +getGhcPaths = liftIO $ do + paths <- findExecutables "ghc" + forM paths $ \path -> do + Stdout version <- cmd path ["--numeric-version"] + return (trim version, path) -- | No suitable ghc version has been found. Show a message. ghcVersionNotFoundFailMsg :: VersionNumber -> String diff --git a/install/src/Install.hs b/install/src/Install.hs index 46f1e0da9..aebdcc509 100644 --- a/install/src/Install.hs +++ b/install/src/Install.hs @@ -47,9 +47,11 @@ defaultMain = do -- unset GHC_PACKAGE_PATH for cabal unsetEnv "GHC_PACKAGE_PATH" + -- used for cabal-based targets ghcPaths <- findInstalledGhcs let ghcVersions = map fst ghcPaths + -- used for stack-based targets hieVersions <- getHieVersions putStrLn $ "run from: " ++ buildSystem @@ -110,7 +112,7 @@ defaultMain = do need ["cabal"] cabalBuildData forM_ - hieVersions + ghcVersions (\version -> phony ("cabal-hie-" ++ version) $ do validateCabalNewInstallIsSupported need ["submodules"] From 39e5c3c3a8a984ade1e1e605a2ef0b2fb2949d4f Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Wed, 26 Jun 2019 01:25:59 +0200 Subject: [PATCH 06/22] use strict copyFile function for hie-x.y binaries --- install/src/Cabal.hs | 13 ++++++++----- install/src/Stack.hs | 12 +++++++----- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index db6bf1b3a..d6e82e054 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -6,7 +6,9 @@ import Development.Shake.FilePath import Control.Monad import Data.Maybe ( isNothing ) import Control.Monad.Extra ( whenMaybe ) -import System.Directory ( findExecutable ) +import System.Directory ( findExecutable + , copyFile + ) import Version import Print @@ -45,10 +47,11 @@ cabalInstallHie versionNumber = do , "exe:hie" , "--overwrite-policy=always" ] - copyFile' (localBin "hie" <.> exe) - (localBin "hie-" ++ versionNumber <.> exe) - copyFile' (localBin "hie" <.> exe) - (localBin "hie-" ++ dropExtension versionNumber <.> exe) + liftIO $ do + copyFile (localBin "hie" <.> exe) + (localBin "hie-" ++ versionNumber <.> exe) + copyFile (localBin "hie" <.> exe) + (localBin "hie-" ++ dropExtension versionNumber <.> exe) -- TODO: review installCabal :: Action () diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 292b5a18b..11470d079 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -4,6 +4,7 @@ import Development.Shake import Development.Shake.Command import Development.Shake.FilePath import Control.Monad +import System.Directory ( copyFile ) import Version import Print @@ -18,12 +19,13 @@ stackBuildHie versionNumber = execStackWithGhc_ versionNumber ["build"] stackInstallHie :: VersionNumber -> Action () stackInstallHie versionNumber = do execStackWithGhc_ versionNumber ["install"] - localBinDir <- getLocalBin + localBinDir <- getLocalBin let hie = "hie" <.> exe - copyFile' (localBinDir hie) - (localBinDir "hie-" ++ versionNumber <.> exe) - copyFile' (localBinDir hie) - (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) + liftIO $ do + copyFile (localBinDir hie) + (localBinDir "hie-" ++ versionNumber <.> exe) + copyFile (localBinDir hie) + (localBinDir "hie-" ++ dropExtension versionNumber <.> exe) buildCopyCompilerTool :: VersionNumber -> Action () buildCopyCompilerTool versionNumber = From d670f5a9bd4749eacd47600f6533dc743a61c1b4 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 27 Jun 2019 17:37:12 +0200 Subject: [PATCH 07/22] move shake.* files into install/ folder --- .gitignore | 1 + install/shake.project | 2 ++ shake.yaml => install/shake.yaml | 2 +- shake.project | 2 -- 4 files changed, 4 insertions(+), 3 deletions(-) create mode 100644 install/shake.project rename shake.yaml => install/shake.yaml (94%) delete mode 100644 shake.project diff --git a/.gitignore b/.gitignore index 90a09f165..144edde75 100644 --- a/.gitignore +++ b/.gitignore @@ -73,3 +73,4 @@ _build/ # stack 2.1 stack.yaml lock files stack*.yaml.lock +shake.yaml.lock diff --git a/install/shake.project b/install/shake.project new file mode 100644 index 000000000..43c7e6072 --- /dev/null +++ b/install/shake.project @@ -0,0 +1,2 @@ +packages: + install/ diff --git a/shake.yaml b/install/shake.yaml similarity index 94% rename from shake.yaml rename to install/shake.yaml index b77f32905..e684d5cee 100644 --- a/shake.yaml +++ b/install/shake.yaml @@ -1,7 +1,7 @@ # Used to provide a different environment for the shake build script resolver: lts-13.18 # GHC 8.6.4 packages: -- install +- . nix: packages: [ zlib ] diff --git a/shake.project b/shake.project deleted file mode 100644 index 94f06ec7e..000000000 --- a/shake.project +++ /dev/null @@ -1,2 +0,0 @@ -packages: - install From 9b351945583646318ffedf961d5df3a52fa41f9a Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 27 Jun 2019 17:58:27 +0200 Subject: [PATCH 08/22] correct help message to show only available ghcs for cabal --- install/hie-install.cabal | 1 + install/src/Help.hs | 48 +++++++++++++++++++++++---------------- install/src/Install.hs | 9 +++++--- 3 files changed, 36 insertions(+), 22 deletions(-) diff --git a/install/hie-install.cabal b/install/hie-install.cabal index 87983ec57..269a07819 100644 --- a/install/hie-install.cabal +++ b/install/hie-install.cabal @@ -25,6 +25,7 @@ library , text default-extensions: LambdaCase , TupleSections + , RecordWildCards default-language: Haskell2010 if flag(run-from-stack) diff --git a/install/src/Help.hs b/install/src/Help.hs index 1cdcc58ec..fff5aa01a 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -6,9 +6,10 @@ import Data.List ( intersperse , intercalate ) -import Env -import Print -import Version +import Env +import Print +import Version +import BuildSystem printUsage :: Action () printUsage = do @@ -39,26 +40,35 @@ shortHelpMessage = do , cabalGhcsTarget ] +-- | A record that specifies for each build system which versions of @hie@ can be built. +data BuildableVersions = BuildableVersions + { stackVersions :: [VersionNumber] + , cabalVersions :: [VersionNumber] + } +getDefaultBuildSystemVersions :: BuildableVersions -> [VersionNumber] +getDefaultBuildSystemVersions BuildableVersions{..} + | isRunFromStack = stackVersions + | isRunFromCabal = cabalVersions + | otherwise = error $ "unknown build system: " ++ buildSystem -helpMessage :: Action () -helpMessage = do - hieVersions <- getHieVersions +helpMessage :: BuildableVersions -> Action () +helpMessage versions@BuildableVersions{..} = do printUsage out "" out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) + mapM_ (out' . showTarget spaces) targets out "" where - spaces hieVersions = space (targets hieVersions) + spaces = space targets -- All targets the shake file supports - targets :: [VersionNumber] -> [(String, String)] - targets hieVersions = intercalate + targets :: [(String, String)] + targets = intercalate [emptyTarget] [ generalTargets - , defaultTargets hieVersions - , stackTargets hieVersions - , cabalTargets hieVersions + , defaultTargets + , stackTargets + , cabalTargets , [macosIcuTarget] ] @@ -67,27 +77,27 @@ helpMessage = do [ helpTarget ] - defaultTargets hieVersions = + defaultTargets = [ buildTarget , buildAllTarget , buildDataTarget ] - ++ map hieTarget hieVersions + ++ map hieTarget (getDefaultBuildSystemVersions versions) - stackTargets hieVersions = + stackTargets = [ stackTarget buildTarget , stackTarget buildAllTarget , stackTarget buildDataTarget ] - ++ map (stackTarget . hieTarget) hieVersions + ++ map (stackTarget . hieTarget) stackVersions - cabalTargets hieVersions = + cabalTargets = [ cabalGhcsTarget , cabalTarget buildTarget , cabalTarget buildAllTarget , cabalTarget buildDataTarget ] - ++ map (cabalTarget . hieTarget) hieVersions + ++ map (cabalTarget . hieTarget) cabalVersions -- | Empty target. Purpose is to introduce a newline between the targets emptyTarget :: (String, String) diff --git a/install/src/Install.hs b/install/src/Install.hs index aebdcc509..857306b37 100644 --- a/install/src/Install.hs +++ b/install/src/Install.hs @@ -10,8 +10,7 @@ import Control.Monad.Extra ( unlessM ) import Data.Maybe ( isJust ) import System.Directory ( listDirectory ) -import System.Environment ( unsetEnv - ) +import System.Environment ( unsetEnv ) import System.Info ( os , arch ) @@ -54,6 +53,10 @@ defaultMain = do -- used for stack-based targets hieVersions <- getHieVersions + let versions = BuildableVersions { stackVersions = hieVersions + , cabalVersions = ghcVersions + } + putStrLn $ "run from: " ++ buildSystem shakeArgs shakeOptions { shakeFiles = "_build" } $ do @@ -63,7 +66,7 @@ defaultMain = do phony "cabal" installCabal phony "short-help" shortHelpMessage phony "all" shortHelpMessage - phony "help" helpMessage + phony "help" (helpMessage versions) phony "check-stack" checkStack phony "check-cabal" checkCabal From 71cbab17ec6a562a852140629f9acaad6dfdb04c Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 27 Jun 2019 18:03:25 +0200 Subject: [PATCH 09/22] apply brittany reformat --- install/src/Help.hs | 45 +++++++++++++++++--------------------------- install/src/Print.hs | 2 +- 2 files changed, 18 insertions(+), 29 deletions(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index fff5aa01a..1e6debe7c 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -47,13 +47,13 @@ data BuildableVersions = BuildableVersions } getDefaultBuildSystemVersions :: BuildableVersions -> [VersionNumber] -getDefaultBuildSystemVersions BuildableVersions{..} +getDefaultBuildSystemVersions BuildableVersions {..} | isRunFromStack = stackVersions | isRunFromCabal = cabalVersions - | otherwise = error $ "unknown build system: " ++ buildSystem + | otherwise = error $ "unknown build system: " ++ buildSystem helpMessage :: BuildableVersions -> Action () -helpMessage versions@BuildableVersions{..} = do +helpMessage versions@BuildableVersions {..} = do printUsage out "" out "Targets:" @@ -63,7 +63,7 @@ helpMessage versions@BuildableVersions{..} = do spaces = space targets -- All targets the shake file supports targets :: [(String, String)] - targets = intercalate + targets = intercalate [emptyTarget] [ generalTargets , defaultTargets @@ -73,30 +73,24 @@ helpMessage versions@BuildableVersions{..} = do ] -- All targets with their respective help message. - generalTargets = - [ helpTarget - ] + generalTargets = [helpTarget] - defaultTargets = - [ buildTarget - , buildAllTarget - , buildDataTarget - ] - ++ map hieTarget (getDefaultBuildSystemVersions versions) + defaultTargets = [buildTarget, buildAllTarget, buildDataTarget] + ++ map hieTarget (getDefaultBuildSystemVersions versions) stackTargets = [ stackTarget buildTarget - , stackTarget buildAllTarget - , stackTarget buildDataTarget - ] + , stackTarget buildAllTarget + , stackTarget buildDataTarget + ] ++ map (stackTarget . hieTarget) stackVersions cabalTargets = [ cabalGhcsTarget - , cabalTarget buildTarget - , cabalTarget buildAllTarget - , cabalTarget buildDataTarget - ] + , cabalTarget buildTarget + , cabalTarget buildAllTarget + , cabalTarget buildDataTarget + ] ++ map (cabalTarget . hieTarget) cabalVersions -- | Empty target. Purpose is to introduce a newline between the targets @@ -115,13 +109,10 @@ cabalTarget = targetWithBuildSystem "cabal" hieTarget :: String -> TargetDescription hieTarget version = - ( "hie-" ++ version - , "Builds hie for GHC version " ++ version - ) + ("hie-" ++ version, "Builds hie for GHC version " ++ version) buildTarget :: TargetDescription -buildTarget = - ("build", "Builds hie with all installed GHCs") +buildTarget = ("build", "Builds hie with all installed GHCs") buildDataTarget :: TargetDescription buildDataTarget = @@ -129,9 +120,7 @@ buildDataTarget = buildAllTarget :: TargetDescription buildAllTarget = - ( "build-all" - , "Builds hie for all installed GHC versions and the data files" - ) + ("build-all", "Builds hie for all installed GHC versions and the data files") -- speical targets diff --git a/install/src/Print.hs b/install/src/Print.hs index 6ae7c4946..8e308d62e 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -9,7 +9,7 @@ import Data.List ( dropWhileEnd import Data.Char ( isSpace ) out :: MonadIO m => String -> m () -out = liftIO . putStrLn +out = liftIO . putStrLn out' :: MonadIO m => String -> m () out' = out . (" " ++) From f07ad7ca3937a260be507c421fd2523e0f432657 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 27 Jun 2019 18:05:15 +0200 Subject: [PATCH 10/22] add cabal.project to install-dir --- install/cabal.project | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 install/cabal.project diff --git a/install/cabal.project b/install/cabal.project new file mode 100644 index 000000000..a14a803d4 --- /dev/null +++ b/install/cabal.project @@ -0,0 +1,2 @@ +packages: + ./ From 7fad241883f01afc5bc44164fc361123b87ac431 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 27 Jun 2019 18:55:38 +0200 Subject: [PATCH 11/22] add documentation to install-helper-functions --- install/src/Help.hs | 26 +++++++++++++------------- install/src/Print.hs | 10 ++++++---- install/src/Version.hs | 2 +- 3 files changed, 20 insertions(+), 18 deletions(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index 1e6debe7c..c9ec690f4 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -13,21 +13,21 @@ import BuildSystem printUsage :: Action () printUsage = do - out "" - out "Usage:" - out' ("stack install.hs ") - out' "or" - out' ("cabal new-run install.hs --project-file shake.project ") + printLine "" + printLine "Usage:" + printLineIndented ("stack install.hs ") + printLineIndented "or" + printLineIndented ("cabal new-run install.hs --project-file shake.project ") -- | short help message is printed by default shortHelpMessage :: Action () shortHelpMessage = do hieVersions <- getHieVersions printUsage - out "" - out "Targets:" - mapM_ (out' . showTarget (spaces hieVersions)) (targets hieVersions) - out "" + printLine "" + printLine "Targets:" + mapM_ (printLineIndented . showTarget (spaces hieVersions)) (targets hieVersions) + printLine "" where spaces hieVersions = space (targets hieVersions) targets hieVersions = @@ -55,10 +55,10 @@ getDefaultBuildSystemVersions BuildableVersions {..} helpMessage :: BuildableVersions -> Action () helpMessage versions@BuildableVersions {..} = do printUsage - out "" - out "Targets:" - mapM_ (out' . showTarget spaces) targets - out "" + printLine "" + printLine "Targets:" + mapM_ (printLineIndented . showTarget spaces) targets + printLine "" where spaces = space targets -- All targets the shake file supports diff --git a/install/src/Print.hs b/install/src/Print.hs index 8e308d62e..82904491f 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -8,11 +8,13 @@ import Data.List ( dropWhileEnd ) import Data.Char ( isSpace ) -out :: MonadIO m => String -> m () -out = liftIO . putStrLn +-- | lift putStrLn to MonadIO +printLine :: MonadIO m => String -> m () +printLine = liftIO . putStrLn -out' :: MonadIO m => String -> m () -out' = out . (" " ++) +-- | print a line prepended with 4 spaces +printLineIndented :: MonadIO m => String -> m () +printLineIndented = printLine . (" " ++) embedInStars :: String -> String embedInStars str = diff --git a/install/src/Version.hs b/install/src/Version.hs index de9bfd019..0d89b4b95 100644 --- a/install/src/Version.hs +++ b/install/src/Version.hs @@ -19,6 +19,6 @@ versionToString = showVersion . makeVersion parseVersionEx :: String -> Version parseVersionEx = fst . head . filter (("" ==) . snd) . readP_to_S parseVersion - +-- | Check that a given version-string is not smaller than the required version checkVersion :: RequiredVersion -> String -> Bool checkVersion required given = parseVersionEx given >= makeVersion required From edb411ca136b9a43b5cfd9697ddfd783197a2075 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Fri, 28 Jun 2019 15:35:12 +0200 Subject: [PATCH 12/22] let stack use moved shake.yaml in install.hs --- install/src/Install.hs | 2 +- install/src/Stack.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/install/src/Install.hs b/install/src/Install.hs index 857306b37..9b088200e 100644 --- a/install/src/Install.hs +++ b/install/src/Install.hs @@ -85,7 +85,7 @@ defaultMain = do phony "build-all" $ need [buildSystem ++ "-build-all"] phony "build-data" $ need [buildSystem ++ "-build-data"] forM_ - hieVersions + (getDefaultBuildSystemVersions versions) (\version -> phony ("hie-" ++ version) $ need [buildSystem ++ "-hie-" ++ version] ) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 11470d079..a2c351333 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -66,11 +66,11 @@ execStackWithGhc versionNumber args = do -- | Execute a stack command with the same resolver as the build script execStackShake :: CmdResult r => [String] -> Action r -execStackShake args = command [] "stack" ("--stack-yaml=shake.yaml" : args) +execStackShake args = command [] "stack" ("--stack-yaml=install/shake.yaml" : args) -- | Execute a stack command with the same resolver as the build script, discarding the output execStackShake_ :: [String] -> Action () -execStackShake_ args = command_ [] "stack" ("--stack-yaml=shake.yaml" : args) +execStackShake_ args = command_ [] "stack" ("--stack-yaml=install/shake.yaml" : args) -- | Error message when the `stack` binary is an older version From aa49439c4a4992bbc8e1a0f5cbf954e134d1e38c Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Fri, 28 Jun 2019 17:04:54 +0200 Subject: [PATCH 13/22] increase max-backjumps when building `hie` with cabal --- install/src/Cabal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index d6e82e054..7d6314504 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -35,7 +35,7 @@ cabalBuildHie versionNumber = do error (ghcVersionNotFoundFailMsg versionNumber) Just p -> return p execCabal_ - ["new-build", "-w", ghcPath, "--write-ghc-environment-files=never"] + ["new-build", "-w", ghcPath, "--write-ghc-environment-files=never", "--max-backjumps=5000"] cabalInstallHie :: VersionNumber -> Action () cabalInstallHie versionNumber = do From 385de659d728d4a6a8fe7d84e854aad5b688df66 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Sat, 29 Jun 2019 16:43:15 +0200 Subject: [PATCH 14/22] document running install.hs from cabal in readme --- README.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/README.md b/README.md index 7f847268e..fd38d53f2 100644 --- a/README.md +++ b/README.md @@ -201,6 +201,18 @@ stack ./install.hs help Remember, this will take time to download a Stackage-LTS and an appropriate GHC. However, afterwards all commands should work as expected. +##### Install via cabal + +The install-script can be invoked via `cabal` instead of `stack` with the command + +```bash +cabal v2-run ./install.hs --project-file install/shake.project +``` + +Unfortunalely, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. + +For briefty, only the `stack`-based commands are presented in the following sections. + ##### Install specific GHC Version Install **Nightly** (and hoogle docs): From 8d10d6e2812a07892565d6da08fed755579a97d2 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Sun, 30 Jun 2019 09:13:21 +0200 Subject: [PATCH 15/22] fix typos in readme --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index fd38d53f2..3c3878048 100644 --- a/README.md +++ b/README.md @@ -209,9 +209,9 @@ The install-script can be invoked via `cabal` instead of `stack` with the comman cabal v2-run ./install.hs --project-file install/shake.project ``` -Unfortunalely, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. +Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. -For briefty, only the `stack`-based commands are presented in the following sections. +For brevity, only the `stack`-based commands are presented in the following sections. ##### Install specific GHC Version From 109df6011fafe83d5ff857af7d44cd8d2989e87a Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Mon, 1 Jul 2019 00:30:36 +0200 Subject: [PATCH 16/22] remove todo for review --- install/src/Cabal.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 7d6314504..c09527505 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -53,7 +53,6 @@ cabalInstallHie versionNumber = do copyFile (localBin "hie" <.> exe) (localBin "hie-" ++ dropExtension versionNumber <.> exe) --- TODO: review installCabal :: Action () installCabal = do -- try to find existing `cabal` executable with appropriate version From 8346b7fdfdd348ec2501872f35eef3c4e72d21cd Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Mon, 1 Jul 2019 06:53:36 +0200 Subject: [PATCH 17/22] rename module Install to HieInstall in hie-install now, tests should work on windows --- install.hs | 2 +- install/hie-install.cabal | 2 +- install/src/Cabal.hs | 1 + install/src/{Install.hs => HieInstall.hs} | 2 +- 4 files changed, 4 insertions(+), 3 deletions(-) rename install/src/{Install.hs => HieInstall.hs} (99%) diff --git a/install.hs b/install.hs index 782c4a5ed..b68745bd3 100755 --- a/install.hs +++ b/install.hs @@ -15,6 +15,6 @@ build-depends: -- TODO: set `shake.project` in cabal-config above, when supported -import Install (defaultMain) +import HieInstall (defaultMain) main = defaultMain diff --git a/install/hie-install.cabal b/install/hie-install.cabal index 269a07819..287b56f6a 100644 --- a/install/hie-install.cabal +++ b/install/hie-install.cabal @@ -10,7 +10,7 @@ cabal-version: >=2.0 library hs-source-dirs: src - exposed-modules: Install + exposed-modules: HieInstall other-modules: BuildSystem , Stack , Version diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index c09527505..7d6314504 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -53,6 +53,7 @@ cabalInstallHie versionNumber = do copyFile (localBin "hie" <.> exe) (localBin "hie-" ++ dropExtension versionNumber <.> exe) +-- TODO: review installCabal :: Action () installCabal = do -- try to find existing `cabal` executable with appropriate version diff --git a/install/src/Install.hs b/install/src/HieInstall.hs similarity index 99% rename from install/src/Install.hs rename to install/src/HieInstall.hs index 9b088200e..3f89e0dc5 100644 --- a/install/src/Install.hs +++ b/install/src/HieInstall.hs @@ -1,4 +1,4 @@ -module Install where +module HieInstall where import Development.Shake import Development.Shake.Command From 84baa246bdd62003126abd0aed33eacd98bf7858 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Mon, 1 Jul 2019 07:01:51 +0200 Subject: [PATCH 18/22] add a testrun of install.hs to ci --- .azure/windows-installhs-stack.yml | 30 ++++++++++++++++++++++++++++++ azure-pipelines.yml | 2 ++ 2 files changed, 32 insertions(+) create mode 100644 .azure/windows-installhs-stack.yml diff --git a/.azure/windows-installhs-stack.yml b/.azure/windows-installhs-stack.yml new file mode 100644 index 000000000..3fab9d640 --- /dev/null +++ b/.azure/windows-installhs-stack.yml @@ -0,0 +1,30 @@ +jobs: +- job: Windows_installhs_Stack + timeoutInMinutes: 0 + pool: + vmImage: windows-2019 + strategy: + matrix: + shake: + YAML_FILE: install/shake.yaml + steps: + - bash: | + curl -sSkL http://www.stackage.org/stack/windows-x86_64 -o /usr/bin/stack.zip + unzip -o /usr/bin/stack.zip -d /usr/bin/ + displayName: Install stack + - bash: | + source .azure/windows.bashrc + stack setup --stack-yaml $(YAML_FILE) + displayName: Install GHC + - bash: | + source .azure/windows.bashrc + stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies + displayName: Build dependencies + - bash: | + source .azure/windows.bashrc + stack build --stack-yaml $(YAML_FILE) + displayName: Build `hie-install` + - bash: | + source .azure/windows.bashrc + stack install.hs help + displayName: Run help of `instal.hs` diff --git a/azure-pipelines.yml b/azure-pipelines.yml index a78fae1c9..4eae53800 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -2,3 +2,5 @@ jobs: - template: ./.azure/linux-stack.yml - template: ./.azure/windows-stack.yml - template: ./.azure/macos-stack.yml +- template: ./.azure/windows-installhs-stack.yml + From 767f467337949dac8174e19a458e7097aac4b449 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Mon, 1 Jul 2019 13:42:42 +0200 Subject: [PATCH 19/22] remove todo for review --- install/src/Cabal.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 7d6314504..c09527505 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -53,7 +53,6 @@ cabalInstallHie versionNumber = do copyFile (localBin "hie" <.> exe) (localBin "hie-" ++ dropExtension versionNumber <.> exe) --- TODO: review installCabal :: Action () installCabal = do -- try to find existing `cabal` executable with appropriate version From a8ae740e974eb49f0efcbc3538cb0219fd88ead4 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 11 Jul 2019 20:24:00 +0200 Subject: [PATCH 20/22] add install.hs tests on more plattforms --- .azure/linux-installhs-stack.yml | 32 ++++++++++++++++++++++++++ .azure/macos-installhs-stack.yml | 32 ++++++++++++++++++++++++++ .azure/windows-installhs-cabal.yml | 37 ++++++++++++++++++++++++++++++ azure-pipelines.yml | 3 ++- 4 files changed, 103 insertions(+), 1 deletion(-) create mode 100644 .azure/linux-installhs-stack.yml create mode 100644 .azure/macos-installhs-stack.yml create mode 100644 .azure/windows-installhs-cabal.yml diff --git a/.azure/linux-installhs-stack.yml b/.azure/linux-installhs-stack.yml new file mode 100644 index 000000000..40bdc6424 --- /dev/null +++ b/.azure/linux-installhs-stack.yml @@ -0,0 +1,32 @@ +jobs: +- job: Linux_installhs_Stack + timeoutInMinutes: 0 + pool: + vmImage: ubuntu-16.04 + strategy: + matrix: + shake: + YAML_FILE: install/shake.yaml + steps: + - bash: | + export STACK_ROOT="$(Build.SourcesDirectory)"/.stack-root + mkdir -p ~/.local/bin + curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | \ + tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' + displayName: Install stack + - bash: | + source .azure/linux.bashrc + stack setup --stack-yaml $(YAML_FILE) + displayName: Install GHC + - bash: | + source .azure/linux.bashrc + stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies + displayName: Build dependencies + - bash: | + source .azure/linux.bashrc + stack build --stack-yaml $(YAML_FILE) + displayName: Build `hie-install` + - bash: | + source .azure/linux.bashrc + stack install.hs help + displayName: Run help of `instal.hs` diff --git a/.azure/macos-installhs-stack.yml b/.azure/macos-installhs-stack.yml new file mode 100644 index 000000000..971b12a23 --- /dev/null +++ b/.azure/macos-installhs-stack.yml @@ -0,0 +1,32 @@ +jobs: +- job: MacOs_installhs_Stack + timeoutInMinutes: 0 + pool: + vmImage: macOS-10.13 + strategy: + matrix: + shake: + YAML_FILE: install/shake.yaml + steps: + - bash: | + export STACK_ROOT="$(Build.SourcesDirectory)"/.stack-root + mkdir -p ~/.local/bin + curl -skL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | \ + tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin; + displayName: Install stack + - bash: | + source .azure/macos.bashrc + stack setup --stack-yaml $(YAML_FILE) + displayName: Install GHC + - bash: | + source .azure/macos.bashrc + stack --stack-yaml $(YAML_FILE) --install-ghc build --only-dependencies + displayName: Build dependencies + - bash: | + source .azure/macos.bashrc + stack build --stack-yaml $(YAML_FILE) + displayName: Build `hie-install` + - bash: | + source .azure/macos.bashrc + stack install.hs help + displayName: Run help of `instal.hs` diff --git a/.azure/windows-installhs-cabal.yml b/.azure/windows-installhs-cabal.yml new file mode 100644 index 000000000..e37d20018 --- /dev/null +++ b/.azure/windows-installhs-cabal.yml @@ -0,0 +1,37 @@ +jobs: +- job: Windows_installhs_Cabal + timeoutInMinutes: 0 + pool: + vmImage: windows-2019 + variables: + YAML_FILE: install/shake.yaml + PROJECT_FILE: install/shake.project + steps: + - bash: | + curl -sSkL http://www.stackage.org/stack/windows-x86_64 -o /usr/bin/stack.zip + unzip -o /usr/bin/stack.zip -d /usr/bin/ + displayName: Install stack + - bash: | + source .azure/windows.bashrc + stack setup --stack-yaml $(YAML_FILE) + displayName: Install GHC + - bash: | + source .azure/windows.bashrc + stack install cabal-install --stack-yaml $(YAML_FILE) + displayName: Install `cabal-install` + - bash: | + source .azure/windows.bashrc + cabal update + displayName: update cabal + # - bash: | + # source .azure/windows.bashrc + # stack --stack-yaml $(YAML_FILE) build --only-dependencies + # displayName: Build dependencies + - bash: | + source .azure/windows.bashrc + cabal v2-build hie-install -w $(stack path --stack-yaml $(YAML_FILE) --compiler-exe) --project-file $(PROJECT_FILE) + displayName: Build `hie-install` + - bash: | + source .azure/windows.bashrc + cabal v2-run install.hs -w $(stack path --stack-yaml $(YAML_FILE) --compiler-exe) --project-file $(PROJECT_FILE) help + displayName: Run help of `install.hs` diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 4eae53800..57aa8497e 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -2,5 +2,6 @@ jobs: - template: ./.azure/linux-stack.yml - template: ./.azure/windows-stack.yml - template: ./.azure/macos-stack.yml +- template: ./.azure/linux-installhs-stack.yml - template: ./.azure/windows-installhs-stack.yml - +- template: ./.azure/macos-installhs-stack.yml From 34f79646b2ec8f9ace476819bb50a385f4ce1fb5 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 11 Jul 2019 20:26:08 +0200 Subject: [PATCH 21/22] readme typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 3c3878048..b44a50dd1 100644 --- a/README.md +++ b/README.md @@ -209,7 +209,7 @@ The install-script can be invoked via `cabal` instead of `stack` with the comman cabal v2-run ./install.hs --project-file install/shake.project ``` -Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. +Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. For brevity, only the `stack`-based commands are presented in the following sections. From 9aa390d95431f19d4172d6f3257adc47a73b73e3 Mon Sep 17 00:00:00 2001 From: Samuel Pilz Date: Thu, 11 Jul 2019 21:20:49 +0200 Subject: [PATCH 22/22] add note that cabal v2-run is not supported on windows --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index b44a50dd1..32025f6d3 100644 --- a/README.md +++ b/README.md @@ -209,6 +209,8 @@ The install-script can be invoked via `cabal` instead of `stack` with the comman cabal v2-run ./install.hs --project-file install/shake.project ``` +Running the script with cabal on windows seems to have some issues and is currently not fully supported. + Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. For brevity, only the `stack`-based commands are presented in the following sections.