Adds isolated install to HLS installs
This commit is contained in:
parent
0d118e2fe1
commit
f212eb4570
@ -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
|
||||
|
56
lib/GHCup.hs
56
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
|
||||
|
Loading…
Reference in New Issue
Block a user