Compare commits

..

1 Commits

Author SHA1 Message Date
527d336f3a Also build 32bit release artifact 2020-04-19 22:03:20 +02:00
28 changed files with 193 additions and 2984 deletions

View File

@@ -57,7 +57,7 @@ variables:
script:
- ./.gitlab/script/ghcup_version.sh
variables:
JSON_VERSION: "0.0.2"
JSON_VERSION: "0.0.1"
.test_ghcup_version:linux:
extends:
@@ -161,7 +161,7 @@ release:linux:32bit:
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "i386-linux-ghcup"
ARTIFACT: "x86_64-linux-ghcup"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"

View File

@@ -42,8 +42,7 @@ chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
# utils
apk add --no-cache \
bash \
git
bash
## Package specific
apk add --no-cache \

View File

@@ -3,7 +3,7 @@
set -eux
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"

View File

@@ -10,17 +10,13 @@ ecabal() {
cabal --store-dir="$(pwd)"/.store "$@"
}
git describe
# build
ecabal update
if [ "${OS}" = "LINUX" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static'
elif [ "${OS}" = "FREEBSD" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections'
ecabal build -w ghc-${GHC_VERSION} -fcurl --ghc-options='-split-sections -optl-static'
else
ecabal build -w ghc-${GHC_VERSION}
ecabal build -w ghc-${GHC_VERSION} -fcurl
fi
mkdir out

View File

@@ -14,16 +14,15 @@ eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
}
git describe
### build
ecabal update
if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION}
ecabal build -w ghc-${GHC_VERSION} -fcurl
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
ecabal build -w ghc-${GHC_VERSION}
fi
cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
@@ -71,11 +70,7 @@ ghci-$(ghc --numeric-version) --version
# test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "DARWIN" ] ; then
eghcup install 8.4.4
else # test wget a bit
eghcup --downloader=wget install 8.4.4
fi
eghcup install 8.4.4
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup set 8.4.4
eghcup set 8.4.4

View File

@@ -43,15 +43,3 @@ Kazu Yamamoto [explained it in his PR](https://github.com/yesodweb/wai/pull/752#
1. Brittany
2. mtl-style preferred
3. no overly pointfree style
## Code structure
Main functionality is in `GHCup` module. Utility functions are
organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
Anything dealing with ghcup specific directories is in
`GHCup.Utils.Dirs`.
Download information on where to fetch bindists from is in
`GHCup.Data.GHCupDownloads`.

View File

@@ -68,15 +68,6 @@ handles your haskell packages and can demand that [a specific version](https://c
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
`MANPATH` may be required to be unset.
### Shell-completion
Shell completions are in `shell-completions`.
For bash: install `shell-completions/bash`
as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros).
## Design goals
1. simplicity

View File

@@ -4,11 +4,8 @@
2. Add/fix downloads to `GHCupDownloads` module, then run `ghcup-gen gen` to generate the new json and validate it via `ghcup-gen check`.
3. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
3. Commit and git push with tag. Wait for tests to succeed.
4. Download release artifacts and upload them `downloads.haskell.org/ghcup`
5. Add release artifacts to GHCupDownloads (see point 2.)
6. Upload the final `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
5. Build ghcup releases for Linux (fully static), mac (with `-fcurl`) and FreeBSD (with `-fcurl`). Upload to `webhost.haskell.org/ghcup/bin/` and update symlinks.

20
TODO.md
View File

@@ -2,39 +2,27 @@
## Now
* try to run exe before upgrade (backup to ~/.ghcup/bin/ghcup.old)
* allow to build 8.8
* curl DL does not cache json
* explain environment variables
* add --keep=<always|error> option
* allow to switch to curl/wget at runtime
* cross support
* installing multiple versions of the same
* proper test suite
* add more logging
* move out GHCup.Version module, bc it's not library-ish
## Maybe
* version ranges in json
* maybe: changelog Show the changelog of a GHC release (online)
* sign the JSON? (Or check gpg keys?)
* testing (especially distro detection -> unit tests)
## Later
* i386 support
* add support for RC/alpha/HEAD versions
## Cleanups
* too many decodeutf8
* avoid alternative for IO
* use plucky or oops instead of Excepts
## Questions
* move out GHCup.Version module, bc it's not library-ish?
* mirror support
* interactive handling when distro doesn't exist and we know the tarball is incompatible?
* ghcup-with wrapper to execute a command with a given ghc in PATH?

View File

@@ -2,7 +2,7 @@
{-# LANGUAGE QuasiQuotes #-}
module GHCup.Data.GHCupDownloads where
module GHCupDownloads where
import GHCup.Types
import GHCup.Utils.Version.QQ
@@ -827,7 +827,7 @@ ghc_883_32_musl :: DownloadInfo
ghc_883_32_musl = DownloadInfo
[uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.3-musl/ghc-8.8.3-i386-unknown-linux-musl.tar.xz|]
(Just [rel|ghc-8.8.3|])
"7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4"
"23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec"
@@ -951,24 +951,6 @@ cabal_3000_64_darwin = DownloadInfo
Nothing
"d4857e068560515e4cbb0e8ca124c370e07892f2a28804d87152834e5fe2b845"
cabal_3000_64_freebsd :: DownloadInfo
cabal_3000_64_freebsd = DownloadInfo
[uri|https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz&dl=1|]
Nothing
"d97b6469ed612a1367ad1032d0722469ee5277668879694d7d4336233b937516"
cabal_3000_32_alpine :: DownloadInfo
cabal_3000_32_alpine = DownloadInfo
[uri|https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.0.0.0-i386-alpine-linux-musl.tar.xz&dl=1|]
Nothing
"a4191cd5a645b00e6a9c53abe6f3cb91fe700de7d7c520c9cb36ce8ec5c9919a"
cabal_3000_64_alpine :: DownloadInfo
cabal_3000_64_alpine = DownloadInfo
[uri|https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.0.0.0-x86_64-alpine-linux-musl.tar.xz&dl=1|]
Nothing
"7b35e5986aba4a40fc37141cbde26612bfc916e95a2d2ff35a413612d8c7cd3a"
---------------------
@@ -994,24 +976,6 @@ cabal_3200_64_darwin = DownloadInfo
Nothing
"9197c17d2ece0f934f5b33e323cfcaf486e4681952687bc3d249488ce3cbe0e9"
cabal_3200_64_freebsd :: DownloadInfo
cabal_3200_64_freebsd = DownloadInfo
[uri|https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz&dl=1|]
Nothing
"e4dc00ab7fef51354e7624dd03e49c6bb684887fc95acb9b33bc52f357a5ef8c"
cabal_3200_32_alpine :: DownloadInfo
cabal_3200_32_alpine = DownloadInfo
[uri|https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz&dl=1|]
Nothing
"4aaa52fbc337ae1ef855a2aa2808186580b21ec36883aafec7473e7d899bc5ec"
cabal_3200_64_alpine :: DownloadInfo
cabal_3200_64_alpine = DownloadInfo
[uri|https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz&dl=1|]
Nothing
"c1f3c21a5307cea8d2a0bd9a2eab9f56f3dd90e947ae64e231f909024980992b"
@@ -1062,7 +1026,7 @@ ghcupDownloads = M.fromList
, M.fromList
[ ( [vver|7.10.3|]
, VersionInfo
[Base [pver|4.8.2.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/7.10.3/docs/html/users_guide/release-7-10-1.html|]
)
@@ -1108,7 +1072,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.0.2|]
, VersionInfo
[Base [pver|4.9.1.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html|]
)
@@ -1154,7 +1118,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.2.2|]
, VersionInfo
[Base [pver|4.10.1.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html|]
)
@@ -1206,7 +1170,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.1|]
, VersionInfo
[Base [pver|4.11.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html|]
)
@@ -1245,7 +1209,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.2|]
, VersionInfo
[Base [pver|4.11.1.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html|]
)
@@ -1295,7 +1259,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.3|]
, VersionInfo
[Base [pver|4.11.1.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html|]
)
@@ -1344,7 +1308,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.4|]
, VersionInfo
[Base [pver|4.11.1.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.4.4/docs/html/users_guide/8.4.4-notes.html|]
)
@@ -1398,7 +1362,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.1|]
, VersionInfo
[Base [pver|4.12.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html|]
)
@@ -1448,7 +1412,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.2|]
, VersionInfo
[Base [pver|4.12.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html|]
)
@@ -1492,7 +1456,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.3|]
, VersionInfo
[Base [pver|4.12.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html|]
)
@@ -1546,7 +1510,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.4|]
, VersionInfo
[Base [pver|4.12.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html|]
)
@@ -1595,7 +1559,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.5|]
, VersionInfo
[Base [pver|4.12.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html|]
)
@@ -1648,7 +1612,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.8.1|]
, VersionInfo
[Base [pver|4.13.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html|]
)
@@ -1701,7 +1665,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.8.2|]
, VersionInfo
[Base [pver|4.13.0.0|]]
[]
(Just
[uri|https://downloads.haskell.org/ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html|]
)
@@ -1754,7 +1718,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.8.3|]
, VersionInfo
[Recommended, Base [pver|4.13.0.0|]]
[Recommended]
(Just
[uri|https://downloads.haskell.org/ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html|]
)
@@ -1807,7 +1771,7 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.10.1|]
, VersionInfo
[Latest, Base [pver|4.14.0.0|]]
[Latest]
(Just
[uri|https://downloads.haskell.org/ghc/8.10.1/docs/html/users_guide/8.10.1-notes.html|]
)
@@ -1925,9 +1889,7 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3000_64_linux)]
)
, (Linux Alpine, M.fromList [(Nothing, cabal_3000_64_alpine)])
, (Darwin , M.fromList [(Nothing, cabal_3000_64_darwin)])
, (FreeBSD, M.fromList [(Nothing, cabal_3000_64_freebsd)])
, (Darwin, M.fromList [(Nothing, cabal_3000_64_darwin)])
]
)
, ( A_32
@@ -1935,7 +1897,6 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3000_32_linux)]
)
, (Linux Alpine, M.fromList [(Nothing, cabal_3000_32_alpine)])
]
)
]
@@ -1957,9 +1918,7 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3200_64_linux)]
)
, (Linux Alpine, M.fromList [(Nothing, cabal_3200_64_alpine)])
, (Darwin , M.fromList [(Nothing, cabal_3200_64_darwin)])
, (FreeBSD, M.fromList [(Nothing, cabal_3200_64_freebsd)])
, (Darwin, M.fromList [(Nothing, cabal_3200_64_darwin)])
]
)
, ( A_32
@@ -1967,7 +1926,6 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3200_32_linux)]
)
, (Linux Alpine, M.fromList [(Nothing, cabal_3200_32_alpine)])
]
)
]

View File

@@ -1,7 +1,7 @@
module GHCup.Data.GHCupInfo where
module GHCupInfo where
import GHCup.Data.GHCupDownloads
import GHCup.Data.ToolRequirements
import GHCupDownloads
import ToolRequirements
import GHCup.Types

View File

@@ -10,10 +10,10 @@
module Main where
import GHCup.Data.GHCupInfo
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import GHCupInfo
import Data.Aeson ( eitherDecode, encode )
import Data.Aeson.Encode.Pretty

View File

@@ -1,11 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module GHCup.Data.ToolRequirements where
module ToolRequirements where
import GHCup.Types
import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ
import qualified Data.Map as M
@@ -62,35 +61,6 @@ toolRequirements = M.fromList
)
]
)
, ( Linux CentOS
, M.fromList
[ ( Nothing
, Requirements
[ "gcc"
, "gcc-c++"
, "gmp"
, "make"
, "ncurses"
, "ncurses-compat-libs"
, "xz"
, "perl"
]
""
),
( Just [vers|7|]
, Requirements
[ "gcc"
, "gcc-c++"
, "gmp"
, "make"
, "ncurses"
, "xz"
, "perl"
]
""
)
]
)
, ( Darwin
, M.fromList
[ ( Nothing

View File

@@ -63,7 +63,6 @@ validate dls = do
checkGHCisSemver
forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
_ <- checkGHCHasBaseVersion
-- exit
e <- liftIO $ readIORef ref
@@ -86,7 +85,7 @@ validate dls = do
[i|FreeBSD missing for #{t} #{v'} #{arch}|]
checkUniqueTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool
let allTags = join $ fmap snd $ availableToolVersions dls tool
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)
@@ -106,10 +105,8 @@ validate dls = do
lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|]
addError
where
isUniqueTag Latest = True
isUniqueTag Recommended = True
isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False
isUniqueTag Latest = True
isUniqueTag Recommended = True
checkGHCisSemver = do
let ghcVers = toListOf (ix GHC % to M.keys % folded) dls
@@ -121,24 +118,13 @@ validate dls = do
-- a tool must have at least one of each mandatory tags
checkMandatoryTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool
let allTags = join $ fmap snd $ availableToolVersions dls tool
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
addError
True -> pure ()
-- all GHC versions must have a base tag
checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, tags) -> case any isBase tags of
False -> do
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
addError
True -> pure ()
isBase (Base _) = True
isBase _ = False
validateTarballs :: ( Monad m
, MonadLogger m
@@ -175,7 +161,7 @@ validateTarballs dls = do
where
downloadAll dli = do
let settings = Settings True False Never Curl
let settings = Settings True False
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())

View File

@@ -32,8 +32,7 @@ import Data.Bifunctor
import Data.Char
import Data.Either
import Data.Functor
import Data.List ( intercalate, sort )
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List ( intercalate )
import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text )
@@ -74,8 +73,6 @@ data Options = Options
, optCache :: Bool
, optUrlSource :: Maybe URI
, optNoVerify :: Bool
, optKeepDirs :: KeepDirs
, optsDownloader :: Downloader
-- commands
, optCommand :: Command
}
@@ -95,10 +92,6 @@ data Command
data ToolVersion = ToolVersion Version
| ToolTag Tag
prettyToolVer :: ToolVersion -> String
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
@@ -110,9 +103,8 @@ data SetGHCOptions = SetGHCOptions
}
data ListOptions = ListOptions
{ lTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
, lRawFormat :: Bool
{ lTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
}
data RmOptions = RmOptions
@@ -166,31 +158,6 @@ opts =
(short 'n' <> long "no-verify" <> help
"Skip tarball checksum verification"
)
<*> option
(eitherReader keepOnParser)
( long "keep"
<> metavar "<always|errors|never>"
<> help
"Keep build directories? (default: never)"
<> value Never
<> hidden
)
<*> option
(eitherReader downloaderParser)
( long "downloader"
#if defined(INTERNAL_DOWNLOADER)
<> metavar "<internal|curl|wget>"
<> help
"Downloader to use (default: internal)"
<> value Internal
#else
<> metavar "<curl|wget>"
<> help
"Downloader to use (default: curl)"
<> value Curl
#endif
<> hidden
)
<*> com
where
parseUri s' =
@@ -342,9 +309,6 @@ listOpts =
)
)
)
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
rmOpts :: Parser RmOptions
rmOpts = RmOptions <$> versionArgument
@@ -503,9 +467,6 @@ tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x)
Left _ -> Left [i|Invalid PVP version for base #{ver'}|]
other -> Left ([i|Unknown tag #{other}|])
versionEither :: String -> Either String Version
@@ -534,24 +495,6 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
where t = T.toLower (T.pack s')
keepOnParser :: String -> Either String KeepDirs
keepOnParser s' | t == T.pack "always" = Right Always
| t == T.pack "errors" = Right Errors
| t == T.pack "never" = Right Never
| otherwise = Left ("Unknown keep value: " <> s')
where t = T.toLower (T.pack s')
downloaderParser :: String -> Either String Downloader
downloaderParser s' | t == T.pack "curl" = Right Curl
| t == T.pack "wget" = Right Wget
#if defined(INTERNAL_DOWNLOADER)
| t == T.pack "internal" = Right Internal
#endif
| otherwise = Left ("Unknown downloader value: " <> s')
where t = T.toLower (T.pack s')
platformParser :: String -> Either String PlatformRequest
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
Right r -> pure r
@@ -627,10 +570,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
toSettings :: Options -> Settings
toSettings Options {..} =
let cache = optCache
noVerify = optNoVerify
keepDirs = optKeepDirs
downloader = optsDownloader
let cache = optCache
noVerify = optNoVerify
in Settings { .. }
@@ -683,31 +624,21 @@ main = do
<> help "Show the numeric version (for use in scripts)"
<> hidden
)
let listCommands = infoOption
"install set rm install-cabal list upgrade compile debug-info tool-requirements changelog"
( long "list-commands"
<> help "List available commands for shell completion"
<> internal
)
let main_footer = [i|Discussion:
ghcup installs the Glasgow Haskell Compiler from the official
release channels, enabling you to easily switch between different
versions. It maintains a self-contained ~/.ghcup directory.
ENV variables:
* TMPDIR: where ghcup does the work (unpacking, building, ...)
* GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME)
versions.
Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
customExecParser
(prefs showHelpOnError)
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands)
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp)
(footerDoc (Just $ text main_footer))
)
>>= \opt@Options {..} -> do
let settings@Settings{..} = toSettings opt
let settings = toSettings opt
-- create ~/.ghcup dir
ghcdir <- ghcupBaseDir
@@ -753,7 +684,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TagNotFound
]
let runListGHC = runE @'[] . runLogger
let runListGHC =
runLogger
. flip runReaderT settings
. runE @'[FileDoesNotExistError]
let runRmGHC =
runLogger . flip runReaderT settings . runE @'[NotInstalled]
@@ -818,9 +752,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(GHCupInfo treq dls) <-
( runLogger
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
. runE @'[JSONError , DownloadFailed]
$ liftE
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource)
$ getDownloads (maybe GHCupURL OwnSource optUrlSource)
)
>>= \case
VRight r -> pure r
@@ -845,18 +779,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
[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|]
runLogger
($(logError) [i|Build failed with #{e}
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
)
pure $ ExitFailure 3
VLeft e -> do
runLogger $ do
@@ -876,13 +802,6 @@ Make sure to clean up #{tmpdir} afterwards.|])
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}|]
@@ -906,12 +825,11 @@ Make sure to clean up #{tmpdir} afterwards.|])
List (ListOptions {..}) ->
(runListGHC $ do
l <- listVersions dls lTool lCriteria
pure l
liftIO $ listVersions dls lTool lCriteria
)
>>= \case
VRight r -> do
liftIO $ printListResult lRawFormat r
liftIO $ printListResult r
pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
@@ -956,11 +874,11 @@ Make sure to clean up #{tmpdir} afterwards.|])
[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}
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.|])
Make sure to clean up #{tmpdir} afterwards.|]
)
pure $ ExitFailure 9
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
@@ -978,11 +896,10 @@ Make sure to clean up #{tmpdir} afterwards.|])
)
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.|])
runLogger
($(logError) [i|Build failed with #{e}
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
)
pure $ ExitFailure 10
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
@@ -1077,70 +994,44 @@ fromVersion :: Monad m
-> Excepts '[TagNotFound] m Version
fromVersion av Nothing tool =
getRecommended av tool ?? TagNotFound Recommended tool
fromVersion av (Just (ToolVersion v)) _ = do
case pvp $ prettyVer v of
Left _ -> pure v
Right (PVP (major' :|[minor'])) ->
case getLatestGHCFor (fromIntegral major') (fromIntegral minor') av of
Just v' -> pure v'
Nothing -> pure v
Right _ -> pure v
fromVersion _ (Just (ToolVersion v)) _ = pure v
fromVersion av (Just (ToolTag Latest)) tool =
getLatest av tool ?? TagNotFound Latest tool
fromVersion av (Just (ToolTag Recommended)) tool =
getRecommended av tool ?? TagNotFound Recommended tool
fromVersion av (Just (ToolTag (Base pvp''))) GHC =
getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion _ (Just (ToolTag t')) tool =
throwE $ TagNotFound t' tool
printListResult :: Bool -> [ListResult] -> IO ()
printListResult raw lr = do
printListResult :: [ListResult] -> IO ()
printListResult lr = do
-- https://gitlab.haskell.org/ghc/ghc/issues/8118
setLocaleEncoding utf8
let
formatted =
gridString
( (if raw then [] else [column expand left def def])
++ [ column expand left def def
, column expand left def def
, column expand left def def
, column expand left def def
]
)
. (\x -> if raw
then x
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
)
[ column expand left def def
, column expand left def def
, column expand left def def
, column expand left def def
, column expand left def def
]
$ fmap
(\ListResult {..} ->
let marks = if
| lSet -> (color Green "✔✔")
| lInstalled -> (color Green "")
| otherwise -> (color Red "")
in (if raw then [] else [marks])
++ [ fmap toLower . show $ lTool
, T.unpack . prettyVer $ lVer
, intercalate "," $ (fmap printTag $ sort lTag)
, intercalate ","
$ (if fromSrc then [color' Blue "compiled"] else mempty)
++ (if lStray then [color' Blue "stray"] else mempty)
]
[ if
| lSet -> (color Green "✔✔")
| lInstalled -> (color Green "")
| otherwise -> (color Red "")
, fmap toLower . show $ lTool
, T.unpack . prettyVer $ lVer
, intercalate "," $ ((fmap . fmap) toLower . fmap show $ lTag)
, if fromSrc then (color Blue "compiled") else mempty
]
)
lr
putStrLn $ formatted
where
printTag Recommended = color' Green "recommended"
printTag Latest = color' Yellow "latest"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
color' = case raw of
True -> flip const
False -> color
checkForUpdates :: (MonadThrow m, MonadIO m, MonadFail m, MonadLogger m)
checkForUpdates :: (MonadIO m, MonadFail m, MonadLogger m)
=> GHCupDownloads
-> m ()
checkForUpdates dls = do
@@ -1166,7 +1057,7 @@ checkForUpdates dls = do
where
latestInstalled tool = (fmap lVer . lastMay)
<$> (listVersions dls (Just tool) (Just ListInstalled))
<$> liftIO (listVersions dls (Just tool) (Just ListInstalled))
prettyDebugInfo :: DebugInfo -> String

View File

@@ -1958,7 +1958,7 @@
"A_32": {
"Linux_Alpine": {
"unknown_versioning": {
"dlHash": "7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4",
"dlHash": "23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec",
"dlSubdir": "ghc-8.8.3",
"dlUri": "https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.3-musl/ghc-8.8.3-i386-unknown-linux-musl.tar.xz"
}

File diff suppressed because it is too large Load Diff

View File

@@ -21,8 +21,8 @@ source-repository head
type: git
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
flag internal-downloader
description: Compile the internal downloader, which links against OpenSSL
flag Curl
description: Use curl instead of http-io-streams for download
default: False
manual: True
@@ -279,9 +279,6 @@ library
exposed-modules:
GHCup
GHCup.Data.GHCupDownloads
GHCup.Data.GHCupInfo
GHCup.Data.ToolRequirements
GHCup.Download
GHCup.Download.Utils
GHCup.Errors
@@ -304,14 +301,15 @@ library
-- other-extensions:
hs-source-dirs: lib
if flag(internal-downloader)
if !flag(curl)
import:
, HsOpenSSL
, http-io-streams
, io-streams
, terminal-progress-bar
exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER
else
cpp-options: -DCURL
executable ghcup
import:
@@ -346,10 +344,6 @@ executable ghcup
hs-source-dirs: app/ghcup
default-language: Haskell2010
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
executable ghcup-gen
import:
config
@@ -378,6 +372,9 @@ executable ghcup-gen
--
main-is: Main.hs
other-modules:
GHCupDownloads
GHCupInfo
ToolRequirements
Validate
-- other-extensions:

View File

@@ -9,7 +9,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup where
@@ -97,15 +96,15 @@ installGHCBin bDls ver mpfReq = do
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
whenM (liftIO $ toolAlreadyInstalled GHC ver)
$ (throwE $ AlreadyInstalled GHC ver)
Settings {..} <- lift ask
Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version)
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
@@ -115,12 +114,24 @@ installGHCBin bDls ver mpfReq = do
-- the subdir of the archive where we do the work
let workdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
liftE $ runBuildAction tmpUnpack (Just ghcdir) (installGHC' workdir ghcdir)
-- Be careful about cleanup. We must catch both pure exceptions
-- as well as async ones.
flip onException
(liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
$ catchAllE
(\es -> do
liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
>> throwE (BuildFailed workdir es)
)
$ installGHC' workdir ghcdir
-- only clean up dir if the build succeeded
liftIO $ deleteDirRecursive tmpUnpack
liftE $ postGHCInstall ver
where
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
installGHC' :: (MonadLogger m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> Path Abs -- ^ Path to install to
@@ -183,7 +194,7 @@ installCabalBin bDls ver mpfReq = do
pure ()
where
-- | Install an unpacked cabal distribution.
-- | Install an unpacked cabal distribution.
installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> Path Abs -- ^ Path to install to
@@ -294,38 +305,25 @@ data ListResult = ListResult
, lVer :: Version
, lTag :: [Tag]
, lInstalled :: Bool
, lSet :: Bool -- ^ currently active version
, fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
, lSet :: Bool
, fromSrc :: Bool
}
deriving (Eq, Ord, Show)
deriving Show
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
availableToolVersions av tool = view
(at tool % non Map.empty % to (fmap (_viTags)))
availableToolVersions :: GHCupDownloads -> Tool -> [(Version, [Tag])]
availableToolVersions av tool = toListOf
(ix tool % to (fmap (\(v, vi) -> (v, (_viTags vi))) . Map.toList) % folded)
av
-- | List all versions from the download info, as well as stray
-- versions.
listVersions :: (MonadLogger m, MonadIO m)
=> GHCupDownloads
listVersions :: GHCupDownloads
-> Maybe Tool
-> Maybe ListCriteria
-> m [ListResult]
-> IO [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)
case t of
-- append stray GHCs
GHC -> do
slr <- strayGHCs avTools
pure $ (sort (slr ++ lr))
_ -> pure lr
filter' <$> forM (availableToolVersions av t) (toListResult t)
Nothing -> do
ghcvers <- listVersions av (Just GHC) criteria
cabalvers <- listVersions av (Just Cabal) criteria
@@ -333,60 +331,21 @@ listVersions av lt criteria = case lt of
pure (ghcvers <> cabalvers <> ghcupvers)
where
strayGHCs :: (MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayGHCs avTools = do
ghcdir <- liftIO $ ghcupGHCBaseDir
fs <- liftIO $ liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir
fmap catMaybes $ forM fs $ \(toFilePath -> f) -> do
case version . decUTF8Safe $ f of
Right v' -> do
case Map.lookup v' avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (== v')) $ ghcSet
fromSrc <- liftIO $ ghcSrcInstalled v'
pure $ Just $ ListResult
{ lTool = GHC
, lVer = v'
, lTag = []
, lInstalled = True
, lStray = maybe True (const False) (Map.lookup v' avTools)
, ..
}
Left e -> do
$(logWarn)
[i|Could not parse version of stray directory #{toFilePath ghcdir}/#{f}: #{e}|]
pure Nothing
toListResult :: Tool -> (Version, [Tag]) -> IO ListResult
toListResult t (v, tags) = case t of
GHC -> do
lSet <- fmap (maybe False (== v)) $ ghcSet
lInstalled <- ghcInstalled v
fromSrc <- ghcSrcInstalled v
pure ListResult { lVer = v, lTag = tags, lTool = t, lStray = False, .. }
pure ListResult { lVer = v, lTag = tags, lTool = t, .. }
Cabal -> do
lSet <- fmap (== v) $ cabalSet
let lInstalled = lSet
pure ListResult { lVer = v
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, ..
}
pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. }
GHCup -> do
let lSet = prettyPVP ghcUpVer == prettyVer v
let lInstalled = lSet
pure ListResult { lVer = v
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, ..
}
pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. }
filter' :: [ListResult] -> [ListResult]
@@ -521,10 +480,20 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
ghcdir <- liftIO $ ghcupGHCDir tver
liftE $ runBuildAction
tmpUnpack
(Just ghcdir)
(compile bghc ghcdir workdir >> markSrcBuilt ghcdir workdir)
-- Be careful about cleanup. We must catch both pure exceptions
-- as well as async ones.
flip onException
(liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
$ catchAllE
(\es ->
liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
>> throwE (BuildFailed workdir es)
)
$ compile bghc ghcdir workdir
markSrcBuilt ghcdir workdir
-- only clean up dir if the build succeeded
liftIO $ deleteDirRecursive tmpUnpack
reThrowAll GHCupSetError $ postGHCInstall tver
pure ()
@@ -644,11 +613,7 @@ compileCabal dls tver bghc jobs patchdir = do
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
liftE $ runBuildAction
tmpUnpack
Nothing
(compile workdir)
reThrowAll (BuildFailed workdir) $ compile workdir
-- only clean up dir if the build succeeded
liftIO $ deleteDirRecursive tmpUnpack

View File

@@ -11,7 +11,7 @@
module GHCup.Download where
#if defined(INTERNAL_DOWNLOADER)
#if !defined(CURL)
import GHCup.Download.IOStreams
import GHCup.Download.Utils
#endif
@@ -35,7 +35,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Aeson
#if defined(INTERNAL_DOWNLOADER)
#if !defined(CURL)
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
#endif
@@ -43,11 +43,10 @@ import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
import Data.Time.Clock.POSIX
#if defined(INTERNAL_DOWNLOADER)
#if !defined(CURL)
import Data.Time.Format
#endif
import Data.Versions
import Data.Word8
import GHC.IO.Exception
import HPath
import HPath.IO as HIO
@@ -58,14 +57,12 @@ import Prelude hiding ( abs
, writeFile
)
import System.IO.Error
import System.Posix.Env.ByteString ( getEnv )
import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L
#if defined(INTERNAL_DOWNLOADER)
#if !defined(CURL)
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as M
import qualified Data.Text as T
@@ -85,48 +82,6 @@ import qualified System.Posix.RawFilePath.Directory
------------------
-- | Like 'getDownloads', but tries to fall back to
-- cached ~/.ghcup/cache/ghcup-<format-ver>.json
getDownloadsF :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
, MonadIO m
, MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader Settings m
)
=> URLSource
-> Excepts
'[JSONError , DownloadFailed , FileDoesNotExistError]
m
GHCupInfo
getDownloadsF urlSource = do
case urlSource of
GHCupURL ->
liftE
$ handleIO (\_ -> readFromCache)
$ catchE @_ @'[JSONError , FileDoesNotExistError]
(\(DownloadFailed _) -> readFromCache)
$ getDownloads urlSource
(OwnSource _) -> liftE $ getDownloads urlSource
(OwnSpec _) -> liftE $ getDownloads urlSource
where
readFromCache = do
lift $ $(logWarn)
[i|Could not get download info, trying cached version (this may not be recent!)|]
let path = view pathL' ghcupURL
cacheDir <- liftIO $ ghcupCacheDir
json_file <- (cacheDir </>) <$> urlBaseName path
bs <-
handleIO' NoSuchThing
(\_ -> throwE $ FileDoesNotExistError (toFilePath json_file))
$ liftIO
$ readFile json_file
lE' JSONDecodeError $ eitherDecode' bs
-- | Downloads the download information! But only if we need to ;P
getDownloads :: ( FromJSONKey Tool
, FromJSONKey Version
@@ -136,7 +91,6 @@ getDownloads :: ( FromJSONKey Tool
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader Settings m
)
=> URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
@@ -162,12 +116,7 @@ getDownloads urlSource = do
--
-- Always save the local file with the mod time of the remote file.
smartDl :: forall m1
. ( MonadCatch m1
, MonadIO m1
, MonadFail m1
, MonadLogger m1
, MonadReader Settings m1
)
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
=> URI
-> Excepts
'[ FileDoesNotExistError
@@ -199,38 +148,31 @@ getDownloads urlSource = do
Just modTime -> do
fileMod <- liftIO $ getModificationTime json_file
if modTime > fileMod
then dlWithMod modTime json_file
then do
bs <- liftE $ downloadBS uri'
liftIO $ writeFileWithModTime modTime json_file bs
pure bs
else liftIO $ readFile json_file
Nothing -> do
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
dlWithoutMod json_file
liftIO $ deleteFile json_file
liftE $ downloadBS uri'
else -- access in less than 5 minutes, re-use file
liftIO $ readFile json_file
else do
liftIO $ createDirIfMissing newDirPerms cacheDir
getModTime >>= \case
Just modTime -> dlWithMod modTime json_file
Just modTime -> do
bs <- liftE $ downloadBS uri'
liftIO $ writeFileWithModTime modTime json_file bs
pure bs
Nothing -> do
-- although we don't know last-modified, we still save
-- it to a file, so we might use it in offline mode
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
dlWithoutMod json_file
liftE $ downloadBS uri'
where
dlWithMod modTime json_file = do
bs <- liftE $ downloadBS uri'
liftIO $ writeFileWithModTime modTime json_file bs
pure bs
dlWithoutMod json_file = do
bs <- liftE $ downloadBS uri'
liftIO $ hideError doesNotExistErrorType $ deleteFile json_file
liftIO $ writeFileL json_file (Just newFilePerms) bs
liftIO $ setModificationTime json_file (fromIntegral @Int 0)
pure bs
getModTime = do
#if !defined(INTERNAL_DOWNLOADER)
#if defined(CURL)
pure Nothing
#else
headers <-
@@ -329,19 +271,12 @@ download dli dest mfn
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
>> (throwE . DownloadFailed $ e)
) $ do
lift getDownloader >>= \case
Curl -> do
o' <- liftIO getCurlOpts
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
(o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing
Wget -> do
o' <- liftIO getWgetOpts
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" True
(o' ++ ["-O", toFilePath destFile , serializeURIRef' $ view dlUri dli]) Nothing Nothing
#if defined(INTERNAL_DOWNLOADER)
Internal -> do
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
liftE $ downloadToFile https host fullPath port destFile
#if defined(CURL)
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
#else
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
liftE $ downloadToFile https host fullPath port destFile
#endif
liftE $ checkDigest dli destFile
@@ -394,7 +329,7 @@ downloadCached dli mfn = do
-- | This is used for downloading the JSON.
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
downloadBS :: (MonadCatch m, MonadIO m)
=> URI
-> Excepts
'[ FileDoesNotExistError
@@ -421,33 +356,18 @@ downloadBS uri'
where
scheme = view (uriSchemeL' % schemeBSL') uri'
path = view pathL' uri'
#if defined(INTERNAL_DOWNLOADER)
dl https = do
#else
#if defined(CURL)
dl _ = do
#endif
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
lift getDownloader >>= \case
Curl -> do
o' <- liftIO getCurlOpts
let exe = [rel|curl|]
args = o' ++ ["-sSfL", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
Wget -> do
o' <- liftIO getWgetOpts
let exe = [rel|wget|]
args = o' ++ ["-qO-", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
#if defined(INTERNAL_DOWNLOADER)
Internal -> do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
liftE $ downloadBS' https host' fullPath' port'
let exe = [rel|curl|]
args = ["-sSfL", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
#else
dl https = do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
liftE $ downloadBS' https host' fullPath' port'
#endif
@@ -465,19 +385,3 @@ checkDigest dli file = do
let eDigest = view dlHash dli
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
-- | Get additional curl args from env. This is an undocumented option.
getCurlOpts :: IO [ByteString]
getCurlOpts =
getEnv "GHCUP_CURL_OPTS" >>= \case
Just r -> pure $ BS.split _space r
Nothing -> pure []
-- | Get additional wget args from env. This is an undocumented option.
getWgetOpts :: IO [ByteString]
getWgetOpts =
getEnv "GHCUP_WGET_OPTS" >>= \case
Just r -> pure $ BS.split _space r
Nothing -> pure []

View File

@@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
module GHCup.Types where
@@ -82,9 +81,7 @@ data VersionInfo = VersionInfo
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest
| Recommended
| Base PVP
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, Show) -- FIXME: manual JSON instance
deriving (Ord, Eq, Show)
data Architecture = A_64
@@ -141,26 +138,12 @@ data URLSource = GHCupURL
data Settings = Settings
{ cache :: Bool
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
{ cache :: Bool
, noVerify :: Bool
}
deriving Show
data KeepDirs = Always
| Errors
| Never
deriving (Eq, Show, Ord)
data Downloader = Curl
| Wget
#if defined(INTERNAL_DOWNLOADER)
| Internal
#endif
deriving (Eq, Show, Ord)
data DebugInfo = DebugInfo
{ diBaseDir :: Path Abs
, diBinDir :: Path Abs

View File

@@ -37,24 +37,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON (UnknownTag x) = String (T.pack x)
instance FromJSON Tag where
parseJSON = withText "Tag" $ \t -> case T.unpack t of
"Latest" -> pure Latest
"Recommended" -> pure Recommended
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
Left e -> fail . show $ e
x -> pure (UnknownTag x)
instance ToJSON URI where
toJSON = toJSON . decUTF8Safe . serializeURIRef'
@@ -156,14 +143,6 @@ instance FromJSONKey Version where
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
instance ToJSON PVP where
toJSON = toJSON . prettyPVP
instance FromJSON PVP where
parseJSON = withText "PVP" $ \t -> case pvp t of
Right x -> pure x
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
instance ToJSONKey Tool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions

View File

@@ -162,7 +162,7 @@ ghcSrcInstalled ver = do
doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
ghcSet :: (MonadIO m) => m (Maybe Version)
ghcSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
ghcSet = do
ghcBin <- (</> [rel|ghc|]) <$> liftIO ghcupBinDir
@@ -222,23 +222,6 @@ getGHCForMajor major' minor' = do
$ semvers
-- | Get the latest available ghc for X.Y major version.
getLatestGHCFor :: Int -- ^ major version component
-> Int -- ^ minor version component
-> GHCupDownloads
-> Maybe Version
getLatestGHCFor major' minor' dls = do
join . fmap
(lastMay . filter
(\v -> case semver $ prettyVer v of
Right SemVer{..} -> fromIntegral _svMajor == major' && fromIntegral _svMinor == minor'
Left _ -> False
)
)
. preview (ix GHC % to Map.keys) $ dls
-----------------
@@ -296,11 +279,6 @@ getRecommended :: GHCupDownloads -> Tool -> Maybe Version
getRecommended av tool = headOf (ix tool % getTagged Recommended % to fst) $ av
-- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe Version
getLatestBaseVersion av pvpVer = headOf (ix GHC % getTagged (Base pvpVer) % to fst) av
-----------------------
--[ Settings Getter ]--
@@ -311,10 +289,6 @@ getCache :: MonadReader Settings m => m Bool
getCache = ask <&> cache
getDownloader :: MonadReader Settings m => m Downloader
getDownloader = ask <&> downloader
-------------
--[ Other ]--
@@ -410,40 +384,3 @@ getChangeLog dls tool (Right tag) = preview
% viChangeLog
% _Just
) dls
-- | Execute a build action while potentially cleaning up:
--
-- 1. the build directory, depending on the KeepDirs setting
-- 2. the install destination, depending on whether the build failed
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 ()
runBuildAction bdir instdir action = do
Settings {..} <- lift ask
flip
onException
(do
forM_ instdir $ \dir ->
liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir
when (keepDirs == Never)
$ liftIO
$ hideError doesNotExistErrorType
$ deleteDirRecursive bdir
)
$ catchAllE
(\es -> do
forM_ instdir $ \dir ->
liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir
when (keepDirs == Never)
$ liftIO
$ hideError doesNotExistErrorType
$ deleteDirRecursive bdir
throwE (BuildFailed bdir es)
)
$ action
when (keepDirs == Never || keepDirs == Errors) $ liftIO $ deleteDirRecursive
bdir

View File

@@ -199,7 +199,6 @@ execLogged exe spath args lfile chdir env = do
lineAction ref rs bs' = do
modifyIORef' ref (swapRegs bs')
regs <- readIORef ref
void $ SPIB.fdWrite fileFd (bs' <> "\n")
forM (zip regs rs) $ \(bs, r) -> do
setConsoleRegion r $ do
w <- consoleWidth
@@ -211,6 +210,8 @@ execLogged exe spath args lfile chdir env = do
. trim w
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
$ bs
SPIB.fdWrite fileFd (bs <> "\n")
swapRegs bs regs | length regs < size = regs ++ [bs]
| otherwise = tail regs ++ [bs]

View File

@@ -13,7 +13,7 @@ import qualified Data.Text as T
-- | This reflects the API version of the JSON.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
ghcUpVer :: PVP
ghcUpVer = [pver|0.1.4|]

View File

@@ -1,14 +0,0 @@
_ghcup()
{
local CMDLINE
local IFS=$'\n'
CMDLINE=(--bash-completion-index $COMP_CWORD)
for arg in ${COMP_WORDS[@]}; do
CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)
done
COMPREPLY=( $(ghcup "${CMDLINE[@]}") )
}
complete -o filenames -F _ghcup ghcup

View File

@@ -1,19 +0,0 @@
function _ghcup
set -l cl (commandline --tokenize --current-process)
# Hack around fish issue #3934
set -l cn (commandline --tokenize --cut-at-cursor --current-process)
set -l cn (count $cn)
set -l tmpline --bash-completion-enriched --bash-completion-index $cn
for arg in $cl
set tmpline $tmpline --bash-completion-word $arg
end
for opt in (ghcup $tmpline)
if test -d $opt
echo -E "$opt/"
else
echo -E "$opt"
end
end
end
complete --no-files --command ghcup --arguments '(_ghcup)'

View File

@@ -1,32 +0,0 @@
#compdef ghcup
local request
local completions
local word
local index=$((CURRENT - 1))
request=(--bash-completion-enriched --bash-completion-index $index)
for arg in ${words[@]}; do
request=(${request[@]} --bash-completion-word $arg)
done
IFS=$'\n' completions=($( ghcup "${request[@]}" ))
for word in $completions; do
local -a parts
# Split the line at a tab if there is one.
IFS=$'\t' parts=($( echo $word ))
if [[ -n $parts[2] ]]; then
if [[ $word[1] == "-" ]]; then
local desc=("$parts[1] ($parts[2])")
compadd -d desc -- $parts[1]
else
local desc=($(print -f "%-019s -- %s" $parts[1] $parts[2]))
compadd -l -d desc -- $parts[1]
fi
else
compadd -f -- $word
fi
done