Allow to specify full path to bootstrap GHC

This commit is contained in:
Julian Ospald 2020-04-08 22:17:39 +02:00
parent 3e52def226
commit 8a0236a350
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 53 additions and 35 deletions

View File

@ -108,7 +108,7 @@ data CompileCommand = CompileGHC CompileOptions
data CompileOptions = CompileOptions data CompileOptions = CompileOptions
{ targetVer :: Version { targetVer :: Version
, bootstrapVer :: Version , bootstrapGhc :: Either Version (Path Abs)
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe (Path Abs) , buildConfig :: Maybe (Path Abs)
} }
@ -310,12 +310,16 @@ compileOpts =
) )
<*> (option <*> (option
(eitherReader (eitherReader
(bimap (const "Not a valid version") id . version . T.pack) (\x ->
(bimap (const "Not a valid version") Left . version . T.pack $ x)
<|> (bimap show Right . parseAbs . E.encodeUtf8 . T.pack $ x)
)
) )
( short 'b' ( short 'b'
<> long "bootstrap-version" <> long "bootstrap-ghc"
<> metavar "BOOTSTRAP_VERSION" <> metavar "BOOTSTRAP_GHC"
<> help "The GHC version to bootstrap with (must be installed)" <> help
"The GHC version (or full path) to bootstrap with (must be installed)"
) )
) )
<*> optional <*> optional
@ -694,7 +698,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
void void
$ (runCompileGHC $ do $ (runCompileGHC $ do
liftE liftE
$ compileGHC dls targetVer bootstrapVer jobs buildConfig $ compileGHC dls targetVer bootstrapGhc jobs buildConfig
) )
>>= \case >>= \case
VRight _ -> VRight _ ->
@ -715,7 +719,7 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues
Compile (CompileCabal CompileOptions {..}) -> Compile (CompileCabal CompileOptions {..}) ->
void void
$ (runCompileCabal $ do $ (runCompileCabal $ do
liftE $ compileCabal dls targetVer bootstrapVer jobs liftE $ compileCabal dls targetVer bootstrapGhc jobs
) )
>>= \case >>= \case
VRight _ -> VRight _ ->

View File

@ -431,10 +431,10 @@ compileGHC :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> GHCupDownloads => GHCupDownloads
-> Version -- ^ version to install -> Version -- ^ version to install
-> Version -- ^ version to bootstrap with -> Either Version (Path Abs) -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
-> Maybe (Path Abs) -- ^ build config -> Maybe (Path Abs) -- ^ build config
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
@ -446,8 +446,8 @@ compileGHC :: ( MonadMask m
] ]
m m
() ()
compileGHC dls tver bver jobs mbuildConfig = do compileGHC dls tver bstrap jobs mbuildConfig = do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bver}|] lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
whenM (liftIO $ toolAlreadyInstalled GHC tver) whenM (liftIO $ toolAlreadyInstalled GHC tver)
(throwE $ AlreadyInstalled GHC tver) (throwE $ AlreadyInstalled GHC tver)
@ -459,7 +459,9 @@ compileGHC dls tver bver jobs mbuildConfig = do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
bghc <- parseRel ("ghc-" <> verToBS bver) bghc <- case bstrap of
Right g -> pure $ Right g
Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver)
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
ghcdir <- liftIO $ ghcupGHCDir tver ghcdir <- liftIO $ ghcupGHCDir tver
@ -491,7 +493,7 @@ HADDOCK_DOCS = YES
GhcWithLlvmCodeGen = YES|] GhcWithLlvmCodeGen = YES|]
compile :: (MonadCatch m, MonadLogger m, MonadIO m) compile :: (MonadCatch m, MonadLogger m, MonadIO m)
=> Path Rel => Either (Path Rel) (Path Abs)
-> Path Abs -> Path Abs
-> Path Abs -> Path Abs
-> Excepts -> Excepts
@ -506,8 +508,11 @@ GhcWithLlvmCodeGen = YES|]
if if
| tver >= [vver|8.8.0|] -> do | tver >= [vver|8.8.0|] -> do
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath bghcPath <- case bghc of
bghcPath <- (liftIO $ searchPath spaths bghc) !? NoDownload Right ghc' -> pure ghc'
Left bver -> do
spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
(liftIO $ searchPath spaths bver) !? NoDownload
lEM $ liftIO $ execLogged lEM $ liftIO $ execLogged
"./configure" "./configure"
False False
@ -519,7 +524,9 @@ GhcWithLlvmCodeGen = YES|]
lEM $ liftIO $ execLogged lEM $ liftIO $ execLogged
"./configure" "./configure"
False False
["--prefix=" <> toFilePath ghcdir, "--with-ghc=" <> toFilePath bghc] [ "--prefix=" <> toFilePath ghcdir
, "--with-ghc=" <> either toFilePath toFilePath bghc
]
[rel|ghc-conf|] [rel|ghc-conf|]
(Just workdir) (Just workdir)
(Just newEnv) (Just newEnv)
@ -532,9 +539,7 @@ GhcWithLlvmCodeGen = YES|]
Nothing -> Nothing ->
liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
lift lift $ $(logInfo) [i|Building (this may take a while)...|]
$ $(logInfo)
[i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/ghc-make.log' to see the progress.|]
lEM $ liftIO $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) lEM $ liftIO $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
(Just workdir) (Just workdir)
@ -556,7 +561,7 @@ compileCabal :: ( MonadReader Settings m
) )
=> GHCupDownloads => GHCupDownloads
-> Version -- ^ version to install -> Version -- ^ version to install
-> Version -- ^ GHC version to build with -> Either Version (Path Abs) -- ^ version to bootstrap with
-> Maybe Int -> Maybe Int
-> Excepts -> Excepts
'[ BuildFailed '[ BuildFailed
@ -567,8 +572,8 @@ compileCabal :: ( MonadReader Settings m
] ]
m m
() ()
compileCabal dls tver bver jobs = do compileCabal dls tver bghc jobs = do
lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bver}|] lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
-- download source tarball -- download source tarball
dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload
@ -588,22 +593,31 @@ compileCabal dls tver bver jobs = do
pure () pure ()
where where
compile :: (MonadLogger m, MonadIO m) compile :: (MonadThrow m, MonadLogger m, MonadIO m)
=> Path Abs => Path Abs
-> Excepts '[ProcessError] m () -> Excepts '[ProcessError] m ()
compile workdir = do compile workdir = do
lift lift $ $(logInfo) [i|Building (this may take a while)...|]
$ $(logInfo)
[i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/cabal-bootstrap.log' to see the progress.|] ghcEnv <- case bghc of
Right path -> do
-- recover the version from /foo/ghc-6.5.4
bn <- basename path
let dn = toFilePath $ dirname path
let ver = snd . B.break (== _hyphen) . toFilePath $ bn
pure
[ ("GHC" , toFilePath path)
, ("GHC_PKG", dn <> "/" <> "ghc-pkg" <> ver)
]
Left bver -> do
let v' = verToBS bver
pure [("GHC", "ghc-" <> v'), ("GHC_PKG", "ghc-pkg-" <> v')]
let v' = verToBS bver
cabal_bin <- liftIO $ ghcupBinDir cabal_bin <- liftIO $ ghcupBinDir
newEnv <- lift $ addToCurrentEnv newEnv <- lift
[ ("GHC" , "ghc-" <> v') $ addToCurrentEnv (("PREFIX", toFilePath cabal_bin) : ghcEnv)
, ("GHC_PKG", "ghc-pkg-" <> v') lift $ $(logDebug) [i|Environment: #{newEnv}|]
, ("GHC_VER", v')
, ("PREFIX" , toFilePath cabal_bin)
]
lEM $ liftIO $ execLogged "./bootstrap.sh" lEM $ liftIO $ execLogged "./bootstrap.sh"
False False