Merge branch 'isolateDir'
This commit is contained in:
commit
f7811961b5
GPG Key ID:
3786C5262ECB4A3F
@ -176,6 +176,8 @@ else
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
|
||||
ls -lah "$GHCUP_BIN"
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
eghcup install hls
|
||||
$(eghcup whereis hls) --version
|
||||
|
||||
@ -2,6 +2,9 @@
|
||||
|
||||
## 0.1.17.8 -- XXXX-XX-XX
|
||||
|
||||
* Fix HLS build not cleaning up properly on failed installations, fixes [#361](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/361)
|
||||
- this also fixes a significant bug on installation failure when combining `--isolate DIR` with `--force`
|
||||
* Fix parsing of symlinks with multiple slashes, wrt [#353](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/353)
|
||||
* Re-enable upgrade functionality for all configurations wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/250)
|
||||
|
||||
## 0.1.17.7 -- 2022-04-21
|
||||
|
||||
@ -447,19 +447,19 @@ install' _ (_, ListResult {..}) = do
|
||||
case lTool of
|
||||
GHC -> do
|
||||
let vi = getVersionInfo lVer GHC dls
|
||||
liftE $ installGHCBin lVer Nothing False $> (vi, dirs, ce)
|
||||
liftE $ installGHCBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
Cabal -> do
|
||||
let vi = getVersionInfo lVer Cabal dls
|
||||
liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
|
||||
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)
|
||||
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
Stack -> do
|
||||
let vi = getVersionInfo lVer Stack dls
|
||||
liftE $ installStackBin lVer Nothing False $> (vi, dirs, ce)
|
||||
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, Dirs{..}, Just ce) -> do
|
||||
|
||||
@ -469,7 +469,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
ghcs
|
||||
jobs
|
||||
ovewrwiteVer
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
cabalProject
|
||||
cabalProjectLocal
|
||||
patches
|
||||
@ -524,7 +524,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
addConfArgs
|
||||
buildFlavour
|
||||
hadrian
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||
when setCompile $ void $ liftE $
|
||||
|
||||
@ -395,7 +395,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
void $ liftE $ sequenceE (installGHCBin
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
)
|
||||
$ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
|
||||
@ -406,7 +406,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
void $ liftE $ sequenceE (installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
)
|
||||
$ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
|
||||
@ -467,7 +467,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
void $ liftE $ sequenceE (installCabalBin
|
||||
v
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
|
||||
pure vi
|
||||
@ -477,7 +477,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
void $ liftE $ sequenceE (installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
v
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
|
||||
pure vi
|
||||
@ -518,7 +518,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||
void $ liftE $ sequenceE (installHLSBin
|
||||
v
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
|
||||
pure vi
|
||||
@ -529,7 +529,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
void $ liftE $ sequenceE (installHLSBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
|
||||
v
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
|
||||
pure vi
|
||||
@ -578,7 +578,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||
void $ liftE $ sequenceE (installStackBin
|
||||
v
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
|
||||
pure vi
|
||||
@ -588,7 +588,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
void $ liftE $ sequenceE (installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
v
|
||||
isolateDir
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
|
||||
pure vi
|
||||
|
||||
@ -351,25 +351,25 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
Just (GHC, v) -> do
|
||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
GHCupInternal
|
||||
False
|
||||
setTool GHC v tmp
|
||||
Just (Cabal, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
GHCupInternal
|
||||
False
|
||||
setTool Cabal v tmp
|
||||
Just (Stack, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
GHCupInternal
|
||||
False
|
||||
setTool Stack v tmp
|
||||
Just (HLS, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
GHCupInternal
|
||||
False
|
||||
setTool HLS v tmp
|
||||
_ -> pure ()
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17.7
|
||||
version: 0.1.17.8
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
|
||||
238
lib/GHCup.hs
238
lib/GHCup.hs
@ -187,7 +187,7 @@ installGHCBindist :: ( MonadFail m
|
||||
)
|
||||
=> DownloadInfo -- ^ where/how to download
|
||||
-> Version -- ^ the version to install
|
||||
-> Maybe FilePath -- ^ isolated filepath if user passed any
|
||||
-> InstallDir
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -205,7 +205,7 @@ installGHCBindist :: ( MonadFail m
|
||||
]
|
||||
m
|
||||
()
|
||||
installGHCBindist dlinfo ver isoFilepath forceInstall = do
|
||||
installGHCBindist dlinfo ver installDir forceInstall = do
|
||||
let tver = mkTVer ver
|
||||
|
||||
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
|
||||
@ -215,12 +215,12 @@ installGHCBindist dlinfo ver isoFilepath forceInstall = do
|
||||
if
|
||||
| not forceInstall
|
||||
, regularGHCInstalled
|
||||
, Nothing <- isoFilepath -> do
|
||||
, GHCupInternal <- installDir -> do
|
||||
throwE $ AlreadyInstalled GHC ver
|
||||
|
||||
| forceInstall
|
||||
, regularGHCInstalled
|
||||
, Nothing <- isoFilepath -> do
|
||||
, GHCupInternal <- installDir -> do
|
||||
lift $ logInfo "Removing the currently installed GHC version first!"
|
||||
liftE $ rmGHCVer tver
|
||||
|
||||
@ -229,17 +229,18 @@ installGHCBindist dlinfo ver isoFilepath forceInstall = do
|
||||
-- download (or use cached version)
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
|
||||
-- prepare paths
|
||||
ghcdir <- lift $ ghcupGHCDir tver
|
||||
|
||||
toolchainSanityChecks
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do -- isolated install
|
||||
case installDir of
|
||||
IsolateDir isoDir -> do -- isolated install
|
||||
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver forceInstall
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver forceInstall
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall
|
||||
GHCupInternal -> do -- regular install
|
||||
-- prepare paths
|
||||
ghcdir <- lift $ ghcupGHCDir tver
|
||||
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall
|
||||
|
||||
-- make symlinks & stuff when regular install,
|
||||
liftE $ postGHCInstall tver
|
||||
@ -271,7 +272,7 @@ installPackedGHC :: ( MonadMask m
|
||||
)
|
||||
=> FilePath -- ^ Path to the packed GHC bindist
|
||||
-> Maybe TarDir -- ^ Subdir of the archive
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> InstallDirResolved
|
||||
-> Version -- ^ The GHC version
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts
|
||||
@ -299,7 +300,11 @@ installPackedGHC dl msubdir inst ver forceInstall = do
|
||||
msubdir
|
||||
|
||||
liftE $ runBuildAction tmpUnpack
|
||||
(Just inst)
|
||||
(case inst of
|
||||
IsolateDirResolved _ -> Nothing -- don't clean up for isolated installs, since that'd potentially delete other
|
||||
-- user files if '--force' is supplied
|
||||
GHCupDir d -> Just d
|
||||
)
|
||||
(installUnpackedGHC workdir inst ver)
|
||||
|
||||
|
||||
@ -316,10 +321,10 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
, MonadMask m
|
||||
)
|
||||
=> FilePath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> InstallDirResolved -- ^ Path to install to
|
||||
-> Version -- ^ The GHC version
|
||||
-> Excepts '[ProcessError] m ()
|
||||
installUnpackedGHC path inst ver
|
||||
installUnpackedGHC path (fromInstallDir -> inst) ver
|
||||
| isWindows = do
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
-- Windows bindists are relocatable and don't need
|
||||
@ -369,7 +374,7 @@ installGHCBin :: ( MonadFail m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version -- ^ the version to install
|
||||
-> Maybe FilePath -- ^ isolated install filepath, if user passed any
|
||||
-> InstallDir
|
||||
-> Bool -- ^ force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -387,9 +392,9 @@ installGHCBin :: ( MonadFail m
|
||||
]
|
||||
m
|
||||
()
|
||||
installGHCBin ver isoFilepath forceInstall = do
|
||||
installGHCBin ver installDir forceInstall = do
|
||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
||||
liftE $ installGHCBindist dlinfo ver isoFilepath forceInstall
|
||||
liftE $ installGHCBindist dlinfo ver installDir forceInstall
|
||||
|
||||
|
||||
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
|
||||
@ -408,7 +413,7 @@ installCabalBindist :: ( MonadMask m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Version
|
||||
-> Maybe FilePath -- ^ isolated install filepath, if user provides any.
|
||||
-> InstallDir
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -425,7 +430,7 @@ installCabalBindist :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
()
|
||||
installCabalBindist dlinfo ver isoFilepath forceInstall = do
|
||||
installCabalBindist dlinfo ver installDir forceInstall = do
|
||||
lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
@ -437,12 +442,12 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
|
||||
if
|
||||
| not forceInstall
|
||||
, regularCabalInstalled
|
||||
, Nothing <- isoFilepath -> do
|
||||
, GHCupInternal <- installDir -> do
|
||||
throwE $ AlreadyInstalled Cabal ver
|
||||
|
||||
| forceInstall
|
||||
, regularCabalInstalled
|
||||
, Nothing <- isoFilepath -> do
|
||||
, GHCupInternal <- installDir -> do
|
||||
lift $ logInfo "Removing the currently installed version first!"
|
||||
liftE $ rmCabalVer ver
|
||||
|
||||
@ -460,30 +465,33 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
|
||||
-- the subdir of the archive where we do the work
|
||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do -- isolated install
|
||||
case installDir of
|
||||
IsolateDir isoDir -> do -- isolated install
|
||||
lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
|
||||
liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall
|
||||
liftE $ installCabalUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
|
||||
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
|
||||
GHCupInternal -> do -- regular install
|
||||
liftE $ installCabalUnpacked workdir (GHCupDir binDir) ver forceInstall
|
||||
|
||||
|
||||
-- | Install an unpacked cabal distribution.Symbol
|
||||
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
|
||||
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> InstallDirResolved -- ^ Path to install to
|
||||
-> Version
|
||||
-> Bool -- ^ Force Install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installCabalUnpacked path inst mver' forceInstall = do
|
||||
installCabalUnpacked path inst ver forceInstall = do
|
||||
lift $ logInfo "Installing cabal"
|
||||
let cabalFile = "cabal"
|
||||
liftIO $ createDirRecursive' inst
|
||||
liftIO $ createDirRecursive' (fromInstallDir inst)
|
||||
let destFileName = cabalFile
|
||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||
<> (case inst of
|
||||
IsolateDirResolved _ -> ""
|
||||
GHCupDir _ -> ("-" <>) . T.unpack . prettyVer $ ver
|
||||
)
|
||||
<> exeExt
|
||||
let destPath = inst </> destFileName
|
||||
let destPath = fromInstallDir inst </> destFileName
|
||||
|
||||
unless forceInstall -- Overwrite it when it IS a force install
|
||||
(liftE $ throwIfFileAlreadyExists destPath)
|
||||
@ -510,7 +518,7 @@ installCabalBin :: ( MonadMask m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Version
|
||||
-> Maybe FilePath -- isolated install Path, if user provided any
|
||||
-> InstallDir
|
||||
-> Bool -- force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -527,9 +535,9 @@ installCabalBin :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
()
|
||||
installCabalBin ver isoFilepath forceInstall = do
|
||||
installCabalBin ver installDir forceInstall = do
|
||||
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
||||
installCabalBindist dlinfo ver isoFilepath forceInstall
|
||||
installCabalBindist dlinfo ver installDir forceInstall
|
||||
|
||||
|
||||
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
|
||||
@ -548,7 +556,7 @@ installHLSBindist :: ( MonadMask m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Version
|
||||
-> Maybe FilePath -- ^ isolated install path, if user passed any
|
||||
-> InstallDir -- ^ isolated install path, if user passed any
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -567,7 +575,7 @@ installHLSBindist :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
()
|
||||
installHLSBindist dlinfo ver isoFilepath forceInstall = do
|
||||
installHLSBindist dlinfo ver installDir forceInstall = do
|
||||
lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
@ -578,12 +586,12 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
|
||||
if
|
||||
| not forceInstall
|
||||
, regularHLSInstalled
|
||||
, Nothing <- isoFilepath -> do -- regular install
|
||||
, GHCupInternal <- installDir -> do -- regular install
|
||||
throwE $ AlreadyInstalled HLS ver
|
||||
|
||||
| forceInstall
|
||||
, regularHLSInstalled
|
||||
, Nothing <- isoFilepath -> do -- regular forced install
|
||||
, GHCupInternal <- installDir -> do -- regular forced install
|
||||
lift $ logInfo "Removing the currently installed version of HLS before force installing!"
|
||||
liftE $ rmHLSVer ver
|
||||
|
||||
@ -604,22 +612,23 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
|
||||
if
|
||||
| not forceInstall
|
||||
, not legacy
|
||||
, (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp
|
||||
, (IsolateDir fp) <- installDir -> liftE $ installDestSanityCheck (IsolateDirResolved fp)
|
||||
| otherwise -> pure ()
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do
|
||||
case installDir of
|
||||
IsolateDir isoDir -> do
|
||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||
if legacy
|
||||
then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall
|
||||
else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir isoDir ver
|
||||
then liftE $ installHLSUnpackedLegacy workdir (IsolateDirResolved isoDir) ver forceInstall
|
||||
else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir (IsolateDirResolved isoDir) ver
|
||||
|
||||
Nothing -> do
|
||||
GHCupInternal -> do
|
||||
if legacy
|
||||
then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall
|
||||
then liftE $ installHLSUnpackedLegacy workdir (GHCupDir binDir) ver forceInstall
|
||||
else do
|
||||
inst <- ghcupHLSDir ver
|
||||
liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
|
||||
liftE $ runBuildAction tmpUnpack (Just inst)
|
||||
$ installHLSUnpacked workdir (GHCupDir inst) ver
|
||||
liftE $ setHLS ver SetHLS_XYZ Nothing
|
||||
|
||||
|
||||
@ -631,10 +640,10 @@ isLegacyHLSBindist path = do
|
||||
-- | Install an unpacked hls distribution.
|
||||
installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
|
||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> InstallDirResolved -- ^ Path to install to
|
||||
-> Version
|
||||
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
|
||||
installHLSUnpacked path inst _ = do
|
||||
installHLSUnpacked path (fromInstallDir -> inst) _ = do
|
||||
lift $ logInfo "Installing HLS"
|
||||
liftIO $ createDirRecursive' inst
|
||||
lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
|
||||
@ -642,13 +651,13 @@ installHLSUnpacked path inst _ = do
|
||||
-- | Install an unpacked hls distribution (legacy).
|
||||
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> InstallDirResolved -- ^ Path to install to
|
||||
-> Version
|
||||
-> Bool -- ^ is it a force install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installHLSUnpackedLegacy path inst mver' forceInstall = do
|
||||
installHLSUnpackedLegacy path installDir ver forceInstall = do
|
||||
lift $ logInfo "Installing HLS"
|
||||
liftIO $ createDirRecursive' inst
|
||||
liftIO $ createDirRecursive' (fromInstallDir installDir)
|
||||
|
||||
-- install haskell-language-server-<ghcver>
|
||||
bins@(_:_) <- liftIO $ findFiles
|
||||
@ -659,11 +668,14 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
|
||||
)
|
||||
forM_ bins $ \f -> do
|
||||
let toF = dropSuffix exeExt f
|
||||
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
|
||||
<> (case installDir of
|
||||
IsolateDirResolved _ -> ""
|
||||
GHCupDir _ -> ("~" <>) . T.unpack . prettyVer $ ver
|
||||
)
|
||||
<> exeExt
|
||||
|
||||
let srcPath = path </> f
|
||||
let destPath = inst </> toF
|
||||
let destPath = fromInstallDir installDir </> toF
|
||||
|
||||
unless forceInstall -- if it is a force install, overwrite it.
|
||||
(liftE $ throwIfFileAlreadyExists destPath)
|
||||
@ -676,10 +688,13 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
|
||||
-- install haskell-language-server-wrapper
|
||||
let wrapper = "haskell-language-server-wrapper"
|
||||
toF = wrapper
|
||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||
<> (case installDir of
|
||||
IsolateDirResolved _ -> ""
|
||||
GHCupDir _ -> ("-" <>) . T.unpack . prettyVer $ ver
|
||||
)
|
||||
<> exeExt
|
||||
srcWrapperPath = path </> wrapper <> exeExt
|
||||
destWrapperPath = inst </> toF
|
||||
destWrapperPath = fromInstallDir installDir </> toF
|
||||
|
||||
unless forceInstall
|
||||
(liftE $ throwIfFileAlreadyExists destWrapperPath)
|
||||
@ -708,7 +723,7 @@ installHLSBin :: ( MonadMask m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Version
|
||||
-> Maybe FilePath -- isolated install Dir (if any)
|
||||
-> InstallDir
|
||||
-> Bool -- force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -727,9 +742,9 @@ installHLSBin :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
()
|
||||
installHLSBin ver isoFilepath forceInstall = do
|
||||
installHLSBin ver installDir forceInstall = do
|
||||
dlinfo <- liftE $ getDownloadInfo HLS ver
|
||||
installHLSBindist dlinfo ver isoFilepath forceInstall
|
||||
installHLSBindist dlinfo ver installDir forceInstall
|
||||
|
||||
|
||||
compileHLS :: ( MonadMask m
|
||||
@ -749,7 +764,7 @@ compileHLS :: ( MonadMask m
|
||||
-> [Version]
|
||||
-> Maybe Int
|
||||
-> Maybe Version
|
||||
-> Maybe FilePath
|
||||
-> InstallDir
|
||||
-> Maybe (Either FilePath URI)
|
||||
-> Maybe URI
|
||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||
@ -764,7 +779,7 @@ compileHLS :: ( MonadMask m
|
||||
, BuildFailed
|
||||
, NotInstalled
|
||||
] m Version
|
||||
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patches cabalArgs = do
|
||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
Dirs { .. } <- lift getDirs
|
||||
@ -837,8 +852,8 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
workdir
|
||||
Nothing
|
||||
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
|
||||
let installDir = workdir </> "out"
|
||||
liftIO $ createDirRecursive' installDir
|
||||
let tmpInstallDir = workdir </> "out"
|
||||
liftIO $ createDirRecursive' tmpInstallDir
|
||||
|
||||
-- apply patches
|
||||
liftE $ applyAnyPatch patches workdir
|
||||
@ -861,8 +876,8 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
|
||||
copyFileE cpl (workdir </> cp <.> "local")
|
||||
artifacts <- forM (sort ghcs) $ \ghc -> do
|
||||
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
|
||||
liftIO $ createDirRecursive' installDir
|
||||
let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
|
||||
liftIO $ createDirRecursive' tmpInstallDir
|
||||
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
|
||||
liftE $ lEM @_ @'[ProcessError] $
|
||||
execLogged "cabal" ( [ "v2-install"
|
||||
@ -885,17 +900,17 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
|
||||
forM_ artifacts $ \artifact -> do
|
||||
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
|
||||
(installDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
|
||||
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
|
||||
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
|
||||
(installDir </> "haskell-language-server-wrapper" <.> exeExt)
|
||||
(tmpInstallDir </> "haskell-language-server-wrapper" <.> exeExt)
|
||||
liftIO $ rmPathForcibly artifact
|
||||
|
||||
case isolateDir of
|
||||
Just isoDir -> do
|
||||
case installDir of
|
||||
IsolateDir isoDir -> do
|
||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||
liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
|
||||
Nothing -> do
|
||||
liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
|
||||
liftE $ installHLSUnpackedLegacy tmpInstallDir (IsolateDirResolved isoDir) installVer True
|
||||
GHCupInternal -> do
|
||||
liftE $ installHLSUnpackedLegacy tmpInstallDir (GHCupDir binDir) installVer True
|
||||
)
|
||||
|
||||
pure installVer
|
||||
@ -919,7 +934,7 @@ installStackBin :: ( MonadMask m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Version
|
||||
-> Maybe FilePath -- ^ isolate install Dir (if any)
|
||||
-> InstallDir
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -936,9 +951,9 @@ installStackBin :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
()
|
||||
installStackBin ver isoFilepath forceInstall = do
|
||||
installStackBin ver installDir forceInstall = do
|
||||
dlinfo <- liftE $ getDownloadInfo Stack ver
|
||||
installStackBindist dlinfo ver isoFilepath forceInstall
|
||||
installStackBindist dlinfo ver installDir forceInstall
|
||||
|
||||
|
||||
-- | Like 'installStackBin', except takes the 'DownloadInfo' as
|
||||
@ -957,7 +972,7 @@ installStackBindist :: ( MonadMask m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Version
|
||||
-> Maybe FilePath -- ^ isolate install Dir (if any)
|
||||
-> InstallDir
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@ -974,7 +989,7 @@ installStackBindist :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
()
|
||||
installStackBindist dlinfo ver isoFilepath forceInstall = do
|
||||
installStackBindist dlinfo ver installDir forceInstall = do
|
||||
lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
|
||||
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
@ -985,12 +1000,12 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
|
||||
if
|
||||
| not forceInstall
|
||||
, regularStackInstalled
|
||||
, Nothing <- isoFilepath -> do
|
||||
, GHCupInternal <- installDir -> do
|
||||
throwE $ AlreadyInstalled Stack ver
|
||||
|
||||
| forceInstall
|
||||
, regularStackInstalled
|
||||
, Nothing <- isoFilepath -> do
|
||||
, GHCupInternal <- installDir -> do
|
||||
lift $ logInfo "Removing the currently installed version of Stack first!"
|
||||
liftE $ rmStackVer ver
|
||||
|
||||
@ -1007,29 +1022,32 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
|
||||
-- the subdir of the archive where we do the work
|
||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do -- isolated install
|
||||
case installDir of
|
||||
IsolateDir isoDir -> do -- isolated install
|
||||
lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
|
||||
liftE $ installStackUnpacked workdir isoDir Nothing forceInstall
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
|
||||
liftE $ installStackUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
|
||||
GHCupInternal -> do -- regular install
|
||||
liftE $ installStackUnpacked workdir (GHCupDir binDir) ver forceInstall
|
||||
|
||||
|
||||
-- | Install an unpacked stack distribution.
|
||||
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
|
||||
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Maybe Version -- ^ Nothing for isolated installs
|
||||
-> InstallDirResolved
|
||||
-> Version
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installStackUnpacked path inst mver' forceInstall = do
|
||||
installStackUnpacked path installDir ver forceInstall = do
|
||||
lift $ logInfo "Installing stack"
|
||||
let stackFile = "stack"
|
||||
liftIO $ createDirRecursive' inst
|
||||
liftIO $ createDirRecursive' (fromInstallDir installDir)
|
||||
let destFileName = stackFile
|
||||
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
|
||||
<> (case installDir of
|
||||
IsolateDirResolved _ -> ""
|
||||
GHCupDir _ -> ("-" <>) . T.unpack . prettyVer $ ver
|
||||
)
|
||||
<> exeExt
|
||||
destPath = inst </> destFileName
|
||||
destPath = fromInstallDir installDir </> destFileName
|
||||
|
||||
unless forceInstall
|
||||
(liftE $ throwIfFileAlreadyExists destPath)
|
||||
@ -1223,7 +1241,7 @@ setHLS :: ( MonadReader env m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
-> SetHLS -- Nothing for legacy
|
||||
-> SetHLS
|
||||
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
|
||||
-- and don't want mess with other versions
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
@ -2121,7 +2139,7 @@ compileGHC :: ( MonadMask m
|
||||
-> [Text] -- ^ additional args to ./configure
|
||||
-> Maybe String -- ^ build flavour
|
||||
-> Bool
|
||||
-> Maybe FilePath -- ^ isolate dir
|
||||
-> InstallDir
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
@ -2146,7 +2164,7 @@ compileGHC :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
GHCTargetVersion
|
||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir
|
||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
|
||||
= do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
@ -2219,18 +2237,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||
|
||||
when alreadyInstalled $ do
|
||||
case isolateDir of
|
||||
Just isoDir ->
|
||||
case installDir of
|
||||
IsolateDir isoDir ->
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Isolate installing to " <> T.pack isoDir
|
||||
Nothing ->
|
||||
GHCupInternal ->
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Will overwrite existing version."
|
||||
lift $ logWarn
|
||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||
|
||||
ghcdir <- case isolateDir of
|
||||
Just isoDir -> pure isoDir
|
||||
Nothing -> lift $ ghcupGHCDir installVer
|
||||
ghcdir <- case installDir of
|
||||
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
||||
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
||||
|
||||
(mBindist, bmk) <- liftE $ runBuildAction
|
||||
tmpUnpack
|
||||
@ -2243,8 +2261,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
pure (b, bmk)
|
||||
)
|
||||
|
||||
case isolateDir of
|
||||
Nothing ->
|
||||
case installDir of
|
||||
GHCupInternal ->
|
||||
-- only remove old ghc in regular installs
|
||||
when alreadyInstalled $ do
|
||||
lift $ logInfo "Deleting existing installation"
|
||||
@ -2259,11 +2277,11 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
(installVer ^. tvVersion)
|
||||
False -- not a force install, since we already overwrite when compiling.
|
||||
|
||||
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||
|
||||
case isolateDir of
|
||||
case installDir of
|
||||
-- set and make symlinks for regular (non-isolated) installs
|
||||
Nothing -> do
|
||||
GHCupInternal -> do
|
||||
reThrowAll GHCupSetError $ postGHCInstall installVer
|
||||
-- restore
|
||||
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing
|
||||
@ -2292,7 +2310,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> InstallDirResolved
|
||||
-> Excepts
|
||||
'[ FileDoesNotExistError
|
||||
, HadrianNotFound
|
||||
@ -2351,7 +2369,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> InstallDirResolved
|
||||
-> Excepts
|
||||
'[ FileDoesNotExistError
|
||||
, HadrianNotFound
|
||||
@ -2486,7 +2504,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath
|
||||
-> FilePath
|
||||
-> InstallDirResolved
|
||||
-> Excepts
|
||||
'[ FileDoesNotExistError
|
||||
, InvalidBuildConfig
|
||||
@ -2497,7 +2515,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
]
|
||||
m
|
||||
()
|
||||
configureBindist tver workdir ghcdir = do
|
||||
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
||||
lift $ logInfo [s|configuring build|]
|
||||
|
||||
if | _tvVersion tver >= [vver|8.8.0|] -> do
|
||||
|
||||
@ -628,3 +628,16 @@ data CapturedProcess = CapturedProcess
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''CapturedProcess
|
||||
|
||||
|
||||
data InstallDir = IsolateDir FilePath
|
||||
| GHCupInternal
|
||||
deriving (Eq, Show)
|
||||
|
||||
data InstallDirResolved = IsolateDirResolved FilePath
|
||||
| GHCupDir FilePath
|
||||
deriving (Eq, Show)
|
||||
|
||||
fromInstallDir :: InstallDirResolved -> FilePath
|
||||
fromInstallDir (IsolateDirResolved fp) = fp
|
||||
fromInstallDir (GHCupDir fp) = fp
|
||||
|
||||
@ -1265,9 +1265,10 @@ ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
|
||||
installDestSanityCheck :: ( MonadIO m
|
||||
, MonadCatch m
|
||||
) =>
|
||||
FilePath ->
|
||||
InstallDirResolved ->
|
||||
Excepts '[DirNotEmpty] m ()
|
||||
installDestSanityCheck isoDir = do
|
||||
installDestSanityCheck (IsolateDirResolved isoDir) = do
|
||||
hideErrorDef [doesNotExistErrorType] () $ do
|
||||
contents <- liftIO $ getDirectoryContentsRecursive isoDir
|
||||
unless (null contents) (throwE $ DirNotEmpty isoDir)
|
||||
installDestSanityCheck _ = pure ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user