Compare commits

...

126 Commits

Author SHA1 Message Date
16ae69e994 Fix property tests 2023-10-13 18:08:16 +08:00
94888e9d8e Add temp git ref to versions to fix CI 2023-10-13 17:52:39 +08:00
Colin Woodbury
cc7cc8c0e4 refactor: use upstream TH constructors 2023-10-13 17:35:39 +09:00
Colin Woodbury
28cb01539d chore: bump versions upper bound and squash warnings 2023-10-13 17:31:17 +09:00
Colin Woodbury
8aa05f311e refactor: upgrade versions library usage 2023-10-13 17:09:35 +09:00
2f107197d4 Merge branch 'issue-887' 2023-10-10 16:57:58 +08:00
486a1bac25 Fix segfault in TUI when hitting enter early
Fixes #887
2023-10-10 10:26:35 +08:00
a73ce186b5 Remove documentation of nightlies
GHC nightlies have been broken for a while and unless
they are not only fixed, but GHC upstream demonstrates that
they can make them work reliably, GHCup will not promote them.
2023-10-07 16:54:54 +08:00
76204aa366 Re-enable threaded runtime
Needed for vty.
2023-10-01 17:17:13 +08:00
502f0ea62f Avoid module recompilation 2023-10-01 17:10:50 +08:00
e7e6663017 Update stackage to 20.26 2023-10-01 14:53:37 +08:00
e27fed09f3 Fix sdist 2023-10-01 14:45:41 +08:00
9eeac00714 Further improvement to tag documentation 2023-10-01 14:38:40 +08:00
c0ffb22d6a Improve documentation around tags 2023-10-01 14:35:31 +08:00
f0b145d8dd Merge remote-tracking branch 'origin/pr/890' 2023-09-30 15:20:42 +08:00
bb700281a3 Update gpg docs 2023-09-30 00:02:36 +08:00
openingnow
fcdec4ba2c Add another cabal store path 2023-09-29 16:58:51 +09:00
371eda962f Update system requirements for specific distro version
fixes #777
2023-09-04 15:08:24 +08:00
50252d8613 Merge branch 'fix-optparse-test' 2023-09-03 14:34:40 +08:00
78c393a16e Fix optparse tests on windows 2023-09-02 18:47:42 +08:00
9c3478075f Merge remote-tracking branch 'origin/pr/864' 2023-09-02 16:35:21 +08:00
7e7c11fda4 Merge remote-tracking branch 'origin/pr/868' 2023-09-02 16:34:30 +08:00
bff14761ac Use optparse-test in release/build 2023-09-02 16:32:46 +08:00
99ddcc938f cabal-fmt 2023-09-02 16:20:54 +08:00
e2301e2fa7 Merge remote-tracking branch 'origin/pr/862' 2023-09-02 16:19:56 +08:00
c52096671e Merge remote-tracking branch 'origin/pr/873' 2023-09-01 13:13:10 +08:00
64f03a2f18 Merge remote-tracking branch 'origin/pr/877' 2023-08-29 18:19:04 +08:00
Fendor
a72b78ef96 Update supported tools table for HLS 2.2.0.0 2023-08-27 14:33:42 +02:00
Zubin Duggal
b17849c258 Add my GPG keys to the docs 2023-08-23 17:59:56 +05:30
d759535faa Merge remote-tracking branch 'origin/pr/870' 2023-08-14 17:45:58 +08:00
Fendor
c25c07aa61 Update supported tool list 2023-08-12 11:56:12 +02:00
Lei Zhu
5f361e1e0b Fix compile test 2023-08-05 13:47:51 +08:00
Lei Zhu
bcb498de20 Merge branch 'master' into optparse-test-suite 2023-08-05 13:08:41 +08:00
Arjun Kathuria
fd6ff9f8ec pretty-print instances for VersionRange and VersionCmp types 2023-07-30 12:45:01 +05:30
Lei Zhu
69d311f0b4 ci 2023-07-29 00:43:33 +08:00
Lei Zhu
fde0e712ac add ci 2023-07-28 23:57:59 +08:00
Lei Zhu
c60aa767ca format 2023-07-28 23:48:03 +08:00
Lei Zhu
78df858ba1 run test 2023-07-28 23:39:21 +08:00
Lei Zhu
f1f4d5e836 gc test 2023-07-28 23:26:19 +08:00
Lei Zhu
2726e83235 whereis test 2023-07-28 23:00:15 +08:00
Lei Zhu
f23631054a compile test 2023-07-28 22:06:16 +08:00
Lei Zhu
9189f9a65a Add absolute description 2023-07-25 23:01:44 +08:00
Lei Zhu
7076472bde compile test 2023-07-25 22:58:01 +08:00
a2a605ad89 Merge remote-tracking branch 'origin/pr/867' 2023-07-25 18:10:40 +08:00
tomjaguarpaw
8fae9a5083 Fix spelling 2023-07-25 08:17:21 +01:00
Lei Zhu
6f07b6a343 compile test 2023-07-24 23:04:18 +08:00
Lei Zhu
dfebfc9504 upgrade test 2023-07-24 22:26:33 +08:00
Lei Zhu
36463ebf97 list test 2023-07-24 22:09:03 +08:00
Lei Zhu
f400f43b8c list test 2023-07-23 23:51:03 +08:00
a3748507ca Merge branch 'ghc-compile' 2023-07-23 22:46:14 +08:00
Lei Zhu
c92875882a rm test 2023-07-23 16:30:25 +08:00
Lei Zhu
2df2e3da40 extend unset ghc optparse example 2023-07-23 15:47:47 +08:00
Lei Zhu
cf1e8659b0 unset test 2023-07-23 15:41:27 +08:00
Lei Zhu
fb2e3f2740 test test 2023-07-23 15:19:13 +08:00
578162f461 Merge remote-tracking branch 'origin/pr/866' 2023-07-23 12:37:20 +08:00
unleashy
29bc40f65b Remove quote escapes 2023-07-22 18:41:00 -03:00
Lei Zhu
aafb77df7c install test 2023-07-22 23:10:27 +08:00
Lei Zhu
dc1a813305 config test 2023-07-22 17:46:23 +08:00
Lei Zhu
16c7ecabe2 nuke test 2023-07-22 17:20:42 +08:00
Lei Zhu
e1d8ba869a Add missing stack for changelog parser 2023-07-22 17:16:58 +08:00
Lei Zhu
38db038953 changlog test 2023-07-22 17:14:49 +08:00
Lei Zhu
bcdf2b23f1 debug-info test 2023-07-22 16:07:49 +08:00
Lei Zhu
83b82c328b Set test 2023-07-22 15:31:37 +08:00
c149ee8d2b Print better error on 'ghcup <command> <tool>-<version>'
Wrt #180
2023-07-22 12:21:19 +08:00
Lei Zhu
c10924274d Set test 2023-07-22 11:45:29 +08:00
Lei Zhu
e13c5a99af Remove origin test to ghcup-test subdir 2023-07-20 23:09:14 +08:00
6623e4b1c8 Add GHC JS cross test 2023-07-19 08:12:10 +08:00
5170baf074 Fix cleaning up directories of compiled tools
'fromSrc' doesn't work well anyway.
2023-07-18 11:02:26 +08:00
d143daeb9a Merge branch 'check-msys2' 2023-07-18 10:13:23 +08:00
699b183f62 Host msys2 on our servers and verify checksum
Wrt #836
2023-07-18 10:07:30 +08:00
09d72e7c97 Don't error on non-empty dirs during cleanup 2023-07-17 23:15:43 +08:00
d551cc8077 Better logging for cross removal 2023-07-17 23:15:43 +08:00
4698639da9 Test linux cross build 2023-07-17 21:25:19 +08:00
e67a9c93fe Add documentation about Void Linux musl 2023-07-16 21:44:43 +08:00
621cc5782b Consume 'VERSION' file if it exists 2023-07-16 21:22:37 +08:00
482503ca0a Fix cross-compilation on make 2023-07-15 20:16:54 +08:00
2fb7328a6e Detect hadrian/make automatically, wrt #846 2023-07-15 20:16:36 +08:00
06eae56646 Fix pulling freebsd bindist 2023-07-12 17:51:56 +08:00
bdbbeb1040 Bump version to 0.1.19.5 2023-07-12 01:05:23 +08:00
1eed02c8c7 Merge branch 'docker-gg' 2023-07-12 01:04:53 +08:00
6d325a1804 Fix docker builds 2023-07-11 23:44:49 +08:00
a05f272b58 Merge remote-tracking branch 'origin/pr/844' 2023-07-11 23:30:51 +08:00
07dfb1e94b Fix tests 2023-07-08 00:07:29 +08:00
6ff07d3dbc Disable fking cabal-cache 2023-07-07 23:41:28 +08:00
0da5572164 Don't need --bignum option 2023-07-07 23:20:16 +08:00
422b99a222 Make cabal-cache non-fatal 2023-07-07 23:20:06 +08:00
055df584a4 Avoid duplicates in cross compilers showing up 2023-07-07 21:09:55 +08:00
9798e0f1d2 Fix brick min size for version column 2023-07-07 17:37:20 +08:00
a43fa7d63e More cross fixes to install bindist 2023-07-07 16:41:58 +08:00
4361ef7a72 Fix cross target being ignored 2023-07-07 00:39:31 +08:00
Sylvain Henry
3218aaa378 Allow cross-compilation with Hadrian 2023-07-07 00:38:50 +08:00
186a37cf3e Fix cross bindist installation 2023-07-07 00:38:50 +08:00
Sylvain Henry
7b1f591cc4 Fix Lint issues 2023-07-06 20:49:57 +08:00
0ecd244177 Update playground link 2023-07-06 20:43:14 +08:00
e14600ae75 Update ghver in bootstrap script 2023-07-02 18:56:18 +08:00
0884756139 Update metadata 2023-07-02 18:55:57 +08:00
4c539d62c1 Add create yaml script 2023-07-02 18:55:40 +08:00
f5b58d1db7 Update metadata submodule 2023-07-02 15:35:39 +08:00
18f6a74d08 Bump cabal in CI to 3.10.1.0 2023-07-02 12:34:04 +08:00
becb3436d0 Bump to 0.1.19.4 2023-07-02 12:32:11 +08:00
1f220cd488 Update metadata submodule 2023-06-29 20:14:41 +08:00
572ee06bbb Update ghcup version in bootstrap script 2023-06-29 20:12:10 +08:00
6e1380ef2e Bump to 0.1.19.2, add changelog 2023-06-29 18:42:05 +08:00
3e83a7fd83 Merge branch 'nightlies' 2023-06-29 18:27:17 +08:00
34ac9cec4d Add nightlies documentation 2023-06-29 14:47:49 +08:00
513f7446b3 Fix 2023-06-29 14:30:07 +08:00
aed478153d Print alternative day if day not found 2023-05-14 22:06:38 +08:00
210816769a Add dlOutput to DownloadInfo 2023-05-14 22:06:38 +08:00
42bf21c86e Update stack 2023-05-14 19:43:50 +08:00
4b34cddcda Implement support for nightlies, wrt #824 2023-05-14 19:43:49 +08:00
1ba2361fea Fix ARMv7 build 2023-05-02 23:54:53 +08:00
278a3005d1 Merge remote-tracking branch 'origin/pr/818' 2023-05-01 16:02:32 +08:00
Luis Morillo
78d68e381a apply logging only on GHC uninstalation 2023-04-14 17:31:28 +02:00
17ffc459db Merge remote-tracking branch 'origin/pr/811' 2023-03-25 16:45:12 +08:00
afcb482866 Update GPG keys 2023-03-25 15:33:56 +08:00
c28de19faa Fix GC with XDG dirs, fixes #810 2023-03-18 22:04:37 +08:00
7ae952c82e Merge remote-tracking branch 'origin/pr/809' 2023-03-18 12:26:32 +08:00
Ryan Davis
98098035c9 Use correct environment variable for STACK_ROOT
The environment variable used to set the root Stack directory was
incorrectly defined as STACK_ROOOT (typo with an extra 'O'). 

This has been fixed and the correct STACK_ROOT variable is now used.

See: https://docs.haskellstack.org/en/stable/environment_variables/#stack_root
2023-03-16 13:38:25 +11:00
acdc0786ba Update tools table 2023-03-15 00:18:14 +08:00
7fa72a8892 Merge remote-tracking branch 'origin/pr/807' 2023-03-15 00:13:54 +08:00
fa22920e51 Merge branch 'docker-glibc' 2023-03-15 00:13:17 +08:00
f084fbce43 Fix f*ckup in docker image creation 2023-03-14 20:56:03 +08:00
Arjun Kathuria
1850c00e9d fix: project build error with new haskus-utils-variant version
* New haskus-utils-variant version 3.3 now includes the function
  "throwSomeE", which was now causing a compile error, since
  we have a function of the same name in our code.

* The function imported from the package and our own version clashed.

* Solution was to conditionally include our shim when haskus-utils-variant
  version < 3.3
2023-03-13 00:25:04 +05:30
c20deceaa8 Improve wording around FreeBSD support 2023-03-11 21:26:16 +08:00
89e4145baf Merge remote-tracking branch 'origin/pr/805' 2023-03-11 21:23:31 +08:00
Alexey Vyskubov
f5f7c26d8a Adds some information about FreeBSD installation. 2023-03-07 13:01:20 +02:00
93 changed files with 16774 additions and 11166 deletions

View File

@@ -1,5 +1,5 @@
freebsd_instance:
image_family: freebsd-13-1
image_family: freebsd-13-2
build_task:
name: build
@@ -16,7 +16,9 @@ build_task:
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
install_script:
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
script:
- tzsetup Etc/GMT
- adjkerntz -a

11
.editorconfig Normal file
View File

@@ -0,0 +1,11 @@
root = true
[*]
end_of_line = LF
trim_trailing_whitespace = true
insert_final_newline = true
[*.hs]
indent_style = space
indent_size = 2
max_line_length = 80

View File

@@ -27,9 +27,11 @@ build_with_cache --project-file=cabal.project.release -w "${GHC}" --enable-tests
mkdir -p out
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
binary_opttest=$(cabal --project-file=cabal.project.release list-bin ghcup-optparse-test)
ver=$("${binary}" --numeric-version)
strip_binary "${binary}"
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
cp "${binary_opttest}" "out/test-optparse-${ARTIFACT}-${ver}${ext}"
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"

13
.github/scripts/cabal-cache.sh vendored Normal file
View File

@@ -0,0 +1,13 @@
#!/usr/bin/env bash
case "$(uname -s)" in
MSYS_*|MINGW*)
ext=".exe"
;;
*)
ext=""
;;
esac
echo "cabal-cache disabled (CABAL_CACHE_DISABLE set)"

View File

@@ -15,7 +15,7 @@ sync_from() {
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi
cabal-cache sync-from-archive \
cabal-cache.sh sync-from-archive \
--host-name-override=${S3_HOST} \
--host-port-override=443 \
--host-ssl-override=True \
@@ -29,7 +29,7 @@ sync_to() {
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi
cabal-cache sync-to-archive \
cabal-cache.sh sync-to-archive \
--host-name-override=${S3_HOST} \
--host-port-override=443 \
--host-ssl-override=True \
@@ -115,6 +115,10 @@ download_cabal_cache() {
mv "cabal-cache${exe}" "${dest}${exe}"
chmod +x "${dest}${exe}"
fi
# install shell wrapper
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
chmod +x "$HOME"/.local/bin/cabal-cache.sh
)
}

74
.github/scripts/cross.sh vendored Normal file
View File

@@ -0,0 +1,74 @@
#!/usr/bin/env bash
set -ex
. .github/scripts/common.sh
run() {
"$@"
}
if [ "${OS}" = "Windows" ] ; then
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
git_describe
rm -rf "${GHCUP_DIR}"
mkdir -p "${GHCUP_BIN}"
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}"
chmod +x "ghcup-test${ext}"
"$GHCUP_BIN/ghcup${ext}" --version
eghcup --version
sha_sum "$GHCUP_BIN/ghcup${ext}"
sha_sum "$(raw_eghcup --offline whereis ghcup)"
### cross build
eghcup --numeric-version
eghcup install ghc "${GHC_VER}"
eghcup set ghc "${GHC_VER}"
eghcup install cabal "${CABAL_VER}"
cabal --version
eghcup debug-info
ecabal update
"${WRAPPER}" "$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" -v \
compile ghc \
$(if [ -n "${HADRIAN_FLAVOUR}" ] ; then printf "%s" "--flavour=${HADRIAN_FLAVOUR}" ; else true ; fi) \
-j "$(nproc)" \
-v "${GHC_TARGET_VERSION}" \
-b "${GHC_VER}" \
-x "${CROSS}" \
-- ${BUILD_CONF_ARGS}
eghcup set ghc "${CROSS}-${GHC_TARGET_VERSION}"
[ "$($(eghcup whereis ghc "${CROSS}-${GHC_TARGET_VERSION}") --numeric-version)" = "${GHC_TARGET_VERSION}" ]
# test that doing fishy symlinks into GHCup dir doesn't cause weird stuff on 'ghcup nuke'
mkdir no_nuke/
mkdir no_nuke/bar
echo 'foo' > no_nuke/file
echo 'bar' > no_nuke/bar/file
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/cache/no_nuke
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/logs/no_nuke
# nuke
eghcup nuke
[ ! -e "${GHCUP_DIR}" ]
# make sure nuke doesn't resolve symlinks
[ -e "$CI_PROJECT_DIR"/no_nuke/file ]
[ -e "$CI_PROJECT_DIR"/no_nuke/bar/file ]

View File

@@ -18,8 +18,10 @@ mkdir -p "${GHCUP_BIN}"
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
cp "out/test-optparse-${ARTIFACT}"-* "ghcup-test-optparse${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}"
chmod +x "ghcup-test${ext}"
chmod +x "ghcup-test-optparse${ext}"
"$GHCUP_BIN/ghcup${ext}" --version
eghcup --version
@@ -29,7 +31,8 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
### Haskell test suite
./ghcup-test${ext}
rm ghcup-test${ext}
./ghcup-test-optparse${ext}
rm ghcup-test${ext} ghcup-test-optparse${ext}
### manual cli based testing

View File

@@ -25,7 +25,7 @@ jobs:
include:
- os: ubuntu-latest
DISTRO: Ubuntu
- os: macOS-10.15
- os: macOS-11
DISTRO: na
- os: windows-latest
DISTRO: na

140
.github/workflows/cross.yaml vendored Normal file
View File

@@ -0,0 +1,140 @@
name: Test cross bindists
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
schedule:
- cron: '0 2 * * *'
env:
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
CABAL_CACHE_NONFATAL: yes
jobs:
build:
name: Build linux binary
runs-on: ubuntu-latest
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ secrets.S3_HOST }}
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 64
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- name: Run build
uses: docker://hasufell/alpine-haskell:3.12
with:
args: sh .github/scripts/build.sh
env:
ARTIFACT: ${{ env.ARTIFACT }}
ARCH: ${{ env.ARCH }}
GHC_VER: ${{ env.GHC_VER }}
DISTRO: Alpine
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ env.S3_HOST }}
- if: always()
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: artifacts
path: |
./out/*
test-cross-linux:
name: Test linux cross
needs: "build"
runs-on: [self-hosted, Linux, X64]
container:
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
options: --user root
env:
CABAL_VER: 3.6.2.0
BUILD_CONF_ARGS: "--enable-unregisterised"
HADRIAN_FLAVOUR: ""
JSON_VERSION: "0.0.7"
GHC_VER: 8.10.6
GHC_TARGET_VERSION: "8.10.7"
ARCH: 64
DISTRO: Debian
ARTIFACT: "x86_64-linux-ghcup"
CROSS: "arm-linux-gnueabihf"
WRAPPER: "run"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- name: Run test (64 bit linux)
run: |
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
sudo apt-get install -y gcc-arm-linux-gnueabihf
sudo dpkg --add-architecture armhf
sudo apt-get update -y
sudo apt-get install -y libncurses-dev:armhf
sh .github/scripts/cross.sh
test-cross-js:
name: Test GHC JS cross
needs: "build"
runs-on: [self-hosted, Linux, X64]
container:
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
options: --user root
env:
CABAL_VER: 3.6.2.0
BUILD_CONF_ARGS: ""
HADRIAN_FLAVOUR: "default+native_bignum"
JSON_VERSION: "0.0.7"
GHC_VER: 9.6.2
GHC_TARGET_VERSION: "9.6.2"
ARCH: 64
DISTRO: Debian
ARTIFACT: "x86_64-linux-ghcup"
CROSS: "javascript-unknown-ghcjs"
WRAPPER: "emconfigure"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- name: Run test (64 bit linux)
run: |
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
git clone https://github.com/emscripten-core/emsdk.git
cd emsdk
./emsdk install latest
./emsdk activate latest
. ./emsdk_env.sh
cd ..
bash .github/scripts/cross.sh

View File

@@ -53,7 +53,7 @@ jobs:
platforms: linux/amd64
docker-arm32:
runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
runs-on: [self-hosted, Linux, ARM64]
steps:
- uses: docker://arm64v8/ubuntu:focal
name: Cleanup (aarch64 linux)
@@ -85,7 +85,7 @@ jobs:
with:
context: ./docker/arm32v7/focal
push: true
tags: hasufell/arm32v7-debian-haskell:10
tags: hasufell/arm32v7-ubuntu-haskell:focal
platforms: linux/arm
docker-aarch:
@@ -121,5 +121,5 @@ jobs:
with:
context: ./docker/arm64v8/focal
push: true
tags: hasufell/arm64v8-debian-haskell:10
tags: hasufell/arm64v8-ubuntu-haskell:focal
platforms: linux/arm64

View File

@@ -12,12 +12,16 @@ on:
schedule:
- cron: '0 2 * * *'
env:
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
CABAL_CACHE_NONFATAL: yes
jobs:
build-linux:
name: Build linux binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -81,7 +85,7 @@ jobs:
name: Build ARM binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -90,7 +94,7 @@ jobs:
fail-fast: true
matrix:
include:
- os: [self-hosted, Linux, ARM64, aarch32-linux]
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
ARCH: ARM
@@ -154,7 +158,7 @@ jobs:
name: Build binary (Mac/Win)
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.10.1.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
@@ -168,7 +172,7 @@ jobs:
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: ARM64
- os: macOS-10.15
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: 64
@@ -247,7 +251,7 @@ jobs:
needs: "build-linux"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
@@ -325,12 +329,12 @@ jobs:
needs: "build-arm"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: [self-hosted, Linux, ARM64, aarch32-linux]
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
ARCH: ARM
@@ -392,7 +396,7 @@ jobs:
needs: "build-macwin"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.10.1.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
strategy:
@@ -403,7 +407,7 @@ jobs:
GHC_VER: 9.2.6
ARCH: ARM64
DISTRO: na
- os: macOS-10.15
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: 64

View File

@@ -1,5 +1,18 @@
# Revision history for ghcup
## 0.1.19.5 -- ????-?-??
* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
## 0.1.19.4 -- 2023-7-02
* fix missing TUI for aarch64 linux binaries
## 0.1.19.3 -- 2023-6-29
* Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824)
* Fix GC with XDG dirs, fixes [#810](https://github.com/haskell/ghcup-hs/issues/810)
## 0.1.19.2 -- 2023-2-24
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)

View File

@@ -45,7 +45,7 @@ import Data.IORef
import Data.Vector ( Vector
, (!?)
)
import Data.Versions hiding ( str )
import Data.Versions
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.FilePath
@@ -73,8 +73,8 @@ data BrickData = BrickData
deriving Show
data BrickSettings = BrickSettings
{ showAllVersions :: Bool
, showAllTools :: Bool
{ showAllVersions :: Bool
, showAllTools :: Bool
}
deriving Show
@@ -156,10 +156,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
<+> padLeft (Pad 5) (str "Notes")
renderList' bis@BrickInternalState{..} =
let getMinLength = length . intercalate "," . fmap tagToString
minLength = V.maximum $ V.map (getMinLength . lTag) clr
in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis
renderItem minTagSize _ b listResult@ListResult{lTag = lTag', ..} =
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
let marks = if
| lSet -> (withAttr (attrName "set") $ str "✔✔")
| lInstalled -> (withAttr (attrName "installed") $ str "")
@@ -184,7 +184,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
( minHSize 6
(printTool lTool)
)
<+> minHSize 15 (str ver)
<+> minHSize minVerSize (str ver)
<+> (let l = catMaybes . fmap printTag $ sort lTag'
in padLeft (Pad 1) $ minHSize minTagSize $ if null l
then emptyWidget
@@ -202,9 +202,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly"
printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
@@ -216,8 +218,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printNotes ListResult {..} =
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
)
++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [withAttr (attrName "day") $ str (show d)])
-- | Draws the list elements.
--
@@ -272,19 +276,22 @@ app attrs dimAttrs =
defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap
Vty.defAttr
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
, (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
]
where
withForeColor | no_color = const
@@ -411,13 +418,17 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
filterVisible v t e | lInstalled e = True
| v
, not t
, Nightly `notElem` lTag e
, lTool e `notElem` hiddenTools = True
| not v
, t
, Old `notElem` lTag e = True
, Old `notElem` lTag e
, Nightly `notElem` lTag e = True
| v
, Nightly `notElem` lTag e
, t = True
| otherwise = (Old `notElem` lTag e) &&
| otherwise = (Old `notElem` lTag e) &&
(Nightly `notElem` lTag e) &&
(lTool e `notElem` hiddenTools)
@@ -460,19 +471,19 @@ install' _ (_, ListResult {..}) = do
dirs <- lift getDirs
case lTool of
GHC -> do
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
Cabal -> do
let vi = getVersionInfo lVer Cabal dls
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do
let vi = getVersionInfo lVer HLS dls
let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
Stack -> do
let vi = getVersionInfo lVer Stack dls
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
)
>>= \case
@@ -553,7 +564,7 @@ del' _ (_, ListResult {..}) = do
let run = runE @'[NotInstalled, UninstallFailed]
run (do
let vi = getVersionInfo lVer lTool dls
let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi
@@ -563,7 +574,7 @@ del' _ (_, ListResult {..}) = do
)
>>= \case
VRight vi -> do
logGHCPostRm (mkTVer lVer)
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
@@ -576,7 +587,7 @@ changelog' :: (MonadReader AppState m, MonadIO m)
-> m (Either String ())
changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (Left lVer) of
case getChangeLog dls lTool (ToolVersion lVer) of
Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do
@@ -656,5 +667,5 @@ getAppData mgi = runExceptT $ do
settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do
lV <- listVersions Nothing Nothing
lV <- listVersions Nothing [] False True (Nothing, Nothing)
pure $ BrickData (reverse lV)

View File

@@ -240,7 +240,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
_
| Just False <- optVerbose -> pure ()
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
@@ -249,7 +249,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
case t of
GHCup -> runLogger $
logWarn ("New GHCup version available: "
<> prettyVer l
<> tVerToText l
<> ". To upgrade, run 'ghcup upgrade'")
_ -> runLogger $
logWarn ("New "
@@ -258,7 +258,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
<> "If you want to install this latest version, run 'ghcup install "
<> T.pack (prettyShow t)
<> " "
<> prettyVer l
<> tVerToText l
<> "'")
Just _ -> pure ()
@@ -332,9 +332,10 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, MonadCatch m
)
=> Command
-> (Tool, Version)
-> (Tool, GHCTargetVersion)
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
@@ -367,12 +368,13 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
)
=> Tool
-> Maybe ToolVersion
-> Version
-> GHCTargetVersion
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool
pure (v == mkTVer ver)
pure (v == ver)

View File

@@ -8,6 +8,11 @@ package ghcup
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
package libarchive
flags: -system-libarchive
@@ -23,3 +28,5 @@ package aeson
package streamly
flags: +use-unliftio
package *
test-show-details: direct

View File

@@ -4,6 +4,11 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
if os(linux)
package ghcup
flags: +tui

View File

@@ -37,8 +37,8 @@ RUN apk add --no-cache \
xz-dev \
ncurses-static
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -37,8 +37,9 @@ RUN apk add --no-cache \
xz-dev \
ncurses-static
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.17.8
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 9 1
ARG GHCUP_VERSION=0.1.17.8
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 9 1
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -43,6 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
If the argument is omitted, the default is `recommended`.
Other tags include:
- `prerelease`: a prerelease version
- `latest-prerelease`: the latest prerelease version
## Manpages
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.
@@ -461,8 +467,10 @@ this is cryptographically secure.
First, obtain the gpg keys:
```sh
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
Then verify the gpg key in one of these ways:

View File

@@ -38,47 +38,78 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
### Linux Debian
#### Generic
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 11
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Ubuntu
#### Generic
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.04 && < 20.10
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.10
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Fedora
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
### Linux Mageia
The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
### Linux CentOS
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
#### Version >= 7 && < 8
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses xz perl`
### Linux Alpine
#### Generic
The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
### Linux VoidLinux
The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
### Linux (generic)
#### Generic
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.
### Darwin
#### Generic
On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
### FreeBSD
#### Generic
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
### Windows
#### Generic
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
## Next steps
@@ -102,10 +133,19 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
<tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
<tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
@@ -143,7 +183,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.8.1.0</td><td></td></tr>
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>3.6.0.0</td><td></td></tr>
<tr><td>3.4.1.0</td><td></td></tr>
@@ -159,7 +200,14 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.1.0.0</td><td></td></tr>
<tr><td>2.0.0.1</td><td></td></tr>
<tr><td>2.0.0.0</td><td></td></tr>
<tr><td>1.10.0.0</td><td></td></tr>
<tr><td>1.9.1.0</td><td></td></tr>
<tr><td>1.9.0.0</td><td></td></tr>
<tr><td>1.8.0.0</td><td></td></tr>
<tr><td>1.7.0.0</td><td></td></tr>
<tr><td>1.6.1.0</td><td></td></tr>
<tr><td>1.6.0.0</td><td></td></tr>
@@ -177,7 +225,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>2.9.1</td><td></td></tr>
<tr><td>2.7.5</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr>
<tr><td>2.7.1</td><td></td></tr>
@@ -190,7 +240,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
This list may not be exhaustive and specifies support for bindists only.
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -231,8 +281,9 @@ There are various issues with GHC itself.
### FreeBSD
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
Lacks some upstream bindists and may need compat libs (such as `misc/compat12x`).
HLS bindists are experimental.
Only latest FreeBSD is generally supported.
### Linux ARMv7/AARCH64
@@ -245,7 +296,14 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
If you want to GPG verify the binaries, import the following keys first:
```sh
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
@@ -307,6 +365,24 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
All set. You can run `cabal init` now in an empty directory to start a project.
## Esoteric distros
### Void Linux
Since void linux can be installed with glibc and musl, it's hard to support correctly with ghcup.
One way to make ghcup work on **Void Linux musl** is to follow the [Overriding distro detection](../guide/#overriding-distro-detection)
section and tell it to consider Alpine bindists only. E.g.:
```sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_MINIMAL=1 sh
source ~/.ghcup/env
ghcup config set platform-override '{ "arch": "A_64", "platform": { "contents": "Alpine", "tag": "Linux" }, "version": "3.17" }'
ghcup install cabal --set latest
ghcup install ghc --set latest
ghcup install stack --set latest
ghcup install hls --set latest
```
## Vim integration
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).

View File

@@ -328,7 +328,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a>
<a href="https://play.haskell.org/" class="btn btn-primary" role="button">Online playground</a>
</div>
## How to learn Haskell proper

View File

@@ -1,6 +1,6 @@
cabal-version: 2.4
name: ghcup
version: 0.1.19.2
version: 0.1.19.5
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
@@ -25,10 +25,10 @@ extra-source-files:
cbits/dirutils.h
data/build_mk/cross
data/build_mk/default
test/data/dir/.keep
test/data/file
test/golden/unix/GHCupInfo.json
test/golden/windows/GHCupInfo.json
test/ghcup-test/data/dir/.keep
test/ghcup-test/data/file
test/ghcup-test/golden/unix/GHCupInfo.json
test/ghcup-test/golden/windows/GHCupInfo.json
source-repository head
type: git
@@ -53,6 +53,43 @@ flag no-exe
default: False
manual: True
common app-common-depends
build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring >=0.10 && <0.12
, cabal-install-parsers >=0.4.5
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time >=1.9.3 && <1.12
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0
library
exposed-modules:
GHCup
@@ -137,7 +174,7 @@ library
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, retry ^>=0.8.1.2
, retry >=0.8.1.2 && <0.10
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, split ^>=0.2.3.4
@@ -146,13 +183,13 @@ library
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time ^>=1.9.3
, time >=1.9.3 && <1.12
, transformers ^>=0.5
, unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, versions >=6.0.3 && <6.1
, word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2
@@ -199,11 +236,11 @@ library
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
build-depends: vty ^>=5.37
build-depends: vty ^>=5.39
executable ghcup
main-is: Main.hs
other-modules:
library ghcup-optparse
import: app-common-depends
exposed-modules:
GHCup.OptParse
GHCup.OptParse.ChangeLog
GHCup.OptParse.Common
@@ -224,6 +261,40 @@ executable ghcup
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: lib-opt
default-language: Haskell2010
default-extensions:
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
build-depends: ghcup
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
executable ghcup
import: app-common-depends
main-is: Main.hs
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
@@ -241,40 +312,8 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded
build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring >=0.10 && <0.12
, cabal-install-parsers >=0.4.5
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
, ghcup-optparse
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
@@ -286,7 +325,7 @@ executable ghcup
, brick ^>=1.5
, transformers ^>=0.5
, unix ^>=2.7
, vty ^>=5.37
, vty ^>=5.39
if os(windows)
cpp-options: -DIS_WINDOWS
@@ -301,7 +340,7 @@ test-suite ghcup-test
type: exitcode-stdio-1.0
main-is: Main.hs
build-tool-depends: hspec-discover:hspec-discover -any
hs-source-dirs: test
hs-source-dirs: test/ghcup-test
other-modules:
GHCup.ArbitraryTypes
GHCup.Prelude.File.Posix.TraversalsSpec
@@ -336,11 +375,49 @@ test-suite ghcup-test
, quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2
, text ^>=2.0
, time >=1.9.3 && <1.12
, uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1
, versions >=6.0.3 && <6.1
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
test-suite ghcup-optparse-test
type: exitcode-stdio-1.0
hs-source-dirs: test/optparse-test
main-is: Main.hs
other-modules:
ChangeLogTest
CompileTest
ConfigTest
GCTest
InstallTest
ListTest
OtherCommandTest
RmTest
RunTest
SetTest
UnsetTest
UpgradeTest
Utils
WhereisTest
if os(windows)
cpp-options: -DIS_WINDOWS
default-language: Haskell2010
ghc-options: -Wall
build-depends:
, base
, ghcup
, ghcup-optparse
, optparse-applicative
, tasty
, tasty-hunit
, template-haskell
, text
, uri-bytestring
, versions

View File

@@ -5,4 +5,6 @@ cradle:
- component: "ghcup:exe:ghcup"
path: ./app/ghcup
- component: "ghcup:test:ghcup-test"
path: ./test
path: ./test/ghcup-test
- component: "ghcup:test:ghcup-optparse-test"
path: ./test/optparse-test

View File

@@ -244,7 +244,8 @@ com =
<> command
"list"
(info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools")
(progDesc "Show available GHCs and other tools"
<> footerDoc (Just $ text listToolFooter))
)
<> command
"upgrade"

View File

@@ -35,7 +35,6 @@ import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef')
import Data.Char (toLower)
@@ -50,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
{ clOpen :: Bool
, clTool :: Maybe Tool
, clToolVer :: Maybe ToolVersion
}
} deriving (Eq, Show)
@@ -76,12 +75,12 @@ changelogP =
e -> Left e
)
)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup|stack>" <> help
"Open changelog for given tool (default: ghc)"
<> completer toolCompleter
)
)
<*> optional (toolVersionTagArgument Nothing Nothing)
<*> optional (toolVersionTagArgument [] Nothing)
@@ -115,20 +114,15 @@ changelog :: ( Monad m
changelog ChangeLogOptions{..} runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let tool = fromMaybe GHC clTool
ver' = maybe
(Right Latest)
(\case
GHCVersion tv -> Left (_tvVersion tv)
ToolVersion tv -> Left tv
ToolTag t -> Right t
)
ver' = fromMaybe
(ToolTag Latest)
clToolVer
muri = getChangeLog dls tool ver'
case muri of
Nothing -> do
runLogger
(logWarn $
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
)
pure ExitSuccess
Just uri -> do

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Common where
@@ -45,7 +46,9 @@ import Data.Functor
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
import Data.Maybe
import Data.Text ( Text )
import Data.Versions hiding ( str )
import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions
import Data.Void
import qualified Data.Vector as V
import GHC.IO.Exception
@@ -72,26 +75,27 @@ import qualified Cabal.Config as CC
--[ Types ]--
-------------
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
-- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolVersion Version
| SetToolTag Tag
| SetToolDay Day
| SetRecommended
| SetNext
deriving (Eq, Show)
prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolDay day) = show day
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
toSetToolVer Nothing = SetRecommended
@@ -102,28 +106,28 @@ toSetToolVer Nothing = SetRecommended
--------------
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument criteria tool =
argument (eitherReader (parser tool))
(metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool)
where
mv (Just GHC) = "GHC_VERSION|TAG"
mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG"
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
mv _ = "VERSION|TAG|RELEASE_DATE"
parser (Just GHC) = ghcVersionTagEither
parser Nothing = ghcVersionTagEither
parser _ = toolVersionTagEither
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
@@ -237,22 +241,23 @@ isolateParser f = case isValid f && isAbsolute f of
-- this accepts cross prefix
ghcVersionTagEither :: String -> Either String ToolVersion
ghcVersionTagEither s' =
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
-- this ignores cross prefix
toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither s' =
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
"latest-prerelease" -> Right LatestPrerelease
"latest-nightly" -> Right LatestNightly
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left $ "Unknown tag " <> other
other -> Left $ "Unknown tag " <> other
ghcVersionEither :: String -> Either String GHCTargetVersion
@@ -261,7 +266,7 @@ ghcVersionEither =
toolVersionEither :: String -> Either String Version
toolVersionEither =
first (const "Not a valid version") . MP.parse version' "" . T.pack
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
toolParser :: String -> Either String Tool
@@ -272,12 +277,22 @@ toolParser s' | t == T.pack "ghc" = Right GHC
| otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack s')
dayParser :: String -> Either String Day
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
criteriaParser :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
| t == T.pack "set" = Right ListSet
| t == T.pack "available" = Right ListAvailable
| otherwise = Left ("Unknown criteria: " <> s')
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
| t == T.pack "set" = Right $ ListSet True
| t == T.pack "available" = Right $ ListAvailable True
| t == T.pack "+installed" = Right $ ListInstalled True
| t == T.pack "+set" = Right $ ListSet True
| t == T.pack "+available" = Right $ ListAvailable True
| t == T.pack "-installed" = Right $ ListInstalled False
| t == T.pack "-set" = Right $ ListSet False
| t == T.pack "-available" = Right $ ListAvailable False
| otherwise = Left ("Unknown criteria: " <> s')
where t = T.toLower (T.pack s')
@@ -455,10 +470,10 @@ tagCompleter tool add = listIOCompleter $ do
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' criteria tool filter' = listIOCompleter $ do
dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig
@@ -487,7 +502,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria
installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
@@ -655,6 +670,7 @@ fromVersion :: ( HasLog env
-> Tool
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
@@ -673,49 +689,58 @@ fromVersion' :: ( HasLog env
-> Tool
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool
second Just <$> getRecommended dls tool
?? TagNotFound Recommended tool
fromVersion' (SetGHCVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion v) tool dls
let vi = getVersionInfo v tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (v, vi)
fromVersion' (SetToolVersion v) tool = do
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo v tool dls
case pvp $ prettyVer v of -- need to be strict here
Left _ -> pure (mkTVer v, vi)
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mempty v', Just vi')
Nothing -> pure (mkTVer v, vi)
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (v, vi)
fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
fromVersion' (SetToolTag LatestNightly) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
fromVersion' (SetToolTag (Base pvp'')) GHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion' SetNext tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
next <- case tool of
@@ -760,7 +785,7 @@ fromVersion' SetNext tool = do
. sort
$ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo (_tvVersion next) tool dls
let vi = getVersionInfo next tool dls
pure (next, vi)
fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool
@@ -776,15 +801,15 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m
, MonadFail m
)
=> m [(Tool, Version)]
=> m [(Tool, GHCTargetVersion)]
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
forMM (getLatest dls t) $ \(l, _) -> do
@@ -799,7 +824,7 @@ checkForUpdates = do
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
logGHCPostRm ghcVer = do
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir

View File

@@ -57,6 +57,7 @@ import Text.Read (readEither)
data CompileCommand = CompileGHC GHCCompileOptions
| CompileHLS HLSCompileOptions
deriving (Eq, Show)
@@ -66,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: GHC.GHCVer Version
{ targetGhc :: GHC.GHCVer
, bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int
, buildConfig :: Maybe FilePath
@@ -76,9 +77,9 @@ data GHCCompileOptions = GHCCompileOptions
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String
, hadrian :: Bool
, buildSystem :: Maybe BuildSystem
, isolateDir :: Maybe FilePath
}
} deriving (Eq, Show)
data HLSCompileOptions = HLSCompileOptions
@@ -93,7 +94,7 @@ data HLSCompileOptions = HLSCompileOptions
, patches :: Maybe (Either FilePath [URI])
, targetGHCs :: [ToolVersion]
, cabalArgs :: [Text]
}
} deriving (Eq, Show)
@@ -170,7 +171,7 @@ ghcCompileOpts =
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile"
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
) <|>
(GHC.GitDist <$> (GitBranch <$> option
@@ -205,7 +206,7 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC"
<> help
"The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
<*> optional
(option
@@ -258,7 +259,7 @@ ghcCompileOpts =
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
)
<*> optional
@@ -268,16 +269,22 @@ ghcCompileOpts =
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
)
)
<*> switch
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
<*> (
(\b -> if b then Just Hadrian else Nothing) <$> switch
(long "hadrian" <> help "Use the hadrian build system instead of make. Tries to detect by default."
)
<|>
(\b -> if b then Just Make else Nothing) <$> switch
(long "make" <> help "Use the make build system instead of hadrian. Tries to detect by default."
)
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
)
)
@@ -291,7 +298,7 @@ hlsCompileOpts =
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The version to compile (pulled from hackage)"
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
)
)
<|>
@@ -311,7 +318,7 @@ hlsCompileOpts =
)
(long "source-dist" <> metavar "VERSION" <> help
"The version to compile (pulled from packaged git sources)"
<> (completer $ versionCompleter Nothing HLS)
<> (completer $ versionCompleter [] HLS)
)
))
<|>
@@ -343,7 +350,7 @@ hlsCompileOpts =
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing HLS)
<> (completer $ versionCompleter [] HLS)
)
)
<|>
@@ -360,7 +367,7 @@ hlsCompileOpts =
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
)
)
@@ -403,7 +410,7 @@ hlsCompileOpts =
option (eitherReader ghcVersionTagEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC [])
<> completer (versionCompleter Nothing GHC))
<> completer (versionCompleter [] GHC))
)
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@@ -453,6 +460,7 @@ type HLSEffects = '[ AlreadyInstalled
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
@@ -510,7 +518,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
case targetHLS of
HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
let vi = getVersionInfo (mkTVer targetVer) HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
@@ -530,7 +538,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
let vi = getVersionInfo (mkTVer targetVer) HLS dls
when setCompile $ void $ liftE $
setHLS targetVer SetHLSOnly Nothing
pure (vi, targetVer)
@@ -554,15 +562,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions {..}) ->
runCompileGHC runAppState (do
case targetGhc of
GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls
let vi = getVersionInfo (mkTVer targetVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
@@ -570,10 +575,8 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure ()
targetVer <- liftE $ compileGHC
((\case
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
GHC.GitDist g -> GHC.GitDist g
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
targetGhc
crossTarget
ovewrwiteVer
bootstrapGhc
jobs
@@ -581,10 +584,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
addConfArgs
buildFlavour
hadrian
buildSystem
(maybe GHCupInternal IsolateDir isolateDir)
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
let vi = getVersionInfo targetVer GHC dls
when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly Nothing
pure (vi, targetVer)

View File

@@ -52,6 +52,7 @@ data ConfigCommand
| SetConfig String (Maybe String)
| InitConfig
| AddReleaseChannel Bool URI
deriving (Eq, Show)

View File

@@ -47,7 +47,7 @@ data GCOptions = GCOptions
, gcHLSNoGHC :: Bool
, gcCache :: Bool
, gcTmp :: Bool
}
} deriving (Eq, Show)

View File

@@ -54,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
deriving (Eq, Show)
@@ -70,7 +71,7 @@ data InstallOptions = InstallOptions
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
}
} deriving (Eq, Show)
@@ -184,7 +185,7 @@ installOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool))
)
)
<*> (Just <$> toolVersionTagArgument Nothing tool)
<*> (Just <$> toolVersionTagArgument [] tool)
)
<|> pure (Nothing, Nothing)
)
@@ -196,7 +197,7 @@ installOpts tool =
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated dir instead of the default one"
<> help "install in an isolated absolute directory instead of the default one"
<> completer (bashCompleter "directory")
)
)
@@ -241,6 +242,7 @@ type InstallEffects = '[ AlreadyInstalled
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
@@ -284,6 +286,7 @@ type InstallGHCEffects = '[ AlreadyInstalled
, NotInstalled
, ProcessError
, TagNotFound
, DayNotFound
, TarDirDoesNotExist
, UninstallFailed
, UnknownArchive
@@ -322,7 +325,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
(_tvVersion v)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
@@ -333,8 +336,8 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
(_tvVersion v)
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
@@ -403,7 +406,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing)
(DownloadInfo uri Nothing "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -453,7 +456,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy
liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -502,7 +505,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing)
(DownloadInfo uri Nothing "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall

View File

@@ -2,6 +2,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
@@ -14,6 +15,7 @@ import GHCup
import GHCup.Prelude
import GHCup.Types
import GHCup.OptParse.Common
import GHCup.Prelude.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -24,7 +26,8 @@ import Data.Char
import Data.List ( intercalate, sort )
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Data.Time.Calendar ( Day )
import Data.Versions
import Data.Void
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
@@ -50,8 +53,12 @@ import qualified Text.Megaparsec.Char as MPC
data ListOptions = ListOptions
{ loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
, lFrom :: Maybe Day
, lTo :: Maybe Day
, lHideOld :: Bool
, lShowNightly :: Bool
, lRawFormat :: Bool
}
} deriving (Eq, Show)
@@ -60,7 +67,6 @@ data ListOptions = ListOptions
--[ Parsers ]--
---------------
listOpts :: Parser ListOptions
listOpts =
ListOptions
@@ -69,7 +75,7 @@ listOpts =
(eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all"
<> completer (toolCompleter)
<> completer toolCompleter
)
)
<*> optional
@@ -78,15 +84,53 @@ listOpts =
( short 'c'
<> long "show-criteria"
<> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions"
<> completer (listCompleter ["installed", "set", "available"])
<> help "Apply filtering criteria, prefix with + or -"
<> completer (listCompleter
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
)
)
<*> optional
(option
(eitherReader dayParser)
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date starting at YYYY-MM-DD or later"
<> completer toolCompleter
)
)
<*> optional
(option
(eitherReader dayParser)
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date earlier than YYYY-MM-DD"
<> completer toolCompleter
)
)
<*> switch
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
)
<*> switch
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
)
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
--------------
--[ Footer ]--
--------------
listToolFooter :: String
listToolFooter = [s|Discussion:
Lists tool versions with optional criteria.
Nightlies are by default hidden.
Examples:
# query nightlies in a specific range
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
# show all installed GHC versions
ghcup list -t ghc -c installed|]
-----------------
@@ -105,9 +149,11 @@ printListResult no_color raw lr = do
printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease"
printTag Nightly = color Red "nightly"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
printTag LatestPrerelease = color Red "latest-prerelease"
printTag LatestNightly = color Red "latest-nightly"
printTag Old = ""
let
@@ -134,8 +180,10 @@ printListResult no_color raw lr = do
then [color Green "hls-powered"]
else mempty
)
++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [color Blue (show d)])
++ (if lNoBindist
then [color Red "no-bindist"]
else mempty
@@ -260,7 +308,7 @@ list :: ( Monad m
-> m ExitCode
list ListOptions{..} no_color runAppState =
runAppState (do
l <- listVersions loTool lCriteria
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess
)

View File

@@ -76,8 +76,8 @@ nuke appState runLogger = do
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
forM_ lInstalled (liftE . rmTool)

View File

@@ -83,7 +83,7 @@ prefetchP = subparser
<$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
<*> optional (toolVersionTagArgument [] (Just GHC)) )
( progDesc "Download GHC assets for installation")
)
<>
@@ -92,7 +92,7 @@ prefetchP = subparser
(info
(PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
<*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation")
)
<>
@@ -101,7 +101,7 @@ prefetchP = subparser
(info
(PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
<*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation")
)
<>
@@ -110,7 +110,7 @@ prefetchP = subparser
(info
(PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
<*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation")
)
<>
@@ -148,6 +148,7 @@ Examples:
type PrefetchEffects = '[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NoDownload
@@ -194,7 +195,7 @@ prefetch prefetchCommand runAppState runLogger =
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
then liftE $ fetchGHCSrc v pfCacheDir
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')

View File

@@ -29,7 +29,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Data.Versions
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
@@ -50,6 +50,7 @@ data RmCommand = RmGHC RmOptions
| RmCabal Version
| RmHLS Version
| RmStack Version
deriving (Eq, Show)
@@ -61,7 +62,7 @@ data RmCommand = RmGHC RmOptions
data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion
}
} deriving (Eq, Show)
@@ -80,19 +81,19 @@ rmParser =
<> command
"cabal"
( RmCabal
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
(progDesc "Remove Cabal version")
)
<> command
"hls"
( RmHLS
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version")
)
<> command
"stack"
( RmStack
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
(progDesc "Remove stack version")
)
)
@@ -102,7 +103,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool
@@ -170,7 +171,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmGHCVer ghcVer
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
pure (getVersionInfo ghcVer GHC dls)
)
>>= \case
VRight vi -> do
@@ -186,7 +187,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmCabalVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Cabal dls)
pure (getVersionInfo (mkTVer tv) Cabal dls)
)
>>= \case
VRight vi -> do
@@ -201,7 +202,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmHLSVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv HLS dls)
pure (getVersionInfo (mkTVer tv) HLS dls)
)
>>= \case
VRight vi -> do
@@ -216,7 +217,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmStackVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Stack dls)
pure (getVersionInfo (mkTVer tv) Stack dls)
)
>>= \case
VRight vi -> do

View File

@@ -68,7 +68,7 @@ data RunOptions = RunOptions
, runBinDir :: Maybe FilePath
, runQuick :: Bool
, runCOMMAND :: [String]
}
} deriving (Eq, Show)
@@ -92,7 +92,7 @@ runOpts =
(eitherReader ghcVersionTagEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC [])
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
)
<*> optional
@@ -100,7 +100,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter Nothing Cabal)
<> (completer $ versionCompleter [] Cabal)
)
)
<*> optional
@@ -108,7 +108,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS [])
<> (completer $ versionCompleter Nothing HLS)
<> (completer $ versionCompleter [] HLS)
)
)
<*> optional
@@ -116,7 +116,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack [])
<> (completer $ versionCompleter Nothing Stack)
<> (completer $ versionCompleter [] Stack)
)
)
<*> optional
@@ -132,7 +132,7 @@ runOpts =
<*> switch
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@@ -175,6 +175,7 @@ type RunEffects = '[ AlreadyInstalled
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
@@ -282,6 +283,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
)
=> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] (ResourceT (ReaderT AppState m)) Toolchain
@@ -332,6 +334,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
-> FilePath
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, UnknownArchive
@@ -357,7 +360,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' GHC v
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
(_tvVersion v)
v
GHCupInternal
False
[]

View File

@@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Data.Versions
import GHC.Unicode
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
@@ -53,6 +53,7 @@ data SetCommand = SetGHC SetOptions
| SetCabal SetOptions
| SetHLS SetOptions
| SetStack SetOptions
deriving (Eq, Show)
@@ -64,7 +65,7 @@ data SetCommand = SetGHC SetOptions
data SetOptions = SetOptions
{ sToolVer :: SetToolVersion
}
} deriving (Eq, Show)
@@ -139,9 +140,9 @@ setParser =
setOpts :: Tool -> Parser SetOptions
setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$>
optional (setVersionArgument (Just ListInstalled) tool))
optional (setVersionArgument [ListInstalled True] tool))
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
setVersionArgument criteria tool =
argument (eitherReader setEither)
(metavar "VERSION|TAG|next"
@@ -184,6 +185,7 @@ setFooter = [s|Discussion:
type SetGHCEffects = '[ FileDoesNotExistError
, NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -198,6 +200,7 @@ runSetGHC runAppState =
type SetCabalEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -212,6 +215,7 @@ runSetCabal runAppState =
type SetHLSEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -226,6 +230,7 @@ runSetHLS runAppState =
type SetStackEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]

View File

@@ -112,7 +112,7 @@ testOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool))
)
)
<*> (Just <$> toolVersionTagArgument Nothing tool)
<*> (Just <$> toolVersionTagArgument [] tool)
)
<|> pure (Nothing, Nothing)
)
@@ -140,6 +140,7 @@ type TestGHCEffects = [ DigestError
, TestFailed
, NextVerNotFound
, TagNotFound
, DayNotFound
, NoToolVersionSet
]
@@ -168,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
(case testBindist of
Nothing -> runTestGHC s' $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCVer (_tvVersion v) addMakeArgs
liftE $ testGHCVer v addMakeArgs
pure vi
Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
pure vi
)
>>= \case

View File

@@ -48,6 +48,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
| UnsetCabal UnsetOptions
| UnsetHLS UnsetOptions
| UnsetStack UnsetOptions
deriving (Eq, Show)
@@ -59,7 +60,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
data UnsetOptions = UnsetOptions
{ sToolVer :: Maybe T.Text -- target platform triple
}
} deriving (Eq, Show)
@@ -68,7 +69,7 @@ data UnsetOptions = UnsetOptions
--[ Parsers ]--
---------------
unsetParser :: Parser UnsetCommand
unsetParser =
subparser
@@ -113,7 +114,14 @@ unsetParser =
unsetGHCFooter :: String
unsetGHCFooter = [s|Discussion:
Unsets the the current GHC version. That means there won't
be a ~/.ghcup/bin/ghc anymore.|]
be a ~/.ghcup/bin/ghc anymore.
Examples:
# unset ghc
ghcup unset ghc
# unset ghc for the target version
ghcup unset ghc armv7-unknown-linux-gnueabihf|]
unsetCabalFooter :: String
unsetCabalFooter = [s|Discussion:

View File

@@ -35,7 +35,7 @@ import System.Environment
import GHCup.Utils
import System.FilePath
import GHCup.Types.Optics
import Data.Versions hiding (str)
import Data.Versions
@@ -50,7 +50,7 @@ import Data.Versions hiding (str)
data UpgradeOpts = UpgradeInplace
| UpgradeAt FilePath
| UpgradeGHCupDir
deriving Show
deriving (Eq, Show)

View File

@@ -54,6 +54,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
| WhereisCacheDir
| WhereisLogsDir
| WhereisConfDir
deriving (Eq, Show)
@@ -66,7 +67,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
data WhereisOptions = WhereisOptions {
directory :: Bool
}
} deriving (Eq, Show)
@@ -82,7 +83,7 @@ whereisP = subparser
command
"ghc"
(WhereisTool GHC <$> info
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter ))
)
@@ -90,7 +91,7 @@ whereisP = subparser
command
"cabal"
(WhereisTool Cabal <$> info
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter ))
)
@@ -98,7 +99,7 @@ whereisP = subparser
command
"hls"
(WhereisTool HLS <$> info
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter ))
)
@@ -106,7 +107,7 @@ whereisP = subparser
command
"stack"
(WhereisTool Stack <$> info
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter ))
)
@@ -222,6 +223,7 @@ type WhereisEffects = '[ NotInstalled
, NoToolVersionSet
, NextVerNotFound
, TagNotFound
, DayNotFound
]

View File

@@ -134,15 +134,24 @@ rmTool :: ( MonadReader env m
=> ListResult
-> Excepts '[NotInstalled, UninstallFailed] m ()
rmTool ListResult {lVer, lTool, lCross} = do
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
let printRmTool = logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
case lTool of
GHC ->
GHC -> do
let ghcTargetVersion = GHCTargetVersion lCross lVer
in rmGHCVer ghcTargetVersion
HLS -> rmHLSVer lVer
Cabal -> liftE $ rmCabalVer lVer
Stack -> liftE $ rmStackVer lVer
GHCup -> lift rmGhcup
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
rmGHCVer ghcTargetVersion
HLS -> do
printRmTool
rmHLSVer lVer
Cabal -> do
printRmTool
liftE $ rmCabalVer lVer
Stack -> do
printRmTool
liftE $ rmStackVer lVer
GHCup -> do
printRmTool
lift rmGhcup
rmGhcupDirs :: ( MonadReader env m
@@ -303,7 +312,7 @@ upgradeGHCup mtarget force' fatal = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ logInfo "Upgrading GHCup..."
let latestVer = fst (fromJust (getLatest dls GHCup))
let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -492,7 +501,7 @@ rmOldGHC :: ( MonadReader env m
=> Excepts '[NotInstalled, UninstallFailed] m ()
rmOldGHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls
let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls
ghcs <- lift $ fmap rights getInstalledGHCs
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc

View File

@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
@@ -280,6 +281,6 @@ rmCabalVer ver = do
when (Just ver == cSet) $ do
cVers <- lift $ fmap rights getInstalledCabals
case headMay . reverse . sort $ cVers of
case headMay . sortBy (comparing Down) $ cVers of
Just latestver -> setCabal latestver
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)

View File

@@ -271,7 +271,6 @@ getBase uri = do
pure f
getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
@@ -283,8 +282,21 @@ getDownloadInfo :: ( MonadReader env m
'[NoDownload]
m
DownloadInfo
getDownloadInfo t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
getDownloadInfo t v = getDownloadInfo' t (mkTVer v)
getDownloadInfo' :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
)
=> Tool
-> GHCTargetVersion
-- ^ tool version
-> Excepts
'[NoDownload]
m
DownloadInfo
getDownloadInfo' t v = do
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let distro_preview f g =
@@ -305,7 +317,7 @@ getDownloadInfo t v = do
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
maybe
(throwE NoDownload)
(throwE $ NoDownload v t (Just pfreq))
pure
(case p of
-- non-musl won't work on alpine
@@ -633,7 +645,9 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing
False -> do
tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
where
outputFileName = mfn <|> _dlOutput dli
downloadCached' :: ( MonadReader env m
@@ -652,7 +666,7 @@ downloadCached' :: ( MonadReader env m
downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile
if
@@ -660,7 +674,9 @@ downloadCached' dli mfn mDestDir = do
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
where
outputFileName = mfn <|> _dlOutput dli

View File

@@ -38,6 +38,7 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import Data.Data (Proxy(..))
import Data.Time (Day)
@@ -59,6 +60,7 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy CopyError in format proxy
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
, let proxy = Proxy :: Proxy TagNotFound in format proxy
, let proxy = Proxy :: Proxy DayNotFound in format proxy
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
@@ -204,12 +206,26 @@ instance HFErrorProject NoCompatiblePlatform where
eDesc _ = "No compatible platform could be found"
-- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
| NoDownload' GlobalTool
deriving Show
instance Pretty NoDownload where
pPrint NoDownload =
text (eDesc (Proxy :: Proxy NoDownload))
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
| (Just target) <- mtarget
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
= text $ "Unable to find a download for "
<> show tool
<> " version '"
<> T.unpack (tVerToText tver)
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
<> "Perhaps you meant: 'ghcup <command> "
<> T.unpack target
<> " "
<> T.unpack (prettyVer vv)
<> "'"
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
instance HFErrorProject NoDownload where
eBase _ = 10
@@ -311,6 +327,21 @@ instance HFErrorProject TagNotFound where
eBase _ = 90
eDesc _ = "Unable to find a tag of a tool"
-- | Unable to find a release day of a tool
data DayNotFound = DayNotFound Day Tool (Maybe Day)
deriving Show
instance Pretty DayNotFound where
pPrint (DayNotFound day tool Nothing) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
pPrint (DayNotFound day tool (Just alternateDay)) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
text "but found an alternative date" <+> text (show alternateDay)
instance HFErrorProject DayNotFound where
eBase _ = 95
eDesc _ = "Unable to find a release date of a tool"
-- | Unable to find the next version of a tool (the one after the currently
-- set one).
data NextVerNotFound = NextVerNotFound Tool

View File

@@ -80,9 +80,10 @@ import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
data GHCVer v = SourceDist v
| GitDist GitBranch
| RemoteDist URI
data GHCVer = SourceDist Version
| GitDist GitBranch
| RemoteDist URI
deriving (Eq, Show)
@@ -105,7 +106,7 @@ testGHCVer :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> Version
=> GHCTargetVersion
-> [T.Text]
-> Excepts
'[ DigestError
@@ -125,7 +126,7 @@ testGHCVer ver addMakeArgs = do
dlInfo <-
preview (ix GHC % ix ver % viTestDL % _Just) dls
?? NoDownload
?? NoDownload ver GHC Nothing
liftE $ testGHCBindist dlInfo ver addMakeArgs
@@ -145,7 +146,7 @@ testGHCBindist :: ( MonadFail m
, MonadUnliftIO m
)
=> DownloadInfo
-> Version
-> GHCTargetVersion
-> [T.Text]
-> Excepts
'[ DigestError
@@ -182,7 +183,7 @@ testPackedGHC :: ( MonadMask m
)
=> FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive
-> Version -- ^ The GHC version
-> GHCTargetVersion -- ^ The GHC version
-> [T.Text] -- ^ additional make args
-> Excepts
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
@@ -208,19 +209,21 @@ testUnpackedGHC :: ( MonadReader env m
, MonadIO m
)
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
-> Version -- ^ The GHC version
-> GHCTargetVersion -- ^ The GHC version
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError] m ()
testUnpackedGHC path ver addMakeArgs = do
lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!"
ghcDir <- lift $ ghcupGHCDir (mkTVer ver)
testUnpackedGHC path tver addMakeArgs = do
lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
ghcDir <- lift $ ghcupGHCDir tver
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
env <- liftIO $ addToPath ghcBinDir False
lEM $ make' (fmap T.unpack addMakeArgs)
(Just $ fromGHCupPath path)
"ghc-test"
(Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env)
(Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver)
<> "ghc-"
<> T.unpack (prettyVer $ _tvVersion tver)) : env)
pure ()
@@ -243,7 +246,7 @@ fetchGHCSrc :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> Version
=> GHCTargetVersion
-> Maybe FilePath
-> Excepts
'[ DigestError
@@ -258,7 +261,7 @@ fetchGHCSrc v mfp = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix v % viSourceDL % _Just) dls
?? NoDownload
?? NoDownload v GHC Nothing
liftE $ downloadCached' dlInfo Nothing mfp
@@ -283,7 +286,7 @@ installGHCBindist :: ( MonadFail m
, MonadUnliftIO m
)
=> DownloadInfo -- ^ where/how to download
-> Version -- ^ the version to install
-> GHCTargetVersion -- ^ the version to install
-> InstallDir
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
@@ -306,10 +309,8 @@ installGHCBindist :: ( MonadFail m
]
m
()
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
let tver = mkTVer ver
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
regularGHCInstalled <- lift $ ghcInstalled tver
@@ -317,7 +318,7 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
| not forceInstall
, regularGHCInstalled
, GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled GHC ver
throwE $ AlreadyInstalled GHC (_tvVersion tver)
| forceInstall
, regularGHCInstalled
@@ -336,12 +337,12 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
case installDir of
IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
GHCupInternal -> do -- regular install
-- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
-- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver
@@ -375,7 +376,7 @@ installPackedGHC :: ( MonadMask m
=> FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive
-> InstallDirResolved
-> Version -- ^ The GHC version
-> GHCTargetVersion -- ^ The GHC version
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts
@@ -423,26 +424,22 @@ installUnpackedGHC :: ( MonadReader env m
)
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> InstallDirResolved -- ^ Path to install to
-> Version -- ^ The GHC version
-> GHCTargetVersion -- ^ The GHC version
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC path inst ver forceInstall addConfArgs
installUnpackedGHC path inst tver forceInstall addConfArgs
| isWindows = do
lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need
-- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> do
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
liftIO $ moveFilePortable source dest
forM_ mtime $ liftIO . setModificationTime dest
liftE $ mergeGHCFileTree path inst tver forceInstall
| otherwise = do
PlatformRequest {..} <- lift getPlatformReq
let ldOverride
| ver >= [vver|8.2.2|]
| _tvVersion tver >= [vver|8.2.2|]
, _rPlatform `elem` [Linux Alpine, Darwin]
= ["--disable-ld-override"]
| otherwise
@@ -451,7 +448,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst)
: (ldOverride <> (T.unpack <$> addConfArgs))
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
)
(Just $ fromGHCupPath path)
"ghc-configure"
@@ -459,17 +456,44 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall
pure ()
mergeGHCFileTree :: ( MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadUnliftIO m
, MonadMask m
, MonadResource m
, MonadFail m
)
=> GHCupPath -- ^ Path to the root of the tree
-> InstallDirResolved -- ^ Path to install to
-> GHCTargetVersion -- ^ The GHC version
-> Bool -- ^ Force install
-> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree root inst tver forceInstall
| isWindows = do
liftE $ mergeFileTree root inst GHC tver $ \source dest -> do
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
liftIO $ moveFilePortable source dest
forM_ mtime $ liftIO . setModificationTime dest
| otherwise = do
liftE $ mergeFileTree root
inst
GHC
(mkTVer ver)
tver
(\f t -> liftIO $ do
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
install f t (not forceInstall)
forM_ mtime $ setModificationTime t)
pure ()
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
-- following symlinks in @~\/.ghcup\/bin@:
@@ -489,7 +513,7 @@ installGHCBin :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> Version -- ^ the version to install
=> GHCTargetVersion -- ^ the version to install
-> InstallDir
-> Bool -- ^ force install
-> [T.Text] -- ^ additional configure args for bindist
@@ -512,9 +536,9 @@ installGHCBin :: ( MonadFail m
]
m
()
installGHCBin ver installDir forceInstall addConfArgs = do
dlinfo <- liftE $ getDownloadInfo GHC ver
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
installGHCBin tver installDir forceInstall addConfArgs = do
dlinfo <- liftE $ getDownloadInfo' GHC tver
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
@@ -708,7 +732,7 @@ rmGHCVer ver = do
Just files -> do
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
removeEmptyDirsRecursive dir
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
f <- recordedInstallationFile GHC ver
lift $ recycleFile f
@@ -755,7 +779,8 @@ compileGHC :: ( MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> GHCVer GHCTargetVersion
=> GHCVer
-> Maybe Text -- ^ cross target
-> Maybe Version -- ^ overwrite version
-> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs
@@ -763,7 +788,7 @@ compileGHC :: ( MonadMask m
-> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour
-> Bool
-> Maybe BuildSystem
-> InstallDir
-> Excepts
'[ AlreadyInstalled
@@ -792,20 +817,21 @@ compileGHC :: ( MonadMask m
]
m
GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
= do
PlatformRequest { .. } <- lift getPlatformReq
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
(workdir, tmpUnpack, tver) <- case targetGhc of
-- unpack from version tarball
SourceDist tver -> do
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
SourceDist ver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
-- download source tarball
let tver = mkTVer ver
dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
preview (ix GHC % ix tver % viSourceDL % _Just) dls
?? NoDownload tver GHC (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
@@ -818,7 +844,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
(view dlSubdir dlInfo)
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
pure (workdir, tmpUnpack, Just tver)
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -842,7 +868,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
pure (workdir, tmpUnpack, mkTVer <$> tver)
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
-- clone from git
GitDist GitBranch{..} -> do
@@ -899,12 +925,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
pure tver
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
installVer <- if | Just ov' <- ov -> pure (mkTVer ov')
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
| Just tver' <- tver -> pure tver'
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
| otherwise -> fail "No GHC version given and couldn't detect version. Giving up..."
alreadyInstalled <- lift $ ghcInstalled installVer
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
@@ -923,16 +949,31 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
(mBindist, bmk) <- liftE $ runBuildAction
mBindist <- liftE $ runBuildAction
tmpUnpack
(do
b <- if hadrian
-- prefer 'tver', because the real version carries out compatibility checks
-- we don't want the user to do funny things with it
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
pure (b, bmk)
-- prefer 'tver', because the real version carries out compatibility checks
-- we don't want the user to do funny things with it
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
case buildSystem of
Just Hadrian -> do
lift $ logInfo "Requested to use Hadrian"
liftE doHadrian
Just Make -> do
lift $ logInfo "Requested to use Make"
doMake
Nothing -> do
supportsHadrian <- liftE $ catchE @HadrianNotFound @'[HadrianNotFound] @'[] (\_ -> return False)
$ fmap (const True)
$ findHadrianFile (fromGHCupPath workdir)
if supportsHadrian
then do
lift $ logInfo "Detected Hadrian"
liftE doHadrian
else do
lift $ logInfo "Detected Make"
doMake
)
case installDir of
@@ -948,12 +989,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
liftE $ installPackedGHC bindist
(Just $ RegexDir "ghc-.*")
ghcdir
(installVer ^. tvVersion)
installVer
False -- not a force install, since we already overwrite when compiling.
[]
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
case installDir of
-- set and make symlinks for regular (non-isolated) installs
GHCupInternal -> do
@@ -976,20 +1015,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
=> GHCupPath
-> Excepts '[ProcessError, ParseError] m Version
getGHCVer tmpUnpack = do
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
CapturedProcess {..} <- lift $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
case _exitCode of
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
hasVersionFile <- liftIO $ doesFileExist versionFile
if hasVersionFile
then do
lift $ logDebug "Detected VERSION file, trying to extract"
contents <- liftIO $ readFile versionFile
either (throwE . ParseError . show) pure . MP.parse version' "" . T.pack . stripNewlineEnd $ contents
else do
lift $ logDebug "Didn't detect VERSION file, trying to extract via legacy 'make'"
CapturedProcess {..} <- lift $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
case _exitCode of
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
defaultConf =
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
in case targetGhc of
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
_ -> default_mk
in case crossTarget of
Just _ -> cross_mk
_ -> default_mk
compileHadrianBindist :: ( MonadReader env m
, HasDirs env
@@ -1015,18 +1063,17 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
m
(Maybe FilePath) -- ^ output path of bindist, None for cross
compileHadrianBindist tver workdir ghcdir = do
lEM $ execWithGhcEnv "python3" ["./boot"] (Just workdir) "ghc-bootstrap"
liftE $ configureBindist tver workdir ghcdir
lift $ logInfo "Building (this may take a while)..."
hadrian_build <- liftE $ findHadrianFile workdir
lEM $ execWithGhcEnv hadrian_build
lEM $ execLogged hadrian_build
( maybe [] (\j -> ["-j" <> show j] ) jobs
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
++ ["binary-dist"]
)
(Just workdir) "ghc-make"
Nothing
[tar] <- liftIO $ findFiles
(workdir </> "_build" </> "bindist")
(makeRegexOpts compExtended
@@ -1059,6 +1106,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
, MonadResource m
)
=> GHCTargetVersion
-> FilePath
@@ -1070,6 +1120,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
, PatchFailed
, ProcessError
, NotFoundInPATH
, MergeFileTreeError
, CopyError]
m
(Maybe FilePath) -- ^ output path of bindist, None for cross
@@ -1091,7 +1142,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
if | isCross tver -> do
lift $ logInfo "Installing cross toolchain..."
lEM $ make ["install"] (Just workdir)
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just workdir)
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir ghcdir)) ghcdir tver True
pure Nothing
| otherwise -> do
lift $ logInfo "Creating bindist..."
@@ -1164,8 +1217,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
-- for cross, we need Stage1Only
case targetGhc of
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
case crossTarget of
Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
(InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
)
@@ -1209,64 +1262,50 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
()
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
lift $ logInfo [s|configuring build|]
if | _tvVersion tver >= [vver|8.8.0|] -> do
lEM $ execWithGhcEnv
"sh"
("./configure" : maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
"ghc-conf"
| otherwise -> do
lEM $ execLogged
"sh"
( [ "./configure", "--with-ghc=" <> either id id bghc
]
++ maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
"ghc-conf"
Nothing
lEM $ configureWithGhcBoot (Just tver)
(maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
"ghc-conf"
pure ()
execWithGhcEnv :: ( MonadReader env m
, HasSettings env
, HasDirs env
, HasLog env
, MonadIO m
, MonadThrow m)
=> FilePath -- ^ thing to execute
-> [String] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
-> FilePath -- ^ log filename (opened in append mode)
-> m (Either ProcessError ())
execWithGhcEnv fp args dir logf = do
env <- ghcEnv
execLogged fp args dir logf (Just env)
configureWithGhcBoot :: ( MonadReader env m
, HasSettings env
, HasDirs env
, HasLog env
, MonadIO m
, MonadThrow m)
=> Maybe GHCTargetVersion
-> [String] -- ^ args for configure
-> Maybe FilePath -- ^ optionally chdir into this
-> FilePath -- ^ log filename (opened in append mode)
-> m (Either ProcessError ())
configureWithGhcBoot mtver args dir logf = do
let execNew = execLogged
"sh"
("./configure" : ("GHC=" <> bghc) : args)
dir
logf
Nothing
execOld = execLogged
"sh"
("./configure" : ("--with-ghc=" <> bghc) : args)
dir
logf
Nothing
if | Just tver <- mtver
, _tvVersion tver >= [vver|8.8.0|] -> execNew
| Nothing <- mtver -> execNew -- need some default for git checkouts where we don't know yet
| otherwise -> execOld
bghc = case bstrap of
Right g -> Right g
Left bver -> Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
ghcEnv = do
cEnv <- liftIO getEnvironment
bghcPath <- case bghc of
Right ghc' -> pure ghc'
Left bver -> do
spaths <- liftIO getSearchPath
throwMaybeM (NotFoundInPATH bver) $ liftIO (searchPath spaths bver)
pure (("GHC", bghcPath) : cEnv)
Right g -> g
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt

View File

@@ -43,6 +43,7 @@ import Control.Monad.Trans.Resource
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.String ( fromString )
import Data.Text ( Text )
@@ -74,6 +75,7 @@ data HLSVer = SourceDist Version
| GitDist GitBranch
| HackageDist Version
| RemoteDist URI
deriving (Eq, Show)
@@ -353,7 +355,7 @@ compileHLS :: ( MonadMask m
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
PlatformRequest { .. } <- lift getPlatformReq
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
@@ -368,8 +370,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
-- download source tarball
dlInfo <-
preview (ix HLS % ix tver % viSourceDL % _Just) dls
?? NoDownload
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
?? NoDownload (mkTVer tver) HLS (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
@@ -704,7 +706,7 @@ rmHLSVer ver = do
when (Just ver == isHlsSet) $ do
-- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs
case headMay . reverse . sort $ hlsVers of
case headMay . sortBy (comparing Down) $ hlsVers of
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
Nothing -> pure ()
@@ -715,8 +717,10 @@ getCabalVersion fp = do
gpd <- case parseGenericPackageDescriptionMaybe contents of
Nothing -> fail $ "could not parse cabal file: " <> fp
Just r -> pure r
let tver = (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
let tver = (\c -> Version Nothing c Nothing Nothing)
. Chunks
. NE.fromList
. fmap (Numeric . fromIntegral)
. versionNumbers
. pkgVersion
. package

View File

@@ -36,6 +36,7 @@ import Data.Either
import Data.List
import Data.Maybe
import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
import Optics
@@ -61,10 +62,10 @@ import qualified Data.Text as T
-- | Filter data type for 'listVersions'.
data ListCriteria = ListInstalled
| ListSet
| ListAvailable
deriving Show
data ListCriteria = ListInstalled Bool
| ListSet Bool
| ListAvailable Bool
deriving (Eq, Show)
-- | A list result describes a single tool version
-- and various of its properties.
@@ -75,16 +76,16 @@ data ListResult = ListResult
, lTag :: [Tag]
, lInstalled :: Bool
, lSet :: Bool -- ^ currently active version
, fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
, hlsPowered :: Bool
, lReleaseDay :: Maybe Day
}
deriving (Eq, Ord, Show)
-- | Extract all available tool versions and their tags.
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo
availableToolVersions av tool = view
(at tool % non Map.empty)
av
@@ -93,19 +94,22 @@ availableToolVersions av tool = view
-- | List all versions from the download info, as well as stray
-- versions.
listVersions :: ( MonadCatch m
, HasLog env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
-> Maybe ListCriteria
-> m [ListResult]
listVersions lt' criteria = do
, HasLog env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
listVersions lt' criteria hideOld showNightly days = do
-- some annoying work to avoid too much repeated IO
cSet <- cabalSet
cabals <- getInstalledCabals
@@ -129,13 +133,13 @@ listVersions lt' criteria = do
slr <- strayGHCs avTools
pure (sort (slr ++ lr))
Cabal -> do
slr <- strayCabals avTools cSet cabals
slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals
pure (sort (slr ++ lr))
HLS -> do
slr <- strayHLS avTools hlsSet' hlses
slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses
pure (sort (slr ++ lr))
Stack -> do
slr <- strayStacks avTools sSet stacks
slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks
pure (sort (slr ++ lr))
GHCup -> do
let cg = maybeToList $ currentGHCup avTools
@@ -154,42 +158,28 @@ listVersions lt' criteria = do
, HasLog env
, MonadIO m
)
=> Map.Map Version VersionInfo
=> Map.Map GHCTargetVersion VersionInfo
-> m [ListResult]
strayGHCs avTools = do
ghcs <- getInstalledGHCs
fmap catMaybes $ forM ghcs $ \case
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
case Map.lookup _tvVersion avTools of
Right tver@GHCTargetVersion{ .. } -> do
case Map.lookup tver avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
fromSrc <- ghcSrcInstalled tver
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = Nothing
, lCross = _tvTarget
, lTag = []
, lInstalled = True
, lStray = isNothing (Map.lookup _tvVersion avTools)
, lStray = isNothing (Map.lookup tver avTools)
, lNoBindist = False
, lReleaseDay = Nothing
, ..
}
Right tver@GHCTargetVersion{ .. } -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = _tvTarget
, lTag = []
, lInstalled = True
, lStray = True -- NOTE: cross currently cannot be installed via bindist
, lNoBindist = False
, ..
}
Left e -> do
logWarn
$ "Could not parse version of stray directory" <> T.pack e
@@ -221,8 +211,8 @@ listVersions lt' criteria = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -255,8 +245,8 @@ listVersions lt' criteria = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -290,8 +280,8 @@ listVersions lt' criteria = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -299,24 +289,24 @@ listVersions lt' criteria = do
$ "Could not parse version of stray directory" <> T.pack e
pure Nothing
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult
currentGHCup av =
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer ""
listVer = Map.lookup currentVer av
latestVer = fst <$> headOf (getTagged Latest) av
recommendedVer = fst <$> headOf (getTagged Latest) av
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
in if | Map.member currentVer av -> Nothing
| otherwise -> Just $ ListResult { lVer = currentVer
| otherwise -> Just $ ListResult { lVer = _tvVersion currentVer
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
, lCross = Nothing
, lTool = GHCup
, fromSrc = False
, lStray = isNothing listVer
, lSet = True
, lInstalled = True
, lNoBindist = False
, hlsPowered = False
, lReleaseDay = Nothing
}
-- NOTE: this are not cross ones, because no bindists
@@ -335,42 +325,41 @@ listVersions lt' criteria = do
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> (Version, VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do
let v = _tvVersion tver
case t of
GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
let tver = mkTVer v
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem v) hlsGHCVersions
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
Cabal -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
let lSet = cSet == Just v
let lInstalled = elem v $ rights cabals
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
GHCup -> do
let lSet = prettyPVP ghcUpVer == prettyVer v
let lInstalled = lSet
pure ListResult { lVer = v
, lTag = tags
, lTag = _viTags
, lCross = Nothing
, lTool = t
, fromSrc = False
, lStray = False
, lNoBindist = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
HLS -> do
@@ -379,11 +368,11 @@ listVersions lt' criteria = do
let lInstalled = elem v $ rights hlses
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
Stack -> do
@@ -392,19 +381,42 @@ listVersions lt' criteria = do
let lInstalled = elem v $ rights stacks
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
filter' :: [ListResult] -> [ListResult]
filter' lr = case criteria of
Nothing -> lr
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
Just ListSet -> filter (\ListResult {..} -> lSet) lr
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
filterDays :: [ListResult] -> [ListResult]
filterDays lrs = case days of
(Nothing, Nothing) -> lrs
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
fromCriteria :: ListCriteria -> ListResult -> Bool
fromCriteria lc ListResult{..} = case lc of
ListInstalled b -> f b lInstalled
ListSet b -> f b lSet
ListAvailable b -> f b $ not lNoBindist
where
f b
| b = id
| otherwise = not
filterOld :: [ListResult] -> [ListResult]
filterOld lr
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
| otherwise = lr
filterNightly :: [ListResult] -> [ListResult]
filterNightly lr
| showNightly = lr
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr

View File

@@ -77,8 +77,14 @@ runBothE' a1 a2 = do
(_ , VLeft e ) -> throwSomeE e
(VRight _, VRight _) -> pure ()
-- "throwSomeE" function has been upstreamed in haskus-utils-variant-3.3
-- So, only conditionally include this shim if
-- haskus-utils-variant version is < 3.3
#if MIN_VERSION_haskus_utils_variant(3,3,0)
#else
-- | Throw some exception
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
{-# INLINABLE throwSomeE #-}
throwSomeE = Excepts . pure . VLeft . liftVariant
#endif

View File

@@ -91,18 +91,16 @@ ghcTargetVerP =
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigists =
let startsWithDigits =
and
. take 3
. concatMap
(map
(\case
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. map (\case
Numeric _ -> True
Alphanum _ -> False)
. NE.toList
. (\(Chunks nec) -> nec)
$ _vChunks v
if startsWithDigists && isNothing (_vEpoch v)
if startsWithDigits && isNothing (_vEpoch v)
then pure $ prettyVer v
else fail "Oh"

View File

@@ -26,36 +26,14 @@ import GHC.Base
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( Lift
, dataToExpQ
)
import Language.Haskell.TH.Syntax ( dataToExpQ )
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
deriving instance Data Versioning
deriving instance Lift Versioning
deriving instance Data Version
deriving instance Lift Version
deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
@@ -279,6 +280,6 @@ rmStackVer ver = do
when (Just ver == sSet) $ do
sVers <- lift $ fmap rights getInstalledStacks
case headMay . reverse . sort $ sVers of
case headMay . sortBy (comparing Down) $ sVers of
Just latestver -> setStack latestver
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)

View File

@@ -31,6 +31,7 @@ import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.DeepSeq ( NFData, rnf )
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Time.Calendar ( Day )
import Data.Text ( Text )
import Data.Versions
import GHC.IO.Exception ( ExitCode )
@@ -44,7 +45,8 @@ import Graphics.Vty ( Key(..) )
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified GHC.Generics as GHC
import qualified Data.List.NonEmpty as NE
import Data.Foldable (foldMap)
#if !defined(BRICK)
data Key = KEsc | KChar Char | KBS | KEnter
@@ -103,7 +105,7 @@ instance NFData Requirements
-- | Description of all binary and source downloads. This is a tree
-- of nested maps.
type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map Version VersionInfo
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
@@ -131,11 +133,15 @@ data GlobalTool = ShimGen
instance NFData GlobalTool
instance Pretty GlobalTool where
pPrint ShimGen = text "shimgen"
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viReleaseDay :: Maybe Day
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
@@ -151,11 +157,17 @@ instance NFData VersionInfo
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest
| Recommended
| Prerelease
| LatestPrerelease
| Base PVP
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
| Recommended -- ^ the recommended version of a tool (unique per tool)
| Prerelease -- ^ denotes a prerelease version
-- (a version should either be 'Prerelease' or
-- 'LatestPrerelease', but not both)
| LatestPrerelease -- ^ the latest prerelease (unique per tool)
| Nightly -- ^ denotes a nightly version
-- (a version should either be 'Nightly' or
-- 'LatestNightly', but not both)
| LatestNightly -- ^ the latest nightly (unique per tool)
| Base PVP -- ^ the base version shipped with GHC
| Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -166,18 +178,22 @@ tagToString :: Tag -> String
tagToString Recommended = "recommended"
tagToString Latest = "latest"
tagToString Prerelease = "prerelease"
tagToString Nightly = "nightly"
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
tagToString (UnknownTag t ) = t
tagToString LatestPrerelease = "latest-prerelease"
tagToString LatestNightly = "latest-nightly"
tagToString Old = ""
instance Pretty Tag where
pPrint Recommended = text "recommended"
pPrint Latest = text "latest"
pPrint Prerelease = text "prerelease"
pPrint Nightly = text "nightly"
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t
pPrint LatestPrerelease = text "latest-prerelease"
pPrint LatestNightly = text "latest-prerelease"
pPrint Old = mempty
data Architecture = A_64
@@ -267,6 +283,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir
, _dlHash :: Text
, _dlCSize :: Maybe Integer
, _dlOutput :: Maybe FilePath
}
deriving (Eq, Ord, GHC.Generic, Show)
@@ -584,7 +601,9 @@ data GHCTargetVersion = GHCTargetVersion
{ _tvTarget :: Maybe Text
, _tvVersion :: Version
}
deriving (Ord, Eq, Show)
deriving (Ord, Eq, Show, GHC.Generic)
instance NFData GHCTargetVersion
data GitBranch = GitBranch
{ ref :: String
@@ -623,6 +642,17 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
instance NFData VersionRange
instance Pretty VersionCmp where
pPrint (VR_gt v) = text "> " <> pPrint v
pPrint (VR_gteq v) = text ">= " <> pPrint v
pPrint (VR_lt v) = text "< " <> pPrint v
pPrint (VR_lteq v) = text "<= " <> pPrint v
pPrint (VR_eq v) = text "= " <> pPrint v
instance Pretty VersionRange where
pPrint (SimpleRange xs) = foldl1 (\x y -> x <> text " && " <> y) $ NE.map pPrint xs
pPrint (OrRange xs vr) = foldMap pPrint xs <> " || " <> pPrint vr
instance Pretty Versioning where
pPrint = text . T.unpack . prettyV
@@ -694,3 +724,21 @@ type PromptQuestion = Text
data PromptResponse = PromptYes | PromptNo
deriving (Show, Eq)
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
| ToolDay Day
deriving (Eq, Show)
instance Pretty ToolVersion where
pPrint (GHCVersion v) = pPrint v
pPrint (ToolVersion v) = pPrint v
pPrint (ToolTag t) = pPrint t
pPrint (ToolDay d) = text (show d)
data BuildSystem = Hadrian
| Make
deriving (Show, Eq)

View File

@@ -48,10 +48,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
@@ -64,9 +65,11 @@ instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease"
toJSON Nightly = String "Nightly"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON LatestPrerelease = String "LatestPrerelease"
toJSON LatestNightly = String "LatestNightly"
toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where
@@ -74,7 +77,9 @@ instance FromJSON Tag where
"Latest" -> pure Latest
"Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease
"Nightly" -> pure Nightly
"LatestPrerelease" -> pure LatestPrerelease
"LatestNightly" -> pure LatestNightly
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
@@ -91,13 +96,29 @@ instance FromJSON URI where
Right x -> pure x
Left e -> fail . show $ e
instance ToJSON GHCTargetVersion where
toJSON = toJSON . tVerToText
instance FromJSON GHCTargetVersion where
parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey GHCTargetVersion where
toJSONKey = toJSONKeyText $ \x -> tVerToText x
instance FromJSONKey GHCTargetVersion where
fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
instance ToJSON Versioning where
toJSON = toJSON . prettyV
instance FromJSON Versioning where
parseJSON = withText "Versioning" $ \t -> case versioning t of
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey Versioning where
toJSONKey = toJSONKeyText $ \x -> prettyV x

View File

@@ -62,7 +62,6 @@ import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Char ( isHexDigit )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
@@ -94,6 +93,7 @@ import qualified Streamly.Prelude as S
import Control.DeepSeq (force)
import GHC.IO (evaluate)
import System.Environment (getEnvironment, setEnv)
import Data.Time (Day(..), diffDays, addDays)
-- $setup
@@ -119,11 +119,11 @@ import System.Environment (getEnvironment, setEnv)
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
@@ -288,13 +288,6 @@ ghcInstalled ver = do
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
-- | Whether the given GHC version is installed from source.
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesFileExist (fromGHCupPath ghcdir </> ghcUpSrcBuiltFile)
-- | Whether the given GHC version is set as the current.
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
@@ -694,10 +687,8 @@ hlsAllBinaries ver = do
-- | Extract (major, minor) from any version.
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"
getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of
@@ -739,7 +730,7 @@ getGHCForPVP pvpIn mt = do
-- | Like 'getGHCForPVP', except with explicit input parameter.
--
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "debug" :| [])), _vMeta = Just "lol"}})
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
@@ -765,21 +756,24 @@ getGHCForPVP' pvpIn ghcs' mt = do
-- | Get the latest available ghc for the given PVP version, which
-- may only contain parts.
--
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
-- Just (PVP {_pComponents = 8 :| [10,7]})
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
-- Just (PVP {_pComponents = 8 :| [8,4]})
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
-- Just (PVP {_pComponents = 8 :| [8,4]})
getLatestToolFor :: MonadThrow m
=> Tool
-> Maybe Text
-> PVP
-> GHCupDownloads
-> m (Maybe (PVP, VersionInfo))
getLatestToolFor tool pvpIn dls = do
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
-> m (Maybe (PVP, VersionInfo, Maybe Text))
getLatestToolFor tool target pvpIn dls = do
let ls :: [(GHCTargetVersion, VersionInfo)]
ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
let ps :: [((PVP, Text), VersionInfo, Maybe Text)]
ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls
pure . fmap (\((pv', _), vi, mt) -> (pv', vi, mt)) . headMay . filter (\((v, _), _, t) -> matchPVPrefix pvpIn v && t == target) $ ps
@@ -884,23 +878,41 @@ intoSubdir bdir tardir = case tardir of
-- | Get the tool version that has this tag. If multiple have it,
-- picks the greatest version.
getTagged :: Tag
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
-> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
getTagged tag =
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
% folding id
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
maybe m (\d -> let diff = diffDays d day
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
Map.empty mvv
in case headMay (Map.toAscList mdv) of
Nothing -> Left Nothing
Just (absDiff, (diff, (k, vi)))
| absDiff == 0 -> Right (k, vi)
| otherwise -> Left (Just (addDays diff day))
getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest) av
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
-- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
getLatestBaseVersion av pvpVer =
headOf (ix GHC % getTagged (Base pvpVer)) av
@@ -954,11 +966,6 @@ ghcToolFiles ver = do
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
-- this GHC was built from source. It contains the build config.
ghcUpSrcBuiltFile :: FilePath
ghcUpSrcBuiltFile = ".ghcup_src_built"
-- | Calls gmake if it exists in PATH, otherwise make.
make :: ( MonadThrow m
@@ -1024,7 +1031,7 @@ applyPatches pdir ddir = do
patches <- liftIO $ quilt `catchIO` (\e ->
if isDoesNotExistError e || isPermissionError e then
lexicographical
lexicographical
else throwIO e)
forM_ patches $ \patch' -> applyPatch patch' ddir
@@ -1081,11 +1088,15 @@ darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog dls tool (Left v') =
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
getChangeLog dls tool (GHCVersion v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (Right tag) =
getChangeLog dls tool (ToolVersion (mkTVer -> v')) =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolTag tag) =
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
getChangeLog dls tool (ToolDay day) =
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
-- | Execute a build action while potentially cleaning up:
@@ -1169,7 +1180,7 @@ rmBDir dir = withRunInIO (\run -> run $
$ rmPathForcibly dir)
getVersionInfo :: Version
getVersionInfo :: GHCTargetVersion
-> Tool
-> GHCupDownloads
-> Maybe VersionInfo
@@ -1199,7 +1210,7 @@ ensureGlobalTools
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."

View File

@@ -279,7 +279,7 @@ ghcupCacheDir
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup"))
pure (GHCupPath (bdir </> "ghcup" </> "cache"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
@@ -308,19 +308,7 @@ ghcupLogsDir
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
ghcupDbDir :: IO GHCupPath
ghcupDbDir
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup" </> "db"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
-- | '~/.ghcup/trash'.

View File

@@ -24,10 +24,10 @@ import qualified Data.Text as T
import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow)
import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (intersperse)
import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)
-- | This reflects the API version of the YAML.
--
@@ -52,7 +52,7 @@ versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: V.Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range
@@ -65,44 +65,15 @@ pvpToVersion pvp_ rest =
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v
versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
Right r -> pure r
where
alternative :: MonadThrow m => V.Version -> m V.PVP
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
rest :: V.Version -> Text
rest (V.Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t V.VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: V.VUnit -> Text
f (V.Digits i) = T.pack $ show i
f (V.Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: V.VChunk -> Bool
isDigit (V.Digits _ :| []) = True
isDigit _ = False
unsafeDigit :: V.VChunk -> Int
unsafeDigit (V.Digits x :| []) = fromIntegral x
unsafeDigit _ = error "unsafeDigit: wrong input"
pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
pvp'' = do
p <- V.pvp'
s <- getParserState
pure (p, stateInput s)
pvpFromList :: [Int] -> V.PVP
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral

View File

@@ -28,7 +28,7 @@
plat="$(uname -s)"
arch=$(uname -m)
ghver="0.1.19.2"
ghver="0.1.19.4"
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -851,8 +851,8 @@ case $ask_stack_answer in
;;
2)
(_eghcup --cache install stack) || die "Stack installation failed"
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
edo mkdir -p "${STACK_ROOT:-$HOME/.stack}"/hooks
hook_exe="${STACK_ROOT:-$HOME/.stack}"/hooks/ghc-install.sh
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
if [ -e "${hook_exe}" ] ; then

View File

@@ -40,10 +40,13 @@ param (
# Whether to disable use of curl.exe
[switch]$DisableCurl,
# The Msys2 version to download (e.g. 20221216)
[string]$Msys2Version
[string]$Msys2Version,
# The Msys2 sha256sum hash
[string]$Msys2Hash
)
$DefaultMsys2Version = "20221216"
$DefaultMsys2Hash = "18370d32b0264915c97e3d7c618f7b32d48ad80858923883fde5145acd32ca0f"
$Silent = !$Interactive
@@ -430,9 +433,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
if (!($Msys2Version)) {
$Msys2Version = $DefaultMsys2Version
}
if (!($Msys2Hash)) {
$Msys2Hash = $DefaultMsys2Hash
}
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
$msysUrl = ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
$msysUrl = ('https://downloads.haskell.org/ghcup/msys2/{0}' -f "$archive")
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
@@ -440,6 +446,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
} else {
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
}
$Msys2HashChecked = Get-FileHash -Algorithm SHA256 "${archivePath}"
if (!($Msys2HashChecked.Hash -eq $Msys2Hash)) {
Print-Msg -color Red -msg ("Hashes don't match, got {0}, but expected {1}" -f $Msys2HashChecked, $Msys2Hash)
Exit 1
}
Print-Msg -msg 'Extracting Msys2 archive...'
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
@@ -448,7 +459,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
Exec "$Bash" '-lc' 'exit'
Exec "$env:windir\system32\taskkill.exe" /F /FI `"MODULES eq msys-2.0.dll`"
Exec "$env:windir\system32\taskkill.exe" /F /FI "MODULES eq msys-2.0.dll"
Print-Msg -msg 'Upgrading full system...'
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'

View File

@@ -0,0 +1,67 @@
#!/bin/bash
set -eu
set -o pipefail
RELEASE=$1
get_sha() {
sha256sum "$1" | awk '{ print $1 }'
}
cd "gh-release-artifacts/v${RELEASE}"
cat <<EOF > /dev/stdout
GHCup:
${RELEASE}:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/ghcup-hs/blob/master/CHANGELOG.md
viSourceDL:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/ghcup-${RELEASE}-src.tar.gz
dlSubdir: ghcup-${RELEASE}
dlHash: $(get_sha "ghcup-${RELEASE}-src.tar.gz")
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-linux-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-linux-ghcup-${RELEASE}")
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-apple-darwin-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-apple-darwin-ghcup-${RELEASE}")
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-portbld-freebsd-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-portbld-freebsd-ghcup-${RELEASE}")
Windows:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-mingw64-ghcup-${RELEASE}.exe
dlHash: $(get_sha "x86_64-mingw64-ghcup-${RELEASE}.exe")
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/i386-linux-ghcup-${RELEASE}
dlHash: $(get_sha "i386-linux-ghcup-${RELEASE}")
Linux_Alpine:
unknown_versioning: *ghcup-32
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-linux-ghcup-${RELEASE}
dlHash: $(get_sha "aarch64-linux-ghcup-${RELEASE}")
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-apple-darwin-ghcup-${RELEASE}
dlHash: $(get_sha "aarch64-apple-darwin-ghcup-${RELEASE}")
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/armv7-linux-ghcup-${RELEASE}
dlHash: $(get_sha "armv7-linux-ghcup-${RELEASE}")
EOF

View File

@@ -29,7 +29,7 @@ gh release download "$RELEASE"
# cirrus
curl -L -o "x86_64-portbld-freebsd-ghcup-${TAG}" \
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}"
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${TAG}?branch=${RELEASE}"
sha256sum ./*-ghcup-* > SHA256SUMS
gpg --detach-sign -u "${SIGNER}" SHA256SUMS

View File

@@ -1,52 +1,38 @@
resolver: lts-18.28
resolver: lts-20.26
packages:
- .
extra-deps:
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- Cabal-3.6.3.0
- Cabal-syntax-3.10.1.0
- aeson-2.1.2.1
- cabal-install-parsers-0.6.1
- chs-cabal-0.1.1.1
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
- chs-deps-0.1.0.0
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
- generically-0.1.1
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.3.0
- haskus-utils-variant-3.2.1
- libarchive-3.0.3.2
- libyaml-streamly-0.2.1
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7
- lzma-static-5.2.5.5
- os-release-1.0.2.1
- parsec-3.1.15.0
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- yaml-streamly-0.12.1
- strict-base-0.4.0.0
- text-2.0.2
- yaml-streamly-0.12.2
- github: fosskers/versions
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
flags:
http-io-streams:
brotli: false
libarchive:
system-libarchive: false
system-libarchive: true
regex-posix:
_regex-posix-clib: true

View File

@@ -11,6 +11,7 @@ import GHCup.Types
import Data.ByteString ( ByteString )
import Data.Versions
import Data.List.NonEmpty
import Data.Time.Calendar ( Day(..) )
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
import Test.QuickCheck.Arbitrary.Generic
@@ -76,6 +77,9 @@ instance Arbitrary Port where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Day where
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
instance Arbitrary (URIRef Absolute) where
arbitrary =
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
@@ -179,6 +183,10 @@ instance Arbitrary GHCupInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary GHCTargetVersion where
arbitrary = GHCTargetVersion Nothing <$> arbitrary
shrink = genericShrink
-- our maps are nested... the default size easily blows up most ppls ram

View File

@@ -24,7 +24,7 @@ spec = do
-- https://github.com/haskell/ghcup-hs/issues/415
describe "GHCup.Prelude.File.Posix.Traversals" $ do
it "readDirEnt" $ do
dirstream <- liftIO $ openDirStreamPortable "test/data"
dirstream <- liftIO $ openDirStreamPortable "test/ghcup-test/data"
(dt1, fp1) <- readDirEntPortable dirstream
(dt2, fp2) <- readDirEntPortable dirstream
(dt3, fp3) <- readDirEntPortable dirstream

View File

@@ -17,6 +17,6 @@ spec = do
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
where
goldenDir
| isWindows = "test/golden/windows"
| otherwise = "test/golden/unix"
| isWindows = "test/ghcup-test/golden/windows"
| otherwise = "test/ghcup-test/golden/unix"

View File

@@ -0,0 +1,51 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module ChangeLogTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import Test.Tasty.HUnit
import Control.Monad.IO.Class
import GHCup.Types
import Data.Versions (versionQ)
changeLogTests :: TestTree
changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
where
check :: String -> ChangeLogOptions -> TestTree
check args expected = testCase args $ do
res <- changeLogParseWith (words args)
liftIO $ res @?= expected
checkList :: [(String, ChangeLogOptions)]
checkList =
[ ("changelog", ChangeLogOptions False Nothing Nothing)
, ("changelog -o", ChangeLogOptions True Nothing Nothing)
, ("changelog -t ghc", ChangeLogOptions False (Just GHC) Nothing)
, ("changelog -t cabal", ChangeLogOptions False (Just Cabal) Nothing)
, ("changelog -t hls", ChangeLogOptions False (Just HLS) Nothing)
, ("changelog -t stack", ChangeLogOptions False (Just Stack) Nothing)
, ("changelog -t ghcup", ChangeLogOptions False (Just GHCup) Nothing)
, ("changelog 9.2", ChangeLogOptions False Nothing
(Just $ GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "9.2"))
)
, ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
, ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
, ("changelog -t cabal 3.10.1.0", ChangeLogOptions False (Just Cabal)
(Just $ GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "3.10.1.0"))
)
, ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
]
changeLogParseWith :: [String] -> IO ChangeLogOptions
changeLogParseWith args = do
ChangeLog a <- parseWith args
pure a

View File

@@ -0,0 +1,191 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module CompileTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import Data.Versions
import GHCup.Types
import URI.ByteString.QQ
import qualified GHCup.OptParse.Compile as GHC (GHCCompileOptions(..))
import qualified GHCup.OptParse.Compile as HLS (HLSCompileOptions(..))
import GHCup.GHC as GHC
import GHCup.HLS as HLS
compileTests :: TestTree
compileTests = testGroup "compile"
$ map (buildTestTree compileParseWith)
[ ("ghc", compileGhcCheckList)
, ("hls", compileHlsCheckList)
]
mkDefaultGHCCompileOptions :: GHCVer -> Either Version FilePath -> GHCCompileOptions
mkDefaultGHCCompileOptions target boot =
GHCCompileOptions
target
boot
Nothing
Nothing
(Just $ Right [])
Nothing
[]
False
Nothing
Nothing
Nothing
Nothing
mkDefaultHLSCompileOptions :: HLSVer -> [ToolVersion] -> HLSCompileOptions
mkDefaultHLSCompileOptions target ghcs =
HLSCompileOptions
target
Nothing
True
False
(Left False)
Nothing
Nothing
Nothing
(Just $ Right [])
ghcs
[]
compileGhcCheckList :: [(String, CompileCommand)]
compileGhcCheckList = mapSecond CompileGHC
[ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions)
, ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" Nothing)
(Left $(versionQ "9.2.8"))
)
, ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Left $(versionQ "9.2.8"))
)
, ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Right "/usr/bin/ghc-9.2.2")
)
, ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|])
(Left $(versionQ "9.2.8"))
)
, (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
, (baseCmd <> "-c build.mk", baseOptions{GHC.buildConfig = Just "build.mk"})
, (baseCmd <> "--config build.mk", baseOptions{GHC.buildConfig = Just "build.mk"})
, (baseCmd <> "--patch file:///example.patch", baseOptions{GHC.patches = Just $ Right [[uri|file:///example.patch|]]})
, (baseCmd <> "-p patch_dir", baseOptions{GHC.patches = Just (Left "patch_dir")})
, (baseCmd <> "--patchdir patch_dir", baseOptions{GHC.patches = Just (Left "patch_dir")})
, (baseCmd <> "-x armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
, (baseCmd <> "--make", baseOptions{GHC.buildSystem = Just Make})
#ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\\\tmp\\out_dir"})
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\\\tmp\\out_dir"})
#else
, (baseCmd <> "-i /tmp/out_dir", baseOptions{GHC.isolateDir = Just "/tmp/out_dir"})
, (baseCmd <> "--isolate /tmp/out_dir", baseOptions{GHC.isolateDir = Just "/tmp/out_dir"})
#endif
]
where
baseCmd :: String
baseCmd = "compile ghc -v 9.4.5 -b 9.2.8 "
baseOptions :: GHCCompileOptions
baseOptions =
mkDefaultGHCCompileOptions
(GHC.SourceDist $(versionQ "9.4.5"))
(Left $(versionQ "9.2.8"))
compileHlsCheckList :: [(String, CompileCommand)]
compileHlsCheckList = mapSecond CompileHLS
[ ("compile hls -v 2.0.0.0 --ghc 9.2.8", baseOptions)
, ("compile hls --version 2.0.0.0 --ghc 9.2.8", baseOptions)
, ("compile hls -g a32db0b --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Nothing})
[ghc928]
)
, ("compile hls --git-ref a32db0b --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Nothing})
[ghc928]
)
, ("compile hls -g a32db0b -r https://github.com/haskell/haskell-language-server.git --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Just "https://github.com/haskell/haskell-language-server.git"})
[ghc928]
)
, ("compile hls -g a32db0b --repository https://github.com/haskell/haskell-language-server.git --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Just "https://github.com/haskell/haskell-language-server.git"})
[ghc928]
)
, ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.SourceDist $(versionQ "2.0.0.0"))
[ghc928]
)
, ("compile hls --remote-source-dist https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.RemoteDist [uri|https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz|])
[ghc928]
)
, ("compile hls -v 2.0.0.0 --ghc latest",
mkDefaultHLSCompileOptions
(HLS.HackageDist $(versionQ "2.0.0.0"))
[ToolTag Latest]
)
, (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
#ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
#else
, (baseCmd <> "-i /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
, (baseCmd <> "--isolate /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
#endif
, (baseCmd <> "--cabal-project file:///tmp/cabal.project", baseOptions{HLS.cabalProject = Just $ Right [uri|file:///tmp/cabal.project|]})
, (baseCmd <> "--cabal-project cabal.ghc8107.project", baseOptions{HLS.cabalProject = Just $ Left "cabal.ghc8107.project"})
, (baseCmd <> "--cabal-project-local file:///tmp/cabal.project.local", baseOptions{HLS.cabalProjectLocal = Just [uri|file:///tmp/cabal.project.local|]})
, (baseCmd <> "--patch file:///example.patch", baseOptions{HLS.patches = Just $ Right [[uri|file:///example.patch|]]})
, (baseCmd <> "-p patch_dir", baseOptions{HLS.patches = Just (Left "patch_dir")})
, (baseCmd <> "--patchdir patch_dir", baseOptions{HLS.patches = Just (Left "patch_dir")})
, (baseCmd <> "-- --enable-tests", baseOptions{HLS.cabalArgs = ["--enable-tests"]})
]
where
baseCmd :: String
baseCmd = "compile hls -v 2.0.0.0 --ghc 9.2.8 "
baseOptions :: HLSCompileOptions
baseOptions =
mkDefaultHLSCompileOptions
(HLS.HackageDist $(versionQ "2.0.0.0"))
[ghc928]
ghc928 :: ToolVersion
ghc928 = GHCVersion $ GHCTargetVersion Nothing $(versionQ "9.2.8")
compileParseWith :: [String] -> IO CompileCommand
compileParseWith args = do
Compile a <- parseWith args
pure a

View File

@@ -0,0 +1,34 @@
{-# LANGUAGE QuasiQuotes #-}
module ConfigTest where
import Test.Tasty
import Test.Tasty.HUnit
import GHCup.OptParse
import Utils
import Control.Monad.IO.Class
import URI.ByteString.QQ
configTests :: TestTree
configTests = testGroup "config" $ map (uncurry check) checkList
where
check :: String -> ConfigCommand -> TestTree
check args expected = testCase args $ do
res <- configParseWith (words args)
liftIO $ res @?= expected
checkList :: [(String, ConfigCommand)]
checkList =
[ ("config", ShowConfig)
, ("config init", InitConfig)
, ("config show", ShowConfig)
, ("config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
, AddReleaseChannel False [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|]
)
, ("config set cache true", SetConfig "cache" (Just "true"))
]
configParseWith :: [String] -> IO ConfigCommand
configParseWith args = do
Config a <- parseWith args
pure a

View File

@@ -0,0 +1,42 @@
module GCTest where
import Test.Tasty
import GHCup.OptParse
import Utils
gcTests :: TestTree
gcTests = buildTestTree gcParseWith ("gc", gcCheckList)
defaultOptions :: GCOptions
defaultOptions =
GCOptions
False
False
False
False
False
False
gcCheckList :: [(String, GCOptions)]
gcCheckList =
[ ("gc", defaultOptions)
, ("gc -o", defaultOptions{gcOldGHC = True})
, ("gc --ghc-old", defaultOptions{gcOldGHC = True})
, ("gc -p", defaultOptions{gcProfilingLibs = True})
, ("gc --profiling-libs", defaultOptions{gcProfilingLibs = True})
, ("gc -s", defaultOptions{gcShareDir = True})
, ("gc --share-dir", defaultOptions{gcShareDir = True})
, ("gc -h", defaultOptions{gcHLSNoGHC = True})
, ("gc --hls-no-ghc", defaultOptions{gcHLSNoGHC = True})
, ("gc -c", defaultOptions{gcCache = True})
, ("gc --cache", defaultOptions{gcCache = True})
, ("gc -t", defaultOptions{gcTmp = True})
, ("gc --tmpdirs", defaultOptions{gcTmp = True})
, ("gc -o -p -s -h -c -t", GCOptions True True True True True True)
]
gcParseWith :: [String] -> IO GCOptions
gcParseWith args = do
GC a <- parseWith args
pure a

View File

@@ -0,0 +1,203 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module InstallTest where
import Test.Tasty
import GHCup.OptParse hiding (HLSCompileOptions(isolateDir))
import Utils
import GHCup.Types
import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHCup.OptParse.Install as Install
import URI.ByteString.QQ
-- Some interests:
-- install ghc *won't* select `set as activate version` as default
-- install cabal *will* select `set as activate version` as default
-- install hls *will* select `set as activate version` as default
-- install stack *will* select `set as activate version` as default
installTests :: TestTree
installTests = testGroup "install"
$ map
(buildTestTree installParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", installGhcCheckList)
, ("cabal", installCabalCheckList)
, ("hls", installHlsCheckList)
, ("stack", installStackCheckList)
]
defaultOptions :: InstallOptions
defaultOptions = InstallOptions Nothing Nothing False Nothing False []
-- | Don't set as active version
mkInstallOptions :: ToolVersion -> InstallOptions
mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False []
-- | Set as active version
mkInstallOptions' :: ToolVersion -> InstallOptions
mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False []
oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)]
oldStyleCheckList =
("install", Right defaultOptions)
: ("install --set", Right defaultOptions{instSet = True})
: ("install --force", Right defaultOptions{forceInstall = True})
#ifdef IS_WINDOWS
: ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\\\"})
#else
: ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"})
#endif
: ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
, Right defaultOptions
{ instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|]
, instVer = Just $ GHCVersion $ GHCTargetVersion Nothing $(versionQ "head")
}
)
: mapSecond
(Right . mkInstallOptions)
[ ("install ghc-9.2", GHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
)
-- invalid
, ("install next", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "next")
)
, ("install latest", ToolTag Latest)
, ("install nightly", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
)
, ("install recommended", ToolTag Recommended)
, ("install prerelease", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
)
, ("install latest-prerelease", ToolTag LatestPrerelease)
, ("install latest-nightly", ToolTag LatestNightly)
, ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs")
$(versionQ "9.6")
)
, ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal-3.10", GHCVersion
$ GHCTargetVersion
(Just "cabal")
$(versionQ "3.10")
)
, ("install hls-2.0.0.0", GHCVersion
$ GHCTargetVersion
(Just "hls")
$(versionQ "2.0.0.0")
)
, ("install stack-2.9.3", GHCVersion
$ GHCTargetVersion
(Just "stack")
$(versionQ "2.9.3")
)
]
installGhcCheckList :: [(String, Either InstallCommand InstallOptions)]
installGhcCheckList =
("install ghc", Left $ InstallGHC defaultOptions)
: mapSecond (Left . InstallGHC . mkInstallOptions)
[ ("install ghc 9.2", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "9.2")
)
, ("install ghc next", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "next")
)
, ("install ghc latest", ToolTag Latest)
, ("install ghc nightly", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
)
, ("install ghc recommended", ToolTag Recommended)
, ("install ghc prerelease", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
)
, ("install ghc latest-prerelease", ToolTag LatestPrerelease)
, ("install ghc latest-nightly", ToolTag LatestNightly)
, ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion
(Just "javascript-unknown-ghcjs")
$(versionQ "9.6")
)
, ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install ghc ghc-9.2", GHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
)
]
installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
installCabalCheckList =
("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
: mapSecond (Left . InstallCabal . mkInstallOptions')
[ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
, ("install cabal next", ToolVersion $(versionQ "next"))
, ("install cabal latest", ToolTag Latest)
, ("install cabal nightly", ToolVersion $(versionQ "nightly"))
, ("install cabal recommended", ToolTag Recommended)
, ("install cabal prerelease", ToolVersion $(versionQ "prerelease"))
, ("install cabal latest-prerelease", ToolTag LatestPrerelease)
, ("install cabal latest-nightly", ToolTag LatestNightly)
, ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal cabal-3.10", ToolVersion $(versionQ "cabal-3.10"))
]
installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
installHlsCheckList =
("install hls", Left $ InstallHLS defaultOptions{instSet = True})
: mapSecond (Left . InstallHLS . mkInstallOptions')
[ ("install hls 3.10", ToolVersion $(versionQ "3.10"))
, ("install hls next", ToolVersion $(versionQ "next"))
, ("install hls latest", ToolTag Latest)
, ("install hls nightly", ToolVersion $(versionQ "nightly"))
, ("install hls recommended", ToolTag Recommended)
, ("install hls prerelease", ToolVersion $(versionQ "prerelease"))
, ("install hls latest-prerelease", ToolTag LatestPrerelease)
, ("install hls latest-nightly", ToolTag LatestNightly)
, ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install hls hls-2.0", ToolVersion $(versionQ "hls-2.0"))
]
installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
installStackCheckList =
("install stack", Left $ InstallStack defaultOptions{instSet = True})
: mapSecond (Left . InstallStack . mkInstallOptions')
[ ("install stack 3.10", ToolVersion $(versionQ "3.10"))
, ("install stack next", ToolVersion $(versionQ "next"))
, ("install stack latest", ToolTag Latest)
, ("install stack nightly", ToolVersion $(versionQ "nightly"))
, ("install stack recommended", ToolTag Recommended)
, ("install stack prerelease", ToolVersion $(versionQ "prerelease"))
, ("install stack latest-prerelease", ToolTag LatestPrerelease)
, ("install stack latest-nightly", ToolTag LatestNightly)
, ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
]
installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)
installParseWith args = do
Install a <- parseWith args
pure a

View File

@@ -0,0 +1,46 @@
module ListTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.List
import GHCup.Types
listTests :: TestTree
listTests = buildTestTree listParseWith ("list", listCheckList)
defaultOptions :: ListOptions
defaultOptions = ListOptions Nothing Nothing Nothing Nothing False False False
listCheckList :: [(String, ListOptions)]
listCheckList =
[ ("list", defaultOptions)
, ("list -t ghc", defaultOptions{loTool = Just GHC})
, ("list -t cabal", defaultOptions{loTool = Just Cabal})
, ("list -t hls", defaultOptions{loTool = Just HLS})
, ("list -t stack", defaultOptions{loTool = Just Stack})
, ("list -c installed", defaultOptions{lCriteria = Just $ ListInstalled True})
, ("list -c +installed", defaultOptions{lCriteria = Just $ ListInstalled True})
, ("list -c -installed", defaultOptions{lCriteria = Just $ ListInstalled False})
, ("list -c set", defaultOptions{lCriteria = Just $ ListSet True})
, ("list -c +set", defaultOptions{lCriteria = Just $ ListSet True})
, ("list -c -set", defaultOptions{lCriteria = Just $ ListSet False})
, ("list -c available", defaultOptions{lCriteria = Just $ ListAvailable True})
, ("list -c +available", defaultOptions{lCriteria = Just $ ListAvailable True})
, ("list -c -available", defaultOptions{lCriteria = Just $ ListAvailable False})
, ("list -s 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22"})
, ("list -u 2023-07-22", defaultOptions{lTo = Just $ read "2023-07-22"})
, ("list --since 2023-07-22 --until 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22", lTo = Just $ read "2023-07-22"})
, ("list -o", defaultOptions{lHideOld = True})
, ("list --hide-old", defaultOptions{lHideOld = True})
, ("list -n", defaultOptions{lShowNightly = True})
, ("list --show-nightly", defaultOptions{lShowNightly = True})
, ("list -r", defaultOptions{lRawFormat = True})
, ("list --raw-format", defaultOptions{lRawFormat = True})
]
listParseWith :: [String] -> IO ListOptions
listParseWith args = do
List a <- parseWith args
pure a

View File

@@ -0,0 +1,33 @@
module Main where
import Test.Tasty
import qualified SetTest
import qualified OtherCommandTest
import qualified ChangeLogTest
import qualified ConfigTest
import qualified InstallTest
import qualified UnsetTest
import qualified RmTest
import qualified ListTest
import qualified UpgradeTest
import qualified CompileTest
import qualified WhereisTest
import qualified GCTest
import qualified RunTest
main :: IO ()
main = defaultMain $ testGroup "ghcup"
[ SetTest.setTests
, OtherCommandTest.otherCommandTests
, ChangeLogTest.changeLogTests
, ConfigTest.configTests
, InstallTest.installTests
, UnsetTest.unsetTests
, RmTest.rmTests
, ListTest.listTests
, UpgradeTest.upgradeTests
, CompileTest.compileTests
, WhereisTest.whereisTests
, GCTest.gcTests
, RunTest.runTests
]

View File

@@ -0,0 +1,38 @@
module OtherCommandTest where
import Test.Tasty
import Test.Tasty.HUnit
import GHCup.OptParse
import Utils
import Control.Monad.IO.Class
otherCommandTests :: TestTree
otherCommandTests = testGroup "other command"
[ testCase "debug-info" $ do
res <- parseWith ["debug-info"]
liftIO $ assertBool "debug-info parse failed" (isDInfo res)
, testCase "tool-requirements" $ do
ToolRequirements opt <- parseWith ["tool-requirements"]
liftIO $ tlrRaw opt @?= False
, testCase "tool-requirements -r" $ do
ToolRequirements opt <- parseWith ["tool-requirements", "--raw-format"]
liftIO $ tlrRaw opt @?= True
, testCase "nuke" $ do
res <- parseWith ["nuke"]
liftIO $ assertBool "nuke parse failed" (isNuke res)
, testCase "test ghc" $ do
res <- parseWith ["test", "ghc"]
liftIO $ assertBool "test parse failed" (isTest res)
]
isDInfo :: Command -> Bool
isDInfo DInfo = True
isDInfo _ = False
isNuke :: Command -> Bool
isNuke Nuke = True
isNuke _ = False
isTest :: Command -> Bool
isTest (Test _) = True
isTest _ = False

View File

@@ -0,0 +1,62 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module RmTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.Versions
rmTests :: TestTree
rmTests =
testGroup "rm"
$ map (buildTestTree rmParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", rmGhcCheckList)
, ("cabal", rmCabalCheckList)
, ("hls", rmHlsCheckList)
, ("stack", rmStackCheckList)
]
oldStyleCheckList :: [(String, Either RmCommand RmOptions)]
oldStyleCheckList = mapSecond (Right . RmOptions)
[ -- failed with ("rm", xxx)
("rm 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
]
rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
[ -- failed with ("rm ghc", xxx)
("rm ghc 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
]
rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
rmCabalCheckList = mapSecond (Left . RmCabal)
[ -- failed with ("rm cabal", xxx)
("rm cabal 3.10", $(versionQ "3.10"))
, ("rm cabal cabal-3.10", $(versionQ "cabal-3.10"))
]
rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
rmHlsCheckList = mapSecond (Left . RmHLS)
[ -- failed with ("rm hls", xxx)
("rm hls 2.0", $(versionQ "2.0"))
, ("rm hls hls-2.0", $(versionQ "hls-2.0"))
]
rmStackCheckList :: [(String, Either RmCommand RmOptions)]
rmStackCheckList = mapSecond (Left . RmStack)
[ -- failed with ("rm stack", xxx)
("rm stack 2.9.1", $(versionQ "2.9.1"))
, ("rm stack stack-2.9.1", $(versionQ "stack-2.9.1"))
]
rmParseWith :: [String] -> IO (Either RmCommand RmOptions)
rmParseWith args = do
Rm a <- parseWith args
pure a

View File

@@ -0,0 +1,68 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module RunTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.Versions (versionQ)
runTests :: TestTree
runTests = buildTestTree runParseWith ("run", runCheckList)
defaultOptions :: RunOptions
defaultOptions =
RunOptions
False
False
False
Nothing
Nothing
Nothing
Nothing
Nothing
False
[]
runCheckList :: [(String, RunOptions)]
runCheckList =
[ ("run", defaultOptions)
, ("run -a", defaultOptions{runAppendPATH = True})
, ("run --append", defaultOptions{runAppendPATH = True})
, ("run -i", defaultOptions{runInstTool' = True})
, ("run --install", defaultOptions{runInstTool' = True})
, ("run -m", defaultOptions{runMinGWPath = True})
, ("run --mingw-path", defaultOptions{runMinGWPath = True})
, ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")})
, ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $(versionQ "3.10")})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(versionQ "2.0")})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(versionQ "2.9") })
#ifdef IS_WINDOWS
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
#else
, ("run -b /tmp/dir", defaultOptions{runBinDir = Just "/tmp/dir"})
, ("run --bindir /tmp/dir", defaultOptions{runBinDir = Just "/tmp/dir"})
#endif
, ("run -q", defaultOptions{runQuick = True})
, ("run --quick", defaultOptions{runQuick = True})
, ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install",
defaultOptions
{ runGHCVer = Just $ ToolTag Latest
, runCabalVer = Just $ ToolVersion $(versionQ "3.10")
, runHLSVer = Just $ ToolVersion $(versionQ "2.0")
, runStackVer = Just $ ToolVersion $(versionQ "2.9")
, runInstTool' = True
}
)
]
runParseWith :: [String] -> IO RunOptions
runParseWith args = do
Run a <- parseWith args
pure a

View File

@@ -0,0 +1,156 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module SetTest where
import GHCup.OptParse
import Test.Tasty
import GHCup.Types
import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
import Utils
setTests :: TestTree
setTests =
testGroup "set"
$ map
(buildTestTree setParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", setGhcCheckList)
, ("cabal", setCabalCheckList)
, ("hls", setHlsCheckList)
, ("stack", setStackCheckList)
]
oldStyleCheckList :: [(String, Either SetCommand SetOptions)]
oldStyleCheckList = mapSecond (Right . SetOptions)
[ ("set", SetRecommended)
, ("set ghc-9.2", SetGHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
)
, ("set next", SetNext)
, ("set latest", SetToolTag Latest)
, ("set nightly", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
)
-- different from `set`
, ("set recommended", SetToolTag Recommended)
, ("set prerelease", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
)
, ("set latest-prerelease", SetToolTag LatestPrerelease)
, ("set latest-nightly", SetToolTag LatestNightly)
, ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs")
$(versionQ "9.6")
)
, ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal-3.10", SetGHCVersion
$ GHCTargetVersion
(Just "cabal")
$(versionQ "3.10")
)
, ("set hls-2.0.0.0", SetGHCVersion
$ GHCTargetVersion
(Just "hls")
$(versionQ "2.0.0.0")
)
, ("set stack-2.9.3", SetGHCVersion
$ GHCTargetVersion
(Just "stack")
$(versionQ "2.9.3")
)
]
setGhcCheckList :: [(String, Either SetCommand SetOptions)]
setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
[ ("set ghc", SetRecommended)
, ("set ghc 9.2", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "9.2")
)
, ("set ghc next", SetNext)
, ("set ghc latest", SetToolTag Latest)
, ("set ghc nightly", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
)
, ("set ghc recommended", SetToolTag Recommended)
, ("set ghc prerelease", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
)
, ("set ghc latest-prerelease", SetToolTag LatestPrerelease)
, ("set ghc latest-nightly", SetToolTag LatestNightly)
, ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion
(Just "javascript-unknown-ghcjs")
$(versionQ "9.6")
)
, ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set ghc ghc-9.2", SetGHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
)
]
setCabalCheckList :: [(String, Either SetCommand SetOptions)]
setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
[ ("set cabal", SetRecommended)
, ("set cabal 3.10", SetToolVersion $(versionQ "3.10"))
, ("set cabal next", SetNext)
, ("set cabal latest", SetToolTag Latest)
, ("set cabal nightly", SetToolVersion $(versionQ "nightly"))
, ("set cabal recommended", SetToolTag Recommended)
, ("set cabal prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set cabal latest-prerelease", SetToolTag LatestPrerelease)
, ("set cabal latest-nightly", SetToolTag LatestNightly)
, ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal cabal-3.10", SetToolVersion $(versionQ "cabal-3.10"))
]
setHlsCheckList :: [(String, Either SetCommand SetOptions)]
setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
[ ("set hls", SetRecommended)
, ("set hls 2.0", SetToolVersion $(versionQ "2.0"))
, ("set hls next", SetNext)
, ("set hls latest", SetToolTag Latest)
, ("set hls nightly", SetToolVersion $(versionQ "nightly"))
, ("set hls recommended", SetToolTag Recommended)
, ("set hls prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set hls latest-prerelease", SetToolTag LatestPrerelease)
, ("set hls latest-nightly", SetToolTag LatestNightly)
, ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set hls hls-2.0", SetToolVersion $(versionQ "hls-2.0"))
]
setStackCheckList :: [(String, Either SetCommand SetOptions)]
setStackCheckList = mapSecond (Left . SetStack . SetOptions)
[ ("set stack", SetRecommended)
, ("set stack 2.9", SetToolVersion $(versionQ "2.9"))
, ("set stack next", SetNext)
, ("set stack latest", SetToolTag Latest)
, ("set stack nightly", SetToolVersion $(versionQ "nightly"))
, ("set stack recommended", SetToolTag Recommended)
, ("set stack prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set stack latest-prerelease", SetToolTag LatestPrerelease)
, ("set stack latest-nightly", SetToolTag LatestNightly)
, ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set stack stack-2.9", SetToolVersion $(versionQ "stack-2.9"))
]
setParseWith :: [String] -> IO (Either SetCommand SetOptions)
setParseWith args = do
Set a <- parseWith args
pure a

View File

@@ -0,0 +1,50 @@
{-# LANGUAGE OverloadedStrings #-}
module UnsetTest where
import Test.Tasty
import GHCup.OptParse
import Utils
unsetTests :: TestTree
unsetTests =
testGroup "unset"
$ map (buildTestTree unsetParseWith)
[ ("ghc", unsetGhcCheckList)
, ("cabal", unsetCabalCheckList)
, ("hls", unsetHlsCheckList)
, ("stack", unsetStackCheckList)
]
unsetGhcCheckList :: [(String, UnsetCommand)]
unsetGhcCheckList = mapSecond (UnsetGHC . UnsetOptions)
[ ("unset ghc", Nothing)
, ("unset ghc armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetCabalCheckList :: [(String, UnsetCommand)]
unsetCabalCheckList = mapSecond (UnsetCabal . UnsetOptions)
[ ("unset cabal", Nothing)
-- This never used
, ("unset cabal armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetHlsCheckList :: [(String, UnsetCommand)]
unsetHlsCheckList = mapSecond (UnsetHLS . UnsetOptions)
[ ("unset hls", Nothing)
-- This never used
, ("unset hls armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetStackCheckList :: [(String, UnsetCommand)]
unsetStackCheckList = mapSecond (UnsetStack . UnsetOptions)
[ ("unset stack", Nothing)
-- This never used
, ("unset stack armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetParseWith :: [String] -> IO UnsetCommand
unsetParseWith args = do
UnSet a <- parseWith args
pure a

View File

@@ -0,0 +1,38 @@
{-# LANGUAGE TupleSections #-}
module UpgradeTest where
import Test.Tasty
import GHCup.OptParse
import Utils
upgradeTests :: TestTree
upgradeTests = buildTestTree upgradeParseWith ("upgrade", upgradeCheckList)
type FullUpgradeOpts =
( UpgradeOpts
, Bool -- ^Force update
, Bool -- ^Fails after upgrading if the upgraded ghcup binary is shadowed by something else in PATH (useful for CI)
)
mkDefaultOptions :: UpgradeOpts -> FullUpgradeOpts
mkDefaultOptions = (, False, False)
upgradeCheckList :: [(String, FullUpgradeOpts)]
upgradeCheckList =
[ ("upgrade", mkDefaultOptions UpgradeGHCupDir)
, ("upgrade -f", (UpgradeGHCupDir, True, False))
, ("upgrade --force", (UpgradeGHCupDir, True, False))
, ("upgrade --fail-if-shadowed", (UpgradeGHCupDir, False, True))
, ("upgrade -i", mkDefaultOptions UpgradeInplace)
, ("upgrade --inplace", mkDefaultOptions UpgradeInplace)
, ("upgrade -t ~", mkDefaultOptions $ UpgradeAt "~")
, ("upgrade --target ~", mkDefaultOptions $ UpgradeAt "~")
, ("upgrade -t ~ -f", (UpgradeAt "~", True, False))
]
upgradeParseWith :: [String] -> IO FullUpgradeOpts
upgradeParseWith args = do
Upgrade a b c <- parseWith args
pure (a, b, c)

View File

@@ -0,0 +1,34 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Utils where
import GHCup.OptParse as GHCup
import Options.Applicative
import Data.Bifunctor
import Test.Tasty
import Test.Tasty.HUnit
import Control.Monad.IO.Class
parseWith :: [String] -> IO Command
parseWith args =
optCommand <$> handleParseResult
(execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
padLeft :: Int -> String -> String
padLeft desiredLength s = padding ++ s
where padding = replicate (desiredLength - length s) ' '
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSecond = map . second
buildTestTree
:: (Eq a, Show a)
=> ([String] -> IO a) -- ^ The parse function
-> (String, [(String, a)]) -- ^ The check list @(test group, [(cli command, expected value)])@
-> TestTree
buildTestTree parse (title, checkList) =
testGroup title
$ zipWith (uncurry . check) [1 :: Int ..] checkList
where
check idx args expected = testCase (padLeft 2 (show idx) ++ "." ++ args) $ do
res <- parse (words args)
liftIO $ res @?= expected

View File

@@ -0,0 +1,42 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module WhereisTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.Versions (versionQ)
whereisTests :: TestTree
whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))]
whereisCheckList = concatMap mk
[ ("whereis ghc", WhereisTool GHC Nothing)
, ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")))
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") $(versionQ "9.2.8")))
, ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest))
, ("whereis cabal", WhereisTool Cabal Nothing)
, ("whereis hls", WhereisTool HLS Nothing)
, ("whereis stack", WhereisTool Stack Nothing)
, ("whereis ghcup", WhereisTool GHCup Nothing)
, ("whereis basedir", WhereisBaseDir)
, ("whereis bindir", WhereisBinDir)
, ("whereis cachedir", WhereisCacheDir)
, ("whereis logsdir", WhereisLogsDir)
, ("whereis confdir", WhereisConfDir)
]
where
mk :: (String, WhereisCommand) -> [(String, (WhereisOptions, WhereisCommand))]
mk (cmd, res) =
[ (cmd, (WhereisOptions False, res))
, (cmd <> " -d", (WhereisOptions True, res))
, (cmd <> " --directory", (WhereisOptions True, res))
]
whereisParseWith :: [String] -> IO (WhereisOptions, WhereisCommand)
whereisParseWith args = do
Whereis a b <- parseWith args
pure (a, b)