Compare commits
54 Commits
stack-fork
...
merge-requ
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
80eb72ce49 | ||
|
|
2c6d0382cf | ||
|
|
e1bec789b0 | ||
|
|
5683493cae | ||
|
|
ae5e213b59 | ||
|
|
911089f334 | ||
|
|
6b89646c1e | ||
|
|
960d5ce79f | ||
|
|
90ed0895d6 | ||
|
|
7471f4f4dc | ||
|
|
781cf8eed5 | ||
|
|
236da31af6 | ||
|
|
1f760af880 | ||
|
|
62d03b776b | ||
|
|
37ea18a0d8 | ||
|
|
083dc59a8f | ||
|
|
a45d069cad | ||
|
|
fdbcd4fafd | ||
|
|
f3c1c925ed | ||
|
|
8f6a7ba39c | ||
|
|
f212eb4570 | ||
|
|
0d118e2fe1 | ||
|
|
c0f46ef81f | ||
|
|
476513b0a7 | ||
|
|
9a511669a8 | ||
|
|
a16a25a3cd | ||
|
|
8666fcd120 | ||
|
|
521ab0aedb | ||
|
|
03d77f5006 | ||
|
|
71e6dbfdca | ||
|
|
692cd1616b | ||
|
|
4e3dbea5d0 | ||
|
|
fd2add78bd | ||
|
|
e9da8ab439 | ||
|
|
9c22ba9d45 | ||
|
|
e5d3080b54 | ||
|
|
5995a8b592 | ||
|
|
bc6d006c57 | ||
|
|
b148d8e2e7 | ||
|
|
4f7d41a8cc | ||
|
|
5efe2e5f7a | ||
|
|
338f5f309d | ||
|
|
ba51cbad6f | ||
|
|
511272e86d | ||
|
|
873f75da9f | ||
|
|
42d4a66493 | ||
|
|
9a79af6fd2 | ||
|
|
63f10a1871 | ||
|
|
9686ee9826 | ||
|
|
4729364e99 | ||
|
|
91d982c7b2 | ||
|
|
8b7c22440e | ||
|
|
9b3d55a095 | ||
|
|
e2daf5381c |
@@ -448,19 +448,19 @@ install' _ (_, ListResult {..}) = do
|
|||||||
case lTool of
|
case lTool of
|
||||||
GHC -> do
|
GHC -> do
|
||||||
let vi = getVersionInfo lVer GHC dls
|
let vi = getVersionInfo lVer GHC dls
|
||||||
liftE $ installGHCBin lVer $> vi
|
liftE $ installGHCBin lVer Nothing $> vi
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
let vi = getVersionInfo lVer Cabal dls
|
let vi = getVersionInfo lVer Cabal dls
|
||||||
liftE $ installCabalBin lVer $> vi
|
liftE $ installCabalBin lVer Nothing $> vi
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let vi = snd <$> getLatest dls GHCup
|
let vi = snd <$> getLatest dls GHCup
|
||||||
liftE $ upgradeGHCup Nothing False $> vi
|
liftE $ upgradeGHCup Nothing False $> vi
|
||||||
HLS -> do
|
HLS -> do
|
||||||
let vi = getVersionInfo lVer HLS dls
|
let vi = getVersionInfo lVer HLS dls
|
||||||
liftE $ installHLSBin lVer $> vi
|
liftE $ installHLSBin lVer Nothing $> vi
|
||||||
Stack -> do
|
Stack -> do
|
||||||
let vi = getVersionInfo lVer Stack dls
|
let vi = getVersionInfo lVer Stack dls
|
||||||
liftE $ installStackBin lVer $> vi
|
liftE $ installStackBin lVer Nothing $> vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
|
|||||||
@@ -138,6 +138,7 @@ data InstallOptions = InstallOptions
|
|||||||
, instPlatform :: Maybe PlatformRequest
|
, instPlatform :: Maybe PlatformRequest
|
||||||
, instBindist :: Maybe URI
|
, instBindist :: Maybe URI
|
||||||
, instSet :: Bool
|
, instSet :: Bool
|
||||||
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
}
|
||||||
|
|
||||||
data SetCommand = SetGHC SetOptions
|
data SetCommand = SetGHC SetOptions
|
||||||
@@ -185,6 +186,7 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, hadrian :: Bool
|
, hadrian :: Bool
|
||||||
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
}
|
||||||
|
|
||||||
data UpgradeOpts = UpgradeInplace
|
data UpgradeOpts = UpgradeInplace
|
||||||
@@ -574,7 +576,7 @@ Examples:
|
|||||||
|
|
||||||
installOpts :: Maybe Tool -> Parser InstallOptions
|
installOpts :: Maybe Tool -> Parser InstallOptions
|
||||||
installOpts tool =
|
installOpts tool =
|
||||||
(\p (u, v) b -> InstallOptions v p u b)
|
(\p (u, v) b is -> InstallOptions v p u b is)
|
||||||
<$> optional
|
<$> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader platformParser)
|
(eitherReader platformParser)
|
||||||
@@ -603,6 +605,15 @@ installOpts tool =
|
|||||||
(long "set" <> help
|
(long "set" <> help
|
||||||
"Set as active version after install"
|
"Set as active version after install"
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader isolateParser)
|
||||||
|
( short 'i'
|
||||||
|
<> long "isolate"
|
||||||
|
<> metavar "DIR"
|
||||||
|
<> help "install in an isolated dir instead of the default one"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
setParser :: Parser (Either SetCommand SetOptions)
|
setParser :: Parser (Either SetCommand SetOptions)
|
||||||
@@ -1000,6 +1011,15 @@ ghcCompileOpts =
|
|||||||
<*> switch
|
<*> switch
|
||||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader isolateParser)
|
||||||
|
( short 'i'
|
||||||
|
<> long "isolate"
|
||||||
|
<> metavar "DIR"
|
||||||
|
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
toolVersionParser :: Parser ToolVersion
|
toolVersionParser :: Parser ToolVersion
|
||||||
@@ -1215,6 +1235,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
|||||||
bindistParser :: String -> Either String URI
|
bindistParser :: String -> Either String URI
|
||||||
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
||||||
|
|
||||||
|
isolateParser :: FilePath -> Either String FilePath
|
||||||
|
isolateParser f = case isValid f of
|
||||||
|
True -> Right $ normalise f
|
||||||
|
False -> Left "Please enter a valid filepath for isolate dir."
|
||||||
|
|
||||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
toSettings :: Options -> IO (Settings, KeyBindings)
|
||||||
toSettings options = do
|
toSettings options = do
|
||||||
@@ -1617,22 +1641,23 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
-----------------------
|
-----------------------
|
||||||
|
|
||||||
let installGHC InstallOptions{..} =
|
let installGHC InstallOptions{..} =
|
||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
|
liftE $ installGHCBin (_tvVersion v) isolateDir
|
||||||
|
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||||
|
pure vi
|
||||||
|
Just uri -> do
|
||||||
|
s' <- liftIO appState
|
||||||
|
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
liftE $ installGHCBin (_tvVersion v)
|
liftE $ installGHCBindist
|
||||||
|
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||||
|
(_tvVersion v)
|
||||||
|
isolateDir
|
||||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
)
|
||||||
s' <- liftIO appState
|
|
||||||
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
|
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
|
||||||
liftE $ installGHCBindist
|
|
||||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
|
||||||
(_tvVersion v)
|
|
||||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
|
||||||
pure vi
|
|
||||||
)
|
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ $(logInfo) "GHC installation successful"
|
runLogger $ $(logInfo) "GHC installation successful"
|
||||||
@@ -1661,7 +1686,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||||
liftE $ installCabalBin (_tvVersion v)
|
liftE $ installCabalBin (_tvVersion v) isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
@@ -1670,6 +1695,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
liftE $ installCabalBindist
|
liftE $ installCabalBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri Nothing "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
|
isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
@@ -1689,10 +1715,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
let installHLS InstallOptions{..} =
|
let installHLS InstallOptions{..} =
|
||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||||
liftE $ installHLSBin (_tvVersion v)
|
liftE $ installHLSBin (_tvVersion v) isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
@@ -1701,6 +1727,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
liftE $ installHLSBindist
|
liftE $ installHLSBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri Nothing "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
|
isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
@@ -1720,19 +1747,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
pure $ ExitFailure 4
|
pure $ ExitFailure 4
|
||||||
|
|
||||||
let installStack InstallOptions{..} =
|
let installStack InstallOptions{..} =
|
||||||
(case instBindist of
|
(case instBindist of
|
||||||
Nothing -> runInstTool instPlatform $ do
|
Nothing -> runInstTool instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||||
liftE $ installStackBin (_tvVersion v)
|
liftE $ installStackBin (_tvVersion v) isolateDir
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
s' <- appState
|
s' <- appState
|
||||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||||
liftE $ installStackBindist
|
liftE $ installStackBindist
|
||||||
(DownloadInfo uri Nothing "")
|
(DownloadInfo uri Nothing "")
|
||||||
(_tvVersion v)
|
(_tvVersion v)
|
||||||
pure vi
|
isolateDir
|
||||||
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -1961,6 +1989,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
hadrian
|
||||||
|
isolateDir
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
|
|||||||
292
lib/GHCup.hs
292
lib/GHCup.hs
@@ -186,6 +186,7 @@ installGHCBindist :: ( MonadFail m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo -- ^ where/how to download
|
=> DownloadInfo -- ^ where/how to download
|
||||||
-> Version -- ^ the version to install
|
-> Version -- ^ the version to install
|
||||||
|
-> Maybe FilePath -- ^ isolated filepath if user passed any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -201,10 +202,15 @@ installGHCBindist :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBindist dlinfo ver = do
|
installGHCBindist dlinfo ver isoFilepath = do
|
||||||
let tver = mkTVer ver
|
let tver = mkTVer ver
|
||||||
|
|
||||||
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
|
||||||
whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
|
|
||||||
|
case isoFilepath of
|
||||||
|
-- we only care for already installed errors in regular (non-isolated) installs
|
||||||
|
Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -212,11 +218,16 @@ installGHCBindist dlinfo ver = do
|
|||||||
-- prepare paths
|
-- prepare paths
|
||||||
ghcdir <- lift $ ghcupGHCDir tver
|
ghcdir <- lift $ ghcupGHCDir tver
|
||||||
|
|
||||||
toolchainSanityChecks
|
case isoFilepath of
|
||||||
|
Just isoDir -> do -- isolated install
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
|
||||||
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
|
||||||
|
Nothing -> do -- regular install
|
||||||
|
toolchainSanityChecks
|
||||||
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
||||||
|
|
||||||
liftE $ postGHCInstall tver
|
-- make symlinks & stuff when regular install,
|
||||||
|
liftE $ postGHCInstall tver
|
||||||
|
|
||||||
where
|
where
|
||||||
toolchainSanityChecks = do
|
toolchainSanityChecks = do
|
||||||
@@ -343,6 +354,7 @@ installGHCBin :: ( MonadFail m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version -- ^ the version to install
|
=> Version -- ^ the version to install
|
||||||
|
-> Maybe FilePath -- ^ isolated install filepath, if user passed any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -358,9 +370,9 @@ installGHCBin :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBin ver = do
|
installGHCBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
dlinfo <- liftE $ getDownloadInfo GHC ver
|
||||||
installGHCBindist dlinfo ver
|
installGHCBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
|
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
|
||||||
@@ -379,6 +391,7 @@ installCabalBindist :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> Version
|
||||||
|
-> Maybe FilePath -- ^ isolated install filepath, if user provides any.
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -394,20 +407,24 @@ installCabalBindist :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installCabalBindist dlinfo ver = do
|
installCabalBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
whenM
|
case isoFilepath of
|
||||||
(lift (cabalInstalled ver) >>= \a -> liftIO $
|
Nothing -> -- for regular install check if any previous versions installed
|
||||||
handleIO (\_ -> pure False)
|
whenM
|
||||||
$ fmap (\x -> a && x)
|
(lift (cabalInstalled ver) >>= \a -> liftIO $
|
||||||
-- ignore when the installation is a legacy cabal (binary, not symlink)
|
handleIO (\_ -> pure False)
|
||||||
$ pathIsLink (binDir </> "cabal" <> exeExt)
|
$ fmap (\x -> a && x)
|
||||||
)
|
-- ignore when the installation is a legacy cabal (binary, not symlink)
|
||||||
(throwE $ AlreadyInstalled Cabal ver)
|
$ pathIsLink (binDir </> "cabal" <> exeExt)
|
||||||
|
)
|
||||||
|
(throwE $ AlreadyInstalled Cabal ver)
|
||||||
|
|
||||||
|
_ -> pure () -- check isn't required in isolated installs
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -420,30 +437,35 @@ installCabalBindist dlinfo ver = do
|
|||||||
-- the subdir of the archive where we do the work
|
-- the subdir of the archive where we do the work
|
||||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||||
|
|
||||||
liftE $ installCabal' workdir binDir
|
case isoFilepath of
|
||||||
|
Just isoDir -> do -- isolated install
|
||||||
|
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
|
||||||
|
liftE $ installCabalUnpacked workdir isoDir ver
|
||||||
|
|
||||||
-- create symlink if this is the latest version
|
Nothing -> do -- regular install
|
||||||
cVers <- lift $ fmap rights getInstalledCabals
|
liftE $ installCabalUnpacked workdir binDir ver
|
||||||
let lInstCabal = headMay . reverse . sort $ cVers
|
|
||||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
|
||||||
|
|
||||||
where
|
-- create symlink if this is the latest version for regular installs
|
||||||
-- | Install an unpacked cabal distribution.
|
cVers <- lift $ fmap rights getInstalledCabals
|
||||||
installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
|
let lInstCabal = headMay . reverse . sort $ cVers
|
||||||
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||||
-> FilePath -- ^ Path to install to
|
|
||||||
-> Excepts '[CopyError] m ()
|
|
||||||
installCabal' path inst = do
|
|
||||||
lift $ $(logInfo) "Installing cabal"
|
|
||||||
let cabalFile = "cabal"
|
|
||||||
liftIO $ createDirRecursive' inst
|
|
||||||
let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
|
||||||
let destPath = inst </> destFileName
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
|
||||||
(path </> cabalFile <> exeExt)
|
|
||||||
destPath
|
|
||||||
lift $ chmod_755 destPath
|
|
||||||
|
|
||||||
|
-- | Install an unpacked cabal distribution.
|
||||||
|
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
|
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Version
|
||||||
|
-> Excepts '[CopyError] m ()
|
||||||
|
installCabalUnpacked path inst ver = do
|
||||||
|
lift $ $(logInfo) "Installing cabal"
|
||||||
|
let cabalFile = "cabal"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
|
let destPath = inst </> destFileName
|
||||||
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> cabalFile <> exeExt)
|
||||||
|
destPath
|
||||||
|
lift $ chmod_755 destPath
|
||||||
|
|
||||||
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
|
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
|
||||||
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
|
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
|
||||||
@@ -462,6 +484,7 @@ installCabalBin :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> Maybe FilePath -- isolated install Path, if user provided any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -477,9 +500,9 @@ installCabalBin :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installCabalBin ver = do
|
installCabalBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
||||||
installCabalBindist dlinfo ver
|
installCabalBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
|
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
|
||||||
@@ -498,6 +521,7 @@ installHLSBindist :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> Version
|
||||||
|
-> Maybe FilePath -- ^ isolated install path, if user passed any
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -513,14 +537,19 @@ installHLSBindist :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installHLSBindist dlinfo ver = do
|
installHLSBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
|
lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
whenM (lift (hlsInstalled ver))
|
case isoFilepath of
|
||||||
(throwE $ AlreadyInstalled HLS ver)
|
Nothing ->
|
||||||
|
-- we only check for already installed in regular (non-isolated) installs
|
||||||
|
whenM (lift (hlsInstalled ver))
|
||||||
|
(throwE $ AlreadyInstalled HLS ver)
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -533,46 +562,52 @@ installHLSBindist dlinfo ver = do
|
|||||||
-- the subdir of the archive where we do the work
|
-- the subdir of the archive where we do the work
|
||||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||||
|
|
||||||
liftE $ installHLS' workdir binDir
|
case isoFilepath of
|
||||||
|
Just isoDir -> do
|
||||||
|
lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
|
||||||
|
liftE $ installHLSUnpacked workdir isoDir ver
|
||||||
|
|
||||||
-- create symlink if this is the latest version
|
Nothing -> do
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
liftE $ installHLSUnpacked workdir binDir ver
|
||||||
let lInstHLS = headMay . reverse . sort $ hlsVers
|
|
||||||
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
|
||||||
|
|
||||||
where
|
-- create symlink if this is the latest version in a regular install
|
||||||
-- | Install an unpacked hls distribution.
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
|
let lInstHLS = headMay . reverse . sort $ hlsVers
|
||||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
||||||
-> FilePath -- ^ Path to install to
|
|
||||||
-> Excepts '[CopyError] m ()
|
|
||||||
installHLS' path inst = do
|
|
||||||
lift $ $(logInfo) "Installing HLS"
|
|
||||||
liftIO $ createDirRecursive' inst
|
|
||||||
|
|
||||||
-- install haskell-language-server-<ghcver>
|
|
||||||
bins@(_:_) <- liftIO $ findFiles
|
|
||||||
path
|
|
||||||
(makeRegexOpts compExtended
|
|
||||||
execBlank
|
|
||||||
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
|
|
||||||
)
|
|
||||||
forM_ bins $ \f -> do
|
|
||||||
let toF = dropSuffix exeExt f
|
|
||||||
<> "~" <> T.unpack (prettyVer ver) <> exeExt
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
|
||||||
(path </> f)
|
|
||||||
(inst </> toF)
|
|
||||||
lift $ chmod_755 (inst </> toF)
|
|
||||||
|
|
||||||
-- install haskell-language-server-wrapper
|
-- | Install an unpacked hls distribution.
|
||||||
let wrapper = "haskell-language-server-wrapper"
|
installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Version
|
||||||
|
-> Excepts '[CopyError] m ()
|
||||||
|
installHLSUnpacked path inst ver = do
|
||||||
|
lift $ $(logInfo) "Installing HLS"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
|
||||||
|
-- install haskell-language-server-<ghcver>
|
||||||
|
bins@(_:_) <- liftIO $ findFiles
|
||||||
|
path
|
||||||
|
(makeRegexOpts compExtended
|
||||||
|
execBlank
|
||||||
|
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
|
||||||
|
)
|
||||||
|
forM_ bins $ \f -> do
|
||||||
|
let toF = dropSuffix exeExt f
|
||||||
|
<> "~" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
(path </> wrapper <> exeExt)
|
(path </> f)
|
||||||
(inst </> toF)
|
(inst </> toF)
|
||||||
lift $ chmod_755 (inst </> toF)
|
lift $ chmod_755 (inst </> toF)
|
||||||
|
|
||||||
|
-- install haskell-language-server-wrapper
|
||||||
|
let wrapper = "haskell-language-server-wrapper"
|
||||||
|
toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> wrapper <> exeExt)
|
||||||
|
(inst </> toF)
|
||||||
|
lift $ chmod_755 (inst </> toF)
|
||||||
|
|
||||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||||
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
||||||
@@ -590,6 +625,7 @@ installHLSBin :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -605,9 +641,9 @@ installHLSBin :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installHLSBin ver = do
|
installHLSBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo HLS ver
|
dlinfo <- liftE $ getDownloadInfo HLS ver
|
||||||
installHLSBindist dlinfo ver
|
installHLSBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
|
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
|
||||||
@@ -627,6 +663,7 @@ installStackBin :: ( MonadMask m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Version
|
=> Version
|
||||||
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -642,9 +679,9 @@ installStackBin :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installStackBin ver = do
|
installStackBin ver isoFilepath = do
|
||||||
dlinfo <- liftE $ getDownloadInfo Stack ver
|
dlinfo <- liftE $ getDownloadInfo Stack ver
|
||||||
installStackBindist dlinfo ver
|
installStackBindist dlinfo ver isoFilepath
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'installStackBin', except takes the 'DownloadInfo' as
|
-- | Like 'installStackBin', except takes the 'DownloadInfo' as
|
||||||
@@ -663,6 +700,7 @@ installStackBindist :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> Version
|
||||||
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, CopyError
|
, CopyError
|
||||||
@@ -678,14 +716,18 @@ installStackBindist :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installStackBindist dlinfo ver = do
|
installStackBindist dlinfo ver isoFilepath = do
|
||||||
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
|
lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
|
||||||
|
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
whenM (lift (stackInstalled ver))
|
case isoFilepath of
|
||||||
(throwE $ AlreadyInstalled Stack ver)
|
Nothing -> -- check previous versions in case of regular installs
|
||||||
|
whenM (lift (stackInstalled ver))
|
||||||
|
(throwE $ AlreadyInstalled Stack ver)
|
||||||
|
|
||||||
|
_ -> pure () -- don't do shit for isolates
|
||||||
|
|
||||||
-- download (or use cached version)
|
-- download (or use cached version)
|
||||||
dl <- liftE $ downloadCached dlinfo Nothing
|
dl <- liftE $ downloadCached dlinfo Nothing
|
||||||
@@ -698,31 +740,35 @@ installStackBindist dlinfo ver = do
|
|||||||
-- the subdir of the archive where we do the work
|
-- the subdir of the archive where we do the work
|
||||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||||
|
|
||||||
liftE $ installStack' workdir binDir
|
case isoFilepath of
|
||||||
|
Just isoDir -> do -- isolated install
|
||||||
|
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
|
||||||
|
liftE $ installStackUnpacked workdir isoDir ver
|
||||||
|
Nothing -> do -- regular install
|
||||||
|
liftE $ installStackUnpacked workdir binDir ver
|
||||||
|
|
||||||
-- create symlink if this is the latest version
|
-- create symlink if this is the latest version and a regular install
|
||||||
sVers <- lift $ fmap rights getInstalledStacks
|
sVers <- lift $ fmap rights getInstalledStacks
|
||||||
let lInstStack = headMay . reverse . sort $ sVers
|
let lInstStack = headMay . reverse . sort $ sVers
|
||||||
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
|
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
|
||||||
|
|
||||||
where
|
|
||||||
-- | Install an unpacked stack distribution.
|
|
||||||
installStack' :: (MonadLogger m, MonadCatch m, MonadIO m)
|
|
||||||
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
|
||||||
-> FilePath -- ^ Path to install to
|
|
||||||
-> Excepts '[CopyError] m ()
|
|
||||||
installStack' path inst = do
|
|
||||||
lift $ $(logInfo) "Installing stack"
|
|
||||||
let stackFile = "stack"
|
|
||||||
liftIO $ createDirRecursive' inst
|
|
||||||
let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
|
||||||
let destPath = inst </> destFileName
|
|
||||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
|
||||||
(path </> stackFile <> exeExt)
|
|
||||||
destPath
|
|
||||||
lift $ chmod_755 destPath
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | Install an unpacked stack distribution.
|
||||||
|
installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
|
||||||
|
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
|
||||||
|
-> FilePath -- ^ Path to install to
|
||||||
|
-> Version
|
||||||
|
-> Excepts '[CopyError] m ()
|
||||||
|
installStackUnpacked path inst ver = do
|
||||||
|
lift $ $(logInfo) "Installing stack"
|
||||||
|
let stackFile = "stack"
|
||||||
|
liftIO $ createDirRecursive' inst
|
||||||
|
let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
||||||
|
let destPath = inst </> destFileName
|
||||||
|
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||||
|
(path </> stackFile <> exeExt)
|
||||||
|
destPath
|
||||||
|
lift $ chmod_755 destPath
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
@@ -1704,6 +1750,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Bool
|
||||||
|
-> Maybe FilePath -- ^ isolate dir
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
@@ -1722,7 +1769,7 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian
|
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
@@ -1792,12 +1839,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
|
||||||
when alreadyInstalled $ do
|
when alreadyInstalled $ do
|
||||||
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
case isolateDir of
|
||||||
|
Just isoDir ->
|
||||||
|
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
|
||||||
|
Nothing ->
|
||||||
|
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
|
||||||
lift $ $(logWarn)
|
lift $ $(logWarn)
|
||||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
ghcdir <- lift $ ghcupGHCDir installVer
|
ghcdir <- case isolateDir of
|
||||||
|
Just isoDir -> pure isoDir
|
||||||
|
Nothing -> lift $ ghcupGHCDir installVer
|
||||||
|
|
||||||
bghc <- case bstrap of
|
bghc <- case bstrap of
|
||||||
Right g -> pure $ Right g
|
Right g -> pure $ Right g
|
||||||
@@ -1814,9 +1867,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
pure (b, bmk)
|
pure (b, bmk)
|
||||||
)
|
)
|
||||||
|
|
||||||
when alreadyInstalled $ do
|
case isolateDir of
|
||||||
lift $ $(logInfo) [i|Deleting existing installation|]
|
Nothing ->
|
||||||
liftE $ rmGHCVer tver
|
-- only remove old ghc in regular installs
|
||||||
|
when alreadyInstalled $ do
|
||||||
|
lift $ $(logInfo) [i|Deleting existing installation|]
|
||||||
|
liftE $ rmGHCVer tver
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
forM_ mBindist $ \bindist -> do
|
forM_ mBindist $ \bindist -> do
|
||||||
liftE $ installPackedGHC bindist
|
liftE $ installPackedGHC bindist
|
||||||
@@ -1825,11 +1883,15 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
|||||||
(tver ^. tvVersion)
|
(tver ^. tvVersion)
|
||||||
|
|
||||||
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||||
|
|
||||||
reThrowAll GHCupSetError $ postGHCInstall tver
|
case isolateDir of
|
||||||
|
-- set and make symlinks for regular (non-isolated) installs
|
||||||
-- restore
|
Nothing -> do
|
||||||
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
reThrowAll GHCupSetError $ postGHCInstall tver
|
||||||
|
-- restore
|
||||||
|
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
|
||||||
|
|
||||||
|
_ -> pure ()
|
||||||
|
|
||||||
pure tver
|
pure tver
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user