adds isolate install feature to compiled ghc command
This commit is contained in:
parent
e1bec789b0
commit
2c6d0382cf
@ -186,6 +186,7 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, hadrian :: Bool
|
, hadrian :: Bool
|
||||||
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
}
|
||||||
|
|
||||||
data UpgradeOpts = UpgradeInplace
|
data UpgradeOpts = UpgradeInplace
|
||||||
@ -1010,6 +1011,15 @@ ghcCompileOpts =
|
|||||||
<*> switch
|
<*> switch
|
||||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader isolateParser)
|
||||||
|
( short 'i'
|
||||||
|
<> long "isolate"
|
||||||
|
<> metavar "DIR"
|
||||||
|
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
toolVersionParser :: Parser ToolVersion
|
toolVersionParser :: Parser ToolVersion
|
||||||
@ -1979,6 +1989,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
hadrian
|
||||||
|
isolateDir
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
|
38
lib/GHCup.hs
38
lib/GHCup.hs
@ -1750,6 +1750,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Bool
|
||||||
|
-> Maybe FilePath -- ^ isolate dir
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@ -1768,7 +1769,7 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian
|
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
@ -1838,12 +1839,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
||||||
when alreadyInstalled $ do
|
when alreadyInstalled $ do
|
||||||
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
case isolateDir of
|
||||||
|
Just isoDir ->
|
||||||
|
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
|
||||||
|
Nothing ->
|
||||||
|
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
||||||
lift $ $(logWarn)
|
lift $ $(logWarn)
|
||||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
ghcdir <- lift $ ghcupGHCDir installVer
|
ghcdir <- case isolateDir of
|
||||||
|
Just isoDir -> pure isoDir
|
||||||
|
Nothing -> lift $ ghcupGHCDir installVer
|
||||||
|
|
||||||
bghc <- case bstrap of
|
bghc <- case bstrap of
|
||||||
Right g -> pure $ Right g
|
Right g -> pure $ Right g
|
||||||
@ -1860,9 +1867,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
pure (b, bmk)
|
pure (b, bmk)
|
||||||
)
|
)
|
||||||
|
|
||||||
when alreadyInstalled $ do
|
case isolateDir of
|
||||||
lift $ $(logInfo) [i|Deleting existing installation|]
|
Nothing ->
|
||||||
liftE $ rmGHCVer tver
|
-- only remove old ghc in regular installs
|
||||||
|
when alreadyInstalled $ do
|
||||||
|
lift $ $(logInfo) [i|Deleting existing installation|]
|
||||||
|
liftE $ rmGHCVer tver
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
forM_ mBindist $ \bindist -> do
|
forM_ mBindist $ \bindist -> do
|
||||||
liftE $ installPackedGHC bindist
|
liftE $ installPackedGHC bindist
|
||||||
@ -1871,11 +1883,15 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
(tver ^. tvVersion)
|
(tver ^. tvVersion)
|
||||||
|
|
||||||
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||||
|
|
||||||
reThrowAll GHCupSetError $ postGHCInstall tver
|
case isolateDir of
|
||||||
|
-- set and make symlinks for regular (non-isolated) installs
|
||||||
-- restore
|
Nothing -> do
|
||||||
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
reThrowAll GHCupSetError $ postGHCInstall tver
|
||||||
|
-- restore
|
||||||
|
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
pure tver
|
pure tver
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user