Compare commits
124 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| a5d228ba89 | |||
| a7be1e7068 | |||
| 30a10d871a | |||
| 90b0281c1c | |||
|
|
bba92baeb1 | ||
| e06a1c03d4 | |||
| 0171f2e870 | |||
| da078c7362 | |||
| 94b4b7c455 | |||
| 6aa486594a | |||
| 2c3148abcc | |||
| dde32fa72e | |||
| 675ab17fff | |||
| 9fcacbd96b | |||
| ba4c6e5b99 | |||
| f2b139b58b | |||
| a44bf5884d | |||
| 64c1d63d33 | |||
| 0300d8f2cc | |||
|
|
bb395b652d | ||
| 59bfdd9a30 | |||
| d85accb08e | |||
| c7439d3c89 | |||
| 38cd5ad8ed | |||
| 5fd0fa8d8e | |||
| 452ca8cca2 | |||
| 5f73320b29 | |||
| d14526059b | |||
| b1cde06bd0 | |||
| 0adb602a96 | |||
| f9a2b21cb0 | |||
| e73cf4033e | |||
| 5f0c6f60b8 | |||
| 29c9611152 | |||
| e90ca97441 | |||
| 1fb0387101 | |||
|
|
1981a12e67 | ||
|
|
eae197ccb3 | ||
|
|
15c6ed2b8d | ||
| fbb648d984 | |||
|
|
c914a284de | ||
| 9a17eaa32a | |||
| 480d6be02f | |||
| 3e907bd890 | |||
|
|
d999c3dfbf | ||
| 41d44b037d | |||
| 9d8d6e3293 | |||
|
|
8696a1c710 | ||
| 2f107197d4 | |||
| 486a1bac25 | |||
| a73ce186b5 | |||
| 76204aa366 | |||
| 502f0ea62f | |||
| e7e6663017 | |||
| e27fed09f3 | |||
| 9eeac00714 | |||
| c0ffb22d6a | |||
| f0b145d8dd | |||
| bb700281a3 | |||
|
|
fcdec4ba2c | ||
| 371eda962f | |||
| 50252d8613 | |||
| 78c393a16e | |||
| 9c3478075f | |||
| 7e7c11fda4 | |||
| bff14761ac | |||
| 99ddcc938f | |||
| e2301e2fa7 | |||
| c52096671e | |||
| 64f03a2f18 | |||
|
|
a72b78ef96 | ||
|
|
b17849c258 | ||
| d759535faa | |||
|
|
c25c07aa61 | ||
|
|
5f361e1e0b | ||
|
|
bcb498de20 | ||
|
|
fd6ff9f8ec | ||
|
|
69d311f0b4 | ||
|
|
fde0e712ac | ||
|
|
c60aa767ca | ||
|
|
78df858ba1 | ||
|
|
f1f4d5e836 | ||
|
|
2726e83235 | ||
|
|
f23631054a | ||
|
|
9189f9a65a | ||
|
|
7076472bde | ||
| a2a605ad89 | |||
|
|
8fae9a5083 | ||
|
|
6f07b6a343 | ||
|
|
dfebfc9504 | ||
|
|
36463ebf97 | ||
|
|
f400f43b8c | ||
| a3748507ca | |||
|
|
c92875882a | ||
|
|
2df2e3da40 | ||
|
|
cf1e8659b0 | ||
|
|
fb2e3f2740 | ||
| 578162f461 | |||
|
|
29bc40f65b | ||
|
|
aafb77df7c | ||
|
|
dc1a813305 | ||
|
|
16c7ecabe2 | ||
|
|
e1d8ba869a | ||
|
|
38db038953 | ||
|
|
bcdf2b23f1 | ||
|
|
83b82c328b | ||
| c149ee8d2b | |||
|
|
c10924274d | ||
|
|
e13c5a99af | ||
| 6623e4b1c8 | |||
| 5170baf074 | |||
| d143daeb9a | |||
| 699b183f62 | |||
| 09d72e7c97 | |||
| d551cc8077 | |||
| 4698639da9 | |||
| e67a9c93fe | |||
| 621cc5782b | |||
| 482503ca0a | |||
| 2fb7328a6e | |||
| 06eae56646 | |||
| bdbbeb1040 | |||
| 1eed02c8c7 | |||
| 6d325a1804 |
11
.editorconfig
Normal file
11
.editorconfig
Normal 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
|
||||
2
.github/scripts/build.sh
vendored
2
.github/scripts/build.sh
vendored
@@ -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"
|
||||
|
||||
|
||||
74
.github/scripts/cross.sh
vendored
Normal file
74
.github/scripts/cross.sh
vendored
Normal 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 ]
|
||||
|
||||
45
.github/scripts/test.sh
vendored
45
.github/scripts/test.sh
vendored
@@ -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
|
||||
@@ -28,31 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
|
||||
|
||||
### Haskell test suite
|
||||
|
||||
./ghcup-test${ext}
|
||||
rm ghcup-test${ext}
|
||||
./"ghcup-test${ext}"
|
||||
./"ghcup-test-optparse${ext}"
|
||||
rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VER}
|
||||
eghcup unset ghc ${GHC_VER}
|
||||
ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
|
||||
[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
|
||||
[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
|
||||
[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
|
||||
eghcup set ghc ${GHC_VER}
|
||||
eghcup install cabal ${CABAL_VER}
|
||||
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
|
||||
eghcup install ghc "${GHC_VER}"
|
||||
eghcup unset ghc "${GHC_VER}"
|
||||
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
|
||||
[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
|
||||
[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
|
||||
[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
|
||||
eghcup set ghc "${GHC_VER}"
|
||||
eghcup install cabal "${CABAL_VER}"
|
||||
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
|
||||
eghcup unset cabal
|
||||
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
||||
|
||||
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
||||
[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
|
||||
eghcup set cabal ${CABAL_VER}
|
||||
[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
|
||||
eghcup set cabal "${CABAL_VER}"
|
||||
|
||||
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
|
||||
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
|
||||
|
||||
if [ "${OS}" != "FreeBSD" ] ; then
|
||||
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
|
||||
@@ -82,10 +85,10 @@ eghcup list -t cabal
|
||||
|
||||
ghc_ver=$(ghc --numeric-version)
|
||||
ghc --version
|
||||
ghc-${ghc_ver} --version
|
||||
"ghc-${ghc_ver}" --version
|
||||
if [ "${OS}" != "Windows" ] ; then
|
||||
ghci --version
|
||||
ghci-${ghc_ver} --version
|
||||
"ghci-${ghc_ver}" --version
|
||||
fi
|
||||
|
||||
|
||||
@@ -129,11 +132,11 @@ else
|
||||
eghcup --offline set 8.10.3
|
||||
eghcup set 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
||||
eghcup set ${GHC_VER}
|
||||
eghcup set "${GHC_VER}"
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup unset ghc
|
||||
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
|
||||
eghcup set ${GHC_VER}
|
||||
eghcup set "${GHC_VER}"
|
||||
eghcup --offline rm 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
@@ -166,10 +169,10 @@ fi
|
||||
# check that lazy loading works for 'whereis'
|
||||
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
eghcup whereis ghc $(ghc --numeric-version)
|
||||
eghcup whereis ghc "$(ghc --numeric-version)"
|
||||
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
|
||||
eghcup rm $(ghc --numeric-version)
|
||||
eghcup rm "$(ghc --numeric-version)"
|
||||
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
|
||||
if [ "${OS}" = "Linux" ] ; then
|
||||
@@ -183,7 +186,7 @@ eghcup gc -c
|
||||
|
||||
# test etags
|
||||
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
|
||||
raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
|
||||
# snapshot yaml and etags file
|
||||
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
|
||||
140
.github/workflows/cross.yaml
vendored
Normal file
140
.github/workflows/cross.yaml
vendored
Normal 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
|
||||
|
||||
2
.gitmodules
vendored
2
.gitmodules
vendored
@@ -1,4 +1,4 @@
|
||||
[submodule "data/metadata"]
|
||||
path = data/metadata
|
||||
url = https://github.com/haskell/ghcup-metadata.git
|
||||
branch = master
|
||||
branch = develop
|
||||
|
||||
16
CHANGELOG.md
16
CHANGELOG.md
@@ -1,5 +1,21 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.20.0 -- 2023-11-10
|
||||
|
||||
### New features
|
||||
|
||||
* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
|
||||
* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
|
||||
* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
|
||||
- you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
|
||||
|
||||
### Improvements and bug fixes
|
||||
|
||||
* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
|
||||
* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
|
||||
* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
|
||||
* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
|
||||
|
||||
## 0.1.19.4 -- 2023-7-02
|
||||
|
||||
* fix missing TUI for aarch64 linux binaries
|
||||
|
||||
@@ -5,18 +5,19 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
|
||||
module BrickMain where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Types.Optics ( getDirs, getPlatformReq )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.OptParse.Common (logGHCPostRm)
|
||||
import GHCup.Prelude ( decUTF8Safe )
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
@@ -30,6 +31,7 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||
, listAttr
|
||||
)
|
||||
import Codec.Archive
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -45,10 +47,9 @@ 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
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
@@ -60,9 +61,34 @@ import qualified Data.Text.Lazy as L
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
import System.Environment (getExecutablePath)
|
||||
#if !IS_WINDOWS
|
||||
import GHCup.Prelude.File
|
||||
import System.FilePath
|
||||
import qualified System.Posix.Process as SPP
|
||||
#endif
|
||||
|
||||
|
||||
installedSign :: String
|
||||
#if IS_WINDOWS
|
||||
installedSign = "I "
|
||||
#else
|
||||
installedSign = "✓ "
|
||||
#endif
|
||||
|
||||
setSign :: String
|
||||
#if IS_WINDOWS
|
||||
setSign = "IS"
|
||||
#else
|
||||
setSign = "✔✔"
|
||||
#endif
|
||||
|
||||
notInstalledSign :: String
|
||||
#if IS_WINDOWS
|
||||
notInstalledSign = "X "
|
||||
#else
|
||||
notInstalledSign = "✗ "
|
||||
#endif
|
||||
|
||||
hiddenTools :: [Tool]
|
||||
hiddenTools = []
|
||||
|
||||
@@ -94,7 +120,7 @@ data BrickState = BrickState
|
||||
|
||||
|
||||
keyHandlers :: KeyBindings
|
||||
-> [ ( Vty.Key
|
||||
-> [ ( KeyCombination
|
||||
, BrickSettings -> String
|
||||
, BrickState -> EventM String BrickState ()
|
||||
)
|
||||
@@ -131,6 +157,9 @@ showKey Vty.KUp = "↑"
|
||||
showKey Vty.KDown = "↓"
|
||||
showKey key = tail (show key)
|
||||
|
||||
showMod :: Vty.Modifier -> String
|
||||
showMod = tail . show
|
||||
|
||||
|
||||
ui :: AttrMap -> BrickState -> Widget String
|
||||
ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
@@ -147,7 +176,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
. txtWrap
|
||||
. T.pack
|
||||
. foldr1 (\x y -> x <> " " <> y)
|
||||
. fmap (\(key, s, _) -> showKey key <> ":" <> s as)
|
||||
. fmap (\(KeyCombination key mods, s, _) -> intercalate "+" (showKey key : (showMod <$> mods)) <> ":" <> s as)
|
||||
$ keyHandlers appKeys
|
||||
header =
|
||||
minHSize 2 emptyWidget
|
||||
@@ -161,9 +190,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
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 "✓ ")
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str "✗ ")
|
||||
| lSet -> (withAttr (attrName "set") $ str setSign)
|
||||
| lInstalled -> (withAttr (attrName "installed") $ str installedSign)
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str notInstalledSign)
|
||||
ver = case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
@@ -218,7 +247,6 @@ 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
|
||||
@@ -322,12 +350,12 @@ eventHandler st@BrickState{..} ev = do
|
||||
(MouseDown _ Vty.BScrollDown _ _) ->
|
||||
put (BrickState { appState = moveCursor 1 appState Down, .. })
|
||||
(VtyEvent (Vty.EvResize _ _)) -> put st
|
||||
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
|
||||
(VtyEvent (Vty.EvKey Vty.KUp [])) ->
|
||||
put BrickState{ appState = moveCursor 1 appState Up, .. }
|
||||
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
|
||||
(VtyEvent (Vty.EvKey Vty.KDown [])) ->
|
||||
put BrickState{ appState = moveCursor 1 appState Down, .. }
|
||||
(VtyEvent (Vty.EvKey key _)) ->
|
||||
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
|
||||
(VtyEvent (Vty.EvKey key mods)) ->
|
||||
case find (\(keyCombo, _, _) -> keyCombo == KeyCombination key mods) (keyHandlers kb) of
|
||||
Nothing -> put st
|
||||
Just (_, _, handler) -> handler st
|
||||
_ -> put st
|
||||
@@ -433,7 +461,7 @@ filterVisible v t e | lInstalled e = True
|
||||
(lTool e `notElem` hiddenTools)
|
||||
|
||||
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
@@ -464,6 +492,11 @@ install' _ (_, ListResult {..}) = do
|
||||
, ToolShadowed
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
run (do
|
||||
@@ -492,12 +525,15 @@ install' _ (_, ListResult {..}) = do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
#if !IS_WINDOWS
|
||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
|
||||
when ((normalise <$> up) == Just (normalise ce)) $
|
||||
-- TODO: track cli arguments of previous invocation
|
||||
liftIO $ SPP.executeFile ce False ["tui"] Nothing
|
||||
#else
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
#endif
|
||||
_ -> pure ()
|
||||
pure $ Right ()
|
||||
VRight (vi, _, _) -> do
|
||||
@@ -510,7 +546,7 @@ install' _ (_, ListResult {..}) = do
|
||||
<> "Also check the logs in ~/.ghcup/logs"
|
||||
|
||||
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
@@ -652,8 +688,10 @@ getGHCupInfo = do
|
||||
|
||||
r <-
|
||||
flip runReaderT settings
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE getDownloadsF
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
|
||||
$ do
|
||||
pfreq <- lift getPlatformReq
|
||||
liftE $ getDownloadsF pfreq
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
|
||||
@@ -42,7 +42,6 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions
|
||||
import GHC.IO.Encoding
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Language.Haskell.TH
|
||||
@@ -85,7 +84,7 @@ toSettings options = do
|
||||
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
||||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
|
||||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
|
||||
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
|
||||
urlSource = fromMaybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) optUrlSource
|
||||
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
||||
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
||||
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
||||
@@ -211,10 +210,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <-
|
||||
( flip runReaderT leanAppstate
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE getDownloadsF
|
||||
)
|
||||
( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do
|
||||
liftE $ getDownloadsF pfreq
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
@@ -341,9 +339,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
] m Bool
|
||||
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
|
||||
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
|
||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
||||
@@ -378,3 +376,4 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
cmp' tool instVer ver = do
|
||||
(v, _) <- liftE $ fromVersion instVer tool
|
||||
pure (v == ver)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -4,30 +4,26 @@ optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
if os(linux)
|
||||
package ghcup
|
||||
flags: +tui
|
||||
if arch(x86_64) || arch(i386)
|
||||
package *
|
||||
ghc-options: -split-sections -optl-static
|
||||
elif os(darwin)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static
|
||||
package ghcup
|
||||
flags: +tui
|
||||
elif os(mingw32)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static,
|
||||
text -simdutf
|
||||
package ghcup
|
||||
flags: -tui
|
||||
text -simdutf,
|
||||
vty-windows >=0.1.0.3
|
||||
elif os(freebsd)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
zip +disable-zstd
|
||||
package *
|
||||
ghc-options: -split-sections -pgmc clang++14
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.aeson >= 2.0.1.0,
|
||||
|
||||
@@ -16,6 +16,11 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
|
||||
# TUI key bindings,
|
||||
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
|
||||
# for possible values.
|
||||
# It's also possible to define key+modifier, e.g.:
|
||||
# quit:
|
||||
# Key:
|
||||
# KChar: c
|
||||
# Mods: [MCtrl]
|
||||
key-bindings:
|
||||
up:
|
||||
KUp: []
|
||||
@@ -46,41 +51,45 @@ meta-cache: 300 # in seconds
|
||||
# 2. Strict: fail hard
|
||||
meta-mode: Lax # Strict | Lax
|
||||
|
||||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
||||
# check the 'URLSource' type in the code.
|
||||
# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
|
||||
# union over tool versions, preferring the later entries.
|
||||
url-source:
|
||||
## Use the internal download uri, this is the default
|
||||
GHCupURL: []
|
||||
- GHCupURL
|
||||
|
||||
## Example 1: Read download info from this location instead
|
||||
## Accepts file/http/https scheme
|
||||
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
|
||||
## which case they are merged right-biased (overwriting duplicate versions).
|
||||
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
|
||||
## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata)
|
||||
# - StackSetupURL
|
||||
|
||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
|
||||
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
|
||||
# AddSource:
|
||||
# Left:
|
||||
# globalTools: {}
|
||||
# toolRequirements: {}
|
||||
# ghcupDownloads:
|
||||
# GHC:
|
||||
# 9.10.2:
|
||||
# viTags: []
|
||||
# viArch:
|
||||
# A_64:
|
||||
# Linux_UnknownLinux:
|
||||
# unknown_versioning:
|
||||
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
|
||||
# dlSubdir: ghc-7.10.3
|
||||
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
|
||||
## Add pre-release channel
|
||||
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||
## Add nightly channel
|
||||
# - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
|
||||
## Add cross compiler channel
|
||||
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
|
||||
|
||||
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
|
||||
## versions).
|
||||
# AddSource:
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
||||
## Use dwarf bindist for 9.4.7 for ghcup metadata
|
||||
# - ghcup-info:
|
||||
# ghcupDownloads:
|
||||
# GHC:
|
||||
# 9.4.7:
|
||||
# viTags: []
|
||||
# viArch:
|
||||
# A_64:
|
||||
# Linux_UnknownLinux:
|
||||
# unknown_versioning:
|
||||
# dlUri: https://downloads.haskell.org/ghc/9.4.7/ghc-9.4.7-x86_64-deb10-linux-dwarf.tar.xz
|
||||
# dlSubdir:
|
||||
# RegexDir: "ghc-.*"
|
||||
# dlHash: b261b3438ba455e3cf757f9c8dc3a06fdc061ea8ec287a65b7809e25fe18bad4
|
||||
|
||||
## for stack metadata and the linux64-tinfo6 bindists, use static alpine for 9.8.1
|
||||
# - setup-info:
|
||||
# ghc:
|
||||
# linux64-tinfo6:
|
||||
# 9.8.1:
|
||||
# url: "https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-alpine3_12-linux-static.tar.xz"
|
||||
# content-length: 229037440
|
||||
# sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3
|
||||
|
||||
# This is a way to override platform detection, e.g. when you're running
|
||||
# a Ubuntu derivate based on 18.04, you could do:
|
||||
|
||||
Submodule data/metadata updated: c88802ea8c...2efadd4588
@@ -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 && \
|
||||
|
||||
@@ -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 && \
|
||||
|
||||
@@ -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 && \
|
||||
|
||||
@@ -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 && \
|
||||
|
||||
@@ -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 && \
|
||||
|
||||
@@ -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 && \
|
||||
|
||||
161
docs/guide.md
161
docs/guide.md
@@ -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.
|
||||
@@ -89,7 +95,7 @@ platform-override:
|
||||
|
||||
This is the complete list of env variables that change GHCup behavior:
|
||||
|
||||
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
|
||||
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
|
||||
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
|
||||
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
|
||||
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
|
||||
@@ -147,8 +153,7 @@ To use a mirror, set the following option in `~/.ghcup/config.yaml`:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
# Accepts file/http/https scheme
|
||||
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
|
||||
- https://some-url/ghcup-0.0.6.yaml
|
||||
```
|
||||
|
||||
See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
|
||||
@@ -178,8 +183,8 @@ This will result in `~/.ghcup/config.yaml` to contain this record:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
AddSource:
|
||||
- Right: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||
- GHCupURL
|
||||
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||
```
|
||||
|
||||
You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
|
||||
@@ -189,64 +194,25 @@ To remove the channel, delete the entire `url-source` section or set it back to
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
GHCupURL: []
|
||||
- GHCupURL
|
||||
```
|
||||
|
||||
If you want to combine your release channel with a mirror, you'd do it like so:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
OwnSource:
|
||||
# base metadata
|
||||
- "https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml"
|
||||
# prerelease channel
|
||||
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
||||
```
|
||||
|
||||
### Nightlies
|
||||
|
||||
Nightlies are just a nother release channel. Currently, only GHC supports nightlies, which are binary releases
|
||||
that are built every night from `master`.
|
||||
|
||||
To add the nightly channel, run:
|
||||
|
||||
```sh
|
||||
ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
|
||||
```
|
||||
|
||||
To list all nightlies from 2023, run:
|
||||
|
||||
```sh
|
||||
ghcup list --show-nightly --tool=ghc --since=2023-01-01
|
||||
```
|
||||
|
||||
Ways to install a nightly:
|
||||
|
||||
```sh
|
||||
# by date
|
||||
ghcup install ghc 2023-06-20
|
||||
# by version
|
||||
ghcup install ghc 9.7.20230619
|
||||
# by tag
|
||||
ghcup install ghc latest-nightly
|
||||
```
|
||||
|
||||
## Stack integration
|
||||
|
||||
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
||||
GHC versions there are two strategies.
|
||||
|
||||
### Strategy 1: System GHC (works on all stack versions)
|
||||
|
||||
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
|
||||
run the following commands:
|
||||
|
||||
```sh
|
||||
stack config set install-ghc false --global
|
||||
stack config set system-ghc true --global
|
||||
```
|
||||
|
||||
### Strategy 2: Stack hooks (new, recommended)
|
||||
### Strategy 1: Stack hooks (new, recommended)
|
||||
|
||||
Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
|
||||
|
||||
@@ -268,6 +234,61 @@ stack config set system-ghc false --global
|
||||
By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
|
||||
this, run `stack config set install-ghc false --global`.
|
||||
|
||||
### Strategy 2: System GHC (works on all stack versions)
|
||||
|
||||
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
|
||||
run the following commands:
|
||||
|
||||
```sh
|
||||
stack config set install-ghc false --global
|
||||
stack config set system-ghc true --global
|
||||
```
|
||||
|
||||
### Using stack's setup-info metadata to install GHC
|
||||
|
||||
You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
|
||||
to install GHC. For that, you can invoke ghcup like so as a shorthand:
|
||||
|
||||
```sh
|
||||
# ghcup will only see GHC now
|
||||
ghcup -s StackSetupURL install ghc 9.4.7
|
||||
# this combines both ghcup and stack metadata
|
||||
ghcup -s '["GHCupURL", "StackSetupURL"]' install ghc 9.4.7
|
||||
```
|
||||
|
||||
To make this permanent and combine it with the GHCup metadata, you can add the following to your `~/.ghcup/config.yaml`:
|
||||
|
||||
```yaml
|
||||
url-source:
|
||||
- GHCupURL
|
||||
# stack versions take precedence
|
||||
# you'll still have access to GHCup provided versions and tools in case they don't exist in stack metadata
|
||||
- StackSetupURL
|
||||
```
|
||||
|
||||
You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:
|
||||
|
||||
```yaml
|
||||
url-source:
|
||||
- GHCupURL
|
||||
- StackSetupURL
|
||||
- setup-info:
|
||||
ghc:
|
||||
linux64-tinfo6:
|
||||
9.4.7:
|
||||
url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
|
||||
content-length: 179117892
|
||||
sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
|
||||
```
|
||||
|
||||
#### Caveats
|
||||
|
||||
The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
|
||||
when you try to install HLS.
|
||||
|
||||
Another potential usability issue is that the `latest` and `recommended` shorthands won't work anymore, since
|
||||
Stack metadata doesn't have a concept of those and we don't try to be smart when combining the metadatas.
|
||||
|
||||
### Windows
|
||||
|
||||
On windows, you may find the following config options useful too:
|
||||
@@ -478,8 +499,48 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
|
||||
|
||||
### github workflows
|
||||
|
||||
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
|
||||
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
|
||||
On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
|
||||
Here's an example workflow with a GHC matrix:
|
||||
|
||||
```yaml
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
fail-fast: true
|
||||
matrix:
|
||||
os: [ubuntu-22.04, macOS-latest]
|
||||
ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- name: Setup toolchain
|
||||
run: |
|
||||
ghcup install cabal --set recommended
|
||||
ghcup install ghc --set ${{ matrix.ghc }}
|
||||
- name: Build
|
||||
run: |
|
||||
cabal update
|
||||
cabal test all --test-show-details=direct
|
||||
|
||||
i386:
|
||||
runs-on: ubuntu-latest
|
||||
container:
|
||||
image: i386/ubuntu:bionic
|
||||
steps:
|
||||
- name: Install GHCup in container
|
||||
run: |
|
||||
apt-get update -y
|
||||
apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
|
||||
# we just go with recommended versions of cabal and GHC
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
|
||||
- uses: actions/checkout@v1
|
||||
- name: Test
|
||||
run: |
|
||||
# in containers we need to fix PATH
|
||||
source ~/.ghcup/env
|
||||
cabal update
|
||||
cabal test all --test-show-details=direct
|
||||
```
|
||||
|
||||
## GPG verification
|
||||
|
||||
@@ -489,8 +550,10 @@ this is cryptographically secure.
|
||||
First, obtain the gpg keys:
|
||||
|
||||
```sh
|
||||
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
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:
|
||||
|
||||
108
docs/install.md
108
docs/install.md
@@ -38,49 +38,85 @@ 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 && <= 12
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 12
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi8 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 && < 23
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 23
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
|
||||
|
||||
### 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`
|
||||
|
||||
Notice that only FreeBSD 13.x is supported. If the installation fails, complaining about `libncursesw.8.so`, you will need to install FreeBSD 12 compat package first, for example, `pkg install misc/compat12x`.
|
||||
|
||||
### 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
|
||||
@@ -104,14 +140,21 @@ 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.6.1</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
|
||||
<tr><td>9.8.1</td><td><span style="color:blue">latest</span>, base-4.19.0.0</td></tr>
|
||||
<tr><td>9.6.3</td><td>base-4.18.1.0</td></tr>
|
||||
<tr><td>9.6.2</td><td>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><span style="color:green">recommended</span>, 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.8</td><td>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><span style="color:green">recommended</span>, 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>
|
||||
@@ -149,7 +192,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.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>3.10.2.0</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>3.10.1.0</td><td></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>
|
||||
@@ -166,8 +210,15 @@ 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.9.1.0</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>1.9.0.0</td><td><span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.3.0.0</td><td></td></tr>
|
||||
<tr><td>2.2.0.0</td><td></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>
|
||||
@@ -186,7 +237,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.3</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.13.1</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>2.11.1</td><td><span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.9.3</td><td></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>
|
||||
@@ -200,7 +253,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 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
@@ -256,7 +309,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: `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C` 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:
|
||||
|
||||
@@ -318,6 +378,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).
|
||||
|
||||
188
ghcup.cabal
188
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 2.4
|
||||
name: ghcup
|
||||
version: 0.1.19.4
|
||||
version: 0.1.20.0
|
||||
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
|
||||
@@ -36,7 +36,7 @@ source-repository head
|
||||
|
||||
flag tui
|
||||
description:
|
||||
Build the brick powered tui (ghcup tui). This is disabled on windows.
|
||||
Build the brick powered tui (ghcup tui).
|
||||
|
||||
default: False
|
||||
manual: True
|
||||
@@ -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 && <0.14
|
||||
, versions >=6.0.3 && <6.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
GHCup
|
||||
@@ -80,7 +117,9 @@ library
|
||||
GHCup.Types
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.JSON.Utils
|
||||
GHCup.Types.JSON.Versions
|
||||
GHCup.Types.Optics
|
||||
GHCup.Types.Stack
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Version
|
||||
@@ -137,7 +176,7 @@ library
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, regex-posix ^>=0.96
|
||||
, resourcet ^>=1.2.2
|
||||
, retry ^>=0.8.1.2 || ^>=0.9
|
||||
, retry >=0.8.1.2 && <0.10
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, split ^>=0.2.3.4
|
||||
@@ -146,13 +185,13 @@ library
|
||||
, template-haskell >=2.7 && <2.20
|
||||
, temporary ^>=1.3
|
||||
, text ^>=2.0
|
||||
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
|
||||
, 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
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.3 && <6.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml-streamly ^>=0.12.0
|
||||
, zlib ^>=0.6.2.2
|
||||
@@ -197,13 +236,13 @@ library
|
||||
, unix ^>=2.7
|
||||
, unix-bytestring ^>=0.3.7.3
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
build-depends: vty ^>=5.37
|
||||
build-depends: vty ^>=6.0
|
||||
|
||||
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 +263,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)
|
||||
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,53 +314,19 @@ 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
|
||||
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
|
||||
, 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
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
other-modules: BrickMain
|
||||
build-depends:
|
||||
, brick ^>=1.5
|
||||
, brick ^>=2.1
|
||||
, transformers ^>=0.5
|
||||
, unix ^>=2.7
|
||||
, vty ^>=5.37
|
||||
, vty ^>=6.0
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
@@ -302,7 +341,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,13 +375,50 @@ test-suite ghcup-test
|
||||
, QuickCheck ^>=2.14.1
|
||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||
, streamly ^>=0.8.2
|
||||
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
|
||||
, 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
|
||||
|
||||
4
hie.yaml
4
hie.yaml
@@ -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
|
||||
@@ -57,16 +57,13 @@ import GHCup.Types
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
|
||||
|
||||
data Options = Options
|
||||
@@ -77,12 +74,13 @@ data Options = Options
|
||||
, optMetaCache :: Maybe Integer
|
||||
, optMetaMode :: Maybe MetaMode
|
||||
, optPlatform :: Maybe PlatformRequest
|
||||
, optUrlSource :: Maybe URI
|
||||
, optUrlSource :: Maybe URLSource
|
||||
, optNoVerify :: Maybe Bool
|
||||
, optKeepDirs :: Maybe KeepDirs
|
||||
, optsDownloader :: Maybe Downloader
|
||||
, optNoNetwork :: Maybe Bool
|
||||
, optGpg :: Maybe GPGSetting
|
||||
, optStackSetup :: Maybe Bool
|
||||
-- commands
|
||||
, optCommand :: Command
|
||||
}
|
||||
@@ -134,13 +132,13 @@ opts =
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader parseUri)
|
||||
(eitherReader parseUrlSource)
|
||||
( short 's'
|
||||
<> long "url-source"
|
||||
<> metavar "URL"
|
||||
<> help "Alternative ghcup download info url"
|
||||
<> metavar "URL_SOURCE"
|
||||
<> help "Alternative ghcup download info"
|
||||
<> internal
|
||||
<> completer fileUri
|
||||
<> completer urlSourceCompleter
|
||||
)
|
||||
)
|
||||
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
|
||||
@@ -178,10 +176,9 @@ opts =
|
||||
"GPG verification (default: none)"
|
||||
<> completer (listCompleter ["strict", "lax", "none"])
|
||||
))
|
||||
<*> invertableSwitch "stack-setup" (Just 's') False (help "Use stack's setup info for discovering and installing GHC versions")
|
||||
<*> com
|
||||
where
|
||||
parseUri s' =
|
||||
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
|
||||
|
||||
|
||||
|
||||
com :: Parser Command
|
||||
@@ -49,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
|
||||
{ clOpen :: Bool
|
||||
, clTool :: Maybe Tool
|
||||
, clToolVer :: Maybe ToolVersion
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -75,7 +75,7 @@ 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
|
||||
)
|
||||
@@ -48,7 +48,7 @@ import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Time.Calendar ( Day )
|
||||
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Versions
|
||||
import Data.Void
|
||||
import qualified Data.Vector as V
|
||||
import GHC.IO.Exception
|
||||
@@ -64,6 +64,8 @@ import URI.ByteString
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Encoding as LE
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified System.FilePath.Posix as FP
|
||||
import GHCup.Version
|
||||
@@ -83,6 +85,7 @@ data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||
| SetToolDay Day
|
||||
| SetRecommended
|
||||
| SetNext
|
||||
deriving (Eq, Show)
|
||||
|
||||
prettyToolVer :: ToolVersion -> String
|
||||
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
||||
@@ -208,19 +211,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
)
|
||||
]
|
||||
distroP :: MP.Parsec Void Text LinuxDistro
|
||||
distroP = choice'
|
||||
[ MP.chunk "debian" $> Debian
|
||||
, MP.chunk "deb" $> Debian
|
||||
, MP.chunk "ubuntu" $> Ubuntu
|
||||
, MP.chunk "mint" $> Mint
|
||||
, MP.chunk "fedora" $> Fedora
|
||||
, MP.chunk "centos" $> CentOS
|
||||
, MP.chunk "redhat" $> RedHat
|
||||
, MP.chunk "alpine" $> Alpine
|
||||
, MP.chunk "gentoo" $> Gentoo
|
||||
, MP.chunk "exherbo" $> Exherbo
|
||||
, MP.chunk "unknown" $> UnknownLinux
|
||||
]
|
||||
distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
|
||||
|
||||
|
||||
uriParser :: String -> Either String URI
|
||||
@@ -333,6 +324,15 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
|
||||
gitFileUri :: [String] -> Completer
|
||||
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
|
||||
|
||||
urlSourceCompleter :: Completer
|
||||
urlSourceCompleter = mkCompleter $ urlSourceCompleter' []
|
||||
|
||||
urlSourceCompleter' :: [String] -> String -> IO [String]
|
||||
urlSourceCompleter' add str' = do
|
||||
let static = ["GHCupURL", "StackSetupURL"]
|
||||
file <- fileUri' add str'
|
||||
pure $ static ++ file
|
||||
|
||||
fileUri :: Completer
|
||||
fileUri = mkCompleter $ fileUri' []
|
||||
|
||||
@@ -366,7 +366,7 @@ fileUri' add = \case
|
||||
-- We need to do this so bash doesn't expand out any ~ or other
|
||||
-- chars we want to complete on, or emit an end of line error
|
||||
-- when seeking the close to the quote.
|
||||
--
|
||||
--
|
||||
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
|
||||
requote :: String -> String
|
||||
requote s =
|
||||
@@ -461,13 +461,15 @@ tagCompleter tool add = listIOCompleter $ do
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
|
||||
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
|
||||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (/= Old)
|
||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
|
||||
mpFreq <- flip runReaderT appState . runE $ platformRequest
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq
|
||||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (/= Old)
|
||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
|
||||
|
||||
versionCompleter :: [ListCriteria] -> Tool -> Completer
|
||||
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
|
||||
@@ -488,8 +490,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
|
||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||
let appState = AppState
|
||||
settings
|
||||
@@ -823,8 +825,20 @@ 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
|
||||
|
||||
parseUrlSource :: String -> Either String URLSource
|
||||
parseUrlSource "GHCupURL" = pure GHCupURL
|
||||
parseUrlSource "StackSetupURL" = pure StackSetupURL
|
||||
parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
|
||||
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
|
||||
|
||||
parseNewUrlSource :: String -> Either String NewURLSource
|
||||
parseNewUrlSource "GHCupURL" = pure NewGHCupURL
|
||||
parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
|
||||
parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
|
||||
<|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
|
||||
|
||||
@@ -57,6 +57,7 @@ import Text.Read (readEither)
|
||||
|
||||
data CompileCommand = CompileGHC GHCCompileOptions
|
||||
| CompileHLS HLSCompileOptions
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
@@ -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")
|
||||
)
|
||||
)
|
||||
@@ -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")
|
||||
)
|
||||
)
|
||||
@@ -577,7 +584,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
patches
|
||||
addConfArgs
|
||||
buildFlavour
|
||||
hadrian
|
||||
buildSystem
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
@@ -32,7 +32,6 @@ import Options.Applicative hiding ( style, ParseError )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
@@ -51,7 +50,8 @@ data ConfigCommand
|
||||
= ShowConfig
|
||||
| SetConfig String (Maybe String)
|
||||
| InitConfig
|
||||
| AddReleaseChannel Bool URI
|
||||
| AddReleaseChannel Bool NewURLSource
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -74,8 +74,8 @@ configP = subparser
|
||||
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
|
||||
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
|
||||
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
|
||||
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
|
||||
(progDesc "Add a release channel from a URI")
|
||||
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader parseNewUrlSource) (metavar "URL_SOURCE" <> completer urlSourceCompleter))
|
||||
(progDesc "Add a release channel, e.g. from a URI")
|
||||
|
||||
|
||||
|
||||
@@ -206,27 +206,15 @@ config configCommand settings userConf keybindings runLogger = case configComman
|
||||
pure $ ExitFailure 65
|
||||
VLeft _ -> pure $ ExitFailure 65
|
||||
|
||||
AddReleaseChannel force uri -> do
|
||||
AddReleaseChannel force new -> do
|
||||
r <- runE @'[DuplicateReleaseChannel] $ do
|
||||
case urlSource settings of
|
||||
AddSource xs -> do
|
||||
case checkDuplicate xs (Right uri) of
|
||||
Duplicate
|
||||
| not force -> throwE (DuplicateReleaseChannel uri)
|
||||
DuplicateLast -> pure ()
|
||||
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (appendUnique xs (Right uri)) })
|
||||
GHCupURL -> do
|
||||
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||
pure ()
|
||||
OwnSource xs -> do
|
||||
case checkDuplicate xs (Right uri) of
|
||||
Duplicate
|
||||
| not force -> throwE (DuplicateReleaseChannel uri)
|
||||
DuplicateLast -> pure ()
|
||||
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (appendUnique xs (Right uri)) })
|
||||
OwnSpec spec -> do
|
||||
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource [Left spec, Right uri] })
|
||||
pure ()
|
||||
let oldSources = fromURLSource (urlSource settings)
|
||||
let merged = oldSources ++ [new]
|
||||
case checkDuplicate oldSources new of
|
||||
Duplicate
|
||||
| not force -> throwE (DuplicateReleaseChannel new)
|
||||
DuplicateLast -> pure ()
|
||||
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ SimpleList merged })
|
||||
case r of
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
@@ -241,15 +229,6 @@ config configCommand settings userConf keybindings runLogger = case configComman
|
||||
| a `elem` xs = Duplicate
|
||||
| otherwise = NoDuplicate
|
||||
|
||||
-- appends the element to the end of the list, but also removes it from the existing list
|
||||
appendUnique :: Eq a => [a] -> a -> [a]
|
||||
appendUnique xs' e = go xs'
|
||||
where
|
||||
go [] = [e]
|
||||
go (x:xs)
|
||||
| x == e = go xs -- skip
|
||||
| otherwise = x : go xs
|
||||
|
||||
doConfig :: MonadIO m => UserSettings -> m ()
|
||||
doConfig usersettings = do
|
||||
let settings' = updateSettings usersettings userConf
|
||||
@@ -47,7 +47,7 @@ data GCOptions = GCOptions
|
||||
, gcHLSNoGHC :: Bool
|
||||
, gcCache :: Bool
|
||||
, gcTmp :: Bool
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions
|
||||
| InstallCabal InstallOptions
|
||||
| InstallHLS InstallOptions
|
||||
| InstallStack InstallOptions
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -62,7 +63,6 @@ data InstallCommand = InstallGHC InstallOptions
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data InstallOptions = InstallOptions
|
||||
{ instVer :: Maybe ToolVersion
|
||||
, instBindist :: Maybe URI
|
||||
@@ -70,7 +70,7 @@ data InstallOptions = InstallOptions
|
||||
, isolateDir :: Maybe FilePath
|
||||
, forceInstall :: Bool
|
||||
, addConfArgs :: [T.Text]
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -133,7 +133,7 @@ installParser =
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> installOpts Nothing)
|
||||
<|> (Right <$> installOpts (Just GHC))
|
||||
where
|
||||
installHLSFooter :: String
|
||||
installHLSFooter = [s|Discussion:
|
||||
@@ -196,7 +196,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")
|
||||
)
|
||||
)
|
||||
@@ -290,6 +290,11 @@ type InstallGHCEffects = '[ AlreadyInstalled
|
||||
, UninstallFailed
|
||||
, UnknownArchive
|
||||
, InstallSetError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
runInstGHC :: AppState
|
||||
@@ -309,13 +314,13 @@ runInstGHC appstate' =
|
||||
|
||||
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
|
||||
install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(Right iopts) -> do
|
||||
(Right iGHCopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
|
||||
installGHC iopts
|
||||
(Left (InstallGHC iopts)) -> installGHC iopts
|
||||
(Left (InstallCabal iopts)) -> installCabal iopts
|
||||
(Left (InstallHLS iopts)) -> installHLS iopts
|
||||
(Left (InstallStack iopts)) -> installStack iopts
|
||||
installGHC iGHCopts
|
||||
(Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
|
||||
(Left (InstallCabal iopts)) -> installCabal iopts
|
||||
(Left (InstallHLS iopts)) -> installHLS iopts
|
||||
(Left (InstallStack iopts)) -> installStack iopts
|
||||
where
|
||||
installGHC :: InstallOptions -> IO ExitCode
|
||||
installGHC InstallOptions{..} = do
|
||||
@@ -27,7 +27,7 @@ import Data.List ( intercalate, sort )
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Time.Calendar ( Day )
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Versions
|
||||
import Data.Void
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
@@ -58,7 +58,7 @@ data ListOptions = ListOptions
|
||||
, lHideOld :: Bool
|
||||
, lShowNightly :: Bool
|
||||
, lRawFormat :: Bool
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -180,7 +180,6 @@ 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
|
||||
@@ -14,6 +14,7 @@ module GHCup.OptParse.Prefetch where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.String.QQ
|
||||
@@ -157,7 +158,9 @@ type PrefetchEffects = '[ TagNotFound
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, JSONError
|
||||
, FileDoesNotExistError ]
|
||||
, FileDoesNotExistError
|
||||
, StackPlatformDetectError
|
||||
]
|
||||
|
||||
|
||||
runPrefetch :: MonadUnliftIO m
|
||||
@@ -210,7 +213,8 @@ prefetch prefetchCommand runAppState runLogger =
|
||||
(v, _) <- liftE $ fromVersion mt Stack
|
||||
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
|
||||
PrefetchMetadata -> do
|
||||
_ <- liftE getDownloadsF
|
||||
pfreq <- lift getPlatformReq
|
||||
_ <- liftE $ getDownloadsF pfreq
|
||||
pure ""
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
@@ -68,7 +68,7 @@ data RunOptions = RunOptions
|
||||
, runBinDir :: Maybe FilePath
|
||||
, runQuick :: Bool
|
||||
, runCOMMAND :: [String]
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -187,6 +187,11 @@ type RunEffects = '[ AlreadyInstalled
|
||||
, ProcessError
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
|
||||
@@ -226,6 +231,7 @@ run :: forall m .
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, Alternative m
|
||||
)
|
||||
=> RunOptions
|
||||
-> IO AppState
|
||||
@@ -255,7 +261,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
liftIO $ putStr tmp
|
||||
pure ExitSuccess
|
||||
(cmd:args) -> do
|
||||
newEnv <- liftIO $ addToPath tmp runAppendPATH
|
||||
newEnv <- liftIO $ addToPath [tmp] runAppendPATH
|
||||
let pathVar = if isWindows then "Path" else "PATH"
|
||||
forM_ (Map.lookup pathVar . Map.fromList $ newEnv) $ liftIO . setEnv pathVar
|
||||
#ifndef IS_WINDOWS
|
||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||
pure ExitSuccess
|
||||
@@ -329,6 +337,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, Alternative m
|
||||
)
|
||||
=> Toolchain
|
||||
-> FilePath
|
||||
@@ -354,6 +363,11 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
, CopyError
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
] (ResourceT (ReaderT AppState m)) ()
|
||||
installToolChainFull Toolchain{..} tmp = do
|
||||
case ghcVer of
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
@@ -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:
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
23
lib/GHCup.hs
23
lib/GHCup.hs
@@ -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
|
||||
|
||||
@@ -5,7 +5,6 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
|
||||
{-|
|
||||
Module : GHCup.Download
|
||||
Description : Downloading
|
||||
@@ -31,9 +30,11 @@ import GHCup.Download.Utils
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import qualified GHCup.Types.Stack as Stack
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Platform
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger.Internal
|
||||
@@ -55,6 +56,7 @@ import Data.ByteString ( ByteString )
|
||||
import Data.CaseInsensitive ( mk )
|
||||
#endif
|
||||
import Data.Maybe
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock.POSIX
|
||||
@@ -112,24 +114,71 @@ getDownloadsF :: ( FromJSONKey Tool
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Excepts
|
||||
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
=> PlatformRequest
|
||||
-> Excepts
|
||||
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
|
||||
m
|
||||
GHCupInfo
|
||||
getDownloadsF = do
|
||||
getDownloadsF pfreq@(PlatformRequest arch plat _) = do
|
||||
Settings { urlSource } <- lift getSettings
|
||||
case urlSource of
|
||||
GHCupURL -> liftE $ getBase ghcupURL
|
||||
(OwnSource exts) -> do
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo ext
|
||||
(OwnSpec av) -> pure av
|
||||
(AddSource exts) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo (base:ext)
|
||||
|
||||
let newUrlSources = fromURLSource urlSource
|
||||
infos <- liftE $ mapM dl' newUrlSources
|
||||
keys <- if any isRight infos
|
||||
then liftE . reThrowAll @_ @_ @'[StackPlatformDetectError] StackPlatformDetectError $ getStackPlatformKey pfreq
|
||||
else pure []
|
||||
ghcupInfos <- fmap catMaybes $ forM infos $ \case
|
||||
Left gi -> pure (Just gi)
|
||||
Right si -> pure $ fromStackSetupInfo si keys
|
||||
mergeGhcupInfo ghcupInfos
|
||||
where
|
||||
|
||||
dl' :: ( FromJSONKey Tool
|
||||
, FromJSONKey Version
|
||||
, FromJSON VersionInfo
|
||||
, MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> NewURLSource
|
||||
-> Excepts
|
||||
'[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
|
||||
m (Either GHCupInfo Stack.SetupInfo)
|
||||
dl' NewGHCupURL = fmap Left $ liftE $ getBase @GHCupInfo ghcupURL
|
||||
dl' NewStackSetupURL = fmap Right $ liftE $ getBase @Stack.SetupInfo stackSetupURL
|
||||
dl' (NewGHCupInfo gi) = pure (Left gi)
|
||||
dl' (NewSetupInfo si) = pure (Right si)
|
||||
dl' (NewURI uri) = catchE @JSONError (\(JSONDecodeError _) -> Right <$> getBase @Stack.SetupInfo uri)
|
||||
$ fmap Left $ getBase @GHCupInfo uri
|
||||
|
||||
fromStackSetupInfo :: MonadThrow m
|
||||
=> Stack.SetupInfo
|
||||
-> [String]
|
||||
-> m GHCupInfo
|
||||
fromStackSetupInfo (Stack.siGHCs -> ghcDli) keys = do
|
||||
let ghcVersionsPerKey = (`M.lookup` ghcDli) <$> (T.pack <$> keys)
|
||||
ghcVersions = fromMaybe mempty . listToMaybe . catMaybes $ ghcVersionsPerKey
|
||||
(ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
|
||||
M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
|
||||
let ghcupDownloads' = M.singleton GHC (M.map fromDownloadInfo ghcupInfo')
|
||||
pure (GHCupInfo mempty ghcupDownloads' mempty)
|
||||
where
|
||||
fromDownloadInfo :: DownloadInfo -> VersionInfo
|
||||
fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
|
||||
in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
|
||||
|
||||
fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
|
||||
fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
|
||||
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
|
||||
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
|
||||
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
|
||||
|
||||
|
||||
mergeGhcupInfo :: MonadFail m
|
||||
=> [GHCupInfo]
|
||||
-> m GHCupInfo
|
||||
@@ -141,6 +190,7 @@ getDownloadsF = do
|
||||
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
|
||||
|
||||
|
||||
|
||||
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
|
||||
yamlFromCache uri = do
|
||||
Dirs{..} <- getDirs
|
||||
@@ -151,7 +201,7 @@ etagsFile :: FilePath -> FilePath
|
||||
etagsFile = (<.> "etags")
|
||||
|
||||
|
||||
getBase :: ( MonadReader env m
|
||||
getBase :: forall j m env . ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadFail m
|
||||
@@ -159,9 +209,10 @@ getBase :: ( MonadReader env m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
, FromJSON j
|
||||
)
|
||||
=> URI
|
||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
|
||||
getBase uri = do
|
||||
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
||||
|
||||
@@ -296,7 +347,7 @@ getDownloadInfo' :: ( MonadReader env m
|
||||
m
|
||||
DownloadInfo
|
||||
getDownloadInfo' t v = do
|
||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
||||
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
let distro_preview f g =
|
||||
@@ -317,7 +368,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
|
||||
@@ -326,6 +377,7 @@ getDownloadInfo' t v = do
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- | Tries to download from the given http or https url
|
||||
-- and saves the result in continuous memory into a file.
|
||||
-- If the filename is not provided, then we:
|
||||
|
||||
@@ -87,6 +87,7 @@ allHFError = unlines allErrors
|
||||
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
|
||||
, let proxy = Proxy :: Proxy ContentLengthError in format proxy
|
||||
, let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
|
||||
, let proxy = Proxy :: Proxy UnsupportedSetupCombo in format proxy
|
||||
, ""
|
||||
, "# high level errors (4000+)"
|
||||
, let proxy = Proxy :: Proxy DownloadFailed in format proxy
|
||||
@@ -99,6 +100,7 @@ allHFError = unlines allErrors
|
||||
, let proxy = Proxy :: Proxy ParseError in format proxy
|
||||
, let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
|
||||
, let proxy = Proxy :: Proxy NoUrlBase in format proxy
|
||||
, let proxy = Proxy :: Proxy DigestMissing in format proxy
|
||||
, ""
|
||||
, "# orphans (800+)"
|
||||
, let proxy = Proxy :: Proxy URIParseError in format proxy
|
||||
@@ -206,12 +208,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
|
||||
@@ -660,18 +676,29 @@ instance HFErrorProject ContentLengthError where
|
||||
eBase _ = 340
|
||||
eDesc _ = "File content length verification failed"
|
||||
|
||||
data DuplicateReleaseChannel = DuplicateReleaseChannel URI
|
||||
data DuplicateReleaseChannel = DuplicateReleaseChannel NewURLSource
|
||||
deriving Show
|
||||
|
||||
instance HFErrorProject DuplicateReleaseChannel where
|
||||
eBase _ = 350
|
||||
eDesc _ = "Duplicate release channel detected when adding URI.\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
|
||||
eDesc _ = "Duplicate release channel detected when adding new source.\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
|
||||
|
||||
instance Pretty DuplicateReleaseChannel where
|
||||
pPrint (DuplicateReleaseChannel uri) =
|
||||
pPrint (DuplicateReleaseChannel source) =
|
||||
text $ "Duplicate release channel detected when adding: \n "
|
||||
<> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
|
||||
<> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
|
||||
<> show source
|
||||
<> "\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
|
||||
|
||||
data UnsupportedSetupCombo = UnsupportedSetupCombo Architecture Platform
|
||||
deriving Show
|
||||
|
||||
instance Pretty UnsupportedSetupCombo where
|
||||
pPrint (UnsupportedSetupCombo arch plat) =
|
||||
text "Could not find a compatible setup combo for:" <+> pPrint arch <+> pPrint plat
|
||||
|
||||
instance HFErrorProject UnsupportedSetupCombo where
|
||||
eBase _ = 360
|
||||
eDesc _ = "Could not find a compatible setup combo"
|
||||
|
||||
-------------------------
|
||||
--[ High-level errors ]--
|
||||
@@ -760,6 +787,22 @@ instance HFErrorProject GHCupSetError where
|
||||
eNum (GHCupSetError xs) = 9000 + eNum xs
|
||||
eDesc _ = "Setting the current version failed."
|
||||
|
||||
-- | Executing stacks platform detection failed.
|
||||
data StackPlatformDetectError = forall es . (ToVariantMaybe StackPlatformDetectError es, PopVariant StackPlatformDetectError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => StackPlatformDetectError (V es)
|
||||
|
||||
instance Pretty StackPlatformDetectError where
|
||||
pPrint (StackPlatformDetectError reason) =
|
||||
case reason of
|
||||
VMaybe (_ :: StackPlatformDetectError) -> pPrint reason
|
||||
_ -> text "Running stack platform detection logic failed:" <+> pPrint reason
|
||||
|
||||
deriving instance Show StackPlatformDetectError
|
||||
|
||||
instance HFErrorProject StackPlatformDetectError where
|
||||
eBase _ = 6000
|
||||
eNum (StackPlatformDetectError xs) = 6000 + eNum xs
|
||||
eDesc _ = "Running stack platform detection logic failed."
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
--[ True Exceptions (e.g. for MonadThrow) ]--
|
||||
@@ -807,6 +850,18 @@ instance HFErrorProject NoUrlBase where
|
||||
eBase _ = 520
|
||||
eDesc _ = "URL does not have a base filename."
|
||||
|
||||
data DigestMissing = DigestMissing URI
|
||||
deriving Show
|
||||
|
||||
instance Pretty DigestMissing where
|
||||
pPrint (DigestMissing uri) =
|
||||
text "Digest missing for:" <+> (text . T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
|
||||
|
||||
instance Exception DigestMissing
|
||||
|
||||
instance HFErrorProject DigestMissing where
|
||||
eBase _ = 530
|
||||
eDesc _ = "An expected digest is missing."
|
||||
|
||||
|
||||
------------------------
|
||||
|
||||
231
lib/GHCup/GHC.hs
231
lib/GHCup/GHC.hs
@@ -74,6 +74,7 @@ import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import qualified Data.ByteString.Base16 as B16
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
@@ -83,6 +84,7 @@ import qualified Text.Megaparsec as MP
|
||||
data GHCVer = SourceDist Version
|
||||
| GitDist GitBranch
|
||||
| RemoteDist URI
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -125,7 +127,7 @@ testGHCVer ver addMakeArgs = do
|
||||
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||
?? NoDownload
|
||||
?? NoDownload ver GHC Nothing
|
||||
|
||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||
|
||||
@@ -215,7 +217,9 @@ 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
|
||||
env <- liftIO $ addToPath [ghcBinDir] False
|
||||
let pathVar = if isWindows then "Path" else "PATH"
|
||||
forM_ (Map.lookup pathVar . Map.fromList $ env) $ liftIO . setEnv pathVar
|
||||
|
||||
lEM $ make' (fmap T.unpack addMakeArgs)
|
||||
(Just $ fromGHCupPath path)
|
||||
@@ -260,7 +264,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
|
||||
|
||||
|
||||
@@ -433,11 +437,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
|
||||
-- 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 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
|
||||
liftE $ mergeGHCFileTree path inst tver forceInstall
|
||||
| otherwise = do
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
|
||||
@@ -459,7 +459,36 @@ installUnpackedGHC path inst tver 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
|
||||
tver
|
||||
@@ -468,8 +497,6 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
|
||||
install f t (not forceInstall)
|
||||
forM_ mtime $ setModificationTime t)
|
||||
|
||||
pure ()
|
||||
|
||||
|
||||
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
||||
-- following symlinks in @~\/.ghcup\/bin@:
|
||||
@@ -488,6 +515,7 @@ installGHCBin :: ( MonadFail m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, Alternative m
|
||||
)
|
||||
=> GHCTargetVersion -- ^ the version to install
|
||||
-> InstallDir
|
||||
@@ -509,6 +537,11 @@ installGHCBin :: ( MonadFail m
|
||||
, ProcessError
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -708,7 +741,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
|
||||
@@ -764,7 +797,7 @@ compileGHC :: ( MonadMask m
|
||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||
-> [Text] -- ^ additional args to ./configure
|
||||
-> Maybe String -- ^ build flavour
|
||||
-> Bool
|
||||
-> Maybe BuildSystem
|
||||
-> InstallDir
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@@ -793,9 +826,9 @@ compileGHC :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
GHCTargetVersion
|
||||
compileGHC targetGhc crossTarget 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
|
||||
@@ -804,9 +837,10 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
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 (mkTVer ver) % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
preview (ix GHC % ix tver % viSourceDL % _Just) dls
|
||||
?? NoDownload tver GHC (Just pfreq)
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
|
||||
-- unpack
|
||||
@@ -905,7 +939,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
-- compiled version, so the user can overwrite it
|
||||
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)
|
||||
@@ -924,16 +958,31 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
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
|
||||
@@ -953,8 +1002,6 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
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
|
||||
@@ -977,13 +1024,22 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
=> 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")))
|
||||
@@ -1020,12 +1076,13 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
|
||||
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
|
||||
@@ -1058,6 +1115,9 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadResource m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath
|
||||
@@ -1069,6 +1129,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
, PatchFailed
|
||||
, ProcessError
|
||||
, NotFoundInPATH
|
||||
, MergeFileTreeError
|
||||
, CopyError]
|
||||
m
|
||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||
@@ -1090,7 +1151,9 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
|
||||
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..."
|
||||
@@ -1208,64 +1271,50 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
||||
()
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -75,6 +75,7 @@ data HLSVer = SourceDist Version
|
||||
| GitDist GitBranch
|
||||
| HackageDist Version
|
||||
| RemoteDist URI
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -354,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
|
||||
|
||||
@@ -370,7 +371,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
||||
-- download source tarball
|
||||
dlInfo <-
|
||||
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
?? NoDownload (mkTVer tver) HLS (Just pfreq)
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
|
||||
-- unpack
|
||||
@@ -716,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
|
||||
|
||||
@@ -65,7 +65,7 @@ import qualified Data.Text as T
|
||||
data ListCriteria = ListInstalled Bool
|
||||
| ListSet Bool
|
||||
| ListAvailable Bool
|
||||
deriving Show
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A list result describes a single tool version
|
||||
-- and various of its properties.
|
||||
@@ -76,7 +76,6 @@ 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
|
||||
@@ -169,7 +168,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
Just _ -> pure Nothing
|
||||
Nothing -> do
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
||||
fromSrc <- ghcSrcInstalled tver
|
||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
||||
pure $ Just $ ListResult
|
||||
{ lTool = GHC
|
||||
@@ -213,7 +211,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup ver avTools)
|
||||
, lNoBindist = False
|
||||
, fromSrc = False -- actually, we don't know :>
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
@@ -248,7 +245,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup ver avTools)
|
||||
, lNoBindist = False
|
||||
, fromSrc = False -- actually, we don't know :>
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
@@ -284,7 +280,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup ver avTools)
|
||||
, lNoBindist = False
|
||||
, fromSrc = False -- actually, we don't know :>
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
@@ -306,7 +301,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||
, lCross = Nothing
|
||||
, lTool = GHCup
|
||||
, fromSrc = False
|
||||
, lStray = isNothing listVer
|
||||
, lSet = True
|
||||
, lInstalled = True
|
||||
@@ -340,7 +334,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
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 tver) (fmap mkTVer <$> hlsGHCVersions)
|
||||
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
|
||||
Cabal -> do
|
||||
@@ -351,7 +344,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lCross = Nothing
|
||||
, lTag = _viTags
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
@@ -364,7 +356,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lTag = _viTags
|
||||
, lCross = Nothing
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, lNoBindist = False
|
||||
, hlsPowered = False
|
||||
@@ -379,7 +370,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lCross = Nothing
|
||||
, lTag = _viTags
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
@@ -393,7 +383,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
||||
, lCross = Nothing
|
||||
, lTag = _viTags
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
|
||||
@@ -28,6 +28,8 @@ import GHCup.Prelude
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prelude.String.QQ
|
||||
import GHCup.Prelude.Version.QQ
|
||||
import GHCup.Prelude.MegaParsec
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -48,11 +50,18 @@ import Prelude hiding ( abs
|
||||
)
|
||||
import System.Info
|
||||
import System.OsRelease
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Void
|
||||
import qualified Data.List as L
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -197,3 +206,155 @@ getLinuxDistro = do
|
||||
try_debian_version = do
|
||||
ver <- T.readFile debian_version
|
||||
pure (T.pack "debian", Just ver)
|
||||
|
||||
|
||||
getStackGhcBuilds :: (MonadReader env m, HasLog env, MonadIO m)
|
||||
=> PlatformResult
|
||||
-> Excepts '[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError] m [String]
|
||||
getStackGhcBuilds PlatformResult{..} = do
|
||||
case _platform of
|
||||
Linux _ -> do
|
||||
-- Some systems don't have ldconfig in the PATH, so make sure to look in
|
||||
-- /sbin and /usr/sbin as well
|
||||
sbinEnv <- liftIO $ addToPath sbinDirs False
|
||||
ldConfig <- lift $ executeOut' "ldconfig" ["-p"] Nothing (Just sbinEnv)
|
||||
firstWords <- case ldConfig of
|
||||
CapturedProcess ExitSuccess so _ ->
|
||||
pure . mapMaybe (listToMaybe . T.words) . T.lines . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ so
|
||||
CapturedProcess (ExitFailure _) _ _ ->
|
||||
-- throwE $ NonZeroExit c "ldconfig" ["-p" ]
|
||||
pure []
|
||||
let checkLib :: (MonadReader env m, HasLog env, MonadIO m) => String -> m Bool
|
||||
checkLib lib
|
||||
| libT `elem` firstWords = do
|
||||
logDebug $ "Found shared library " <> libT <> " in 'ldconfig -p' output"
|
||||
pure True
|
||||
| isWindows =
|
||||
-- Cannot parse /usr/lib on Windows
|
||||
pure False
|
||||
| otherwise = hasMatches lib usrLibDirs
|
||||
-- This is a workaround for the fact that libtinfo.so.x doesn't
|
||||
-- appear in the 'ldconfig -p' output on Arch or Slackware even
|
||||
-- when it exists. There doesn't seem to be an easy way to get the
|
||||
-- true list of directories to scan for shared libs, but this
|
||||
-- works for our particular cases.
|
||||
where
|
||||
libT = T.pack lib
|
||||
|
||||
hasMatches :: (MonadReader env m, HasLog env, MonadIO m) => String -> [FilePath] -> m Bool
|
||||
hasMatches lib dirs = do
|
||||
matches <- filterM (liftIO . doesFileExist . (</> lib)) dirs
|
||||
case matches of
|
||||
[] -> logDebug ("Did not find shared library " <> libT) >> pure False
|
||||
(path:_) -> logDebug ("Found shared library " <> libT <> " in " <> T.pack path) >> pure True
|
||||
where
|
||||
libT = T.pack lib
|
||||
|
||||
getLibc6Version :: MonadIO m
|
||||
=> Excepts '[ParseError, ProcessError] m Version
|
||||
getLibc6Version = do
|
||||
CapturedProcess{..} <- lift $ executeOut "ldd" ["--version"] Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> either (throwE . ParseError . show) pure
|
||||
. MP.parse lddVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure c -> throwE $ NonZeroExit c "ldd" ["--version" ]
|
||||
|
||||
-- Assumes the first line of ldd has the format:
|
||||
--
|
||||
-- ldd (...) nn.nn
|
||||
--
|
||||
-- where nn.nn corresponds to the version of libc6.
|
||||
lddVersion :: MP.Parsec Void Text Version
|
||||
lddVersion = do
|
||||
skipWhile (/= ')')
|
||||
skip (== ')')
|
||||
skipSpace
|
||||
version'
|
||||
|
||||
hasMusl <- hasMatches relFileLibcMuslx86_64So1 libDirs
|
||||
mLibc6Version <- veitherToEither <$> runE getLibc6Version
|
||||
case mLibc6Version of
|
||||
Right libc6Version -> logDebug $ "Found shared library libc6 in version: " <> prettyVer libc6Version
|
||||
Left _ -> logDebug "Did not find a version of shared library libc6."
|
||||
let hasLibc6_2_32 = either (const False) (>= [vver|2.32|]) mLibc6Version
|
||||
hastinfo5 <- checkLib relFileLibtinfoSo5
|
||||
hastinfo6 <- checkLib relFileLibtinfoSo6
|
||||
hasncurses6 <- checkLib relFileLibncurseswSo6
|
||||
hasgmp5 <- checkLib relFileLibgmpSo10
|
||||
hasgmp4 <- checkLib relFileLibgmpSo3
|
||||
let libComponents = if hasMusl
|
||||
then
|
||||
[ ["musl"] ]
|
||||
else
|
||||
concat
|
||||
[ if hastinfo6 && hasgmp5
|
||||
then
|
||||
if hasLibc6_2_32
|
||||
then [["tinfo6"]]
|
||||
else [["tinfo6-libc6-pre232"]]
|
||||
else [[]]
|
||||
, [ [] | hastinfo5 && hasgmp5 ]
|
||||
, [ ["ncurses6"] | hasncurses6 && hasgmp5 ]
|
||||
, [ ["gmp4"] | hasgmp4 ]
|
||||
]
|
||||
pure $ map
|
||||
(\c -> case c of
|
||||
[] -> []
|
||||
_ -> L.intercalate "-" c)
|
||||
libComponents
|
||||
FreeBSD ->
|
||||
case _distroVersion of
|
||||
Just fVer
|
||||
| fVer >= [vers|12|] -> pure []
|
||||
_ -> pure ["ino64"]
|
||||
Darwin -> pure []
|
||||
Windows -> pure []
|
||||
where
|
||||
|
||||
relFileLibcMuslx86_64So1 :: FilePath
|
||||
relFileLibcMuslx86_64So1 = "libc.musl-x86_64.so.1"
|
||||
libDirs :: [FilePath]
|
||||
libDirs = ["/lib", "/lib64"]
|
||||
usrLibDirs :: [FilePath]
|
||||
usrLibDirs = ["/usr/lib", "/usr/lib64"]
|
||||
sbinDirs :: [FilePath]
|
||||
sbinDirs = ["/sbin", "/usr/sbin"]
|
||||
relFileLibtinfoSo5 :: FilePath
|
||||
relFileLibtinfoSo5 = "libtinfo.so.5"
|
||||
relFileLibtinfoSo6 :: FilePath
|
||||
relFileLibtinfoSo6 = "libtinfo.so.6"
|
||||
relFileLibncurseswSo6 :: FilePath
|
||||
relFileLibncurseswSo6 = "libncursesw.so.6"
|
||||
relFileLibgmpSo10 :: FilePath
|
||||
relFileLibgmpSo10 = "libgmp.so.10"
|
||||
relFileLibgmpSo3 :: FilePath
|
||||
relFileLibgmpSo3 = "libgmp.so.3"
|
||||
|
||||
getStackOSKey :: Monad m => PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
|
||||
getStackOSKey PlatformRequest { .. } =
|
||||
case (_rArch, _rPlatform) of
|
||||
(A_32 , Linux _) -> pure "linux32"
|
||||
(A_64 , Linux _) -> pure "linux64"
|
||||
(A_32 , Darwin ) -> pure "macosx"
|
||||
(A_64 , Darwin ) -> pure "macosx"
|
||||
(A_32 , FreeBSD) -> pure "freebsd32"
|
||||
(A_64 , FreeBSD) -> pure "freebsd64"
|
||||
(A_32 , Windows) -> pure "windows32"
|
||||
(A_64 , Windows) -> pure "windows64"
|
||||
(A_ARM , Linux _) -> pure "linux-armv7"
|
||||
(A_ARM64, Linux _) -> pure "linux-aarch64"
|
||||
(A_Sparc, Linux _) -> pure "linux-sparc"
|
||||
(A_ARM64, Darwin ) -> pure "macosx-aarch64"
|
||||
(A_ARM64, FreeBSD) -> pure "freebsd-aarch64"
|
||||
(arch', os') -> throwE $ UnsupportedSetupCombo arch' os'
|
||||
|
||||
getStackPlatformKey :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||
=> PlatformRequest
|
||||
-> Excepts '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound, ProcessError] m [String]
|
||||
getStackPlatformKey pfreq@PlatformRequest{..} = do
|
||||
osKey <- liftE $ getStackOSKey pfreq
|
||||
builds <- liftE $ getStackGhcBuilds (PlatformResult _rPlatform _rVersion)
|
||||
let builds' = (\build -> if null build then osKey else osKey <> "-" <> build) <$> builds
|
||||
logDebug $ "Potential GHC builds: " <> mconcat (L.intersperse ", " $ fmap T.pack builds')
|
||||
pure builds'
|
||||
|
||||
|
||||
@@ -43,6 +43,10 @@ import Control.Monad.Reader
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass ( Pretty )
|
||||
import qualified Data.Text as T
|
||||
import System.Environment (getEnvironment)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import System.FilePath
|
||||
import Data.List (intercalate)
|
||||
|
||||
|
||||
|
||||
@@ -88,3 +92,25 @@ throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excep
|
||||
{-# INLINABLE throwSomeE #-}
|
||||
throwSomeE = Excepts . pure . VLeft . liftVariant
|
||||
#endif
|
||||
|
||||
addToPath :: [FilePath]
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> IO [(String, String)]
|
||||
addToPath paths append = do
|
||||
cEnv <- getEnvironment
|
||||
return $ addToPath' cEnv paths append
|
||||
|
||||
addToPath' :: [(String, String)]
|
||||
-> [FilePath]
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> [(String, String)]
|
||||
addToPath' cEnv' newPaths append =
|
||||
let cEnv = Map.fromList cEnv'
|
||||
paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
{- HLINT ignore "Redundant bracket" -}
|
||||
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ newPaths) else (newPaths ++ curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
in envWithNewPath
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -122,3 +120,17 @@ verP suffix = do
|
||||
|
||||
pathSep :: MP.Parsec Void Text Char
|
||||
pathSep = MP.oneOf pathSeparators
|
||||
|
||||
skipWhile :: (Char -> Bool) -> MP.Parsec Void Text ()
|
||||
skipWhile f = void $ MP.takeWhileP Nothing f
|
||||
|
||||
skip :: (Char -> Bool) -> MP.Parsec Void Text ()
|
||||
skip f = void $ MP.satisfy f
|
||||
|
||||
skipSpace :: MP.Parsec Void Text ()
|
||||
skipSpace = void $ MP.satisfy isSpace
|
||||
|
||||
isSpace :: Char -> Bool
|
||||
isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')
|
||||
{-# INLINE isSpace #-}
|
||||
|
||||
|
||||
@@ -11,6 +11,7 @@ Portability : portable
|
||||
-}
|
||||
module GHCup.Prelude.Process (
|
||||
executeOut,
|
||||
executeOut',
|
||||
execLogged,
|
||||
exec,
|
||||
toProcessError,
|
||||
|
||||
@@ -70,6 +70,16 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
||||
maybe (pure ()) changeWorkingDirectory chdir
|
||||
SPP.executeFile path True args Nothing
|
||||
|
||||
executeOut' :: MonadIO m
|
||||
=> FilePath -- ^ command as filename, e.g. 'ls'
|
||||
-> [String] -- ^ arguments to the command
|
||||
-> Maybe FilePath -- ^ chdir to this path
|
||||
-> Maybe [(String, String)]
|
||||
-> m CapturedProcess
|
||||
executeOut' path args chdir env = liftIO $ captureOutStreams $ do
|
||||
maybe (pure ()) changeWorkingDirectory chdir
|
||||
SPP.executeFile path True args env
|
||||
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
@@ -169,7 +179,7 @@ execLogged exe args chdir lfile env = do
|
||||
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
|
||||
|
||||
blue :: ByteString -> ByteString
|
||||
blue bs
|
||||
blue bs
|
||||
| no_color = bs
|
||||
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
|
||||
|
||||
|
||||
@@ -140,8 +140,16 @@ executeOut :: MonadIO m
|
||||
-> [String] -- ^ arguments to the command
|
||||
-> Maybe FilePath -- ^ chdir to this path
|
||||
-> m CapturedProcess
|
||||
executeOut path args chdir = do
|
||||
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
|
||||
executeOut path args chdir = executeOut' path args chdir Nothing
|
||||
|
||||
executeOut' :: MonadIO m
|
||||
=> FilePath -- ^ command as filename, e.g. 'ls'
|
||||
-> [String] -- ^ arguments to the command
|
||||
-> Maybe FilePath -- ^ chdir to this path
|
||||
-> Maybe [(String, String)]
|
||||
-> m CapturedProcess
|
||||
executeOut' path args chdir env' = do
|
||||
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir, env = env' })
|
||||
(exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
|
||||
pure $ CapturedProcess exit out err
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -234,7 +234,7 @@ setStack ver = do
|
||||
|
||||
liftIO (isShadowed stackbin) >>= \case
|
||||
Nothing -> pure ()
|
||||
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
|
||||
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Stack pa stackbin ver)
|
||||
|
||||
pure ()
|
||||
|
||||
|
||||
@@ -22,10 +22,12 @@ module GHCup.Types
|
||||
( module GHCup.Types
|
||||
#if defined(BRICK)
|
||||
, Key(..)
|
||||
, Modifier(..)
|
||||
#endif
|
||||
)
|
||||
where
|
||||
|
||||
import GHCup.Types.Stack ( SetupInfo )
|
||||
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
|
||||
|
||||
import Control.DeepSeq ( NFData, rnf )
|
||||
@@ -39,13 +41,13 @@ import Optics ( makeLenses )
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||
import URI.ByteString
|
||||
#if defined(BRICK)
|
||||
import Graphics.Vty ( Key(..) )
|
||||
import Graphics.Vty ( Key(..), Modifier(..) )
|
||||
#endif
|
||||
|
||||
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
|
||||
|
||||
#if !defined(BRICK)
|
||||
data Key = KEsc | KChar Char | KBS | KEnter
|
||||
@@ -54,8 +56,15 @@ data Key = KEsc | KChar Char | KBS | KEnter
|
||||
| KFun Int | KBackTab | KPrtScr | KPause | KIns
|
||||
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
|
||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||
|
||||
data Modifier = MShift | MCtrl | MMeta | MAlt
|
||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||
#endif
|
||||
|
||||
data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
|
||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
--[ GHCInfo Tree ]--
|
||||
@@ -132,6 +141,9 @@ 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.
|
||||
@@ -153,13 +165,17 @@ instance NFData VersionInfo
|
||||
|
||||
|
||||
-- | A tag. These are currently attached to a version of a tool.
|
||||
data Tag = Latest
|
||||
| Recommended
|
||||
| Prerelease
|
||||
| LatestPrerelease
|
||||
| Nightly
|
||||
| LatestNightly
|
||||
| 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
|
||||
@@ -185,7 +201,7 @@ instance Pretty Tag where
|
||||
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 LatestNightly = text "latest-prerelease"
|
||||
pPrint Old = mempty
|
||||
|
||||
data Architecture = A_64
|
||||
@@ -241,13 +257,18 @@ data LinuxDistro = Debian
|
||||
| RedHat
|
||||
| Alpine
|
||||
| AmazonLinux
|
||||
| Rocky
|
||||
| Void
|
||||
-- rolling
|
||||
| Gentoo
|
||||
| Exherbo
|
||||
-- not known
|
||||
| UnknownLinux
|
||||
-- ^ must exit
|
||||
deriving (Eq, GHC.Generic, Ord, Show)
|
||||
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
||||
|
||||
allDistros :: [LinuxDistro]
|
||||
allDistros = enumFromTo minBound maxBound
|
||||
|
||||
instance NFData LinuxDistro
|
||||
|
||||
@@ -260,6 +281,8 @@ distroToString CentOS = "centos"
|
||||
distroToString RedHat = "redhat"
|
||||
distroToString Alpine = "alpine"
|
||||
distroToString AmazonLinux = "amazon"
|
||||
distroToString Rocky = "rocky"
|
||||
distroToString Void = "void"
|
||||
distroToString Gentoo = "gentoo"
|
||||
distroToString Exherbo = "exherbo"
|
||||
distroToString UnknownLinux = "unknown"
|
||||
@@ -319,15 +342,41 @@ instance Pretty TarDir where
|
||||
|
||||
-- | Where to fetch GHCupDownloads from.
|
||||
data URLSource = GHCupURL
|
||||
| OwnSource [Either GHCupInfo URI] -- ^ complete source list
|
||||
| OwnSpec GHCupInfo
|
||||
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
|
||||
deriving (GHC.Generic, Show)
|
||||
| StackSetupURL
|
||||
| OwnSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ complete source list
|
||||
| OwnSpec (Either GHCupInfo SetupInfo)
|
||||
| AddSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ merge with GHCupURL
|
||||
| SimpleList [NewURLSource]
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
data NewURLSource = NewGHCupURL
|
||||
| NewStackSetupURL
|
||||
| NewGHCupInfo GHCupInfo
|
||||
| NewSetupInfo SetupInfo
|
||||
| NewURI URI
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
instance NFData NewURLSource
|
||||
|
||||
fromURLSource :: URLSource -> [NewURLSource]
|
||||
fromURLSource GHCupURL = [NewGHCupURL]
|
||||
fromURLSource StackSetupURL = [NewStackSetupURL]
|
||||
fromURLSource (OwnSource arr) = convert' <$> arr
|
||||
fromURLSource (AddSource arr) = NewGHCupURL:(convert' <$> arr)
|
||||
fromURLSource (SimpleList arr) = arr
|
||||
fromURLSource (OwnSpec (Left gi)) = [NewGHCupInfo gi]
|
||||
fromURLSource (OwnSpec (Right si)) = [NewSetupInfo si]
|
||||
|
||||
convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
|
||||
convert' (Left (Left gi)) = NewGHCupInfo gi
|
||||
convert' (Left (Right si)) = NewSetupInfo si
|
||||
convert' (Right uri) = NewURI uri
|
||||
|
||||
instance NFData URLSource
|
||||
instance NFData (URIRef Absolute) where
|
||||
rnf (URI !_ !_ !_ !_ !_) = ()
|
||||
|
||||
|
||||
data MetaMode = Strict
|
||||
| Lax
|
||||
deriving (Show, Read, Eq, GHC.Generic)
|
||||
@@ -400,47 +449,51 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
}
|
||||
|
||||
data UserKeyBindings = UserKeyBindings
|
||||
{ kUp :: Maybe Key
|
||||
, kDown :: Maybe Key
|
||||
, kQuit :: Maybe Key
|
||||
, kInstall :: Maybe Key
|
||||
, kUninstall :: Maybe Key
|
||||
, kSet :: Maybe Key
|
||||
, kChangelog :: Maybe Key
|
||||
, kShowAll :: Maybe Key
|
||||
, kShowAllTools :: Maybe Key
|
||||
{ kUp :: Maybe KeyCombination
|
||||
, kDown :: Maybe KeyCombination
|
||||
, kQuit :: Maybe KeyCombination
|
||||
, kInstall :: Maybe KeyCombination
|
||||
, kUninstall :: Maybe KeyCombination
|
||||
, kSet :: Maybe KeyCombination
|
||||
, kChangelog :: Maybe KeyCombination
|
||||
, kShowAll :: Maybe KeyCombination
|
||||
, kShowAllTools :: Maybe KeyCombination
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
data KeyBindings = KeyBindings
|
||||
{ bUp :: Key
|
||||
, bDown :: Key
|
||||
, bQuit :: Key
|
||||
, bInstall :: Key
|
||||
, bUninstall :: Key
|
||||
, bSet :: Key
|
||||
, bChangelog :: Key
|
||||
, bShowAllVersions :: Key
|
||||
, bShowAllTools :: Key
|
||||
{ bUp :: KeyCombination
|
||||
, bDown :: KeyCombination
|
||||
, bQuit :: KeyCombination
|
||||
, bInstall :: KeyCombination
|
||||
, bUninstall :: KeyCombination
|
||||
, bSet :: KeyCombination
|
||||
, bChangelog :: KeyCombination
|
||||
, bShowAllVersions :: KeyCombination
|
||||
, bShowAllTools :: KeyCombination
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData KeyBindings
|
||||
#if defined(IS_WINDOWS) || !defined(BRICK)
|
||||
#if !defined(BRICK)
|
||||
instance NFData Key
|
||||
|
||||
instance NFData Modifier
|
||||
|
||||
#endif
|
||||
instance NFData KeyCombination
|
||||
|
||||
defaultKeyBindings :: KeyBindings
|
||||
defaultKeyBindings = KeyBindings
|
||||
{ bUp = KUp
|
||||
, bDown = KDown
|
||||
, bQuit = KChar 'q'
|
||||
, bInstall = KChar 'i'
|
||||
, bUninstall = KChar 'u'
|
||||
, bSet = KChar 's'
|
||||
, bChangelog = KChar 'c'
|
||||
, bShowAllVersions = KChar 'a'
|
||||
, bShowAllTools = KChar 't'
|
||||
{ bUp = KeyCombination { key = KUp , mods = [] }
|
||||
, bDown = KeyCombination { key = KDown , mods = [] }
|
||||
, bQuit = KeyCombination { key = KChar 'q', mods = [] }
|
||||
, bInstall = KeyCombination { key = KChar 'i', mods = [] }
|
||||
, bUninstall = KeyCombination { key = KChar 'u', mods = [] }
|
||||
, bSet = KeyCombination { key = KChar 's', mods = [] }
|
||||
, bChangelog = KeyCombination { key = KChar 'c', mods = [] }
|
||||
, bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
|
||||
, bShowAllTools = KeyCombination { key = KChar 't', mods = [] }
|
||||
}
|
||||
|
||||
data AppState = AppState
|
||||
@@ -634,6 +687,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
|
||||
|
||||
@@ -710,6 +774,7 @@ data ToolVersion = GHCVersion GHCTargetVersion
|
||||
| ToolVersion Version
|
||||
| ToolTag Tag
|
||||
| ToolDay Day
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Pretty ToolVersion where
|
||||
pPrint (GHCVersion v) = pPrint v
|
||||
@@ -719,4 +784,7 @@ instance Pretty ToolVersion where
|
||||
|
||||
|
||||
|
||||
data BuildSystem = Hadrian
|
||||
| Make
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
||||
@@ -22,7 +22,9 @@ Portability : portable
|
||||
module GHCup.Types.JSON where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Stack (SetupInfo)
|
||||
import GHCup.Types.JSON.Utils
|
||||
import GHCup.Types.JSON.Versions ()
|
||||
import GHCup.Prelude.MegaParsec
|
||||
|
||||
import Control.Applicative ( (<|>) )
|
||||
@@ -31,7 +33,9 @@ import Data.Aeson.TH
|
||||
import Data.Aeson.Types hiding (Key)
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List.NonEmpty ( NonEmpty(..) )
|
||||
import Data.Maybe
|
||||
import Data.Text.Encoding as E
|
||||
import Data.Foldable
|
||||
import Data.Versions
|
||||
import Data.Void
|
||||
import URI.ByteString
|
||||
@@ -48,10 +52,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
|
||||
@@ -111,34 +116,6 @@ instance FromJSONKey GHCTargetVersion where
|
||||
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 GHCTargetVersion (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Versioning where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
||||
|
||||
instance FromJSONKey Versioning where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey (Maybe Versioning) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyV x
|
||||
Nothing -> T.pack "unknown_versioning"
|
||||
|
||||
instance FromJSONKey (Maybe Versioning) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_versioning" then pure Nothing else just t
|
||||
where
|
||||
just t = case versioning t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey Platform where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
@@ -175,43 +152,6 @@ instance ToJSONKey Architecture where
|
||||
instance FromJSONKey Architecture where
|
||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
||||
|
||||
instance ToJSONKey (Maybe Version) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyVer x
|
||||
Nothing -> T.pack "unknown_version"
|
||||
|
||||
instance FromJSONKey (Maybe Version) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_version" then pure Nothing else just t
|
||||
where
|
||||
just t = case version t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON Version where
|
||||
toJSON = toJSON . prettyVer
|
||||
|
||||
instance FromJSON Version where
|
||||
parseJSON = withText "Version" $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Version where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyVer x
|
||||
|
||||
instance FromJSONKey Version where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON PVP where
|
||||
toJSON = toJSON . prettyPVP
|
||||
|
||||
instance FromJSON PVP where
|
||||
parseJSON = withText "PVP" $ \t -> case pvp t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Tool where
|
||||
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
||||
|
||||
@@ -341,33 +281,64 @@ instance FromJSONKey (Maybe VersionRange) where
|
||||
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
||||
|
||||
|
||||
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
|
||||
instance FromJSON GHCupInfo where
|
||||
parseJSON = withObject "GHCupInfo" $ \o -> do
|
||||
toolRequirements' <- o .:? "toolRequirements"
|
||||
globalTools' <- o .:? "globalTools"
|
||||
ghcupDownloads' <- o .: "ghcupDownloads"
|
||||
pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads' (fromMaybe mempty globalTools'))
|
||||
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
|
||||
instance ToJSON NewURLSource where
|
||||
toJSON NewGHCupURL = String "GHCupURL"
|
||||
toJSON NewStackSetupURL = String "StackSetupURL"
|
||||
toJSON (NewGHCupInfo gi) = object [ "ghcup-info" .= gi ]
|
||||
toJSON (NewSetupInfo si) = object [ "setup-info" .= si ]
|
||||
toJSON (NewURI uri) = toJSON uri
|
||||
|
||||
instance ToJSON URLSource where
|
||||
toJSON = toJSON . fromURLSource
|
||||
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Modifier
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||
|
||||
instance FromJSON URLSource where
|
||||
parseJSON v =
|
||||
parseGHCupURL v
|
||||
<|> parseStackURL v
|
||||
<|> parseOwnSourceLegacy v
|
||||
<|> parseOwnSourceNew1 v
|
||||
<|> parseOwnSourceNew2 v
|
||||
<|> parseOwnSpec v
|
||||
<|> legacyParseAddSource v
|
||||
<|> newParseAddSource v
|
||||
-- new since Stack SetupInfo
|
||||
<|> parseOwnSpecNew v
|
||||
<|> parseOwnSourceNew3 v
|
||||
<|> newParseAddSource2 v
|
||||
-- more lenient versions
|
||||
<|> parseOwnSpecLenient v
|
||||
<|> parseOwnSourceLenient v
|
||||
<|> parseAddSourceLenient v
|
||||
-- simplified list
|
||||
<|> parseNewUrlSource v
|
||||
<|> parseNewUrlSource' v
|
||||
where
|
||||
convert'' :: Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
|
||||
convert'' (Left gi) = Left (Left gi)
|
||||
convert'' (Right uri) = Right uri
|
||||
|
||||
parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
|
||||
r :: URI <- o .: "OwnSource"
|
||||
pure (OwnSource [Right r])
|
||||
@@ -376,18 +347,100 @@ instance FromJSON URLSource where
|
||||
pure (OwnSource (fmap Right r))
|
||||
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
|
||||
pure (OwnSource r)
|
||||
pure (OwnSource (convert'' <$> r))
|
||||
parseOwnSpec = withObject "URLSource" $ \o -> do
|
||||
r :: GHCupInfo <- o .: "OwnSpec"
|
||||
pure (OwnSpec r)
|
||||
pure (OwnSpec $ Left r)
|
||||
parseGHCupURL = withObject "URLSource" $ \o -> do
|
||||
_ :: [Value] <- o .: "GHCupURL"
|
||||
pure GHCupURL
|
||||
parseStackURL = withObject "URLSource" $ \o -> do
|
||||
_ :: [Value] <- o .: "StackSetupURL"
|
||||
pure StackSetupURL
|
||||
legacyParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: Either GHCupInfo URI <- o .: "AddSource"
|
||||
pure (AddSource [r])
|
||||
pure (AddSource [convert'' r])
|
||||
newParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "AddSource"
|
||||
pure (AddSource (convert'' <$> r))
|
||||
|
||||
-- new since Stack SetupInfo
|
||||
parseOwnSpecNew = withObject "URLSource" $ \o -> do
|
||||
r :: Either GHCupInfo SetupInfo <- o .: "OwnSpec"
|
||||
pure (OwnSpec r)
|
||||
parseOwnSourceNew3 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "OwnSource"
|
||||
pure (OwnSource r)
|
||||
newParseAddSource2 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "AddSource"
|
||||
pure (AddSource r)
|
||||
|
||||
-- more lenient versions
|
||||
parseOwnSpecLenient = withObject "URLSource" $ \o -> do
|
||||
spec :: Object <- o .: "OwnSpec"
|
||||
OwnSpec <$> lenientInfoParser spec
|
||||
parseOwnSourceLenient = withObject "URLSource" $ \o -> do
|
||||
mown :: Array <- o .: "OwnSource"
|
||||
OwnSource . toList <$> mapM lenientInfoUriParser mown
|
||||
parseAddSourceLenient = withObject "URLSource" $ \o -> do
|
||||
madd :: Array <- o .: "AddSource"
|
||||
AddSource . toList <$> mapM lenientInfoUriParser madd
|
||||
|
||||
-- simplified
|
||||
parseNewUrlSource = withArray "URLSource" $ \a -> do
|
||||
SimpleList . toList <$> mapM parseJSON a
|
||||
parseNewUrlSource' v' = SimpleList .(:[]) <$> parseJSON v'
|
||||
|
||||
|
||||
lenientInfoUriParser :: Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
|
||||
lenientInfoUriParser (Object o) = Left <$> lenientInfoParser o
|
||||
lenientInfoUriParser v@(String _) = Right <$> parseJSON v
|
||||
lenientInfoUriParser _ = fail "Unexpected json in lenientInfoUriParser"
|
||||
|
||||
|
||||
lenientInfoParser :: Object -> Parser (Either GHCupInfo SetupInfo)
|
||||
lenientInfoParser o = do
|
||||
setup_info :: Maybe Object <- o .:? "setup-info"
|
||||
case setup_info of
|
||||
Nothing -> do
|
||||
r <- parseJSON (Object o)
|
||||
pure $ Left r
|
||||
Just setup_info' -> do
|
||||
r <- parseJSON (Object setup_info')
|
||||
pure $ Right r
|
||||
|
||||
instance FromJSON NewURLSource where
|
||||
parseJSON v = uri v <|> url v <|> gi v <|> si v
|
||||
where
|
||||
uri = withText "NewURLSource" $ \t -> NewURI <$> parseJSON (String t)
|
||||
url = withText "NewURLSource" $ \t -> case T.unpack t of
|
||||
"GHCupURL" -> pure NewGHCupURL
|
||||
"StackSetupURL" -> pure NewStackSetupURL
|
||||
t' -> fail $ "Unexpected text value in NewURLSource: " <> t'
|
||||
gi = withObject "NewURLSource" $ \o -> do
|
||||
ginfo :: GHCupInfo <- o .: "ghcup-info"
|
||||
pure $ NewGHCupInfo ginfo
|
||||
|
||||
si = withObject "NewURLSource" $ \o -> do
|
||||
sinfo :: SetupInfo <- o .: "setup-info"
|
||||
pure $ NewSetupInfo sinfo
|
||||
|
||||
|
||||
instance FromJSON KeyCombination where
|
||||
parseJSON v = proper v <|> simple v
|
||||
where
|
||||
simple = withObject "KeyCombination" $ \o -> do
|
||||
k <- parseJSON (Object o)
|
||||
pure (KeyCombination k [])
|
||||
proper = withObject "KeyCombination" $ \o -> do
|
||||
k <- o .: "Key"
|
||||
m <- o .: "Mods"
|
||||
pure $ KeyCombination k m
|
||||
|
||||
instance ToJSON KeyCombination where
|
||||
toJSON (KeyCombination k m) = object ["Key" .= k, "Mods" .= m]
|
||||
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
|
||||
|
||||
90
lib/GHCup/Types/JSON/Versions.hs
Normal file
90
lib/GHCup/Types/JSON/Versions.hs
Normal file
@@ -0,0 +1,90 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.JSON.Versions
|
||||
Description : GHCup Version JSON types/instances
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Types.JSON.Versions where
|
||||
|
||||
import Data.Aeson hiding (Key)
|
||||
import Data.Aeson.Types hiding (Key)
|
||||
import Data.Versions
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
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 GHCTargetVersion (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Versioning where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
||||
|
||||
instance FromJSONKey Versioning where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey (Maybe Versioning) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyV x
|
||||
Nothing -> T.pack "unknown_versioning"
|
||||
|
||||
instance FromJSONKey (Maybe Versioning) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_versioning" then pure Nothing else just t
|
||||
where
|
||||
just t = case versioning t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey (Maybe Version) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyVer x
|
||||
Nothing -> T.pack "unknown_version"
|
||||
|
||||
instance FromJSONKey (Maybe Version) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_version" then pure Nothing else just t
|
||||
where
|
||||
just t = case version t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON Version where
|
||||
toJSON = toJSON . prettyVer
|
||||
|
||||
instance FromJSON Version where
|
||||
parseJSON = withText "Version" $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Version where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyVer x
|
||||
|
||||
instance FromJSONKey Version where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON PVP where
|
||||
toJSON = toJSON . prettyPVP
|
||||
|
||||
instance FromJSON PVP where
|
||||
parseJSON = withText "PVP" $ \t -> case pvp t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
|
||||
180
lib/GHCup/Types/Stack.hs
Normal file
180
lib/GHCup/Types/Stack.hs
Normal file
@@ -0,0 +1,180 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.Stack
|
||||
Description : GHCup types.Stack
|
||||
Copyright : (c) Julian Ospald, 2023
|
||||
License : LGPL-3.0
|
||||
Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Types.Stack where
|
||||
|
||||
import GHCup.Types.JSON.Versions ()
|
||||
|
||||
import Control.Applicative
|
||||
import Control.DeepSeq ( NFData )
|
||||
import Data.ByteString
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import Data.Map.Strict ( Map )
|
||||
import Data.Text ( Text )
|
||||
import Data.Text.Encoding
|
||||
import Data.Versions
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
|
||||
--------------------------------------
|
||||
--[ Stack download info copy pasta ]--
|
||||
--------------------------------------
|
||||
|
||||
data SetupInfo = SetupInfo
|
||||
{ siSevenzExe :: Maybe DownloadInfo
|
||||
, siSevenzDll :: Maybe DownloadInfo
|
||||
, siMsys2 :: Map Text VersionedDownloadInfo
|
||||
, siGHCs :: Map Text (Map Version GHCDownloadInfo)
|
||||
, siStack :: Map Text (Map Version DownloadInfo)
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance NFData SetupInfo
|
||||
|
||||
instance FromJSON SetupInfo where
|
||||
parseJSON = withObject "SetupInfo" $ \o -> do
|
||||
siSevenzExe <- o .:? "sevenzexe-info"
|
||||
siSevenzDll <- o .:? "sevenzdll-info"
|
||||
siMsys2 <- o .:? "msys2" .!= mempty
|
||||
siGHCs <- o .:? "ghc" .!= mempty
|
||||
siStack <- o .:? "stack" .!= mempty
|
||||
pure SetupInfo {..}
|
||||
|
||||
instance ToJSON SetupInfo where
|
||||
toJSON (SetupInfo {..}) = object [ "sevenzexe-info" .= siSevenzExe
|
||||
, "sevenzdll-info" .= siSevenzDll
|
||||
, "msys2" .= siMsys2
|
||||
, "ghc" .= siGHCs
|
||||
, "stack" .= siStack
|
||||
]
|
||||
|
||||
-- | For the @siGHCs@ field maps are deeply merged. For all fields the values
|
||||
-- from the first @SetupInfo@ win.
|
||||
instance Semigroup SetupInfo where
|
||||
l <> r =
|
||||
SetupInfo
|
||||
{ siSevenzExe = siSevenzExe l <|> siSevenzExe r
|
||||
, siSevenzDll = siSevenzDll l <|> siSevenzDll r
|
||||
, siMsys2 = siMsys2 l <> siMsys2 r
|
||||
, siGHCs = Map.unionWith (<>) (siGHCs l) (siGHCs r)
|
||||
, siStack = Map.unionWith (<>) (siStack l) (siStack r) }
|
||||
|
||||
instance Monoid SetupInfo where
|
||||
mempty =
|
||||
SetupInfo
|
||||
{ siSevenzExe = Nothing
|
||||
, siSevenzDll = Nothing
|
||||
, siMsys2 = Map.empty
|
||||
, siGHCs = Map.empty
|
||||
, siStack = Map.empty
|
||||
}
|
||||
mappend = (<>)
|
||||
|
||||
-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)
|
||||
-- | Information for a file to download.
|
||||
data DownloadInfo = DownloadInfo
|
||||
{ downloadInfoUrl :: Text
|
||||
-- ^ URL or absolute file path
|
||||
, downloadInfoContentLength :: Maybe Int
|
||||
, downloadInfoSha1 :: Maybe ByteString
|
||||
, downloadInfoSha256 :: Maybe ByteString
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance ToJSON DownloadInfo where
|
||||
toJSON (DownloadInfo {..}) = object [ "url" .= downloadInfoUrl
|
||||
, "content-length" .= downloadInfoContentLength
|
||||
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
|
||||
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
|
||||
]
|
||||
|
||||
instance NFData DownloadInfo
|
||||
|
||||
instance FromJSON DownloadInfo where
|
||||
parseJSON = withObject "DownloadInfo" parseDownloadInfoFromObject
|
||||
|
||||
-- | Parse JSON in existing object for 'DownloadInfo'
|
||||
parseDownloadInfoFromObject :: Object -> Parser DownloadInfo
|
||||
parseDownloadInfoFromObject o = do
|
||||
url <- o .: "url"
|
||||
contentLength <- o .:? "content-length"
|
||||
sha1TextMay <- o .:? "sha1"
|
||||
sha256TextMay <- o .:? "sha256"
|
||||
pure
|
||||
DownloadInfo
|
||||
{ downloadInfoUrl = url
|
||||
, downloadInfoContentLength = contentLength
|
||||
, downloadInfoSha1 = fmap encodeUtf8 sha1TextMay
|
||||
, downloadInfoSha256 = fmap encodeUtf8 sha256TextMay
|
||||
}
|
||||
|
||||
data VersionedDownloadInfo = VersionedDownloadInfo
|
||||
{ vdiVersion :: Version
|
||||
, vdiDownloadInfo :: DownloadInfo
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance ToJSON VersionedDownloadInfo where
|
||||
toJSON (VersionedDownloadInfo {vdiDownloadInfo = DownloadInfo{..}, ..})
|
||||
= object [ "version" .= vdiVersion
|
||||
, "url" .= downloadInfoUrl
|
||||
, "content-length" .= downloadInfoContentLength
|
||||
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
|
||||
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
|
||||
]
|
||||
|
||||
instance NFData VersionedDownloadInfo
|
||||
|
||||
instance FromJSON VersionedDownloadInfo where
|
||||
parseJSON = withObject "VersionedDownloadInfo" $ \o -> do
|
||||
ver' <- o .: "version"
|
||||
downloadInfo <- parseDownloadInfoFromObject o
|
||||
pure VersionedDownloadInfo
|
||||
{ vdiVersion = ver'
|
||||
, vdiDownloadInfo = downloadInfo
|
||||
}
|
||||
|
||||
data GHCDownloadInfo = GHCDownloadInfo
|
||||
{ gdiConfigureOpts :: [Text]
|
||||
, gdiConfigureEnv :: Map Text Text
|
||||
, gdiDownloadInfo :: DownloadInfo
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance NFData GHCDownloadInfo
|
||||
|
||||
instance ToJSON GHCDownloadInfo where
|
||||
toJSON (GHCDownloadInfo {gdiDownloadInfo = DownloadInfo {..}, ..})
|
||||
= object [ "configure-opts" .= gdiConfigureOpts
|
||||
, "configure-env" .= gdiConfigureEnv
|
||||
, "url" .= downloadInfoUrl
|
||||
, "content-length" .= downloadInfoContentLength
|
||||
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
|
||||
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
|
||||
]
|
||||
|
||||
instance FromJSON GHCDownloadInfo where
|
||||
parseJSON = withObject "GHCDownloadInfo" $ \o -> do
|
||||
configureOpts <- o .:? "configure-opts" .!= mempty
|
||||
configureEnv <- o .:? "configure-env" .!= mempty
|
||||
downloadInfo <- parseDownloadInfoFromObject o
|
||||
pure GHCDownloadInfo
|
||||
{ gdiConfigureOpts = configureOpts
|
||||
, gdiConfigureEnv = configureEnv
|
||||
, gdiDownloadInfo = downloadInfo
|
||||
}
|
||||
|
||||
@@ -49,7 +49,6 @@ import GHCup.Prelude.Logger.Internal
|
||||
import GHCup.Prelude.MegaParsec
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prelude.String.QQ
|
||||
|
||||
import Codec.Archive hiding ( Directory )
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
@@ -90,9 +89,9 @@ import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
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)
|
||||
|
||||
|
||||
@@ -119,11 +118,11 @@ import Data.Time (Day(..), diffDays, addDays)
|
||||
-- >>> 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 +287,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
|
||||
@@ -376,7 +368,9 @@ cabalSet = do
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- liftIO $ isBrokenSymlink cabalbin
|
||||
if broken
|
||||
then pure Nothing
|
||||
then do
|
||||
logWarn $ "Broken symlink at " <> T.pack cabalbin
|
||||
pure Nothing
|
||||
else do
|
||||
link <- liftIO
|
||||
$ handleIO' InvalidArgument
|
||||
@@ -473,7 +467,9 @@ stackSet = do
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- liftIO $ isBrokenSymlink stackBin
|
||||
if broken
|
||||
then pure Nothing
|
||||
then do
|
||||
logWarn $ "Broken symlink at " <> T.pack stackBin
|
||||
pure Nothing
|
||||
else do
|
||||
link <- liftIO
|
||||
$ handleIO' InvalidArgument
|
||||
@@ -527,15 +523,17 @@ isLegacyHLS ver = do
|
||||
|
||||
|
||||
-- Return the currently set hls version, if any.
|
||||
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
hlsSet = do
|
||||
Dirs {..} <- getDirs
|
||||
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||
|
||||
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- isBrokenSymlink hlsBin
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- liftIO $ isBrokenSymlink hlsBin
|
||||
if broken
|
||||
then pure Nothing
|
||||
then do
|
||||
logWarn $ "Broken symlink at " <> T.pack hlsBin
|
||||
pure Nothing
|
||||
else do
|
||||
link <- liftIO $ getLinkTarget hlsBin
|
||||
Just <$> linkVersion link
|
||||
@@ -563,6 +561,7 @@ hlsSet = do
|
||||
-- | Return the GHC versions the currently selected HLS supports.
|
||||
hlsGHCVersions :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
@@ -694,10 +693,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 +736,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,11 +762,11 @@ 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
|
||||
@@ -975,11 +972,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
|
||||
@@ -1045,7 +1037,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
|
||||
|
||||
@@ -1093,7 +1085,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
-> FilePath
|
||||
-> m (Either ProcessError ())
|
||||
darwinNotarization Darwin path = exec
|
||||
"xattr"
|
||||
"/usr/bin/xattr"
|
||||
["-r", "-d", "com.apple.quarantine", path]
|
||||
Nothing
|
||||
Nothing
|
||||
@@ -1224,7 +1216,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..."
|
||||
@@ -1328,22 +1320,6 @@ warnAboutHlsCompatibility = do
|
||||
|
||||
|
||||
|
||||
addToPath :: FilePath
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> IO [(String, String)]
|
||||
addToPath path append = do
|
||||
cEnv <- Map.fromList <$> getEnvironment
|
||||
let paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
{- HLINT ignore "Redundant bracket" -}
|
||||
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
liftIO $ setEnv pathVar newPath
|
||||
return envWithNewPath
|
||||
|
||||
|
||||
-----------
|
||||
--[ Git ]--
|
||||
-----------
|
||||
|
||||
@@ -24,17 +24,20 @@ 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.
|
||||
--
|
||||
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
|
||||
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
||||
ghcupURL :: URI
|
||||
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
|
||||
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]
|
||||
|
||||
stackSetupURL :: URI
|
||||
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
|
||||
|
||||
-- | The current ghcup version.
|
||||
ghcUpVer :: V.PVP
|
||||
@@ -53,7 +56,7 @@ versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
||||
|
||||
versionRange :: V.Versioning -> VersionRange -> Bool
|
||||
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
|
||||
versionRange ver' (OrRange cmps range) =
|
||||
versionRange ver' (OrRange cmps range) =
|
||||
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
||||
|
||||
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
|
||||
@@ -65,44 +68,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
|
||||
|
||||
@@ -172,9 +172,8 @@ _done() {
|
||||
green "Start a new haskell project in the current directory via:"
|
||||
green " cabal init --interactive"
|
||||
green
|
||||
green "Install other GHC versions and tools via:"
|
||||
green " ghcup list"
|
||||
green " ghcup install <tool> <version>"
|
||||
green "To install other GHC versions and tools, run:"
|
||||
green " ghcup tui"
|
||||
green
|
||||
green "To install system libraries and update msys2/mingw64,"
|
||||
green "open the \"Mingw haskell shell\""
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
* cabal - The Cabal build tool for managing Haskell software"
|
||||
* stack - (optional) A cross-platform program for developing Haskell projects"
|
||||
* hls - (optional) A language server for developers to integrate with their editor/IDE"
|
||||
|
||||
|
||||
By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
|
||||
#>
|
||||
param (
|
||||
@@ -40,10 +40,15 @@ 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,
|
||||
# Whether to disable creation of several desktop shortcuts
|
||||
[switch]$DontWriteDesktopShortcuts
|
||||
)
|
||||
|
||||
$DefaultMsys2Version = "20221216"
|
||||
$DefaultMsys2Hash = "18370d32b0264915c97e3d7c618f7b32d48ad80858923883fde5145acd32ca0f"
|
||||
|
||||
$Silent = !$Interactive
|
||||
|
||||
@@ -136,7 +141,7 @@ filter Get-FileSize {
|
||||
function Get-FileWCSynchronous{
|
||||
param(
|
||||
[Parameter(Mandatory=$true)]
|
||||
[string]$url,
|
||||
[string]$url,
|
||||
[string]$destinationFolder="$env:USERPROFILE\Downloads",
|
||||
[switch]$includeStats
|
||||
)
|
||||
@@ -226,7 +231,7 @@ if ($GhcupBasePrefixEnv) {
|
||||
Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
|
||||
} else {
|
||||
Print-Msg -color Red -msg "Couldn't find a writable partition with at least 5GB free disk space!"
|
||||
Exit 1
|
||||
Exit 1
|
||||
}
|
||||
}
|
||||
|
||||
@@ -271,7 +276,7 @@ Press enter to accept the default [{0}]:
|
||||
if (!($GhcupBasePrefix.EndsWith('\'))) {
|
||||
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
|
||||
}
|
||||
|
||||
|
||||
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
|
||||
if (!($GhcupBasePrefix)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
@@ -347,7 +352,7 @@ if ($CabalDir) {
|
||||
$CabDirEnv = $CabalDir
|
||||
if (!($CabDirEnv)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
Exit 1
|
||||
Exit 1
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
||||
Exit 1
|
||||
@@ -362,7 +367,7 @@ if ($CabalDir) {
|
||||
|
||||
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
|
||||
if (!($CabDirEnv)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
||||
} else {
|
||||
@@ -407,6 +412,26 @@ if (!($InstallStack)) {
|
||||
}
|
||||
}
|
||||
|
||||
if ($Interactive) {
|
||||
$DesktopDecision = $Host.UI.PromptForChoice('Create Desktop shortcuts'
|
||||
, 'Do you want to create convenience desktop shortcuts (e.g. for uninstallation and msys2 shell)?'
|
||||
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
|
||||
'&No'
|
||||
'&Abort'), 0)
|
||||
if ($DesktopDecision -eq 0) {
|
||||
$InstallDesktopShortcuts = $true
|
||||
} elseif ($DesktopDecision -eq 2) {
|
||||
Exit 0
|
||||
}
|
||||
} else {
|
||||
if ($Minimal) {
|
||||
$InstallDesktopShortcuts = $false
|
||||
} elseif ($DontWriteDesktopShortcuts) {
|
||||
$InstallDesktopShortcuts = $false
|
||||
} else {
|
||||
$InstallDesktopShortcuts = $true
|
||||
}
|
||||
}
|
||||
|
||||
# mingw foo
|
||||
Print-Msg -msg 'First checking for Msys2...'
|
||||
@@ -430,9 +455,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 +468,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 +481,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'
|
||||
@@ -474,12 +507,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
$MsysDirPrompt = Read-Host
|
||||
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
|
||||
} else {
|
||||
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
|
||||
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
|
||||
$MsysDir = Read-Host
|
||||
}
|
||||
$MsysDir = $MsysDir.TrimEnd().TrimStart()
|
||||
if (!($MsysDir)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
|
||||
Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
|
||||
@@ -499,8 +532,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
Start-Sleep -s 5
|
||||
}
|
||||
|
||||
Print-Msg -msg 'Creating shortcuts...'
|
||||
$uninstallShortCut = @'
|
||||
|
||||
if ($InstallDesktopShortcuts) {
|
||||
|
||||
Print-Msg -msg 'Creating shortcuts...'
|
||||
$uninstallShortCut = @'
|
||||
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
|
||||
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
|
||||
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
|
||||
@@ -562,12 +598,13 @@ if ($Host.Name -eq "ConsoleHost")
|
||||
}
|
||||
'@
|
||||
|
||||
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
||||
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
||||
}
|
||||
|
||||
Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
|
||||
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'
|
||||
|
||||
@@ -9,8 +9,8 @@ set -eu
|
||||
|
||||
case $HOOK_GHC_TYPE in
|
||||
bindist)
|
||||
ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
|
||||
printf "%s/ghc" "${ghcdir}"
|
||||
ghc_path=$(ghcup whereis ghc "$HOOK_GHC_VERSION" || { ghcup install ghc "$HOOK_GHC_VERSION" >/dev/null && ghcup whereis ghc "$HOOK_GHC_VERSION" ; }) || { >&2 echo "Installing $HOOK_GHC_VERSION via ghcup failed" exit 3 ;}
|
||||
printf "%s" "${ghc_path}"
|
||||
;;
|
||||
git)
|
||||
# TODO: should be somewhat possible
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
resolver: lts-20.20
|
||||
resolver: lts-20.26
|
||||
|
||||
packages:
|
||||
- .
|
||||
@@ -24,6 +24,8 @@ extra-deps:
|
||||
- strict-base-0.4.0.0
|
||||
- text-2.0.2
|
||||
- yaml-streamly-0.12.2
|
||||
- github: fosskers/versions
|
||||
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
|
||||
@@ -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
|
||||
@@ -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"
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
51
test/optparse-test/ChangeLogTest.hs
Normal file
51
test/optparse-test/ChangeLogTest.hs
Normal 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
|
||||
191
test/optparse-test/CompileTest.hs
Normal file
191
test/optparse-test/CompileTest.hs
Normal 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
|
||||
41
test/optparse-test/ConfigTest.hs
Normal file
41
test/optparse-test/ConfigTest.hs
Normal file
@@ -0,0 +1,41 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module ConfigTest where
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import GHCup.OptParse
|
||||
import GHCup.Types (NewURLSource(..))
|
||||
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 (NewURI [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|])
|
||||
)
|
||||
, ("config add-release-channel GHCupURL"
|
||||
, AddReleaseChannel False NewGHCupURL
|
||||
)
|
||||
, ("config add-release-channel StackSetupURL"
|
||||
, AddReleaseChannel False NewStackSetupURL
|
||||
)
|
||||
, ("config set cache true", SetConfig "cache" (Just "true"))
|
||||
]
|
||||
|
||||
configParseWith :: [String] -> IO ConfigCommand
|
||||
configParseWith args = do
|
||||
Config a <- parseWith args
|
||||
pure a
|
||||
42
test/optparse-test/GCTest.hs
Normal file
42
test/optparse-test/GCTest.hs
Normal 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
|
||||
203
test/optparse-test/InstallTest.hs
Normal file
203
test/optparse-test/InstallTest.hs
Normal 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
|
||||
46
test/optparse-test/ListTest.hs
Normal file
46
test/optparse-test/ListTest.hs
Normal 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
|
||||
33
test/optparse-test/Main.hs
Normal file
33
test/optparse-test/Main.hs
Normal 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
|
||||
]
|
||||
38
test/optparse-test/OtherCommandTest.hs
Normal file
38
test/optparse-test/OtherCommandTest.hs
Normal 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
|
||||
62
test/optparse-test/RmTest.hs
Normal file
62
test/optparse-test/RmTest.hs
Normal 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
|
||||
68
test/optparse-test/RunTest.hs
Normal file
68
test/optparse-test/RunTest.hs
Normal 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
|
||||
156
test/optparse-test/SetTest.hs
Normal file
156
test/optparse-test/SetTest.hs
Normal 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
|
||||
50
test/optparse-test/UnsetTest.hs
Normal file
50
test/optparse-test/UnsetTest.hs
Normal 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
|
||||
38
test/optparse-test/UpgradeTest.hs
Normal file
38
test/optparse-test/UpgradeTest.hs
Normal 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)
|
||||
34
test/optparse-test/Utils.hs
Normal file
34
test/optparse-test/Utils.hs
Normal 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
|
||||
42
test/optparse-test/WhereisTest.hs
Normal file
42
test/optparse-test/WhereisTest.hs
Normal 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)
|
||||
Reference in New Issue
Block a user