diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 0d6e6d6..0e0f26f 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1726,19 +1726,26 @@ Report bugs at |] pure $ ExitFailure 4 let installStack InstallOptions{..} = - (case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Stack - liftE $ installStackBin (_tvVersion v) - 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 isolateDir of + Just isoDir -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + let stackVersion = (_tvVersion v) + liftE $ installStackBinIsolated isoDir stackVersion + pure vi + Nothing -> + case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + liftE $ installStackBin (_tvVersion v) + 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 VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index d9f8509..559fcef 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -873,6 +873,60 @@ installStack' path inst ver = do 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 ]--