diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 7b284dd..0d6e6d6 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1688,19 +1688,26 @@ Report bugs at |] 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 4c04b41..50f30dd 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-\@ -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. installHLSBin :: ( MonadMask m