Compare commits

...

50 Commits

Author SHA1 Message Date
a8be2efd85 Bump to version 0.1.5 2020-04-29 22:34:20 +02:00
f46700e1cc First cross try 2020-04-29 20:19:01 +02:00
d7a6935a1a Fix CI on FreeBSD 2020-04-29 20:14:38 +02:00
a1282b2854 Fix missing import 2020-04-29 19:36:16 +02:00
34b9ea7d20 Fix CI 2020-04-29 19:17:59 +02:00
0ff7ebb1fd Allow to set downloader 2020-04-29 19:12:58 +02:00
f83dcbc430 Run 'git describe' in CI to make sure --version reports it 2020-04-29 12:38:57 +02:00
56e4a6b15f Invert curl flag to internal-downloader 2020-04-29 09:56:26 +02:00
ee9b2ec30d Update docs 2020-04-28 17:41:08 +02:00
640cf1e2c1 Add zsh and fish completion wrt #19 2020-04-27 23:36:13 +02:00
56c439d716 Fall back to cached ghcup-<..>.json 2020-04-27 23:23:34 +02:00
1ed6e49a81 Install git in CI 2020-04-27 21:55:35 +02:00
fad9f83e6a Add CentoOS tool requirements 2020-04-27 21:52:44 +02:00
2e28b0d00f Fix release builds 2020-04-27 21:23:46 +02:00
ed4ff15f96 Update bash-completion 2020-04-27 07:47:46 +02:00
1d623723a2 Fix bug with missing ~/.ghcup/ghc/ dir 2020-04-26 22:06:00 +02:00
931080244f Fix bug in logging 2020-04-26 20:17:59 +02:00
27e2e7f848 Fix building of documentation 2020-04-26 11:55:47 +02:00
8b638c7ecb Rm stray ghc version 2020-04-25 13:22:12 +02:00
acd370611f Fix gitlab CI 2020-04-25 13:02:34 +02:00
e1b5a89cee Add bash-completion 2020-04-22 21:45:33 +02:00
5edebd57d9 Move download info into library 2020-04-22 19:32:48 +02:00
bcaccaaf31 Implement --keep 2020-04-22 19:32:14 +02:00
818a5d2d85 Document environment variables 2020-04-22 16:14:10 +02:00
13acce07d4 Allow to install X.Y versions 2020-04-22 16:13:58 +02:00
4ed5e21b7f Validate that all GHC versions have a base tag 2020-04-22 16:13:23 +02:00
86aab6bb59 Improve output formatting 2020-04-22 16:12:56 +02:00
7f5cb64b18 Re-add --format-raw to list subcommand 2020-04-22 13:03:46 +02:00
6c12eb16eb Add base tag 2020-04-22 11:59:40 +02:00
e637f90fae List stray tools 2020-04-21 23:37:48 +02:00
5b33c3f491 Update TODO 2020-04-19 22:49:19 +02:00
1842ed464f Also build 32bit release artifact 2020-04-19 22:31:53 +02:00
296bbdd561 Fix digest of ghc-8.8.3-i386-unknown-linux-musl.tar.xz 2020-04-19 22:05:18 +02:00
27ead1be7c Build releases 2020-04-19 18:55:07 +02:00
5184609dba Enable FreeBSD testing
Also use the new ghcup for bootstrapping GHC in install_deps.
2020-04-19 16:33:45 +02:00
5d94d0bf75 Also check for GHC and Cabal updates on start 2020-04-18 20:20:18 +02:00
72bcfa9270 Fix CI 2020-04-18 17:29:44 +02:00
fafff9dadd Update FAQ 2020-04-18 16:57:51 +02:00
e3c20d53a8 Add changelog command
This should be backwardscompatible with 0.0.1 json format.

Also slightly change 'getTagged' to list the latest version
with a tag, not the oldest.
2020-04-18 15:06:22 +02:00
8b7dc68491 Fix ChangeLog date 2020-04-18 15:04:39 +02:00
7742fe08b5 Improve help messages 2020-04-17 22:58:15 +02:00
a773da037c On second thought... 2020-04-17 20:50:23 +02:00
dfeb814dcc Formatting 2020-04-17 18:57:58 +02:00
0623c7b1b1 Improve error reporting 2020-04-17 18:57:58 +02:00
62005f83a4 Improve debug info 2020-04-17 18:57:58 +02:00
eaafd77a7e Add --version and --numeric-version 2020-04-17 18:57:58 +02:00
9d9e415a09 Remove use of unsafe decodeUtf8 2020-04-17 09:30:45 +02:00
6c1ae585b7 Indicate removal of tmpdir after failed build 2020-04-17 09:29:31 +02:00
793aad7b6c Fix ghc-make when files are in PATH
Fixes #11
2020-04-16 23:15:21 +02:00
fd7807a66e Add 0.1.4 downloads 2020-04-16 23:14:27 +02:00
39 changed files with 4350 additions and 620 deletions

View File

@@ -12,16 +12,52 @@ 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.1" JSON_VERSION: "0.0.2"
.test_ghcup_version:linux: .test_ghcup_version:linux:
extends: extends:
@@ -29,50 +65,133 @@ 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 ######## ######## linux test ########
test:linux:recommended: test:linux:recommended:
extends: .test_ghcup_version:linux extends: .test_ghcup_version:linux
variables: variables:
GHC_VERSION: "recommended" GHC_VERSION: "8.6.5"
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: "latest" GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
allow_failure: true allow_failure: true
######## darwin ######## ######## darwin test ########
test:mac:recommended: test:mac:recommended:
extends: .test_ghcup_version:darwin extends: .test_ghcup_version:darwin
variables: variables:
GHC_VERSION: "recommended" GHC_VERSION: "8.6.5"
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: "latest" GHC_VERSION: "8.8.3"
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://gitlab.haskell.org/haskell/ghcup/-/raw/master/ghcup > ./ghcup-legacy curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin
chmod +x ghcup-legacy chmod +x ghcup-bin
./ghcup-legacy install ${GHC_VERSION} ./ghcup-bin install ${GHC_VERSION}
./ghcup-legacy set ${GHC_VERSION} ./ghcup-bin set ${GHC_VERSION}
./ghcup-legacy install-cabal ./ghcup-bin install-cabal ${CABAL_VERSION}
exit 0 exit 0

View File

@@ -0,0 +1,23 @@
#!/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

@@ -0,0 +1,61 @@
#!/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 sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env" . "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
curl -sSfL https://gitlab.haskell.org/haskell/ghcup/-/raw/master/ghcup > ./ghcup-legacy curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
chmod +x ghcup-legacy chmod +x ghcup-bin
./ghcup-legacy install ${GHC_VERSION} ./ghcup-bin install ${GHC_VERSION}
./ghcup-legacy set ${GHC_VERSION} ./ghcup-bin set ${GHC_VERSION}
./ghcup-legacy install-cabal ./ghcup-bin install-cabal ${CABAL_VERSION}

30
.gitlab/script/ghcup_release.sh Executable file
View File

@@ -0,0 +1,30 @@
#!/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,32 +14,45 @@ eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@" ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
} }
# build git describe
### build
ecabal update ecabal update
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
ecabal build -fcurl ecabal build -w ghc-${GHC_VERSION}
else else
ecabal build ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
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 eghcup install-cabal ${CABAL_VERSION}
cabal --version cabal --version
@@ -58,7 +71,11 @@ 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
eghcup install 8.4.4 if [ "${OS}" = "LINUX" ] ; then
eghcup --downloader=wget install 8.4.4
else # test wget a bit
eghcup 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,22 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.4 -- 2012-04-16 ## 0.1.5 -- 2020-04-30
* Fix errors when PATH variable contains path components that are actually files
* Add `--version` and `--numeric-version` options
* Add `changelog` command
* Also check for available GHC and Cabal updates on start
* Add base versions as tags for every GHC version (these are "installable" tags and the latest GHC version matching the tag will be picked)
* Added `--format-raw` to list subcommand
* Allow to install X.Y versions (e.g.: ghcup install 8.8)
* Implement `--keep=<always|errors|never>` to control temporary build directories cleanup
* Add proper shell completions to the repo
* Fix building of documentation
* Allow to work in offline mode and use cached files if possible
* Allow to set the downloader via `--downloader=<curl|wget>`
* Support for compiling and installing a cross GHC (see README). This is experimental.
## 0.1.4 -- 2020-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,3 +43,22 @@ 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`.
## Major refactors
1. First major refactor included adding cross support. This added
`GHCTargetVersion`, which includes the target in addition to the version.
Most of the `Version` parameters to functions had to be replaced with
that and ensured the logic is consistent for cross and non-cross
installs.

View File

@@ -11,6 +11,8 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
* [Installation](#installation) * [Installation](#installation)
* [Usage](#usage) * [Usage](#usage)
* [Manpages](#manpages) * [Manpages](#manpages)
* [Shell-completion](#shell-completion)
* [Cross support](#cross-support)
* [Design goals](#design-goals) * [Design goals](#design-goals)
* [How](#how) * [How](#how)
* [Known users](#known-users) * [Known users](#known-users)
@@ -68,6 +70,26 @@ 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).
### Cross support
ghcup can compile and install a cross GHC for any target. However, this
requires that the build host has a complete cross toolchain and various
libraries installed for the target platform.
Consult the GHC documentation on the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#tools-to-install).
For distributions with non-standard locations of cross toolchain and
libraries, this may need some tweaking of `build.mk` or configure args.
See `ghcup compile ghc --help` for further information.
## Design goals ## Design goals
1. simplicity 1. simplicity
@@ -142,3 +164,6 @@ 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,8 +4,11 @@
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. 3. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`. 4. Download release artifacts and upload them `downloads.haskell.org/ghcup`
5. Add release artifacts to GHCupDownloads (see point 2.)
6. Upload the final `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
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,27 +2,39 @@
## Now ## Now
* move out GHCup.Version module, bc it's not library-ish * try to run exe before upgrade (backup to ~/.ghcup/bin/ghcup.old)
* allow to build 8.8
* curl DL does not cache json
* explain environment variables
* add --keep=<always|error> option
* allow to switch to curl/wget at runtime
* cross support
* installing multiple versions of the same
* proper test suite
* add more logging
## Maybe ## Maybe
* maybe: changelog Show the changelog of a GHC release (online) * version ranges in json
* 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

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

@@ -27,9 +27,12 @@ import Haskus.Utils.Variant.Excepts
import Optics import Optics
import System.Exit import System.Exit
import System.IO import System.IO
import Text.ParserCombinators.ReadP
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Version as V
data ValidationError = InternalError String data ValidationError = InternalError String
@@ -61,8 +64,9 @@ validate dls = do
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v arch (M.keys pspecs) checkHasRequiredPlatforms t v arch (M.keys pspecs)
checkGHCisSemver checkGHCVerIsValid
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
@@ -85,7 +89,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 $ fmap snd $ availableToolVersions dls tool let allTags = join $ M.elems $ availableToolVersions dls tool
let nonUnique = let nonUnique =
fmap fst fmap fst
. filter (\(_, b) -> not b) . filter (\(_, b) -> not b)
@@ -105,26 +109,40 @@ 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 checkGHCVerIsValid = do
let ghcVers = toListOf (ix GHC % to M.keys % folded) dls let ghcVers = toListOf (ix GHC % to M.keys % folded) dls
forM_ ghcVers $ \v -> case semver (prettyVer v) of forM_ ghcVers $ \v ->
Left _ -> do case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
lift $ $(logError) [i|GHC version #{v} is not valid semver|] [_] -> pure ()
addError _ -> do
Right _ -> pure () lift $ $(logError) [i|GHC version #{v} is not valid |]
addError
-- 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 $ fmap snd $ availableToolVersions dls tool let allTags = join $ M.elems $ 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
@@ -161,7 +179,7 @@ validateTarballs dls = do
where where
downloadAll dli = do downloadAll dli = do
let settings = Settings True False let settings = Settings True False Never Curl
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr , colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ()) , rawOutter = (\_ -> pure ())

File diff suppressed because it is too large Load Diff

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.3/x86_64-linux-ghcup-0.1.3 _url=https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4
;; ;;
i*86) i*86)
_url=https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3 _url=https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4
;; ;;
*) 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.3/x86_64-portbld-freebsd-ghcup-0.1.3 _url=https://downloads.haskell.org/~ghcup/0.1.4/x86_64-portbld-freebsd-ghcup-0.1.4
;; ;;
"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.3/x86_64-apple-darwin-ghcup-0.1.3 ;; _url=https://downloads.haskell.org/~ghcup/0.1.4/x86_64-apple-darwin-ghcup-0.1.4 ;;
*) die "Unknown platform: ${_plat}" *) die "Unknown platform: ${_plat}"
;; ;;
esac esac

View File

@@ -170,6 +170,7 @@
"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": {
@@ -264,6 +265,7 @@
"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": {
@@ -377,6 +379,7 @@
"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": {
@@ -482,6 +485,7 @@
"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": {
@@ -616,6 +620,7 @@
"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": {
@@ -756,6 +761,7 @@
"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"
] ]
@@ -885,6 +891,7 @@
"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": {
@@ -1005,6 +1012,7 @@
"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": {
@@ -1132,6 +1140,7 @@
"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": {
@@ -1245,6 +1254,7 @@
"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": {
@@ -1365,6 +1375,7 @@
"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": {
@@ -1492,6 +1503,7 @@
"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": {
@@ -1618,6 +1630,7 @@
"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": {
@@ -1722,6 +1735,7 @@
"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": {
@@ -1856,6 +1870,7 @@
"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": {
@@ -1943,7 +1958,7 @@
"A_32": { "A_32": {
"Linux_Alpine": { "Linux_Alpine": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec", "dlHash": "7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4",
"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"
} }
@@ -1983,6 +1998,7 @@
"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"
] ]
@@ -2022,6 +2038,7 @@
"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": {
@@ -2057,6 +2074,7 @@
"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"
@@ -2109,46 +2127,48 @@
"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.3": { "0.1.4": {
"viArch": { "viArch": {
"A_64": { "A_64": {
"FreeBSD": { "FreeBSD": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "2daa775d6fa307cb8123fa45ba20e2acd244cdb8cfb3f2b3c8a1aa3f3571c46f", "dlHash": "cda0b959f053abc04ab0a1b9919a505b8c9304e2898a291f527a370cb0e00731",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/x86_64-portbld-freebsd-ghcup-0.1.4"
} }
}, },
"Darwin": { "Darwin": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "a617b06619ec6e75d50dac53f36814c3cafd4dbeebe8cea46d9cd5842c0c94a9", "dlHash": "2422b79933ae037237ccb8f836417b90b3111d7931beb7ae8b9e33a1945c641e",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/x86_64-apple-darwin-ghcup-0.1.4"
} }
}, },
"Linux_UnknownLinux": { "Linux_UnknownLinux": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "873f73b65cf5e399864b81ed597a0e14fa73e0c492429cd3a85fe0fdc585a4c8", "dlHash": "78d69ed4c9a810a445af89ea25e4217a632799ecb427b06cd2320ffb574f555e",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/x86_64-linux-ghcup-0.1.3" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4"
} }
} }
}, },
"A_32": { "A_32": {
"Linux_UnknownLinux": { "Linux_UnknownLinux": {
"unknown_versioning": { "unknown_versioning": {
"dlHash": "ff76a6130d6ea869a65bed127255bfa1ddf6aa1bd690df99d872467422c08be0", "dlHash": "057cc1cc39abdacd92cb1d4fb44c850fd9c5398a36b893286248ac5c38bc0c70",
"dlSubdir": null, "dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3" "dlUri": "https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4"
} }
} }
} }
}, },
"viSourceDL": null, "viSourceDL": null,
"viChangeLog": "https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md",
"viTags": [ "viTags": [
"Recommended", "Recommended",
"Latest" "Latest"

2278
ghcup-0.0.2.json Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.4 version: 0.1.5
synopsis: ghc toolchain installer as an exe/library synopsis: ghc toolchain installer as an exe/library
description: description:
A rewrite of the shell script ghcup, for providing A rewrite of the shell script ghcup, for providing
@@ -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 Curl flag internal-downloader
description: Use curl instead of http-io-streams for download description: Compile the internal downloader, which links against OpenSSL
default: False default: False
manual: True manual: True
@@ -41,9 +41,6 @@ common ascii-string
common async common async
build-depends: async >=0.8 build-depends: async >=0.8
common attoparsec
build-depends: attoparsec >=0.13
common base common base
build-depends: base >=4.12 && <5 build-depends: base >=4.12 && <5
@@ -230,7 +227,6 @@ library
, aeson , aeson
, ascii-string , ascii-string
, async , async
, attoparsec
, binary , binary
, bytestring , bytestring
, bz2 , bz2
@@ -248,6 +244,7 @@ library
, hpath-posix , hpath-posix
, language-bash , language-bash
, lzma , lzma
, megaparsec
, monad-logger , monad-logger
, mtl , mtl
, optics , optics
@@ -279,6 +276,9 @@ 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
@@ -292,6 +292,7 @@ library
GHCup.Utils.Dirs GHCup.Utils.Dirs
GHCup.Utils.File GHCup.Utils.File
GHCup.Utils.Logger GHCup.Utils.Logger
GHCup.Utils.MegaParsec
GHCup.Utils.Prelude GHCup.Utils.Prelude
GHCup.Utils.String.QQ GHCup.Utils.String.QQ
GHCup.Utils.Version.QQ GHCup.Utils.Version.QQ
@@ -301,15 +302,14 @@ library
-- other-extensions: -- other-extensions:
hs-source-dirs: lib hs-source-dirs: lib
if !flag(curl) if flag(internal-downloader)
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
else cpp-options: -DINTERNAL_DOWNLOADER
cpp-options: -DCURL
executable ghcup executable ghcup
import: import:
@@ -326,8 +326,10 @@ 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
@@ -342,6 +344,10 @@ 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
@@ -370,9 +376,6 @@ 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,6 +9,7 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup where module GHCup where
@@ -40,6 +41,7 @@ import Data.ByteString ( ByteString )
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions import Data.Versions
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
@@ -52,11 +54,14 @@ import Prelude hiding ( abs
, writeFile , writeFile
) )
import System.IO.Error import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment )
import System.Posix.FilePath ( getSearchPath ) import System.Posix.FilePath ( getSearchPath )
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@@ -93,45 +98,34 @@ installGHCBin :: ( MonadFail m
m m
() ()
installGHCBin bDls ver mpfReq = do installGHCBin bDls ver mpfReq = do
let tver = (mkTVer ver)
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 $ ghcInstalled tver)
$ (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
-- prepare paths -- prepare paths
ghcdir <- liftIO $ ghcupGHCDir ver ghcdir <- liftIO $ ghcupGHCDir tver
-- 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)
-- Be careful about cleanup. We must catch both pure exceptions liftE $ runBuildAction tmpUnpack (Just ghcdir) (installGHC' workdir ghcdir)
-- 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 liftE $ postGHCInstall tver
liftIO $ deleteDirRecursive tmpUnpack
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
@@ -172,15 +166,15 @@ installCabalBin :: ( MonadMask m
() ()
installCabalBin bDls ver mpfReq = do installCabalBin bDls ver mpfReq = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] lift $ $(logDebug) [i|Requested to install cabal version #{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 Cabal ver pfreq bDls dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
-- unpack -- unpack
tmpUnpack <- lift withGHCupTmpDir tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
@@ -194,7 +188,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
@@ -226,11 +220,11 @@ installCabalBin bDls ver mpfReq = do
-- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc/<ver>/share symlink -- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc/<ver>/share symlink
-- for `SetGHCOnly` constructor. -- for `SetGHCOnly` constructor.
setGHC :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) setGHC :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version => GHCTargetVersion
-> SetGHC -> SetGHC
-> Excepts '[NotInstalled] m Version -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC ver sghc = do setGHC ver sghc = do
let verBS = verToBS ver let verBS = verToBS (_tvVersion ver)
ghcdir <- liftIO $ ghcupGHCDir ver ghcdir <- liftIO $ ghcupGHCDir ver
-- symlink destination -- symlink destination
@@ -240,7 +234,7 @@ setGHC ver sghc = do
-- first delete the old symlinks (this fixes compatibility issues -- first delete the old symlinks (this fixes compatibility issues
-- with old ghcup) -- with old ghcup)
case sghc of case sghc of
SetGHCOnly -> liftE $ rmPlain ver SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
SetGHC_XY -> lift $ rmMajorSymlinks ver SetGHC_XY -> lift $ rmMajorSymlinks ver
SetGHC_XYZ -> lift $ rmMinorSymlinks ver SetGHC_XYZ -> lift $ rmMinorSymlinks ver
@@ -250,9 +244,8 @@ setGHC ver sghc = do
targetFile <- case sghc of targetFile <- case sghc of
SetGHCOnly -> pure file SetGHCOnly -> pure file
SetGHC_XY -> do SetGHC_XY -> do
major' <- major' <- (\(mj, mi) -> E.encodeUtf8 $ intToText mj <> "." <> intToText mi)
(\(mj, mi) -> E.encodeUtf8 $ intToText mj <> "." <> intToText mi) <$> getMajorMinorV (_tvVersion ver)
<$> getGHCMajor ver
parseRel (toFilePath file <> B.singleton _hyphen <> major') parseRel (toFilePath file <> B.singleton _hyphen <> major')
SetGHC_XYZ -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS) SetGHC_XYZ -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS)
@@ -263,7 +256,7 @@ setGHC ver sghc = do
liftIO $ createSymlink fullF destL liftIO $ createSymlink fullF destL
-- create symlink for share dir -- create symlink for share dir
lift $ symlinkShareDir ghcdir verBS when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verBS
pure ver pure ver
@@ -303,27 +296,41 @@ data ListCriteria = ListInstalled
data ListResult = ListResult data ListResult = ListResult
{ lTool :: Tool { lTool :: Tool
, lVer :: Version , lVer :: Version
, lCross :: Maybe Text -- ^ currently only for GHC
, lTag :: [Tag] , lTag :: [Tag]
, lInstalled :: Bool , lInstalled :: Bool
, lSet :: Bool , lSet :: Bool -- ^ currently active version
, fromSrc :: Bool , fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
} }
deriving Show deriving (Eq, Ord, Show)
availableToolVersions :: GHCupDownloads -> Tool -> [(Version, [Tag])] availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
availableToolVersions av tool = toListOf availableToolVersions av tool = view
(ix tool % to (fmap (\(v, vi) -> (v, (_viTags vi))) . Map.toList) % folded) (at tool % non Map.empty % to (fmap (_viTags)))
av av
listVersions :: GHCupDownloads -- | List all versions from the download info, as well as stray
-- versions.
listVersions :: (MonadThrow m, MonadLogger m, MonadIO m)
=> GHCupDownloads
-> Maybe Tool -> Maybe Tool
-> Maybe ListCriteria -> Maybe ListCriteria
-> IO [ListResult] -> m [ListResult]
listVersions av lt criteria = case lt of listVersions av lt criteria = case lt of
Just t -> do Just t -> do
filter' <$> forM (availableToolVersions av t) (toListResult t) -- get versions from GHCupDownloads
let avTools = availableToolVersions av t
lr <- filter' <$> forM (Map.toList avTools) (liftIO . toListResult t)
case t of
-- append stray GHCs
GHC -> do
slr <- strayGHCs avTools
pure $ (sort (slr ++ lr))
_ -> pure lr
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
@@ -331,21 +338,75 @@ listVersions av lt criteria = case lt of
pure (ghcvers <> cabalvers <> ghcupvers) pure (ghcvers <> cabalvers <> ghcupvers)
where where
strayGHCs :: (MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayGHCs avTools = do
ghcs <- getInstalledGHCs
fmap catMaybes $ forM ghcs $ \case
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
case Map.lookup _tvVersion avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
fromSrc <- liftIO $ ghcSrcInstalled tver
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = Nothing
, lTag = []
, lInstalled = True
, lStray = maybe True (const False) (Map.lookup _tvVersion avTools)
, ..
}
Right tver@GHCTargetVersion{ .. } -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- liftIO $ ghcSrcInstalled tver
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = _tvTarget
, lTag = []
, lInstalled = True
, lStray = True -- NOTE: cross currently cannot be installed via bindist
, ..
}
Left e -> do
$(logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing
-- NOTE: this are not cross ones, because no bindists
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 let tver = mkTVer v
lInstalled <- ghcInstalled v lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
fromSrc <- ghcSrcInstalled v lInstalled <- ghcInstalled tver
pure ListResult { lVer = v, lTag = tags, lTool = t, .. } fromSrc <- ghcSrcInstalled tver
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
Cabal -> do Cabal -> do
lSet <- fmap (== v) $ cabalSet lSet <- fmap (== v) $ cabalSet
let lInstalled = lSet let lInstalled = lSet
pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. } pure ListResult { lVer = v
, lCross = Nothing
, 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, lTag = tags, lTool = t, fromSrc = False, .. } pure ListResult { lVer = v
, lTag = tags
, lCross = Nothing
, lTool = t
, fromSrc = False
, lStray = False
, ..
}
filter' :: [ListResult] -> [ListResult] filter' :: [ListResult] -> [ListResult]
@@ -363,10 +424,10 @@ listVersions av lt criteria = case lt of
-- | This function may throw and crash in various ways. -- | This function may throw and crash in various ways.
rmGHCVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m) rmGHCVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m)
=> Version => GHCTargetVersion
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmGHCVer ver = do rmGHCVer ver = do
isSetGHC <- fmap (maybe False (== ver)) $ ghcSet isSetGHC <- fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
dir <- liftIO $ ghcupGHCDir ver dir <- liftIO $ ghcupGHCDir ver
let d' = toFilePath dir let d' = toFilePath dir
exists <- liftIO $ doesDirectoryExist dir exists <- liftIO $ doesDirectoryExist dir
@@ -377,7 +438,7 @@ rmGHCVer ver = do
-- this isn't atomic, order matters -- this isn't atomic, order matters
when isSetGHC $ do when isSetGHC $ do
lift $ $(logInfo) [i|Removing ghc symlinks|] lift $ $(logInfo) [i|Removing ghc symlinks|]
liftE $ rmPlain ver liftE $ rmPlain (_tvTarget ver)
lift $ $(logInfo) [i|Removing directory recursively: #{d'}|] lift $ $(logInfo) [i|Removing directory recursively: #{d'}|]
liftIO $ deleteDirRecursive dir liftIO $ deleteDirRecursive dir
@@ -389,15 +450,15 @@ rmGHCVer ver = do
-- first remove -- first remove
lift $ rmMajorSymlinks ver lift $ rmMajorSymlinks ver
-- then fix them (e.g. with an earlier version) -- then fix them (e.g. with an earlier version)
(mj, mi) <- getGHCMajor ver (mj, mi) <- getMajorMinorV (_tvVersion ver)
getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) getGHCForMajor mj mi (_tvTarget ver) >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
liftIO liftIO
$ ghcupBaseDir $ ghcupBaseDir
>>= hideError doesNotExistErrorType >>= hideError doesNotExistErrorType
. deleteFile . deleteFile
. (</> [rel|share|]) . (</> [rel|share|])
else throwE (NotInstalled GHC ver) else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))
@@ -438,11 +499,12 @@ compileGHC :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> GHCupDownloads => GHCupDownloads
-> Version -- ^ version to install -> GHCTargetVersion -- ^ version to install
-> Either Version (Path Abs) -- ^ version to bootstrap with -> Either Version (Path Abs) -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
-> Maybe (Path Abs) -- ^ build config -> Maybe (Path Abs) -- ^ build config
-> Maybe (Path Abs) -> Maybe (Path Abs) -- ^ patch directory
-> [Text] -- ^ additional args to ./configure
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
@@ -459,13 +521,15 @@ compileGHC :: ( MonadMask m
] ]
m m
() ()
compileGHC dls tver bstrap jobs mbuildConfig patchdir = do compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs = do
lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|] lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
whenM (liftIO $ toolAlreadyInstalled GHC tver) whenM (liftIO $ ghcInstalled tver)
(throwE $ AlreadyInstalled GHC tver) (throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
-- download source tarball -- download source tarball
dlInfo <- preview (ix GHC % ix tver % viSourceDL % _Just) dls ?? NoDownload dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing dl <- liftE $ downloadCached dlInfo Nothing
-- unpack -- unpack
@@ -480,32 +544,29 @@ 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
-- Be careful about cleanup. We must catch both pure exceptions liftE $ runBuildAction
-- as well as async ones. tmpUnpack
flip onException (Just ghcdir)
(liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir) (compile bghc ghcdir workdir >> markSrcBuilt ghcdir workdir)
$ 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 ()
where where
defaultConf = [s| defaultConf = case _tvTarget tver of
Nothing -> [s|
V=0 V=0
BUILD_MAN = NO BUILD_MAN = NO
BUILD_SPHINX_HTML = NO BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES HADDOCK_DOCS = YES|]
GhcWithLlvmCodeGen = YES|] Just _ -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO
Stage1Only = YES|]
compile :: (MonadCatch m, MonadLogger m, MonadIO m) compile :: (MonadCatch m, MonadLogger m, MonadIO m)
=> Either (Path Rel) (Path Abs) => Either (Path Rel) (Path Abs)
@@ -513,6 +574,7 @@ GhcWithLlvmCodeGen = YES|]
-> Path Abs -> Path Abs
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
, InvalidBuildConfig
, PatchFailed , PatchFailed
, ProcessError , ProcessError
, NotFoundInPATH , NotFoundInPATH
@@ -521,14 +583,14 @@ GhcWithLlvmCodeGen = YES|]
() ()
compile bghc ghcdir workdir = do compile bghc ghcdir workdir = do
lift $ $(logInfo) [i|configuring build|] lift $ $(logInfo) [i|configuring build|]
liftE $ checkBuildConfig
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
-- force ld.bfd for build (others seem to misbehave, like lld from FreeBSD) cEnv <- liftIO $ getEnvironment
newEnv <- addToCurrentEnv [("LD", "ld.bfd")]
if if
| tver >= [vver|8.8.0|] -> do | (_tvVersion tver) >= [vver|8.8.0|] -> do
bghcPath <- case bghc of bghcPath <- case bghc of
Right ghc' -> pure ghc' Right ghc' -> pure ghc'
Left bver -> do Left bver -> do
@@ -537,20 +599,32 @@ GhcWithLlvmCodeGen = YES|]
lEM $ liftIO $ execLogged lEM $ liftIO $ execLogged
"./configure" "./configure"
False False
["--prefix=" <> toFilePath ghcdir] ( ["--prefix=" <> toFilePath ghcdir]
++ (maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x])
(_tvTarget tver)
)
++ fmap E.encodeUtf8 aargs
)
[rel|ghc-conf|] [rel|ghc-conf|]
(Just workdir) (Just workdir)
(Just (("GHC", toFilePath bghcPath) : newEnv)) (Just (("GHC", toFilePath bghcPath) : cEnv))
| otherwise -> do | otherwise -> do
lEM $ liftIO $ execLogged lEM $ liftIO $ execLogged
"./configure" "./configure"
False False
[ "--prefix=" <> toFilePath ghcdir ( [ "--prefix=" <> toFilePath ghcdir
, "--with-ghc=" <> either toFilePath toFilePath bghc , "--with-ghc=" <> either toFilePath toFilePath bghc
] ]
++ (maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x])
(_tvTarget tver)
)
++ fmap E.encodeUtf8 aargs
)
[rel|ghc-conf|] [rel|ghc-conf|]
(Just workdir) (Just workdir)
(Just newEnv) (Just cEnv)
case mbuildConfig of case mbuildConfig of
Just bc -> liftIOException Just bc -> liftIOException
@@ -573,6 +647,30 @@ GhcWithLlvmCodeGen = YES|]
build_mk workdir = workdir </> [rel|mk/build.mk|] build_mk workdir = workdir </> [rel|mk/build.mk|]
checkBuildConfig :: (MonadCatch m, MonadIO m)
=> Excepts
'[FileDoesNotExistError , InvalidBuildConfig]
m
()
checkBuildConfig = do
c <- case mbuildConfig of
Just bc -> do
BL.toStrict <$> liftIOException doesNotExistErrorType
(FileDoesNotExistError $ toFilePath bc)
(liftIO $ readFile bc)
Nothing -> pure defaultConf
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
-- for cross, we need Stage1Only
case _tvTarget tver of
Just _ -> when (not $ elem "Stage1Only = YES" lines') $ throwE
(InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
)
Nothing -> pure ()
compileCabal :: ( MonadReader Settings m compileCabal :: ( MonadReader Settings m
, MonadResource m , MonadResource m
@@ -613,7 +711,11 @@ 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
@@ -728,12 +830,12 @@ upgradeGHCup dls mtarget force = do
-- | Creates ghc-x.y.z and ghc-x.y symlinks. This is used for -- | Creates ghc-x.y.z and ghc-x.y symlinks. This is used for
-- both installing from source and bindist. -- both installing from source and bindist.
postGHCInstall :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) postGHCInstall :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version => GHCTargetVersion
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
postGHCInstall ver = do postGHCInstall ver@GHCTargetVersion{..} = do
void $ liftE $ setGHC ver SetGHC_XYZ void $ liftE $ setGHC ver SetGHC_XYZ
-- Create ghc-x.y symlinks. This may not be the current -- Create ghc-x.y symlinks. This may not be the current
-- version, create it regardless. -- version, create it regardless.
(mj, mi) <- liftIO $ getGHCMajor ver (mj, mi) <- getMajorMinorV _tvVersion
getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) getGHCForMajor mj mi _tvTarget >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)

View File

@@ -2,7 +2,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module GHCupDownloads where module GHCup.Data.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|])
"23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec" "7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4"
@@ -951,6 +951,24 @@ 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"
--------------------- ---------------------
@@ -976,6 +994,24 @@ 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"
@@ -984,32 +1020,32 @@ cabal_3200_64_darwin = DownloadInfo
------------- -------------
ghcup_013_32_linux :: DownloadInfo ghcup_014_32_linux :: DownloadInfo
ghcup_013_32_linux = DownloadInfo ghcup_014_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3|] [uri|https://downloads.haskell.org/~ghcup/0.1.4/i386-linux-ghcup-0.1.4|]
Nothing Nothing
"ff76a6130d6ea869a65bed127255bfa1ddf6aa1bd690df99d872467422c08be0" "057cc1cc39abdacd92cb1d4fb44c850fd9c5398a36b893286248ac5c38bc0c70"
ghcup_013_64_linux :: DownloadInfo ghcup_014_64_linux :: DownloadInfo
ghcup_013_64_linux = DownloadInfo ghcup_014_64_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-linux-ghcup-0.1.3|] [uri|https://downloads.haskell.org/~ghcup/0.1.4/x86_64-linux-ghcup-0.1.4|]
Nothing Nothing
"873f73b65cf5e399864b81ed597a0e14fa73e0c492429cd3a85fe0fdc585a4c8" "78d69ed4c9a810a445af89ea25e4217a632799ecb427b06cd2320ffb574f555e"
ghcup_013_64_freebsd :: DownloadInfo ghcup_014_64_freebsd :: DownloadInfo
ghcup_013_64_freebsd = DownloadInfo ghcup_014_64_freebsd = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3|] [uri|https://downloads.haskell.org/~ghcup/0.1.4/x86_64-portbld-freebsd-ghcup-0.1.4|]
Nothing Nothing
"2daa775d6fa307cb8123fa45ba20e2acd244cdb8cfb3f2b3c8a1aa3f3571c46f" "cda0b959f053abc04ab0a1b9919a505b8c9304e2898a291f527a370cb0e00731"
ghcup_013_64_darwin10_13 :: DownloadInfo ghcup_014_64_darwin10_13 :: DownloadInfo
ghcup_013_64_darwin10_13 = DownloadInfo ghcup_014_64_darwin10_13 = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3|] [uri|https://downloads.haskell.org/~ghcup/0.1.4/x86_64-apple-darwin-ghcup-0.1.4|]
Nothing Nothing
"a617b06619ec6e75d50dac53f36814c3cafd4dbeebe8cea46d9cd5842c0c94a9" "2422b79933ae037237ccb8f836417b90b3111d7931beb7ae8b9e33a1945c641e"
@@ -1026,7 +1062,10 @@ 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|])
@@ -1069,7 +1108,10 @@ 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|])
@@ -1112,7 +1154,10 @@ 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|])
@@ -1161,7 +1206,10 @@ 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|])
@@ -1197,7 +1245,10 @@ 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|])
@@ -1244,7 +1295,10 @@ 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|])
@@ -1290,7 +1344,10 @@ 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|])
@@ -1341,7 +1398,10 @@ 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|])
@@ -1388,7 +1448,10 @@ 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|])
@@ -1429,7 +1492,10 @@ 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|])
@@ -1480,7 +1546,10 @@ 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|])
@@ -1526,7 +1595,10 @@ 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|])
@@ -1576,7 +1648,10 @@ 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|])
@@ -1626,7 +1701,10 @@ 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|])
@@ -1676,7 +1754,10 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.8.3|] , ( [vver|8.8.3|]
, VersionInfo , VersionInfo
[Recommended] [Recommended, Base [pver|4.13.0.0|]]
(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|])
@@ -1726,7 +1807,10 @@ ghcupDownloads = M.fromList
) )
, ( [vver|8.10.1|] , ( [vver|8.10.1|]
, VersionInfo , VersionInfo
[Latest] [Latest, Base [pver|4.14.0.0|]]
(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|])
@@ -1796,6 +1880,9 @@ 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|])
@@ -1824,6 +1911,9 @@ 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|])
@@ -1835,7 +1925,9 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux [ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3000_64_linux)] , M.fromList [(Nothing, cabal_3000_64_linux)]
) )
, (Darwin, M.fromList [(Nothing, cabal_3000_64_darwin)]) , (Linux Alpine, M.fromList [(Nothing, cabal_3000_64_alpine)])
, (Darwin , M.fromList [(Nothing, cabal_3000_64_darwin)])
, (FreeBSD, M.fromList [(Nothing, cabal_3000_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32
@@ -1843,6 +1935,7 @@ 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)])
] ]
) )
] ]
@@ -1850,6 +1943,9 @@ 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|])
@@ -1861,7 +1957,9 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux [ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3200_64_linux)] , M.fromList [(Nothing, cabal_3200_64_linux)]
) )
, (Darwin, M.fromList [(Nothing, cabal_3200_64_darwin)]) , (Linux Alpine, M.fromList [(Nothing, cabal_3200_64_alpine)])
, (Darwin , M.fromList [(Nothing, cabal_3200_64_darwin)])
, (FreeBSD, M.fromList [(Nothing, cabal_3200_64_freebsd)])
] ]
) )
, ( A_32 , ( A_32
@@ -1869,6 +1967,7 @@ 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)])
] ]
) )
] ]
@@ -1877,20 +1976,31 @@ ghcupDownloads = M.fromList
) )
, ( GHCup , ( GHCup
, M.fromList , M.fromList
[ ( [vver|0.1.3|] [ ( [vver|0.1.4|]
, VersionInfo [Recommended, Latest] Nothing $ M.fromList , VersionInfo
[ ( A_64 [Recommended, Latest]
, M.fromList (Just
[ (Linux UnknownLinux, M.fromList [(Nothing, ghcup_013_64_linux)]) [uri|https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md|]
, (Darwin, M.fromList [(Nothing, ghcup_013_64_darwin10_13)]) )
, (FreeBSD, M.fromList [(Nothing, ghcup_013_64_freebsd)]) Nothing
$ 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 GHCupInfo where module GHCup.Data.GHCupInfo where
import GHCupDownloads import GHCup.Data.GHCupDownloads
import ToolRequirements import GHCup.Data.ToolRequirements
import GHCup.Types import GHCup.Types

View File

@@ -1,10 +1,11 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module ToolRequirements where module GHCup.Data.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
@@ -61,6 +62,35 @@ 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

@@ -11,7 +11,7 @@
module GHCup.Download where module GHCup.Download where
#if !defined(CURL) #if defined(INTERNAL_DOWNLOADER)
import GHCup.Download.IOStreams import GHCup.Download.IOStreams
import GHCup.Download.Utils import GHCup.Download.Utils
#endif #endif
@@ -35,18 +35,19 @@ 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(CURL)
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( CI )
#endif #endif
import Data.Maybe 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(CURL) #if defined(INTERNAL_DOWNLOADER)
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
@@ -57,12 +58,14 @@ 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(CURL) #if defined(INTERNAL_DOWNLOADER)
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
@@ -82,6 +85,48 @@ 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
@@ -91,6 +136,7 @@ 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
@@ -116,7 +162,12 @@ 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, MonadIO m1, MonadFail m1, MonadLogger m1) . ( MonadCatch m1
, MonadIO m1
, MonadFail m1
, MonadLogger m1
, MonadReader Settings m1
)
=> URI => URI
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
@@ -148,31 +199,38 @@ 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 do then dlWithMod modTime json_file
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|]
liftIO $ deleteFile json_file dlWithoutMod 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 -> do Just modTime -> dlWithMod modTime json_file
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|]
liftE $ downloadBS uri' dlWithoutMod json_file
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(CURL) #if !defined(INTERNAL_DOWNLOADER)
pure Nothing pure Nothing
#else #else
headers <- headers <-
@@ -192,7 +250,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 . E.decodeUtf8 $ h) (T.unpack . decUTF8Safe $ h)
#endif #endif
@@ -256,7 +314,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' = E.decodeUtf8 (serializeURIRef' (view dlUri dli)) let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli))
lift $ $(logInfo) [i|downloading: #{uri'}|] lift $ $(logInfo) [i|downloading: #{uri'}|]
-- destination dir must exist -- destination dir must exist
@@ -271,12 +329,19 @@ download dli dest mfn
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile) (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
>> (throwE . DownloadFailed $ e) >> (throwE . DownloadFailed $ e)
) $ do ) $ do
#if defined(CURL) lift getDownloader >>= \case
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True Curl -> do
["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing o' <- liftIO getCurlOpts
#else liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli) (o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing
liftE $ downloadToFile https host fullPath port destFile Wget -> do
o' <- liftIO getWgetOpts
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" True
(o' ++ ["-O", toFilePath destFile , serializeURIRef' $ view dlUri dli]) Nothing Nothing
#if defined(INTERNAL_DOWNLOADER)
Internal -> do
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
liftE $ downloadToFile https host fullPath port destFile
#endif #endif
liftE $ checkDigest dli destFile liftE $ checkDigest dli destFile
@@ -329,7 +394,7 @@ downloadCached dli mfn = do
-- | This is used for downloading the JSON. -- | This is used for downloading the JSON.
downloadBS :: (MonadCatch m, MonadIO m) downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
=> URI => URI
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
@@ -356,32 +421,63 @@ downloadBS uri'
where where
scheme = view (uriSchemeL' % schemeBSL') uri' scheme = view (uriSchemeL' % schemeBSL') uri'
path = view pathL' uri' path = view pathL' uri'
#if defined(CURL) #if defined(INTERNAL_DOWNLOADER)
dl _ = do
let exe = [rel|curl|]
args = ["-sSfL", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
#else
dl https = do dl https = do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri' #else
liftE $ downloadBS' https host' fullPath' port' dl _ = do
#endif
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
lift getDownloader >>= \case
Curl -> do
o' <- liftIO getCurlOpts
let exe = [rel|curl|]
args = o' ++ ["-sSfL", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
Wget -> do
o' <- liftIO getWgetOpts
let exe = [rel|wget|]
args = o' ++ ["-qO-", serializeURIRef' uri']
liftIO (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure $ L.fromStrict stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
#if defined(INTERNAL_DOWNLOADER)
Internal -> do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
liftE $ downloadBS' https host' fullPath' port'
#endif #endif
checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m) checkDigest :: (MonadIO m, MonadThrow 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
let p' = toFilePath file p' <- toFilePath <$> basename file
lift $ $(logInfo) [i|verifying digest of: #{p'}|] lift $ $(logInfo) [i|verifying digest of: #{p'}|]
c <- liftIO $ readFile file c <- liftIO $ readFile file
let cDigest = E.decodeUtf8 . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
eDigest = view dlHash dli let 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,7 +47,6 @@ 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
@@ -146,7 +145,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 $ E.decodeUtf8 x' of Just x' -> case decimal $ decUTF8Safe x' of
Left _ -> 0 Left _ -> 0
Right (r', _) -> r' Right (r', _) -> r'
Nothing -> 0 Nothing -> 0

View File

@@ -64,7 +64,7 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
-- | The tool is not installed. Some operations rely on a tool -- | The tool is not installed. Some operations rely on a tool
-- to be installed (such as setting the current GHC version). -- to be installed (such as setting the current GHC version).
data NotInstalled = NotInstalled Tool Version data NotInstalled = NotInstalled Tool Text
deriving Show deriving Show
-- | An executable was expected to be in PATH, but was not found. -- | An executable was expected to be in PATH, but was not found.
@@ -104,6 +104,9 @@ data PatchFailed = PatchFailed
data NoToolRequirements = NoToolRequirements data NoToolRequirements = NoToolRequirements
deriving Show deriving Show
data InvalidBuildConfig = InvalidBuildConfig Text
deriving Show
------------------------- -------------------------
--[ High-level errors ]-- --[ High-level errors ]--

View File

@@ -39,7 +39,6 @@ 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 ]--
@@ -84,13 +83,13 @@ getPlatform = do
( either (const Nothing) Just ( either (const Nothing) Just
. versioning . versioning
. getMajorVersion . getMajorVersion
. E.decodeUtf8 . decUTF8Safe
) )
<$> 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 . E.decodeUtf8) (either (const Nothing) Just . versioning . decUTF8Safe)
<$> getFreeBSDVersion <$> getFreeBSDVersion
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
what -> throwE $ NoCompatiblePlatform what what -> throwE $ NoCompatiblePlatform what
@@ -159,7 +158,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 (E.decodeUtf8 name, Just $ E.decodeUtf8 ver) pure (decUTF8Safe name, Just $ decUTF8Safe ver)
try_lsb_release :: IO (Text, Maybe Text) try_lsb_release :: IO (Text, Maybe Text)
try_lsb_release = do try_lsb_release = do
@@ -169,7 +168,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 lBS2sT $ readFile redhat_release t <- fmap decUTF8Safe' $ readFile redhat_release
let nameRegex n = let nameRegex n =
makeRegexOpts compIgnoreCase makeRegexOpts compIgnoreCase
execBlank execBlank
@@ -192,4 +191,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 $ lBS2sT ver) pure (T.pack "debian", Just . decUTF8Safe' $ ver)

View File

@@ -1,4 +1,6 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Types where module GHCup.Types where
@@ -70,9 +72,10 @@ 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
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball , _viChangeLog :: Maybe URI
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
} }
deriving (Eq, Show) deriving (Eq, Show)
@@ -80,7 +83,9 @@ 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
deriving (Ord, Eq, Show) | Base PVP
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, Show) -- FIXME: manual JSON instance
data Architecture = A_64 data Architecture = A_64
@@ -137,12 +142,26 @@ 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
@@ -172,3 +191,23 @@ data PlatformRequest = PlatformRequest
, _rVersion :: Maybe Versioning , _rVersion :: Maybe Versioning
} }
deriving (Eq, Show) deriving (Eq, Show)
-- | A GHC identified by the target platform triple
-- and the version.
data GHCTargetVersion = GHCTargetVersion
{ _tvTarget :: Maybe Text
, _tvVersion :: Version
}
deriving (Ord, Eq, Show)
mkTVer :: Version -> GHCTargetVersion
mkTVer = GHCTargetVersion Nothing
-- | Assembles a path of the form: <target-triple>-<version>
prettyTVer :: GHCTargetVersion -> Text
prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
prettyTVer (GHCTargetVersion Nothing v') = prettyVer v'

View File

@@ -37,14 +37,27 @@ 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 . decodeUtf8 . serializeURIRef' toJSON = toJSON . decUTF8Safe . serializeURIRef'
instance FromJSON URI where instance FromJSON URI where
parseJSON = withText "URL" $ \t -> parseJSON = withText "URL" $ \t ->
@@ -143,6 +156,14 @@ 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
@@ -151,7 +172,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 . E.decodeUtf8 $ fp True -> toJSON . decUTF8Safe $ fp
False -> String "/not/a/valid/path" False -> String "/not/a/valid/path"
where fp = toFilePath p where fp = toFilePath p

View File

@@ -19,6 +19,8 @@ makeLenses ''DownloadInfo
makeLenses ''Tag makeLenses ''Tag
makeLenses ''VersionInfo makeLenses ''VersionInfo
makeLenses ''GHCTargetVersion
makeLenses ''GHCupInfo makeLenses ''GHCupInfo
uriSchemeL' :: Lens' (URIRef Absolute) Scheme uriSchemeL' :: Lens' (URIRef Absolute) Scheme

View File

@@ -4,6 +4,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils module GHCup.Utils
@@ -15,10 +16,13 @@ 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
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
@@ -28,11 +32,12 @@ import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Logger import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Data.Attoparsec.ByteString
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions import Data.Versions
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
@@ -50,6 +55,7 @@ import System.Posix.FilePath ( getSearchPath
, takeFileName , takeFileName
) )
import System.Posix.Files.ByteString ( readSymbolicLink ) import System.Posix.Files.ByteString ( readSymbolicLink )
import Text.Regex.Posix
import URI.ByteString import URI.ByteString
import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar as Tar
@@ -59,7 +65,7 @@ import qualified Codec.Compression.Lzma as Lzma
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
@@ -72,62 +78,69 @@ import qualified Data.Text.Encoding as E
-- | The symlink destination of a ghc tool. -- | The symlink destination of a ghc tool.
ghcLinkDestination :: ByteString -- ^ the tool, such as 'ghc', 'haddock' etc. ghcLinkDestination :: ByteString -- ^ the tool, such as 'ghc', 'haddock' etc.
-> Version -> GHCTargetVersion
-> ByteString -> ByteString
ghcLinkDestination tool ver = "../ghc/" <> verToBS ver <> "/bin/" <> tool ghcLinkDestination tool ver =
"../ghc/" <> E.encodeUtf8 (prettyTVer ver) <> "/bin/" <> tool
-- | Extract the version part of the result of `ghcLinkDestination`.
ghcLinkVersion :: MonadThrow m => ByteString -> m Version
ghcLinkVersion = either (throwM . ParseError) pure . parseOnly parser
where
parser = string "../ghc/" *> verParser <* string "/bin/ghc"
verParser = many1' (notWord8 _slash) >>= \t ->
case version $ E.decodeUtf8 $ B.pack t of
Left e -> fail $ show e
Right r -> pure r
-- e.g. ghc-8.6.5 -- e.g. ghc-8.6.5
rmMinorSymlinks :: (MonadIO m, MonadLogger m) => Version -> m () rmMinorSymlinks :: (MonadIO m, MonadLogger m) => GHCTargetVersion -> m ()
rmMinorSymlinks ver = do rmMinorSymlinks GHCTargetVersion {..} = do
bindir <- liftIO $ ghcupBinDir bindir <- liftIO $ ghcupBinDir
files <- liftIO $ getDirsFiles' bindir
let myfiles = files <- liftIO $ findFiles'
filter (\x -> ("-" <> verToBS ver) `B.isSuffixOf` toFilePath x) files bindir
forM_ myfiles $ \f -> do ( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk $ prettyVer _tvVersion)
*> (MP.chunk $ prettyVer _tvVersion)
*> MP.eof
)
forM_ files $ \f -> do
let fullF = (bindir </> f) let fullF = (bindir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|] $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- E.g. ghc, if this version is the set one.
-- This reads `ghcupGHCDir`. -- Removes the set ghc version for the given target, if any.
rmPlain :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) rmPlain :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version => Maybe Text -- ^ target
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmPlain ver = do rmPlain target = do
files <- liftE $ ghcToolFiles ver mtv <- ghcSet target
bindir <- liftIO $ ghcupBinDir forM_ mtv $ \tv -> do
forM_ files $ \f -> do files <- liftE $ ghcToolFiles tv
let fullF = (bindir </> f) bindir <- liftIO $ ghcupBinDir
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] forM_ files $ \f -> do
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF let fullF = (bindir </> f)
-- old ghcup lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
let hdc_file = (bindir </> [rel|haddock-ghc|]) liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
lift $ $(logDebug) [i|rm -f #{toFilePath hdc_file}|] -- old ghcup
liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file let hdc_file = (bindir </> [rel|haddock-ghc|])
lift $ $(logDebug) [i|rm -f #{toFilePath hdc_file}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file
-- e.g. ghc-8.6 -- e.g. ghc-8.6
rmMajorSymlinks :: (MonadLogger m, MonadIO m) => Version -> m () rmMajorSymlinks :: (MonadThrow m, MonadLogger m, MonadIO m)
rmMajorSymlinks ver = do => GHCTargetVersion
(mj, mi) <- liftIO $ getGHCMajor ver -> m ()
let v' = E.encodeUtf8 $ intToText mj <> "." <> intToText mi rmMajorSymlinks GHCTargetVersion {..} = do
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
bindir <- liftIO ghcupBinDir bindir <- liftIO ghcupBinDir
files <- liftIO $ getDirsFiles' bindir files <- liftIO $ findFiles'
let myfiles = filter (\x -> ("-" <> v') `B.isSuffixOf` toFilePath x) files bindir
forM_ myfiles $ \f -> do ( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk v')
*> MP.chunk v'
*> MP.eof
)
forM_ files $ \f -> do
let fullF = (bindir </> f) let fullF = (bindir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|] $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
@@ -140,33 +153,61 @@ rmMajorSymlinks ver = do
----------------------------------- -----------------------------------
toolAlreadyInstalled :: Tool -> Version -> IO Bool ghcInstalled :: GHCTargetVersion -> IO Bool
toolAlreadyInstalled tool ver = case tool of
GHC -> ghcInstalled ver
Cabal -> cabalInstalled ver
GHCup -> pure True
ghcInstalled :: Version -> IO Bool
ghcInstalled ver = do ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver ghcdir <- ghcupGHCDir ver
doesDirectoryExist ghcdir doesDirectoryExist ghcdir
ghcSrcInstalled :: Version -> IO Bool ghcSrcInstalled :: GHCTargetVersion -> IO Bool
ghcSrcInstalled ver = do ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver ghcdir <- ghcupGHCDir ver
doesFileExist (ghcdir </> ghcUpSrcBuiltFile) doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
ghcSet :: (MonadIO m, MonadThrow m) => m (Maybe Version) ghcSet :: (MonadThrow m, MonadIO m)
ghcSet = do => Maybe Text -- ^ the target of the GHC version, if any
ghcBin <- (</> [rel|ghc|]) <$> liftIO ghcupBinDir -- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersion)
ghcSet mtarget = do
ghc <- parseRel $ E.encodeUtf8 (maybe "ghc" (<> "-ghc") mtarget)
ghcBin <- (</> ghc) <$> liftIO ghcupBinDir
-- link destination is of the form ../ghc/<ver>/bin/ghc -- link destination is of the form ../ghc/<ver>/bin/ghc
-- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
link <- readSymbolicLink $ toFilePath ghcBin link <- readSymbolicLink $ toFilePath ghcBin
Just <$> ghcLinkVersion link Just <$> ghcLinkVersion link
where
ghcLinkVersion :: MonadThrow m => ByteString -> m GHCTargetVersion
ghcLinkVersion bs = do
t <- throwEither $ E.decodeUtf8' bs
throwEither $ MP.parse parser "" t
where
parser =
MP.chunk "../ghc/"
*> (do
r <- parseUntil1 (MP.chunk "/")
rest <- MP.getInput
MP.setInput r
x <- ghcTargetVerP
MP.setInput rest
pure x
)
<* MP.chunk "/"
<* MP.takeRest
<* MP.eof
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
-- If a dir cannot be parsed, returns left.
getInstalledGHCs :: MonadIO m => m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs = do
ghcdir <- liftIO $ ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir
forM fs $ \f -> case parseGHCupGHCDir f of
Right r -> pure $ Right r
Left _ -> pure $ Left f
cabalInstalled :: Version -> IO Bool cabalInstalled :: Version -> IO Bool
@@ -179,7 +220,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 (E.decodeUtf8 reportedVer) of case version $ decUTF8Safe reportedVer of
Left e -> throwM e Left e -> throwM e
Right r -> pure r Right r -> pure r
@@ -190,32 +231,49 @@ cabalSet = do
----------------------------------------- -----------------------------------------
-- | We assume GHC is in semver format. I hope it is. getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getGHCMajor :: MonadThrow m => Version -> m (Int, Int) getMajorMinorV Version {..} = case _vChunks of
getGHCMajor ver = do ([Digits x] : [Digits y] : _) -> pure (fromIntegral x, fromIntegral y)
SemVer {..} <- throwEither (semver $ prettyVer ver) _ -> throwM $ ParseError "Could not parse X.Y from version"
pure (fromIntegral _svMajor, fromIntegral _svMinor)
matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of
Just (x, y) -> x == major' && y == minor'
Nothing -> False
-- | Get the latest installed full GHC version that satisfies X.Y. -- | Get the latest installed full GHC version that satisfies X.Y.
-- This reads `ghcupGHCBaseDir`. -- This reads `ghcupGHCBaseDir`.
getGHCForMajor :: (MonadIO m, MonadThrow m) getGHCForMajor :: (MonadIO m, MonadThrow m)
=> Int -- ^ major version component => Int -- ^ major version component
-> Int -- ^ minor version component -> Int -- ^ minor version component
-> m (Maybe Version) -> Maybe Text -- ^ the target triple
getGHCForMajor major' minor' = do -> m (Maybe GHCTargetVersion)
p <- liftIO $ ghcupGHCBaseDir getGHCForMajor major' minor' mt = do
ghcs <- liftIO $ getDirsFiles' p ghcs <- rights <$> getInstalledGHCs
semvers <- forM ghcs $ throwEither . semver . E.decodeUtf8 . toFilePath
mapM (throwEither . version) pure
. fmap prettySemVer
. lastMay . lastMay
. sort . sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
. filter . filter
(\SemVer {..} -> (\GHCTargetVersion {..} ->
fromIntegral _svMajor == major' && fromIntegral _svMinor == minor' _tvTarget == mt && matchMajor _tvVersion major' minor'
) )
$ semvers $ ghcs
-- | 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 -> matchMajor v major' minor'))
. preview (ix GHC % to Map.keys)
$ dls
@@ -232,8 +290,9 @@ 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
let fp = E.decodeUtf8 (toFilePath av) fp <- (decUTF8Safe . toFilePath) <$> basename av
lift $ $(logInfo) [i|Unpacking: #{fp}|] let dfp = decUTF8Safe . toFilePath $ dest
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
@@ -258,21 +317,27 @@ unpackToDir dest av = do
------------ ------------
-- | Get the tool versions that have this tag. -- | Get the tool version that has this tag. If multiple have it,
getTagged :: GHCupDownloads -> Tool -> Tag -> [Version] -- picks the greatest version.
getTagged av tool tag = toListOf getTagged :: Tag
( ix tool -> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo)
% to (Map.filter (\VersionInfo {..} -> elem tag _viTags)) getTagged tag =
% to Map.keys ( to (Map.filter (\VersionInfo {..} -> elem tag _viTags))
% folded % to Map.toDescList
% _head
) )
av
getLatest :: GHCupDownloads -> Tool -> Maybe Version getLatest :: GHCupDownloads -> Tool -> Maybe Version
getLatest av tool = headOf folded $ getTagged av tool Latest getLatest av tool = headOf (ix tool % getTagged Latest % to fst) $ av
getRecommended :: GHCupDownloads -> Tool -> Maybe Version getRecommended :: GHCupDownloads -> Tool -> Maybe Version
getRecommended av tool = headOf folded $ getTagged av tool Recommended getRecommended av tool = headOf (ix tool % getTagged Recommended % to fst) $ av
-- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe Version
getLatestBaseVersion av pvpVer =
headOf (ix GHC % getTagged (Base pvpVer) % to fst) av
@@ -285,6 +350,10 @@ getCache :: MonadReader Settings m => m Bool
getCache = ask <&> cache getCache = ask <&> cache
getDownloader :: MonadReader Settings m => m Downloader
getDownloader = ask <&> downloader
------------- -------------
--[ Other ]-- --[ Other ]--
@@ -298,12 +367,12 @@ urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
-- Get tool files from '~/.ghcup/bin/ghc/<ver>/bin/*' -- Get tool files from '~/.ghcup/bin/ghc/<ver>/bin/*'
-- while ignoring *-<ver> symlinks. -- while ignoring *-<ver> symlinks and accounting for cross triple prefix.
-- --
-- Returns unversioned relative files, e.g.: -- Returns unversioned relative files, e.g.:
-- ["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"] -- ["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]
ghcToolFiles :: (MonadThrow m, MonadFail m, MonadIO m) ghcToolFiles :: (MonadThrow m, MonadFail m, MonadIO m)
=> Version => GHCTargetVersion
-> Excepts '[NotInstalled] m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles ver = do ghcToolFiles ver = do
ghcdir <- liftIO $ ghcupGHCDir ver ghcdir <- liftIO $ ghcupGHCDir ver
@@ -311,18 +380,28 @@ ghcToolFiles ver = do
-- fail if ghc is not installed -- fail if ghc is not installed
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
(throwE (NotInstalled GHC ver)) (throwE (NotInstalled GHC (prettyTVer ver)))
files <- liftIO $ getDirsFiles' bindir files <- liftIO $ getDirsFiles' bindir
-- figure out the <ver> suffix, because this might not be `Version` for -- figure out the <ver> suffix, because this might not be `Version` for
-- alpha/rc releases, but x.y.a.somedate. -- alpha/rc releases, but x.y.a.somedate.
-- for cross, this won't be "ghc", but e.g.
-- "armv7-unknown-linux-gnueabihf-ghc"
[ghcbin] <- liftIO $ findFiles
bindir
(makeRegexOpts compExtended
execBlank
([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString)
)
(Just symver) <- (Just symver) <-
(B.stripPrefix "ghc-" . takeFileName) (B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName)
<$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> [rel|ghc|])) <$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> ghcbin))
when (B.null symver) when (B.null symver)
(throwIO $ userError $ "Fatal: ghc symlink target is broken") (throwIO $ userError $ "Fatal: ghc symlink target is broken")
pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) files pure . filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) $ files
-- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that -- | This file, when residing in ~/.ghcup/ghc/<ver>/ signals that
@@ -368,3 +447,47 @@ 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

@@ -1,10 +1,13 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils.Dirs where module GHCup.Utils.Dirs where
import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.Applicative import Control.Applicative
@@ -13,7 +16,6 @@ import Control.Monad
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Maybe import Data.Maybe
import Data.Versions
import HPath import HPath
import HPath.IO import HPath.IO
import Optics import Optics
@@ -27,8 +29,10 @@ import System.Posix.Env.ByteString ( getEnv
import System.Posix.Temp.ByteString ( mkdtemp ) import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Text.Encoding as E
import qualified System.Posix.FilePath as FP import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU import qualified System.Posix.User as PU
import qualified Text.Megaparsec as MP
@@ -37,6 +41,7 @@ import qualified System.Posix.User as PU
------------------------- -------------------------
-- | ~/.ghcup by default
ghcupBaseDir :: IO (Path Abs) ghcupBaseDir :: IO (Path Abs)
ghcupBaseDir = do ghcupBaseDir = do
bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
@@ -44,16 +49,30 @@ ghcupBaseDir = do
Nothing -> liftIO getHomeDirectory Nothing -> liftIO getHomeDirectory
pure (bdir </> [rel|.ghcup|]) pure (bdir </> [rel|.ghcup|])
-- | ~/.ghcup/ghc by default.
ghcupGHCBaseDir :: IO (Path Abs) ghcupGHCBaseDir :: IO (Path Abs)
ghcupGHCBaseDir = ghcupBaseDir <&> (</> [rel|ghc|]) ghcupGHCBaseDir = ghcupBaseDir <&> (</> [rel|ghc|])
ghcupGHCDir :: Version -> IO (Path Abs)
-- | Gets '~/.ghcup/ghc/<ghcupGHCDir>'.
-- The dir may be of the form
-- * armv7-unknown-linux-gnueabihf-8.8.3
-- * 8.8.4
ghcupGHCDir :: GHCTargetVersion -> IO (Path Abs)
ghcupGHCDir ver = do ghcupGHCDir ver = do
ghcbasedir <- ghcupGHCBaseDir ghcbasedir <- ghcupGHCBaseDir
verdir <- parseRel (verToBS ver) verdir <- parseRel $ E.encodeUtf8 (prettyTVer ver)
pure (ghcbasedir </> verdir) pure (ghcbasedir </> verdir)
-- | See 'ghcupToolParser'.
parseGHCupGHCDir :: MonadThrow m => Path Rel -> m GHCTargetVersion
parseGHCupGHCDir (toFilePath -> f) = do
fp <- throwEither $ E.decodeUtf8' f
throwEither $ MP.parse ghcTargetVerP "" fp
ghcupBinDir :: IO (Path Abs) ghcupBinDir :: IO (Path Abs)
ghcupBinDir = ghcupBaseDir <&> (</> [rel|bin|]) ghcupBinDir = ghcupBaseDir <&> (</> [rel|bin|])

View File

@@ -18,6 +18,8 @@ import Data.Foldable
import Data.Functor import Data.Functor
import Data.IORef import Data.IORef
import Data.Maybe import Data.Maybe
import Data.Text ( Text )
import Data.Void
import GHC.Foreign ( peekCStringLen ) import GHC.Foreign ( peekCStringLen )
import GHC.IO.Encoding ( getLocaleEncoding ) import GHC.IO.Encoding ( getLocaleEncoding )
import GHC.IO.Exception import GHC.IO.Exception
@@ -39,12 +41,12 @@ import "unix" System.Posix.IO.ByteString
hiding ( openFd ) hiding ( openFd )
import System.Posix.Process ( ProcessStatus(..) ) import System.Posix.Process ( ProcessStatus(..) )
import System.Posix.Types import System.Posix.Types
import Text.Regex.Posix
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 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
@@ -53,12 +55,14 @@ import qualified Streamly.Internal.Memory.ArrayStream
import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.FileSystem.Handle as FH
import qualified Streamly.Internal.Data.Unfold as SU import qualified Streamly.Internal.Data.Unfold as SU
import qualified Streamly.Prelude as S import qualified Streamly.Prelude as S
import qualified Text.Megaparsec as MP
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 "unix-bytestring" System.Posix.IO.ByteString import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB as SPIB
-- | Bool signals whether the regions should be cleaned. -- | Bool signals whether the regions should be cleaned.
data StopThread = StopThread Bool data StopThread = StopThread Bool
deriving Show deriving Show
@@ -201,6 +205,7 @@ 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
@@ -208,12 +213,10 @@ execLogged exe spath args lfile chdir env = do
. T.pack . T.pack
. color Blue . color Blue
. T.unpack . T.unpack
. E.decodeUtf8With E.lenientDecode . decUTF8Safe
. 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]
@@ -371,8 +374,7 @@ searchPath paths needle = go paths
where where
go [] = pure Nothing go [] = pure Nothing
go (x : xs) = go (x : xs) =
hideErrorDefM PermissionDenied (go xs) hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (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)
@@ -383,3 +385,27 @@ searchPath paths needle = go paths
if p == toFilePath needle if p == toFilePath needle
then isExecutable (basedir </> needle) then isExecutable (basedir </> needle)
else pure False else pure False
findFiles :: Path Abs -> Regex -> IO [Path Rel]
findFiles path regex = do
dirStream <- openDirStream (toFilePath path)
f <-
(fmap . fmap) snd
. S.toList
. S.filter (\(_, p) -> match regex p)
$ dirContentsStream dirStream
pure $ join $ fmap parseRel f
findFiles' :: Path Abs -> MP.Parsec Void Text () -> IO [Path Rel]
findFiles' path parser = do
dirStream <- openDirStream (toFilePath path)
f <-
(fmap . fmap) snd
. S.toList
. S.filter (\(_, p) -> case E.decodeUtf8' p of
Left _ -> False
Right p' -> isJust $ MP.parseMaybe parser p')
$ dirContentsStream dirStream
pure $ join $ fmap parseRel f

View File

@@ -0,0 +1,87 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.MegaParsec where
import GHCup.Types
import Control.Applicative
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Data.Functor
import Data.Maybe
import Data.Text ( Text )
import Data.Versions
import Data.Void
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
choice' [] = fail "Empty list"
choice' [x ] = x
choice' (x : xs) = MP.try x <|> choice' xs
parseUntil :: MP.Parsec Void Text a -> MP.Parsec Void Text Text
parseUntil p = do
(MP.try (MP.lookAhead p) $> mempty)
<|> (do
c <- T.singleton <$> MP.anySingle
c2 <- parseUntil p
pure (c `mappend` c2)
)
parseUntil1 :: MP.Parsec Void Text a -> MP.Parsec Void Text Text
parseUntil1 p = do
i1 <- MP.getOffset
t <- parseUntil p
i2 <- MP.getOffset
if i1 == i2 then fail "empty parse" else pure t
-- | Parses e.g.
-- * armv7-unknown-linux-gnueabihf-ghc
-- * armv7-unknown-linux-gnueabihf-ghci
ghcTargetBinP :: Text -> MP.Parsec Void Text (Maybe Text, Text)
ghcTargetBinP t =
(,)
<$> ( MP.try
(Just <$> (parseUntil1 (MP.chunk "-" *> MP.chunk t)) <* MP.chunk "-"
)
<|> (flip const Nothing <$> mempty)
)
<*> (MP.chunk t <* MP.eof)
-- | Extracts target triple and version from e.g.
-- * armv7-unknown-linux-gnueabihf-8.8.3
-- * armv7-unknown-linux-gnueabihf-8.8.3
ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion
ghcTargetVerP =
(\x y -> GHCTargetVersion x y)
<$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP)) <* MP.chunk "-")
<|> (flip const Nothing <$> mempty)
)
<*> (version' <* MP.eof)
where
verP :: MP.Parsec Void Text Text
verP = do
v <- version'
let startsWithDigists =
and
. take 3
. join
. (fmap . fmap)
(\case
(Digits _) -> True
(Str _) -> False
)
$ (_vChunks v)
if startsWithDigists && not (isJust (_vEpoch v))
then pure $ prettyVer v
else fail "Oh"

View File

@@ -29,6 +29,7 @@ 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
@@ -87,10 +88,6 @@ 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
@@ -168,14 +165,14 @@ liftIOException errType ex =
. lift . lift
hideErrorDef :: IOErrorType -> a -> IO a -> IO a hideErrorDef :: [IOErrorType] -> a -> IO a -> IO a
hideErrorDef err def = hideErrorDef errs def =
handleIO (\e -> if err == ioeGetErrorType e then pure def else ioError e) handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e)
hideErrorDefM :: IOErrorType -> IO a -> IO a -> IO a hideErrorDefM :: [IOErrorType] -> IO a -> IO a -> IO a
hideErrorDefM err def = hideErrorDefM errs def =
handleIO (\e -> if err == ioeGetErrorType e then def else ioError e) handleIO (\e -> if ioeGetErrorType e `elem` errs then def else ioError e)
-- TODO: does this work? -- TODO: does this work?
@@ -221,6 +218,12 @@ throwEither a = case a of
Right r -> pure r Right r -> pure r
throwEither' :: (Exception a, MonadThrow m) => a -> Either x b -> m b
throwEither' e eth = case eth of
Left _ -> throwM e
Right r -> pure r
verToBS :: Version -> ByteString verToBS :: Version -> ByteString
verToBS = E.encodeUtf8 . prettyVer verToBS = E.encodeUtf8 . prettyVer
@@ -243,4 +246,16 @@ addToCurrentEnv adds = do
pvpToVersion :: PVP -> Version pvpToVersion :: PVP -> Version
pvpToVersion = either (\_ -> error "Couldn't convert PVP to Version") id . version . prettyPVP pvpToVersion =
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,9 +9,14 @@ 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.1.json|] ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
ghcUpVer :: PVP ghcUpVer :: PVP
ghcUpVer = [pver|0.1.4|] ghcUpVer = [pver|0.1.5|]
numericVer :: String
numericVer = T.unpack . prettyPVP $ ghcUpVer

14
shell-completions/bash Normal file
View File

@@ -0,0 +1,14 @@
_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

19
shell-completions/fish Normal file
View File

@@ -0,0 +1,19 @@
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)'

32
shell-completions/zsh Normal file
View File

@@ -0,0 +1,32 @@
#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