Compare commits

..

23 Commits

Author SHA1 Message Date
2de549862a Get rid of language-bash
And clean up detection logic a bit. We also don't
read /etc/lsb-release manually more, since it's format is
not specified.
2020-06-27 18:54:20 +02:00
c502f70f68 Update DOCKER_REV 2020-06-27 01:38:38 +02:00
cbf076740a Merge branch 'hadrian' 2020-06-20 18:59:01 +02:00
86c144b285 Merge remote-tracking branch 'remotes/origin/merge-requests/12' into hadrian 2020-06-20 14:40:47 +02:00
7ec6e8604c Slight style changes 2020-06-20 14:37:38 +02:00
de70f4820f Merge remote-tracking branch 'origin/merge-requests/13' into hadrian 2020-06-20 12:39:21 +02:00
Brian McKenna
febe6fcb35 Fix behaviour of non-Hadrian builds
getFileStatus will resolve symbolic links. getSymbolicLinkStatus doesn't.
2020-06-20 03:38:41 +00:00
Brian McKenna
3055529d4c Update GHCupDownloads with ghcup-0.0.2.json content 2020-06-19 23:17:34 +00:00
Brian McKenna
d276bfb3ec Extract Hadrian logic to isHadrian function with comment 2020-06-19 23:06:46 +00:00
9db0664465 Add hie.yaml 2020-06-19 19:44:30 +02:00
e9c727647a Update .gitigore 2020-06-19 19:42:55 +02:00
55eef8a3d3 Merge branch 'redhat' 2020-06-19 19:22:56 +02:00
d07ad3eb26 Update ghcup-0.0.2.json with redhat wrt #29 2020-06-19 10:49:31 +02:00
Sigmund Vestergaard
ad53b141c7 Removed reference to specific version of RHEL in GHCupDownloads.hs 2020-06-19 10:49:31 +02:00
Sigmund Vestergaard
23c13a07a9 Added support for RedHat in lib/GHCup/Data/GHCupDownloads.hs 2020-06-19 10:49:31 +02:00
Brian McKenna
a186b07763 Support Hadrian provided bindists
Fixes #31
2020-06-18 14:03:51 +00:00
puffnfresh
1ca628aba1 Fix dlSubdir of ghc-8.10.1-x86_64-unknown-linux for Linux_Alpine 2020-06-18 07:52:34 -04:00
8f4ef48891 Merge remote-tracking branch 'origin/merge-requests/10' 2020-06-14 11:50:02 +02:00
Artur Gajowy
d852ab3415 Use BOOTSTAP_HASKELL_{GHC,CABAL}_VERSION env vars as overrides 2020-06-14 00:15:50 +02:00
a1bcc4b51f Strip release binaries 2020-05-30 22:15:48 +02:00
be93a98bd4 Update ToolRequirements for Ubuntu, add Debian
Fixes #26
2020-05-17 18:43:58 +02:00
85054d9c76 Show note for versions that don't have a bindist 2020-05-15 21:53:45 +02:00
6c95218daf Support multiple installed versions of cabal
Fixes #23
2020-05-13 21:33:45 +02:00
17 changed files with 874 additions and 316 deletions

3
.gitignore vendored
View File

@@ -1,3 +1,6 @@
.ghci
.vim
codex.tags
dist-newstyle/
cabal.project.local
.stack-work/

View File

@@ -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

View File

@@ -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}

View File

@@ -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}"

View File

@@ -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

View File

@@ -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)

View File

@@ -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

View File

@@ -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",

View File

@@ -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
View File

@@ -0,0 +1,4 @@
cradle:
cabal:
- path: "."
component: "ghcup:lib:ghcup"

View File

@@ -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|])

View File

@@ -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)]
)

View File

@@ -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"
]
""

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View 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