From 511272e86d0725237332a9701779e0056169e460 Mon Sep 17 00:00:00 2001
From: Arjun Kathuria <arjun.kathuria8@gmail.com>
Date: Fri, 23 Jul 2021 16:46:11 +0530
Subject: [PATCH] Adds isolated installs to Stack install

---
 app/ghcup/Main.hs | 33 +++++++++++++++++------------
 lib/GHCup.hs      | 54 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 74 insertions(+), 13 deletions(-)

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 <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           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 ]--