Allow to compile over existing version, fixes #59
This commit is contained in:
parent
59ece98fdc
commit
a269131e2d
@ -992,6 +992,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
, PatchFailed
|
, PatchFailed
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
|
, NotInstalled
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
|
12
lib/GHCup.hs
12
lib/GHCup.hs
@ -807,6 +807,7 @@ compileGHC :: ( MonadMask m
|
|||||||
, PatchFailed
|
, PatchFailed
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
|
, NotInstalled
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
@ -816,8 +817,9 @@ compileGHC :: ( MonadMask m
|
|||||||
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformRequest {..})
|
compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformRequest {..})
|
||||||
= do
|
= do
|
||||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
|
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
|
||||||
whenM (lift $ ghcInstalled tver)
|
|
||||||
(throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
|
alreadyInstalled <- lift $ ghcInstalled tver
|
||||||
|
alreadySet <- fmap (maybe False (==tver)) $ lift $ ghcSet (_tvTarget tver)
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
@ -847,6 +849,9 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformReque
|
|||||||
pure (b, bmk)
|
pure (b, bmk)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
when alreadyInstalled $ do
|
||||||
|
lift $ $(logInfo) [i|Deleting existing installation|]
|
||||||
|
liftE $ rmGHCVer tver
|
||||||
liftE $ installPackedGHC bindist
|
liftE $ installPackedGHC bindist
|
||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
ghcdir
|
ghcdir
|
||||||
@ -856,6 +861,9 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@(PlatformReque
|
|||||||
liftIO $ writeFile (ghcdir </> ghcUpSrcBuiltFile) (Just newFilePerms) bmk
|
liftIO $ writeFile (ghcdir </> ghcUpSrcBuiltFile) (Just newFilePerms) bmk
|
||||||
|
|
||||||
reThrowAll GHCupSetError $ postGHCInstall tver
|
reThrowAll GHCupSetError $ postGHCInstall tver
|
||||||
|
|
||||||
|
-- restore
|
||||||
|
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
where
|
where
|
||||||
|
@ -596,8 +596,8 @@ getChangeLog dls tool (Right tag) =
|
|||||||
-- 1. the build directory, depending on the KeepDirs setting
|
-- 1. the build directory, depending on the KeepDirs setting
|
||||||
-- 2. the install destination, depending on whether the build failed
|
-- 2. the install destination, depending on whether the build failed
|
||||||
runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m)
|
runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m)
|
||||||
=> Path Abs -- ^ build directory
|
=> Path Abs -- ^ build directory (cleaned up depending on Settings)
|
||||||
-> Maybe (Path Abs) -- ^ install location (e.g. for GHC)
|
-> Maybe (Path Abs) -- ^ dir to *always* clean up on exception
|
||||||
-> Excepts e m a
|
-> Excepts e m a
|
||||||
-> Excepts '[BuildFailed] m a
|
-> Excepts '[BuildFailed] m a
|
||||||
runBuildAction bdir instdir action = do
|
runBuildAction bdir instdir action = do
|
||||||
|
Loading…
Reference in New Issue
Block a user