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

updates Bindist functions as per https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/127#note_366702

Browse Source
This commit is contained in:
Arjun Kathuria 2021-07-26 11:49:52 +05:30
parent 5683493cae
commit e1bec789b0
1 changed files with 67 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
lib/GHCup.hs
View File

@ -204,14 +204,13 @@ installGHCBindist :: ( MonadFail m
() ()
installGHCBindist dlinfo ver isoFilepath = do installGHCBindist dlinfo ver isoFilepath = do
let tver = mkTVer ver let tver = mkTVer ver
let isIsolatedInstall = isJust isoFilepath
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
-- we only care for already installed errors in regular (non-isolated) installs case isoFilepath of
when (not isIsolatedInstall) $ -- we only care for already installed errors in regular (non-isolated) installs
whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
_ -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@ -219,21 +218,16 @@ installGHCBindist dlinfo ver isoFilepath = do
-- prepare paths -- prepare paths
ghcdir <- lift $ ghcupGHCDir tver ghcdir <- lift $ ghcupGHCDir tver
let isoDir = if isIsolatedInstall case isoFilepath of
then fromJust isoFilepath Just isoDir -> do -- isolated install
else mempty :: FilePath lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
Nothing -> do -- regular install
toolchainSanityChecks
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
if isIsolatedInstall -- make symlinks & stuff when regular install,
then do liftE $ postGHCInstall tver
lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
else do
toolchainSanityChecks
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
-- make symlinks & stuff when regular install,
-- don't make any for isolated installs.
whenM (pure $ not isIsolatedInstall) (liftE $ postGHCInstall tver)
where where
toolchainSanityChecks = do toolchainSanityChecks = do
@ -419,18 +413,18 @@ installCabalBindist dlinfo ver isoFilepath = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
let isIsolatedInstall = isJust isoFilepath case isoFilepath of
Nothing -> -- for regular install check if any previous versions installed
whenM
(lift (cabalInstalled ver) >>= \a -> liftIO $
handleIO (\_ -> pure False)
$ fmap (\x -> a && x)
-- ignore when the installation is a legacy cabal (binary, not symlink)
$ pathIsLink (binDir </> "cabal" <> exeExt)
)
(throwE $ AlreadyInstalled Cabal ver)
-- check if cabal already installed in regular (non-isolated) installs _ -> pure () -- check isn't required in isolated installs
when (not isIsolatedInstall) $
whenM
(lift (cabalInstalled ver) >>= \a -> liftIO $
handleIO (\_ -> pure False)
$ fmap (\x -> a && x)
-- ignore when the installation is a legacy cabal (binary, not symlink)
$ pathIsLink (binDir </> "cabal" <> exeExt)
)
(throwE $ AlreadyInstalled Cabal ver)
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@ -443,21 +437,18 @@ installCabalBindist dlinfo ver isoFilepath = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
let isoDir = fromJust isoFilepath case isoFilepath of
Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
liftE $ installCabalUnpacked workdir isoDir ver
if isIsolatedInstall Nothing -> do -- regular install
then do liftE $ installCabalUnpacked workdir binDir ver
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
liftE $ installCabalUnpacked workdir isoDir ver
else do
liftE $ installCabalUnpacked workdir binDir ver
-- create symlink if this is the latest version -- create symlink if this is the latest version for regular installs
-- not applicable for isolated installs cVers <- lift $ fmap rights getInstalledCabals
whenM (pure $ not isIsolatedInstall) $ do let lInstCabal = headMay . reverse . sort $ cVers
cVers <- lift $ fmap rights getInstalledCabals when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
let lInstCabal = headMay . reverse . sort $ cVers
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
-- | Install an unpacked cabal distribution. -- | Install an unpacked cabal distribution.
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
@ -552,12 +543,13 @@ installHLSBindist dlinfo ver isoFilepath = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
let isIsolatedInstall = isJust isoFilepath case isoFilepath of
Nothing ->
-- we only check for already installed in regular (non-isolated) installs
whenM (lift (hlsInstalled ver))
(throwE $ AlreadyInstalled HLS ver)
-- we only check for already installed in regular (non-isolated) installs _ -> pure ()
when (not isIsolatedInstall) $
whenM (lift (hlsInstalled ver))
(throwE $ AlreadyInstalled HLS ver)
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@ -569,20 +561,20 @@ installHLSBindist dlinfo ver isoFilepath = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
let isoDir = fromJust isoFilepath
if isIsolatedInstall case isoFilepath of
then do Just isoDir -> do
lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
liftE $ installHLSUnpacked workdir isoDir ver liftE $ installHLSUnpacked workdir isoDir ver
else do
liftE $ installHLSUnpacked workdir binDir ver Nothing -> do
liftE $ installHLSUnpacked workdir binDir ver
-- create symlink if this is the latest version in a regular install
hlsVers <- lift $ fmap rights getInstalledHLSs
let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
-- create symlink if this is the latest version in a regular install
whenM (pure $ not isIsolatedInstall) $ do
hlsVers <- lift $ fmap rights getInstalledHLSs
let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
-- | Install an unpacked hls distribution. -- | Install an unpacked hls distribution.
installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
@ -730,11 +722,12 @@ installStackBindist dlinfo ver isoFilepath = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
let isIsolatedInstall = isJust isoFilepath case isoFilepath of
Nothing -> -- check previous versions in case of regular installs
whenM (lift (stackInstalled ver))
(throwE $ AlreadyInstalled Stack ver)
when (not isIsolatedInstall) $ _ -> pure () -- don't do shit for isolates
whenM (lift (stackInstalled ver))
(throwE $ AlreadyInstalled Stack ver)
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@ -747,20 +740,17 @@ installStackBindist dlinfo ver isoFilepath = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
let isoDir = fromJust isoFilepath case isoFilepath of
Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
liftE $ installStackUnpacked workdir isoDir ver
Nothing -> do -- regular install
liftE $ installStackUnpacked workdir binDir ver
if isIsolatedInstall -- create symlink if this is the latest version and a regular install
then do sVers <- lift $ fmap rights getInstalledStacks
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] let lInstStack = headMay . reverse . sort $ sVers
liftE $ installStackUnpacked workdir isoDir ver when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
else do
liftE $ installStackUnpacked workdir binDir ver
-- create symlink if this is the latest version and a regular install
whenM (pure $ not isIsolatedInstall) $ do
sVers <- lift $ fmap rights getInstalledStacks
let lInstStack = headMay . reverse . sort $ sVers
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
-- | Install an unpacked stack distribution. -- | Install an unpacked stack distribution.