From a4a7f73fb7ca55f81df29da65b02b3b5d14b95b5 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 20 Jul 2021 21:45:24 +0200 Subject: [PATCH] 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