From f212eb457082eba1bb4ca7da4a708ab896812dd9 Mon Sep 17 00:00:00 2001
From: Arjun Kathuria <arjun.kathuria8@gmail.com>
Date: Fri, 23 Jul 2021 16:25:01 +0530
Subject: [PATCH] Adds isolated install to HLS installs

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

diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index 37921fb..f56064a 100644
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -1718,19 +1718,26 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           pure $ ExitFailure 4
 
           let installHLS InstallOptions{..} =
-                (case instBindist of
-                   Nothing -> runInstTool instPlatform $ do
-                     (v, vi) <- liftE $ fromVersion instVer HLS
-                     liftE $ installHLSBin (_tvVersion v)
-                     pure vi
-                   Just uri -> do
-                     s' <- appState
-                     runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
-                       (v, vi) <- liftE $ fromVersion instVer HLS
-                       liftE $ installHLSBindist
-                           (DownloadInfo uri Nothing "")
-                           (_tvVersion v)
-                       pure vi
+                (case isolateDir of
+                  Just isoDir -> runInstTool instPlatform $ do
+                         (v, vi) <- liftE $ fromVersion instVer HLS
+                         let hlsVersion = (_tvVersion v)
+                         liftE $ installHLSBinIsolated isoDir hlsVersion
+                         pure vi
+                  Nothing ->
+                    case instBindist of
+                       Nothing -> runInstTool instPlatform $ do
+                         (v, vi) <- liftE $ fromVersion instVer HLS
+                         liftE $ installHLSBin (_tvVersion v)
+                         pure vi
+                       Just uri -> do
+                         s' <- appState
+                         runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
+                           (v, vi) <- liftE $ fromVersion instVer HLS
+                           liftE $ installHLSBindist
+                               (DownloadInfo uri Nothing "")
+                               (_tvVersion v)
+                           pure vi
                   )
                   >>= \case
                         VRight vi -> do
diff --git a/lib/GHCup.hs b/lib/GHCup.hs
index b34a76d..4e3b9d9 100644
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -667,6 +667,62 @@ installHLS' path inst ver = do
     (inst </> toF)
   lift $ chmod_755 (inst </> toF)
 
+-- | Installs hls binaries in an isolated location provided by user,
+-- doesn't make any symlinks
+
+installHLSBinIsolated :: ( MonadMask m
+                         , MonadCatch m
+                         , MonadReader env m
+                         , HasPlatformReq env
+                         , HasGHCupInfo env
+                         , HasDirs env
+                         , HasSettings 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
+                           ()
+installHLSBinIsolated isoDir ver = do
+  dlinfo <- liftE $ getDownloadInfo HLS ver
+
+  lift $ $(logDebug) [i|Requested to install hls 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 HLS to #{isoDir}|]
+
+  liftE $ installHLS' workdir isoDir ver
+
+
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
 installHLSBin :: ( MonadMask m