Compare commits
23 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 2de549862a | |||
| c502f70f68 | |||
| cbf076740a | |||
| 86c144b285 | |||
| 7ec6e8604c | |||
| de70f4820f | |||
|
|
febe6fcb35 | ||
|
|
3055529d4c | ||
|
|
d276bfb3ec | ||
| 9db0664465 | |||
| e9c727647a | |||
| 55eef8a3d3 | |||
| d07ad3eb26 | |||
|
|
ad53b141c7 | ||
|
|
23c13a07a9 | ||
|
|
a186b07763 | ||
|
|
1ca628aba1 | ||
| 8f4ef48891 | |||
|
|
d852ab3415 | ||
| a1bcc4b51f | |||
| be93a98bd4 | |||
| 85054d9c76 | |||
| 6c95218daf |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -1,3 +1,6 @@
|
||||
.ghci
|
||||
.vim
|
||||
codex.tags
|
||||
dist-newstyle/
|
||||
cabal.project.local
|
||||
.stack-work/
|
||||
|
||||
@@ -2,7 +2,7 @@ variables:
|
||||
GIT_SSL_NO_VERIFY: "1"
|
||||
|
||||
# Commit of ghc/ci-images repository from which to pull Docker images
|
||||
DOCKER_REV: cefaee3c742af193e0f7783f87edb0d35374515c
|
||||
DOCKER_REV: 1ac7f435c9312f10422a82d304194778378e2a1a
|
||||
|
||||
############################################################
|
||||
# CI Step
|
||||
|
||||
@@ -26,5 +26,6 @@ fi
|
||||
mkdir out
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
ver=$(./ghcup --numeric-version)
|
||||
strip -s ./ghcup
|
||||
cp ghcup out/${ARTIFACT}-${ver}
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
#/bin/sh
|
||||
#!/bin/sh
|
||||
|
||||
set -ex
|
||||
|
||||
@@ -19,4 +19,6 @@ ghcup set 8.8.3
|
||||
|
||||
cabal update
|
||||
cabal build --constraint="zlib static" --constraint="lzma static"
|
||||
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" "./${ARTIFACT}"
|
||||
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
strip -s ghcup
|
||||
cp ghcup "./${ARTIFACT}"
|
||||
|
||||
@@ -47,16 +47,16 @@ Common use cases are:
|
||||
ghcup list
|
||||
|
||||
# install the recommended GHC version
|
||||
ghcup install
|
||||
ghcup install ghc
|
||||
|
||||
# install a specific GHC version
|
||||
ghcup install 8.2.2
|
||||
ghcup install ghc 8.2.2
|
||||
|
||||
# set the currently "active" GHC version
|
||||
ghcup set 8.4.4
|
||||
ghcup set ghc 8.4.4
|
||||
|
||||
# install cabal-install
|
||||
ghcup install-cabal
|
||||
ghcup install cabal
|
||||
|
||||
# update ghcup itself
|
||||
ghcup upgrade
|
||||
|
||||
@@ -23,6 +23,7 @@ import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Version
|
||||
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
@@ -53,7 +54,7 @@ import System.Console.Pretty
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO hiding ( appendFile )
|
||||
import Text.Read
|
||||
import Text.Read hiding ( lift )
|
||||
import Text.Layout.Table
|
||||
import URI.ByteString
|
||||
|
||||
@@ -82,11 +83,11 @@ data Options = Options
|
||||
}
|
||||
|
||||
data Command
|
||||
= Install InstallOptions
|
||||
| InstallCabal InstallOptions
|
||||
| SetGHC SetGHCOptions
|
||||
= Install (Either InstallCommand InstallOptions)
|
||||
| InstallCabalLegacy InstallOptions
|
||||
| Set (Either SetCommand SetOptions)
|
||||
| List ListOptions
|
||||
| Rm RmOptions
|
||||
| Rm (Either RmCommand RmOptions)
|
||||
| DInfo
|
||||
| Compile CompileCommand
|
||||
| Upgrade UpgradeOpts Bool
|
||||
@@ -101,13 +102,19 @@ prettyToolVer (ToolVersion v') = T.unpack $ prettyTVer v'
|
||||
prettyToolVer (ToolTag t) = show t
|
||||
|
||||
|
||||
data InstallCommand = InstallGHC InstallOptions
|
||||
| InstallCabal InstallOptions
|
||||
|
||||
data InstallOptions = InstallOptions
|
||||
{ instVer :: Maybe ToolVersion
|
||||
, instPlatform :: Maybe PlatformRequest
|
||||
}
|
||||
|
||||
data SetGHCOptions = SetGHCOptions
|
||||
{ ghcVer :: Maybe ToolVersion
|
||||
data SetCommand = SetGHC SetOptions
|
||||
| SetCabal SetOptions
|
||||
|
||||
data SetOptions = SetOptions
|
||||
{ sToolVer :: Maybe ToolVersion
|
||||
}
|
||||
|
||||
data ListOptions = ListOptions
|
||||
@@ -116,6 +123,9 @@ data ListOptions = ListOptions
|
||||
, lRawFormat :: Bool
|
||||
}
|
||||
|
||||
data RmCommand = RmGHC RmOptions
|
||||
| RmCabal Version
|
||||
|
||||
data RmOptions = RmOptions
|
||||
{ ghcVer :: GHCTargetVersion
|
||||
}
|
||||
@@ -213,44 +223,38 @@ com =
|
||||
subparser
|
||||
( command
|
||||
"install"
|
||||
((info
|
||||
((Install <$> installOpts) <**> helper)
|
||||
( progDesc "Install or update GHC"
|
||||
<> footerDoc (Just $ text installFooter)
|
||||
)
|
||||
)
|
||||
( Install
|
||||
<$> (info
|
||||
(installParser <**> helper)
|
||||
( progDesc "Install or update GHC/cabal"
|
||||
<> footerDoc (Just $ text installToolFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"set"
|
||||
( SetGHC
|
||||
<$> (info
|
||||
(setGHCOpts <**> helper)
|
||||
( progDesc "Set currently active GHC version"
|
||||
<> footerDoc (Just $ text setFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"rm"
|
||||
( Rm
|
||||
<$> (info (rmOpts <**> helper) (progDesc "Remove a GHC version"))
|
||||
)
|
||||
|
||||
<> command
|
||||
"install-cabal"
|
||||
((info
|
||||
((InstallCabal <$> installOpts) <**> helper)
|
||||
( progDesc "Install or update cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
(Set <$> setParser <**> helper)
|
||||
( progDesc "Set currently active GHC/cabal version"
|
||||
<> footerDoc (Just $ text setFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"rm"
|
||||
((info
|
||||
(Rm <$> rmParser <**> helper)
|
||||
( progDesc "Remove a GHC/cabal version"
|
||||
<> footerDoc (Just $ text rmFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
<> command
|
||||
"list"
|
||||
( List
|
||||
<$> (info (listOpts <**> helper)
|
||||
(progDesc "Show available GHCs and other tools")
|
||||
)
|
||||
((info (List <$> listOpts <**> helper)
|
||||
(progDesc "Show available GHCs and other tools")
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"upgrade"
|
||||
@@ -284,33 +288,95 @@ com =
|
||||
)
|
||||
<> command
|
||||
"changelog"
|
||||
((info (fmap ChangeLog changelogP <**> helper)
|
||||
(progDesc "Find/show changelog"
|
||||
<> footerDoc (Just $ text changeLogFooter)
|
||||
)
|
||||
((info
|
||||
(fmap ChangeLog changelogP <**> helper)
|
||||
( progDesc "Find/show changelog"
|
||||
<> footerDoc (Just $ text changeLogFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> commandGroup "Other commands:"
|
||||
<> hidden
|
||||
)
|
||||
<|> subparser
|
||||
( command
|
||||
"install-cabal"
|
||||
((info
|
||||
((InstallCabalLegacy <$> installOpts) <**> helper)
|
||||
( progDesc "Install or update cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> internal
|
||||
)
|
||||
where
|
||||
installFooter = [i|Discussion:
|
||||
Installs the specified GHC version (or a recommended default one) into
|
||||
a self-contained "~/.ghcup/ghc/<ghcver>" directory
|
||||
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".|]
|
||||
installToolFooter :: String
|
||||
installToolFooter = [i|Discussion:
|
||||
Installs GHC or cabal. When no command is given, installs GHC
|
||||
with the specified version/tag.
|
||||
It is recommended to always specify a subcommand ('ghc' or 'cabal').|]
|
||||
|
||||
setFooter :: String
|
||||
setFooter = [i|Discussion:
|
||||
Sets the the current GHC version by creating non-versioned
|
||||
symlinks for all ghc binaries of the specified version in
|
||||
"~/.ghcup/bin/<binary>".|]
|
||||
installCabalFooter = [i|Discussion:
|
||||
Sets the currently active GHC or cabal version. When no command is given,
|
||||
defaults to setting GHC with the specified version/tag (if no tag
|
||||
is given, sets GHC to 'recommended' version).
|
||||
It is recommended to always specify a subcommand ('ghc' or 'cabal').|]
|
||||
|
||||
rmFooter :: String
|
||||
rmFooter = [i|Discussion:
|
||||
Remove the given GHC or cabal version. When no command is given,
|
||||
defaults to removing GHC with the specified version.
|
||||
It is recommended to always specify a subcommand ('ghc' or 'cabal').|]
|
||||
|
||||
changeLogFooter :: String
|
||||
changeLogFooter = [i|Discussion:
|
||||
By default returns the URI of the ChangeLog of the latest GHC release.
|
||||
Pass '-o' to automatically open via xdg-open.|]
|
||||
|
||||
|
||||
installCabalFooter :: String
|
||||
installCabalFooter = [i|Discussion:
|
||||
Installs the specified cabal-install version (or a recommended default one)
|
||||
into "~/.ghcup/bin", so it can be overwritten by later
|
||||
"cabal install cabal-install", which installs into "~/.cabal/bin" by
|
||||
default. Make sure to set up your PATH appropriately, so the cabal
|
||||
installation takes precedence.|]
|
||||
changeLogFooter = [i|Discussion:
|
||||
By default returns the URI of the ChangeLog of the latest GHC release.
|
||||
Pass '-o' to automatically open via xdg-open.|]
|
||||
|
||||
|
||||
installParser :: Parser (Either InstallCommand InstallOptions)
|
||||
installParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
( InstallGHC
|
||||
<$> (info
|
||||
(installOpts <**> helper)
|
||||
( progDesc "Install GHC"
|
||||
<> footerDoc (Just $ text installGHCFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"cabal"
|
||||
( InstallCabal
|
||||
<$> (info
|
||||
(installOpts <**> helper)
|
||||
( progDesc "Install Cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> installOpts)
|
||||
where
|
||||
installGHCFooter :: String
|
||||
installGHCFooter = [i|Discussion:
|
||||
Installs the specified GHC version (or a recommended default one) into
|
||||
a self-contained "~/.ghcup/ghc/<ghcver>" directory
|
||||
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".|]
|
||||
|
||||
|
||||
installOpts :: Parser InstallOptions
|
||||
@@ -330,8 +396,46 @@ installOpts =
|
||||
<*> optional toolVersionArgument
|
||||
|
||||
|
||||
setGHCOpts :: Parser SetGHCOptions
|
||||
setGHCOpts = SetGHCOptions <$> optional toolVersionArgument
|
||||
setParser :: Parser (Either SetCommand SetOptions)
|
||||
setParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
( SetGHC
|
||||
<$> (info
|
||||
(setOpts <**> helper)
|
||||
( progDesc "Set GHC version"
|
||||
<> footerDoc (Just $ text setGHCFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"cabal"
|
||||
( SetCabal
|
||||
<$> (info
|
||||
(setOpts <**> helper)
|
||||
( progDesc "Set Cabal version"
|
||||
<> footerDoc (Just $ text setCabalFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> setOpts)
|
||||
where
|
||||
setGHCFooter :: String
|
||||
setGHCFooter = [i|Discussion:
|
||||
Sets the the current GHC version by creating non-versioned
|
||||
symlinks for all ghc binaries of the specified version in
|
||||
"~/.ghcup/bin/<binary>".|]
|
||||
|
||||
setCabalFooter :: String
|
||||
setCabalFooter = [i|Discussion:
|
||||
Sets the the current Cabal version.|]
|
||||
|
||||
|
||||
setOpts :: Parser SetOptions
|
||||
setOpts = SetOptions <$> optional toolVersionArgument
|
||||
|
||||
listOpts :: Parser ListOptions
|
||||
listOpts =
|
||||
@@ -357,6 +461,26 @@ listOpts =
|
||||
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
||||
)
|
||||
|
||||
|
||||
rmParser :: Parser (Either RmCommand RmOptions)
|
||||
rmParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
(RmGHC <$> (info (rmOpts <**> helper) (progDesc "Remove GHC version")))
|
||||
<> command
|
||||
"cabal"
|
||||
( RmCabal
|
||||
<$> (info (versionParser' <**> helper)
|
||||
(progDesc "Remove Cabal version")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> rmOpts)
|
||||
|
||||
|
||||
|
||||
rmOpts :: Parser RmOptions
|
||||
rmOpts = RmOptions <$> versionArgument
|
||||
|
||||
@@ -534,6 +658,12 @@ versionParser = option
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
|
||||
)
|
||||
|
||||
versionParser' :: Parser Version
|
||||
versionParser' = argument
|
||||
(eitherReader (bimap show id . version . T.pack))
|
||||
(metavar "VERSION")
|
||||
|
||||
|
||||
tagEither :: String -> Either String Tag
|
||||
tagEither s' = case fmap toLower s' of
|
||||
"recommended" -> Right Recommended
|
||||
@@ -744,7 +874,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, rawOutter = appendFile logfile
|
||||
}
|
||||
|
||||
-- wrapper to run effects with settings
|
||||
|
||||
-------------------------
|
||||
-- Effect interpreters --
|
||||
-------------------------
|
||||
|
||||
let runInstTool =
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
@@ -776,7 +910,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, TagNotFound
|
||||
]
|
||||
|
||||
let runListGHC = runE @'[] . runLogger
|
||||
let
|
||||
runSetCabal =
|
||||
runLogger
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
]
|
||||
|
||||
let runListGHC = runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||
|
||||
let runRmGHC =
|
||||
runLogger . flip runReaderT settings . runE @'[NotInstalled]
|
||||
@@ -811,13 +953,16 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
. flip runReaderT settings
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ BuildFailed
|
||||
@'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
]
|
||||
@@ -838,6 +983,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, DownloadFailed
|
||||
]
|
||||
|
||||
|
||||
---------------------------
|
||||
-- Getting download info --
|
||||
---------------------------
|
||||
|
||||
(GHCupInfo treq dls) <-
|
||||
( runLogger
|
||||
. flip runReaderT settings
|
||||
@@ -851,81 +1001,143 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger
|
||||
($(logError) [i|Error fetching download info: #{e}|])
|
||||
exitWith (ExitFailure 2)
|
||||
runLogger $ checkForUpdates dls
|
||||
(runLogger
|
||||
. runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ checkForUpdates dls
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) [i|Error checking for upgrades: #{e}|])
|
||||
|
||||
|
||||
-----------------------
|
||||
-- Command functions --
|
||||
-----------------------
|
||||
|
||||
let installGHC InstallOptions{..} =
|
||||
(runInstTool $ do
|
||||
v <- liftE $ fromVersion dls instVer GHC
|
||||
liftE $ installGHCBin dls (_tvVersion v) instPlatform -- FIXME: ugly sharing of tool version
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
runLogger $ $(logInfo) ("GHC installation successful")
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn)
|
||||
[i|GHC ver #{prettyVer v} already installed|]
|
||||
pure ExitSuccess
|
||||
VLeft (V (BuildFailed tmpdir e)) -> do
|
||||
case keepDirs of
|
||||
Never -> runLogger ($(logError) [i|Build failed with #{e}|])
|
||||
_ -> runLogger ($(logError) [i|Build failed with #{e}
|
||||
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.
|
||||
Make sure to clean up #{tmpdir} afterwards.|])
|
||||
pure $ ExitFailure 3
|
||||
VLeft (V NoDownload) -> do
|
||||
|
||||
runLogger $ do
|
||||
case instVer of
|
||||
Just iver -> $(logError) [i|No available GHC version for #{prettyToolVer iver}|]
|
||||
Nothing -> $(logError) [i|No available recommended GHC version|]
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) [i|#{e}|]
|
||||
$(logError) [i|Also check the logs in ~/.ghcup/logs|]
|
||||
pure $ ExitFailure 3
|
||||
|
||||
|
||||
let installCabal InstallOptions{..} =
|
||||
(runInstTool $ do
|
||||
v <- liftE $ fromVersion dls instVer Cabal
|
||||
liftE $ installCabalBin dls (_tvVersion v) instPlatform -- FIXME: ugly sharing of tool version
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
runLogger $ $(logInfo) ("Cabal installation successful")
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn)
|
||||
[i|Cabal ver #{prettyVer v} already installed|]
|
||||
pure ExitSuccess
|
||||
VLeft (V NoDownload) -> do
|
||||
|
||||
runLogger $ do
|
||||
case instVer of
|
||||
Just iver -> $(logError) [i|No available Cabal version for #{prettyToolVer iver}|]
|
||||
Nothing -> $(logError) [i|No available recommended Cabal version|]
|
||||
pure $ ExitFailure 4
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) [i|#{e}|]
|
||||
$(logError) [i|Also check the logs in ~/.ghcup/logs|]
|
||||
pure $ ExitFailure 4
|
||||
|
||||
let setGHC' SetOptions{..} =
|
||||
(runSetGHC $ do
|
||||
v <- liftE $ fromVersion dls sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly
|
||||
)
|
||||
>>= \case
|
||||
VRight (GHCTargetVersion{..}) -> do
|
||||
runLogger
|
||||
$ $(logInfo)
|
||||
[i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|]
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 5
|
||||
|
||||
let setCabal' SetOptions{..} =
|
||||
(runSetCabal $ do
|
||||
v <- liftE $ fromVersion dls sToolVer Cabal
|
||||
liftE $ setCabal (_tvVersion v)
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let rmGHC' RmOptions{..} =
|
||||
(runRmGHC $ do
|
||||
liftE $ rmGHCVer ghcVer
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 7
|
||||
|
||||
let rmCabal' tv =
|
||||
(runSetCabal $ do
|
||||
liftE $ rmCabalVer tv
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 15
|
||||
|
||||
|
||||
|
||||
res <- case optCommand of
|
||||
Install (InstallOptions {..}) ->
|
||||
(runInstTool $ do
|
||||
v <- liftE $ fromVersion dls instVer GHC
|
||||
liftE $ installGHCBin dls (_tvVersion v) instPlatform -- FIXME: ugly sharing of tool version
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
runLogger $ $(logInfo) ("GHC installation successful")
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn)
|
||||
[i|GHC ver #{prettyVer v} already installed|]
|
||||
pure ExitSuccess
|
||||
VLeft (V (BuildFailed tmpdir e)) -> do
|
||||
case keepDirs of
|
||||
Never -> runLogger ($(logError) [i|Build failed with #{e}|])
|
||||
_ -> runLogger ($(logError) [i|Build failed with #{e}
|
||||
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.
|
||||
Make sure to clean up #{tmpdir} afterwards.|])
|
||||
pure $ ExitFailure 3
|
||||
VLeft (V NoDownload) -> do
|
||||
Install (Right iopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
|
||||
installGHC iopts
|
||||
Install (Left (InstallGHC iopts)) -> installGHC iopts
|
||||
Install (Left (InstallCabal iopts)) -> installCabal iopts
|
||||
InstallCabalLegacy iopts -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
|
||||
installCabal iopts
|
||||
|
||||
runLogger $ do
|
||||
case instVer of
|
||||
Just iver -> $(logError) [i|No available GHC version for #{prettyToolVer iver}|]
|
||||
Nothing -> $(logError) [i|No available recommended GHC version|]
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) [i|#{e}|]
|
||||
$(logError) [i|Also check the logs in ~/.ghcup/logs|]
|
||||
pure $ ExitFailure 3
|
||||
InstallCabal (InstallOptions {..}) ->
|
||||
(runInstTool $ do
|
||||
v <- liftE $ fromVersion dls instVer Cabal
|
||||
liftE $ installCabalBin dls (_tvVersion v) instPlatform -- FIXME: ugly sharing of tool version
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
runLogger $ $(logInfo) ("Cabal installation successful")
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn)
|
||||
[i|Cabal ver #{prettyVer v} already installed|]
|
||||
pure ExitSuccess
|
||||
VLeft (V NoDownload) -> do
|
||||
|
||||
runLogger $ do
|
||||
case instVer of
|
||||
Just iver -> $(logError) [i|No available Cabal version for #{prettyToolVer iver}|]
|
||||
Nothing -> $(logError) [i|No available recommended Cabal version|]
|
||||
pure $ ExitFailure 4
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) [i|#{e}|]
|
||||
$(logError) [i|Also check the logs in ~/.ghcup/logs|]
|
||||
pure $ ExitFailure 4
|
||||
|
||||
SetGHC (SetGHCOptions {..}) ->
|
||||
(runSetGHC $ do
|
||||
v <- liftE $ fromVersion dls ghcVer GHC
|
||||
liftE $ setGHC v SetGHCOnly
|
||||
)
|
||||
>>= \case
|
||||
VRight (GHCTargetVersion{..}) -> do
|
||||
runLogger
|
||||
$ $(logInfo)
|
||||
[i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|]
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 5
|
||||
Set (Right sopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.|])
|
||||
setGHC' sopts
|
||||
Set (Left (SetGHC sopts)) -> setGHC' sopts
|
||||
Set (Left (SetCabal sopts)) -> setCabal' sopts
|
||||
|
||||
List (ListOptions {..}) ->
|
||||
(runListGHC $ do
|
||||
@@ -940,15 +1152,11 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 6
|
||||
|
||||
Rm (RmOptions {..}) ->
|
||||
(runRmGHC $ do
|
||||
liftE $ rmGHCVer ghcVer
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger ($(logError) [i|#{e}|])
|
||||
pure $ ExitFailure 7
|
||||
Rm (Right rmopts) -> do
|
||||
runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|])
|
||||
rmGHC' rmopts
|
||||
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
|
||||
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
|
||||
|
||||
DInfo ->
|
||||
do
|
||||
@@ -1153,7 +1361,8 @@ printListResult raw lr = do
|
||||
, intercalate "," $ (fmap printTag $ sort lTag)
|
||||
, intercalate ","
|
||||
$ (if fromSrc then [color' Blue "compiled"] else mempty)
|
||||
++ (if lStray then [color' Blue "stray"] else mempty)
|
||||
++ (if lStray then [color' Yellow "stray"] else mempty)
|
||||
++ (if lNoBindist then [color' Red "no-bindist"] else mempty)
|
||||
]
|
||||
)
|
||||
lr
|
||||
@@ -1167,29 +1376,35 @@ printListResult raw lr = do
|
||||
True -> flip const
|
||||
False -> color
|
||||
|
||||
checkForUpdates :: (MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
|
||||
checkForUpdates :: (MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
|
||||
=> GHCupDownloads
|
||||
-> m ()
|
||||
-> Excepts
|
||||
'[ NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, DistroNotFound
|
||||
]
|
||||
m
|
||||
()
|
||||
checkForUpdates dls = do
|
||||
forM_ (getLatest dls GHCup) $ \l -> do
|
||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
when (l > ghc_ver)
|
||||
$ $(logWarn)
|
||||
$ lift $ $(logWarn)
|
||||
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
|
||||
|
||||
forM_ (getLatest dls GHC) $ \l -> do
|
||||
mghc_ver <- latestInstalled GHC
|
||||
forM mghc_ver $ \ghc_ver ->
|
||||
when (l > ghc_ver)
|
||||
$ $(logWarn)
|
||||
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install #{prettyVer l}'|]
|
||||
$ lift $ $(logWarn)
|
||||
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
|
||||
|
||||
forM_ (getLatest dls Cabal) $ \l -> do
|
||||
mcabal_ver <- latestInstalled Cabal
|
||||
forM mcabal_ver $ \cabal_ver ->
|
||||
when (l > cabal_ver)
|
||||
$ $(logWarn)
|
||||
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install-cabal #{prettyVer l}'|]
|
||||
$ lift $ $(logWarn)
|
||||
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
|
||||
|
||||
where
|
||||
latestInstalled tool = (fmap lVer . lastMay)
|
||||
|
||||
@@ -4,6 +4,8 @@
|
||||
(
|
||||
|
||||
: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
|
||||
: "${BOOTSTRAP_HASKELL_GHC_VERSION:=recommended}"
|
||||
: "${BOOTSTRAP_HASKELL_CABAL_VERSION:=recommended}"
|
||||
|
||||
die() {
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
@@ -127,10 +129,10 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
|
||||
read -r answer </dev/tty
|
||||
fi
|
||||
|
||||
eghcup --cache install
|
||||
eghcup --cache install "${BOOTSTRAP_HASKELL_GHC_VERSION}"
|
||||
|
||||
eghcup set
|
||||
eghcup --cache install-cabal
|
||||
eghcup set "${BOOTSTRAP_HASKELL_GHC_VERSION}"
|
||||
eghcup --cache install-cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
|
||||
|
||||
edo cabal new-update
|
||||
|
||||
|
||||
@@ -34,14 +34,33 @@
|
||||
"notes": ""
|
||||
}
|
||||
},
|
||||
"Linux_Debian": {
|
||||
"unknown_versioning": {
|
||||
"distroPKGs": [
|
||||
"build-essential",
|
||||
"curl",
|
||||
"libffi-dev",
|
||||
"libffi6",
|
||||
"libgmp-dev",
|
||||
"libgmp10",
|
||||
"libncurses-dev",
|
||||
"libncurses5",
|
||||
"libtinfo5"
|
||||
],
|
||||
"notes": ""
|
||||
}
|
||||
},
|
||||
"Linux_Ubuntu": {
|
||||
"unknown_versioning": {
|
||||
"distroPKGs": [
|
||||
"build-essential",
|
||||
"curl",
|
||||
"libgmp-dev",
|
||||
"libffi-dev",
|
||||
"libffi6",
|
||||
"libgmp-dev",
|
||||
"libgmp10",
|
||||
"libncurses-dev",
|
||||
"libncurses5",
|
||||
"libtinfo5"
|
||||
],
|
||||
"notes": ""
|
||||
@@ -578,6 +597,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "355bd85c69933c31bbe99b4269ce719acfd0aad0b45e359ac39b9bb13996acc6",
|
||||
"dlSubdir": "ghc-8.6.3",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-centos7-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "52ae92f4e8bb2ac0b7847287ea3da37081f5f7bf8bbb7c78ac35fde537d1a89f",
|
||||
@@ -668,7 +694,7 @@
|
||||
"Linux_Alpine": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "cb13b645d103e2fba2eb8dfcc4e5f2fbd9550c00c4df42f342b4210436dcb8a8",
|
||||
"dlSubdir": "ghc-8.10.1",
|
||||
"dlSubdir": "ghc-8.10.1-x86_64-unknown-linux",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-alpine3.10-linux-integer-simple.tar.xz"
|
||||
}
|
||||
},
|
||||
@@ -713,6 +739,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "0618b94854edc6be5302489df905e627820b71be6b66c950f5e3088fe92df0a1",
|
||||
"dlSubdir": "ghc-8.10.1",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-centos7-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "3c4cd72b4806045779739e8f5d1658e30e57123d88c2c8966422cdbcae448470",
|
||||
@@ -852,6 +885,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "80ab566f4411299f9e5922d60749ca80f989d697db19e03ed875619d699f0edf",
|
||||
"dlSubdir": "ghc-8.6.5",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-centos7-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "cf78b53eaf336083e7a05f4a3000afbae4abe5bbc77ef80cc40e09d04ac5b4a1",
|
||||
@@ -1105,6 +1145,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "6cdd34e4dbaeb801e805811f91cf43a2d5f64b22f884718ffbd3542a2f4dd14f",
|
||||
"dlSubdir": "ghc-8.8.1",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-centos7-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "851a78df620bc056c34b252c97040d5755e294993fa8afa5429708b5229204d6",
|
||||
@@ -1474,6 +1521,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "f065a017d7a38f235f186ffe32d8261a4fd39c7e945d5cde85c0984c2569db99",
|
||||
"dlSubdir": "ghc-8.8.2",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-centos7-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "dbe2db717b33460f790e155e487d2a31c9b21a9d245f0c9490ad65844c3ea21f",
|
||||
@@ -1847,6 +1901,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "83a96650f5a92b1e4d7651d256d6438624342d40e780e68125033435a54cd674",
|
||||
"dlSubdir": "ghc-8.4.4",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-centos70-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "8ab2befddc14d1434d0aad0c5d3c7e0c2b78ff84caa3429fa62527bfc6b86095",
|
||||
@@ -1977,6 +2038,13 @@
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-apple-darwin.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_RedHat": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "4b2b5313f7c12b81e54efcb26705fa9e4ad5b98f2b58bfc76fb0c9ba1d55eb1f",
|
||||
"dlSubdir": "ghc-8.8.3",
|
||||
"dlUri": "https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-centos7-linux.tar.xz"
|
||||
}
|
||||
},
|
||||
"Linux_UnknownLinux": {
|
||||
"unknown_versioning": {
|
||||
"dlHash": "45ee1de3bfc98cbcc4886b65fc7651ade2d3820aa85eac2dbe9bc7bf91e7c818",
|
||||
|
||||
14
ghcup.cabal
14
ghcup.cabal
@@ -98,9 +98,6 @@ common http-io-streams
|
||||
common io-streams
|
||||
build-depends: io-streams >=1.5
|
||||
|
||||
common language-bash
|
||||
build-depends: language-bash >=0.9
|
||||
|
||||
common lzma
|
||||
build-depends: lzma >=0.0.0.3
|
||||
|
||||
@@ -182,6 +179,9 @@ common unix
|
||||
common unix-bytestring
|
||||
build-depends: unix-bytestring >=0.3
|
||||
|
||||
common unordered-containers
|
||||
build-depends: unordered-containers >= 0.2.10.0
|
||||
|
||||
common uri-bytestring
|
||||
build-depends: uri-bytestring >=0.3.2.2
|
||||
|
||||
@@ -194,9 +194,6 @@ common vector
|
||||
common versions
|
||||
build-depends: versions >=3.5
|
||||
|
||||
common waargonaut
|
||||
build-depends: waargonaut >=0.8
|
||||
|
||||
common word8
|
||||
build-depends: word8 >=0.1.3
|
||||
|
||||
@@ -242,7 +239,6 @@ library
|
||||
, hpath-filepath
|
||||
, hpath-io
|
||||
, hpath-posix
|
||||
, language-bash
|
||||
, lzma
|
||||
, megaparsec
|
||||
, monad-logger
|
||||
@@ -267,6 +263,7 @@ library
|
||||
, transformers
|
||||
, unix
|
||||
, unix-bytestring
|
||||
, unordered-containers
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
, vector
|
||||
@@ -288,7 +285,7 @@ library
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Bash
|
||||
GHCup.Utils.OsRelease
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Utils.File
|
||||
GHCup.Utils.Logger
|
||||
@@ -327,6 +324,7 @@ executable ghcup
|
||||
, pretty-terminal
|
||||
, resourcet
|
||||
, safe
|
||||
, safe-exceptions
|
||||
, string-interpolate
|
||||
, table-layout
|
||||
, template-haskell
|
||||
|
||||
4
hie.yaml
Normal file
4
hie.yaml
Normal file
@@ -0,0 +1,4 @@
|
||||
cradle:
|
||||
cabal:
|
||||
- path: "."
|
||||
component: "ghcup:lib:ghcup"
|
||||
214
lib/GHCup.hs
214
lib/GHCup.hs
@@ -38,6 +38,7 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.String.Interpolate
|
||||
@@ -53,6 +54,7 @@ import Prelude hiding ( abs
|
||||
, readFile
|
||||
, writeFile
|
||||
)
|
||||
import Safe hiding ( at )
|
||||
import System.IO.Error
|
||||
import System.Posix.Env.ByteString ( getEnvironment )
|
||||
import System.Posix.FilePath ( getSearchPath )
|
||||
@@ -148,24 +150,39 @@ installCabalBin :: ( MonadMask m
|
||||
, MonadLogger m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> GHCupDownloads
|
||||
-> Version
|
||||
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
|
||||
-> Excepts
|
||||
'[ CopyError
|
||||
'[ AlreadyInstalled
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, UnknownArchive
|
||||
]
|
||||
m
|
||||
()
|
||||
installCabalBin bDls ver mpfReq = do
|
||||
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
|
||||
|
||||
bindir <- liftIO ghcupBinDir
|
||||
|
||||
whenM
|
||||
(liftIO $ cabalInstalled ver >>= \a ->
|
||||
handleIO (\_ -> pure False)
|
||||
$ fmap (\x -> a && isSymbolicLink x)
|
||||
-- ignore when the installation is a legacy cabal (binary, not symlink)
|
||||
$ getSymbolicLinkStatus (toFilePath (bindir </> [rel|cabal|]))
|
||||
)
|
||||
$ (throwE $ AlreadyInstalled Cabal ver)
|
||||
|
||||
Settings {..} <- lift ask
|
||||
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
|
||||
|
||||
@@ -178,13 +195,16 @@ installCabalBin bDls ver mpfReq = do
|
||||
liftE $ unpackToDir tmpUnpack dl
|
||||
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
|
||||
|
||||
-- prepare paths
|
||||
bindir <- liftIO ghcupBinDir
|
||||
|
||||
-- the subdir of the archive where we do the work
|
||||
let workdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
|
||||
|
||||
liftE $ installCabal' workdir bindir
|
||||
|
||||
-- create symlink if this is the latest version
|
||||
cVers <- liftIO $ fmap rights $ getInstalledCabals
|
||||
let lInstCabal = headMay . reverse . sort $ cVers
|
||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||
|
||||
pure ()
|
||||
|
||||
where
|
||||
@@ -197,16 +217,17 @@ installCabalBin bDls ver mpfReq = do
|
||||
lift $ $(logInfo) "Installing cabal"
|
||||
let cabalFile = [rel|cabal|]
|
||||
liftIO $ createDirIfMissing newDirPerms inst
|
||||
destFileName <- lift $ parseRel (toFilePath cabalFile <> "-" <> verToBS ver)
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
(path </> cabalFile)
|
||||
(inst </> cabalFile)
|
||||
(inst </> destFileName)
|
||||
Overwrite
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Set GHC ]--
|
||||
---------------
|
||||
---------------------
|
||||
--[ Set GHC/cabal ]--
|
||||
---------------------
|
||||
|
||||
|
||||
|
||||
@@ -283,6 +304,40 @@ setGHC ver sghc = do
|
||||
|
||||
|
||||
|
||||
-- | Set the ~/.ghcup/bin/cabal symlink.
|
||||
setCabal :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
|
||||
=> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
setCabal ver = do
|
||||
let verBS = verToBS ver
|
||||
targetFile <- parseRel ("cabal-" <> verBS)
|
||||
|
||||
-- symlink destination
|
||||
bindir <- liftIO $ ghcupBinDir
|
||||
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms bindir
|
||||
|
||||
whenM (liftIO $ fmap not $ doesFileExist (bindir </> targetFile))
|
||||
$ throwE
|
||||
$ NotInstalled Cabal (prettyVer ver)
|
||||
|
||||
let cabalbin = bindir </> [rel|cabal|]
|
||||
|
||||
-- delete old file (may be binary or symlink)
|
||||
lift $ $(logDebug) [i|rm -f #{toFilePath cabalbin}|]
|
||||
liftIO $ hideError doesNotExistErrorType $ deleteFile
|
||||
cabalbin
|
||||
|
||||
-- create symlink
|
||||
let destL = toFilePath targetFile
|
||||
lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath cabalbin}|]
|
||||
liftIO $ createSymlink cabalbin destL
|
||||
|
||||
pure ()
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ List tools ]--
|
||||
@@ -302,6 +357,7 @@ data ListResult = ListResult
|
||||
, lSet :: Bool -- ^ currently active version
|
||||
, fromSrc :: Bool -- ^ compiled from source
|
||||
, lStray :: Bool -- ^ not in download info
|
||||
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
@@ -314,28 +370,41 @@ availableToolVersions av tool = view
|
||||
|
||||
-- | List all versions from the download info, as well as stray
|
||||
-- versions.
|
||||
listVersions :: (MonadThrow m, MonadLogger m, MonadIO m)
|
||||
listVersions :: ( MonadCatch m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
=> GHCupDownloads
|
||||
-> Maybe Tool
|
||||
-> Maybe ListCriteria
|
||||
-> m [ListResult]
|
||||
listVersions av lt criteria = case lt of
|
||||
Just t -> do
|
||||
-- get versions from GHCupDownloads
|
||||
let avTools = availableToolVersions av t
|
||||
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult t)
|
||||
-> Excepts
|
||||
'[ NoCompatiblePlatform
|
||||
, NoCompatibleArch
|
||||
, DistroNotFound
|
||||
]
|
||||
m
|
||||
[ListResult]
|
||||
listVersions av lt criteria = do
|
||||
pfreq <- platformRequest
|
||||
case lt of
|
||||
Just t -> do
|
||||
-- get versions from GHCupDownloads
|
||||
let avTools = availableToolVersions av t
|
||||
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult pfreq t)
|
||||
|
||||
case t of
|
||||
-- append stray GHCs
|
||||
GHC -> do
|
||||
slr <- strayGHCs avTools
|
||||
pure $ (sort (slr ++ lr))
|
||||
_ -> pure lr
|
||||
Nothing -> do
|
||||
ghcvers <- listVersions av (Just GHC) criteria
|
||||
cabalvers <- listVersions av (Just Cabal) criteria
|
||||
ghcupvers <- listVersions av (Just GHCup) criteria
|
||||
pure (ghcvers <> cabalvers <> ghcupvers)
|
||||
case t of
|
||||
-- append stray GHCs
|
||||
GHC -> do
|
||||
slr <- lift $ strayGHCs avTools
|
||||
pure $ (sort (slr ++ lr))
|
||||
_ -> pure lr
|
||||
Nothing -> do
|
||||
ghcvers <- listVersions av (Just GHC) criteria
|
||||
cabalvers <- listVersions av (Just Cabal) criteria
|
||||
ghcupvers <- listVersions av (Just GHCup) criteria
|
||||
pure (ghcvers <> cabalvers <> ghcupvers)
|
||||
|
||||
where
|
||||
strayGHCs :: (MonadThrow m, MonadLogger m, MonadIO m)
|
||||
@@ -357,6 +426,7 @@ listVersions av lt criteria = case lt of
|
||||
, lTag = []
|
||||
, lInstalled = True
|
||||
, lStray = maybe True (const False) (Map.lookup _tvVersion avTools)
|
||||
, lNoBindist = False
|
||||
, ..
|
||||
}
|
||||
Right tver@GHCTargetVersion{ .. } -> do
|
||||
@@ -369,6 +439,7 @@ listVersions av lt criteria = case lt of
|
||||
, lTag = []
|
||||
, lInstalled = True
|
||||
, lStray = True -- NOTE: cross currently cannot be installed via bindist
|
||||
, lNoBindist = False
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
@@ -377,17 +448,19 @@ listVersions av lt criteria = case lt of
|
||||
pure Nothing
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: Tool -> (Version, [Tag]) -> IO ListResult
|
||||
toListResult t (v, tags) = case t of
|
||||
toListResult :: PlatformRequest -> Tool -> (Version, [Tag]) -> IO ListResult
|
||||
toListResult pfreq t (v, tags) = case t of
|
||||
GHC -> do
|
||||
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
|
||||
let tver = mkTVer v
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
||||
lInstalled <- ghcInstalled tver
|
||||
fromSrc <- ghcSrcInstalled tver
|
||||
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
||||
Cabal -> do
|
||||
lSet <- fmap (== v) $ cabalSet
|
||||
let lInstalled = lSet
|
||||
let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq av
|
||||
lSet <- fmap (maybe False (== v)) $ cabalSet
|
||||
lInstalled <- cabalInstalled v
|
||||
pure ListResult { lVer = v
|
||||
, lCross = Nothing
|
||||
, lTag = tags
|
||||
@@ -405,6 +478,7 @@ listVersions av lt criteria = case lt of
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, lNoBindist = False
|
||||
, ..
|
||||
}
|
||||
|
||||
@@ -417,9 +491,9 @@ listVersions av lt criteria = case lt of
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ GHC rm ]--
|
||||
--------------
|
||||
--------------------
|
||||
--[ GHC/cabal rm ]--
|
||||
--------------------
|
||||
|
||||
|
||||
-- | This function may throw and crash in various ways.
|
||||
@@ -461,6 +535,26 @@ rmGHCVer ver = do
|
||||
else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))
|
||||
|
||||
|
||||
-- | This function may throw and crash in various ways.
|
||||
rmCabalVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m)
|
||||
=> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmCabalVer ver = do
|
||||
whenM (fmap not $ liftIO $ cabalInstalled ver) $ throwE (NotInstalled GHC (prettyVer ver))
|
||||
|
||||
cSet <- liftIO cabalSet
|
||||
|
||||
bindir <- liftIO ghcupBinDir
|
||||
cabalFile <- lift $ parseRel ("cabal-" <> verToBS ver)
|
||||
liftIO $ hideError doesNotExistErrorType $ deleteFile (bindir </> cabalFile)
|
||||
|
||||
when (maybe False (== ver) cSet) $ do
|
||||
cVers <- liftIO $ fmap rights $ getInstalledCabals
|
||||
case headMay . reverse . sort $ cVers of
|
||||
Just latestver -> setCabal latestver
|
||||
Nothing -> liftIO $ hideError doesNotExistErrorType $ deleteFile
|
||||
(bindir </> [rel|cabal|])
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
@@ -671,26 +765,29 @@ Stage1Only = YES|]
|
||||
|
||||
|
||||
|
||||
|
||||
compileCabal :: ( MonadReader Settings m
|
||||
, MonadResource m
|
||||
, MonadMask m
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> GHCupDownloads
|
||||
-> Version -- ^ version to install
|
||||
-> Version -- ^ version to install
|
||||
-> Either Version (Path Abs) -- ^ version to bootstrap with
|
||||
-> Maybe Int
|
||||
-> Maybe (Path Abs)
|
||||
-> Excepts
|
||||
'[ BuildFailed
|
||||
'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DistroNotFound
|
||||
, DownloadFailed
|
||||
, NoCompatibleArch
|
||||
, NoCompatiblePlatform
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
]
|
||||
@@ -699,6 +796,17 @@ compileCabal :: ( MonadReader Settings m
|
||||
compileCabal dls tver bghc jobs patchdir = do
|
||||
lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
|
||||
|
||||
bindir <- liftIO ghcupBinDir
|
||||
|
||||
whenM
|
||||
(liftIO $ cabalInstalled tver >>= \a ->
|
||||
handleIO (\_ -> pure False)
|
||||
$ fmap (\x -> a && isSymbolicLink x)
|
||||
-- ignore when the installation is a legacy cabal (binary, not symlink)
|
||||
$ getSymbolicLinkStatus (toFilePath (bindir </> [rel|cabal|]))
|
||||
)
|
||||
$ (throwE $ AlreadyInstalled Cabal tver)
|
||||
|
||||
-- download source tarball
|
||||
dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
@@ -711,21 +819,25 @@ compileCabal dls tver bghc jobs patchdir = do
|
||||
|
||||
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
|
||||
|
||||
cbin <- liftE $ runBuildAction tmpUnpack Nothing (compile workdir)
|
||||
|
||||
liftE $ runBuildAction
|
||||
tmpUnpack
|
||||
Nothing
|
||||
(compile workdir)
|
||||
destFileName <- lift $ parseRel ("cabal-" <> verToBS tver)
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
|
||||
cbin
|
||||
(bindir </> destFileName)
|
||||
Overwrite
|
||||
|
||||
-- only clean up dir if the build succeeded
|
||||
liftIO $ deleteDirRecursive tmpUnpack
|
||||
-- create symlink if this is the latest version
|
||||
cVers <- liftIO $ fmap rights $ getInstalledCabals
|
||||
let lInstCabal = headMay . reverse . sort $ cVers
|
||||
when (maybe True (tver >=) lInstCabal) $ liftE $ setCabal tver
|
||||
|
||||
pure ()
|
||||
|
||||
where
|
||||
compile :: (MonadThrow m, MonadLogger m, MonadIO m)
|
||||
compile :: (MonadThrow m, MonadLogger m, MonadIO m, MonadResource m)
|
||||
=> Path Abs
|
||||
-> Excepts '[ProcessError , PatchFailed] m ()
|
||||
-> Excepts '[ProcessError , PatchFailed] m (Path Abs)
|
||||
compile workdir = do
|
||||
lift $ $(logInfo) [i|Building (this may take a while)...|]
|
||||
|
||||
@@ -741,14 +853,19 @@ compileCabal dls tver bghc jobs patchdir = do
|
||||
pure
|
||||
[ ("GHC" , toFilePath path)
|
||||
, ("GHC_PKG", dn <> "/" <> "ghc-pkg" <> ver)
|
||||
, ("HADDOCK", dn <> "/" <> "haddock" <> ver)
|
||||
]
|
||||
Left bver -> do
|
||||
let v' = verToBS bver
|
||||
pure [("GHC", "ghc-" <> v'), ("GHC_PKG", "ghc-pkg-" <> v')]
|
||||
pure
|
||||
[ ("GHC" , "ghc-" <> v')
|
||||
, ("GHC_PKG", "ghc-pkg-" <> v')
|
||||
, ("HADDOCK", "haddock-" <> v')
|
||||
]
|
||||
|
||||
cabal_bin <- liftIO $ ghcupBinDir
|
||||
newEnv <- lift
|
||||
$ addToCurrentEnv (("PREFIX", toFilePath cabal_bin) : ghcEnv)
|
||||
tmp <- lift withGHCupTmpDir
|
||||
liftIO $ createDirRecursive newDirPerms (tmp </> [rel|bin|])
|
||||
newEnv <- lift $ addToCurrentEnv (("PREFIX", toFilePath tmp) : ghcEnv)
|
||||
lift $ $(logDebug) [i|Environment: #{newEnv}|]
|
||||
|
||||
lEM $ liftIO $ execLogged "./bootstrap.sh"
|
||||
@@ -757,6 +874,7 @@ compileCabal dls tver bghc jobs patchdir = do
|
||||
[rel|cabal-bootstrap|]
|
||||
(Just workdir)
|
||||
(Just newEnv)
|
||||
pure $ (tmp </> [rel|bin/cabal|])
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -883,7 +883,7 @@ ghc_8101_64_darwin = DownloadInfo
|
||||
ghc_8101_64_alpine :: DownloadInfo
|
||||
ghc_8101_64_alpine = DownloadInfo
|
||||
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-alpine3.10-linux-integer-simple.tar.xz|]
|
||||
(Just [rel|ghc-8.10.1|])
|
||||
(Just [rel|ghc-8.10.1-x86_64-unknown-linux|])
|
||||
"cb13b645d103e2fba2eb8dfcc4e5f2fbd9550c00c4df42f342b4210436dcb8a8"
|
||||
|
||||
|
||||
@@ -1360,6 +1360,7 @@ ghcupDownloads = M.fromList
|
||||
, M.fromList [(Nothing, ghc_844_64_fedora)]
|
||||
)
|
||||
, (Linux CentOS, M.fromList [(Nothing, ghc_844_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_844_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_844_64_centos)]
|
||||
)
|
||||
@@ -1509,6 +1510,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Linux Fedora, M.fromList [(Nothing, ghc_863_64_fedora)])
|
||||
, (Linux CentOS, M.fromList [(Nothing, ghc_863_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_863_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_863_64_centos)]
|
||||
)
|
||||
@@ -1612,6 +1614,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Linux Fedora, M.fromList [(Nothing, ghc_865_64_fedora)])
|
||||
, (Linux CentOS, M.fromList [(Nothing, ghc_865_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_865_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_865_64_centos)]
|
||||
)
|
||||
@@ -1665,6 +1668,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Linux Fedora, M.fromList [(Nothing, ghc_881_64_fedora)])
|
||||
, (Linux CentOS, M.fromList [(Nothing, ghc_881_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_881_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_881_64_centos)]
|
||||
)
|
||||
@@ -1718,6 +1722,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Linux Fedora, M.fromList [(Nothing, ghc_882_64_fedora)])
|
||||
, (Linux CentOS, M.fromList [(Nothing, ghc_882_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_882_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_882_64_centos)]
|
||||
)
|
||||
@@ -1771,6 +1776,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, (Linux Fedora, M.fromList [(Nothing, ghc_883_64_fedora)])
|
||||
, (Linux CentOS, M.fromList [(Nothing, ghc_883_64_centos)])
|
||||
, (Linux RedHat, M.fromList [(Nothing, ghc_883_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_883_64_centos)]
|
||||
)
|
||||
@@ -1834,6 +1840,7 @@ ghcupDownloads = M.fromList
|
||||
, (Just [vers|7|], ghc_8101_64_centos)
|
||||
]
|
||||
)
|
||||
, ( Linux RedHat, M.fromList [(Nothing, ghc_8101_64_centos)])
|
||||
, ( Linux AmazonLinux
|
||||
, M.fromList [(Nothing, ghc_8101_64_centos)]
|
||||
)
|
||||
|
||||
@@ -53,9 +53,30 @@ toolRequirements = M.fromList
|
||||
, Requirements
|
||||
[ "build-essential"
|
||||
, "curl"
|
||||
, "libgmp-dev"
|
||||
, "libffi-dev"
|
||||
, "libffi6"
|
||||
, "libgmp-dev"
|
||||
, "libgmp10"
|
||||
, "libncurses-dev"
|
||||
, "libncurses5"
|
||||
, "libtinfo5"
|
||||
]
|
||||
""
|
||||
)
|
||||
]
|
||||
)
|
||||
, ( Linux Debian
|
||||
, M.fromList
|
||||
[ ( Nothing
|
||||
, Requirements
|
||||
[ "build-essential"
|
||||
, "curl"
|
||||
, "libffi-dev"
|
||||
, "libffi6"
|
||||
, "libgmp-dev"
|
||||
, "libgmp10"
|
||||
, "libncurses-dev"
|
||||
, "libncurses5"
|
||||
, "libtinfo5"
|
||||
]
|
||||
""
|
||||
|
||||
@@ -12,7 +12,7 @@ module GHCup.Platform where
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Bash
|
||||
import GHCup.Utils.OsRelease
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
@@ -111,7 +111,6 @@ getLinuxDistro = do
|
||||
(name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ liftIO $ asum
|
||||
[ try_os_release
|
||||
, try_lsb_release_cmd
|
||||
, try_lsb_release
|
||||
, try_redhat_release
|
||||
, try_debian_version
|
||||
]
|
||||
@@ -136,10 +135,6 @@ getLinuxDistro = do
|
||||
where
|
||||
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
|
||||
|
||||
os_release :: Path Abs
|
||||
os_release = [abs|/etc/os-release|]
|
||||
lsb_release :: Path Abs
|
||||
lsb_release = [abs|/etc/lsb-release|]
|
||||
lsb_release_cmd :: Path Rel
|
||||
lsb_release_cmd = [rel|lsb-release|]
|
||||
redhat_release :: Path Abs
|
||||
@@ -149,9 +144,8 @@ getLinuxDistro = do
|
||||
|
||||
try_os_release :: IO (Text, Maybe Text)
|
||||
try_os_release = do
|
||||
(Just name) <- getAssignmentValueFor os_release "NAME"
|
||||
ver <- getAssignmentValueFor os_release "VERSION_ID"
|
||||
pure (T.pack name, fmap T.pack ver)
|
||||
OsRelease { name = Just n, version_id = v } <- parseOsRelease
|
||||
pure (T.pack n, fmap T.pack v)
|
||||
|
||||
try_lsb_release_cmd :: IO (Text, Maybe Text)
|
||||
try_lsb_release_cmd = do
|
||||
@@ -160,12 +154,6 @@ getLinuxDistro = do
|
||||
ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing
|
||||
pure (decUTF8Safe name, Just $ decUTF8Safe ver)
|
||||
|
||||
try_lsb_release :: IO (Text, Maybe Text)
|
||||
try_lsb_release = do
|
||||
(Just name) <- getAssignmentValueFor lsb_release "DISTRIB_ID"
|
||||
ver <- getAssignmentValueFor lsb_release "DISTRIB_RELEASE"
|
||||
pure (T.pack name, fmap T.pack ver)
|
||||
|
||||
try_redhat_release :: IO (Text, Maybe Text)
|
||||
try_redhat_release = do
|
||||
t <- fmap decUTF8Safe' $ readFile redhat_release
|
||||
|
||||
@@ -210,19 +210,41 @@ getInstalledGHCs = do
|
||||
Left _ -> pure $ Left f
|
||||
|
||||
|
||||
getInstalledCabals :: IO [Either (Path Rel) Version]
|
||||
getInstalledCabals = do
|
||||
bindir <- liftIO $ ghcupBinDir
|
||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
bindir
|
||||
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
|
||||
vs <- forM bins $ \f -> case fmap version (fmap decUTF8Safe . B.stripPrefix "cabal-" . toFilePath $ f) of
|
||||
Just (Right r) -> pure $ Right r
|
||||
Just (Left _) -> pure $ Left f
|
||||
Nothing -> pure $ Left f
|
||||
cs <- cabalSet -- for legacy cabal
|
||||
pure $ maybe vs (\x -> Right x:vs) cs
|
||||
|
||||
|
||||
cabalInstalled :: Version -> IO Bool
|
||||
cabalInstalled ver = do
|
||||
reportedVer <- cabalSet
|
||||
pure (reportedVer == ver)
|
||||
vers <- fmap rights $ getInstalledCabals
|
||||
pure $ elem ver $ vers
|
||||
|
||||
cabalSet :: (MonadIO m, MonadThrow m) => m Version
|
||||
|
||||
cabalSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
|
||||
cabalSet = do
|
||||
cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
|
||||
mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing
|
||||
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc
|
||||
case version $ decUTF8Safe reportedVer of
|
||||
Left e -> throwM e
|
||||
Right r -> pure r
|
||||
mc <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut
|
||||
cabalbin
|
||||
["--numeric-version"]
|
||||
Nothing
|
||||
fmap join $ forM mc $ \c -> if
|
||||
| not (B.null (_stdOut c))
|
||||
, _exitCode c == ExitSuccess -> do
|
||||
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ c
|
||||
case version $ decUTF8Safe reportedVer of
|
||||
Left e -> throwM e
|
||||
Right r -> pure $ Just r
|
||||
| otherwise -> pure Nothing
|
||||
|
||||
|
||||
|
||||
@@ -395,13 +417,26 @@ ghcToolFiles ver = do
|
||||
([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString)
|
||||
)
|
||||
|
||||
(Just symver) <-
|
||||
(B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName)
|
||||
<$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> ghcbin))
|
||||
when (B.null symver)
|
||||
(throwIO $ userError $ "Fatal: ghc symlink target is broken")
|
||||
let ghcbinPath = bindir </> ghcbin
|
||||
ghcIsHadrian <- liftIO $ isHadrian ghcbinPath
|
||||
onlyUnversioned <- if ghcIsHadrian
|
||||
then pure id
|
||||
else do
|
||||
(Just symver) <-
|
||||
(B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName)
|
||||
<$> (liftIO $ readSymbolicLink $ toFilePath ghcbinPath)
|
||||
when (B.null symver)
|
||||
(throwIO $ userError $ "Fatal: ghc symlink target is broken")
|
||||
pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x)
|
||||
|
||||
pure . filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) $ files
|
||||
pure $ onlyUnversioned files
|
||||
where
|
||||
-- GHC is moving some builds to Hadrian for bindists,
|
||||
-- which doesn't create versioned binaries.
|
||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
|
||||
isHadrian :: Path Abs -- ^ ghcbin path
|
||||
-> IO Bool
|
||||
isHadrian = fmap (/= SymbolicLink) . getFileType
|
||||
|
||||
|
||||
-- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that
|
||||
@@ -463,11 +498,11 @@ getChangeLog dls tool (Right tag) =
|
||||
runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m)
|
||||
=> Path Abs -- ^ build directory
|
||||
-> Maybe (Path Abs) -- ^ install location (e.g. for GHC)
|
||||
-> Excepts e m ()
|
||||
-> Excepts '[BuildFailed] m ()
|
||||
-> Excepts e m a
|
||||
-> Excepts '[BuildFailed] m a
|
||||
runBuildAction bdir instdir action = do
|
||||
Settings {..} <- lift ask
|
||||
flip
|
||||
v <- flip
|
||||
onException
|
||||
(do
|
||||
forM_ instdir $ \dir ->
|
||||
@@ -491,3 +526,4 @@ runBuildAction bdir instdir action = do
|
||||
|
||||
when (keepDirs == Never || keepDirs == Errors) $ liftIO $ deleteDirRecursive
|
||||
bdir
|
||||
pure v
|
||||
|
||||
@@ -1,69 +0,0 @@
|
||||
module GHCup.Utils.Bash
|
||||
( findAssignment
|
||||
, equalsAssignmentWith
|
||||
, getRValue
|
||||
, getAssignmentValueFor
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad
|
||||
import Data.ByteString.UTF8 ( toString )
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import HPath
|
||||
import HPath.IO
|
||||
import Language.Bash.Parse
|
||||
import Language.Bash.Syntax
|
||||
import Language.Bash.Word
|
||||
import Prelude hiding ( readFile )
|
||||
|
||||
import qualified Data.ByteString.Lazy.UTF8 as UTF8
|
||||
|
||||
|
||||
extractAssignments :: List -> [Assign]
|
||||
extractAssignments (List stms) = join $ fmap getAssign $ getCommands stms
|
||||
where
|
||||
getCommands :: [Statement] -> [Command]
|
||||
getCommands = join . fmap commands . catMaybes . fmap findPipes
|
||||
where
|
||||
findPipes (Statement (Last p@(Pipeline{})) Sequential) = Just p
|
||||
findPipes _ = Nothing
|
||||
|
||||
getAssign :: Command -> [Assign]
|
||||
getAssign (Command (SimpleCommand ass _) _) = ass
|
||||
getAssign _ = []
|
||||
|
||||
|
||||
-- | Find an assignment matching the predicate in the given file.
|
||||
findAssignment :: Path b -> (Assign -> Bool) -> IO (Maybe Assign)
|
||||
findAssignment p predicate = do
|
||||
fileContents <- readFile p
|
||||
-- TODO: this should accept bytestring:
|
||||
-- https://github.com/knrafto/language-bash/issues/37
|
||||
case parse (toString . toFilePath $ p) (UTF8.toString fileContents) of
|
||||
Left e -> fail $ show e
|
||||
Right l -> pure $ find predicate (extractAssignments $ l)
|
||||
|
||||
|
||||
-- | Check that the assignment is of the form Foo= ignoring the
|
||||
-- right hand-side.
|
||||
equalsAssignmentWith :: String -> Assign -> Bool
|
||||
equalsAssignmentWith n ass = case ass of
|
||||
(Assign (Parameter name' Nothing) Equals _) -> n == name'
|
||||
_ -> False
|
||||
|
||||
|
||||
-- | This pretty-prints the right hand of an Equals assignment, removing
|
||||
-- quotations. No evaluation is performed.
|
||||
getRValue :: Assign -> Maybe String
|
||||
getRValue ass = case ass of
|
||||
(Assign (Parameter _ _) Equals (RValue w)) -> Just $ unquote w
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
-- | Given a bash assignment such as Foo="Bar" in the given file,
|
||||
-- will return "Bar" (without quotations).
|
||||
getAssignmentValueFor :: Path b -> String -> IO (Maybe String)
|
||||
getAssignmentValueFor p n = do
|
||||
mass <- findAssignment p (equalsAssignmentWith n)
|
||||
pure (mass >>= getRValue)
|
||||
164
lib/GHCup/Utils/OsRelease.hs
Normal file
164
lib/GHCup/Utils/OsRelease.hs
Normal file
@@ -0,0 +1,164 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
-- | A module to retrieve os-release information according to the
|
||||
-- freedesktop standard:
|
||||
-- https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
--
|
||||
-- Some of it is stolen from:
|
||||
-- https://hackage.haskell.org/package/os-release-0.2.2/docs/src/System-OsRelease.html
|
||||
module GHCup.Utils.OsRelease where
|
||||
|
||||
import GHCup.Utils.MegaParsec
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Void
|
||||
import HPath
|
||||
import HPath.IO
|
||||
import Prelude hiding ( abs
|
||||
, readFile
|
||||
)
|
||||
|
||||
import qualified Data.ByteString.Lazy.UTF8 as UTF8
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MP
|
||||
|
||||
|
||||
-- | All the explicitly documented fields of `os-release`.
|
||||
data OsRelease = OsRelease {
|
||||
name :: Maybe String
|
||||
, version :: Maybe String
|
||||
, id :: Maybe String
|
||||
, id_like :: Maybe String
|
||||
, version_codename :: Maybe String
|
||||
, version_id :: Maybe String
|
||||
, pretty_name :: Maybe String
|
||||
, ansi_color :: Maybe String
|
||||
, cpe_name :: Maybe String
|
||||
, home_url :: Maybe String
|
||||
, documentation_url :: Maybe String
|
||||
, support_url :: Maybe String
|
||||
, bug_report_url :: Maybe String
|
||||
, privacy_policy_url :: Maybe String
|
||||
, build_id :: Maybe String
|
||||
, variant :: Maybe String
|
||||
, variant_id :: Maybe String
|
||||
, logo :: Maybe String
|
||||
} deriving (Show)
|
||||
|
||||
emptyOsRelease :: OsRelease
|
||||
emptyOsRelease = OsRelease { name = Nothing
|
||||
, version = Nothing
|
||||
, id = Nothing
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = Nothing
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Nothing
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Nothing
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
|
||||
-- | Parse a single line assignment and extract the right hand side.
|
||||
-- This is only a subset of a shell parser, see
|
||||
-- https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
parseAssignment :: MP.Parsec Void String (String, String)
|
||||
parseAssignment =
|
||||
(,)
|
||||
<$> (MP.space *> key)
|
||||
<*> (MP.char '=' *> (MP.try qval <|> mempty) <* MP.space <* MP.eof)
|
||||
where
|
||||
dropSpace :: String -> String
|
||||
dropSpace = reverse . dropWhile (\x -> x == ' ' || x == '\t') . reverse
|
||||
|
||||
key :: MP.Parsec Void String String
|
||||
key = some (MP.try MP.alphaNumChar <|> MP.char '_')
|
||||
|
||||
qval :: MP.Parsec Void String String
|
||||
qval = do
|
||||
c <- MP.lookAhead MP.printChar
|
||||
case c of
|
||||
' ' -> pure ""
|
||||
'"' -> MP.char c *> val c <* MP.char c
|
||||
'\'' -> MP.char c *> val c <* MP.char c
|
||||
-- no quote, have to drop trailing spaces
|
||||
_ -> fmap dropSpace (some MP.alphaNumChar)
|
||||
val :: Char -> MP.Parsec Void String String
|
||||
val q = many (qspecial q <|> MP.noneOf (specials q)) -- noneOf may be too lax
|
||||
|
||||
qspecial :: Char -> MP.Parsec Void String Char
|
||||
qspecial q =
|
||||
fmap (!! 1)
|
||||
. choice'
|
||||
. fmap (\s -> MP.try . MP.chunk $ ['\\', s])
|
||||
$ (specials q)
|
||||
|
||||
specials :: Char -> [Char]
|
||||
specials q = [q, '\\', '$', '`']
|
||||
|
||||
|
||||
-- | Get all allAssignments as `(key, val)` from the `os-release`
|
||||
-- file contents.
|
||||
allAssignments :: String -- ^ file contents of os-release
|
||||
-> [(String, String)]
|
||||
allAssignments = rights . fmap (MP.parse parseAssignment "") . lines
|
||||
|
||||
|
||||
-- | Parse the assignments into OsRelease.
|
||||
--
|
||||
-- This can't fail and will create an "empty" product type instead on
|
||||
-- failure.
|
||||
osRelease :: [(String, String)] -- ^ assignments
|
||||
-> OsRelease
|
||||
osRelease =
|
||||
(\case
|
||||
Error _ -> emptyOsRelease
|
||||
Success v -> v
|
||||
)
|
||||
. fromJSON
|
||||
. Object
|
||||
. HM.fromList
|
||||
. fmap (\(k, v) -> (T.toLower . T.pack $ k, String . T.pack $ v))
|
||||
|
||||
|
||||
-- | Tries to read `/etc/os-release` and `/usr/lib/os_release` in order.
|
||||
-- Throws an exception if both files do not exist.
|
||||
readOsRelease :: IO String
|
||||
readOsRelease = do
|
||||
let os_release1 :: Path Abs
|
||||
os_release1 = [abs|/etc/os-release|]
|
||||
let os_release2 :: Path Abs
|
||||
os_release2 = [abs|/usr/lib/os-release|]
|
||||
|
||||
bs <- readFile os_release1 <|> readFile os_release2
|
||||
-- os-release is utf8
|
||||
pure . UTF8.toString $ bs
|
||||
|
||||
|
||||
-- | Tries to read `/etc/os-release` and `/usr/lib/os_release` in order
|
||||
-- and parses into `OsRelease`. Throws an exception if both files do not
|
||||
-- exist.
|
||||
parseOsRelease :: IO OsRelease
|
||||
parseOsRelease = fmap (osRelease . allAssignments) readOsRelease
|
||||
|
||||
|
||||
deriveJSON defaultOptions ''OsRelease
|
||||
Reference in New Issue
Block a user