Compare commits

...

67 Commits

Author SHA1 Message Date
1207c7b3dd Revert "Remove travis"
This reverts commit 5e35a91ef0.
2020-05-07 18:32:55 +02:00
788883df7b Fix CI 2020-05-07 00:42:52 +02:00
5ab1f6c203 Small improvements to bootstrap-haskell 2020-05-06 22:33:52 +02:00
175066780b Forget about .bash_profile
Previously we would prefer .bash_profile
if no .bashrc exists, but that seems a bit
far-fetched.

.bash_profile is for login shells, .bashrc
is sourced for interactive non-login shells,
but most .bash_profiles also explicitly source
.bashrc, so it's hard to go wrong with it.
2020-05-02 23:50:09 +02:00
a629cf7b9f Update gitignore 2020-05-01 16:28:51 +02:00
684130bfa3 Update bootstrap-haskell 2020-05-01 16:27:41 +02:00
ee34d85dbc Set TMPDIR during CI 2020-05-01 16:27:27 +02:00
d2b280da2d Update tarballs 2020-04-30 20:46:45 +02:00
a5593a725f Cleanup 2020-04-30 00:59:19 +02:00
5e35a91ef0 Remove travis 2020-04-30 00:43:44 +02:00
4abd10d9c9 Update RELEASING.md 2020-04-30 00:31:33 +02:00
0bbac877bd Update ghcup tarballs 2020-04-30 00:12:30 +02:00
f558bd9932 Fix CI failing on git-describe 2020-04-29 23:01:51 +02:00
781c28b03c Update RELEASING.md 2020-04-29 22:37:12 +02:00
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
879bd061dd Bump to 0.1.4 2020-04-16 09:04:19 +02:00
75632b2cf1 Fix ghc being unlinked after installing a new one
Fixes #7
2020-04-16 08:39:36 +02:00
b65b9dc5e1 Test that setting ghc versions isn't broken
Wrt #7
2020-04-16 08:39:29 +02:00
44 changed files with 2253 additions and 797 deletions

2
.gitignore vendored
View File

@@ -1,2 +1,4 @@
dist-newstyle/
cabal.project.local
.stack-work/
bin/

View File

@@ -12,16 +12,52 @@ variables:
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
tags:
- 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:
tags:
- 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:
script:
- ./.gitlab/script/ghcup_version.sh
variables:
JSON_VERSION: "0.0.1"
JSON_VERSION: "0.0.2"
.test_ghcup_version:linux:
extends:
@@ -29,50 +65,133 @@ variables:
- .debian
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
variables:
OS: "LINUX"
.test_ghcup_version:darwin:
extends:
- .test_ghcup_version
- .darwin
- .root_cleanup
before_script:
- ./.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:
extends: .test_ghcup_version:linux
variables:
GHC_VERSION: "recommended"
GHC_VERSION: "8.6.5"
CABAL_VERSION: "3.2.0.0"
test:linux:latest:
extends: .test_ghcup_version:linux
variables:
GHC_VERSION: "latest"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
######## darwin ########
######## darwin test ########
test:mac:recommended:
extends: .test_ghcup_version:darwin
variables:
GHC_VERSION: "recommended"
GHC_VERSION: "8.6.5"
CABAL_VERSION: "3.2.0.0"
test:mac:latest:
extends: .test_ghcup_version:darwin
variables:
GHC_VERSION: "latest"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
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,13 @@ set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
curl -sSfL https://gitlab.haskell.org/haskell/ghcup/-/raw/master/ghcup > ./ghcup-legacy
chmod +x ghcup-legacy
mkdir -p "${TMPDIR}"
./ghcup-legacy install ${GHC_VERSION}
./ghcup-legacy set ${GHC_VERSION}
./ghcup-legacy install-cabal
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin
chmod +x ghcup-bin
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
exit 0

View File

@@ -0,0 +1,25 @@
#!/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"
mkdir -p "${TMPDIR}"
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,63 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../../ghcup_env"
mkdir -p "${TMPDIR}"
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

@@ -2,15 +2,17 @@
set -eux
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
curl -sSfL https://gitlab.haskell.org/haskell/ghcup/-/raw/master/ghcup > ./ghcup-legacy
chmod +x ghcup-legacy
mkdir -p "${TMPDIR}"
./ghcup-legacy install ${GHC_VERSION}
./ghcup-legacy set ${GHC_VERSION}
./ghcup-legacy install-cabal
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
chmod +x ghcup-bin
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}

View File

@@ -1,3 +1,3 @@
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export PATH="$CI_PROJECT_DIR/.ghcup/bin:$CI_PROJECT_DIR/.local/bin:$PATH"
export TMPDIR="$CI_PROJECT_DIR/tmp"

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 "$@"
}
# build
git describe --always
### build
ecabal update
if [ "${OS}" = "DARWIN" ] ; then
ecabal build -fcurl
ecabal build -w ghc-${GHC_VERSION}
else
ecabal build
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
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-gen')" .
# testing
cp ./ghcup "$CI_PROJECT_DIR"/.local/bin/ghcup
cp ./ghcup-gen "$CI_PROJECT_DIR"/.local/bin/ghcup-gen
### cleanup
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
### manual cli based testing
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 set ${GHC_VERSION}
eghcup install-cabal
eghcup install-cabal ${CABAL_VERSION}
cabal --version
@@ -49,11 +62,29 @@ eghcup list
eghcup list -t ghc
eghcup list -t cabal
ghc_ver=$(ghc --numeric-version)
ghc --version
ghci --version
ghc-$(ghc --numeric-version) --version
ghci-$(ghc --numeric-version) --version
# test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "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}" ]
eghcup set 8.4.4
eghcup set 8.4.4
[ "$(ghc --numeric-version)" = "8.4.4" ]
eghcup set ${GHC_VERSION}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup rm 8.4.4
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup rm $(ghc --numeric-version)
eghcup upgrade

View File

@@ -18,5 +18,5 @@ ghcup set 8.8.3
## install ghcup
cabal update
cabal build -fcurl
cabal build
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" "./${ARTIFACT}"

View File

@@ -1,5 +1,26 @@
# Revision history for ghcup
## 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
* Fix unlinking of ghc symlinks after new installation, wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
## 0.1.3 -- 2020-04-15
* Fix lesser bug when skipping ghcup update

View File

@@ -1,42 +0,0 @@
FROM alpine:edge
# ghc and cabal
RUN apk add --no-cache \
curl \
gcc \
g++ \
gmp-dev \
ncurses-dev \
libffi-dev \
make \
xz \
tar \
perl \
\
cabal \
ghc
# utils
RUN apk add --no-cache \
bash
## Package specific
RUN apk add --no-cache \
zlib \
zlib-dev \
zlib-static \
gmp \
gmp-dev \
openssl-dev \
openssl-libs-static \
xz \
xz-dev
RUN cabal v2-update
COPY . /app
WORKDIR /app
RUN chmod +x /app/docker/build.sh

View File

@@ -43,3 +43,22 @@ Kazu Yamamoto [explained it in his PR](https://github.com/yesodweb/wai/pull/752#
1. Brittany
2. mtl-style preferred
3. no overly pointfree style
## Code structure
Main functionality is in `GHCup` module. Utility functions are
organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
Anything dealing with ghcup specific directories is in
`GHCup.Utils.Dirs`.
Download information on where to fetch bindists from is in
`GHCup.Data.GHCupDownloads`.
## 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)
* [Usage](#usage)
* [Manpages](#manpages)
* [Shell-completion](#shell-completion)
* [Cross support](#cross-support)
* [Design goals](#design-goals)
* [How](#how)
* [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.
`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
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).
3. Why the haskell reimplementation?
Why not?

View File

@@ -2,10 +2,18 @@
1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the JSON representation of it. The version of the json represents the change increments. `ghcUpVer` is the current application version.
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. Update version in ghcup.cabal
3. Commit and git push with tag. Wait for tests to succeed.
3. Add ChangeLog entry
4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
4. Add/fix downloads to `GHCupDownloads` module, then run `ghcup-gen gen` to generate the new json and validate it via `ghcup-gen check`.
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.
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
6. Download release artifacts and upload them `downloads.haskell.org/ghcup`
7. Add release artifacts to GHCupDownloads (see point 4.)
8. Upload the final `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup`

19
TODO.md
View File

@@ -2,27 +2,38 @@
## Now
* move out GHCup.Version module, bc it's not library-ish
* ghcup init?
* merge two download files
* fetch/unpack functionality
* installing multiple versions of the same
* post-install
* proper test suite
* !! update of 0.1.5 must go in ghcup-0.0.1.json !!
* try to run exe before upgrade (backup to ~/.ghcup/bin/ghcup.old)
* stdout flushing?
* resume support (for make-install only)
## Maybe
* maybe: changelog Show the changelog of a GHC release (online)
* version ranges in json
* sign the JSON? (Or check gpg keys?)
* testing (especially distro detection -> unit tests)
## Later
* i386 support
* add support for RC/alpha/HEAD versions
## Cleanups
* too many decodeutf8
* avoid alternative for IO
* use plucky or oops instead of Excepts
## Questions
* move out GHCup.Version module, bc it's not library-ish?
* mirror support
* interactive handling when distro doesn't exist and we know the tarball is incompatible?
* ghcup-with wrapper to execute a command with a given ghc in PATH?

View File

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

View File

@@ -27,9 +27,12 @@ import Haskus.Utils.Variant.Excepts
import Optics
import System.Exit
import System.IO
import Text.ParserCombinators.ReadP
import qualified Data.ByteString as B
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Version as V
data ValidationError = InternalError String
@@ -61,8 +64,9 @@ validate dls = do
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v arch (M.keys pspecs)
checkGHCisSemver
checkGHCVerIsValid
forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
_ <- checkGHCHasBaseVersion
-- exit
e <- liftIO $ readIORef ref
@@ -85,7 +89,7 @@ validate dls = do
[i|FreeBSD missing for #{t} #{v'} #{arch}|]
checkUniqueTags tool = do
let allTags = join $ fmap snd $ availableToolVersions dls tool
let allTags = join $ M.elems $ availableToolVersions dls tool
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)
@@ -105,26 +109,40 @@ validate dls = do
lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|]
addError
where
isUniqueTag Latest = True
isUniqueTag Recommended = True
isUniqueTag Latest = True
isUniqueTag Recommended = True
isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False
checkGHCisSemver = do
checkGHCVerIsValid = do
let ghcVers = toListOf (ix GHC % to M.keys % folded) dls
forM_ ghcVers $ \v -> case semver (prettyVer v) of
Left _ -> do
lift $ $(logError) [i|GHC version #{v} is not valid semver|]
addError
Right _ -> pure ()
forM_ ghcVers $ \v ->
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
[_] -> pure ()
_ -> do
lift $ $(logError) [i|GHC version #{v} is not valid |]
addError
-- a tool must have at least one of each mandatory tags
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
False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
addError
True -> pure ()
-- all GHC versions must have a base tag
checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, tags) -> case any isBase tags of
False -> do
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
addError
True -> pure ()
isBase (Base _) = True
isBase _ = False
validateTarballs :: ( Monad m
, MonadLogger m
@@ -161,7 +179,7 @@ validateTarballs dls = do
where
downloadAll dli = do
let settings = Settings True False
let settings = Settings True False Never Curl
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())

File diff suppressed because it is too large Load Diff

View File

@@ -26,15 +26,16 @@ eghcup() {
download_ghcup() {
_plat="$(uname -s)"
_arch=$(uname -m)
_ghver="0.1.5"
case "${_plat}" in
"linux"|"Linux")
case "${_arch}" in
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/${_ghver}/x86_64-linux-ghcup-${_ghver}
;;
i*86)
_url=https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3
_url=https://downloads.haskell.org/~ghcup/${_ghver}/i386-linux-ghcup-${_ghver}
;;
*) die "Unknown architecture: ${_arch}"
;;
@@ -50,7 +51,7 @@ download_ghcup() {
*) die "Unknown architecture: ${_arch}"
;;
esac
_url=https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3
_url=https://downloads.haskell.org/~ghcup/${_ghver}/x86_64-portbld-freebsd-ghcup-${_ghver}
;;
"Darwin"|"darwin")
case "${_arch}" in
@@ -62,30 +63,31 @@ download_ghcup() {
*) die "Unknown architecture: ${_arch}"
;;
esac
_url=https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3 ;;
_url=https://downloads.haskell.org/~ghcup/${_ghver}/x86_64-apple-darwin-ghcup-${_ghver} ;;
*) die "Unknown platform: ${_plat}"
;;
esac
edo curl -Lf "${_url}" > "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
unset _plat _arch _url
unset _plat _arch _url _ghver
}
echo
echo "Welcome to Haskell!"
echo
echo "This will download and install the Glasgow Haskell Compiler (GHC)"
echo "and the Cabal build tool."
echo "This script will download and install the following binaries:"
echo " * ghcup - The Haskell toolchain installer (for managing GHC/cabal versions)"
echo " * ghc - The Glasgow Haskell Compiler"
echo " * cabal - The Cabal build tool"
echo
echo "ghcup installs only into the following directory, which can be removed anytime:"
echo " $GHCUP_INSTALL_BASE_PREFIX/.ghcup"
echo
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed"
printf "\\033[0;35m%s\\033[0m\\n" "or ctrl-c to abort."
printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed or ctrl-c to abort."
printf "\\033[0;35m%s\\033[0m\\n" "Note that this script can be re-run at any given time."
echo
# Wait for user input to continue.
@@ -116,8 +118,7 @@ echo "$(ghcup tool-requirements)"
echo
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed"
printf "\\033[0;35m%s\\033[0m\\n" "or ctrl-c to abort."
printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed or ctrl-c to abort."
printf "\\033[0;35m%s\\033[0m\\n" "Installation may take a while."
echo
@@ -147,21 +148,11 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
GHCUP_PROFILE_FILE="$HOME/.zshrc"
MY_SHELL="zsh" ;;
*/bash) # login shell is bash
if [ -f "$HOME/.bashrc" ] ; then # bashrc is not sourced by default, so assume it isn't if file does not exist
GHCUP_PROFILE_FILE="$HOME/.bashrc"
else
GHCUP_PROFILE_FILE="$HOME/.bash_profile"
fi
GHCUP_PROFILE_FILE="$HOME/.bashrc"
MY_SHELL="bash" ;;
*/sh) # login shell is sh, but might be a symlink to bash or zsh
if [ -n "${BASH}" ] ; then
if [ -f "$HOME/.bashrc" ] ; then # bashrc is not sourced by default, so assume it isn't if file does not exist
GHCUP_PROFILE_FILE="$HOME/.bashrc"
else
GHCUP_PROFILE_FILE="$HOME/.bash_profile"
fi
GHCUP_PROFILE_FILE="$HOME/.bashrc"
MY_SHELL="bash"
elif [ -n "${ZSH_VERSION}" ] ; then
GHCUP_PROFILE_FILE="$HOME/.zshrc"

View File

@@ -1,14 +0,0 @@
#!/bin/sh
set -ex
cd /app
cabal v2-update
cabal v2-install \
--install-method=copy \
--overwrite-policy=always \
--installdir="/bin" \
--ghc-options='-optl-static'

View File

@@ -58,6 +58,35 @@
"distroPKGs": [],
"notes": "You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages."
}
},
"Linux_CentOS": {
"7": {
"distroPKGs": [
"gcc",
"gcc-c++",
"gmp",
"gmp-devel",
"make",
"ncurses",
"xz",
"perl"
],
"notes": ""
},
"unknown_versioning": {
"distroPKGs": [
"gcc",
"gcc-c++",
"gmp",
"gmp-devel",
"make",
"ncurses",
"ncurses-compat-libs",
"xz",
"perl"
],
"notes": ""
}
}
}
}
@@ -170,7 +199,10 @@
"dlSubdir": "ghc-8.6.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html",
"viTags": [
"base-4.12.0.0"
]
},
"8.0.2": {
"viArch": {
@@ -264,7 +296,10 @@
"dlSubdir": "ghc-8.0.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html",
"viTags": [
"base-4.9.1.0"
]
},
"8.6.4": {
"viArch": {
@@ -377,7 +412,10 @@
"dlSubdir": "ghc-8.6.4",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html",
"viTags": [
"base-4.12.0.0"
]
},
"8.4.1": {
"viArch": {
@@ -482,7 +520,10 @@
"dlSubdir": "ghc-8.4.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html",
"viTags": [
"base-4.11.0.0"
]
},
"8.6.3": {
"viArch": {
@@ -616,7 +657,10 @@
"dlSubdir": "ghc-8.6.3",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html",
"viTags": [
"base-4.12.0.0"
]
},
"8.10.1": {
"viArch": {
@@ -756,8 +800,10 @@
"dlSubdir": "ghc-8.10.1",
"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": [
"Latest"
"Latest",
"base-4.14.0.0"
]
},
"8.6.5": {
@@ -885,7 +931,10 @@
"dlSubdir": "ghc-8.6.5",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html",
"viTags": [
"base-4.12.0.0"
]
},
"8.4.2": {
"viArch": {
@@ -1005,7 +1054,10 @@
"dlSubdir": "ghc-8.4.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html",
"viTags": [
"base-4.11.1.0"
]
},
"8.8.1": {
"viArch": {
@@ -1132,7 +1184,10 @@
"dlSubdir": "ghc-8.8.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html",
"viTags": [
"base-4.13.0.0"
]
},
"8.4.3": {
"viArch": {
@@ -1245,7 +1300,10 @@
"dlSubdir": "ghc-8.4.3",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html",
"viTags": [
"base-4.11.1.0"
]
},
"8.6.1": {
"viArch": {
@@ -1365,7 +1423,10 @@
"dlSubdir": "ghc-8.6.1",
"dlUri": "https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html",
"viTags": [
"base-4.12.0.0"
]
},
"8.8.2": {
"viArch": {
@@ -1492,7 +1553,10 @@
"dlSubdir": "ghc-8.8.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html",
"viTags": [
"base-4.13.0.0"
]
},
"7.10.3": {
"viArch": {
@@ -1618,7 +1682,10 @@
"dlSubdir": "ghc-7.10.3",
"dlUri": "https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html",
"viTags": [
"base-4.8.2.0"
]
},
"8.2.2": {
"viArch": {
@@ -1722,7 +1789,10 @@
"dlSubdir": "ghc-8.2.2",
"dlUri": "https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html",
"viTags": [
"base-4.10.1.0"
]
},
"8.4.4": {
"viArch": {
@@ -1856,7 +1926,10 @@
"dlSubdir": "ghc-8.4.4",
"dlUri": "https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz"
},
"viTags": []
"viChangeLog": "https://downloads.haskell.org/~ghc/8.4.4/docs/html/users_guide/8.4.4-notes.html",
"viTags": [
"base-4.11.1.0"
]
},
"8.8.3": {
"viArch": {
@@ -1943,7 +2016,7 @@
"A_32": {
"Linux_Alpine": {
"unknown_versioning": {
"dlHash": "23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec",
"dlHash": "7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4",
"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"
}
@@ -1983,8 +2056,10 @@
"dlSubdir": "ghc-8.8.3",
"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": [
"Recommended"
"Recommended",
"base-4.13.0.0"
]
}
},
@@ -1992,11 +2067,25 @@
"3.0.0.0": {
"viArch": {
"A_64": {
"Linux_Alpine": {
"unknown_versioning": {
"dlHash": "2b7ea63601e11a0db2941b96e6a7036a48efc2a1ab3849d7dfce08b45f5daa58",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-alpine-linux-musl.tar.xz"
}
},
"FreeBSD": {
"unknown_versioning": {
"dlHash": "2240842ab2ae7b955feb8b526aba1c7991248c803383107adf39990441294d2a",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz"
}
},
"Darwin": {
"unknown_versioning": {
"dlHash": "d4857e068560515e4cbb0e8ca124c370e07892f2a28804d87152834e5fe2b845",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-apple-darwin17.7.0.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-apple-darwin17.7.0.tar.xz"
}
},
"Linux_UnknownLinux": {
@@ -2008,11 +2097,18 @@
}
},
"A_32": {
"Linux_Alpine": {
"unknown_versioning": {
"dlHash": "ac018f061993d40bf146517e32629bcab274b4d9f5527b1c37a665ebdf3f5ac6",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-alpine-linux-musl.tar.xz"
}
},
"Linux_UnknownLinux": {
"unknown_versioning": {
"dlHash": "6898ccd6e6dc0872999c06daaf61d546164e12f60a1880d09852c9f0c59c5cf6",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-unknown-linux.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-unknown-linux.tar.xz"
}
}
}
@@ -2022,16 +2118,31 @@
"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"
},
"viChangeLog": "https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog",
"viTags": []
},
"3.2.0.0": {
"viArch": {
"A_64": {
"Linux_Alpine": {
"unknown_versioning": {
"dlHash": "8bae37a1ce8b5f10440b5591fed734935e1411c1b765258325ffe268e2cc2042",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz"
}
},
"FreeBSD": {
"unknown_versioning": {
"dlHash": "f1e35151cca91541b0fb4bdb3ed18f3c348038eab751845ad19c11307d66c273",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz"
}
},
"Darwin": {
"unknown_versioning": {
"dlHash": "9197c17d2ece0f934f5b33e323cfcaf486e4681952687bc3d249488ce3cbe0e9",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-apple-darwin17.7.0.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-apple-darwin17.7.0.tar.xz"
}
},
"Linux_UnknownLinux": {
@@ -2043,11 +2154,18 @@
}
},
"A_32": {
"Linux_Alpine": {
"unknown_versioning": {
"dlHash": "c2a419dedf730987b60daf8d24e871d115a09ea608d740d7c61b36e3f5b9c830",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz"
}
},
"Linux_UnknownLinux": {
"unknown_versioning": {
"dlHash": "2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz"
}
}
}
@@ -2057,6 +2175,7 @@
"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"
},
"viChangeLog": "https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog",
"viTags": [
"Recommended",
"Latest"
@@ -2069,7 +2188,7 @@
"unknown_versioning": {
"dlHash": "720bef015f834a03deb7180be2952a44e7c2e6c8429137570404c3de4f46b984",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-alpine-linux-musl.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-alpine-linux-musl.tar.xz"
}
},
"FreeBSD": {
@@ -2083,14 +2202,14 @@
"unknown_versioning": {
"dlHash": "56361cf4b0d920fe23174751fea1fb82a8e1ce522bd9706a3fbe47a72e458c9c",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz"
}
},
"Linux_UnknownLinux": {
"unknown_versioning": {
"dlHash": "6136c189ffccaa39916f9cb5788f757166444a2d0c473b987856a79ecbf0c714",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-linux.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-linux.tar.xz"
}
}
},
@@ -2099,7 +2218,7 @@
"unknown_versioning": {
"dlHash": "b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198",
"dlSubdir": null,
"dlUri": "https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-i386-unknown-linux.tar.xz"
"dlUri": "https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-i386-unknown-linux.tar.xz"
}
}
}
@@ -2109,46 +2228,48 @@
"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"
},
"viChangeLog": "https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog",
"viTags": []
}
},
"GHCup": {
"0.1.3": {
"0.1.5": {
"viArch": {
"A_64": {
"FreeBSD": {
"unknown_versioning": {
"dlHash": "2daa775d6fa307cb8123fa45ba20e2acd244cdb8cfb3f2b3c8a1aa3f3571c46f",
"dlHash": "6dd57cc5958ef3a6ba7de22808d9292d31dada8af95277578b69be35fc090194",
"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.5/x86_64-portbld-freebsd-ghcup-0.1.5"
}
},
"Darwin": {
"unknown_versioning": {
"dlHash": "a617b06619ec6e75d50dac53f36814c3cafd4dbeebe8cea46d9cd5842c0c94a9",
"dlHash": "5be3324b65c737af942cc5ed1a025d4882f29c1efcc7dcd971a893efab78d394",
"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.5/x86_64-apple-darwin-ghcup-0.1.5"
}
},
"Linux_UnknownLinux": {
"unknown_versioning": {
"dlHash": "873f73b65cf5e399864b81ed597a0e14fa73e0c492429cd3a85fe0fdc585a4c8",
"dlHash": "cfdb01dde77121859b5d90b6707238b54e23787fcbb3003e18ab52a5dbfee330",
"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.5/x86_64-linux-ghcup-0.1.5"
}
}
},
"A_32": {
"Linux_UnknownLinux": {
"unknown_versioning": {
"dlHash": "ff76a6130d6ea869a65bed127255bfa1ddf6aa1bd690df99d872467422c08be0",
"dlHash": "3707f60d703912709335dc0103fb1af5e5dfa83050825a8156b56bc81760b2a8",
"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.5/i386-linux-ghcup-0.1.5"
}
}
}
},
"viSourceDL": null,
"viChangeLog": "https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md",
"viTags": [
"Recommended",
"Latest"

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
version: 0.1.3
version: 0.1.5
synopsis: ghc toolchain installer as an exe/library
description:
A rewrite of the shell script ghcup, for providing
@@ -21,8 +21,8 @@ source-repository head
type: git
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
flag Curl
description: Use curl instead of http-io-streams for download
flag internal-downloader
description: Compile the internal downloader, which links against OpenSSL
default: False
manual: True
@@ -41,9 +41,6 @@ common ascii-string
common async
build-depends: async >=0.8
common attoparsec
build-depends: attoparsec >=0.13
common base
build-depends: base >=4.12 && <5
@@ -230,7 +227,6 @@ library
, aeson
, ascii-string
, async
, attoparsec
, binary
, bytestring
, bz2
@@ -248,6 +244,7 @@ library
, hpath-posix
, language-bash
, lzma
, megaparsec
, monad-logger
, mtl
, optics
@@ -279,6 +276,9 @@ library
exposed-modules:
GHCup
GHCup.Data.GHCupDownloads
GHCup.Data.GHCupInfo
GHCup.Data.ToolRequirements
GHCup.Download
GHCup.Download.Utils
GHCup.Errors
@@ -292,6 +292,7 @@ library
GHCup.Utils.Dirs
GHCup.Utils.File
GHCup.Utils.Logger
GHCup.Utils.MegaParsec
GHCup.Utils.Prelude
GHCup.Utils.String.QQ
GHCup.Utils.Version.QQ
@@ -301,15 +302,14 @@ library
-- other-extensions:
hs-source-dirs: lib
if !flag(curl)
if flag(internal-downloader)
import:
, HsOpenSSL
, http-io-streams
, io-streams
, terminal-progress-bar
exposed-modules: GHCup.Download.IOStreams
else
cpp-options: -DCURL
cpp-options: -DINTERNAL_DOWNLOADER
executable ghcup
import:
@@ -326,8 +326,10 @@ executable ghcup
, optparse-applicative
, pretty-terminal
, resourcet
, safe
, string-interpolate
, table-layout
, template-haskell
, text
, uri-bytestring
, utf8-string
@@ -342,6 +344,10 @@ executable ghcup
hs-source-dirs: app/ghcup
default-language: Haskell2010
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
executable ghcup-gen
import:
config
@@ -370,9 +376,6 @@ executable ghcup-gen
--
main-is: Main.hs
other-modules:
GHCupDownloads
GHCupInfo
ToolRequirements
Validate
-- other-extensions:

View File

@@ -9,6 +9,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup where
@@ -40,6 +41,7 @@ import Data.ByteString ( ByteString )
import Data.List
import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions
import Data.Word8
import GHC.IO.Exception
@@ -52,11 +54,14 @@ import Prelude hiding ( abs
, writeFile
)
import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment )
import System.Posix.FilePath ( getSearchPath )
import System.Posix.Files.ByteString
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@@ -93,45 +98,34 @@ installGHCBin :: ( MonadFail m
m
()
installGHCBin bDls ver mpfReq = do
let tver = (mkTVer ver)
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
whenM (liftIO $ toolAlreadyInstalled GHC ver)
whenM (liftIO $ ghcInstalled tver)
$ (throwE $ AlreadyInstalled GHC ver)
Settings {..} <- lift ask
Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version)
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
-- prepare paths
ghcdir <- liftIO $ ghcupGHCDir ver
ghcdir <- liftIO $ ghcupGHCDir tver
-- the subdir of the archive where we do the work
let workdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
-- Be careful about cleanup. We must catch both pure exceptions
-- as well as async ones.
flip onException
(liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
$ catchAllE
(\es -> do
liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
>> throwE (BuildFailed workdir es)
)
$ installGHC' workdir ghcdir
liftE $ runBuildAction tmpUnpack (Just ghcdir) (installGHC' workdir ghcdir)
-- only clean up dir if the build succeeded
liftIO $ deleteDirRecursive tmpUnpack
liftE $ postGHCInstall ver
liftE $ postGHCInstall tver
where
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
installGHC' :: (MonadLogger m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> Path Abs -- ^ Path to install to
@@ -172,15 +166,15 @@ installCabalBin :: ( MonadMask m
()
installCabalBin bDls ver mpfReq = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
Settings {..} <- lift ask
Settings {..} <- lift ask
pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
-- download (or use cached version)
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
tmpUnpack <- lift withGHCupTmpDir
liftE $ unpackToDir tmpUnpack dl
void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
@@ -194,7 +188,7 @@ installCabalBin bDls ver mpfReq = do
pure ()
where
-- | Install an unpacked cabal distribution.
-- | Install an unpacked cabal distribution.
installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> Path Abs -- ^ Path to install to
@@ -226,11 +220,11 @@ installCabalBin bDls ver mpfReq = do
-- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc/<ver>/share symlink
-- for `SetGHCOnly` constructor.
setGHC :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version
=> GHCTargetVersion
-> SetGHC
-> Excepts '[NotInstalled] m Version
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC ver sghc = do
let verBS = verToBS ver
let verBS = verToBS (_tvVersion ver)
ghcdir <- liftIO $ ghcupGHCDir ver
-- symlink destination
@@ -240,20 +234,18 @@ setGHC ver sghc = do
-- first delete the old symlinks (this fixes compatibility issues
-- with old ghcup)
case sghc of
SetGHCOnly -> liftE $ rmPlain ver
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
SetGHC_XY -> lift $ rmMajorSymlinks ver
SetGHC_XYZ -> lift $ rmMinorSymlinks ver
-- for ghc tools (ghc, ghci, haddock, ...)
verfiles <- ghcToolFiles ver
forM_ verfiles $ \file -> do
liftIO $ hideError doesNotExistErrorType $ deleteFile (bindir </> file)
targetFile <- case sghc of
SetGHCOnly -> pure file
SetGHC_XY -> do
major' <-
(\(mj, mi) -> E.encodeUtf8 $ intToText mj <> "." <> intToText mi)
<$> getGHCMajor ver
major' <- (\(mj, mi) -> E.encodeUtf8 $ intToText mj <> "." <> intToText mi)
<$> getMajorMinorV (_tvVersion ver)
parseRel (toFilePath file <> B.singleton _hyphen <> major')
SetGHC_XYZ -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS)
@@ -264,7 +256,7 @@ setGHC ver sghc = do
liftIO $ createSymlink fullF destL
-- create symlink for share dir
lift $ symlinkShareDir ghcdir verBS
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verBS
pure ver
@@ -304,27 +296,41 @@ data ListCriteria = ListInstalled
data ListResult = ListResult
{ lTool :: Tool
, lVer :: Version
, lCross :: Maybe Text -- ^ currently only for GHC
, lTag :: [Tag]
, lInstalled :: Bool
, lSet :: Bool
, fromSrc :: Bool
, lSet :: Bool -- ^ currently active version
, fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
}
deriving Show
deriving (Eq, Ord, Show)
availableToolVersions :: GHCupDownloads -> Tool -> [(Version, [Tag])]
availableToolVersions av tool = toListOf
(ix tool % to (fmap (\(v, vi) -> (v, (_viTags vi))) . Map.toList) % folded)
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
availableToolVersions av tool = view
(at tool % non Map.empty % to (fmap (_viTags)))
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 ListCriteria
-> IO [ListResult]
-> m [ListResult]
listVersions av lt criteria = case lt of
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
ghcvers <- listVersions av (Just GHC) criteria
cabalvers <- listVersions av (Just Cabal) criteria
@@ -332,21 +338,75 @@ listVersions av lt criteria = case lt of
pure (ghcvers <> cabalvers <> ghcupvers)
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 t (v, tags) = case t of
GHC -> do
lSet <- fmap (maybe False (== v)) $ ghcSet
lInstalled <- ghcInstalled v
fromSrc <- ghcSrcInstalled v
pure ListResult { lVer = v, lTag = tags, lTool = t, .. }
let tver = mkTVer v
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
Cabal -> do
lSet <- fmap (== v) $ cabalSet
let lInstalled = lSet
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
let lSet = prettyPVP ghcUpVer == prettyVer v
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]
@@ -364,10 +424,10 @@ listVersions av lt criteria = case lt of
-- | This function may throw and crash in various ways.
rmGHCVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m)
=> Version
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmGHCVer ver = do
isSetGHC <- fmap (maybe False (== ver)) $ ghcSet
isSetGHC <- fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
dir <- liftIO $ ghcupGHCDir ver
let d' = toFilePath dir
exists <- liftIO $ doesDirectoryExist dir
@@ -378,7 +438,7 @@ rmGHCVer ver = do
-- this isn't atomic, order matters
when isSetGHC $ do
lift $ $(logInfo) [i|Removing ghc symlinks|]
liftE $ rmPlain ver
liftE $ rmPlain (_tvTarget ver)
lift $ $(logInfo) [i|Removing directory recursively: #{d'}|]
liftIO $ deleteDirRecursive dir
@@ -390,15 +450,15 @@ rmGHCVer ver = do
-- first remove
lift $ rmMajorSymlinks ver
-- then fix them (e.g. with an earlier version)
(mj, mi) <- getGHCMajor ver
getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
(mj, mi) <- getMajorMinorV (_tvVersion ver)
getGHCForMajor mj mi (_tvTarget ver) >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
liftIO
$ ghcupBaseDir
>>= hideError doesNotExistErrorType
. deleteFile
. (</> [rel|share|])
else throwE (NotInstalled GHC ver)
else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))
@@ -439,11 +499,12 @@ compileGHC :: ( MonadMask m
, MonadFail m
)
=> GHCupDownloads
-> Version -- ^ version to install
-> GHCTargetVersion -- ^ version to install
-> Either Version (Path Abs) -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs
-> Maybe (Path Abs) -- ^ build config
-> Maybe (Path Abs)
-> Maybe (Path Abs) -- ^ patch directory
-> [Text] -- ^ additional args to ./configure
-> Excepts
'[ AlreadyInstalled
, BuildFailed
@@ -460,13 +521,15 @@ compileGHC :: ( MonadMask 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}|]
whenM (liftIO $ toolAlreadyInstalled GHC tver)
(throwE $ AlreadyInstalled GHC tver)
whenM (liftIO $ ghcInstalled tver)
(throwE $ AlreadyInstalled GHC (tver ^. tvVersion))
-- 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
-- unpack
@@ -481,32 +544,29 @@ compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
ghcdir <- liftIO $ ghcupGHCDir tver
-- Be careful about cleanup. We must catch both pure exceptions
-- as well as async ones.
flip onException
(liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
$ catchAllE
(\es ->
liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
>> throwE (BuildFailed workdir es)
)
$ compile bghc ghcdir workdir
markSrcBuilt ghcdir workdir
-- only clean up dir if the build succeeded
liftIO $ deleteDirRecursive tmpUnpack
liftE $ runBuildAction
tmpUnpack
(Just ghcdir)
(compile bghc ghcdir workdir >> markSrcBuilt ghcdir workdir)
reThrowAll GHCupSetError $ postGHCInstall tver
pure ()
where
defaultConf = [s|
defaultConf = case _tvTarget tver of
Nothing -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES
GhcWithLlvmCodeGen = YES|]
HADDOCK_DOCS = 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)
=> Either (Path Rel) (Path Abs)
@@ -514,6 +574,7 @@ GhcWithLlvmCodeGen = YES|]
-> Path Abs
-> Excepts
'[ FileDoesNotExistError
, InvalidBuildConfig
, PatchFailed
, ProcessError
, NotFoundInPATH
@@ -522,14 +583,14 @@ GhcWithLlvmCodeGen = YES|]
()
compile bghc ghcdir workdir = do
lift $ $(logInfo) [i|configuring build|]
liftE $ checkBuildConfig
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
-- force ld.bfd for build (others seem to misbehave, like lld from FreeBSD)
newEnv <- addToCurrentEnv [("LD", "ld.bfd")]
cEnv <- liftIO $ getEnvironment
if
| tver >= [vver|8.8.0|] -> do
| (_tvVersion tver) >= [vver|8.8.0|] -> do
bghcPath <- case bghc of
Right ghc' -> pure ghc'
Left bver -> do
@@ -538,20 +599,32 @@ GhcWithLlvmCodeGen = YES|]
lEM $ liftIO $ execLogged
"./configure"
False
["--prefix=" <> toFilePath ghcdir]
( ["--prefix=" <> toFilePath ghcdir]
++ (maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x])
(_tvTarget tver)
)
++ fmap E.encodeUtf8 aargs
)
[rel|ghc-conf|]
(Just workdir)
(Just (("GHC", toFilePath bghcPath) : newEnv))
(Just (("GHC", toFilePath bghcPath) : cEnv))
| otherwise -> do
lEM $ liftIO $ execLogged
"./configure"
False
[ "--prefix=" <> toFilePath ghcdir
, "--with-ghc=" <> either toFilePath toFilePath bghc
]
( [ "--prefix=" <> toFilePath ghcdir
, "--with-ghc=" <> either toFilePath toFilePath bghc
]
++ (maybe mempty
(\x -> ["--target=" <> E.encodeUtf8 x])
(_tvTarget tver)
)
++ fmap E.encodeUtf8 aargs
)
[rel|ghc-conf|]
(Just workdir)
(Just newEnv)
(Just cEnv)
case mbuildConfig of
Just bc -> liftIOException
@@ -574,6 +647,30 @@ GhcWithLlvmCodeGen = YES|]
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
, MonadResource m
@@ -614,7 +711,11 @@ compileCabal dls tver bghc jobs patchdir = do
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
liftIO $ deleteDirRecursive tmpUnpack
@@ -729,12 +830,12 @@ upgradeGHCup dls mtarget force = do
-- | Creates ghc-x.y.z and ghc-x.y symlinks. This is used for
-- both installing from source and bindist.
postGHCInstall :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
postGHCInstall ver = do
postGHCInstall ver@GHCTargetVersion{..} = do
void $ liftE $ setGHC ver SetGHC_XYZ
-- Create ghc-x.y symlinks. This may not be the current
-- version, create it regardless.
(mj, mi) <- liftIO $ getGHCMajor ver
getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
(mj, mi) <- getMajorMinorV _tvVersion
getGHCForMajor mj mi _tvTarget >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)

View File

@@ -2,7 +2,7 @@
{-# LANGUAGE QuasiQuotes #-}
module GHCupDownloads where
module GHCup.Data.GHCupDownloads where
import GHCup.Types
import GHCup.Utils.Version.QQ
@@ -827,7 +827,7 @@ ghc_883_32_musl :: DownloadInfo
ghc_883_32_musl = DownloadInfo
[uri|https://github.com/redneb/ghc-alt-libc/releases/download/ghc-8.8.3-musl/ghc-8.8.3-i386-unknown-linux-musl.tar.xz|]
(Just [rel|ghc-8.8.3|])
"23779adb4cf4b314d0f8c66ee215ba6e74154c0768a573780475943544020bec"
"7a5f41646d06777e75636291a1855d60a0984552bbdf33c3d107565d302f38a4"
@@ -897,25 +897,25 @@ ghc_8101_64_alpine = DownloadInfo
cabal_2410_32_linux :: DownloadInfo
cabal_2410_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-i386-unknown-linux.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-i386-unknown-linux.tar.xz|]
Nothing
"b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198"
cabal_2410_64_linux :: DownloadInfo
cabal_2410_64_linux = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-linux.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-linux.tar.xz|]
Nothing
"6136c189ffccaa39916f9cb5788f757166444a2d0c473b987856a79ecbf0c714"
cabal_2410_64_darwin :: DownloadInfo
cabal_2410_64_darwin = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz|]
Nothing
"56361cf4b0d920fe23174751fea1fb82a8e1ce522bd9706a3fbe47a72e458c9c"
cabal_2410_64_alpine :: DownloadInfo
cabal_2410_64_alpine = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-alpine-linux-musl.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-alpine-linux-musl.tar.xz|]
Nothing
"720bef015f834a03deb7180be2952a44e7c2e6c8429137570404c3de4f46b984"
@@ -935,7 +935,7 @@ cabal_2410_64_freebsd = DownloadInfo
cabal_3000_32_linux :: DownloadInfo
cabal_3000_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-unknown-linux.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-unknown-linux.tar.xz|]
Nothing
"6898ccd6e6dc0872999c06daaf61d546164e12f60a1880d09852c9f0c59c5cf6"
@@ -947,10 +947,28 @@ cabal_3000_64_linux = DownloadInfo
cabal_3000_64_darwin :: DownloadInfo
cabal_3000_64_darwin = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-apple-darwin17.7.0.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-apple-darwin17.7.0.tar.xz|]
Nothing
"d4857e068560515e4cbb0e8ca124c370e07892f2a28804d87152834e5fe2b845"
cabal_3000_64_freebsd :: DownloadInfo
cabal_3000_64_freebsd = DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz|]
Nothing
"2240842ab2ae7b955feb8b526aba1c7991248c803383107adf39990441294d2a"
cabal_3000_32_alpine :: DownloadInfo
cabal_3000_32_alpine = DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-alpine-linux-musl.tar.xz|]
Nothing
"ac018f061993d40bf146517e32629bcab274b4d9f5527b1c37a665ebdf3f5ac6"
cabal_3000_64_alpine :: DownloadInfo
cabal_3000_64_alpine = DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-alpine-linux-musl.tar.xz|]
Nothing
"2b7ea63601e11a0db2941b96e6a7036a48efc2a1ab3849d7dfce08b45f5daa58"
---------------------
@@ -960,7 +978,7 @@ cabal_3000_64_darwin = DownloadInfo
cabal_3200_32_linux :: DownloadInfo
cabal_3200_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz|]
Nothing
"2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93"
@@ -972,10 +990,28 @@ cabal_3200_64_linux = DownloadInfo
cabal_3200_64_darwin :: DownloadInfo
cabal_3200_64_darwin = DownloadInfo
[uri|https://downloads.haskell.org/cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-apple-darwin17.7.0.tar.xz|]
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-apple-darwin17.7.0.tar.xz|]
Nothing
"9197c17d2ece0f934f5b33e323cfcaf486e4681952687bc3d249488ce3cbe0e9"
cabal_3200_64_freebsd :: DownloadInfo
cabal_3200_64_freebsd = DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz|]
Nothing
"f1e35151cca91541b0fb4bdb3ed18f3c348038eab751845ad19c11307d66c273"
cabal_3200_32_alpine :: DownloadInfo
cabal_3200_32_alpine = DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz|]
Nothing
"c2a419dedf730987b60daf8d24e871d115a09ea608d740d7c61b36e3f5b9c830"
cabal_3200_64_alpine :: DownloadInfo
cabal_3200_64_alpine = DownloadInfo
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz|]
Nothing
"8bae37a1ce8b5f10440b5591fed734935e1411c1b765258325ffe268e2cc2042"
@@ -984,32 +1020,32 @@ cabal_3200_64_darwin = DownloadInfo
-------------
ghcup_013_32_linux :: DownloadInfo
ghcup_013_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/i386-linux-ghcup-0.1.3|]
ghcup_015_32_linux :: DownloadInfo
ghcup_015_32_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.5/i386-linux-ghcup-0.1.5|]
Nothing
"ff76a6130d6ea869a65bed127255bfa1ddf6aa1bd690df99d872467422c08be0"
"3707f60d703912709335dc0103fb1af5e5dfa83050825a8156b56bc81760b2a8"
ghcup_013_64_linux :: DownloadInfo
ghcup_013_64_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-linux-ghcup-0.1.3|]
ghcup_015_64_linux :: DownloadInfo
ghcup_015_64_linux = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-linux-ghcup-0.1.5|]
Nothing
"873f73b65cf5e399864b81ed597a0e14fa73e0c492429cd3a85fe0fdc585a4c8"
"cfdb01dde77121859b5d90b6707238b54e23787fcbb3003e18ab52a5dbfee330"
ghcup_013_64_freebsd :: DownloadInfo
ghcup_013_64_freebsd = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-portbld-freebsd-ghcup-0.1.3|]
ghcup_015_64_freebsd :: DownloadInfo
ghcup_015_64_freebsd = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-portbld-freebsd-ghcup-0.1.5|]
Nothing
"2daa775d6fa307cb8123fa45ba20e2acd244cdb8cfb3f2b3c8a1aa3f3571c46f"
"6dd57cc5958ef3a6ba7de22808d9292d31dada8af95277578b69be35fc090194"
ghcup_013_64_darwin10_13 :: DownloadInfo
ghcup_013_64_darwin10_13 = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.3/x86_64-apple-darwin-ghcup-0.1.3|]
ghcup_015_64_darwin10_13 :: DownloadInfo
ghcup_015_64_darwin10_13 = DownloadInfo
[uri|https://downloads.haskell.org/~ghcup/0.1.5/x86_64-apple-darwin-ghcup-0.1.5|]
Nothing
"a617b06619ec6e75d50dac53f36814c3cafd4dbeebe8cea46d9cd5842c0c94a9"
"5be3324b65c737af942cc5ed1a025d4882f29c1efcc7dcd971a893efab78d394"
@@ -1026,7 +1062,10 @@ ghcupDownloads = M.fromList
, M.fromList
[ ( [vver|7.10.3|]
, VersionInfo
[]
[Base [pver|4.8.2.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz|]
(Just [rel|ghc-7.10.3|])
@@ -1069,7 +1108,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.0.2|]
, VersionInfo
[]
[Base [pver|4.9.1.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz|]
(Just [rel|ghc-8.0.2|])
@@ -1112,7 +1154,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.2.2|]
, VersionInfo
[]
[Base [pver|4.10.1.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz|]
(Just [rel|ghc-8.2.2|])
@@ -1161,7 +1206,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.1|]
, VersionInfo
[]
[Base [pver|4.11.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz|]
(Just [rel|ghc-8.4.1|])
@@ -1197,7 +1245,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.2|]
, VersionInfo
[]
[Base [pver|4.11.1.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz|]
(Just [rel|ghc-8.4.2|])
@@ -1244,7 +1295,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.3|]
, VersionInfo
[]
[Base [pver|4.11.1.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz|]
(Just [rel|ghc-8.4.3|])
@@ -1290,7 +1344,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.4.4|]
, VersionInfo
[]
[Base [pver|4.11.1.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.4.4/docs/html/users_guide/8.4.4-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz|]
(Just [rel|ghc-8.4.4|])
@@ -1341,7 +1398,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.1|]
, VersionInfo
[]
[Base [pver|4.12.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz|]
(Just [rel|ghc-8.6.1|])
@@ -1388,7 +1448,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.2|]
, VersionInfo
[]
[Base [pver|4.12.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz|]
(Just [rel|ghc-8.6.2|])
@@ -1429,7 +1492,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.3|]
, VersionInfo
[]
[Base [pver|4.12.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz|]
(Just [rel|ghc-8.6.3|])
@@ -1480,7 +1546,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.4|]
, VersionInfo
[]
[Base [pver|4.12.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz|]
(Just [rel|ghc-8.6.4|])
@@ -1526,7 +1595,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.6.5|]
, VersionInfo
[]
[Base [pver|4.12.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz|]
(Just [rel|ghc-8.6.5|])
@@ -1576,7 +1648,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.8.1|]
, VersionInfo
[]
[Base [pver|4.13.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz|]
(Just [rel|ghc-8.8.1|])
@@ -1626,7 +1701,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.8.2|]
, VersionInfo
[]
[Base [pver|4.13.0.0|]]
(Just
[uri|https://downloads.haskell.org/~ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html|]
)
(Just $ DownloadInfo
[uri|https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz|]
(Just [rel|ghc-8.8.2|])
@@ -1676,7 +1754,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.8.3|]
, 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
[uri|https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz|]
(Just [rel|ghc-8.8.3|])
@@ -1726,7 +1807,10 @@ ghcupDownloads = M.fromList
)
, ( [vver|8.10.1|]
, 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
[uri|https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz|]
(Just [rel|ghc-8.10.1|])
@@ -1796,6 +1880,9 @@ ghcupDownloads = M.fromList
[ ( [vver|2.4.1.0|]
, VersionInfo
[]
(Just
[uri|https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog|]
)
(Just $ DownloadInfo
[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|])
@@ -1824,6 +1911,9 @@ ghcupDownloads = M.fromList
, ( [vver|3.0.0.0|]
, VersionInfo
[]
(Just
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog|]
)
(Just $ DownloadInfo
[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|])
@@ -1835,7 +1925,9 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, 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
@@ -1843,6 +1935,7 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, 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|]
, VersionInfo
[Recommended, Latest]
(Just
[uri|https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog|]
)
(Just $ DownloadInfo
[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|])
@@ -1861,7 +1957,9 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, 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
@@ -1869,6 +1967,7 @@ ghcupDownloads = M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, cabal_3200_32_linux)]
)
, (Linux Alpine, M.fromList [(Nothing, cabal_3200_32_alpine)])
]
)
]
@@ -1877,20 +1976,31 @@ ghcupDownloads = M.fromList
)
, ( GHCup
, M.fromList
[ ( [vver|0.1.3|]
, VersionInfo [Recommended, Latest] Nothing $ M.fromList
[ ( A_64
, M.fromList
[ (Linux UnknownLinux, M.fromList [(Nothing, ghcup_013_64_linux)])
, (Darwin, M.fromList [(Nothing, ghcup_013_64_darwin10_13)])
, (FreeBSD, M.fromList [(Nothing, ghcup_013_64_freebsd)])
[ ( [vver|0.1.5|]
, VersionInfo
[Recommended, Latest]
(Just
[uri|https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md|]
)
Nothing
$ M.fromList
[ ( A_64
, M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, ghcup_015_64_linux)]
)
, (Darwin , M.fromList [(Nothing, ghcup_015_64_darwin10_13)])
, (FreeBSD, M.fromList [(Nothing, ghcup_015_64_freebsd)])
]
)
, ( A_32
, M.fromList
[ ( Linux UnknownLinux
, M.fromList [(Nothing, ghcup_015_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 ToolRequirements
import GHCup.Data.GHCupDownloads
import GHCup.Data.ToolRequirements
import GHCup.Types

View File

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

View File

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

View File

@@ -47,7 +47,6 @@ import URI.ByteString
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M
import qualified Data.Text.Encoding as E
import qualified System.IO.Streams as Streams
@@ -146,7 +145,7 @@ downloadInternal = go (5 :: Int)
downloadStream r i' = do
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
Right (r', _) -> r'
Nothing -> 0

View File

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

View File

@@ -39,7 +39,6 @@ import System.Info
import Text.Regex.Posix
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
--------------------------
--[ Platform detection ]--
@@ -84,13 +83,13 @@ getPlatform = do
( either (const Nothing) Just
. versioning
. getMajorVersion
. E.decodeUtf8
. decUTF8Safe
)
<$> getDarwinVersion
pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
"freebsd" -> do
ver <-
(either (const Nothing) Just . versioning . E.decodeUtf8)
(either (const Nothing) Just . versioning . decUTF8Safe)
<$> getFreeBSDVersion
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
what -> throwE $ NoCompatiblePlatform what
@@ -159,7 +158,7 @@ getLinuxDistro = do
(Just _) <- findExecutable lsb_release_cmd
name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] 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 = do
@@ -169,7 +168,7 @@ getLinuxDistro = do
try_redhat_release :: IO (Text, Maybe Text)
try_redhat_release = do
t <- fmap lBS2sT $ readFile redhat_release
t <- fmap decUTF8Safe' $ readFile redhat_release
let nameRegex n =
makeRegexOpts compIgnoreCase
execBlank
@@ -192,4 +191,4 @@ getLinuxDistro = do
try_debian_version :: IO (Text, Maybe Text)
try_debian_version = do
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
@@ -70,9 +72,10 @@ data Tool = GHC
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
{ _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
}
deriving (Eq, Show)
@@ -80,7 +83,9 @@ data VersionInfo = VersionInfo
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest
| Recommended
deriving (Ord, Eq, Show)
| Base PVP
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, Show) -- FIXME: manual JSON instance
data Architecture = A_64
@@ -137,12 +142,26 @@ data URLSource = GHCupURL
data Settings = Settings
{ cache :: Bool
, noVerify :: Bool
{ cache :: Bool
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
}
deriving Show
data KeepDirs = Always
| Errors
| Never
deriving (Eq, Show, Ord)
data Downloader = Curl
| Wget
#if defined(INTERNAL_DOWNLOADER)
| Internal
#endif
deriving (Eq, Show, Ord)
data DebugInfo = DebugInfo
{ diBaseDir :: Path Abs
, diBinDir :: Path Abs
@@ -172,3 +191,23 @@ data PlatformRequest = PlatformRequest
, _rVersion :: Maybe Versioning
}
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 } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where
parseJSON = withText "Tag" $ \t -> case T.unpack t of
"Latest" -> pure Latest
"Recommended" -> pure Recommended
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
Left e -> fail . show $ e
x -> pure (UnknownTag x)
instance ToJSON URI where
toJSON = toJSON . decodeUtf8 . serializeURIRef'
toJSON = toJSON . decUTF8Safe . serializeURIRef'
instance FromJSON URI where
parseJSON = withText "URL" $ \t ->
@@ -143,6 +156,14 @@ instance FromJSONKey Version where
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
instance ToJSON PVP where
toJSON = toJSON . prettyPVP
instance FromJSON PVP where
parseJSON = withText "PVP" $ \t -> case pvp t of
Right x -> pure x
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
instance ToJSONKey Tool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
@@ -151,7 +172,7 @@ instance FromJSONKey Tool where
instance ToJSON (Path Rel) where
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"
where fp = toFilePath p

View File

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

View File

@@ -4,6 +4,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils
@@ -15,10 +16,13 @@ where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Utils.File
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import Control.Applicative
import Control.Exception.Safe
@@ -28,11 +32,12 @@ import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Attoparsec.ByteString
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions
import Data.Word8
import GHC.IO.Exception
@@ -50,6 +55,7 @@ import System.Posix.FilePath ( getSearchPath
, takeFileName
)
import System.Posix.Files.ByteString ( readSymbolicLink )
import Text.Regex.Posix
import URI.ByteString
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.Map.Strict as Map
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.
ghcLinkDestination :: ByteString -- ^ the tool, such as 'ghc', 'haddock' etc.
-> Version
-> GHCTargetVersion
-> ByteString
ghcLinkDestination tool ver = "../ghc/" <> verToBS 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
ghcLinkDestination tool ver =
"../ghc/" <> E.encodeUtf8 (prettyTVer ver) <> "/bin/" <> tool
-- e.g. ghc-8.6.5
rmMinorSymlinks :: (MonadIO m, MonadLogger m) => Version -> m ()
rmMinorSymlinks ver = do
rmMinorSymlinks :: (MonadIO m, MonadLogger m) => GHCTargetVersion -> m ()
rmMinorSymlinks GHCTargetVersion {..} = do
bindir <- liftIO $ ghcupBinDir
files <- liftIO $ getDirsFiles' bindir
let myfiles =
filter (\x -> ("-" <> verToBS ver) `B.isSuffixOf` toFilePath x) files
forM_ myfiles $ \f -> do
files <- liftIO $ findFiles'
bindir
( 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)
$(logDebug) [i|rm -f #{toFilePath 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)
=> Version
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m ()
rmPlain ver = do
files <- liftE $ ghcToolFiles ver
bindir <- liftIO $ ghcupBinDir
forM_ files $ \f -> do
let fullF = (bindir </> f)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- old ghcup
let hdc_file = (bindir </> [rel|haddock-ghc|])
lift $ $(logDebug) [i|rm -f #{toFilePath hdc_file}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file
rmPlain target = do
mtv <- ghcSet target
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
bindir <- liftIO $ ghcupBinDir
forM_ files $ \f -> do
let fullF = (bindir </> f)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- old ghcup
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
rmMajorSymlinks :: (MonadLogger m, MonadIO m) => Version -> m ()
rmMajorSymlinks ver = do
(mj, mi) <- liftIO $ getGHCMajor ver
let v' = E.encodeUtf8 $ intToText mj <> "." <> intToText mi
rmMajorSymlinks :: (MonadThrow m, MonadLogger m, MonadIO m)
=> GHCTargetVersion
-> m ()
rmMajorSymlinks GHCTargetVersion {..} = do
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
bindir <- liftIO ghcupBinDir
files <- liftIO $ getDirsFiles' bindir
let myfiles = filter (\x -> ("-" <> v') `B.isSuffixOf` toFilePath x) files
forM_ myfiles $ \f -> do
files <- liftIO $ findFiles'
bindir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk v')
*> MP.chunk v'
*> MP.eof
)
forM_ files $ \f -> do
let fullF = (bindir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
@@ -140,33 +153,61 @@ rmMajorSymlinks ver = do
-----------------------------------
toolAlreadyInstalled :: Tool -> Version -> IO Bool
toolAlreadyInstalled tool ver = case tool of
GHC -> ghcInstalled ver
Cabal -> cabalInstalled ver
GHCup -> pure True
ghcInstalled :: Version -> IO Bool
ghcInstalled :: GHCTargetVersion -> IO Bool
ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver
doesDirectoryExist ghcdir
ghcSrcInstalled :: Version -> IO Bool
ghcSrcInstalled :: GHCTargetVersion -> IO Bool
ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver
doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
ghcSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
ghcSet = do
ghcBin <- (</> [rel|ghc|]) <$> liftIO ghcupBinDir
ghcSet :: (MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
-- (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
-- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
link <- readSymbolicLink $ toFilePath ghcBin
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
@@ -179,7 +220,7 @@ cabalSet = do
cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
mc <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing
let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc
case version (E.decodeUtf8 reportedVer) of
case version $ decUTF8Safe reportedVer of
Left e -> throwM e
Right r -> pure r
@@ -190,32 +231,49 @@ cabalSet = do
-----------------------------------------
-- | We assume GHC is in semver format. I hope it is.
getGHCMajor :: MonadThrow m => Version -> m (Int, Int)
getGHCMajor ver = do
SemVer {..} <- throwEither (semver $ prettyVer ver)
pure (fromIntegral _svMajor, fromIntegral _svMinor)
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version {..} = case _vChunks of
([Digits x] : [Digits y] : _) -> pure (fromIntegral x, fromIntegral y)
_ -> throwM $ ParseError "Could not parse X.Y from version"
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.
-- This reads `ghcupGHCBaseDir`.
getGHCForMajor :: (MonadIO m, MonadThrow m)
=> Int -- ^ major version component
-> Int -- ^ minor version component
-> m (Maybe Version)
getGHCForMajor major' minor' = do
p <- liftIO $ ghcupGHCBaseDir
ghcs <- liftIO $ getDirsFiles' p
semvers <- forM ghcs $ throwEither . semver . E.decodeUtf8 . toFilePath
mapM (throwEither . version)
. fmap prettySemVer
=> Int -- ^ major version component
-> Int -- ^ minor version component
-> Maybe Text -- ^ the target triple
-> m (Maybe GHCTargetVersion)
getGHCForMajor major' minor' mt = do
ghcs <- rights <$> getInstalledGHCs
pure
. lastMay
. sort
. sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
. filter
(\SemVer {..} ->
fromIntegral _svMajor == major' && fromIntegral _svMinor == minor'
(\GHCTargetVersion {..} ->
_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
-> Excepts '[UnknownArchive] m ()
unpackToDir dest av = do
let fp = E.decodeUtf8 (toFilePath av)
lift $ $(logInfo) [i|Unpacking: #{fp}|]
fp <- (decUTF8Safe . toFilePath) <$> basename av
let dfp = decUTF8Safe . toFilePath $ dest
lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
fn <- toFilePath <$> basename av
let untar = Tar.unpack (toFilePath dest) . Tar.read
@@ -258,21 +317,27 @@ unpackToDir dest av = do
------------
-- | Get the tool versions that have this tag.
getTagged :: GHCupDownloads -> Tool -> Tag -> [Version]
getTagged av tool tag = toListOf
( ix tool
% to (Map.filter (\VersionInfo {..} -> elem tag _viTags))
% to Map.keys
% folded
-- | Get the tool version that has this tag. If multiple have it,
-- picks the greatest version.
getTagged :: Tag
-> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo)
getTagged tag =
( to (Map.filter (\VersionInfo {..} -> elem tag _viTags))
% to Map.toDescList
% _head
)
av
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 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
getDownloader :: MonadReader Settings m => m Downloader
getDownloader = ask <&> downloader
-------------
--[ Other ]--
@@ -298,12 +367,12 @@ urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
-- 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.:
-- ["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]
ghcToolFiles :: (MonadThrow m, MonadFail m, MonadIO m)
=> Version
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles ver = do
ghcdir <- liftIO $ ghcupGHCDir ver
@@ -311,18 +380,28 @@ ghcToolFiles ver = do
-- fail if ghc is not installed
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
-- 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) <-
(B.stripPrefix "ghc-" . takeFileName)
<$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> [rel|ghc|]))
(B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName)
<$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> ghcbin))
when (B.null symver)
(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
@@ -368,3 +447,47 @@ darwinNotarization Darwin path = exec
Nothing
Nothing
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 QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils.Dirs where
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import Control.Applicative
@@ -13,7 +16,6 @@ import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Maybe
import Data.Versions
import HPath
import HPath.IO
import Optics
@@ -27,8 +29,10 @@ import System.Posix.Env.ByteString ( getEnv
import System.Posix.Temp.ByteString ( mkdtemp )
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.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 = do
bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
@@ -44,16 +49,30 @@ ghcupBaseDir = do
Nothing -> liftIO getHomeDirectory
pure (bdir </> [rel|.ghcup|])
-- | ~/.ghcup/ghc by default.
ghcupGHCBaseDir :: IO (Path Abs)
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
ghcbasedir <- ghcupGHCBaseDir
verdir <- parseRel (verToBS ver)
verdir <- parseRel $ E.encodeUtf8 (prettyTVer ver)
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 = ghcupBaseDir <&> (</> [rel|bin|])

View File

@@ -18,6 +18,8 @@ import Data.Foldable
import Data.Functor
import Data.IORef
import Data.Maybe
import Data.Text ( Text )
import Data.Void
import GHC.Foreign ( peekCStringLen )
import GHC.IO.Encoding ( getLocaleEncoding )
import GHC.IO.Exception
@@ -39,12 +41,12 @@ import "unix" System.Posix.IO.ByteString
hiding ( openFd )
import System.Posix.Process ( ProcessStatus(..) )
import System.Posix.Types
import Text.Regex.Posix
import qualified Control.Exception as EX
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified System.Posix.Process.ByteString
as SPPB
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.Internal.Data.Unfold as SU
import qualified Streamly.Prelude as S
import qualified Text.Megaparsec as MP
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
-- | Bool signals whether the regions should be cleaned.
data StopThread = StopThread Bool
deriving Show
@@ -201,6 +205,7 @@ execLogged exe spath args lfile chdir env = do
lineAction ref rs bs' = do
modifyIORef' ref (swapRegs bs')
regs <- readIORef ref
void $ SPIB.fdWrite fileFd (bs' <> "\n")
forM (zip regs rs) $ \(bs, r) -> do
setConsoleRegion r $ do
w <- consoleWidth
@@ -208,12 +213,10 @@ execLogged exe spath args lfile chdir env = do
. T.pack
. color Blue
. T.unpack
. E.decodeUtf8With E.lenientDecode
. decUTF8Safe
. trim w
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
$ bs
SPIB.fdWrite fileFd (bs <> "\n")
swapRegs bs regs | length regs < size = regs ++ [bs]
| otherwise = tail regs ++ [bs]
@@ -371,8 +374,7 @@ searchPath paths needle = go paths
where
go [] = pure Nothing
go (x : xs) =
hideErrorDefM PermissionDenied (go xs)
$ hideErrorDefM NoSuchThing (go xs)
hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs)
$ do
dirStream <- openDirStream (toFilePath x)
S.findM (\(_, p) -> isMatch x p) (dirContentsStream dirStream)
@@ -383,3 +385,27 @@ searchPath paths needle = go paths
if p == toFilePath needle
then isExecutable (basedir </> needle)
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.Text as T
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.Builder 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 ~f = guard =<< f
lBS2sT :: L.ByteString -> Text
lBS2sT = TL.toStrict . TLE.decodeUtf8
handleIO' :: (MonadIO m, MonadCatch m)
=> IOErrorType
@@ -168,14 +165,14 @@ liftIOException errType ex =
. lift
hideErrorDef :: IOErrorType -> a -> IO a -> IO a
hideErrorDef err def =
handleIO (\e -> if err == ioeGetErrorType e then pure def else ioError e)
hideErrorDef :: [IOErrorType] -> a -> IO a -> IO a
hideErrorDef errs def =
handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e)
hideErrorDefM :: IOErrorType -> IO a -> IO a -> IO a
hideErrorDefM err def =
handleIO (\e -> if err == ioeGetErrorType e then def else ioError e)
hideErrorDefM :: [IOErrorType] -> IO a -> IO a -> IO a
hideErrorDefM errs def =
handleIO (\e -> if ioeGetErrorType e `elem` errs then def else ioError e)
-- TODO: does this work?
@@ -221,6 +218,12 @@ throwEither a = case a of
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 = E.encodeUtf8 . prettyVer
@@ -243,4 +246,16 @@ addToCurrentEnv adds = do
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.QQ
import qualified Data.Text as T
-- | This reflects the API version of the JSON.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
ghcUpVer :: PVP
ghcUpVer = [pver|0.1.3|]
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

View File

@@ -1,66 +0,0 @@
#!/usr/bin/env bash
set -eu
status_message() {
printf "\\033[0;32m%s\\033[0m\\n" "$1"
}
error_message() {
printf "\\033[0;31m%s\\033[0m\\n" "$1"
}
SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
CACHE_LOCATION="${HOME}/.cabal/packages/hackage.haskell.org/01-index.cache"
if [ ! -f "${CACHE_LOCATION}" ] ; then
error_message "${CACHE_LOCATION} does not exist, did you run 'cabal update'?"
exit 1
fi
if [ ! -f "${SCRIPTPATH}/cabal.project" ] ; then
error_message "Could not find ${SCRIPTPATH}/cabal.project, skipping index state update."
exit 3
fi
cabal v2-update
arch=$(getconf LONG_BIT)
case "${arch}" in
32)
byte_size=4
magic_word="CABA1002"
;;
64)
byte_size=8
magic_word="00000000CABA1002"
;;
*)
error_message "Unknown architecture (long bit): ${arch}"
exit 2
;;
esac
# This is the logic to parse the binary format of 01-index.cache.
# The first word is a magic 'caba1002', the second one is the timestamp in unix epoch.
# Better than copying the cabal-install source code.
if [ "$(xxd -u -p -l${byte_size} -s 0 "${CACHE_LOCATION}")" != "${magic_word}" ] ; then
error_message "Magic word does not match!"
exit 4
fi
cache_timestamp=$(echo "ibase=16;obase=A;$(xxd -u -p -l${byte_size} -s ${byte_size} "${CACHE_LOCATION}")" | bc)
# If we got junk from the binary file, this should fail.
cache_date=$(date --utc --date "@${cache_timestamp}" "+%FT%TZ")
status_message "Updating index state in ${SCRIPTPATH}/cabal.project"
if grep -q "^index-state: .*" "${SCRIPTPATH}/cabal.project" ; then
awk '/index-state:/ {gsub(/.*/, "index-state: '${cache_date}'")}; { print }' "${SCRIPTPATH}/cabal.project" > "${SCRIPTPATH}/cabal.project.tmp"
mv "${SCRIPTPATH}/cabal.project.tmp" "${SCRIPTPATH}/cabal.project"
else
printf "index-state: %s\n" "${cache_date}" >> "${SCRIPTPATH}/cabal.project"
fi