Adds isolated installs to Stack install

This commit is contained in:
Arjun Kathuria 2021-07-23 16:46:11 +05:30
parent 873f75da9f
commit 511272e86d
2 changed files with 74 additions and 13 deletions

View File

@ -1726,19 +1726,26 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 4 pure $ ExitFailure 4
let installStack InstallOptions{..} = let installStack InstallOptions{..} =
(case instBindist of (case isolateDir of
Nothing -> runInstTool instPlatform $ do Just isoDir -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBin (_tvVersion v) let stackVersion = (_tvVersion v)
pure vi liftE $ installStackBinIsolated isoDir stackVersion
Just uri -> do pure vi
s' <- appState Nothing ->
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do case instBindist of
(v, vi) <- liftE $ fromVersion instVer Stack Nothing -> runInstTool instPlatform $ do
liftE $ installStackBindist (v, vi) <- liftE $ fromVersion instVer Stack
(DownloadInfo uri Nothing "") liftE $ installStackBin (_tvVersion v)
(_tvVersion v) pure vi
pure vi Just uri -> do
s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
pure vi
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do

View File

@ -873,6 +873,60 @@ installStack' path inst ver = do
lift $ chmod_755 destPath lift $ chmod_755 destPath
-- | Installs stack into an isolated location sepcified by the user,
-- also, doesn't make any symlinks.
installStackBinIsolated :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> FilePath
-> Version
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installStackBinIsolated isoDir ver = do
dlinfo <- liftE $ getDownloadInfo Stack ver
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
PlatformRequest {_rPlatform} <- lift getPlatformReq
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ lift $ darwinNotarization _rPlatform tmpUnpack
-- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
liftE $ installStack' workdir isoDir ver
--------------------- ---------------------
--[ Set GHC/cabal ]-- --[ Set GHC/cabal ]--