hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix `--overwrite-version for ghcup compile ghc

Browse Source 
Fixes #253
This commit is contained in:
Julian Ospald 2021-09-29 22:33:17 +02:00
parent b8907335ba
commit 0af7aaef3c
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lib/GHCup.hs
View File

@ -2189,13 +2189,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
let installVer = maybe tver (\ov' -> tver { _tvVersion = ov' }) ov let installVer = maybe tver (\ov' -> tver { _tvVersion = ov' }) ov
alreadyInstalled <- lift $ ghcInstalled installVer alreadyInstalled <- lift $ ghcInstalled installVer
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver) alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
when alreadyInstalled $ do when alreadyInstalled $ do
case isolateDir of case isolateDir of
Just isoDir -> Just isoDir ->
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Isolate installing to " <> T.pack isoDir
Nothing -> Nothing ->
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version." lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " 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
@ -2220,7 +2221,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
-- only remove old ghc in regular installs -- only remove old ghc in regular installs
when alreadyInstalled $ do when alreadyInstalled $ do
lift $ logInfo "Deleting existing installation" lift $ logInfo "Deleting existing installation"
liftE $ rmGHCVer tver liftE $ rmGHCVer installVer
_ -> pure () _ -> pure ()
@ -2228,7 +2229,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
liftE $ installPackedGHC bindist liftE $ installPackedGHC bindist
(Just $ RegexDir "ghc-.*") (Just $ RegexDir "ghc-.*")
ghcdir ghcdir
(tver ^. tvVersion) (installVer ^. tvVersion)
False -- not a force install, since we already overwrite when compiling. False -- not a force install, since we already overwrite when compiling.
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
@ -2236,13 +2237,13 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
case isolateDir of case isolateDir of
-- set and make symlinks for regular (non-isolated) installs -- set and make symlinks for regular (non-isolated) installs
Nothing -> do Nothing -> do
reThrowAll GHCupSetError $ postGHCInstall tver reThrowAll GHCupSetError $ postGHCInstall installVer
-- restore -- restore
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly
_ -> pure () _ -> pure ()
pure tver pure installVer
where where
defaultConf = defaultConf =