diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index dd9f92f2dbe7ba84bf193e8115ea2298ae2ddde5..cc40748c4bdcc65ad0250e80146248e46191ac1e 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 0000000000000000000000000000000000000000..192e70e85f1a7a60e9aa862354f4d01159075161
--- /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 fdfc6ed0297f1722ae96fa7ac048e01be04a3890..f5aefcd6424f1d0a7ddda3b9c9c0a031eded0e68 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 <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
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 <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
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 09e18a036be7f4cb4f45dd5aff8fae7fdc5a605a..f348f10db91ea4e66bf3286ea134a57797a3650c 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,71 +1824,94 @@ 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|]
-
- Dirs {..} <- lift getDirs
- pfreq <- lift getPlatformReq
-
- forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
+ 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
- cEnv <- liftIO getEnvironment
+ 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")
- if | _tvVersion tver >= [vver|8.8.0|] -> do
- bghcPath <- case bghc of
- Right ghc' -> pure ghc'
- Left bver -> do
- spaths <- liftIO getSearchPath
- liftIO (searchPath spaths bver) !? NotFoundInPATH bver
- lEM $ execLogged
- "sh"
- ("./configure" : maybe mempty
- (\x -> ["--target=" <> T.unpack x])
- (_tvTarget tver)
- ++ ["--prefix=" <> ghcdir]
-#if defined(IS_WINDOWS)
- ++ ["--enable-tarballs-autodownload"]
-#endif
- ++ fmap T.unpack aargs
- )
- (Just workdir)
- "ghc-conf"
- (Just (("GHC", bghcPath) : cEnv))
- | otherwise -> do
- lEM $ execLogged
- "sh"
- ( [ "./configure", "--with-ghc=" <> either id id bghc
- ]
- ++ maybe mempty
- (\x -> ["--target=" <> T.unpack x])
- (_tvTarget tver)
- ++ ["--prefix=" <> ghcdir]
+ findHadrianFile :: (MonadIO m)
+ => FilePath
+ -> Excepts
+ '[HadrianNotFound]
+ m
+ FilePath
+ findHadrianFile workdir = do
#if defined(IS_WINDOWS)
- ++ ["--enable-tarballs-autodownload"]
+ let possible_files = ((workdir </> "hadrian") </>) <$> ["build.bat"]
+#else
+ let possible_files = ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
#endif
- ++ fmap T.unpack aargs
- )
- (Just workdir)
- "ghc-conf"
- (Just cEnv)
+ 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
@@ -1913,25 +1939,46 @@ endif|]
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
+ 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
+
checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
=> FilePath
-> Excepts
@@ -1959,14 +2006,87 @@ endif|]
liftIO $ threadDelay 5000000
addBuildFlavourToConf bc = case buildFlavour of
- Just bf -> [i|BuildFlavour = #{bf}
-#{bc}|]
+ 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
+
+ if | _tvVersion tver >= [vver|8.8.0|] -> do
+ bghcPath <- case bghc of
+ Right ghc' -> pure ghc'
+ Left bver -> do
+ spaths <- liftIO getSearchPath
+ liftIO (searchPath spaths bver) !? NotFoundInPATH bver
+ lEM $ execLogged
+ "sh"
+ ("./configure" : maybe mempty
+ (\x -> ["--target=" <> T.unpack x])
+ (_tvTarget tver)
+ ++ ["--prefix=" <> ghcdir]
+#if defined(IS_WINDOWS)
+ ++ ["--enable-tarballs-autodownload"]
+#endif
+ ++ fmap T.unpack aargs
+ )
+ (Just workdir)
+ "ghc-conf"
+ (Just (("GHC", bghcPath) : cEnv))
+ | otherwise -> do
+ lEM $ execLogged
+ "sh"
+ ( [ "./configure", "--with-ghc=" <> either id id bghc
+ ]
+ ++ maybe mempty
+ (\x -> ["--target=" <> T.unpack x])
+ (_tvTarget tver)
+ ++ ["--prefix=" <> ghcdir]
+#if defined(IS_WINDOWS)
+ ++ ["--enable-tarballs-autodownload"]
+#endif
+ ++ fmap T.unpack aargs
+ )
+ (Just workdir)
+ "ghc-conf"
+ (Just cEnv)
+ pure ()
+
+
+
+
---------------------
diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs
index a1366d7be7c4acbdee64a6d71e61e04e7105ddc8..bd803b258194efac3a1354eb8fb87e967050fe61 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 b94b7e331a874f4a226dc12f33ce3d2c70e696df..09ab375ea0d717fea8ac2f84ad52e03021bb7959 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