Compare commits

..

No commits in common. "34b9ea7d20e8c47ec04a51dbe17c44715e5dc86d" and "879bd061ddcc9b85ae11451c29dfa5d65e79de93" have entirely different histories.

35 changed files with 448 additions and 3807 deletions

View File

@ -12,52 +12,16 @@ variables:
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
tags: tags:
- x86_64-linux - x86_64-linux
variables:
OS: "LINUX"
.alpine:64bit:
image: "alpine:edge"
tags:
- x86_64-linux
variables:
OS: "LINUX"
BIT: "64"
.alpine:32bit:
image: "i386/alpine:edge"
tags:
- x86_64-linux
variables:
OS: "LINUX"
BIT: "32"
.darwin: .darwin:
tags: tags:
- x86_64-darwin - x86_64-darwin
variables:
OS: "DARWIN"
.freebsd:
tags:
- x86_64-freebsd
variables:
OS: "FREEBSD"
.root_cleanup:
after_script:
- BUILD_DIR=$CI_PROJECT_DIR
- echo "Cleaning $BUILD_DIR"
- cd $HOME
- test -n "$BUILD_DIR"
- shopt -s extglob
- rm -Rf "$BUILD_DIR"/!(out)
- exit 0
.test_ghcup_version: .test_ghcup_version:
script: script:
- ./.gitlab/script/ghcup_version.sh - ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.2" JSON_VERSION: "0.0.1"
.test_ghcup_version:linux: .test_ghcup_version:linux:
extends: extends:
@ -65,133 +29,50 @@ variables:
- .debian - .debian
before_script: before_script:
- ./.gitlab/before_script/linux/install_deps.sh - ./.gitlab/before_script/linux/install_deps.sh
variables:
OS: "LINUX"
.test_ghcup_version:darwin: .test_ghcup_version:darwin:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .darwin - .darwin
- .root_cleanup
before_script: before_script:
- ./.gitlab/before_script/darwin/install_deps.sh - ./.gitlab/before_script/darwin/install_deps.sh
variables:
OS: "DARWIN"
after_script:
- BUILD_DIR=$CI_PROJECT_DIR
- echo "Cleaning $BUILD_DIR"
- cd $HOME
- rm -Rf "$BUILD_DIR"/*
- exit 0
.test_ghcup_version:freebsd:
extends:
- .test_ghcup_version
- .freebsd
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
.release_ghcup:
script:
- ./.gitlab/script/ghcup_release.sh
artifacts:
expire_in: 2 week
paths:
- out
only:
- tags
######## linux test ######## ######## linux ########
test:linux:recommended: test:linux:recommended:
extends: .test_ghcup_version:linux extends: .test_ghcup_version:linux
variables: variables:
GHC_VERSION: "8.6.5" GHC_VERSION: "recommended"
CABAL_VERSION: "3.2.0.0"
test:linux:latest: test:linux:latest:
extends: .test_ghcup_version:linux extends: .test_ghcup_version:linux
variables: variables:
GHC_VERSION: "8.8.3" GHC_VERSION: "latest"
CABAL_VERSION: "3.2.0.0"
allow_failure: true allow_failure: true
######## darwin test ######## ######## darwin ########
test:mac:recommended: test:mac:recommended:
extends: .test_ghcup_version:darwin extends: .test_ghcup_version:darwin
variables: variables:
GHC_VERSION: "8.6.5" GHC_VERSION: "recommended"
CABAL_VERSION: "3.2.0.0"
test:mac:latest: test:mac:latest:
extends: .test_ghcup_version:darwin extends: .test_ghcup_version:darwin
variables: variables:
GHC_VERSION: "8.8.3" GHC_VERSION: "latest"
CABAL_VERSION: "3.2.0.0"
allow_failure: true allow_failure: true
######## freebsd test ########
test:freebsd:recommended:
extends: .test_ghcup_version:freebsd
variables:
GHC_VERSION: "8.6.5"
CABAL_VERSION: "3.2.0.0"
test:freebsd:latest:
extends: .test_ghcup_version:freebsd
variables:
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
######## linux release ########
release:linux:64bit:
extends:
- .alpine:64bit
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "x86_64-linux-ghcup"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
release:linux:32bit:
extends:
- .alpine:32bit
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "i386-linux-ghcup"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
######## darwin release ########
release:darwin:
extends:
- .darwin
- .release_ghcup
- .root_cleanup
before_script:
- ./.gitlab/before_script/darwin/install_deps.sh
variables:
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
MACOSX_DEPLOYMENT_TARGET: "10.7"
######## freebsd release ########
release:freebsd:
extends:
- .freebsd
- .release_ghcup
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
GHC_VERSION: "8.6.5"

View File

@ -4,11 +4,11 @@ set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env" . "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin curl -sSfL https://gitlab.haskell.org/haskell/ghcup/-/raw/master/ghcup > ./ghcup-legacy
chmod +x ghcup-bin chmod +x ghcup-legacy
./ghcup-bin install ${GHC_VERSION} ./ghcup-legacy install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION} ./ghcup-legacy set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-legacy install-cabal
exit 0 exit 0

View File

@ -1,23 +0,0 @@
#!/bin/sh
set -eux
# pkg install --force --yes --no-repo-update curl gcc gmp gmake ncurses perl5 libffi libiconv
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
chmod +x ghcup-bin
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
# ./ghcup-bin install ${GHC_VERSION}
# ./ghcup-bin install-cabal ${CABAL_VERSION}
# ./ghcup-bin set ${GHC_VERSION}
# install cabal-3.2.0.0
curl -sSfL -o cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz&dl=1'
tar xf cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz
cp cabal "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
exit 0

View File

@ -1,61 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../../ghcup_env"
apk add --no-cache \
curl \
gcc \
g++ \
gmp-dev \
ncurses-dev \
libffi-dev \
make \
xz \
tar \
perl
ln -s libncurses.so /usr/lib/libtinfo.so
ln -s libncursesw.so.6 /usr/lib/libtinfow.so.6
if [ "${BIT}" = "32" ] ; then
curl -sSfL https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4 > ./ghcup-bin
else
curl -sSfL https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4 > ./ghcup-bin
fi
chmod +x ghcup-bin
./ghcup-bin upgrade
./ghcup-bin install ${GHC_VERSION}
# ./ghcup-bin install-cabal ${CABAL_VERSION}
# install cabal-3.2.0.0
if [ "${BIT}" = "32" ] ; then
curl -sSfL -o cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz&dl=1'
tar xf cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz
cp cabal-install-3.2.0.0-i386-alpine-linux-musl "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
else
curl -sSfL -o cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz 'https://hasufell.de/d/d3e215db133e4fcaa61e/files/?p=/cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz&dl=1'
tar xf cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz
cp cabal-install-3.2.0.0-x86_64-alpine-linux-musl "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
fi
chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
# utils
apk add --no-cache \
bash \
git
## Package specific
apk add --no-cache \
zlib \
zlib-dev \
zlib-static \
gmp \
gmp-dev \
openssl-dev \
openssl-libs-static \
xz \
xz-dev

View File

@ -3,14 +3,14 @@
set -eux set -eux
sudo apt-get update -y 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" . "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin curl -sSfL https://gitlab.haskell.org/haskell/ghcup/-/raw/master/ghcup > ./ghcup-legacy
chmod +x ghcup-bin chmod +x ghcup-legacy
./ghcup-bin install ${GHC_VERSION} ./ghcup-legacy install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION} ./ghcup-legacy set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-legacy install-cabal

View File

@ -1,30 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
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'
else
ecabal build -w ghc-${GHC_VERSION}
fi
mkdir out
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" .
ver=$(./ghcup --numeric-version)
cp ghcup out/${ARTIFACT}-${ver}

View File

@ -14,45 +14,32 @@ eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@" ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
} }
git describe # build
### build
ecabal update ecabal update
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION} ecabal build -fcurl
else else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader ecabal build
fi fi
cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" . cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" . cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" .
# testing
cp ./ghcup "$CI_PROJECT_DIR"/.local/bin/ghcup cp ./ghcup "$CI_PROJECT_DIR"/.local/bin/ghcup
cp ./ghcup-gen "$CI_PROJECT_DIR"/.local/bin/ghcup-gen cp ./ghcup-gen "$CI_PROJECT_DIR"/.local/bin/ghcup-gen
### cleanup
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
### manual cli based testing
ghcup-gen check -f ghcup-${JSON_VERSION}.json ghcup-gen check -f ghcup-${JSON_VERSION}.json
eghcup --numeric-version eghcup numeric-version
# TODO: rm once we have tarballs
if [ "${OS}" = "FREEBSD" ] ; then
GHC_VERSION=8.6.3
CABAL_VERSION=2.4.1.0
fi
eghcup install ${GHC_VERSION} eghcup install ${GHC_VERSION}
eghcup set ${GHC_VERSION} eghcup set ${GHC_VERSION}
eghcup install-cabal ${CABAL_VERSION} eghcup install-cabal
cabal --version cabal --version
@ -71,11 +58,7 @@ ghci-$(ghc --numeric-version) --version
# test installing new ghc doesn't mess with currently set GHC # test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7 # https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "DARWIN" ] ; then eghcup install 8.4.4
eghcup install 8.4.4
else # test wget a bit
eghcup --downloader=wget install 8.4.4
fi
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup set 8.4.4 eghcup set 8.4.4
eghcup set 8.4.4 eghcup set 8.4.4

View File

@ -1,6 +1,6 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.4 -- 2020-04-16 ## 0.1.4 -- 2012-04-16
* build on all platforms with curl (as a binary), wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/6 * build on all platforms with curl (as a binary), wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/6
* Fix unlinking of ghc symlinks after new installation, wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/7 * Fix unlinking of ghc symlinks after new installation, wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/7

View File

@ -43,15 +43,3 @@ Kazu Yamamoto [explained it in his PR](https://github.com/yesodweb/wai/pull/752#
1. Brittany 1. Brittany
2. mtl-style preferred 2. mtl-style preferred
3. no overly pointfree style 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. 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. `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 ## Design goals
1. simplicity 1. simplicity
@ -151,6 +142,3 @@ ghcup is not a reimplementation of stack. The only common part is automatic inst
Consider using [Chocolatey](https://chocolatey.org/search?q=ghc) or [ghcups](https://github.com/kakkun61/ghcups). Consider using [Chocolatey](https://chocolatey.org/search?q=ghc) or [ghcups](https://github.com/kakkun61/ghcups).
3. Why the haskell reimplementation?
Why not?

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`. 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` 4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
5. Add release artifacts to GHCupDownloads (see point 2.)
6. Upload the final `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 ## Now
* try to run exe before upgrade (backup to ~/.ghcup/bin/ghcup.old) * move out GHCup.Version module, bc it's not library-ish
* 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
## Maybe ## Maybe
* version ranges in json * maybe: changelog Show the changelog of a GHC release (online)
* sign the JSON? (Or check gpg keys?) * sign the JSON? (Or check gpg keys?)
* testing (especially distro detection -> unit tests) * testing (especially distro detection -> unit tests)
## Later ## Later
* i386 support
* add support for RC/alpha/HEAD versions * add support for RC/alpha/HEAD versions
## Cleanups ## Cleanups
* too many decodeutf8
* avoid alternative for IO * avoid alternative for IO
* use plucky or oops instead of Excepts * use plucky or oops instead of Excepts
## Questions ## Questions
* move out GHCup.Version module, bc it's not library-ish?
* mirror support * mirror support
* interactive handling when distro doesn't exist and we know the tarball is incompatible? * 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? * ghcup-with wrapper to execute a command with a given ghc in PATH?

View File

@ -2,7 +2,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module GHCup.Data.GHCupDownloads where module GHCupDownloads where
import GHCup.Types import GHCup.Types
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
@ -827,7 +827,7 @@ ghc_883_32_musl :: DownloadInfo
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|] [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|]) (Just [rel|ghc-8.8.3|])
"7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4" "23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec"
@ -951,24 +951,6 @@ cabal_3000_64_darwin = DownloadInfo
Nothing Nothing
"d4857e068560515e4cbb0e8ca124c370e07892f2a28804d87152834e5fe2b845" "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 Nothing
"9197c17d2ece0f934f5b33e323cfcaf486e4681952687bc3d249488ce3cbe0e9" "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"
@ -1020,32 +984,32 @@ cabal_3200_64_alpine = DownloadInfo
------------- -------------
ghcup_014_32_linux :: DownloadInfo ghcup_013_32_linux :: DownloadInfo
ghcup_014_32_linux = DownloadInfo ghcup_013_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4|] [uri|https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3|]
Nothing Nothing
"057cc1cc39abdacd92cb1d4fb44c850fd9c5398a36b893286248ac5c38bc0c70" "ff76a6130d6ea869a65bed127255bfa1ddf6aa1bd690df99d872467422c08be0"
ghcup_014_64_linux :: DownloadInfo ghcup_013_64_linux :: DownloadInfo
ghcup_014_64_linux = DownloadInfo ghcup_013_64_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4|] [uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-linux-ghcup-0.1.3|]
Nothing Nothing
"78d69ed4c9a810a445af89ea25e4217a632799ecb427b06cd2320ffb574f555e" "873f73b65cf5e399864b81ed597a0e14fa73e0c492429cd3a85fe0fdc585a4c8"
ghcup_014_64_freebsd :: DownloadInfo ghcup_013_64_freebsd :: DownloadInfo
ghcup_014_64_freebsd = DownloadInfo ghcup_013_64_freebsd = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.4/x86_64-portbld-freebsd-ghcup-0.1.4|] [uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3|]
Nothing Nothing
"cda0b959f053abc04ab0a1b9919a505b8c9304e2898a291f527a370cb0e00731" "2daa775d6fa307cb8123fa45ba20e2acd244cdb8cfb3f2b3c8a1aa3f3571c46f"
ghcup_014_64_darwin10_13 :: DownloadInfo ghcup_013_64_darwin10_13 :: DownloadInfo
ghcup_014_64_darwin10_13 = DownloadInfo ghcup_013_64_darwin10_13 = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.4/x86_64-apple-darwin-ghcup-0.1.4|] [uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3|]
Nothing Nothing
"2422b79933ae037237ccb8f836417b90b3111d7931beb7ae8b9e33a1945c641e" "a617b06619ec6e75d50dac53f36814c3cafd4dbeebe8cea46d9cd5842c0c94a9"
@ -1062,10 +1026,7 @@ ghcupDownloads = M.fromList
, M.fromList , M.fromList
[ ( [vver|7.10.3|] [ ( [vver|7.10.3|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz|]
(Just [rel|ghc-7.10.3|]) (Just [rel|ghc-7.10.3|])
@ -1108,10 +1069,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.0.2|] , ( [vver|8.0.2|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz|]
(Just [rel|ghc-8.0.2|]) (Just [rel|ghc-8.0.2|])
@ -1154,10 +1112,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.2.2|] , ( [vver|8.2.2|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz|]
(Just [rel|ghc-8.2.2|]) (Just [rel|ghc-8.2.2|])
@ -1206,10 +1161,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.4.1|] , ( [vver|8.4.1|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz|]
(Just [rel|ghc-8.4.1|]) (Just [rel|ghc-8.4.1|])
@ -1245,10 +1197,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.4.2|] , ( [vver|8.4.2|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz|]
(Just [rel|ghc-8.4.2|]) (Just [rel|ghc-8.4.2|])
@ -1295,10 +1244,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.4.3|] , ( [vver|8.4.3|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz|]
(Just [rel|ghc-8.4.3|]) (Just [rel|ghc-8.4.3|])
@ -1344,10 +1290,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.4.4|] , ( [vver|8.4.4|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz|]
(Just [rel|ghc-8.4.4|]) (Just [rel|ghc-8.4.4|])
@ -1398,10 +1341,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.6.1|] , ( [vver|8.6.1|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz|]
(Just [rel|ghc-8.6.1|]) (Just [rel|ghc-8.6.1|])
@ -1448,10 +1388,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.6.2|] , ( [vver|8.6.2|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz|]
(Just [rel|ghc-8.6.2|]) (Just [rel|ghc-8.6.2|])
@ -1492,10 +1429,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.6.3|] , ( [vver|8.6.3|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz|]
(Just [rel|ghc-8.6.3|]) (Just [rel|ghc-8.6.3|])
@ -1546,10 +1480,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.6.4|] , ( [vver|8.6.4|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz|]
(Just [rel|ghc-8.6.4|]) (Just [rel|ghc-8.6.4|])
@ -1595,10 +1526,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.6.5|] , ( [vver|8.6.5|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|]
(Just [rel|ghc-8.6.5|]) (Just [rel|ghc-8.6.5|])
@ -1648,10 +1576,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.8.1|] , ( [vver|8.8.1|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz|]
(Just [rel|ghc-8.8.1|]) (Just [rel|ghc-8.8.1|])
@ -1701,10 +1626,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.8.2|] , ( [vver|8.8.2|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz|]
(Just [rel|ghc-8.8.2|]) (Just [rel|ghc-8.8.2|])
@ -1754,10 +1676,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.8.3|] , ( [vver|8.8.3|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz|]
(Just [rel|ghc-8.8.3|]) (Just [rel|ghc-8.8.3|])
@ -1807,10 +1726,7 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.10.1|] , ( [vver|8.10.1|]
, VersionInfo , 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|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz|] [uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz|]
(Just [rel|ghc-8.10.1|]) (Just [rel|ghc-8.10.1|])
@ -1880,9 +1796,6 @@ ghcupDownloads = M.fromList
[ ( [vver|2.4.1.0|] [ ( [vver|2.4.1.0|]
, VersionInfo , VersionInfo
[] []
(Just
[uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz|] [uri|https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz|]
(Just [rel|cabal-cabal-install-v2.4.1.0/cabal-install|]) (Just [rel|cabal-cabal-install-v2.4.1.0/cabal-install|])
@ -1911,9 +1824,6 @@ ghcupDownloads = M.fromList
, ( [vver|3.0.0.0|] , ( [vver|3.0.0.0|]
, VersionInfo , VersionInfo
[] []
(Just
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz|] [uri|https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz|]
(Just [rel|cabal-cabal-install-v3.0.0.0/cabal-install|]) (Just [rel|cabal-cabal-install-v3.0.0.0/cabal-install|])
@ -1925,9 +1835,7 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux [ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3000_64_linux)] , M.fromList [(Nothing, cabal_3000_64_linux)]
) )
, (Linux Alpine, M.fromList [(Nothing, cabal_3000_64_alpine)]) , (Darwin, M.fromList [(Nothing, cabal_3000_64_darwin)])
, (Darwin , M.fromList [(Nothing, cabal_3000_64_darwin)])
, (FreeBSD, M.fromList [(Nothing, cabal_3000_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32
@ -1935,7 +1843,6 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux [ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3000_32_linux)] , M.fromList [(Nothing, cabal_3000_32_linux)]
) )
, (Linux Alpine, M.fromList [(Nothing, cabal_3000_32_alpine)])
] ]
) )
] ]
@ -1943,9 +1850,6 @@ ghcupDownloads = M.fromList
, ( [vver|3.2.0.0|] , ( [vver|3.2.0.0|]
, VersionInfo , VersionInfo
[Recommended, Latest] [Recommended, Latest]
(Just
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog|]
)
(Just $ DownloadInfo (Just $ DownloadInfo
[uri|https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz|] [uri|https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz|]
(Just [rel|cabal-cabal-install-v3.2.0.0/cabal-install|]) (Just [rel|cabal-cabal-install-v3.2.0.0/cabal-install|])
@ -1957,9 +1861,7 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux [ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3200_64_linux)] , M.fromList [(Nothing, cabal_3200_64_linux)]
) )
, (Linux Alpine, M.fromList [(Nothing, cabal_3200_64_alpine)]) , (Darwin, M.fromList [(Nothing, cabal_3200_64_darwin)])
, (Darwin , M.fromList [(Nothing, cabal_3200_64_darwin)])
, (FreeBSD, M.fromList [(Nothing, cabal_3200_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32
@ -1967,7 +1869,6 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux [ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3200_32_linux)] , M.fromList [(Nothing, cabal_3200_32_linux)]
) )
, (Linux Alpine, M.fromList [(Nothing, cabal_3200_32_alpine)])
] ]
) )
] ]
@ -1976,31 +1877,20 @@ ghcupDownloads = M.fromList
) )
, ( GHCup , ( GHCup
, M.fromList , M.fromList
[ ( [vver|0.1.4|] [ ( [vver|0.1.3|]
, VersionInfo , VersionInfo [Recommended, Latest] Nothing $ M.fromList
[Recommended, Latest] [ ( A_64
(Just , M.fromList
[uri|https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md|] [ (Linux UnknownLinux, M.fromList [(Nothing, ghcup_013_64_linux)])
) , (Darwin, M.fromList [(Nothing, ghcup_013_64_darwin10_13)])
Nothing , (FreeBSD, M.fromList [(Nothing, ghcup_013_64_freebsd)])
$ M.fromList
[ ( A_64
, M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, ghcup_014_64_linux)]
)
, (Darwin , M.fromList [(Nothing, ghcup_014_64_darwin10_13)])
, (FreeBSD, M.fromList [(Nothing, ghcup_014_64_freebsd)])
]
)
, ( A_32
, M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, ghcup_014_32_linux)]
)
]
)
] ]
)
, ( A_32
, M.fromList
[(Linux UnknownLinux, M.fromList [(Nothing, ghcup_013_32_linux)])]
)
]
) )
] ]
) )

View File

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

View File

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

View File

@ -1,11 +1,10 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module GHCup.Data.ToolRequirements where module ToolRequirements where
import GHCup.Types import GHCup.Types
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ
import qualified Data.Map as M 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 , ( Darwin
, M.fromList , M.fromList
[ ( Nothing [ ( Nothing

View File

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

View File

@ -17,7 +17,6 @@ import GHCup.Platform
import GHCup.Requirements import GHCup.Requirements
import GHCup.Types import GHCup.Types
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Version import GHCup.Version
@ -32,9 +31,7 @@ import Data.Bifunctor
import Data.Char import Data.Char
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.List ( intercalate, sort ) import Data.List ( intercalate )
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
@ -43,11 +40,8 @@ import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import HPath import HPath
import HPath.IO import HPath.IO
import Language.Haskell.TH
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import Safe
import System.Console.Pretty import System.Console.Pretty
import System.Environment import System.Environment
import System.Exit import System.Exit
@ -74,8 +68,6 @@ data Options = Options
, optCache :: Bool , optCache :: Bool
, optUrlSource :: Maybe URI , optUrlSource :: Maybe URI
, optNoVerify :: Bool , optNoVerify :: Bool
, optKeepDirs :: KeepDirs
, optsDownloader :: Downloader
-- commands -- commands
, optCommand :: Command , optCommand :: Command
} }
@ -89,16 +81,12 @@ data Command
| DInfo | DInfo
| Compile CompileCommand | Compile CompileCommand
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool
| NumericVersion
| ToolRequirements | ToolRequirements
| ChangeLog ChangeLogOptions
data ToolVersion = ToolVersion Version data ToolVersion = ToolVersion Version
| ToolTag Tag | ToolTag Tag
prettyToolVer :: ToolVersion -> String
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t
data InstallOptions = InstallOptions data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion { instVer :: Maybe ToolVersion
@ -110,9 +98,8 @@ data SetGHCOptions = SetGHCOptions
} }
data ListOptions = ListOptions data ListOptions = ListOptions
{ lTool :: Maybe Tool { lTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria , lCriteria :: Maybe ListCriteria
, lRawFormat :: Bool
} }
data RmOptions = RmOptions data RmOptions = RmOptions
@ -137,19 +124,17 @@ data UpgradeOpts = UpgradeInplace
| UpgradeGHCupDir | UpgradeGHCupDir
deriving Show deriving Show
data ChangeLogOptions = ChangeLogOptions
{ clOpen :: Bool
, clTool :: Maybe Tool
, clToolVer :: Maybe ToolVersion
}
opts :: Parser Options opts :: Parser Options
opts = opts =
Options Options
<$> switch (short 'v' <> long "verbose" <> help "Enable verbosity") <$> switch
(short 'v' <> long "verbose" <> help
"Enable verbosity"
)
<*> switch <*> switch
(short 'c' <> long "cache" <> help "Cache downloads in ~/.ghcup/cache" (short 'c' <> long "cache" <> help
"Cache downloads in ~/.ghcup/cache"
) )
<*> (optional <*> (optional
(option (option
@ -166,31 +151,6 @@ opts =
(short 'n' <> long "no-verify" <> help (short 'n' <> long "no-verify" <> help
"Skip tarball checksum verification" "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 <*> com
where where
parseUri s' = parseUri s' =
@ -202,21 +162,15 @@ com =
subparser subparser
( command ( command
"install" "install"
((info ((info ((Install <$> installOpts) <**> helper)
((Install <$> installOpts) <**> helper) (progDesc "Install or update GHC")
( progDesc "Install or update GHC"
<> footerDoc (Just $ text installFooter)
)
) )
) )
<> command <> command
"set" "set"
( SetGHC ( SetGHC
<$> (info <$> (info (setGHCOpts <**> helper)
(setGHCOpts <**> helper) (progDesc "Set currently active GHC version")
( progDesc "Set currently active GHC version"
<> footerDoc (Just $ text setFooter)
)
) )
) )
<> command <> command
@ -227,11 +181,8 @@ com =
<> command <> command
"install-cabal" "install-cabal"
((info ((info ((InstallCabal <$> installOpts) <**> helper)
((InstallCabal <$> installOpts) <**> helper) (progDesc "Install or update cabal")
( progDesc "Install or update cabal"
<> footerDoc (Just $ text installCabalFooter)
)
) )
) )
<> command <> command
@ -243,14 +194,12 @@ com =
) )
<> command <> command
"upgrade" "upgrade"
(info (info ((Upgrade <$> upgradeOptsP <*>
( (Upgrade <$> upgradeOptsP <*> switch switch
(short 'f' <> long "force" <> help "Force update") (short 'f' <> long "force" <> help
) "Force update"
<**> helper )
) ) <**> helper) (progDesc "Upgrade ghcup"))
(progDesc "Upgrade ghcup")
)
<> command <> command
"compile" "compile"
( Compile ( Compile
@ -264,6 +213,11 @@ com =
( command ( command
"debug-info" "debug-info"
((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info"))) ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
<> command
"numeric-version"
( (\_ -> NumericVersion)
<$> (info (helper) (progDesc "Show the numeric version"))
)
<> command <> command
"tool-requirements" "tool-requirements"
( (\_ -> ToolRequirements) ( (\_ -> ToolRequirements)
@ -271,35 +225,9 @@ com =
(progDesc "Show the requirements for ghc/cabal") (progDesc "Show the requirements for ghc/cabal")
) )
) )
<> command
"changelog"
((info (fmap ChangeLog changelogP <**> helper)
(progDesc "Find/show changelog"
<> footerDoc (Just $ text changeLogFooter)
)
)
)
<> commandGroup "Other commands:" <> commandGroup "Other commands:"
<> hidden <> hidden
) )
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>".|]
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:
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.|]
installOpts :: Parser InstallOptions installOpts :: Parser InstallOptions
@ -342,75 +270,27 @@ listOpts =
) )
) )
) )
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
rmOpts :: Parser RmOptions rmOpts :: Parser RmOptions
rmOpts = RmOptions <$> versionArgument rmOpts = RmOptions <$> versionArgument
changelogP :: Parser ChangeLogOptions
changelogP =
(\x y -> ChangeLogOptions x y)
<$> switch (short 'o' <> long "open" <> help "xdg-open the changelog url")
<*> (optional
(option
(eitherReader
(\s' -> case fmap toLower s' of
"ghc" -> Right GHC
"cabal" -> Right Cabal
"ghcup" -> Right GHCup
e -> Left $ e
)
)
(short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
"Open changelog for given tool (default: ghc)"
)
)
)
<*> optional toolVersionArgument
compileP :: Parser CompileCommand compileP :: Parser CompileCommand
compileP = subparser compileP = subparser
( command ( command
"ghc" "ghc"
( CompileGHC ( CompileGHC
<$> (info <$> (info (compileOpts <**> helper) (progDesc "Compile GHC from source")
(compileOpts <**> helper)
( progDesc "Compile GHC from source"
<> footerDoc (Just $ text compileFooter)
)
) )
) )
<> command <> command
"cabal" "cabal"
( CompileCabal ( CompileCabal
<$> (info <$> (info (compileOpts <**> helper)
(compileOpts <**> helper) (progDesc "Compile Cabal from source")
( progDesc "Compile Cabal from source"
<> footerDoc (Just $ text compileCabalFooter)
)
) )
) )
) )
where
compileFooter = [i|Discussion:
Compiles and installs the specified GHC version into
a self-contained "~/.ghcup/ghc/<ghcver>" directory
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
Examples:
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2
ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2|]
compileCabalFooter = [i|Discussion:
Compiles and installs the specified Cabal version
into "~/.ghcup/bin".
Examples:
ghcup compile cabal -j 4 -v 3.2.0.0 -b 8.6.5
ghcup compile cabal -j 4 -v 3.2.0.0 -b /usr/bin/ghc-8.6.5|]
compileOpts :: Parser CompileOptions compileOpts :: Parser CompileOptions
@ -491,7 +371,9 @@ toolVersionArgument =
versionArgument :: Parser Version versionArgument :: Parser Version
versionArgument = argument (eitherReader versionEither) (metavar "VERSION") versionArgument = argument
(eitherReader versionEither)
(metavar "VERSION")
versionParser :: Parser Version versionParser :: Parser Version
versionParser = option versionParser = option
@ -503,17 +385,14 @@ tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended "recommended" -> Right Recommended
"latest" -> Right Latest "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}|]) other -> Left ([i|Unknown tag #{other}|])
versionEither :: String -> Either String Version versionEither :: String -> Either String Version
versionEither s' = versionEither s' =
-- 'version' is a bit too lax and will parse typoed tags -- 'version' is a bit too lax and will parse typoed tags
case readMaybe ((: []) . head $ s') :: Maybe Int of case readMaybe ((:[]) . head $ s') :: Maybe Int of
Just _ -> bimap (const "Not a valid version") id . version . T.pack $ s' Just _ -> bimap (const "Not a valid version") id . version . T.pack $ s'
Nothing -> Left "Not a valid version" Nothing -> Left "Not a valid version"
toolVersionEither :: String -> Either String ToolVersion toolVersionEither :: String -> Either String ToolVersion
toolVersionEither s' = toolVersionEither s' =
@ -534,24 +413,6 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
where t = T.toLower (T.pack s') 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 :: String -> Either String PlatformRequest
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
Right r -> pure r Right r -> pure r
@ -627,10 +488,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
toSettings :: Options -> Settings toSettings :: Options -> Settings
toSettings Options {..} = toSettings Options {..} =
let cache = optCache let cache = optCache
noVerify = optNoVerify noVerify = optNoVerify
keepDirs = optKeepDirs
downloader = optsDownloader
in Settings { .. } in Settings { .. }
@ -659,55 +518,13 @@ upgradeOptsP =
describe_result :: String
describe_result = $( (LitE . StringL) <$>
runIO (do
CapturedProcess{..} <- executeOut [rel|git|] ["describe"] Nothing
case _exitCode of
ExitSuccess -> pure . T.unpack . decUTF8Safe $ _stdOut
ExitFailure _ -> pure numericVer
)
)
main :: IO () main :: IO ()
main = do main = do
let versionHelp = infoOption
( ("The GHCup Haskell installer, version " <>)
$ (head . lines $ describe_result)
)
(long "version" <> help "Show version" <> hidden)
let numericVersionHelp = infoOption
numericVer
( long "numeric-version"
<> 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: customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
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)
Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
customExecParser
(prefs showHelpOnError)
(info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands)
(footerDoc (Just $ text main_footer))
)
>>= \opt@Options {..} -> do >>= \opt@Options {..} -> do
let settings@Settings{..} = toSettings opt let settings = toSettings opt
-- create ~/.ghcup dir -- create ~/.ghcup dir
ghcdir <- ghcupBaseDir ghcdir <- ghcupBaseDir
@ -753,7 +570,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TagNotFound , TagNotFound
] ]
let runListGHC = runE @'[] . runLogger let runListGHC =
runLogger
. flip runReaderT settings
. runE @'[FileDoesNotExistError]
let runRmGHC = let runRmGHC =
runLogger . flip runReaderT settings . runE @'[NotInstalled] runLogger . flip runReaderT settings . runE @'[NotInstalled]
@ -818,175 +638,141 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(GHCupInfo treq dls) <- (GHCupInfo treq dls) <-
( runLogger ( runLogger
. flip runReaderT settings . flip runReaderT settings
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError] . runE @'[JSONError , DownloadFailed]
$ liftE $ liftE
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource) $ getDownloads (maybe GHCupURL OwnSource optUrlSource)
) )
>>= \case >>= \case
VRight r -> pure r VRight r -> pure r
VLeft e -> do VLeft e ->
runLogger runLogger
($(logError) [i|Error fetching download info: #{e}|]) ($(logError) [i|Error fetching download info: #{e}|])
exitWith (ExitFailure 2) >> exitFailure
runLogger $ checkForUpdates dls runLogger $ checkForUpdates dls
res <- case optCommand of case optCommand of
Install (InstallOptions {..}) -> Install (InstallOptions {..}) ->
(runInstTool $ do void
v <- liftE $ fromVersion dls instVer GHC $ (runInstTool $ do
liftE $ installGHCBin dls v instPlatform v <- liftE $ fromVersion dls instVer GHC
) liftE $ installGHCBin dls v instPlatform
)
>>= \case >>= \case
VRight _ -> do VRight _ ->
runLogger $ $(logInfo) ("GHC installation successful") runLogger $ $(logInfo) ("GHC installation successful")
pure ExitSuccess VLeft (V (AlreadyInstalled _ v)) ->
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed|] [i|GHC ver #{prettyVer v} already installed|]
pure ExitSuccess VLeft (V (BuildFailed tmpdir e)) ->
VLeft (V (BuildFailed tmpdir e)) -> do runLogger
case keepDirs of ($(logError) [i|Build failed with #{e}
Never -> runLogger ($(logError) [i|Build failed with #{e}|]) Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
_ -> runLogger ($(logError) [i|Build failed with #{e} )
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues. >> exitFailure
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 VLeft e -> do
runLogger $ do runLogger $ do
$(logError) [i|#{e}|] $(logError) [i|#{e}|]
$(logError) [i|Also check the logs in ~/.ghcup/logs|] $(logError) [i|Also check the logs in ~/.ghcup/logs|]
pure $ ExitFailure 3 exitFailure
InstallCabal (InstallOptions {..}) -> InstallCabal (InstallOptions {..}) ->
(runInstTool $ do void
v <- liftE $ fromVersion dls instVer Cabal $ (runInstTool $ do
liftE $ installCabalBin dls v instPlatform v <- liftE $ fromVersion dls instVer Cabal
) liftE $ installCabalBin dls v instPlatform
)
>>= \case >>= \case
VRight _ -> do VRight _ ->
runLogger $ $(logInfo) ("Cabal installation successful") runLogger $ $(logInfo) ("Cabal installation successful")
pure ExitSuccess VLeft (V (AlreadyInstalled _ v)) ->
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|Cabal ver #{prettyVer v} already installed|] [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 VLeft e -> do
runLogger $ do runLogger $ do
$(logError) [i|#{e}|] $(logError) [i|#{e}|]
$(logError) [i|Also check the logs in ~/.ghcup/logs|] $(logError) [i|Also check the logs in ~/.ghcup/logs|]
pure $ ExitFailure 4 exitFailure
SetGHC (SetGHCOptions {..}) -> SetGHC (SetGHCOptions {..}) ->
(runSetGHC $ do void
v <- liftE $ fromVersion dls ghcVer GHC $ (runSetGHC $ do
liftE $ setGHC v SetGHCOnly v <- liftE $ fromVersion dls ghcVer GHC
) liftE $ setGHC v SetGHCOnly
)
>>= \case >>= \case
VRight v -> do VRight v ->
runLogger runLogger $ $(logInfo) [i|GHC #{prettyVer v} successfully set as default version|]
$ $(logInfo) VLeft e ->
[i|GHC #{prettyVer v} successfully set as default version|] runLogger ($(logError) [i|#{e}|]) >> exitFailure
pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 5
List (ListOptions {..}) -> List (ListOptions {..}) ->
(runListGHC $ do void
l <- listVersions dls lTool lCriteria $ (runListGHC $ do
pure l liftIO $ listVersions dls lTool lCriteria
) )
>>= \case >>= \case
VRight r -> do VRight r -> liftIO $ printListResult r
liftIO $ printListResult lRawFormat r VLeft e ->
pure ExitSuccess runLogger ($(logError) [i|#{e}|]) >> exitFailure
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 6
Rm (RmOptions {..}) -> Rm (RmOptions {..}) ->
(runRmGHC $ do void
liftE $ rmGHCVer ghcVer $ (runRmGHC $ do
) liftE $ rmGHCVer ghcVer
)
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight _ -> pure ()
VLeft e -> do VLeft e ->
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|]) >> exitFailure
pure $ ExitFailure 7
DInfo -> DInfo -> do
do void
(runDebugInfo $ liftE $ getDebugInfo) $ (runDebugInfo $ do
liftE $ getDebugInfo
)
>>= \case >>= \case
VRight dinfo -> do VRight dinfo -> putStrLn $ show dinfo
putStrLn $ prettyDebugInfo dinfo VLeft e ->
pure ExitSuccess runLogger ($(logError) [i|#{e}|]) >> exitFailure
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 8
Compile (CompileGHC CompileOptions {..}) -> Compile (CompileGHC CompileOptions {..}) ->
(runCompileGHC $ liftE $ compileGHC dls void
targetVer $ (runCompileGHC $ do
bootstrapGhc liftE
jobs $ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir
buildConfig )
patchDir
)
>>= \case >>= \case
VRight _ -> do VRight _ ->
runLogger $ $(logInfo) runLogger $ $(logInfo)
("GHC successfully compiled and installed") ("GHC successfully compiled and installed")
pure ExitSuccess VLeft (V (AlreadyInstalled _ v)) ->
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed|] [i|GHC ver #{prettyVer v} already installed|]
pure ExitSuccess VLeft (V (BuildFailed tmpdir e)) ->
VLeft (V (BuildFailed tmpdir e)) -> do runLogger
case keepDirs of ($(logError) [i|Build failed with #{e}
Never -> runLogger ($(logError) [i|Build failed with #{e}|]) Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
_ -> runLogger ($(logError) [i|Build failed with #{e} )
Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues. >> exitFailure
Make sure to clean up #{tmpdir} afterwards.|]) VLeft e ->
pure $ ExitFailure 9 runLogger ($(logError) [i|#{e}|]) >> exitFailure
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 9
Compile (CompileCabal CompileOptions {..}) -> Compile (CompileCabal CompileOptions {..}) ->
(runCompileCabal $ do void
liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir $ (runCompileCabal $ do
) liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir
)
>>= \case >>= \case
VRight _ -> do VRight _ ->
runLogger $ $(logInfo)
("Cabal successfully compiled and installed")
VLeft (V (BuildFailed tmpdir e)) ->
runLogger runLogger
($(logInfo) ($(logError) [i|Build failed with #{e}
"Cabal successfully compiled and installed" Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
) )
pure ExitSuccess >> exitFailure
VLeft (V (BuildFailed tmpdir e)) -> do VLeft e ->
case keepDirs of runLogger ($(logError) [i|#{e}|]) >> exitFailure
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 10
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 10
Upgrade (uOpts) force -> do Upgrade (uOpts) force -> do
target <- case uOpts of target <- case uOpts of
@ -999,74 +785,38 @@ Make sure to clean up #{tmpdir} afterwards.|])
bdir <- liftIO $ ghcupBinDir bdir <- liftIO $ ghcupBinDir
pure (Just (bdir </> [rel|ghcup|])) pure (Just (bdir </> [rel|ghcup|]))
(runUpgrade $ (liftE $ upgradeGHCup dls target force)) >>= \case void
VRight v' -> do $ (runUpgrade $ do
let pretty_v = prettyVer v' liftE $ upgradeGHCup dls target force
runLogger $ $(logInfo) )
[i|Successfully upgraded GHCup to version #{pretty_v}|]
pure ExitSuccess
VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) [i|No GHCup update available|]
pure ExitSuccess
VLeft e -> do
runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 11
ToolRequirements ->
( runLogger
$ runE
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
$ do
platform <- liftE $ getPlatform
req <-
(getCommonRequirements platform $ treq)
?? NoToolRequirements
liftIO $ T.hPutStr stdout (prettyRequirements req)
)
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight v' -> do
VLeft e -> do let pretty_v = prettyVer v'
runLogger runLogger
($(logError) $ $(logInfo)
[i|Error getting tool requirements: #{e}|] [i|Successfully upgraded GHCup to version #{pretty_v}|]
) VLeft (V NoUpdate) ->
pure $ ExitFailure 12 runLogger $ $(logWarn)
[i|No GHCup update available|]
VLeft e ->
runLogger ($(logError) [i|#{e}|]) >> exitFailure
ChangeLog (ChangeLogOptions {..}) -> do NumericVersion -> T.hPutStr stdout (prettyPVP ghcUpVer)
let tool = fromMaybe GHC clTool ToolRequirements -> (runLogger $ runE
ver' = maybe @'[ NoCompatiblePlatform
(Right Latest) , DistroNotFound
(\case , NoToolRequirements
ToolVersion tv -> Left tv ] $ do
ToolTag t -> Right t platform <- liftE $ getPlatform
) req <- (getCommonRequirements platform $ treq)
clToolVer ?? NoToolRequirements
muri = getChangeLog dls tool ver' liftIO $ T.hPutStr stdout (prettyRequirements req))
case muri of >>= \case
Nothing -> do VRight r -> pure r
runLogger VLeft e ->
($(logWarn) runLogger
[i|Could not find ChangeLog for #{tool}, version #{either (T.unpack . prettyVer) show ver'}|] ($(logError) [i|Error getting tool requirements: #{e}|])
) >> exitFailure
pure ExitSuccess
Just uri -> do
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
if clOpen
then
exec "xdg-open"
True
[serializeURIRef' uri]
Nothing
Nothing
>>= \case
Right _ -> pure ExitSuccess
Left e -> runLogger ($(logError) [i|#{e}|])
>> pure (ExitFailure 13)
else putStrLn uri' >> pure ExitSuccess
case res of
ExitSuccess -> pure ()
ef@(ExitFailure _) -> exitWith ef
pure () pure ()
@ -1077,115 +827,47 @@ fromVersion :: Monad m
-> Excepts '[TagNotFound] m Version -> Excepts '[TagNotFound] m Version
fromVersion av Nothing tool = fromVersion av Nothing tool =
getRecommended av tool ?? TagNotFound Recommended tool getRecommended av tool ?? TagNotFound Recommended tool
fromVersion av (Just (ToolVersion v)) _ = do fromVersion _ (Just (ToolVersion v)) _ = pure v
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 av (Just (ToolTag Latest)) tool = fromVersion av (Just (ToolTag Latest)) tool =
getLatest av tool ?? TagNotFound Latest tool getLatest av tool ?? TagNotFound Latest tool
fromVersion av (Just (ToolTag Recommended)) tool = fromVersion av (Just (ToolTag Recommended)) tool =
getRecommended av tool ?? TagNotFound 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 :: [ListResult] -> IO ()
printListResult raw lr = do printListResult lr = do
-- https://gitlab.haskell.org/ghc/ghc/issues/8118 -- https://gitlab.haskell.org/ghc/ghc/issues/8118
setLocaleEncoding utf8 setLocaleEncoding utf8
let let
formatted = formatted =
gridString 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 , 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
)
$ fmap $ fmap
(\ListResult {..} -> (\ListResult {..} ->
let marks = if [ if
| lSet -> (color Green "✔✔") | lSet -> (color Green "✔✔")
| lInstalled -> (color Green "") | lInstalled -> (color Green "")
| otherwise -> (color Red "") | otherwise -> (color Red "")
in (if raw then [] else [marks]) , fmap toLower . show $ lTool
++ [ fmap toLower . show $ lTool , T.unpack . prettyVer $ lVer
, T.unpack . prettyVer $ lVer , intercalate "," $ ((fmap . fmap) toLower . fmap show $ lTag)
, intercalate "," $ (fmap printTag $ sort lTag) , if fromSrc then (color Blue "compiled") else mempty
, intercalate "," ]
$ (if fromSrc then [color' Blue "compiled"] else mempty)
++ (if lStray then [color' Blue "stray"] else mempty)
]
) )
lr lr
putStrLn $ formatted 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)
=> GHCupDownloads checkForUpdates :: (MonadFail m, MonadLogger m) => GHCupDownloads -> m ()
-> m ()
checkForUpdates dls = do checkForUpdates dls = do
forM_ (getLatest dls GHCup) $ \l -> do forM_ (getLatest dls GHCup) $ \l -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver) when (l > ghc_ver)
$ $(logWarn) $ $(logWarn)
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|] [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}'|]
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}'|]
where
latestInstalled tool = (fmap lVer . lastMay)
<$> (listVersions dls (Just tool) (Just ListInstalled))
prettyDebugInfo :: DebugInfo -> String
prettyDebugInfo DebugInfo {..} = [i|Debug Info
==========
GHCup base dir: #{toFilePath diBaseDir}
GHCup bin dir: #{toFilePath diBinDir}
GHCup GHC directory: #{toFilePath diGHCDir}
GHCup cache directory: #{toFilePath diCacheDir}
Architecture: #{prettyArch diArch}
Platform: #{prettyPlatform diPlatform}
Version: #{describe_result}|]
where
prettyArch :: Architecture -> String
prettyArch A_64 = "amd64"
prettyArch A_32 = "i386"
prettyPlatform :: PlatformResult -> String
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> show v'
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat

View File

@ -31,10 +31,10 @@ download_ghcup() {
"linux"|"Linux") "linux"|"Linux")
case "${_arch}" in case "${_arch}" in
x86_64|amd64) x86_64|amd64)
_url=https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4 _url=https://downloads.haskell.org/~ghcup/0.1.3/x86_64-linux-ghcup-0.1.3
;; ;;
i*86) i*86)
_url=https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4 _url=https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3
;; ;;
*) die "Unknown architecture: ${_arch}" *) die "Unknown architecture: ${_arch}"
;; ;;
@ -50,7 +50,7 @@ download_ghcup() {
*) die "Unknown architecture: ${_arch}" *) die "Unknown architecture: ${_arch}"
;; ;;
esac esac
_url=https://downloads.haskell.org/~ghcup/0.1.4/x86_64-portbld-freebsd-ghcup-0.1.4 _url=https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3
;; ;;
"Darwin"|"darwin") "Darwin"|"darwin")
case "${_arch}" in case "${_arch}" in
@ -62,7 +62,7 @@ download_ghcup() {
*) die "Unknown architecture: ${_arch}" *) die "Unknown architecture: ${_arch}"
;; ;;
esac esac
_url=https://downloads.haskell.org/~ghcup/0.1.4/x86_64-apple-darwin-ghcup-0.1.4 ;; _url=https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3 ;;
*) die "Unknown platform: ${_plat}" *) die "Unknown platform: ${_plat}"
;; ;;
esac esac

View File

@ -170,7 +170,6 @@
"dlSubdir": "ghc-8.6.2", "dlSubdir": "ghc-8.6.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html",
"viTags": [] "viTags": []
}, },
"8.0.2": { "8.0.2": {
@ -265,7 +264,6 @@
"dlSubdir": "ghc-8.0.2", "dlSubdir": "ghc-8.0.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html",
"viTags": [] "viTags": []
}, },
"8.6.4": { "8.6.4": {
@ -379,7 +377,6 @@
"dlSubdir": "ghc-8.6.4", "dlSubdir": "ghc-8.6.4",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html",
"viTags": [] "viTags": []
}, },
"8.4.1": { "8.4.1": {
@ -485,7 +482,6 @@
"dlSubdir": "ghc-8.4.1", "dlSubdir": "ghc-8.4.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html",
"viTags": [] "viTags": []
}, },
"8.6.3": { "8.6.3": {
@ -620,7 +616,6 @@
"dlSubdir": "ghc-8.6.3", "dlSubdir": "ghc-8.6.3",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html",
"viTags": [] "viTags": []
}, },
"8.10.1": { "8.10.1": {
@ -761,7 +756,6 @@
"dlSubdir": "ghc-8.10.1", "dlSubdir": "ghc-8.10.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.10.1/docs/html/users_guide/8.10.1-notes.html",
"viTags": [ "viTags": [
"Latest" "Latest"
] ]
@ -891,7 +885,6 @@
"dlSubdir": "ghc-8.6.5", "dlSubdir": "ghc-8.6.5",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html",
"viTags": [] "viTags": []
}, },
"8.4.2": { "8.4.2": {
@ -1012,7 +1005,6 @@
"dlSubdir": "ghc-8.4.2", "dlSubdir": "ghc-8.4.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html",
"viTags": [] "viTags": []
}, },
"8.8.1": { "8.8.1": {
@ -1140,7 +1132,6 @@
"dlSubdir": "ghc-8.8.1", "dlSubdir": "ghc-8.8.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html",
"viTags": [] "viTags": []
}, },
"8.4.3": { "8.4.3": {
@ -1254,7 +1245,6 @@
"dlSubdir": "ghc-8.4.3", "dlSubdir": "ghc-8.4.3",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html",
"viTags": [] "viTags": []
}, },
"8.6.1": { "8.6.1": {
@ -1375,7 +1365,6 @@
"dlSubdir": "ghc-8.6.1", "dlSubdir": "ghc-8.6.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html",
"viTags": [] "viTags": []
}, },
"8.8.2": { "8.8.2": {
@ -1503,7 +1492,6 @@
"dlSubdir": "ghc-8.8.2", "dlSubdir": "ghc-8.8.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html",
"viTags": [] "viTags": []
}, },
"7.10.3": { "7.10.3": {
@ -1630,7 +1618,6 @@
"dlSubdir": "ghc-7.10.3", "dlSubdir": "ghc-7.10.3",
"dlUri": "https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/7.10.3/docs/html/users_guide/release-7-10-1.html",
"viTags": [] "viTags": []
}, },
"8.2.2": { "8.2.2": {
@ -1735,7 +1722,6 @@
"dlSubdir": "ghc-8.2.2", "dlSubdir": "ghc-8.2.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html",
"viTags": [] "viTags": []
}, },
"8.4.4": { "8.4.4": {
@ -1870,7 +1856,6 @@
"dlSubdir": "ghc-8.4.4", "dlSubdir": "ghc-8.4.4",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.4.4/docs/html/users_guide/8.4.4-notes.html",
"viTags": [] "viTags": []
}, },
"8.8.3": { "8.8.3": {
@ -1958,7 +1943,7 @@
"A_32": { "A_32": {
"Linux_Alpine": { "Linux_Alpine": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4", "dlHash": "23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec",
"dlSubdir": "ghc-8.8.3", "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" "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"
} }
@ -1998,7 +1983,6 @@
"dlSubdir": "ghc-8.8.3", "dlSubdir": "ghc-8.8.3",
"dlUri": "https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz" "dlUri": "https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz"
}, },
"viChangeLog": "https://downloads.haskell.org/ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html",
"viTags": [ "viTags": [
"Recommended" "Recommended"
] ]
@ -2038,7 +2022,6 @@
"dlSubdir": "cabal-cabal-install-v3.0.0.0/cabal-install", "dlSubdir": "cabal-cabal-install-v3.0.0.0/cabal-install",
"dlUri": "https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz" "dlUri": "https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz"
}, },
"viChangeLog": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog",
"viTags": [] "viTags": []
}, },
"3.2.0.0": { "3.2.0.0": {
@ -2074,7 +2057,6 @@
"dlSubdir": "cabal-cabal-install-v3.2.0.0/cabal-install", "dlSubdir": "cabal-cabal-install-v3.2.0.0/cabal-install",
"dlUri": "https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz" "dlUri": "https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz"
}, },
"viChangeLog": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog",
"viTags": [ "viTags": [
"Recommended", "Recommended",
"Latest" "Latest"
@ -2127,48 +2109,46 @@
"dlSubdir": "cabal-cabal-install-v2.4.1.0/cabal-install", "dlSubdir": "cabal-cabal-install-v2.4.1.0/cabal-install",
"dlUri": "https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz" "dlUri": "https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz"
}, },
"viChangeLog": "https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog",
"viTags": [] "viTags": []
} }
}, },
"GHCup": { "GHCup": {
"0.1.4": { "0.1.3": {
"viArch": { "viArch": {
"A_64": { "A_64": {
"FreeBSD": { "FreeBSD": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "cda0b959f053abc04ab0a1b9919a505b8c9304e2898a291f527a370cb0e00731", "dlHash": "2daa775d6fa307cb8123fa45ba20e2acd244cdb8cfb3f2b3c8a1aa3f3571c46f",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/x86_64-portbld-freebsd-ghcup-0.1.4" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3"
} }
}, },
"Darwin": { "Darwin": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "2422b79933ae037237ccb8f836417b90b3111d7931beb7ae8b9e33a1945c641e", "dlHash": "a617b06619ec6e75d50dac53f36814c3cafd4dbeebe8cea46d9cd5842c0c94a9",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/x86_64-apple-darwin-ghcup-0.1.4" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3"
} }
}, },
"Linux_UnknownLinux": { "Linux_UnknownLinux": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "78d69ed4c9a810a445af89ea25e4217a632799ecb427b06cd2320ffb574f555e", "dlHash": "873f73b65cf5e399864b81ed597a0e14fa73e0c492429cd3a85fe0fdc585a4c8",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/x86_64-linux-ghcup-0.1.3"
} }
} }
}, },
"A_32": { "A_32": {
"Linux_UnknownLinux": { "Linux_UnknownLinux": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "057cc1cc39abdacd92cb1d4fb44c850fd9c5398a36b893286248ac5c38bc0c70", "dlHash": "ff76a6130d6ea869a65bed127255bfa1ddf6aa1bd690df99d872467422c08be0",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3"
} }
} }
} }
}, },
"viSourceDL": null, "viSourceDL": null,
"viChangeLog": "https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md",
"viTags": [ "viTags": [
"Recommended", "Recommended",
"Latest" "Latest"

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

@ -11,7 +11,7 @@
module GHCup.Download where module GHCup.Download where
#if defined(INTERNAL_DOWNLOADER) #if !defined(CURL)
import GHCup.Download.IOStreams import GHCup.Download.IOStreams
import GHCup.Download.Utils import GHCup.Download.Utils
#endif #endif
@ -35,7 +35,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Data.Aeson import Data.Aeson
#if defined(INTERNAL_DOWNLOADER) #if !defined(CURL)
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( CI )
#endif #endif
@ -43,11 +43,10 @@ import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
#if defined(INTERNAL_DOWNLOADER) #if !defined(CURL)
import Data.Time.Format import Data.Time.Format
#endif #endif
import Data.Versions import Data.Versions
import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
import HPath import HPath
import HPath.IO as HIO import HPath.IO as HIO
@ -58,14 +57,12 @@ import Prelude hiding ( abs
, writeFile , writeFile
) )
import System.IO.Error import System.IO.Error
import System.Posix.Env.ByteString ( getEnv )
import URI.ByteString import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
#if defined(INTERNAL_DOWNLOADER) #if !defined(CURL)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T 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 -- | Downloads the download information! But only if we need to ;P
getDownloads :: ( FromJSONKey Tool getDownloads :: ( FromJSONKey Tool
, FromJSONKey Version , FromJSONKey Version
@ -136,7 +91,6 @@ getDownloads :: ( FromJSONKey Tool
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadReader Settings m
) )
=> URLSource => URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo -> 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. -- Always save the local file with the mod time of the remote file.
smartDl :: forall m1 smartDl :: forall m1
. ( MonadCatch m1 . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
, MonadIO m1
, MonadFail m1
, MonadLogger m1
, MonadReader Settings m1
)
=> URI => URI
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
@ -199,38 +148,31 @@ getDownloads urlSource = do
Just modTime -> do Just modTime -> do
fileMod <- liftIO $ getModificationTime json_file fileMod <- liftIO $ getModificationTime json_file
if modTime > fileMod 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 else liftIO $ readFile json_file
Nothing -> do Nothing -> do
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|] 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 else -- access in less than 5 minutes, re-use file
liftIO $ readFile json_file liftIO $ readFile json_file
else do else do
liftIO $ createDirIfMissing newDirPerms cacheDir liftIO $ createDirIfMissing newDirPerms cacheDir
getModTime >>= \case 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 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|] lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
dlWithoutMod json_file liftE $ downloadBS uri'
where 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 getModTime = do
#if !defined(INTERNAL_DOWNLOADER) #if defined(CURL)
pure Nothing pure Nothing
#else #else
headers <- headers <-
@ -250,7 +192,7 @@ getDownloads urlSource = do
True True
defaultTimeLocale defaultTimeLocale
"%a, %d %b %Y %H:%M:%S %Z" "%a, %d %b %Y %H:%M:%S %Z"
(T.unpack . decUTF8Safe $ h) (T.unpack . E.decodeUtf8 $ h)
#endif #endif
@ -314,7 +256,7 @@ download dli dest mfn
liftIO $ copyFile fromFile destFile Strict liftIO $ copyFile fromFile destFile Strict
pure destFile pure destFile
dl = do dl = do
let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli)) let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli))
lift $ $(logInfo) [i|downloading: #{uri'}|] lift $ $(logInfo) [i|downloading: #{uri'}|]
-- destination dir must exist -- destination dir must exist
@ -329,19 +271,12 @@ download dli dest mfn
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile) (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
>> (throwE . DownloadFailed $ e) >> (throwE . DownloadFailed $ e)
) $ do ) $ do
lift getDownloader >>= \case #if defined(CURL)
Curl -> do liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
o' <- liftIO getCurlOpts ["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True #else
(o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
Wget -> do liftE $ downloadToFile https host fullPath port destFile
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
#endif #endif
liftE $ checkDigest dli destFile liftE $ checkDigest dli destFile
@ -394,7 +329,7 @@ downloadCached dli mfn = do
-- | This is used for downloading the JSON. -- | This is used for downloading the JSON.
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m) downloadBS :: (MonadCatch m, MonadIO m)
=> URI => URI
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
@ -421,63 +356,32 @@ downloadBS uri'
where where
scheme = view (uriSchemeL' % schemeBSL') uri' scheme = view (uriSchemeL' % schemeBSL') uri'
path = view pathL' uri' path = view pathL' uri'
#if defined(INTERNAL_DOWNLOADER) #if defined(CURL)
dl https = do
#else
dl _ = do dl _ = do
#endif let exe = [rel|curl|]
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|] args = ["-sSfL", serializeURIRef' uri']
lift getDownloader >>= \case liftIO (executeOut exe args Nothing) >>= \case
Curl -> do CapturedProcess ExitSuccess stdout _ -> do
o' <- liftIO getCurlOpts pure $ L.fromStrict stdout
let exe = [rel|curl|] CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
args = o' ++ ["-sSfL", serializeURIRef' uri'] #else
liftIO (executeOut exe args Nothing) >>= \case dl https = do
CapturedProcess ExitSuccess stdout _ -> do (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
pure $ L.fromStrict stdout liftE $ downloadBS' https host' fullPath' port'
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'
#endif #endif
checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader Settings m) checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m)
=> DownloadInfo => DownloadInfo
-> Path Abs -> Path Abs
-> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
checkDigest dli file = do checkDigest dli file = do
verify <- lift ask <&> (not . noVerify) verify <- lift ask <&> (not . noVerify)
when verify $ do when verify $ do
p' <- toFilePath <$> basename file let p' = toFilePath file
lift $ $(logInfo) [i|verifying digest of: #{p'}|] lift $ $(logInfo) [i|verifying digest of: #{p'}|]
c <- liftIO $ readFile file c <- liftIO $ readFile file
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c let cDigest = E.decodeUtf8 . B16.encode . SHA256.hashlazy $ c
let eDigest = view dlHash dli eDigest = view dlHash dli
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) 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

@ -47,6 +47,7 @@ import URI.ByteString
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text.Encoding as E
import qualified System.IO.Streams as Streams import qualified System.IO.Streams as Streams
@ -145,7 +146,7 @@ downloadInternal = go (5 :: Int)
downloadStream r i' = do downloadStream r i' = do
let size = case getHeader r "Content-Length" of let size = case getHeader r "Content-Length" of
Just x' -> case decimal $ decUTF8Safe x' of Just x' -> case decimal $ E.decodeUtf8 x' of
Left _ -> 0 Left _ -> 0
Right (r', _) -> r' Right (r', _) -> r'
Nothing -> 0 Nothing -> 0

View File

@ -39,6 +39,7 @@ import System.Info
import Text.Regex.Posix import Text.Regex.Posix
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
-------------------------- --------------------------
--[ Platform detection ]-- --[ Platform detection ]--
@ -83,13 +84,13 @@ getPlatform = do
( either (const Nothing) Just ( either (const Nothing) Just
. versioning . versioning
. getMajorVersion . getMajorVersion
. decUTF8Safe . E.decodeUtf8
) )
<$> getDarwinVersion <$> getDarwinVersion
pure $ PlatformResult { _platform = Darwin, _distroVersion = ver } pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
"freebsd" -> do "freebsd" -> do
ver <- ver <-
(either (const Nothing) Just . versioning . decUTF8Safe) (either (const Nothing) Just . versioning . E.decodeUtf8)
<$> getFreeBSDVersion <$> getFreeBSDVersion
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
what -> throwE $ NoCompatiblePlatform what what -> throwE $ NoCompatiblePlatform what
@ -158,7 +159,7 @@ getLinuxDistro = do
(Just _) <- findExecutable lsb_release_cmd (Just _) <- findExecutable lsb_release_cmd
name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing
ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing
pure (decUTF8Safe name, Just $ decUTF8Safe ver) pure (E.decodeUtf8 name, Just $ E.decodeUtf8 ver)
try_lsb_release :: IO (Text, Maybe Text) try_lsb_release :: IO (Text, Maybe Text)
try_lsb_release = do try_lsb_release = do
@ -168,7 +169,7 @@ getLinuxDistro = do
try_redhat_release :: IO (Text, Maybe Text) try_redhat_release :: IO (Text, Maybe Text)
try_redhat_release = do try_redhat_release = do
t <- fmap decUTF8Safe' $ readFile redhat_release t <- fmap lBS2sT $ readFile redhat_release
let nameRegex n = let nameRegex n =
makeRegexOpts compIgnoreCase makeRegexOpts compIgnoreCase
execBlank execBlank
@ -191,4 +192,4 @@ getLinuxDistro = do
try_debian_version :: IO (Text, Maybe Text) try_debian_version :: IO (Text, Maybe Text)
try_debian_version = do try_debian_version = do
ver <- readFile debian_version ver <- readFile debian_version
pure (T.pack "debian", Just . decUTF8Safe' $ ver) pure (T.pack "debian", Just $ lBS2sT ver)

View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module GHCup.Types where module GHCup.Types where
@ -71,10 +70,9 @@ data Tool = GHC
-- | All necessary information of a tool version, including -- | All necessary information of a tool version, including
-- source download and per-architecture downloads. -- source download and per-architecture downloads.
data VersionInfo = VersionInfo data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag { _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball , _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -82,9 +80,7 @@ data VersionInfo = VersionInfo
-- | A tag. These are currently attached to a version of a tool. -- | A tag. These are currently attached to a version of a tool.
data Tag = Latest data Tag = Latest
| Recommended | Recommended
| Base PVP deriving (Ord, Eq, Show)
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, Show) -- FIXME: manual JSON instance
data Architecture = A_64 data Architecture = A_64
@ -141,26 +137,12 @@ data URLSource = GHCupURL
data Settings = Settings data Settings = Settings
{ cache :: Bool { cache :: Bool
, noVerify :: Bool , noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
} }
deriving Show 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 data DebugInfo = DebugInfo
{ diBaseDir :: Path Abs { diBaseDir :: Path Abs
, diBinDir :: Path Abs , diBinDir :: Path Abs

View File

@ -37,27 +37,14 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements 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 instance ToJSON URI where
toJSON = toJSON . decUTF8Safe . serializeURIRef' toJSON = toJSON . decodeUtf8 . serializeURIRef'
instance FromJSON URI where instance FromJSON URI where
parseJSON = withText "URL" $ \t -> parseJSON = withText "URL" $ \t ->
@ -156,14 +143,6 @@ instance FromJSONKey Version where
Right x -> pure x Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e 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 instance ToJSONKey Tool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions toJSONKey = genericToJSONKey defaultJSONKeyOptions
@ -172,7 +151,7 @@ instance FromJSONKey Tool where
instance ToJSON (Path Rel) where instance ToJSON (Path Rel) where
toJSON p = case and . fmap isAscii . BS.unpack $ fp of toJSON p = case and . fmap isAscii . BS.unpack $ fp of
True -> toJSON . decUTF8Safe $ fp True -> toJSON . E.decodeUtf8 $ fp
False -> String "/not/a/valid/path" False -> String "/not/a/valid/path"
where fp = toFilePath p where fp = toFilePath p

View File

@ -15,7 +15,6 @@ where
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.File import GHCup.Utils.File
@ -84,11 +83,9 @@ ghcLinkVersion = either (throwM . ParseError) pure . parseOnly parser
where where
parser = string "../ghc/" *> verParser <* string "/bin/ghc" parser = string "../ghc/" *> verParser <* string "/bin/ghc"
verParser = many1' (notWord8 _slash) >>= \t -> verParser = many1' (notWord8 _slash) >>= \t ->
case case version $ E.decodeUtf8 $ B.pack t of
version (decUTF8Safe $ B.pack t) Left e -> fail $ show e
of Right r -> pure r
Left e -> fail $ show e
Right r -> pure r
-- e.g. ghc-8.6.5 -- e.g. ghc-8.6.5
@ -162,7 +159,7 @@ ghcSrcInstalled ver = do
doesFileExist (ghcdir </> ghcUpSrcBuiltFile) doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
ghcSet :: (MonadIO m) => m (Maybe Version) ghcSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
ghcSet = do ghcSet = do
ghcBin <- (</> [rel|ghc|]) <$> liftIO ghcupBinDir ghcBin <- (</> [rel|ghc|]) <$> liftIO ghcupBinDir
@ -182,7 +179,7 @@ cabalSet = do
cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc
case version $ decUTF8Safe reportedVer of case version (E.decodeUtf8 reportedVer) of
Left e -> throwM e Left e -> throwM e
Right r -> pure r Right r -> pure r
@ -209,8 +206,7 @@ getGHCForMajor :: (MonadIO m, MonadThrow m)
getGHCForMajor major' minor' = do getGHCForMajor major' minor' = do
p <- liftIO $ ghcupGHCBaseDir p <- liftIO $ ghcupGHCBaseDir
ghcs <- liftIO $ getDirsFiles' p ghcs <- liftIO $ getDirsFiles' p
semvers <- forM ghcs $ \ghc -> semvers <- forM ghcs $ throwEither . semver . E.decodeUtf8 . toFilePath
throwEither . semver =<< (throwEither . E.decodeUtf8' . toFilePath $ ghc)
mapM (throwEither . version) mapM (throwEither . version)
. fmap prettySemVer . fmap prettySemVer
. lastMay . lastMay
@ -222,23 +218,6 @@ getGHCForMajor major' minor' = do
$ semvers $ 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
----------------- -----------------
@ -253,9 +232,8 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
-> Path Abs -- ^ archive path -> Path Abs -- ^ archive path
-> Excepts '[UnknownArchive] m () -> Excepts '[UnknownArchive] m ()
unpackToDir dest av = do unpackToDir dest av = do
fp <- (decUTF8Safe . toFilePath) <$> basename av let fp = E.decodeUtf8 (toFilePath av)
let dfp = decUTF8Safe . toFilePath $ dest lift $ $(logInfo) [i|Unpacking: #{fp}|]
lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
fn <- toFilePath <$> basename av fn <- toFilePath <$> basename av
let untar = Tar.unpack (toFilePath dest) . Tar.read let untar = Tar.unpack (toFilePath dest) . Tar.read
@ -280,25 +258,21 @@ unpackToDir dest av = do
------------ ------------
-- | Get the tool version that has this tag. If multiple have it, -- | Get the tool versions that have this tag.
-- picks the greatest version. getTagged :: GHCupDownloads -> Tool -> Tag -> [Version]
getTagged :: Tag -> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo) getTagged av tool tag = toListOf
getTagged tag = ( ix tool
( to (Map.filter (\VersionInfo {..} -> elem tag _viTags)) % to (Map.filter (\VersionInfo {..} -> elem tag _viTags))
% to Map.toDescList % to Map.keys
% _head % folded
) )
av
getLatest :: GHCupDownloads -> Tool -> Maybe Version getLatest :: GHCupDownloads -> Tool -> Maybe Version
getLatest av tool = headOf (ix tool % getTagged Latest % to fst) $ av getLatest av tool = headOf folded $ getTagged av tool Latest
getRecommended :: GHCupDownloads -> Tool -> Maybe Version getRecommended :: GHCupDownloads -> Tool -> Maybe Version
getRecommended av tool = headOf (ix tool % getTagged Recommended % to fst) $ av getRecommended av tool = headOf folded $ getTagged av tool Recommended
-- | 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
@ -311,10 +285,6 @@ getCache :: MonadReader Settings m => m Bool
getCache = ask <&> cache getCache = ask <&> cache
getDownloader :: MonadReader Settings m => m Downloader
getDownloader = ask <&> downloader
------------- -------------
--[ Other ]-- --[ Other ]--
@ -398,52 +368,3 @@ darwinNotarization Darwin path = exec
Nothing Nothing
Nothing Nothing
darwinNotarization _ _ = pure $ Right () darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog dls tool (Left v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (Right tag) = preview
( ix tool
% getTagged tag
% to snd
% 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

@ -43,6 +43,8 @@ import System.Posix.Types
import qualified Control.Exception as EX import qualified Control.Exception as EX
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified System.Posix.Process.ByteString import qualified System.Posix.Process.ByteString
as SPPB as SPPB
import Streamly.External.Posix.DirStream import Streamly.External.Posix.DirStream
@ -199,7 +201,6 @@ execLogged exe spath args lfile chdir env = do
lineAction ref rs bs' = do lineAction ref rs bs' = do
modifyIORef' ref (swapRegs bs') modifyIORef' ref (swapRegs bs')
regs <- readIORef ref regs <- readIORef ref
void $ SPIB.fdWrite fileFd (bs' <> "\n")
forM (zip regs rs) $ \(bs, r) -> do forM (zip regs rs) $ \(bs, r) -> do
setConsoleRegion r $ do setConsoleRegion r $ do
w <- consoleWidth w <- consoleWidth
@ -207,10 +208,12 @@ execLogged exe spath args lfile chdir env = do
. T.pack . T.pack
. color Blue . color Blue
. T.unpack . T.unpack
. decUTF8Safe . E.decodeUtf8With E.lenientDecode
. trim w . trim w
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b) . (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
$ bs $ bs
SPIB.fdWrite fileFd (bs <> "\n")
swapRegs bs regs | length regs < size = regs ++ [bs] swapRegs bs regs | length regs < size = regs ++ [bs]
| otherwise = tail regs ++ [bs] | otherwise = tail regs ++ [bs]
@ -368,7 +371,8 @@ searchPath paths needle = go paths
where where
go [] = pure Nothing go [] = pure Nothing
go (x : xs) = go (x : xs) =
hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs) hideErrorDefM PermissionDenied (go xs)
$ hideErrorDefM NoSuchThing (go xs)
$ do $ do
dirStream <- openDirStream (toFilePath x) dirStream <- openDirStream (toFilePath x)
S.findM (\(_, p) -> isMatch x p) (dirContentsStream dirStream) S.findM (\(_, p) -> isMatch x p) (dirContentsStream dirStream)

View File

@ -29,7 +29,6 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S import qualified Data.Strict.Maybe as S
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B import qualified Data.Text.Lazy.Builder.Int as B
@ -88,6 +87,10 @@ whileM_ ~action = void . whileM action
guardM :: (Monad m, Alternative m) => m Bool -> m () guardM :: (Monad m, Alternative m) => m Bool -> m ()
guardM ~f = guard =<< f guardM ~f = guard =<< f
lBS2sT :: L.ByteString -> Text
lBS2sT = TL.toStrict . TLE.decodeUtf8
handleIO' :: (MonadIO m, MonadCatch m) handleIO' :: (MonadIO m, MonadCatch m)
=> IOErrorType => IOErrorType
@ -165,14 +168,14 @@ liftIOException errType ex =
. lift . lift
hideErrorDef :: [IOErrorType] -> a -> IO a -> IO a hideErrorDef :: IOErrorType -> a -> IO a -> IO a
hideErrorDef errs def = hideErrorDef err def =
handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e) handleIO (\e -> if err == ioeGetErrorType e then pure def else ioError e)
hideErrorDefM :: [IOErrorType] -> IO a -> IO a -> IO a hideErrorDefM :: IOErrorType -> IO a -> IO a -> IO a
hideErrorDefM errs def = hideErrorDefM err def =
handleIO (\e -> if ioeGetErrorType e `elem` errs then def else ioError e) handleIO (\e -> if err == ioeGetErrorType e then def else ioError e)
-- TODO: does this work? -- TODO: does this work?
@ -240,16 +243,4 @@ addToCurrentEnv adds = do
pvpToVersion :: PVP -> Version pvpToVersion :: PVP -> Version
pvpToVersion = pvpToVersion = either (\_ -> error "Couldn't convert PVP to Version") id . version . prettyPVP
either (\_ -> error "Couldn't convert PVP to Version") id
. version
. prettyPVP
-- | Safe 'decodeUtf8With'. Replaces an invalid input byte with
-- the Unicode replacement character U+FFFD.
decUTF8Safe :: ByteString -> Text
decUTF8Safe = E.decodeUtf8With E.lenientDecode
decUTF8Safe' :: L.ByteString -> Text
decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode

View File

@ -9,14 +9,9 @@ import Data.Versions
import URI.ByteString import URI.ByteString
import URI.ByteString.QQ import URI.ByteString.QQ
import qualified Data.Text as T
-- | This reflects the API version of the JSON. -- | This reflects the API version of the JSON.
ghcupURL :: URI 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 :: PVP
ghcUpVer = [pver|0.1.4|] ghcUpVer = [pver|0.1.4|]
numericVer :: String
numericVer = T.unpack . prettyPVP $ ghcUpVer

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