From a6108f831942905bf0d3eb0d5901340affab3bdb Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 20 Jul 2021 11:54:14 +0200 Subject: [PATCH 1/3] Fix listVersion wrt #183 --- lib/GHCup.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 3628bd3..9b1bfb3 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -1010,10 +1010,10 @@ listVersions lt' criteria = do slr <- strayCabals avTools cSet cabals pure (sort (slr ++ lr)) HLS -> do - slr <- strayHLS avTools + slr <- strayHLS avTools hlsSet' hlses pure (sort (slr ++ lr)) Stack -> do - slr <- strayStacks avTools + slr <- strayStacks avTools sSet stacks pure (sort (slr ++ lr)) GHCup -> pure lr Nothing -> do @@ -1113,15 +1113,16 @@ listVersions lt' criteria = do , MonadLogger m , MonadIO m) => Map.Map Version [Tag] + -> Maybe Version + -> [Either FilePath Version] -> m [ListResult] - strayHLS avTools = do - hlss <- getInstalledHLSs + strayHLS avTools hlsSet' hlss = do fmap catMaybes $ forM hlss $ \case Right ver -> case Map.lookup ver avTools of Just _ -> pure Nothing Nothing -> do - lSet <- fmap (== Just ver) hlsSet + let lSet = hlsSet' == Just ver pure $ Just $ ListResult { lTool = HLS , lVer = ver @@ -1147,15 +1148,16 @@ listVersions lt' criteria = do , MonadIO m ) => Map.Map Version [Tag] + -> Maybe Version + -> [Either FilePath Version] -> m [ListResult] - strayStacks avTools = do - stacks <- getInstalledStacks + strayStacks avTools stackSet' stacks = do fmap catMaybes $ forM stacks $ \case Right ver -> case Map.lookup ver avTools of Just _ -> pure Nothing Nothing -> do - lSet <- fmap (== Just ver) hlsSet + let lSet = stackSet' == Just ver pure $ Just $ ListResult { lTool = Stack , lVer = ver From 9e181b8820e49f59c8d2e1273a6060c90283be88 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 20 Jul 2021 13:08:17 +0200 Subject: [PATCH 2/3] Allow passing "flavor" to 'ghcup compile ghc' Fixes #183 --- app/ghcup/Main.hs | 9 +++++++++ lib/GHCup.hs | 48 +++++++++++++++++++++++++++++++---------------- 2 files changed, 41 insertions(+), 16 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 30459f1..fdfc6ed 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -182,6 +182,7 @@ data GHCCompileOptions = GHCCompileOptions , addConfArgs :: [Text] , setCompile :: Bool , ovewrwiteVer :: Maybe Version + , buildFlavour :: Maybe String } data UpgradeOpts = UpgradeInplace @@ -987,6 +988,13 @@ ghcCompileOpts = "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'" ) ) + <*> optional + (option + str + (short 'f' <> long "flavour" <> metavar "BUILD_FLAVOUR" <> help + "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')" + ) + ) toolVersionParser :: Parser ToolVersion @@ -1926,6 +1934,7 @@ Report bugs at |] buildConfig patchDir addConfArgs + buildFlavour GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let vi = getVersionInfo (_tvVersion targetVer) GHC dls when setCompile $ void $ liftE $ diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 9b1bfb3..09e18a0 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -1667,10 +1667,11 @@ compileGHC :: ( MonadMask m => Either GHCTargetVersion GitBranch -- ^ version to install -> Maybe Version -- ^ overwrite version -> Either Version FilePath -- ^ version to bootstrap with - -> Maybe Int -- ^ jobs + -> Maybe Int -- ^ jobs -> Maybe FilePath -- ^ build config -> Maybe FilePath -- ^ patch directory - -> [Text] -- ^ additional args to ./configure + -> [Text] -- ^ additional args to ./configure + -> Maybe String -- ^ build flavour -> Excepts '[ AlreadyInstalled , BuildFailed @@ -1689,7 +1690,7 @@ compileGHC :: ( MonadMask m ] m GHCTargetVersion -compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs +compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour = do PlatformRequest { .. } <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo @@ -1806,13 +1807,19 @@ BUILD_MAN = NO BUILD_SPHINX_HTML = NO BUILD_SPHINX_PDF = NO HADDOCK_DOCS = NO +ifneq "$(BuildFlavour)" "" +include mk/flavours/$(BuildFlavour).mk +endif Stage1Only = YES|] _ -> [s| V=0 BUILD_MAN = NO BUILD_SPHINX_HTML = NO BUILD_SPHINX_PDF = NO -HADDOCK_DOCS = YES|] +HADDOCK_DOCS = YES +ifneq "$(BuildFlavour)" "" +include mk/flavours/$(BuildFlavour).mk +endif|] compileBindist :: ( MonadReader env m , HasDirs env @@ -1834,7 +1841,6 @@ HADDOCK_DOCS = YES|] (Maybe FilePath) -- ^ output path of bindist, None for cross compileBindist bghc tver workdir ghcdir = do lift $ $(logInfo) [i|configuring build|] - liftE checkBuildConfig Dirs {..} <- lift getDirs pfreq <- lift getPlatformReq @@ -1887,7 +1893,9 @@ HADDOCK_DOCS = YES|] (FileDoesNotExistError bc) (liftIO $ copyFile bc (build_mk workdir)) Nothing -> - liftIO $ B.writeFile (build_mk workdir) defaultConf + liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf) + + liftE $ checkBuildConfig (build_mk workdir) lift $ $(logInfo) [i|Building (this may take a while)...|] lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir) @@ -1924,19 +1932,17 @@ HADDOCK_DOCS = YES|] build_mk workdir = workdir "mk" "build.mk" - checkBuildConfig :: (MonadCatch m, MonadIO m) - => Excepts + checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m) + => FilePath + -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m () - checkBuildConfig = do - c <- case mbuildConfig of - Just bc -> do - liftIOException - doesNotExistErrorType - (FileDoesNotExistError bc) - (liftIO $ B.readFile bc) - Nothing -> pure defaultConf + checkBuildConfig bc = do + c <- liftIOException + doesNotExistErrorType + (FileDoesNotExistError bc) + (liftIO $ B.readFile bc) let lines' = fmap T.strip . T.lines $ decUTF8Safe c -- for cross, we need Stage1Only @@ -1947,6 +1953,16 @@ HADDOCK_DOCS = YES|] ) _ -> pure () + forM_ buildFlavour $ \bf -> + when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do + lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|] + liftIO $ threadDelay 5000000 + + addBuildFlavourToConf bc = case buildFlavour of + Just bf -> [i|BuildFlavour = #{bf} +#{bc}|] + Nothing -> bc + isCross :: GHCTargetVersion -> Bool isCross = isJust . _tvTarget From a4a7f73fb7ca55f81df29da65b02b3b5d14b95b5 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 20 Jul 2021 21:45:24 +0200 Subject: [PATCH 3/3] Allow to use Hadrian as build system, fixes #35 --- .gitlab-ci.yml | 20 +++ .gitlab/script/ghcup_git.sh | 52 ++++++ app/ghcup/Main.hs | 8 + lib/GHCup.hs | 324 ++++++++++++++++++++++++------------ lib/GHCup/Errors.hs | 15 +- lib/GHCup/Utils.hs | 3 +- 6 files changed, 315 insertions(+), 107 deletions(-) create mode 100755 .gitlab/script/ghcup_git.sh diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index dd9f92f..cc40748 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -281,11 +281,31 @@ test:linux:cross-armv7: CROSS: "arm-linux-gnueabihf" needs: [] when: manual + allow_failure: true before_script: - ./.gitlab/before_script/linux/install_deps.sh script: - ./.gitlab/script/ghcup_cross.sh +test:linux:git:hadrian: + stage: test + extends: + - .test_ghcup_version + - .debian + variables: + GHC_VERSION: "8.10.5" + GHC_GIT_TAG: "ghc-9.0.1-release" + GHC_GIT_VERSION: "9.0.1" + CABAL_VERSION: "3.4.0.0" + CROSS: "" + needs: [] + when: manual + allow_failure: true + before_script: + - ./.gitlab/before_script/linux/install_deps.sh + script: + - ./.gitlab/script/ghcup_git.sh + ######## linux 32bit test ######## diff --git a/.gitlab/script/ghcup_git.sh b/.gitlab/script/ghcup_git.sh new file mode 100755 index 0000000..192e70e --- /dev/null +++ b/.gitlab/script/ghcup_git.sh @@ -0,0 +1,52 @@ +#!/bin/sh + +set -eux + +. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env" + +mkdir -p "$CI_PROJECT_DIR"/.local/bin + +CI_PROJECT_DIR=$(pwd) + +ecabal() { + cabal "$@" +} + +eghcup() { + ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@" +} + +git describe --always + +### build + +ecabal update + +ecabal build -w ghc-${GHC_VERSION} +cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup + +### cleanup + +rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup + +### manual cli based testing + +eghcup --numeric-version + +eghcup install ghc ${GHC_VERSION} +eghcup set ghc ${GHC_VERSION} +eghcup install cabal ${CABAL_VERSION} + +cabal --version + +eghcup debug-info + +eghcup compile ghc -j $(nproc) -g ${GHC_GIT_TAG} -b ${GHC_VERSION} -- --enable-unregisterised +eghcup set ghc ${GHC_GIT_VERSION} + +[ `$(eghcup whereis ghc ${GHC_GIT_VERSION}) --numeric-version` = "${GHC_GIT_VERSION}" ] + +# nuke +eghcup nuke +[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ] + diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index fdfc6ed..f5aefcd 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -183,6 +183,7 @@ data GHCCompileOptions = GHCCompileOptions , setCompile :: Bool , ovewrwiteVer :: Maybe Version , buildFlavour :: Maybe String + , hadrian :: Bool } data UpgradeOpts = UpgradeInplace @@ -995,6 +996,9 @@ ghcCompileOpts = "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')" ) ) + <*> switch + (long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)" + ) toolVersionParser :: Parser ToolVersion @@ -1914,6 +1918,9 @@ Report bugs at |] runLogger $ $(logError) $ T.pack $ prettyShow e pure $ ExitFailure 8 + Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do + runLogger $ $(logError) "Hadrian cross compile support is not yet implemented!" + pure $ ExitFailure 9 Compile (CompileGHC GHCCompileOptions {..}) -> runCompileGHC (do case targetGhc of @@ -1935,6 +1942,7 @@ Report bugs at |] patchDir addConfArgs buildFlavour + hadrian GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo let vi = getVersionInfo (_tvVersion targetVer) GHC dls when setCompile $ void $ liftE $ diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 09e18a0..f348f10 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -1672,6 +1672,7 @@ compileGHC :: ( MonadMask m -> Maybe FilePath -- ^ patch directory -> [Text] -- ^ additional args to ./configure -> Maybe String -- ^ build flavour + -> Bool -> Excepts '[ AlreadyInstalled , BuildFailed @@ -1690,7 +1691,7 @@ compileGHC :: ( MonadMask m ] m GHCTargetVersion -compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour +compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian = do PlatformRequest { .. } <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo @@ -1775,8 +1776,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour tmpUnpack Nothing (do - b <- compileBindist bghc tver workdir ghcdir - bmk <- liftIO $ B.readFile (build_mk workdir) + b <- if hadrian + then compileHadrianBindist bghc tver workdir ghcdir + else compileMakeBindist bghc tver workdir ghcdir + bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk workdir) pure (b, bmk) ) @@ -1821,31 +1824,224 @@ ifneq "$(BuildFlavour)" "" include mk/flavours/$(BuildFlavour).mk endif|] - compileBindist :: ( MonadReader env m - , HasDirs env - , HasSettings env - , HasPlatformReq env - , MonadThrow m - , MonadCatch m - , MonadLogger m - , MonadIO m - , MonadFail m - ) - => Either FilePath FilePath - -> GHCTargetVersion - -> FilePath - -> FilePath - -> Excepts - '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError] - m - (Maybe FilePath) -- ^ output path of bindist, None for cross - compileBindist bghc tver workdir ghcdir = do - lift $ $(logInfo) [i|configuring build|] - + compileHadrianBindist :: ( MonadReader env m + , HasDirs env + , HasSettings env + , HasPlatformReq env + , MonadThrow m + , MonadCatch m + , MonadLogger m + , MonadIO m + , MonadFail m + ) + => Either FilePath FilePath + -> GHCTargetVersion + -> FilePath + -> FilePath + -> Excepts + '[ FileDoesNotExistError + , HadrianNotFound + , InvalidBuildConfig + , PatchFailed + , ProcessError + , NotFoundInPATH + , CopyError] + m + (Maybe FilePath) -- ^ output path of bindist, None for cross + compileHadrianBindist bghc tver workdir ghcdir = do + lEM $ execLogged "python3" ["./boot"] (Just workdir) "ghc-bootstrap" Nothing + + liftE $ configureBindist bghc tver workdir ghcdir + + lift $ $(logInfo) [i|Building (this may take a while)...|] + hadrian_build <- liftE $ findHadrianFile workdir + lEM $ execLogged hadrian_build + ( maybe [] (\j -> [[i|-j#{j}|]] ) jobs + ++ maybe [] (\bf -> [[i|--flavour=#{bf}|]]) buildFlavour + ++ ["binary-dist"] + ) + (Just workdir) "ghc-make" Nothing + [tar] <- liftIO $ findFiles + (workdir "_build" "bindist") + (makeRegexOpts compExtended + execBlank + ([s|^ghc-.*\.tar\..*$|] :: ByteString) + ) + liftE $ fmap Just $ copyBindist tver tar (workdir "_build" "bindist") + + findHadrianFile :: (MonadIO m) + => FilePath + -> Excepts + '[HadrianNotFound] + m + FilePath + findHadrianFile workdir = do +#if defined(IS_WINDOWS) + let possible_files = ((workdir "hadrian") ) <$> ["build.bat"] +#else + let possible_files = ((workdir "hadrian") ) <$> ["build", "build.sh"] +#endif + exsists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f)) + case filter fst exsists of + [] -> throwE HadrianNotFound + ((_, x):_) -> pure x + + compileMakeBindist :: ( MonadReader env m + , HasDirs env + , HasSettings env + , HasPlatformReq env + , MonadThrow m + , MonadCatch m + , MonadLogger m + , MonadIO m + , MonadFail m + ) + => Either FilePath FilePath + -> GHCTargetVersion + -> FilePath + -> FilePath + -> Excepts + '[ FileDoesNotExistError + , HadrianNotFound + , InvalidBuildConfig + , PatchFailed + , ProcessError + , NotFoundInPATH + , CopyError] + m + (Maybe FilePath) -- ^ output path of bindist, None for cross + compileMakeBindist bghc tver workdir ghcdir = do + liftE $ configureBindist bghc tver workdir ghcdir + + case mbuildConfig of + Just bc -> liftIOException + doesNotExistErrorType + (FileDoesNotExistError bc) + (liftIO $ copyFile bc (build_mk workdir)) + Nothing -> + liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf) + + liftE $ checkBuildConfig (build_mk workdir) + + lift $ $(logInfo) [i|Building (this may take a while)...|] + lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir) + + if | isCross tver -> do + lift $ $(logInfo) [i|Installing cross toolchain...|] + lEM $ make ["install"] (Just workdir) + pure Nothing + | otherwise -> do + lift $ $(logInfo) [i|Creating bindist...|] + lEM $ make ["binary-dist"] (Just workdir) + [tar] <- liftIO $ findFiles + workdir + (makeRegexOpts compExtended + execBlank + ([s|^ghc-.*\.tar\..*$|] :: ByteString) + ) + liftE $ fmap Just $ copyBindist tver tar workdir + + build_mk workdir = workdir "mk" "build.mk" + + copyBindist :: ( MonadReader env m + , HasDirs env + , HasSettings env + , HasPlatformReq env + , MonadIO m + , MonadThrow m + , MonadCatch m + , MonadLogger m + ) + => GHCTargetVersion + -> FilePath -- ^ tar file + -> FilePath -- ^ workdir + -> Excepts + '[CopyError] + m + FilePath + copyBindist tver tar workdir = do Dirs {..} <- lift getDirs pfreq <- lift getPlatformReq + c <- liftIO $ BL.readFile (workdir tar) + cDigest <- + fmap (T.take 8) + . lift + . throwEither + . E.decodeUtf8' + . B16.encode + . SHA256.hashlazy + $ c + cTime <- liftIO getCurrentTime + let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|] + let tarPath = cacheDir tarName + handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir tar) + tarPath + lift $ $(logInfo) [i|Copied bindist to #{tarPath}|] + pure tarPath - forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir + checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m) + => FilePath + -> Excepts + '[FileDoesNotExistError, InvalidBuildConfig] + m + () + checkBuildConfig bc = do + c <- liftIOException + doesNotExistErrorType + (FileDoesNotExistError bc) + (liftIO $ B.readFile bc) + let lines' = fmap T.strip . T.lines $ decUTF8Safe c + + -- for cross, we need Stage1Only + case targetGhc of + Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE + (InvalidBuildConfig + [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|] + ) + _ -> pure () + + forM_ buildFlavour $ \bf -> + when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do + lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|] + liftIO $ threadDelay 5000000 + + addBuildFlavourToConf bc = case buildFlavour of + Just bf -> [i|BuildFlavour = #{bf}|] <> [s| +|] <> [i|#{bc}|] + Nothing -> bc + + isCross :: GHCTargetVersion -> Bool + isCross = isJust . _tvTarget + + + configureBindist :: ( MonadReader env m + , HasDirs env + , HasSettings env + , HasPlatformReq env + , MonadThrow m + , MonadCatch m + , MonadLogger m + , MonadIO m + , MonadFail m + ) + => Either FilePath FilePath + -> GHCTargetVersion + -> FilePath + -> FilePath + -> Excepts + '[ FileDoesNotExistError + , InvalidBuildConfig + , PatchFailed + , ProcessError + , NotFoundInPATH + , CopyError + ] + m + () + configureBindist bghc tver workdir ghcdir = do + lift $ $(logInfo) [s|configuring build|] + + forM_ patchdir (\dir -> liftE $ applyPatches dir workdir) cEnv <- liftIO getEnvironment @@ -1886,85 +2082,9 @@ endif|] (Just workdir) "ghc-conf" (Just cEnv) + pure () - case mbuildConfig of - Just bc -> liftIOException - doesNotExistErrorType - (FileDoesNotExistError bc) - (liftIO $ copyFile bc (build_mk workdir)) - Nothing -> - liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf) - liftE $ checkBuildConfig (build_mk workdir) - - lift $ $(logInfo) [i|Building (this may take a while)...|] - lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir) - - if | isCross tver -> do - lift $ $(logInfo) [i|Installing cross toolchain...|] - lEM $ make ["install"] (Just workdir) - pure Nothing - | otherwise -> do - lift $ $(logInfo) [i|Creating bindist...|] - lEM $ make ["binary-dist"] (Just workdir) - [tar] <- liftIO $ findFiles - workdir - (makeRegexOpts compExtended - execBlank - ([s|^ghc-.*\.tar\..*$|] :: ByteString) - ) - c <- liftIO $ BL.readFile (workdir tar) - cDigest <- - fmap (T.take 8) - . lift - . throwEither - . E.decodeUtf8' - . B16.encode - . SHA256.hashlazy - $ c - cTime <- liftIO getCurrentTime - let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|] - let tarPath = cacheDir tarName - handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir tar) - tarPath - lift $ $(logInfo) [i|Copied bindist to #{tarPath}|] - pure $ Just tarPath - - build_mk workdir = workdir "mk" "build.mk" - - checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m) - => FilePath - -> Excepts - '[FileDoesNotExistError, InvalidBuildConfig] - m - () - checkBuildConfig bc = do - c <- liftIOException - doesNotExistErrorType - (FileDoesNotExistError bc) - (liftIO $ B.readFile bc) - let lines' = fmap T.strip . T.lines $ decUTF8Safe c - - -- for cross, we need Stage1Only - case targetGhc of - Left (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE - (InvalidBuildConfig - [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|] - ) - _ -> pure () - - forM_ buildFlavour $ \bf -> - when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do - lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|] - liftIO $ threadDelay 5000000 - - addBuildFlavourToConf bc = case buildFlavour of - Just bf -> [i|BuildFlavour = #{bf} -#{bc}|] - Nothing -> bc - - isCross :: GHCTargetVersion -> Bool - isCross = isJust . _tvTarget diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index a1366d7..bd803b2 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -31,8 +31,8 @@ import Data.String.Interpolate import Data.Text ( Text ) import Data.Versions import Haskus.Utils.Variant -import Text.PrettyPrint -import Text.PrettyPrint.HughesPJClass +import Text.PrettyPrint hiding ( (<>) ) +import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) import URI.ByteString @@ -240,6 +240,13 @@ instance Pretty NoNetwork where pPrint NoNetwork = text [i|A download was required or requested, but '--offline' was specified.|] +data HadrianNotFound = HadrianNotFound + deriving Show + +instance Pretty HadrianNotFound where + pPrint HadrianNotFound = + text [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|] + ------------------------- --[ High-level errors ]-- @@ -256,11 +263,11 @@ deriving instance Show DownloadFailed -- | A build failed. -data BuildFailed = forall es . Show (V es) => BuildFailed FilePath (V es) +data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FilePath (V es) instance Pretty BuildFailed where pPrint (BuildFailed path reason) = - text [i|BuildFailed failed in dir "#{path}": #{reason}|] + text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason deriving instance Show BuildFailed diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index b94b7e3..09ab375 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -78,6 +78,7 @@ import System.Win32.Console import System.Win32.File hiding ( copyFile ) import System.Win32.Types #endif +import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) import Text.Regex.Posix import URI.ByteString @@ -882,7 +883,7 @@ getChangeLog dls tool (Right tag) = -- -- 1. the build directory, depending on the KeepDirs setting -- 2. the install destination, depending on whether the build failed -runBuildAction :: (Show (V e), MonadReader env m, HasDirs env, HasSettings env, MonadIO m, MonadMask m) +runBuildAction :: (Pretty (V e), Show (V e), MonadReader env m, HasDirs env, HasSettings env, MonadIO m, MonadMask m) => FilePath -- ^ build directory (cleaned up depending on Settings) -> Maybe FilePath -- ^ dir to *always* clean up on exception -> Excepts e m a