Compare commits
110 Commits
issue-361
...
bryans-pgp
| Author | SHA1 | Date | |
|---|---|---|---|
| d6ee392eab | |||
| 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 | |||
| a05f272b58 | |||
| 07dfb1e94b | |||
| 6ff07d3dbc | |||
| 0da5572164 | |||
| 422b99a222 | |||
| 055df584a4 | |||
| 9798e0f1d2 | |||
| a43fa7d63e | |||
| 4361ef7a72 | |||
|
|
3218aaa378 | ||
| 186a37cf3e | |||
|
|
7b1f591cc4 | ||
| 0ecd244177 | |||
| e14600ae75 | |||
| 0884756139 | |||
| 4c539d62c1 | |||
| f5b58d1db7 | |||
| 18f6a74d08 | |||
| becb3436d0 | |||
| 1f220cd488 | |||
| 572ee06bbb | |||
| 6e1380ef2e | |||
| 3e83a7fd83 | |||
| 34ac9cec4d | |||
| 513f7446b3 | |||
| aed478153d | |||
| 210816769a | |||
| 42bf21c86e | |||
| 4b34cddcda | |||
| 1ba2361fea | |||
| 278a3005d1 | |||
|
|
78d68e381a | ||
| 17ffc459db | |||
| afcb482866 | |||
|
c28de19faa
|
|||
|
7ae952c82e
|
|||
|
|
98098035c9 | ||
|
acdc0786ba
|
|||
|
7fa72a8892
|
|||
|
fa22920e51
|
|||
|
f084fbce43
|
|||
|
|
1850c00e9d | ||
|
c20deceaa8
|
|||
|
89e4145baf
|
|||
|
|
f5f7c26d8a |
@@ -1,5 +1,5 @@
|
|||||||
freebsd_instance:
|
freebsd_instance:
|
||||||
image_family: freebsd-13-1
|
image_family: freebsd-13-2
|
||||||
|
|
||||||
build_task:
|
build_task:
|
||||||
name: build
|
name: build
|
||||||
@@ -16,7 +16,9 @@ build_task:
|
|||||||
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
||||||
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
||||||
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
||||||
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
install_script:
|
||||||
|
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
|
||||||
|
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
||||||
script:
|
script:
|
||||||
- tzsetup Etc/GMT
|
- tzsetup Etc/GMT
|
||||||
- adjkerntz -a
|
- adjkerntz -a
|
||||||
|
|||||||
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
|
mkdir -p out
|
||||||
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
|
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
|
||||||
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
|
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)
|
ver=$("${binary}" --numeric-version)
|
||||||
strip_binary "${binary}"
|
strip_binary "${binary}"
|
||||||
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
|
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
|
||||||
cp "${binary_test}" "out/test-${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"
|
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
|
||||||
|
|
||||||
|
|||||||
13
.github/scripts/cabal-cache.sh
vendored
Normal file
13
.github/scripts/cabal-cache.sh
vendored
Normal file
@@ -0,0 +1,13 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
case "$(uname -s)" in
|
||||||
|
MSYS_*|MINGW*)
|
||||||
|
ext=".exe"
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
ext=""
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
|
||||||
|
echo "cabal-cache disabled (CABAL_CACHE_DISABLE set)"
|
||||||
|
|
||||||
8
.github/scripts/common.sh
vendored
8
.github/scripts/common.sh
vendored
@@ -15,7 +15,7 @@ sync_from() {
|
|||||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
cabal-cache sync-from-archive \
|
cabal-cache.sh sync-from-archive \
|
||||||
--host-name-override=${S3_HOST} \
|
--host-name-override=${S3_HOST} \
|
||||||
--host-port-override=443 \
|
--host-port-override=443 \
|
||||||
--host-ssl-override=True \
|
--host-ssl-override=True \
|
||||||
@@ -29,7 +29,7 @@ sync_to() {
|
|||||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
cabal-cache sync-to-archive \
|
cabal-cache.sh sync-to-archive \
|
||||||
--host-name-override=${S3_HOST} \
|
--host-name-override=${S3_HOST} \
|
||||||
--host-port-override=443 \
|
--host-port-override=443 \
|
||||||
--host-ssl-override=True \
|
--host-ssl-override=True \
|
||||||
@@ -115,6 +115,10 @@ download_cabal_cache() {
|
|||||||
mv "cabal-cache${exe}" "${dest}${exe}"
|
mv "cabal-cache${exe}" "${dest}${exe}"
|
||||||
chmod +x "${dest}${exe}"
|
chmod +x "${dest}${exe}"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
# install shell wrapper
|
||||||
|
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
|
||||||
|
chmod +x "$HOME"/.local/bin/cabal-cache.sh
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
74
.github/scripts/cross.sh
vendored
Normal file
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 ]
|
||||||
|
|
||||||
5
.github/scripts/test.sh
vendored
5
.github/scripts/test.sh
vendored
@@ -18,8 +18,10 @@ mkdir -p "${GHCUP_BIN}"
|
|||||||
|
|
||||||
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
|
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
|
||||||
cp "out/test-${ARTIFACT}"-* "ghcup-test${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_BIN/ghcup${ext}"
|
||||||
chmod +x "ghcup-test${ext}"
|
chmod +x "ghcup-test${ext}"
|
||||||
|
chmod +x "ghcup-test-optparse${ext}"
|
||||||
|
|
||||||
"$GHCUP_BIN/ghcup${ext}" --version
|
"$GHCUP_BIN/ghcup${ext}" --version
|
||||||
eghcup --version
|
eghcup --version
|
||||||
@@ -29,7 +31,8 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
|
|||||||
### Haskell test suite
|
### Haskell test suite
|
||||||
|
|
||||||
./ghcup-test${ext}
|
./ghcup-test${ext}
|
||||||
rm ghcup-test${ext}
|
./ghcup-test-optparse${ext}
|
||||||
|
rm ghcup-test${ext} ghcup-test-optparse${ext}
|
||||||
|
|
||||||
### manual cli based testing
|
### manual cli based testing
|
||||||
|
|
||||||
|
|||||||
2
.github/workflows/bootstrap.yaml
vendored
2
.github/workflows/bootstrap.yaml
vendored
@@ -25,7 +25,7 @@ jobs:
|
|||||||
include:
|
include:
|
||||||
- os: ubuntu-latest
|
- os: ubuntu-latest
|
||||||
DISTRO: Ubuntu
|
DISTRO: Ubuntu
|
||||||
- os: macOS-10.15
|
- os: macOS-11
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
- os: windows-latest
|
- os: windows-latest
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
|
|||||||
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
|
||||||
|
|
||||||
6
.github/workflows/docker.yaml
vendored
6
.github/workflows/docker.yaml
vendored
@@ -53,7 +53,7 @@ jobs:
|
|||||||
platforms: linux/amd64
|
platforms: linux/amd64
|
||||||
|
|
||||||
docker-arm32:
|
docker-arm32:
|
||||||
runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
|
runs-on: [self-hosted, Linux, ARM64]
|
||||||
steps:
|
steps:
|
||||||
- uses: docker://arm64v8/ubuntu:focal
|
- uses: docker://arm64v8/ubuntu:focal
|
||||||
name: Cleanup (aarch64 linux)
|
name: Cleanup (aarch64 linux)
|
||||||
@@ -85,7 +85,7 @@ jobs:
|
|||||||
with:
|
with:
|
||||||
context: ./docker/arm32v7/focal
|
context: ./docker/arm32v7/focal
|
||||||
push: true
|
push: true
|
||||||
tags: hasufell/arm32v7-debian-haskell:10
|
tags: hasufell/arm32v7-ubuntu-haskell:focal
|
||||||
platforms: linux/arm
|
platforms: linux/arm
|
||||||
|
|
||||||
docker-aarch:
|
docker-aarch:
|
||||||
@@ -121,5 +121,5 @@ jobs:
|
|||||||
with:
|
with:
|
||||||
context: ./docker/arm64v8/focal
|
context: ./docker/arm64v8/focal
|
||||||
push: true
|
push: true
|
||||||
tags: hasufell/arm64v8-debian-haskell:10
|
tags: hasufell/arm64v8-ubuntu-haskell:focal
|
||||||
platforms: linux/arm64
|
platforms: linux/arm64
|
||||||
|
|||||||
24
.github/workflows/release.yaml
vendored
24
.github/workflows/release.yaml
vendored
@@ -12,12 +12,16 @@ on:
|
|||||||
schedule:
|
schedule:
|
||||||
- cron: '0 2 * * *'
|
- cron: '0 2 * * *'
|
||||||
|
|
||||||
|
env:
|
||||||
|
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
|
||||||
|
CABAL_CACHE_NONFATAL: yes
|
||||||
|
|
||||||
jobs:
|
jobs:
|
||||||
build-linux:
|
build-linux:
|
||||||
name: Build linux binary
|
name: Build linux binary
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||||
@@ -81,7 +85,7 @@ jobs:
|
|||||||
name: Build ARM binary
|
name: Build ARM binary
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||||
@@ -90,7 +94,7 @@ jobs:
|
|||||||
fail-fast: true
|
fail-fast: true
|
||||||
matrix:
|
matrix:
|
||||||
include:
|
include:
|
||||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
- os: [self-hosted, Linux, ARM64]
|
||||||
ARTIFACT: "armv7-linux-ghcup"
|
ARTIFACT: "armv7-linux-ghcup"
|
||||||
GHC_VER: 9.2.2
|
GHC_VER: 9.2.2
|
||||||
ARCH: ARM
|
ARCH: ARM
|
||||||
@@ -154,7 +158,7 @@ jobs:
|
|||||||
name: Build binary (Mac/Win)
|
name: Build binary (Mac/Win)
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
@@ -168,7 +172,7 @@ jobs:
|
|||||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.6
|
GHC_VER: 9.2.6
|
||||||
ARCH: ARM64
|
ARCH: ARM64
|
||||||
- os: macOS-10.15
|
- os: macOS-11
|
||||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.6
|
GHC_VER: 9.2.6
|
||||||
ARCH: 64
|
ARCH: 64
|
||||||
@@ -247,7 +251,7 @@ jobs:
|
|||||||
needs: "build-linux"
|
needs: "build-linux"
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
strategy:
|
strategy:
|
||||||
matrix:
|
matrix:
|
||||||
@@ -325,12 +329,12 @@ jobs:
|
|||||||
needs: "build-arm"
|
needs: "build-arm"
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
strategy:
|
strategy:
|
||||||
matrix:
|
matrix:
|
||||||
include:
|
include:
|
||||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
- os: [self-hosted, Linux, ARM64]
|
||||||
ARTIFACT: "armv7-linux-ghcup"
|
ARTIFACT: "armv7-linux-ghcup"
|
||||||
GHC_VER: 9.2.2
|
GHC_VER: 9.2.2
|
||||||
ARCH: ARM
|
ARCH: ARM
|
||||||
@@ -392,7 +396,7 @@ jobs:
|
|||||||
needs: "build-macwin"
|
needs: "build-macwin"
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
strategy:
|
strategy:
|
||||||
@@ -403,7 +407,7 @@ jobs:
|
|||||||
GHC_VER: 9.2.6
|
GHC_VER: 9.2.6
|
||||||
ARCH: ARM64
|
ARCH: ARM64
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
- os: macOS-10.15
|
- os: macOS-11
|
||||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.6
|
GHC_VER: 9.2.6
|
||||||
ARCH: 64
|
ARCH: 64
|
||||||
|
|||||||
13
CHANGELOG.md
13
CHANGELOG.md
@@ -1,5 +1,18 @@
|
|||||||
# Revision history for ghcup
|
# Revision history for ghcup
|
||||||
|
|
||||||
|
## 0.1.19.5 -- ????-?-??
|
||||||
|
|
||||||
|
* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
|
||||||
|
|
||||||
|
## 0.1.19.4 -- 2023-7-02
|
||||||
|
|
||||||
|
* fix missing TUI for aarch64 linux binaries
|
||||||
|
|
||||||
|
## 0.1.19.3 -- 2023-6-29
|
||||||
|
|
||||||
|
* Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824)
|
||||||
|
* Fix GC with XDG dirs, fixes [#810](https://github.com/haskell/ghcup-hs/issues/810)
|
||||||
|
|
||||||
## 0.1.19.2 -- 2023-2-24
|
## 0.1.19.2 -- 2023-2-24
|
||||||
|
|
||||||
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)
|
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)
|
||||||
|
|||||||
@@ -11,6 +11,7 @@ module BrickMain where
|
|||||||
import GHCup
|
import GHCup
|
||||||
import GHCup.Download
|
import GHCup.Download
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
|
import GHCup.Types.Optics ( getDirs )
|
||||||
import GHCup.Types hiding ( LeanAppState(..) )
|
import GHCup.Types hiding ( LeanAppState(..) )
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import GHCup.OptParse.Common (logGHCPostRm)
|
import GHCup.OptParse.Common (logGHCPostRm)
|
||||||
@@ -19,7 +20,6 @@ import GHCup.Prelude.File
|
|||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.Process
|
import GHCup.Prelude.Process
|
||||||
import GHCup.Prompts
|
import GHCup.Prompts
|
||||||
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
|
||||||
|
|
||||||
import Brick
|
import Brick
|
||||||
import Brick.Widgets.Border
|
import Brick.Widgets.Border
|
||||||
@@ -53,7 +53,6 @@ import System.Exit
|
|||||||
import System.IO.Unsafe
|
import System.IO.Unsafe
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
import Optics ( view )
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy.Builder as B
|
import qualified Data.Text.Lazy.Builder as B
|
||||||
@@ -74,8 +73,8 @@ data BrickData = BrickData
|
|||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
data BrickSettings = BrickSettings
|
data BrickSettings = BrickSettings
|
||||||
{ showAllVersions :: Bool
|
{ showAllVersions :: Bool
|
||||||
, showAllTools :: Bool
|
, showAllTools :: Bool
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
@@ -157,10 +156,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
|||||||
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
|
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
|
||||||
<+> padLeft (Pad 5) (str "Notes")
|
<+> padLeft (Pad 5) (str "Notes")
|
||||||
renderList' bis@BrickInternalState{..} =
|
renderList' bis@BrickInternalState{..} =
|
||||||
let getMinLength = length . intercalate "," . fmap tagToString
|
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
|
||||||
minLength = V.maximum $ V.map (getMinLength . lTag) clr
|
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
|
||||||
in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis
|
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
|
||||||
renderItem minTagSize _ b listResult@ListResult{lTag = lTag', ..} =
|
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
|
||||||
let marks = if
|
let marks = if
|
||||||
| lSet -> (withAttr (attrName "set") $ str "✔✔")
|
| lSet -> (withAttr (attrName "set") $ str "✔✔")
|
||||||
| lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
|
| lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
|
||||||
@@ -185,7 +184,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
|||||||
( minHSize 6
|
( minHSize 6
|
||||||
(printTool lTool)
|
(printTool lTool)
|
||||||
)
|
)
|
||||||
<+> minHSize 15 (str ver)
|
<+> minHSize minVerSize (str ver)
|
||||||
<+> (let l = catMaybes . fmap printTag $ sort lTag'
|
<+> (let l = catMaybes . fmap printTag $ sort lTag'
|
||||||
in padLeft (Pad 1) $ minHSize minTagSize $ if null l
|
in padLeft (Pad 1) $ minHSize minTagSize $ if null l
|
||||||
then emptyWidget
|
then emptyWidget
|
||||||
@@ -203,9 +202,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
|||||||
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
|
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
|
||||||
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
|
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
|
||||||
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
|
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
|
||||||
|
printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly"
|
||||||
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
|
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||||
printTag Old = Nothing
|
printTag Old = Nothing
|
||||||
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
|
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
|
||||||
|
printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly"
|
||||||
printTag (UnknownTag t) = Just $ str t
|
printTag (UnknownTag t) = Just $ str t
|
||||||
|
|
||||||
printTool Cabal = str "cabal"
|
printTool Cabal = str "cabal"
|
||||||
@@ -217,8 +218,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
|||||||
printNotes ListResult {..} =
|
printNotes ListResult {..} =
|
||||||
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
|
(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)
|
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
|
||||||
|
++ (case lReleaseDay of
|
||||||
|
Nothing -> mempty
|
||||||
|
Just d -> [withAttr (attrName "day") $ str (show d)])
|
||||||
|
|
||||||
-- | Draws the list elements.
|
-- | Draws the list elements.
|
||||||
--
|
--
|
||||||
@@ -273,19 +276,22 @@ app attrs dimAttrs =
|
|||||||
defaultAttributes :: Bool -> AttrMap
|
defaultAttributes :: Bool -> AttrMap
|
||||||
defaultAttributes no_color = attrMap
|
defaultAttributes no_color = attrMap
|
||||||
Vty.defAttr
|
Vty.defAttr
|
||||||
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
|
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
|
||||||
, (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
|
, (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red)
|
||||||
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
|
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
|
||||||
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
|
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
|
||||||
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
|
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
|
||||||
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
||||||
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
||||||
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||||
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
, (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red)
|
||||||
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||||
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
|
, (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red)
|
||||||
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
||||||
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
|
||||||
|
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
|
||||||
|
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
||||||
|
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
withForeColor | no_color = const
|
withForeColor | no_color = const
|
||||||
@@ -412,13 +418,17 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
|
|||||||
filterVisible v t e | lInstalled e = True
|
filterVisible v t e | lInstalled e = True
|
||||||
| v
|
| v
|
||||||
, not t
|
, not t
|
||||||
|
, Nightly `notElem` lTag e
|
||||||
, lTool e `notElem` hiddenTools = True
|
, lTool e `notElem` hiddenTools = True
|
||||||
| not v
|
| not v
|
||||||
, t
|
, t
|
||||||
, Old `notElem` lTag e = True
|
, Old `notElem` lTag e
|
||||||
|
, Nightly `notElem` lTag e = True
|
||||||
| v
|
| v
|
||||||
|
, Nightly `notElem` lTag e
|
||||||
, t = True
|
, t = True
|
||||||
| otherwise = (Old `notElem` lTag e) &&
|
| otherwise = (Old `notElem` lTag e) &&
|
||||||
|
(Nightly `notElem` lTag e) &&
|
||||||
(lTool e `notElem` hiddenTools)
|
(lTool e `notElem` hiddenTools)
|
||||||
|
|
||||||
|
|
||||||
@@ -461,24 +471,24 @@ install' _ (_, ListResult {..}) = do
|
|||||||
dirs <- lift getDirs
|
dirs <- lift getDirs
|
||||||
case lTool of
|
case lTool of
|
||||||
GHC -> do
|
GHC -> do
|
||||||
let vi = getVersionInfo lVer GHC dls
|
let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
|
||||||
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
|
liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
let vi = getVersionInfo lVer Cabal dls
|
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
|
||||||
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
|
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let vi = snd <$> getLatest dls GHCup
|
let vi = snd <$> getLatest dls GHCup
|
||||||
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
||||||
HLS -> do
|
HLS -> do
|
||||||
let vi = getVersionInfo lVer HLS dls
|
let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
|
||||||
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
|
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||||
Stack -> do
|
Stack -> do
|
||||||
let vi = getVersionInfo lVer Stack dls
|
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
|
||||||
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
|
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight (vi, Dirs{..}, Just ce) -> do
|
VRight (vi, Dirs{..}, Just ce) -> do
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
|
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||||
case lTool of
|
case lTool of
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||||
@@ -490,7 +500,7 @@ install' _ (_, ListResult {..}) = do
|
|||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
pure $ Right ()
|
pure $ Right ()
|
||||||
VRight (vi, _, _) -> do
|
VRight (vi, _, _) -> do
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
|
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||||
pure $ Right ()
|
pure $ Right ()
|
||||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||||
@@ -554,7 +564,7 @@ del' _ (_, ListResult {..}) = do
|
|||||||
let run = runE @'[NotInstalled, UninstallFailed]
|
let run = runE @'[NotInstalled, UninstallFailed]
|
||||||
|
|
||||||
run (do
|
run (do
|
||||||
let vi = getVersionInfo lVer lTool dls
|
let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
|
||||||
case lTool of
|
case lTool of
|
||||||
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
|
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
|
||||||
Cabal -> liftE $ rmCabalVer lVer $> vi
|
Cabal -> liftE $ rmCabalVer lVer $> vi
|
||||||
@@ -564,8 +574,8 @@ del' _ (_, ListResult {..}) = do
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
logGHCPostRm (mkTVer lVer)
|
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
|
||||||
forM_ (view viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
logInfo msg
|
logInfo msg
|
||||||
pure $ Right ()
|
pure $ Right ()
|
||||||
VLeft e -> pure $ Left (prettyHFError e)
|
VLeft e -> pure $ Left (prettyHFError e)
|
||||||
@@ -577,7 +587,7 @@ changelog' :: (MonadReader AppState m, MonadIO m)
|
|||||||
-> m (Either String ())
|
-> m (Either String ())
|
||||||
changelog' _ (_, ListResult {..}) = do
|
changelog' _ (_, ListResult {..}) = do
|
||||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||||
case getChangeLog dls lTool (Left lVer) of
|
case getChangeLog dls lTool (ToolVersion lVer) of
|
||||||
Nothing -> pure $ Left $
|
Nothing -> pure $ Left $
|
||||||
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
|
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
@@ -657,5 +667,5 @@ getAppData mgi = runExceptT $ do
|
|||||||
settings <- liftIO $ readIORef settings'
|
settings <- liftIO $ readIORef settings'
|
||||||
|
|
||||||
flip runReaderT settings $ do
|
flip runReaderT settings $ do
|
||||||
lV <- listVersions Nothing Nothing
|
lV <- listVersions Nothing [] False True (Nothing, Nothing)
|
||||||
pure $ BrickData (reverse lV)
|
pure $ BrickData (reverse lV)
|
||||||
|
|||||||
@@ -244,7 +244,8 @@ com =
|
|||||||
<> command
|
<> command
|
||||||
"list"
|
"list"
|
||||||
(info (List <$> listOpts <**> helper)
|
(info (List <$> listOpts <**> helper)
|
||||||
(progDesc "Show available GHCs and other tools")
|
(progDesc "Show available GHCs and other tools"
|
||||||
|
<> footerDoc (Just $ text listToolFooter))
|
||||||
)
|
)
|
||||||
<> command
|
<> command
|
||||||
"upgrade"
|
"upgrade"
|
||||||
|
|||||||
@@ -35,7 +35,6 @@ import qualified Data.Text as T
|
|||||||
import Control.Exception.Safe (MonadMask)
|
import Control.Exception.Safe (MonadMask)
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import Data.Versions
|
|
||||||
import URI.ByteString (serializeURIRef')
|
import URI.ByteString (serializeURIRef')
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
|
|
||||||
@@ -50,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
|
|||||||
{ clOpen :: Bool
|
{ clOpen :: Bool
|
||||||
, clTool :: Maybe Tool
|
, clTool :: Maybe Tool
|
||||||
, clToolVer :: Maybe ToolVersion
|
, clToolVer :: Maybe ToolVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -76,12 +75,12 @@ changelogP =
|
|||||||
e -> Left e
|
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)"
|
"Open changelog for given tool (default: ghc)"
|
||||||
<> completer toolCompleter
|
<> completer toolCompleter
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional (toolVersionTagArgument Nothing Nothing)
|
<*> optional (toolVersionTagArgument [] Nothing)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -115,20 +114,15 @@ changelog :: ( Monad m
|
|||||||
changelog ChangeLogOptions{..} runAppState runLogger = do
|
changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||||
let tool = fromMaybe GHC clTool
|
let tool = fromMaybe GHC clTool
|
||||||
ver' = maybe
|
ver' = fromMaybe
|
||||||
(Right Latest)
|
(ToolTag Latest)
|
||||||
(\case
|
|
||||||
GHCVersion tv -> Left (_tvVersion tv)
|
|
||||||
ToolVersion tv -> Left tv
|
|
||||||
ToolTag t -> Right t
|
|
||||||
)
|
|
||||||
clToolVer
|
clToolVer
|
||||||
muri = getChangeLog dls tool ver'
|
muri = getChangeLog dls tool ver'
|
||||||
case muri of
|
case muri of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
runLogger
|
runLogger
|
||||||
(logWarn $
|
(logWarn $
|
||||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
|
||||||
)
|
)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
|
|||||||
@@ -5,6 +5,7 @@
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE NumericUnderscores #-}
|
{-# LANGUAGE NumericUnderscores #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
module GHCup.OptParse.Common where
|
module GHCup.OptParse.Common where
|
||||||
|
|
||||||
@@ -45,6 +46,8 @@ import Data.Functor
|
|||||||
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
|
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
|
||||||
import Data.Versions hiding ( str )
|
import Data.Versions hiding ( str )
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
@@ -57,7 +60,6 @@ import System.Process ( readProcess )
|
|||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Text.HTML.TagSoup hiding ( Tag )
|
import Text.HTML.TagSoup hiding ( Tag )
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
import Optics ( view )
|
|
||||||
|
|
||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
@@ -73,26 +75,27 @@ import qualified Cabal.Config as CC
|
|||||||
--[ Types ]--
|
--[ Types ]--
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
data ToolVersion = GHCVersion GHCTargetVersion
|
|
||||||
| ToolVersion Version
|
|
||||||
| ToolTag Tag
|
|
||||||
|
|
||||||
-- a superset of ToolVersion
|
-- a superset of ToolVersion
|
||||||
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||||
| SetToolVersion Version
|
| SetToolVersion Version
|
||||||
| SetToolTag Tag
|
| SetToolTag Tag
|
||||||
|
| SetToolDay Day
|
||||||
| SetRecommended
|
| SetRecommended
|
||||||
| SetNext
|
| SetNext
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
prettyToolVer :: ToolVersion -> String
|
prettyToolVer :: ToolVersion -> String
|
||||||
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
||||||
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
|
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
|
||||||
prettyToolVer (ToolTag t) = show t
|
prettyToolVer (ToolTag t) = show t
|
||||||
|
prettyToolVer (ToolDay day) = show day
|
||||||
|
|
||||||
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
||||||
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
|
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
|
||||||
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
||||||
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
||||||
|
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
|
||||||
toSetToolVer Nothing = SetRecommended
|
toSetToolVer Nothing = SetRecommended
|
||||||
|
|
||||||
|
|
||||||
@@ -103,28 +106,28 @@ toSetToolVer Nothing = SetRecommended
|
|||||||
--------------
|
--------------
|
||||||
|
|
||||||
|
|
||||||
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
|
||||||
toolVersionTagArgument criteria tool =
|
toolVersionTagArgument criteria tool =
|
||||||
argument (eitherReader (parser tool))
|
argument (eitherReader (parser tool))
|
||||||
(metavar (mv tool)
|
(metavar (mv tool)
|
||||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||||
<> foldMap (completer . versionCompleter criteria) tool)
|
<> foldMap (completer . versionCompleter criteria) tool)
|
||||||
where
|
where
|
||||||
mv (Just GHC) = "GHC_VERSION|TAG"
|
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
|
||||||
mv (Just HLS) = "HLS_VERSION|TAG"
|
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
|
||||||
mv _ = "VERSION|TAG"
|
mv _ = "VERSION|TAG|RELEASE_DATE"
|
||||||
|
|
||||||
parser (Just GHC) = ghcVersionTagEither
|
parser (Just GHC) = ghcVersionTagEither
|
||||||
parser Nothing = ghcVersionTagEither
|
parser Nothing = ghcVersionTagEither
|
||||||
parser _ = toolVersionTagEither
|
parser _ = toolVersionTagEither
|
||||||
|
|
||||||
|
|
||||||
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
|
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
|
||||||
versionParser' criteria tool = argument
|
versionParser' criteria tool = argument
|
||||||
(eitherReader (first show . version . T.pack))
|
(eitherReader (first show . version . T.pack))
|
||||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
|
||||||
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
|
||||||
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
|
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
|
||||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
|
||||||
@@ -238,22 +241,23 @@ isolateParser f = case isValid f && isAbsolute f of
|
|||||||
-- this accepts cross prefix
|
-- this accepts cross prefix
|
||||||
ghcVersionTagEither :: String -> Either String ToolVersion
|
ghcVersionTagEither :: String -> Either String ToolVersion
|
||||||
ghcVersionTagEither s' =
|
ghcVersionTagEither s' =
|
||||||
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
|
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
|
||||||
|
|
||||||
-- this ignores cross prefix
|
-- this ignores cross prefix
|
||||||
toolVersionTagEither :: String -> Either String ToolVersion
|
toolVersionTagEither :: String -> Either String ToolVersion
|
||||||
toolVersionTagEither s' =
|
toolVersionTagEither s' =
|
||||||
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
|
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
|
||||||
|
|
||||||
tagEither :: String -> Either String Tag
|
tagEither :: String -> Either String Tag
|
||||||
tagEither s' = case fmap toLower s' of
|
tagEither s' = case fmap toLower s' of
|
||||||
"recommended" -> Right Recommended
|
"recommended" -> Right Recommended
|
||||||
"latest" -> Right Latest
|
"latest" -> Right Latest
|
||||||
"latest-prerelease" -> Right LatestPrerelease
|
"latest-prerelease" -> Right LatestPrerelease
|
||||||
|
"latest-nightly" -> Right LatestNightly
|
||||||
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
||||||
Right x -> Right (Base x)
|
Right x -> Right (Base x)
|
||||||
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
||||||
other -> Left $ "Unknown tag " <> other
|
other -> Left $ "Unknown tag " <> other
|
||||||
|
|
||||||
|
|
||||||
ghcVersionEither :: String -> Either String GHCTargetVersion
|
ghcVersionEither :: String -> Either String GHCTargetVersion
|
||||||
@@ -262,7 +266,7 @@ ghcVersionEither =
|
|||||||
|
|
||||||
toolVersionEither :: String -> Either String Version
|
toolVersionEither :: String -> Either String Version
|
||||||
toolVersionEither =
|
toolVersionEither =
|
||||||
first (const "Not a valid version") . MP.parse version' "" . T.pack
|
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
|
||||||
|
|
||||||
|
|
||||||
toolParser :: String -> Either String Tool
|
toolParser :: String -> Either String Tool
|
||||||
@@ -273,12 +277,22 @@ toolParser s' | t == T.pack "ghc" = Right GHC
|
|||||||
| otherwise = Left ("Unknown tool: " <> s')
|
| otherwise = Left ("Unknown tool: " <> s')
|
||||||
where t = T.toLower (T.pack s')
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
dayParser :: String -> Either String Day
|
||||||
|
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
|
||||||
|
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
|
||||||
|
|
||||||
|
|
||||||
criteriaParser :: String -> Either String ListCriteria
|
criteriaParser :: String -> Either String ListCriteria
|
||||||
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
|
||||||
| t == T.pack "set" = Right ListSet
|
| t == T.pack "set" = Right $ ListSet True
|
||||||
| t == T.pack "available" = Right ListAvailable
|
| t == T.pack "available" = Right $ ListAvailable True
|
||||||
| otherwise = Left ("Unknown criteria: " <> s')
|
| t == T.pack "+installed" = Right $ ListInstalled True
|
||||||
|
| t == T.pack "+set" = Right $ ListSet True
|
||||||
|
| t == T.pack "+available" = Right $ ListAvailable True
|
||||||
|
| t == T.pack "-installed" = Right $ ListInstalled False
|
||||||
|
| t == T.pack "-set" = Right $ ListSet False
|
||||||
|
| t == T.pack "-available" = Right $ ListAvailable False
|
||||||
|
| otherwise = Left ("Unknown criteria: " <> s')
|
||||||
where t = T.toLower (T.pack s')
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
|
||||||
@@ -452,14 +466,14 @@ tagCompleter tool add = listIOCompleter $ do
|
|||||||
case mGhcUpInfo of
|
case mGhcUpInfo of
|
||||||
VRight ghcupInfo -> do
|
VRight ghcupInfo -> do
|
||||||
let allTags = filter (/= Old)
|
let allTags = filter (/= Old)
|
||||||
$ (view viTags) =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||||
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
|
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
|
||||||
|
|
||||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
versionCompleter :: [ListCriteria] -> Tool -> Completer
|
||||||
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
|
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
|
||||||
|
|
||||||
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
|
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
|
||||||
versionCompleter' criteria tool filter' = listIOCompleter $ do
|
versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||||
dirs' <- liftIO getAllDirs
|
dirs' <- liftIO getAllDirs
|
||||||
let loggerConfig = LoggerConfig
|
let loggerConfig = LoggerConfig
|
||||||
@@ -488,7 +502,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
|
|||||||
|
|
||||||
runEnv = flip runReaderT appState
|
runEnv = flip runReaderT appState
|
||||||
|
|
||||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
|
||||||
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
|
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
|
||||||
|
|
||||||
|
|
||||||
@@ -656,6 +670,7 @@ fromVersion :: ( HasLog env
|
|||||||
-> Tool
|
-> Tool
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||||
@@ -674,49 +689,58 @@ fromVersion' :: ( HasLog env
|
|||||||
-> Tool
|
-> Tool
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||||
fromVersion' SetRecommended tool = do
|
fromVersion' SetRecommended tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getRecommended dls tool
|
second Just <$> getRecommended dls tool
|
||||||
?? TagNotFound Recommended tool
|
?? TagNotFound Recommended tool
|
||||||
fromVersion' (SetGHCVersion v) tool = do
|
fromVersion' (SetGHCVersion v) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
let vi = getVersionInfo v tool dls
|
||||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||||
Left _ -> pure (v, vi)
|
Left _ -> pure (v, vi)
|
||||||
Right pvpIn ->
|
Right pvpIn ->
|
||||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
|
||||||
Just (pvp_, vi') -> do
|
Just (pvp_, vi', mt) -> do
|
||||||
v' <- lift $ pvpToVersion pvp_ ""
|
v' <- lift $ pvpToVersion pvp_ ""
|
||||||
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||||
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
pure (GHCTargetVersion mt v', Just vi')
|
||||||
Nothing -> pure (v, vi)
|
Nothing -> pure (v, vi)
|
||||||
fromVersion' (SetToolVersion v) tool = do
|
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo v tool dls
|
let vi = getVersionInfo v tool dls
|
||||||
case pvp $ prettyVer v of -- need to be strict here
|
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||||
Left _ -> pure (mkTVer v, vi)
|
Left _ -> pure (v, vi)
|
||||||
Right pvpIn ->
|
Right pvpIn ->
|
||||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
|
||||||
Just (pvp_, vi') -> do
|
Just (pvp_, vi', mt) -> do
|
||||||
v' <- lift $ pvpToVersion pvp_ ""
|
v' <- lift $ pvpToVersion pvp_ ""
|
||||||
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||||
pure (GHCTargetVersion mempty v', Just vi')
|
pure (GHCTargetVersion mt v', Just vi')
|
||||||
Nothing -> pure (mkTVer v, vi)
|
Nothing -> pure (v, vi)
|
||||||
fromVersion' (SetToolTag Latest) tool = do
|
fromVersion' (SetToolTag Latest) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||||
|
fromVersion' (SetToolDay day) tool = do
|
||||||
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
bimap id Just <$> case getByReleaseDay dls tool day of
|
||||||
|
Left ad -> throwE $ DayNotFound day tool ad
|
||||||
|
Right v -> pure v
|
||||||
fromVersion' (SetToolTag LatestPrerelease) tool = do
|
fromVersion' (SetToolTag LatestPrerelease) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
|
bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
|
||||||
|
fromVersion' (SetToolTag LatestNightly) tool = do
|
||||||
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
|
||||||
fromVersion' (SetToolTag Recommended) tool = do
|
fromVersion' (SetToolTag Recommended) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
||||||
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
||||||
fromVersion' SetNext tool = do
|
fromVersion' SetNext tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
next <- case tool of
|
next <- case tool of
|
||||||
@@ -761,7 +785,7 @@ fromVersion' SetNext tool = do
|
|||||||
. sort
|
. sort
|
||||||
$ stacks) ?? NoToolVersionSet tool
|
$ stacks) ?? NoToolVersionSet tool
|
||||||
GHCup -> fail "GHCup cannot be set"
|
GHCup -> fail "GHCup cannot be set"
|
||||||
let vi = getVersionInfo (_tvVersion next) tool dls
|
let vi = getVersionInfo next tool dls
|
||||||
pure (next, vi)
|
pure (next, vi)
|
||||||
fromVersion' (SetToolTag t') tool =
|
fromVersion' (SetToolTag t') tool =
|
||||||
throwE $ TagNotFound t' tool
|
throwE $ TagNotFound t' tool
|
||||||
@@ -777,15 +801,15 @@ checkForUpdates :: ( MonadReader env m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> m [(Tool, Version)]
|
=> m [(Tool, GHCTargetVersion)]
|
||||||
checkForUpdates = do
|
checkForUpdates = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||||
lInstalled <- listVersions Nothing (Just ListInstalled)
|
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
|
||||||
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||||
|
|
||||||
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
|
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
|
||||||
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||||
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
|
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
|
||||||
|
|
||||||
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
||||||
forMM (getLatest dls t) $ \(l, _) -> do
|
forMM (getLatest dls t) $ \(l, _) -> do
|
||||||
|
|||||||
@@ -16,11 +16,11 @@ import qualified GHCup.GHC as GHC
|
|||||||
import qualified GHCup.HLS as HLS
|
import qualified GHCup.HLS as HLS
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import GHCup.Types.Optics
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
import GHCup.OptParse.Common
|
import GHCup.OptParse.Common
|
||||||
import GHCup.Types.Optics
|
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
@@ -36,7 +36,6 @@ import Data.Versions ( Version, prettyVer, version, p
|
|||||||
import qualified Data.Versions as V
|
import qualified Data.Versions as V
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Options.Applicative.Help.Pretty ( text )
|
import Options.Applicative.Help.Pretty ( text )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
@@ -58,6 +57,7 @@ import Text.Read (readEither)
|
|||||||
|
|
||||||
data CompileCommand = CompileGHC GHCCompileOptions
|
data CompileCommand = CompileGHC GHCCompileOptions
|
||||||
| CompileHLS HLSCompileOptions
|
| CompileHLS HLSCompileOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -67,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
|
|||||||
|
|
||||||
|
|
||||||
data GHCCompileOptions = GHCCompileOptions
|
data GHCCompileOptions = GHCCompileOptions
|
||||||
{ targetGhc :: GHC.GHCVer Version
|
{ targetGhc :: GHC.GHCVer
|
||||||
, bootstrapGhc :: Either Version FilePath
|
, bootstrapGhc :: Either Version FilePath
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, buildConfig :: Maybe FilePath
|
, buildConfig :: Maybe FilePath
|
||||||
@@ -77,9 +77,9 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, hadrian :: Bool
|
, buildSystem :: Maybe BuildSystem
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
data HLSCompileOptions = HLSCompileOptions
|
data HLSCompileOptions = HLSCompileOptions
|
||||||
@@ -94,7 +94,7 @@ data HLSCompileOptions = HLSCompileOptions
|
|||||||
, patches :: Maybe (Either FilePath [URI])
|
, patches :: Maybe (Either FilePath [URI])
|
||||||
, targetGHCs :: [ToolVersion]
|
, targetGHCs :: [ToolVersion]
|
||||||
, cabalArgs :: [Text]
|
, cabalArgs :: [Text]
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -171,7 +171,7 @@ ghcCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||||
"The tool version to compile"
|
"The tool version to compile"
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
) <|>
|
) <|>
|
||||||
(GHC.GitDist <$> (GitBranch <$> option
|
(GHC.GitDist <$> (GitBranch <$> option
|
||||||
@@ -206,7 +206,7 @@ ghcCompileOpts =
|
|||||||
<> metavar "BOOTSTRAP_GHC"
|
<> metavar "BOOTSTRAP_GHC"
|
||||||
<> help
|
<> help
|
||||||
"The GHC version (or full path) to bootstrap with (must be installed)"
|
"The GHC version (or full path) to bootstrap with (must be installed)"
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
@@ -259,7 +259,7 @@ ghcCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -269,16 +269,22 @@ ghcCompileOpts =
|
|||||||
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
"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
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader isolateParser)
|
(eitherReader isolateParser)
|
||||||
( short 'i'
|
( short 'i'
|
||||||
<> long "isolate"
|
<> long "isolate"
|
||||||
<> metavar "DIR"
|
<> 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")
|
<> completer (bashCompleter "directory")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -292,7 +298,7 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||||
"The version to compile (pulled from hackage)"
|
"The version to compile (pulled from hackage)"
|
||||||
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|>
|
<|>
|
||||||
@@ -312,7 +318,7 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
(long "source-dist" <> metavar "VERSION" <> help
|
(long "source-dist" <> metavar "VERSION" <> help
|
||||||
"The version to compile (pulled from packaged git sources)"
|
"The version to compile (pulled from packaged git sources)"
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
))
|
))
|
||||||
<|>
|
<|>
|
||||||
@@ -344,7 +350,7 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|>
|
<|>
|
||||||
@@ -361,7 +367,7 @@ hlsCompileOpts =
|
|||||||
( short 'i'
|
( short 'i'
|
||||||
<> long "isolate"
|
<> long "isolate"
|
||||||
<> metavar "DIR"
|
<> 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")
|
<> completer (bashCompleter "directory")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -404,7 +410,7 @@ hlsCompileOpts =
|
|||||||
option (eitherReader ghcVersionTagEither)
|
option (eitherReader ghcVersionTagEither)
|
||||||
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
||||||
<> completer (tagCompleter GHC [])
|
<> completer (tagCompleter GHC [])
|
||||||
<> completer (versionCompleter Nothing GHC))
|
<> completer (versionCompleter [] GHC))
|
||||||
)
|
)
|
||||||
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
||||||
|
|
||||||
@@ -454,6 +460,7 @@ type HLSEffects = '[ AlreadyInstalled
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
@@ -511,8 +518,8 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
case targetHLS of
|
case targetHLS of
|
||||||
HLS.SourceDist targetVer -> do
|
HLS.SourceDist targetVer -> do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
||||||
forM_ (view viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
lift $ logInfo msg
|
lift $ logInfo msg
|
||||||
lift $ logInfo
|
lift $ logInfo
|
||||||
"...waiting for 5 seconds, you can still abort..."
|
"...waiting for 5 seconds, you can still abort..."
|
||||||
@@ -531,7 +538,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
patches
|
patches
|
||||||
cabalArgs
|
cabalArgs
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
setHLS targetVer SetHLSOnly Nothing
|
setHLS targetVer SetHLSOnly Nothing
|
||||||
pure (vi, targetVer)
|
pure (vi, targetVer)
|
||||||
@@ -540,7 +547,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
VRight (vi, tv) -> do
|
VRight (vi, tv) -> do
|
||||||
runLogger $ logInfo
|
runLogger $ logInfo
|
||||||
"HLS successfully compiled and installed"
|
"HLS successfully compiled and installed"
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
liftIO $ putStr (T.unpack $ prettyVer tv)
|
liftIO $ putStr (T.unpack $ prettyVer tv)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
@@ -555,26 +562,21 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ logError $ T.pack $ prettyHFError e
|
runLogger $ logError $ T.pack $ prettyHFError e
|
||||||
pure $ ExitFailure 9
|
pure $ ExitFailure 9
|
||||||
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
|
||||||
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
|
||||||
pure $ ExitFailure 9
|
|
||||||
(CompileGHC GHCCompileOptions {..}) ->
|
(CompileGHC GHCCompileOptions {..}) ->
|
||||||
runCompileGHC runAppState (do
|
runCompileGHC runAppState (do
|
||||||
case targetGhc of
|
case targetGhc of
|
||||||
GHC.SourceDist targetVer -> do
|
GHC.SourceDist targetVer -> do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer GHC dls
|
let vi = getVersionInfo (mkTVer targetVer) GHC dls
|
||||||
forM_ (view viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
lift $ logInfo msg
|
lift $ logInfo msg
|
||||||
lift $ logInfo
|
lift $ logInfo
|
||||||
"...waiting for 5 seconds, you can still abort..."
|
"...waiting for 5 seconds, you can still abort..."
|
||||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
targetVer <- liftE $ compileGHC
|
targetVer <- liftE $ compileGHC
|
||||||
((\case
|
targetGhc
|
||||||
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
|
crossTarget
|
||||||
GHC.GitDist g -> GHC.GitDist g
|
|
||||||
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
|
|
||||||
ovewrwiteVer
|
ovewrwiteVer
|
||||||
bootstrapGhc
|
bootstrapGhc
|
||||||
jobs
|
jobs
|
||||||
@@ -582,10 +584,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
patches
|
patches
|
||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
buildSystem
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
let vi = getVersionInfo targetVer GHC dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
setGHC targetVer SetGHCOnly Nothing
|
setGHC targetVer SetGHCOnly Nothing
|
||||||
pure (vi, targetVer)
|
pure (vi, targetVer)
|
||||||
@@ -594,7 +596,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
VRight (vi, tv) -> do
|
VRight (vi, tv) -> do
|
||||||
runLogger $ logInfo
|
runLogger $ logInfo
|
||||||
"GHC successfully compiled and installed"
|
"GHC successfully compiled and installed"
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
liftIO $ putStr (T.unpack $ tVerToText tv)
|
liftIO $ putStr (T.unpack $ tVerToText tv)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
|||||||
@@ -52,6 +52,7 @@ data ConfigCommand
|
|||||||
| SetConfig String (Maybe String)
|
| SetConfig String (Maybe String)
|
||||||
| InitConfig
|
| InitConfig
|
||||||
| AddReleaseChannel Bool URI
|
| AddReleaseChannel Bool URI
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -47,7 +47,7 @@ data GCOptions = GCOptions
|
|||||||
, gcHLSNoGHC :: Bool
|
, gcHLSNoGHC :: Bool
|
||||||
, gcCache :: Bool
|
, gcCache :: Bool
|
||||||
, gcTmp :: Bool
|
, gcTmp :: Bool
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -23,7 +23,6 @@ import GHCup.Utils.Dirs
|
|||||||
import GHCup.Prelude
|
import GHCup.Prelude
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
import GHCup.Types.Optics
|
|
||||||
|
|
||||||
import Codec.Archive
|
import Codec.Archive
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
@@ -37,7 +36,6 @@ import Data.Maybe
|
|||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Options.Applicative.Help.Pretty ( text )
|
import Options.Applicative.Help.Pretty ( text )
|
||||||
import Optics
|
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import URI.ByteString hiding ( uriParser )
|
import URI.ByteString hiding ( uriParser )
|
||||||
@@ -56,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions
|
|||||||
| InstallCabal InstallOptions
|
| InstallCabal InstallOptions
|
||||||
| InstallHLS InstallOptions
|
| InstallHLS InstallOptions
|
||||||
| InstallStack InstallOptions
|
| InstallStack InstallOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -72,7 +71,7 @@ data InstallOptions = InstallOptions
|
|||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
, forceInstall :: Bool
|
, forceInstall :: Bool
|
||||||
, addConfArgs :: [T.Text]
|
, addConfArgs :: [T.Text]
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -186,7 +185,7 @@ installOpts tool =
|
|||||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
<*> (Just <$> toolVersionTagArgument [] tool)
|
||||||
)
|
)
|
||||||
<|> pure (Nothing, Nothing)
|
<|> pure (Nothing, Nothing)
|
||||||
)
|
)
|
||||||
@@ -198,7 +197,7 @@ installOpts tool =
|
|||||||
( short 'i'
|
( short 'i'
|
||||||
<> long "isolate"
|
<> long "isolate"
|
||||||
<> metavar "DIR"
|
<> 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")
|
<> completer (bashCompleter "directory")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -243,6 +242,7 @@ type InstallEffects = '[ AlreadyInstalled
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, DigestError
|
, DigestError
|
||||||
, ContentLengthError
|
, ContentLengthError
|
||||||
, GPGError
|
, GPGError
|
||||||
@@ -286,6 +286,7 @@ type InstallGHCEffects = '[ AlreadyInstalled
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, ProcessError
|
, ProcessError
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, UninstallFailed
|
, UninstallFailed
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
@@ -324,7 +325,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
Nothing -> runInstGHC s' $ do
|
Nothing -> runInstGHC s' $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
liftE $ runBothE' (installGHCBin
|
liftE $ runBothE' (installGHCBin
|
||||||
(_tvVersion v)
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
addConfArgs
|
addConfArgs
|
||||||
@@ -335,8 +336,8 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
runInstGHC s'{ settings = settings {noVerify = True}} $ do
|
runInstGHC s'{ settings = settings {noVerify = True}} $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
liftE $ runBothE' (installGHCBindist
|
liftE $ runBothE' (installGHCBindist
|
||||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
|
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
|
||||||
(_tvVersion v)
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
addConfArgs
|
addConfArgs
|
||||||
@@ -347,7 +348,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ logInfo "GHC installation successful"
|
runLogger $ logInfo "GHC installation successful"
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
|
||||||
@@ -405,7 +406,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
||||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||||
liftE $ runBothE' (installCabalBindist
|
liftE $ runBothE' (installCabalBindist
|
||||||
(DownloadInfo uri Nothing "" Nothing)
|
(DownloadInfo uri Nothing "" Nothing Nothing)
|
||||||
v
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
@@ -415,7 +416,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ logInfo "Cabal installation successful"
|
runLogger $ logInfo "Cabal installation successful"
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||||
@@ -455,7 +456,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||||
-- TODO: support legacy
|
-- TODO: support legacy
|
||||||
liftE $ runBothE' (installHLSBindist
|
liftE $ runBothE' (installHLSBindist
|
||||||
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
|
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
|
||||||
v
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
@@ -465,7 +466,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ logInfo "HLS installation successful"
|
runLogger $ logInfo "HLS installation successful"
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||||
@@ -504,7 +505,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
||||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||||
liftE $ runBothE' (installStackBindist
|
liftE $ runBothE' (installStackBindist
|
||||||
(DownloadInfo uri Nothing "" Nothing)
|
(DownloadInfo uri Nothing "" Nothing Nothing)
|
||||||
v
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
@@ -514,7 +515,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
runLogger $ logInfo "Stack installation successful"
|
runLogger $ logInfo "Stack installation successful"
|
||||||
forM_ (view viPostInstall =<< vi) $ \msg ->
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
VLeft e@(V (AlreadyInstalled _ _)) -> do
|
||||||
|
|||||||
@@ -2,6 +2,7 @@
|
|||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
|
||||||
@@ -14,6 +15,7 @@ import GHCup
|
|||||||
import GHCup.Prelude
|
import GHCup.Prelude
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.OptParse.Common
|
import GHCup.OptParse.Common
|
||||||
|
import GHCup.Prelude.String.QQ
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
@@ -24,6 +26,7 @@ import Data.Char
|
|||||||
import Data.List ( intercalate, sort )
|
import Data.List ( intercalate, sort )
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
import Data.Versions hiding ( str )
|
import Data.Versions hiding ( str )
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
@@ -50,8 +53,12 @@ import qualified Text.Megaparsec.Char as MPC
|
|||||||
data ListOptions = ListOptions
|
data ListOptions = ListOptions
|
||||||
{ loTool :: Maybe Tool
|
{ loTool :: Maybe Tool
|
||||||
, lCriteria :: Maybe ListCriteria
|
, lCriteria :: Maybe ListCriteria
|
||||||
|
, lFrom :: Maybe Day
|
||||||
|
, lTo :: Maybe Day
|
||||||
|
, lHideOld :: Bool
|
||||||
|
, lShowNightly :: Bool
|
||||||
, lRawFormat :: Bool
|
, lRawFormat :: Bool
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -60,7 +67,6 @@ data ListOptions = ListOptions
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
listOpts :: Parser ListOptions
|
listOpts :: Parser ListOptions
|
||||||
listOpts =
|
listOpts =
|
||||||
ListOptions
|
ListOptions
|
||||||
@@ -69,7 +75,7 @@ listOpts =
|
|||||||
(eitherReader toolParser)
|
(eitherReader toolParser)
|
||||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||||
"Tool to list versions for. Default is all"
|
"Tool to list versions for. Default is all"
|
||||||
<> completer (toolCompleter)
|
<> completer toolCompleter
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -78,15 +84,53 @@ listOpts =
|
|||||||
( short 'c'
|
( short 'c'
|
||||||
<> long "show-criteria"
|
<> long "show-criteria"
|
||||||
<> metavar "<installed|set|available>"
|
<> metavar "<installed|set|available>"
|
||||||
<> help "Show only installed/set/available tool versions"
|
<> help "Apply filtering criteria, prefix with + or -"
|
||||||
<> completer (listCompleter ["installed", "set", "available"])
|
<> completer (listCompleter
|
||||||
|
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader dayParser)
|
||||||
|
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
|
||||||
|
"List only tools with release date starting at YYYY-MM-DD or later"
|
||||||
|
<> completer toolCompleter
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader dayParser)
|
||||||
|
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
|
||||||
|
"List only tools with release date earlier than YYYY-MM-DD"
|
||||||
|
<> completer toolCompleter
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<*> switch
|
||||||
|
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
|
||||||
|
)
|
||||||
|
<*> switch
|
||||||
|
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
|
||||||
|
)
|
||||||
<*> switch
|
<*> switch
|
||||||
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
--------------
|
||||||
|
--[ Footer ]--
|
||||||
|
--------------
|
||||||
|
|
||||||
|
|
||||||
|
listToolFooter :: String
|
||||||
|
listToolFooter = [s|Discussion:
|
||||||
|
Lists tool versions with optional criteria.
|
||||||
|
Nightlies are by default hidden.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
# query nightlies in a specific range
|
||||||
|
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
|
||||||
|
# show all installed GHC versions
|
||||||
|
ghcup list -t ghc -c installed|]
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
@@ -105,9 +149,11 @@ printListResult no_color raw lr = do
|
|||||||
printTag Recommended = color Green "recommended"
|
printTag Recommended = color Green "recommended"
|
||||||
printTag Latest = color Yellow "latest"
|
printTag Latest = color Yellow "latest"
|
||||||
printTag Prerelease = color Red "prerelease"
|
printTag Prerelease = color Red "prerelease"
|
||||||
|
printTag Nightly = color Red "nightly"
|
||||||
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||||
printTag (UnknownTag t ) = t
|
printTag (UnknownTag t ) = t
|
||||||
printTag LatestPrerelease = color Red "latest-prerelease"
|
printTag LatestPrerelease = color Red "latest-prerelease"
|
||||||
|
printTag LatestNightly = color Red "latest-nightly"
|
||||||
printTag Old = ""
|
printTag Old = ""
|
||||||
|
|
||||||
let
|
let
|
||||||
@@ -134,8 +180,10 @@ printListResult no_color raw lr = do
|
|||||||
then [color Green "hls-powered"]
|
then [color Green "hls-powered"]
|
||||||
else mempty
|
else mempty
|
||||||
)
|
)
|
||||||
++ (if fromSrc then [color Blue "compiled"] else mempty)
|
|
||||||
++ (if lStray then [color Yellow "stray"] else mempty)
|
++ (if lStray then [color Yellow "stray"] else mempty)
|
||||||
|
++ (case lReleaseDay of
|
||||||
|
Nothing -> mempty
|
||||||
|
Just d -> [color Blue (show d)])
|
||||||
++ (if lNoBindist
|
++ (if lNoBindist
|
||||||
then [color Red "no-bindist"]
|
then [color Red "no-bindist"]
|
||||||
else mempty
|
else mempty
|
||||||
@@ -260,7 +308,7 @@ list :: ( Monad m
|
|||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
list ListOptions{..} no_color runAppState =
|
list ListOptions{..} no_color runAppState =
|
||||||
runAppState (do
|
runAppState (do
|
||||||
l <- listVersions loTool lCriteria
|
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
|
||||||
liftIO $ printListResult no_color lRawFormat l
|
liftIO $ printListResult no_color lRawFormat l
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -76,8 +76,8 @@ nuke appState runLogger = do
|
|||||||
|
|
||||||
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||||
lift $ logInfo "Nuking in 3...2...1"
|
lift $ logInfo "Nuking in 3...2...1"
|
||||||
|
|
||||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
|
||||||
|
|
||||||
forM_ lInstalled (liftE . rmTool)
|
forM_ lInstalled (liftE . rmTool)
|
||||||
|
|
||||||
|
|||||||
@@ -83,7 +83,7 @@ prefetchP = subparser
|
|||||||
<$> (PrefetchGHCOptions
|
<$> (PrefetchGHCOptions
|
||||||
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
||||||
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
|
<*> optional (toolVersionTagArgument [] (Just GHC)) )
|
||||||
( progDesc "Download GHC assets for installation")
|
( progDesc "Download GHC assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -92,7 +92,7 @@ prefetchP = subparser
|
|||||||
(info
|
(info
|
||||||
(PrefetchCabal
|
(PrefetchCabal
|
||||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
|
<*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
|
||||||
( progDesc "Download cabal assets for installation")
|
( progDesc "Download cabal assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -101,7 +101,7 @@ prefetchP = subparser
|
|||||||
(info
|
(info
|
||||||
(PrefetchHLS
|
(PrefetchHLS
|
||||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
|
<*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
|
||||||
( progDesc "Download HLS assets for installation")
|
( progDesc "Download HLS assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -110,7 +110,7 @@ prefetchP = subparser
|
|||||||
(info
|
(info
|
||||||
(PrefetchStack
|
(PrefetchStack
|
||||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
|
<*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
|
||||||
( progDesc "Download stack assets for installation")
|
( progDesc "Download stack assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -148,6 +148,7 @@ Examples:
|
|||||||
|
|
||||||
|
|
||||||
type PrefetchEffects = '[ TagNotFound
|
type PrefetchEffects = '[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, NoDownload
|
, NoDownload
|
||||||
@@ -194,7 +195,7 @@ prefetch prefetchCommand runAppState runLogger =
|
|||||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||||
(v, _) <- liftE $ fromVersion mt GHC
|
(v, _) <- liftE $ fromVersion mt GHC
|
||||||
if pfGHCSrc
|
if pfGHCSrc
|
||||||
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
|
then liftE $ fetchGHCSrc v pfCacheDir
|
||||||
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
||||||
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
||||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||||
|
|||||||
@@ -3,6 +3,7 @@
|
|||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
@@ -33,7 +34,6 @@ import Haskus.Utils.Variant.Excepts
|
|||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Optics
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Control.Exception.Safe (MonadMask)
|
import Control.Exception.Safe (MonadMask)
|
||||||
@@ -50,6 +50,7 @@ data RmCommand = RmGHC RmOptions
|
|||||||
| RmCabal Version
|
| RmCabal Version
|
||||||
| RmHLS Version
|
| RmHLS Version
|
||||||
| RmStack Version
|
| RmStack Version
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -61,7 +62,7 @@ data RmCommand = RmGHC RmOptions
|
|||||||
|
|
||||||
data RmOptions = RmOptions
|
data RmOptions = RmOptions
|
||||||
{ ghcVer :: GHCTargetVersion
|
{ ghcVer :: GHCTargetVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -80,19 +81,19 @@ rmParser =
|
|||||||
<> command
|
<> command
|
||||||
"cabal"
|
"cabal"
|
||||||
( RmCabal
|
( RmCabal
|
||||||
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
|
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
|
||||||
(progDesc "Remove Cabal version")
|
(progDesc "Remove Cabal version")
|
||||||
)
|
)
|
||||||
<> command
|
<> command
|
||||||
"hls"
|
"hls"
|
||||||
( RmHLS
|
( RmHLS
|
||||||
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
|
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
|
||||||
(progDesc "Remove haskell-language-server version")
|
(progDesc "Remove haskell-language-server version")
|
||||||
)
|
)
|
||||||
<> command
|
<> command
|
||||||
"stack"
|
"stack"
|
||||||
( RmStack
|
( RmStack
|
||||||
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
|
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
|
||||||
(progDesc "Remove stack version")
|
(progDesc "Remove stack version")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -102,7 +103,7 @@ rmParser =
|
|||||||
|
|
||||||
|
|
||||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||||
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
|
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -170,7 +171,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmGHCVer ghcVer
|
rmGHCVer ghcVer
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
|
pure (getVersionInfo ghcVer GHC dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -186,7 +187,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmCabalVer tv
|
rmCabalVer tv
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo tv Cabal dls)
|
pure (getVersionInfo (mkTVer tv) Cabal dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -201,7 +202,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmHLSVer tv
|
rmHLSVer tv
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo tv HLS dls)
|
pure (getVersionInfo (mkTVer tv) HLS dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -216,7 +217,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmStackVer tv
|
rmStackVer tv
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo tv Stack dls)
|
pure (getVersionInfo (mkTVer tv) Stack dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -227,5 +228,5 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
postRmLog vi =
|
postRmLog vi =
|
||||||
forM_ (view viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
|
|||||||
@@ -68,7 +68,7 @@ data RunOptions = RunOptions
|
|||||||
, runBinDir :: Maybe FilePath
|
, runBinDir :: Maybe FilePath
|
||||||
, runQuick :: Bool
|
, runQuick :: Bool
|
||||||
, runCOMMAND :: [String]
|
, runCOMMAND :: [String]
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -92,7 +92,7 @@ runOpts =
|
|||||||
(eitherReader ghcVersionTagEither)
|
(eitherReader ghcVersionTagEither)
|
||||||
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
||||||
<> completer (tagCompleter GHC [])
|
<> completer (tagCompleter GHC [])
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -100,7 +100,7 @@ runOpts =
|
|||||||
(eitherReader toolVersionTagEither)
|
(eitherReader toolVersionTagEither)
|
||||||
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
||||||
<> completer (tagCompleter Cabal [])
|
<> completer (tagCompleter Cabal [])
|
||||||
<> (completer $ versionCompleter Nothing Cabal)
|
<> (completer $ versionCompleter [] Cabal)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -108,7 +108,7 @@ runOpts =
|
|||||||
(eitherReader toolVersionTagEither)
|
(eitherReader toolVersionTagEither)
|
||||||
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
||||||
<> completer (tagCompleter HLS [])
|
<> completer (tagCompleter HLS [])
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -116,7 +116,7 @@ runOpts =
|
|||||||
(eitherReader toolVersionTagEither)
|
(eitherReader toolVersionTagEither)
|
||||||
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
||||||
<> completer (tagCompleter Stack [])
|
<> completer (tagCompleter Stack [])
|
||||||
<> (completer $ versionCompleter Nothing Stack)
|
<> (completer $ versionCompleter [] Stack)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -132,7 +132,7 @@ runOpts =
|
|||||||
<*> switch
|
<*> switch
|
||||||
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
|
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
|
||||||
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
|
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -175,6 +175,7 @@ type RunEffects = '[ AlreadyInstalled
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, DigestError
|
, DigestError
|
||||||
, ContentLengthError
|
, ContentLengthError
|
||||||
, GPGError
|
, GPGError
|
||||||
@@ -282,6 +283,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
)
|
)
|
||||||
=> Excepts
|
=> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] (ResourceT (ReaderT AppState m)) Toolchain
|
] (ResourceT (ReaderT AppState m)) Toolchain
|
||||||
@@ -332,6 +334,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
-> FilePath
|
-> FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
@@ -357,7 +360,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
Just v -> do
|
Just v -> do
|
||||||
isInstalled <- lift $ checkIfToolInstalled' GHC v
|
isInstalled <- lift $ checkIfToolInstalled' GHC v
|
||||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||||
(_tvVersion v)
|
v
|
||||||
GHCupInternal
|
GHCupInternal
|
||||||
False
|
False
|
||||||
[]
|
[]
|
||||||
|
|||||||
@@ -53,6 +53,7 @@ data SetCommand = SetGHC SetOptions
|
|||||||
| SetCabal SetOptions
|
| SetCabal SetOptions
|
||||||
| SetHLS SetOptions
|
| SetHLS SetOptions
|
||||||
| SetStack SetOptions
|
| SetStack SetOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -64,7 +65,7 @@ data SetCommand = SetGHC SetOptions
|
|||||||
|
|
||||||
data SetOptions = SetOptions
|
data SetOptions = SetOptions
|
||||||
{ sToolVer :: SetToolVersion
|
{ sToolVer :: SetToolVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -139,9 +140,9 @@ setParser =
|
|||||||
setOpts :: Tool -> Parser SetOptions
|
setOpts :: Tool -> Parser SetOptions
|
||||||
setOpts tool = SetOptions <$>
|
setOpts tool = SetOptions <$>
|
||||||
(fromMaybe SetRecommended <$>
|
(fromMaybe SetRecommended <$>
|
||||||
optional (setVersionArgument (Just ListInstalled) tool))
|
optional (setVersionArgument [ListInstalled True] tool))
|
||||||
|
|
||||||
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
|
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
|
||||||
setVersionArgument criteria tool =
|
setVersionArgument criteria tool =
|
||||||
argument (eitherReader setEither)
|
argument (eitherReader setEither)
|
||||||
(metavar "VERSION|TAG|next"
|
(metavar "VERSION|TAG|next"
|
||||||
@@ -184,6 +185,7 @@ setFooter = [s|Discussion:
|
|||||||
type SetGHCEffects = '[ FileDoesNotExistError
|
type SetGHCEffects = '[ FileDoesNotExistError
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -198,6 +200,7 @@ runSetGHC runAppState =
|
|||||||
|
|
||||||
type SetCabalEffects = '[ NotInstalled
|
type SetCabalEffects = '[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -212,6 +215,7 @@ runSetCabal runAppState =
|
|||||||
|
|
||||||
type SetHLSEffects = '[ NotInstalled
|
type SetHLSEffects = '[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -226,6 +230,7 @@ runSetHLS runAppState =
|
|||||||
|
|
||||||
type SetStackEffects = '[ NotInstalled
|
type SetStackEffects = '[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
|
|||||||
@@ -112,7 +112,7 @@ testOpts tool =
|
|||||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
<*> (Just <$> toolVersionTagArgument [] tool)
|
||||||
)
|
)
|
||||||
<|> pure (Nothing, Nothing)
|
<|> pure (Nothing, Nothing)
|
||||||
)
|
)
|
||||||
@@ -140,6 +140,7 @@ type TestGHCEffects = [ DigestError
|
|||||||
, TestFailed
|
, TestFailed
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -168,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
|
|||||||
(case testBindist of
|
(case testBindist of
|
||||||
Nothing -> runTestGHC s' $ do
|
Nothing -> runTestGHC s' $ do
|
||||||
(v, vi) <- liftE $ fromVersion testVer GHC
|
(v, vi) <- liftE $ fromVersion testVer GHC
|
||||||
liftE $ testGHCVer (_tvVersion v) addMakeArgs
|
liftE $ testGHCVer v addMakeArgs
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
runTestGHC s'{ settings = settings {noVerify = True}} $ do
|
runTestGHC s'{ settings = settings {noVerify = True}} $ do
|
||||||
(v, vi) <- liftE $ fromVersion testVer GHC
|
(v, vi) <- liftE $ fromVersion testVer GHC
|
||||||
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs
|
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
|
||||||
pure vi
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
|
|||||||
@@ -48,6 +48,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
|
|||||||
| UnsetCabal UnsetOptions
|
| UnsetCabal UnsetOptions
|
||||||
| UnsetHLS UnsetOptions
|
| UnsetHLS UnsetOptions
|
||||||
| UnsetStack UnsetOptions
|
| UnsetStack UnsetOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -59,7 +60,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
|
|||||||
|
|
||||||
data UnsetOptions = UnsetOptions
|
data UnsetOptions = UnsetOptions
|
||||||
{ sToolVer :: Maybe T.Text -- target platform triple
|
{ sToolVer :: Maybe T.Text -- target platform triple
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -68,7 +69,7 @@ data UnsetOptions = UnsetOptions
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
unsetParser :: Parser UnsetCommand
|
unsetParser :: Parser UnsetCommand
|
||||||
unsetParser =
|
unsetParser =
|
||||||
subparser
|
subparser
|
||||||
@@ -113,7 +114,14 @@ unsetParser =
|
|||||||
unsetGHCFooter :: String
|
unsetGHCFooter :: String
|
||||||
unsetGHCFooter = [s|Discussion:
|
unsetGHCFooter = [s|Discussion:
|
||||||
Unsets the the current GHC version. That means there won't
|
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 :: String
|
||||||
unsetCabalFooter = [s|Discussion:
|
unsetCabalFooter = [s|Discussion:
|
||||||
|
|||||||
@@ -28,7 +28,6 @@ import Haskus.Utils.Variant.Excepts
|
|||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Optics ( view )
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Control.Exception.Safe (MonadMask)
|
import Control.Exception.Safe (MonadMask)
|
||||||
@@ -51,7 +50,7 @@ import Data.Versions hiding (str)
|
|||||||
data UpgradeOpts = UpgradeInplace
|
data UpgradeOpts = UpgradeInplace
|
||||||
| UpgradeAt FilePath
|
| UpgradeAt FilePath
|
||||||
| UpgradeGHCupDir
|
| UpgradeGHCupDir
|
||||||
deriving Show
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -145,7 +144,7 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
|
|||||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||||
runLogger $ logInfo $
|
runLogger $ logInfo $
|
||||||
"Successfully upgraded GHCup to version " <> pretty_v
|
"Successfully upgraded GHCup to version " <> pretty_v
|
||||||
forM_ (view viPostInstall vi) $ \msg ->
|
forM_ (_viPostInstall vi) $ \msg ->
|
||||||
runLogger $ logInfo msg
|
runLogger $ logInfo msg
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft (V NoUpdate) -> do
|
VLeft (V NoUpdate) -> do
|
||||||
|
|||||||
@@ -54,6 +54,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
|||||||
| WhereisCacheDir
|
| WhereisCacheDir
|
||||||
| WhereisLogsDir
|
| WhereisLogsDir
|
||||||
| WhereisConfDir
|
| WhereisConfDir
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -66,7 +67,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
|||||||
|
|
||||||
data WhereisOptions = WhereisOptions {
|
data WhereisOptions = WhereisOptions {
|
||||||
directory :: Bool
|
directory :: Bool
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -82,7 +83,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"ghc"
|
"ghc"
|
||||||
(WhereisTool GHC <$> info
|
(WhereisTool GHC <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
|
||||||
( progDesc "Get GHC location"
|
( progDesc "Get GHC location"
|
||||||
<> footerDoc (Just $ text whereisGHCFooter ))
|
<> footerDoc (Just $ text whereisGHCFooter ))
|
||||||
)
|
)
|
||||||
@@ -90,7 +91,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"cabal"
|
"cabal"
|
||||||
(WhereisTool Cabal <$> info
|
(WhereisTool Cabal <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
|
||||||
( progDesc "Get cabal location"
|
( progDesc "Get cabal location"
|
||||||
<> footerDoc (Just $ text whereisCabalFooter ))
|
<> footerDoc (Just $ text whereisCabalFooter ))
|
||||||
)
|
)
|
||||||
@@ -98,7 +99,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"hls"
|
"hls"
|
||||||
(WhereisTool HLS <$> info
|
(WhereisTool HLS <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
|
||||||
( progDesc "Get HLS location"
|
( progDesc "Get HLS location"
|
||||||
<> footerDoc (Just $ text whereisHLSFooter ))
|
<> footerDoc (Just $ text whereisHLSFooter ))
|
||||||
)
|
)
|
||||||
@@ -106,7 +107,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"stack"
|
"stack"
|
||||||
(WhereisTool Stack <$> info
|
(WhereisTool Stack <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
|
||||||
( progDesc "Get stack location"
|
( progDesc "Get stack location"
|
||||||
<> footerDoc (Just $ text whereisStackFooter ))
|
<> footerDoc (Just $ text whereisStackFooter ))
|
||||||
)
|
)
|
||||||
@@ -222,6 +223,7 @@ type WhereisEffects = '[ NotInstalled
|
|||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -240,7 +240,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
_
|
_
|
||||||
| Just False <- optVerbose -> pure ()
|
| Just False <- optVerbose -> pure ()
|
||||||
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||||
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
||||||
newTools <- lift checkForUpdates
|
newTools <- lift checkForUpdates
|
||||||
forM_ newTools $ \newTool@(t, l) -> do
|
forM_ newTools $ \newTool@(t, l) -> do
|
||||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
||||||
@@ -249,7 +249,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
case t of
|
case t of
|
||||||
GHCup -> runLogger $
|
GHCup -> runLogger $
|
||||||
logWarn ("New GHCup version available: "
|
logWarn ("New GHCup version available: "
|
||||||
<> prettyVer l
|
<> tVerToText l
|
||||||
<> ". To upgrade, run 'ghcup upgrade'")
|
<> ". To upgrade, run 'ghcup upgrade'")
|
||||||
_ -> runLogger $
|
_ -> runLogger $
|
||||||
logWarn ("New "
|
logWarn ("New "
|
||||||
@@ -258,7 +258,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
<> "If you want to install this latest version, run 'ghcup install "
|
<> "If you want to install this latest version, run 'ghcup install "
|
||||||
<> T.pack (prettyShow t)
|
<> T.pack (prettyShow t)
|
||||||
<> " "
|
<> " "
|
||||||
<> prettyVer l
|
<> tVerToText l
|
||||||
<> "'")
|
<> "'")
|
||||||
Just _ -> pure ()
|
Just _ -> pure ()
|
||||||
|
|
||||||
@@ -332,9 +332,10 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
)
|
)
|
||||||
=> Command
|
=> Command
|
||||||
-> (Tool, Version)
|
-> (Tool, GHCTargetVersion)
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m Bool
|
] m Bool
|
||||||
@@ -367,12 +368,13 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
=> Tool
|
=> Tool
|
||||||
-> Maybe ToolVersion
|
-> Maybe ToolVersion
|
||||||
-> Version
|
-> GHCTargetVersion
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m Bool
|
] m Bool
|
||||||
cmp' tool instVer ver = do
|
cmp' tool instVer ver = do
|
||||||
(v, _) <- liftE $ fromVersion instVer tool
|
(v, _) <- liftE $ fromVersion instVer tool
|
||||||
pure (v == mkTVer ver)
|
pure (v == ver)
|
||||||
|
|||||||
@@ -9,7 +9,7 @@ constraints: http-io-streams -brotli,
|
|||||||
any.aeson >= 2.0.1.0
|
any.aeson >= 2.0.1.0
|
||||||
|
|
||||||
package libarchive
|
package libarchive
|
||||||
flags: +system-libarchive
|
flags: -system-libarchive
|
||||||
|
|
||||||
package aeson-pretty
|
package aeson-pretty
|
||||||
flags: +lib-only
|
flags: +lib-only
|
||||||
@@ -23,3 +23,5 @@ package aeson
|
|||||||
package streamly
|
package streamly
|
||||||
flags: +use-unliftio
|
flags: +use-unliftio
|
||||||
|
|
||||||
|
package *
|
||||||
|
test-show-details: direct
|
||||||
Submodule data/metadata updated: 0b98de04cc...c88802ea8c
@@ -37,8 +37,8 @@ RUN apk add --no-cache \
|
|||||||
xz-dev \
|
xz-dev \
|
||||||
ncurses-static
|
ncurses-static
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||||
|
|||||||
@@ -37,8 +37,9 @@ RUN apk add --no-cache \
|
|||||||
xz-dev \
|
xz-dev \
|
||||||
ncurses-static
|
ncurses-static
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
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
|
RUN update_opt.sh 11 1
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.17.8
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
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
|
RUN update_opt.sh 9 1
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.17.8
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
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
|
RUN update_opt.sh 11 1
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
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
|
RUN update_opt.sh 9 1
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||||
|
|||||||
@@ -203,6 +203,34 @@ url-source:
|
|||||||
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
||||||
```
|
```
|
||||||
|
|
||||||
|
### Nightlies
|
||||||
|
|
||||||
|
Nightlies are just another 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 integration
|
||||||
|
|
||||||
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
||||||
@@ -461,8 +489,10 @@ this is cryptographically secure.
|
|||||||
First, obtain the gpg keys:
|
First, obtain the gpg keys:
|
||||||
|
|
||||||
```sh
|
```sh
|
||||||
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
|
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
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 33C3A599DB85EA9B8BAA1866B202264020068BFB
|
||||||
```
|
```
|
||||||
|
|
||||||
Then verify the gpg key in one of these ways:
|
Then verify the gpg key in one of these ways:
|
||||||
|
|||||||
102
docs/install.md
102
docs/install.md
@@ -38,47 +38,78 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
|
|||||||
|
|
||||||
### Linux Debian
|
### Linux Debian
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
#### Version >= 11
|
||||||
|
|
||||||
|
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
### Linux Ubuntu
|
### Linux Ubuntu
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
#### Version >= 20.04 && < 20.10
|
||||||
|
|
||||||
|
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
#### Version >= 20.10
|
||||||
|
|
||||||
|
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
|
||||||
### Linux Fedora
|
### Linux Fedora
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
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
|
### Linux CentOS
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
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
|
### 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`
|
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)
|
### 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.
|
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
|
### 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 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.
|
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
|
||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
|
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
|
||||||
|
|
||||||
|
|
||||||
### Windows
|
### 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.
|
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
|
## Next steps
|
||||||
@@ -102,10 +133,19 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
|
<tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
|
||||||
|
<tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
|
||||||
|
<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
|
||||||
|
<tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
|
||||||
|
<tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
|
||||||
|
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
|
||||||
|
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
|
||||||
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
|
<tr><td>9.4.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.4.1</td><td>base-4.17.0.0</td></tr>
|
||||||
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
|
<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
|
||||||
|
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
|
||||||
|
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
|
||||||
|
<tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
|
||||||
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
|
<tr><td>9.2.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.3</td><td>base-4.16.2.0</td></tr>
|
||||||
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
|
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
|
||||||
@@ -143,7 +183,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
|
<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
|
||||||
|
<tr><td>3.8.1.0</td><td></td></tr>
|
||||||
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
|
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
|
||||||
<tr><td>3.6.0.0</td><td></td></tr>
|
<tr><td>3.6.0.0</td><td></td></tr>
|
||||||
<tr><td>3.4.1.0</td><td></td></tr>
|
<tr><td>3.4.1.0</td><td></td></tr>
|
||||||
@@ -159,7 +200,14 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||||
|
<tr><td>2.1.0.0</td><td></td></tr>
|
||||||
|
<tr><td>2.0.0.1</td><td></td></tr>
|
||||||
|
<tr><td>2.0.0.0</td><td></td></tr>
|
||||||
|
<tr><td>1.10.0.0</td><td></td></tr>
|
||||||
|
<tr><td>1.9.1.0</td><td></td></tr>
|
||||||
|
<tr><td>1.9.0.0</td><td></td></tr>
|
||||||
|
<tr><td>1.8.0.0</td><td></td></tr>
|
||||||
<tr><td>1.7.0.0</td><td></td></tr>
|
<tr><td>1.7.0.0</td><td></td></tr>
|
||||||
<tr><td>1.6.1.0</td><td></td></tr>
|
<tr><td>1.6.1.0</td><td></td></tr>
|
||||||
<tr><td>1.6.0.0</td><td></td></tr>
|
<tr><td>1.6.0.0</td><td></td></tr>
|
||||||
@@ -177,7 +225,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
<tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
|
||||||
|
<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
|
||||||
|
<tr><td>2.9.1</td><td></td></tr>
|
||||||
<tr><td>2.7.5</td><td></td></tr>
|
<tr><td>2.7.5</td><td></td></tr>
|
||||||
<tr><td>2.7.3</td><td></td></tr>
|
<tr><td>2.7.3</td><td></td></tr>
|
||||||
<tr><td>2.7.1</td><td></td></tr>
|
<tr><td>2.7.1</td><td></td></tr>
|
||||||
@@ -190,7 +240,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
|
|
||||||
This list may not be exhaustive and specifies support for bindists only.
|
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 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
|
||||||
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||||
@@ -231,8 +281,9 @@ There are various issues with GHC itself.
|
|||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
|
|
||||||
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
|
Lacks some upstream bindists and may need compat libs (such as `misc/compat12x`).
|
||||||
HLS bindists are experimental.
|
HLS bindists are experimental.
|
||||||
|
Only latest FreeBSD is generally supported.
|
||||||
|
|
||||||
### Linux ARMv7/AARCH64
|
### Linux ARMv7/AARCH64
|
||||||
|
|
||||||
@@ -245,7 +296,12 @@ 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/)
|
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
|
||||||
and place it into your `PATH` anywhere.
|
and place it into your `PATH` anywhere.
|
||||||
|
|
||||||
If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
|
If you want to GPG verify the binaries, import the following keys first:
|
||||||
|
|
||||||
|
* `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C`
|
||||||
|
* `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`
|
||||||
|
* `88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4`
|
||||||
|
* `33C3A599DB85EA9B8BAA1866B202264020068BFB`
|
||||||
|
|
||||||
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
|
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
|
||||||
|
|
||||||
@@ -307,6 +363,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.
|
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
|
## Vim integration
|
||||||
|
|
||||||
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
||||||
|
|||||||
@@ -328,7 +328,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
|
|||||||
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
|
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
|
||||||
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
|
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
|
||||||
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
|
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
|
||||||
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a>
|
<a href="https://play.haskell.org/" class="btn btn-primary" role="button">Online playground</a>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
## How to learn Haskell proper
|
## How to learn Haskell proper
|
||||||
|
|||||||
177
ghcup.cabal
177
ghcup.cabal
@@ -1,6 +1,6 @@
|
|||||||
cabal-version: 2.4
|
cabal-version: 2.4
|
||||||
name: ghcup
|
name: ghcup
|
||||||
version: 0.1.19.2
|
version: 0.1.19.5
|
||||||
license: LGPL-3.0-only
|
license: LGPL-3.0-only
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
copyright: Julian Ospald 2020
|
copyright: Julian Ospald 2020
|
||||||
@@ -53,6 +53,43 @@ flag no-exe
|
|||||||
default: False
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
|
|
||||||
|
common app-common-depends
|
||||||
|
build-depends:
|
||||||
|
, aeson >=1.4
|
||||||
|
, aeson-pretty ^>=0.8.8
|
||||||
|
, async ^>=2.2.3
|
||||||
|
, base >=4.12 && <5
|
||||||
|
, bytestring >=0.10 && <0.12
|
||||||
|
, cabal-install-parsers >=0.4.5
|
||||||
|
, cabal-plan ^>=0.7.2
|
||||||
|
, containers ^>=0.6
|
||||||
|
, deepseq ^>=1.4
|
||||||
|
, directory ^>=1.3.6.0
|
||||||
|
, filepath ^>=1.4.2.1
|
||||||
|
, haskus-utils-types ^>=1.5
|
||||||
|
, haskus-utils-variant ^>=3.2.1
|
||||||
|
, libarchive ^>=3.0.3.0
|
||||||
|
, megaparsec >=8.0.0 && <9.3
|
||||||
|
, mtl ^>=2.2
|
||||||
|
, optparse-applicative >=0.15.1.0 && <0.18
|
||||||
|
, pretty ^>=1.1.3.1
|
||||||
|
, pretty-terminal ^>=0.1.0.0
|
||||||
|
, process ^>=1.6.11.0
|
||||||
|
, resourcet ^>=1.2.2
|
||||||
|
, safe ^>=0.3.18
|
||||||
|
, safe-exceptions ^>=0.1
|
||||||
|
, tagsoup ^>=0.14
|
||||||
|
, template-haskell >=2.7 && <2.20
|
||||||
|
, temporary ^>=1.3
|
||||||
|
, text ^>=2.0
|
||||||
|
, time >=1.9.3 && <1.12
|
||||||
|
, unordered-containers ^>=0.2
|
||||||
|
, uri-bytestring ^>=0.3.2.2
|
||||||
|
, utf8-string ^>=1.0
|
||||||
|
, vector ^>=0.12
|
||||||
|
, versions >=4.0.1 && <5.1
|
||||||
|
, yaml-streamly ^>=0.12.0
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
GHCup
|
GHCup
|
||||||
@@ -137,7 +174,7 @@ library
|
|||||||
, pretty-terminal ^>=0.1.0.0
|
, pretty-terminal ^>=0.1.0.0
|
||||||
, regex-posix ^>=0.96
|
, regex-posix ^>=0.96
|
||||||
, resourcet ^>=1.2.2
|
, resourcet ^>=1.2.2
|
||||||
, retry ^>=0.8.1.2
|
, retry >=0.8.1.2 && <0.10
|
||||||
, safe ^>=0.3.18
|
, safe ^>=0.3.18
|
||||||
, safe-exceptions ^>=0.1
|
, safe-exceptions ^>=0.1
|
||||||
, split ^>=0.2.3.4
|
, split ^>=0.2.3.4
|
||||||
@@ -146,7 +183,7 @@ library
|
|||||||
, template-haskell >=2.7 && <2.20
|
, template-haskell >=2.7 && <2.20
|
||||||
, temporary ^>=1.3
|
, temporary ^>=1.3
|
||||||
, text ^>=2.0
|
, text ^>=2.0
|
||||||
, time ^>=1.9.3
|
, time >=1.9.3 && <1.12
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, unliftio-core ^>=0.2.0.1
|
, unliftio-core ^>=0.2.0.1
|
||||||
, unordered-containers ^>=0.2.10.0
|
, unordered-containers ^>=0.2.10.0
|
||||||
@@ -201,7 +238,67 @@ library
|
|||||||
cpp-options: -DBRICK
|
cpp-options: -DBRICK
|
||||||
build-depends: vty ^>=5.37
|
build-depends: vty ^>=5.37
|
||||||
|
|
||||||
|
library ghcup-optparse
|
||||||
|
import: app-common-depends
|
||||||
|
exposed-modules:
|
||||||
|
GHCup.OptParse
|
||||||
|
GHCup.OptParse.ChangeLog
|
||||||
|
GHCup.OptParse.Common
|
||||||
|
GHCup.OptParse.Compile
|
||||||
|
GHCup.OptParse.Config
|
||||||
|
GHCup.OptParse.DInfo
|
||||||
|
GHCup.OptParse.GC
|
||||||
|
GHCup.OptParse.Install
|
||||||
|
GHCup.OptParse.List
|
||||||
|
GHCup.OptParse.Nuke
|
||||||
|
GHCup.OptParse.Prefetch
|
||||||
|
GHCup.OptParse.Rm
|
||||||
|
GHCup.OptParse.Run
|
||||||
|
GHCup.OptParse.Set
|
||||||
|
GHCup.OptParse.Test
|
||||||
|
GHCup.OptParse.ToolRequirements
|
||||||
|
GHCup.OptParse.UnSet
|
||||||
|
GHCup.OptParse.Upgrade
|
||||||
|
GHCup.OptParse.Whereis
|
||||||
|
|
||||||
|
hs-source-dirs: app/ghcup
|
||||||
|
default-language: Haskell2010
|
||||||
|
default-extensions:
|
||||||
|
LambdaCase
|
||||||
|
MultiWayIf
|
||||||
|
NamedFieldPuns
|
||||||
|
PackageImports
|
||||||
|
RecordWildCards
|
||||||
|
ScopedTypeVariables
|
||||||
|
StrictData
|
||||||
|
TupleSections
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||||
|
-fwarn-incomplete-record-updates
|
||||||
|
|
||||||
|
build-depends: ghcup
|
||||||
|
|
||||||
|
if flag(internal-downloader)
|
||||||
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
|
|
||||||
|
if (flag(tui) && !os(windows))
|
||||||
|
cpp-options: -DBRICK
|
||||||
|
other-modules: BrickMain
|
||||||
|
build-depends:
|
||||||
|
, brick ^>=1.5
|
||||||
|
, transformers ^>=0.5
|
||||||
|
, unix ^>=2.7
|
||||||
|
, vty ^>=5.37
|
||||||
|
|
||||||
|
if os(windows)
|
||||||
|
cpp-options: -DIS_WINDOWS
|
||||||
|
|
||||||
|
else
|
||||||
|
build-depends: unix ^>=2.7
|
||||||
|
|
||||||
executable ghcup
|
executable ghcup
|
||||||
|
import: app-common-depends
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
GHCup.OptParse
|
GHCup.OptParse
|
||||||
@@ -241,41 +338,8 @@ executable ghcup
|
|||||||
-fwarn-incomplete-record-updates -threaded
|
-fwarn-incomplete-record-updates -threaded
|
||||||
|
|
||||||
build-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
|
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-types ^>=1.5
|
, ghcup-optparse
|
||||||
, haskus-utils-variant ^>=3.2.1
|
|
||||||
, libarchive ^>=3.0.3.0
|
|
||||||
, megaparsec >=8.0.0 && <9.3
|
|
||||||
, mtl ^>=2.2
|
|
||||||
, optics ^>=0.4
|
|
||||||
, optparse-applicative >=0.15.1.0 && <0.18
|
|
||||||
, pretty ^>=1.1.3.1
|
|
||||||
, pretty-terminal ^>=0.1.0.0
|
|
||||||
, process ^>=1.6.11.0
|
|
||||||
, resourcet ^>=1.2.2
|
|
||||||
, safe ^>=0.3.18
|
|
||||||
, safe-exceptions ^>=0.1
|
|
||||||
, tagsoup ^>=0.14
|
|
||||||
, template-haskell >=2.7 && <2.20
|
|
||||||
, temporary ^>=1.3
|
|
||||||
, text ^>=2.0
|
|
||||||
, unordered-containers ^>=0.2
|
|
||||||
, uri-bytestring ^>=0.3.2.2
|
|
||||||
, utf8-string ^>=1.0
|
|
||||||
, vector ^>=0.12
|
|
||||||
, versions >=4.0.1 && <5.1
|
|
||||||
, yaml-streamly ^>=0.12.0
|
|
||||||
|
|
||||||
if flag(internal-downloader)
|
if flag(internal-downloader)
|
||||||
cpp-options: -DINTERNAL_DOWNLOADER
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
@@ -302,7 +366,7 @@ test-suite ghcup-test
|
|||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
build-tool-depends: hspec-discover:hspec-discover -any
|
build-tool-depends: hspec-discover:hspec-discover -any
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test/ghcup-test
|
||||||
other-modules:
|
other-modules:
|
||||||
GHCup.ArbitraryTypes
|
GHCup.ArbitraryTypes
|
||||||
GHCup.Prelude.File.Posix.TraversalsSpec
|
GHCup.Prelude.File.Posix.TraversalsSpec
|
||||||
@@ -337,6 +401,7 @@ test-suite ghcup-test
|
|||||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||||
, streamly ^>=0.8.2
|
, streamly ^>=0.8.2
|
||||||
, text ^>=2.0
|
, text ^>=2.0
|
||||||
|
, time >=1.9.3 && <1.12
|
||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=4.0.1 && <5.1
|
||||||
|
|
||||||
@@ -345,3 +410,39 @@ test-suite ghcup-test
|
|||||||
|
|
||||||
else
|
else
|
||||||
build-depends: unix ^>=2.7
|
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
|
||||||
|
, text
|
||||||
|
, uri-bytestring
|
||||||
|
, versions
|
||||||
|
|||||||
4
hie.yaml
4
hie.yaml
@@ -5,4 +5,6 @@ cradle:
|
|||||||
- component: "ghcup:exe:ghcup"
|
- component: "ghcup:exe:ghcup"
|
||||||
path: ./app/ghcup
|
path: ./app/ghcup
|
||||||
- component: "ghcup:test:ghcup-test"
|
- component: "ghcup:test:ghcup-test"
|
||||||
path: ./test
|
path: ./test/ghcup-test
|
||||||
|
- component: "ghcup:test:ghcup-optparse-test"
|
||||||
|
path: ./test/optparse-test
|
||||||
27
lib/GHCup.hs
27
lib/GHCup.hs
@@ -134,15 +134,24 @@ rmTool :: ( MonadReader env m
|
|||||||
=> ListResult
|
=> ListResult
|
||||||
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||||
rmTool ListResult {lVer, lTool, lCross} = do
|
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
|
case lTool of
|
||||||
GHC ->
|
GHC -> do
|
||||||
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
||||||
in rmGHCVer ghcTargetVersion
|
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
|
||||||
HLS -> rmHLSVer lVer
|
rmGHCVer ghcTargetVersion
|
||||||
Cabal -> liftE $ rmCabalVer lVer
|
HLS -> do
|
||||||
Stack -> liftE $ rmStackVer lVer
|
printRmTool
|
||||||
GHCup -> lift rmGhcup
|
rmHLSVer lVer
|
||||||
|
Cabal -> do
|
||||||
|
printRmTool
|
||||||
|
liftE $ rmCabalVer lVer
|
||||||
|
Stack -> do
|
||||||
|
printRmTool
|
||||||
|
liftE $ rmStackVer lVer
|
||||||
|
GHCup -> do
|
||||||
|
printRmTool
|
||||||
|
lift rmGhcup
|
||||||
|
|
||||||
|
|
||||||
rmGhcupDirs :: ( MonadReader env m
|
rmGhcupDirs :: ( MonadReader env m
|
||||||
@@ -303,7 +312,7 @@ upgradeGHCup mtarget force' fatal = do
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
lift $ logInfo "Upgrading GHCup..."
|
lift $ logInfo "Upgrading GHCup..."
|
||||||
let latestVer = fst (fromJust (getLatest dls GHCup))
|
let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
|
||||||
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
|
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
|
||||||
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
|
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
|
||||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||||
@@ -492,7 +501,7 @@ rmOldGHC :: ( MonadReader env m
|
|||||||
=> Excepts '[NotInstalled, UninstallFailed] m ()
|
=> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||||
rmOldGHC = do
|
rmOldGHC = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls
|
let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls
|
||||||
ghcs <- lift $ fmap rights getInstalledGHCs
|
ghcs <- lift $ fmap rights getInstalledGHCs
|
||||||
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
||||||
|
|
||||||
|
|||||||
@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
|
|||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Ord
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( patch )
|
import Data.Versions hiding ( patch )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@@ -177,7 +178,7 @@ installCabalBin :: ( MonadMask m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> VersionRev
|
=> Version
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Bool -- force install
|
-> Bool -- force install
|
||||||
-> Excepts
|
-> Excepts
|
||||||
@@ -198,7 +199,7 @@ installCabalBin :: ( MonadMask m
|
|||||||
()
|
()
|
||||||
installCabalBin ver installDir forceInstall = do
|
installCabalBin ver installDir forceInstall = do
|
||||||
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
dlinfo <- liftE $ getDownloadInfo Cabal ver
|
||||||
installCabalBindist dlinfo (vVersion ver) installDir forceInstall
|
installCabalBindist dlinfo ver installDir forceInstall
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
@@ -280,6 +281,6 @@ rmCabalVer ver = do
|
|||||||
|
|
||||||
when (Just ver == cSet) $ do
|
when (Just ver == cSet) $ do
|
||||||
cVers <- lift $ fmap rights getInstalledCabals
|
cVers <- lift $ fmap rights getInstalledCabals
|
||||||
case headMay . reverse . sort $ cVers of
|
case headMay . sortBy (comparing Down) $ cVers of
|
||||||
Just latestver -> setCabal latestver
|
Just latestver -> setCabal latestver
|
||||||
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)
|
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)
|
||||||
|
|||||||
@@ -271,25 +271,37 @@ getBase uri = do
|
|||||||
|
|
||||||
pure f
|
pure f
|
||||||
|
|
||||||
|
|
||||||
getDownloadInfo :: ( MonadReader env m
|
getDownloadInfo :: ( MonadReader env m
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
)
|
)
|
||||||
=> Tool
|
=> Tool
|
||||||
-> VersionRev
|
-> Version
|
||||||
-- ^ tool version
|
-- ^ tool version
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[NoDownload]
|
'[NoDownload]
|
||||||
m
|
m
|
||||||
DownloadInfo
|
DownloadInfo
|
||||||
getDownloadInfo t (VersionRev v vr) = do
|
getDownloadInfo t v = getDownloadInfo' t (mkTVer v)
|
||||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
|
||||||
|
getDownloadInfo' :: ( MonadReader env m
|
||||||
|
, HasPlatformReq env
|
||||||
|
, HasGHCupInfo env
|
||||||
|
)
|
||||||
|
=> Tool
|
||||||
|
-> GHCTargetVersion
|
||||||
|
-- ^ tool version
|
||||||
|
-> Excepts
|
||||||
|
'[NoDownload]
|
||||||
|
m
|
||||||
|
DownloadInfo
|
||||||
|
getDownloadInfo' t v = do
|
||||||
|
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
let distro_preview f g =
|
let distro_preview f g =
|
||||||
let platformVersionSpec =
|
let platformVersionSpec =
|
||||||
preview (ix t % ix v % viDownload % ix vr % viArch % ix a % ix (f p)) dls
|
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
|
||||||
mv' = g mv
|
mv' = g mv
|
||||||
in fmap snd
|
in fmap snd
|
||||||
. find
|
. find
|
||||||
@@ -305,7 +317,7 @@ getDownloadInfo t (VersionRev v vr) = do
|
|||||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||||
|
|
||||||
maybe
|
maybe
|
||||||
(throwE NoDownload)
|
(throwE $ NoDownload v t (Just pfreq))
|
||||||
pure
|
pure
|
||||||
(case p of
|
(case p of
|
||||||
-- non-musl won't work on alpine
|
-- non-musl won't work on alpine
|
||||||
@@ -633,7 +645,9 @@ downloadCached dli mfn = do
|
|||||||
True -> downloadCached' dli mfn Nothing
|
True -> downloadCached' dli mfn Nothing
|
||||||
False -> do
|
False -> do
|
||||||
tmp <- lift withGHCupTmpDir
|
tmp <- lift withGHCupTmpDir
|
||||||
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
|
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
|
||||||
|
where
|
||||||
|
outputFileName = mfn <|> _dlOutput dli
|
||||||
|
|
||||||
|
|
||||||
downloadCached' :: ( MonadReader env m
|
downloadCached' :: ( MonadReader env m
|
||||||
@@ -652,7 +666,7 @@ downloadCached' :: ( MonadReader env m
|
|||||||
downloadCached' dli mfn mDestDir = do
|
downloadCached' dli mfn mDestDir = do
|
||||||
Dirs { cacheDir } <- lift getDirs
|
Dirs { cacheDir } <- lift getDirs
|
||||||
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
|
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
|
||||||
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
|
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
|
||||||
let cachfile = destDir </> fn
|
let cachfile = destDir </> fn
|
||||||
fileExists <- liftIO $ doesFileExist cachfile
|
fileExists <- liftIO $ doesFileExist cachfile
|
||||||
if
|
if
|
||||||
@@ -660,7 +674,9 @@ downloadCached' dli mfn mDestDir = do
|
|||||||
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
|
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
|
||||||
liftE $ checkDigest (view dlHash dli) cachfile
|
liftE $ checkDigest (view dlHash dli) cachfile
|
||||||
pure cachfile
|
pure cachfile
|
||||||
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
|
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
|
||||||
|
where
|
||||||
|
outputFileName = mfn <|> _dlOutput dli
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -38,6 +38,7 @@ import qualified Data.Text as T
|
|||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Data.Text.Encoding.Error as E
|
import qualified Data.Text.Encoding.Error as E
|
||||||
import Data.Data (Proxy(..))
|
import Data.Data (Proxy(..))
|
||||||
|
import Data.Time (Day)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -59,6 +60,7 @@ allHFError = unlines allErrors
|
|||||||
, let proxy = Proxy :: Proxy CopyError in format proxy
|
, let proxy = Proxy :: Proxy CopyError in format proxy
|
||||||
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
|
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
|
||||||
, let proxy = Proxy :: Proxy TagNotFound in format proxy
|
, let proxy = Proxy :: Proxy TagNotFound in format proxy
|
||||||
|
, let proxy = Proxy :: Proxy DayNotFound in format proxy
|
||||||
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
|
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
|
||||||
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
|
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
|
||||||
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
|
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
|
||||||
@@ -204,12 +206,26 @@ instance HFErrorProject NoCompatiblePlatform where
|
|||||||
eDesc _ = "No compatible platform could be found"
|
eDesc _ = "No compatible platform could be found"
|
||||||
|
|
||||||
-- | Unable to find a download for the requested version/distro.
|
-- | Unable to find a download for the requested version/distro.
|
||||||
data NoDownload = NoDownload
|
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
|
||||||
|
| NoDownload' GlobalTool
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty NoDownload where
|
instance Pretty NoDownload where
|
||||||
pPrint NoDownload =
|
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
|
||||||
text (eDesc (Proxy :: Proxy NoDownload))
|
| (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
|
instance HFErrorProject NoDownload where
|
||||||
eBase _ = 10
|
eBase _ = 10
|
||||||
@@ -311,6 +327,21 @@ instance HFErrorProject TagNotFound where
|
|||||||
eBase _ = 90
|
eBase _ = 90
|
||||||
eDesc _ = "Unable to find a tag of a tool"
|
eDesc _ = "Unable to find a tag of a tool"
|
||||||
|
|
||||||
|
-- | Unable to find a release day of a tool
|
||||||
|
data DayNotFound = DayNotFound Day Tool (Maybe Day)
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance Pretty DayNotFound where
|
||||||
|
pPrint (DayNotFound day tool Nothing) =
|
||||||
|
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
|
||||||
|
pPrint (DayNotFound day tool (Just alternateDay)) =
|
||||||
|
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
|
||||||
|
text "but found an alternative date" <+> text (show alternateDay)
|
||||||
|
|
||||||
|
instance HFErrorProject DayNotFound where
|
||||||
|
eBase _ = 95
|
||||||
|
eDesc _ = "Unable to find a release date of a tool"
|
||||||
|
|
||||||
-- | Unable to find the next version of a tool (the one after the currently
|
-- | Unable to find the next version of a tool (the one after the currently
|
||||||
-- set one).
|
-- set one).
|
||||||
data NextVerNotFound = NextVerNotFound Tool
|
data NextVerNotFound = NextVerNotFound Tool
|
||||||
|
|||||||
318
lib/GHCup/GHC.hs
318
lib/GHCup/GHC.hs
@@ -78,12 +78,12 @@ import qualified Data.Text as T
|
|||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import qualified Data.Map.Strict as M
|
|
||||||
|
|
||||||
|
|
||||||
data GHCVer v = SourceDist v
|
data GHCVer = SourceDist Version
|
||||||
| GitDist GitBranch
|
| GitDist GitBranch
|
||||||
| RemoteDist URI
|
| RemoteDist URI
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -106,7 +106,7 @@ testGHCVer :: ( MonadFail m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> VersionRev
|
=> GHCTargetVersion
|
||||||
-> [T.Text]
|
-> [T.Text]
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ DigestError
|
'[ DigestError
|
||||||
@@ -121,12 +121,12 @@ testGHCVer :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
testGHCVer (VersionRev ver vr) addMakeArgs = do
|
testGHCVer ver addMakeArgs = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix ver % viDownload % to M.toAscList % maybe _last ix vr % to snd % viTestDL % _Just) dls
|
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload ver GHC Nothing
|
||||||
|
|
||||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||||
|
|
||||||
@@ -146,7 +146,7 @@ testGHCBindist :: ( MonadFail m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> GHCTargetVersion
|
||||||
-> [T.Text]
|
-> [T.Text]
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ DigestError
|
'[ DigestError
|
||||||
@@ -183,7 +183,7 @@ testPackedGHC :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> FilePath -- ^ Path to the packed GHC bindist
|
=> FilePath -- ^ Path to the packed GHC bindist
|
||||||
-> Maybe TarDir -- ^ Subdir of the archive
|
-> Maybe TarDir -- ^ Subdir of the archive
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> [T.Text] -- ^ additional make args
|
-> [T.Text] -- ^ additional make args
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
|
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
|
||||||
@@ -209,19 +209,21 @@ testUnpackedGHC :: ( MonadReader env m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
|
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
-> Excepts '[ProcessError] m ()
|
-> Excepts '[ProcessError] m ()
|
||||||
testUnpackedGHC path ver addMakeArgs = do
|
testUnpackedGHC path tver addMakeArgs = do
|
||||||
lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!"
|
lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
|
||||||
ghcDir <- lift $ ghcupGHCDir (mkTVer ver)
|
ghcDir <- lift $ ghcupGHCDir tver
|
||||||
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
|
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
|
||||||
env <- liftIO $ addToPath ghcBinDir False
|
env <- liftIO $ addToPath ghcBinDir False
|
||||||
|
|
||||||
lEM $ make' (fmap T.unpack addMakeArgs)
|
lEM $ make' (fmap T.unpack addMakeArgs)
|
||||||
(Just $ fromGHCupPath path)
|
(Just $ fromGHCupPath path)
|
||||||
"ghc-test"
|
"ghc-test"
|
||||||
(Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env)
|
(Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver)
|
||||||
|
<> "ghc-"
|
||||||
|
<> T.unpack (prettyVer $ _tvVersion tver)) : env)
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
@@ -244,7 +246,7 @@ fetchGHCSrc :: ( MonadFail m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> VersionRev
|
=> GHCTargetVersion
|
||||||
-> Maybe FilePath
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ DigestError
|
'[ DigestError
|
||||||
@@ -255,11 +257,11 @@ fetchGHCSrc :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
FilePath
|
FilePath
|
||||||
fetchGHCSrc (VersionRev v vr) mfp = do
|
fetchGHCSrc v mfp = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix v % viDownload % to M.toAscList % maybe _last ix vr % to snd % viSourceDL % _Just) dls
|
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload v GHC Nothing
|
||||||
liftE $ downloadCached' dlInfo Nothing mfp
|
liftE $ downloadCached' dlInfo Nothing mfp
|
||||||
|
|
||||||
|
|
||||||
@@ -284,7 +286,7 @@ installGHCBindist :: ( MonadFail m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> DownloadInfo -- ^ where/how to download
|
=> DownloadInfo -- ^ where/how to download
|
||||||
-> Version -- ^ the version to install
|
-> GHCTargetVersion -- ^ the version to install
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Bool -- ^ Force install
|
-> Bool -- ^ Force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
@@ -307,10 +309,8 @@ installGHCBindist :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
|
||||||
let tver = mkTVer ver
|
lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
|
||||||
|
|
||||||
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
|
|
||||||
|
|
||||||
regularGHCInstalled <- lift $ ghcInstalled tver
|
regularGHCInstalled <- lift $ ghcInstalled tver
|
||||||
|
|
||||||
@@ -318,7 +318,7 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
|||||||
| not forceInstall
|
| not forceInstall
|
||||||
, regularGHCInstalled
|
, regularGHCInstalled
|
||||||
, GHCupInternal <- installDir -> do
|
, GHCupInternal <- installDir -> do
|
||||||
throwE $ AlreadyInstalled GHC ver
|
throwE $ AlreadyInstalled GHC (_tvVersion tver)
|
||||||
|
|
||||||
| forceInstall
|
| forceInstall
|
||||||
, regularGHCInstalled
|
, regularGHCInstalled
|
||||||
@@ -337,12 +337,12 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
|||||||
case installDir of
|
case installDir of
|
||||||
IsolateDir isoDir -> do -- isolated install
|
IsolateDir isoDir -> do -- isolated install
|
||||||
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
|
||||||
GHCupInternal -> do -- regular install
|
GHCupInternal -> do -- regular install
|
||||||
-- prepare paths
|
-- prepare paths
|
||||||
ghcdir <- lift $ ghcupGHCDir tver
|
ghcdir <- lift $ ghcupGHCDir tver
|
||||||
|
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
|
||||||
|
|
||||||
-- make symlinks & stuff when regular install,
|
-- make symlinks & stuff when regular install,
|
||||||
liftE $ postGHCInstall tver
|
liftE $ postGHCInstall tver
|
||||||
@@ -376,7 +376,7 @@ installPackedGHC :: ( MonadMask m
|
|||||||
=> FilePath -- ^ Path to the packed GHC bindist
|
=> FilePath -- ^ Path to the packed GHC bindist
|
||||||
-> Maybe TarDir -- ^ Subdir of the archive
|
-> Maybe TarDir -- ^ Subdir of the archive
|
||||||
-> InstallDirResolved
|
-> InstallDirResolved
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> Bool -- ^ Force install
|
-> Bool -- ^ Force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
-> Excepts
|
-> Excepts
|
||||||
@@ -424,26 +424,22 @@ installUnpackedGHC :: ( MonadReader env m
|
|||||||
)
|
)
|
||||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
||||||
-> InstallDirResolved -- ^ Path to install to
|
-> InstallDirResolved -- ^ Path to install to
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> Bool -- ^ Force install
|
-> Bool -- ^ Force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
-> Excepts '[ProcessError, MergeFileTreeError] m ()
|
-> Excepts '[ProcessError, MergeFileTreeError] m ()
|
||||||
installUnpackedGHC path inst ver forceInstall addConfArgs
|
installUnpackedGHC path inst tver forceInstall addConfArgs
|
||||||
| isWindows = do
|
| isWindows = do
|
||||||
lift $ logInfo "Installing GHC (this may take a while)"
|
lift $ logInfo "Installing GHC (this may take a while)"
|
||||||
-- Windows bindists are relocatable and don't need
|
-- Windows bindists are relocatable and don't need
|
||||||
-- to run configure.
|
-- to run configure.
|
||||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||||
liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> do
|
liftE $ mergeGHCFileTree path inst tver forceInstall
|
||||||
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
|
| otherwise = do
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
|
|
||||||
let ldOverride
|
let ldOverride
|
||||||
| ver >= [vver|8.2.2|]
|
| _tvVersion tver >= [vver|8.2.2|]
|
||||||
, _rPlatform `elem` [Linux Alpine, Darwin]
|
, _rPlatform `elem` [Linux Alpine, Darwin]
|
||||||
= ["--disable-ld-override"]
|
= ["--disable-ld-override"]
|
||||||
| otherwise
|
| otherwise
|
||||||
@@ -452,7 +448,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
|||||||
lift $ logInfo "Installing GHC (this may take a while)"
|
lift $ logInfo "Installing GHC (this may take a while)"
|
||||||
lEM $ execLogged "sh"
|
lEM $ execLogged "sh"
|
||||||
("./configure" : ("--prefix=" <> fromInstallDir inst)
|
("./configure" : ("--prefix=" <> fromInstallDir inst)
|
||||||
: (ldOverride <> (T.unpack <$> addConfArgs))
|
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
|
||||||
)
|
)
|
||||||
(Just $ fromGHCupPath path)
|
(Just $ fromGHCupPath path)
|
||||||
"ghc-configure"
|
"ghc-configure"
|
||||||
@@ -460,17 +456,44 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
|||||||
tmpInstallDest <- lift withGHCupTmpDir
|
tmpInstallDest <- lift withGHCupTmpDir
|
||||||
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
|
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
|
inst
|
||||||
GHC
|
GHC
|
||||||
(mkTVer ver)
|
tver
|
||||||
(\f t -> liftIO $ do
|
(\f t -> liftIO $ do
|
||||||
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
|
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
|
||||||
install f t (not forceInstall)
|
install f t (not forceInstall)
|
||||||
forM_ mtime $ setModificationTime t)
|
forM_ mtime $ setModificationTime t)
|
||||||
|
|
||||||
pure ()
|
|
||||||
|
|
||||||
|
|
||||||
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
||||||
-- following symlinks in @~\/.ghcup\/bin@:
|
-- following symlinks in @~\/.ghcup\/bin@:
|
||||||
@@ -490,7 +513,7 @@ installGHCBin :: ( MonadFail m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version -- ^ the version to install
|
=> GHCTargetVersion -- ^ the version to install
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Bool -- ^ force install
|
-> Bool -- ^ force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
@@ -513,9 +536,9 @@ installGHCBin :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBin ver installDir forceInstall addConfArgs = do
|
installGHCBin tver installDir forceInstall addConfArgs = do
|
||||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
dlinfo <- liftE $ getDownloadInfo' GHC tver
|
||||||
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
|
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -709,7 +732,7 @@ rmGHCVer ver = do
|
|||||||
Just files -> do
|
Just files -> do
|
||||||
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
||||||
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
||||||
removeEmptyDirsRecursive dir
|
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
|
||||||
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
||||||
f <- recordedInstallationFile GHC ver
|
f <- recordedInstallationFile GHC ver
|
||||||
lift $ recycleFile f
|
lift $ recycleFile f
|
||||||
@@ -756,7 +779,8 @@ compileGHC :: ( MonadMask m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> GHCVer GHCTargetVersion
|
=> GHCVer
|
||||||
|
-> Maybe Text -- ^ cross target
|
||||||
-> Maybe Version -- ^ overwrite version
|
-> Maybe Version -- ^ overwrite version
|
||||||
-> Either Version FilePath -- ^ version to bootstrap with
|
-> Either Version FilePath -- ^ version to bootstrap with
|
||||||
-> Maybe Int -- ^ jobs
|
-> Maybe Int -- ^ jobs
|
||||||
@@ -764,7 +788,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Maybe BuildSystem
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
@@ -793,20 +817,21 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
|
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
SourceDist tver -> do
|
SourceDist ver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
|
let tver = mkTVer ver
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % viSourceDL % _Just) dls
|
preview (ix GHC % ix tver % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload tver GHC (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@@ -819,7 +844,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, Just tver)
|
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
|
||||||
|
|
||||||
RemoteDist uri -> do
|
RemoteDist uri -> do
|
||||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||||
@@ -843,7 +868,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, mkTVer <$> tver)
|
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||||
|
|
||||||
-- clone from git
|
-- clone from git
|
||||||
GitDist GitBranch{..} -> do
|
GitDist GitBranch{..} -> do
|
||||||
@@ -900,12 +925,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
pure tver
|
pure tver
|
||||||
|
|
||||||
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
|
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||||
-- the version that's installed may differ from the
|
-- the version that's installed may differ from the
|
||||||
-- compiled version, so the user can overwrite it
|
-- compiled version, so the user can overwrite it
|
||||||
installVer <- if | Just ov' <- ov -> pure (mkTVer ov')
|
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
||||||
| Just tver' <- tver -> pure tver'
|
| 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
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||||
@@ -924,16 +949,31 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
||||||
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
||||||
|
|
||||||
(mBindist, bmk) <- liftE $ runBuildAction
|
mBindist <- liftE $ runBuildAction
|
||||||
tmpUnpack
|
tmpUnpack
|
||||||
(do
|
(do
|
||||||
b <- if hadrian
|
-- prefer 'tver', because the real version carries out compatibility checks
|
||||||
-- prefer 'tver', because the real version carries out compatibility checks
|
-- we don't want the user to do funny things with it
|
||||||
-- we don't want the user to do funny things with it
|
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
case buildSystem of
|
||||||
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
Just Hadrian -> do
|
||||||
pure (b, bmk)
|
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
|
case installDir of
|
||||||
@@ -949,12 +989,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
liftE $ installPackedGHC bindist
|
liftE $ installPackedGHC bindist
|
||||||
(Just $ RegexDir "ghc-.*")
|
(Just $ RegexDir "ghc-.*")
|
||||||
ghcdir
|
ghcdir
|
||||||
(installVer ^. tvVersion)
|
installVer
|
||||||
False -- not a force install, since we already overwrite when compiling.
|
False -- not a force install, since we already overwrite when compiling.
|
||||||
[]
|
[]
|
||||||
|
|
||||||
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
|
|
||||||
|
|
||||||
case installDir of
|
case installDir of
|
||||||
-- set and make symlinks for regular (non-isolated) installs
|
-- set and make symlinks for regular (non-isolated) installs
|
||||||
GHCupInternal -> do
|
GHCupInternal -> do
|
||||||
@@ -977,20 +1015,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
=> GHCupPath
|
=> GHCupPath
|
||||||
-> Excepts '[ProcessError, ParseError] m Version
|
-> Excepts '[ProcessError, ParseError] m Version
|
||||||
getGHCVer tmpUnpack = do
|
getGHCVer tmpUnpack = do
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
|
||||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
CapturedProcess {..} <- lift $ makeOut
|
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
|
||||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
hasVersionFile <- liftIO $ doesFileExist versionFile
|
||||||
case _exitCode of
|
if hasVersionFile
|
||||||
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
then do
|
||||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
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 =
|
defaultConf =
|
||||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
||||||
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
||||||
in case targetGhc of
|
in case crossTarget of
|
||||||
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
|
Just _ -> cross_mk
|
||||||
_ -> default_mk
|
_ -> default_mk
|
||||||
|
|
||||||
compileHadrianBindist :: ( MonadReader env m
|
compileHadrianBindist :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
@@ -1016,18 +1063,17 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
m
|
m
|
||||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||||
compileHadrianBindist tver workdir ghcdir = do
|
compileHadrianBindist tver workdir ghcdir = do
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just workdir) "ghc-bootstrap"
|
|
||||||
|
|
||||||
liftE $ configureBindist tver workdir ghcdir
|
liftE $ configureBindist tver workdir ghcdir
|
||||||
|
|
||||||
lift $ logInfo "Building (this may take a while)..."
|
lift $ logInfo "Building (this may take a while)..."
|
||||||
hadrian_build <- liftE $ findHadrianFile workdir
|
hadrian_build <- liftE $ findHadrianFile workdir
|
||||||
lEM $ execWithGhcEnv hadrian_build
|
lEM $ execLogged hadrian_build
|
||||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||||
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
||||||
++ ["binary-dist"]
|
++ ["binary-dist"]
|
||||||
)
|
)
|
||||||
(Just workdir) "ghc-make"
|
(Just workdir) "ghc-make"
|
||||||
|
Nothing
|
||||||
[tar] <- liftIO $ findFiles
|
[tar] <- liftIO $ findFiles
|
||||||
(workdir </> "_build" </> "bindist")
|
(workdir </> "_build" </> "bindist")
|
||||||
(makeRegexOpts compExtended
|
(makeRegexOpts compExtended
|
||||||
@@ -1060,6 +1106,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
|
, MonadMask m
|
||||||
|
, MonadUnliftIO m
|
||||||
|
, MonadResource m
|
||||||
)
|
)
|
||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> FilePath
|
-> FilePath
|
||||||
@@ -1071,6 +1120,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
, PatchFailed
|
, PatchFailed
|
||||||
, ProcessError
|
, ProcessError
|
||||||
, NotFoundInPATH
|
, NotFoundInPATH
|
||||||
|
, MergeFileTreeError
|
||||||
, CopyError]
|
, CopyError]
|
||||||
m
|
m
|
||||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||||
@@ -1092,7 +1142,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
if | isCross tver -> do
|
if | isCross tver -> do
|
||||||
lift $ logInfo "Installing cross toolchain..."
|
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
|
pure Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
lift $ logInfo "Creating bindist..."
|
lift $ logInfo "Creating bindist..."
|
||||||
@@ -1165,8 +1217,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
|
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
|
||||||
|
|
||||||
-- for cross, we need Stage1Only
|
-- for cross, we need Stage1Only
|
||||||
case targetGhc of
|
case crossTarget of
|
||||||
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||||
(InvalidBuildConfig
|
(InvalidBuildConfig
|
||||||
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
||||||
)
|
)
|
||||||
@@ -1210,64 +1262,50 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
()
|
()
|
||||||
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
||||||
lift $ logInfo [s|configuring build|]
|
lift $ logInfo [s|configuring build|]
|
||||||
|
lEM $ configureWithGhcBoot (Just tver)
|
||||||
if | _tvVersion tver >= [vver|8.8.0|] -> do
|
(maybe mempty
|
||||||
lEM $ execWithGhcEnv
|
(\x -> ["--target=" <> T.unpack x])
|
||||||
"sh"
|
(_tvTarget tver)
|
||||||
("./configure" : maybe mempty
|
++ ["--prefix=" <> ghcdir]
|
||||||
(\x -> ["--target=" <> T.unpack x])
|
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||||
(_tvTarget tver)
|
++ fmap T.unpack aargs
|
||||||
++ ["--prefix=" <> ghcdir]
|
)
|
||||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
(Just workdir)
|
||||||
++ fmap T.unpack aargs
|
"ghc-conf"
|
||||||
)
|
|
||||||
(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
|
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
execWithGhcEnv :: ( MonadReader env m
|
configureWithGhcBoot :: ( MonadReader env m
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m)
|
, MonadThrow m)
|
||||||
=> FilePath -- ^ thing to execute
|
=> Maybe GHCTargetVersion
|
||||||
-> [String] -- ^ args for the thing
|
-> [String] -- ^ args for configure
|
||||||
-> Maybe FilePath -- ^ optionally chdir into this
|
-> Maybe FilePath -- ^ optionally chdir into this
|
||||||
-> FilePath -- ^ log filename (opened in append mode)
|
-> FilePath -- ^ log filename (opened in append mode)
|
||||||
-> m (Either ProcessError ())
|
-> m (Either ProcessError ())
|
||||||
execWithGhcEnv fp args dir logf = do
|
configureWithGhcBoot mtver args dir logf = do
|
||||||
env <- ghcEnv
|
let execNew = execLogged
|
||||||
execLogged fp args dir logf (Just env)
|
"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
|
bghc = case bstrap of
|
||||||
Right g -> Right g
|
Right g -> g
|
||||||
Left bver -> Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
Left bver -> "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)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -43,6 +43,7 @@ import Control.Monad.Trans.Resource
|
|||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Ord
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String ( fromString )
|
import Data.String ( fromString )
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
@@ -74,6 +75,7 @@ data HLSVer = SourceDist Version
|
|||||||
| GitDist GitBranch
|
| GitDist GitBranch
|
||||||
| HackageDist Version
|
| HackageDist Version
|
||||||
| RemoteDist URI
|
| RemoteDist URI
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -353,7 +355,7 @@ compileHLS :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] m Version
|
||||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
Dirs { .. } <- lift getDirs
|
Dirs { .. } <- lift getDirs
|
||||||
|
|
||||||
@@ -368,8 +370,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix HLS % ix tver % viDownload % _last % viSourceDL % _Just) dls
|
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload (mkTVer tver) HLS (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@@ -704,7 +706,7 @@ rmHLSVer ver = do
|
|||||||
when (Just ver == isHlsSet) $ do
|
when (Just ver == isHlsSet) $ do
|
||||||
-- set latest hls
|
-- set latest hls
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
case headMay . reverse . sort $ hlsVers of
|
case headMay . sortBy (comparing Down) $ hlsVers of
|
||||||
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
|
|
||||||
|
|||||||
@@ -36,6 +36,7 @@ import Data.Either
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
import Data.Versions hiding ( patch )
|
import Data.Versions hiding ( patch )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics
|
||||||
@@ -61,10 +62,10 @@ import qualified Data.Text as T
|
|||||||
|
|
||||||
|
|
||||||
-- | Filter data type for 'listVersions'.
|
-- | Filter data type for 'listVersions'.
|
||||||
data ListCriteria = ListInstalled
|
data ListCriteria = ListInstalled Bool
|
||||||
| ListSet
|
| ListSet Bool
|
||||||
| ListAvailable
|
| ListAvailable Bool
|
||||||
deriving Show
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | A list result describes a single tool version
|
-- | A list result describes a single tool version
|
||||||
-- and various of its properties.
|
-- and various of its properties.
|
||||||
@@ -75,16 +76,16 @@ data ListResult = ListResult
|
|||||||
, lTag :: [Tag]
|
, lTag :: [Tag]
|
||||||
, lInstalled :: Bool
|
, lInstalled :: Bool
|
||||||
, lSet :: Bool -- ^ currently active version
|
, lSet :: Bool -- ^ currently active version
|
||||||
, fromSrc :: Bool -- ^ compiled from source
|
|
||||||
, lStray :: Bool -- ^ not in download info
|
, lStray :: Bool -- ^ not in download info
|
||||||
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
||||||
, hlsPowered :: Bool
|
, hlsPowered :: Bool
|
||||||
|
, lReleaseDay :: Maybe Day
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
|
||||||
-- | Extract all available tool versions and their tags.
|
-- | Extract all available tool versions and their tags.
|
||||||
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
|
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo
|
||||||
availableToolVersions av tool = view
|
availableToolVersions av tool = view
|
||||||
(at tool % non Map.empty)
|
(at tool % non Map.empty)
|
||||||
av
|
av
|
||||||
@@ -93,19 +94,22 @@ availableToolVersions av tool = view
|
|||||||
-- | List all versions from the download info, as well as stray
|
-- | List all versions from the download info, as well as stray
|
||||||
-- versions.
|
-- versions.
|
||||||
listVersions :: ( MonadCatch m
|
listVersions :: ( MonadCatch m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
)
|
)
|
||||||
=> Maybe Tool
|
=> Maybe Tool
|
||||||
-> Maybe ListCriteria
|
-> [ListCriteria]
|
||||||
-> m [ListResult]
|
-> Bool
|
||||||
listVersions lt' criteria = do
|
-> Bool
|
||||||
|
-> (Maybe Day, Maybe Day)
|
||||||
|
-> m [ListResult]
|
||||||
|
listVersions lt' criteria hideOld showNightly days = do
|
||||||
-- some annoying work to avoid too much repeated IO
|
-- some annoying work to avoid too much repeated IO
|
||||||
cSet <- cabalSet
|
cSet <- cabalSet
|
||||||
cabals <- getInstalledCabals
|
cabals <- getInstalledCabals
|
||||||
@@ -129,13 +133,13 @@ listVersions lt' criteria = do
|
|||||||
slr <- strayGHCs avTools
|
slr <- strayGHCs avTools
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
slr <- strayCabals avTools cSet cabals
|
slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
HLS -> do
|
HLS -> do
|
||||||
slr <- strayHLS avTools hlsSet' hlses
|
slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
Stack -> do
|
Stack -> do
|
||||||
slr <- strayStacks avTools sSet stacks
|
slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let cg = maybeToList $ currentGHCup avTools
|
let cg = maybeToList $ currentGHCup avTools
|
||||||
@@ -154,42 +158,28 @@ listVersions lt' criteria = do
|
|||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> Map.Map Version VersionInfo
|
=> Map.Map GHCTargetVersion VersionInfo
|
||||||
-> m [ListResult]
|
-> m [ListResult]
|
||||||
strayGHCs avTools = do
|
strayGHCs avTools = do
|
||||||
ghcs <- getInstalledGHCs
|
ghcs <- getInstalledGHCs
|
||||||
fmap catMaybes $ forM ghcs $ \case
|
fmap catMaybes $ forM ghcs $ \case
|
||||||
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
|
Right tver@GHCTargetVersion{ .. } -> do
|
||||||
case Map.lookup _tvVersion avTools of
|
case Map.lookup tver avTools of
|
||||||
Just _ -> pure Nothing
|
Just _ -> pure Nothing
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
|
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
||||||
fromSrc <- ghcSrcInstalled tver
|
|
||||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
||||||
pure $ Just $ ListResult
|
pure $ Just $ ListResult
|
||||||
{ lTool = GHC
|
{ lTool = GHC
|
||||||
, lVer = _tvVersion
|
, lVer = _tvVersion
|
||||||
, lCross = Nothing
|
, lCross = _tvTarget
|
||||||
, lTag = []
|
, lTag = []
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup _tvVersion avTools)
|
, lStray = isNothing (Map.lookup tver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Right tver@GHCTargetVersion{ .. } -> do
|
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
|
||||||
fromSrc <- ghcSrcInstalled tver
|
|
||||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
|
||||||
pure $ Just $ ListResult
|
|
||||||
{ lTool = GHC
|
|
||||||
, lVer = _tvVersion
|
|
||||||
, lCross = _tvTarget
|
|
||||||
, lTag = []
|
|
||||||
, lInstalled = True
|
|
||||||
, lStray = True -- NOTE: cross currently cannot be installed via bindist
|
|
||||||
, lNoBindist = False
|
|
||||||
, ..
|
|
||||||
}
|
|
||||||
Left e -> do
|
Left e -> do
|
||||||
logWarn
|
logWarn
|
||||||
$ "Could not parse version of stray directory" <> T.pack e
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
@@ -221,8 +211,8 @@ listVersions lt' criteria = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -255,8 +245,8 @@ listVersions lt' criteria = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -290,8 +280,8 @@ listVersions lt' criteria = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -299,24 +289,24 @@ listVersions lt' criteria = do
|
|||||||
$ "Could not parse version of stray directory" <> T.pack e
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult
|
||||||
currentGHCup av =
|
currentGHCup av =
|
||||||
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
|
let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer ""
|
||||||
listVer = Map.lookup currentVer av
|
listVer = Map.lookup currentVer av
|
||||||
latestVer = fst <$> headOf (getTagged Latest) av
|
latestVer = fst <$> headOf (getTagged Latest) av
|
||||||
recommendedVer = fst <$> headOf (getTagged Latest) av
|
recommendedVer = fst <$> headOf (getTagged Latest) av
|
||||||
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
||||||
in if | Map.member currentVer av -> Nothing
|
in if | Map.member currentVer av -> Nothing
|
||||||
| otherwise -> Just $ ListResult { lVer = currentVer
|
| otherwise -> Just $ ListResult { lVer = _tvVersion currentVer
|
||||||
, lTag = maybe (if isOld then [Old] else []) (view viTags) listVer
|
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTool = GHCup
|
, lTool = GHCup
|
||||||
, fromSrc = False
|
|
||||||
, lStray = isNothing listVer
|
, lStray = isNothing listVer
|
||||||
, lSet = True
|
, lSet = True
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
-- NOTE: this are not cross ones, because no bindists
|
-- NOTE: this are not cross ones, because no bindists
|
||||||
@@ -335,43 +325,41 @@ listVersions lt' criteria = do
|
|||||||
-> [Either FilePath Version]
|
-> [Either FilePath Version]
|
||||||
-> Maybe Version
|
-> Maybe Version
|
||||||
-> [Either FilePath Version]
|
-> [Either FilePath Version]
|
||||||
-> (Version, VersionInfo)
|
-> (GHCTargetVersion, VersionInfo)
|
||||||
-> m ListResult
|
-> m ListResult
|
||||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
|
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do
|
||||||
let tags = view viTags vi
|
let v = _tvVersion tver
|
||||||
case t of
|
case t of
|
||||||
GHC -> do
|
GHC -> do
|
||||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
|
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
|
||||||
let tver = mkTVer v
|
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
|
||||||
lInstalled <- ghcInstalled tver
|
lInstalled <- ghcInstalled tver
|
||||||
fromSrc <- ghcSrcInstalled tver
|
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
|
||||||
hlsPowered <- fmap (elem v) hlsGHCVersions
|
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
|
||||||
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
|
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
|
||||||
let lSet = cSet == Just v
|
let lSet = cSet == Just v
|
||||||
let lInstalled = elem v $ rights cabals
|
let lInstalled = elem v $ rights cabals
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let lSet = prettyPVP ghcUpVer == prettyVer v
|
let lSet = prettyPVP ghcUpVer == prettyVer v
|
||||||
let lInstalled = lSet
|
let lInstalled = lSet
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
HLS -> do
|
HLS -> do
|
||||||
@@ -380,11 +368,11 @@ listVersions lt' criteria = do
|
|||||||
let lInstalled = elem v $ rights hlses
|
let lInstalled = elem v $ rights hlses
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Stack -> do
|
Stack -> do
|
||||||
@@ -393,19 +381,42 @@ listVersions lt' criteria = do
|
|||||||
let lInstalled = elem v $ rights stacks
|
let lInstalled = elem v $ rights stacks
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
filter' :: [ListResult] -> [ListResult]
|
filter' :: [ListResult] -> [ListResult]
|
||||||
filter' lr = case criteria of
|
filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
|
||||||
Nothing -> lr
|
|
||||||
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
|
filterDays :: [ListResult] -> [ListResult]
|
||||||
Just ListSet -> filter (\ListResult {..} -> lSet) lr
|
filterDays lrs = case days of
|
||||||
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
|
(Nothing, Nothing) -> lrs
|
||||||
|
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
|
||||||
|
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
|
||||||
|
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
|
||||||
|
|
||||||
|
fromCriteria :: ListCriteria -> ListResult -> Bool
|
||||||
|
fromCriteria lc ListResult{..} = case lc of
|
||||||
|
ListInstalled b -> f b lInstalled
|
||||||
|
ListSet b -> f b lSet
|
||||||
|
ListAvailable b -> f b $ not lNoBindist
|
||||||
|
where
|
||||||
|
f b
|
||||||
|
| b = id
|
||||||
|
| otherwise = not
|
||||||
|
|
||||||
|
filterOld :: [ListResult] -> [ListResult]
|
||||||
|
filterOld lr
|
||||||
|
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
|
||||||
|
| otherwise = lr
|
||||||
|
|
||||||
|
filterNightly :: [ListResult] -> [ListResult]
|
||||||
|
filterNightly lr
|
||||||
|
| showNightly = lr
|
||||||
|
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr
|
||||||
|
|
||||||
|
|||||||
@@ -77,8 +77,14 @@ runBothE' a1 a2 = do
|
|||||||
(_ , VLeft e ) -> throwSomeE e
|
(_ , VLeft e ) -> throwSomeE e
|
||||||
(VRight _, VRight _) -> pure ()
|
(VRight _, VRight _) -> pure ()
|
||||||
|
|
||||||
|
-- "throwSomeE" function has been upstreamed in haskus-utils-variant-3.3
|
||||||
|
-- So, only conditionally include this shim if
|
||||||
|
-- haskus-utils-variant version is < 3.3
|
||||||
|
|
||||||
|
#if MIN_VERSION_haskus_utils_variant(3,3,0)
|
||||||
|
#else
|
||||||
-- | Throw some exception
|
-- | Throw some exception
|
||||||
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
|
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
|
||||||
{-# INLINABLE throwSomeE #-}
|
{-# INLINABLE throwSomeE #-}
|
||||||
throwSomeE = Excepts . pure . VLeft . liftVariant
|
throwSomeE = Excepts . pure . VLeft . liftVariant
|
||||||
|
#endif
|
||||||
|
|||||||
@@ -28,8 +28,6 @@ import System.FilePath
|
|||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import Data.Char (digitToInt)
|
|
||||||
import Data.Data (Proxy(..))
|
|
||||||
|
|
||||||
|
|
||||||
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
|
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
|
||||||
@@ -88,33 +86,7 @@ ghcTargetVerP =
|
|||||||
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
|
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
|
||||||
<|> ((\ _ x -> x) Nothing <$> mempty)
|
<|> ((\ _ x -> x) Nothing <$> mempty)
|
||||||
)
|
)
|
||||||
<*> version'
|
<*> (version' <* MP.eof)
|
||||||
where
|
|
||||||
verP' :: MP.Parsec Void Text Text
|
|
||||||
verP' = do
|
|
||||||
v <- version'
|
|
||||||
let startsWithDigists =
|
|
||||||
and
|
|
||||||
. take 3
|
|
||||||
. concatMap
|
|
||||||
(map
|
|
||||||
(\case
|
|
||||||
(Digits _) -> True
|
|
||||||
(Str _) -> False
|
|
||||||
) . NE.toList)
|
|
||||||
. NE.toList
|
|
||||||
$ _vChunks v
|
|
||||||
if startsWithDigists && isNothing (_vEpoch v)
|
|
||||||
then pure $ prettyVer v
|
|
||||||
else fail "Oh"
|
|
||||||
|
|
||||||
ghcTargetVerRevP :: MP.Parsec Void Text GHCTargetVersionRev
|
|
||||||
ghcTargetVerRevP =
|
|
||||||
(\x y -> GHCTargetVersionRev x y)
|
|
||||||
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
|
|
||||||
<|> ((\ _ x -> x) Nothing <$> mempty)
|
|
||||||
)
|
|
||||||
<*> versionRevP
|
|
||||||
where
|
where
|
||||||
verP' :: MP.Parsec Void Text Text
|
verP' :: MP.Parsec Void Text Text
|
||||||
verP' = do
|
verP' = do
|
||||||
@@ -150,44 +122,3 @@ verP suffix = do
|
|||||||
|
|
||||||
pathSep :: MP.Parsec Void Text Char
|
pathSep :: MP.Parsec Void Text Char
|
||||||
pathSep = MP.oneOf pathSeparators
|
pathSep = MP.oneOf pathSeparators
|
||||||
|
|
||||||
versionRevP :: MP.Parsec Void Text VersionRev
|
|
||||||
versionRevP = MP.label "versionRev" $
|
|
||||||
MP.try (parseUntil (MP.try (MP.chunk "-r")) >>= versionWithRev) <|> ((`VersionRev` 0) <$> version')
|
|
||||||
where
|
|
||||||
versionWithRev ver = do
|
|
||||||
rest <- MP.getInput
|
|
||||||
MP.setInput ver
|
|
||||||
v <- version'
|
|
||||||
MP.setInput rest
|
|
||||||
_ <- MP.chunk "-r"
|
|
||||||
rev <- parseInt
|
|
||||||
pure $ VersionRev v rev
|
|
||||||
|
|
||||||
digit = MP.oneOf ['0'..'9'] MP.<?> "digit"
|
|
||||||
parseInt :: MP.Parsec Void Text Int
|
|
||||||
parseInt = MP.label "parseInt" $ do
|
|
||||||
i <- MP.tokensToChunk (Proxy :: Proxy Text) <$> some digit
|
|
||||||
pure $ numberValue 10 $ T.unpack i
|
|
||||||
|
|
||||||
numberValue :: Int -> String -> Int
|
|
||||||
numberValue base = foldl (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0
|
|
||||||
|
|
||||||
userVersionRevP :: MP.Parsec Void Text UserVersionRev
|
|
||||||
userVersionRevP = MP.label "userVersionRev" $
|
|
||||||
((\(VersionRev v r) -> UserVersionRev v (Just r)) <$> MP.try versionRevP) <|> ((`UserVersionRev` Nothing) <$> version')
|
|
||||||
|
|
||||||
|
|
||||||
-- | Read a @VersionRev@ from a String.
|
|
||||||
--
|
|
||||||
-- - 3.3.2 -> VersionRev { vVersion = 3.3.3, vRev = 0 }
|
|
||||||
-- - 2.3.4-r3 -> VersionRev { vVersion = 2.3.4, vRev = 3 }
|
|
||||||
versionRev :: Text -> Either (MP.ParseErrorBundle Text Void) VersionRev
|
|
||||||
versionRev = MP.parse versionRevP ""
|
|
||||||
|
|
||||||
-- | Read a @UserVersionRev@ from a String.
|
|
||||||
--
|
|
||||||
-- - 3.3.2 -> UserVersionRev { vVersion = 3.3.3, vRev = Nothing }
|
|
||||||
-- - 2.3.4-r3 -> UserVersionRev { vVersion = 2.3.4, vRev = Just 3 }
|
|
||||||
userVersionRev :: Text -> Either (MP.ParseErrorBundle Text Void) UserVersionRev
|
|
||||||
userVersionRev = MP.parse userVersionRevP ""
|
|
||||||
|
|||||||
@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
|
|||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Ord
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( patch )
|
import Data.Versions hiding ( patch )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@@ -279,6 +280,6 @@ rmStackVer ver = do
|
|||||||
|
|
||||||
when (Just ver == sSet) $ do
|
when (Just ver == sSet) $ do
|
||||||
sVers <- lift $ fmap rights getInstalledStacks
|
sVers <- lift $ fmap rights getInstalledStacks
|
||||||
case headMay . reverse . sort $ sVers of
|
case headMay . sortBy (comparing Down) $ sVers of
|
||||||
Just latestver -> setStack latestver
|
Just latestver -> setStack latestver
|
||||||
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)
|
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)
|
||||||
|
|||||||
@@ -31,6 +31,7 @@ import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
|
|||||||
import Control.DeepSeq ( NFData, rnf )
|
import Control.DeepSeq ( NFData, rnf )
|
||||||
import Data.Map.Strict ( Map )
|
import Data.Map.Strict ( Map )
|
||||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import GHC.IO.Exception ( ExitCode )
|
import GHC.IO.Exception ( ExitCode )
|
||||||
@@ -44,9 +45,8 @@ import Graphics.Vty ( Key(..) )
|
|||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.List.NonEmpty as NE
|
||||||
|
import Data.Foldable (foldMap)
|
||||||
|
|
||||||
|
|
||||||
#if !defined(BRICK)
|
#if !defined(BRICK)
|
||||||
data Key = KEsc | KChar Char | KBS | KEnter
|
data Key = KEsc | KChar Char | KBS | KEnter
|
||||||
@@ -105,7 +105,7 @@ instance NFData Requirements
|
|||||||
-- | Description of all binary and source downloads. This is a tree
|
-- | Description of all binary and source downloads. This is a tree
|
||||||
-- of nested maps.
|
-- of nested maps.
|
||||||
type GHCupDownloads = Map Tool ToolVersionSpec
|
type GHCupDownloads = Map Tool ToolVersionSpec
|
||||||
type ToolVersionSpec = Map Version VersionInfo
|
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
|
||||||
type ArchitectureSpec = Map Architecture PlatformSpec
|
type ArchitectureSpec = Map Architecture PlatformSpec
|
||||||
type PlatformSpec = Map Platform PlatformVersionSpec
|
type PlatformSpec = Map Platform PlatformVersionSpec
|
||||||
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
|
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
|
||||||
@@ -133,24 +133,15 @@ data GlobalTool = ShimGen
|
|||||||
|
|
||||||
instance NFData GlobalTool
|
instance NFData GlobalTool
|
||||||
|
|
||||||
|
instance Pretty GlobalTool where
|
||||||
|
pPrint ShimGen = text "shimgen"
|
||||||
|
|
||||||
|
|
||||||
-- | All necessary information of a tool version, including
|
-- | All necessary information of a tool version, including
|
||||||
-- source download and per-architecture downloads.
|
-- source download and per-architecture downloads.
|
||||||
data VersionInfo = VersionInfo
|
data VersionInfo = VersionInfo
|
||||||
{ _viTags :: [Tag] -- ^ version specific tag
|
{ _viTags :: [Tag] -- ^ version specific tag
|
||||||
, _viChangeLog :: Maybe URI
|
, _viReleaseDay :: Maybe Day
|
||||||
, _viDownload :: Map Int VersionDownload
|
|
||||||
-- informative messages
|
|
||||||
, _viPostInstall :: Maybe Text
|
|
||||||
, _viPostRemove :: Maybe Text
|
|
||||||
, _viPreCompile :: Maybe Text
|
|
||||||
}
|
|
||||||
deriving (Eq, GHC.Generic, Show)
|
|
||||||
|
|
||||||
instance NFData VersionInfo
|
|
||||||
|
|
||||||
data VersionInfoLegacy = VersionInfoLegacy
|
|
||||||
{ _viTags :: [Tag] -- ^ version specific tag
|
|
||||||
, _viChangeLog :: Maybe URI
|
, _viChangeLog :: Maybe URI
|
||||||
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
||||||
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
||||||
@@ -162,47 +153,7 @@ data VersionInfoLegacy = VersionInfoLegacy
|
|||||||
}
|
}
|
||||||
deriving (Eq, GHC.Generic, Show)
|
deriving (Eq, GHC.Generic, Show)
|
||||||
|
|
||||||
data VersionDownload = VersionDownload
|
instance NFData VersionInfo
|
||||||
{ _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
|
||||||
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
|
||||||
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
|
|
||||||
|
|
||||||
}
|
|
||||||
deriving (Eq, GHC.Generic, Show)
|
|
||||||
|
|
||||||
instance NFData VersionDownload
|
|
||||||
|
|
||||||
fromVersionInfoLegacy :: VersionInfoLegacy -> VersionInfo
|
|
||||||
fromVersionInfoLegacy VersionInfoLegacy{..} =
|
|
||||||
VersionInfo {_viDownload = M.singleton 0 $ VersionDownload { _viSourceDL = _viSourceDL
|
|
||||||
, _viTestDL = _viTestDL
|
|
||||||
, _viArch = _viArch
|
|
||||||
}
|
|
||||||
, ..}
|
|
||||||
|
|
||||||
|
|
||||||
-- | A version with a revision, denoting bindist 'versions' that are purely distribution specific.
|
|
||||||
--
|
|
||||||
-- The revision starts at 0.
|
|
||||||
data VersionRev = VersionRev { vVersion :: Version, vRev :: Int }
|
|
||||||
deriving (Ord, Eq, GHC.Generic, Show)
|
|
||||||
|
|
||||||
showVersionRev :: VersionRev -> Text
|
|
||||||
showVersionRev (VersionRev v 0) = prettyVer v
|
|
||||||
showVersionRev (VersionRev v r) = prettyVer v <> "-r" <> T.pack (show r)
|
|
||||||
|
|
||||||
-- | Similar to @VersionRev@, except that revision is optional. The absence of a revision has
|
|
||||||
-- a particular meaning:
|
|
||||||
--
|
|
||||||
-- * for install/prefetch: we want the latest available revision
|
|
||||||
-- * for compile: it depends
|
|
||||||
-- * for rm/set/unset/whereis/changelog: we want the revision that is installed (there can be only one)
|
|
||||||
--
|
|
||||||
-- Translating @UserVersionRev@ to @VersionRev@ requires context of the GHCup metadata,
|
|
||||||
-- installed versions and the to be executed command.
|
|
||||||
data UserVersionRev = UserVersionRev { uvVersion :: Version, uvRev :: Maybe Int }
|
|
||||||
deriving (Ord, Eq, GHC.Generic, Show)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | A tag. These are currently attached to a version of a tool.
|
-- | A tag. These are currently attached to a version of a tool.
|
||||||
@@ -210,6 +161,8 @@ data Tag = Latest
|
|||||||
| Recommended
|
| Recommended
|
||||||
| Prerelease
|
| Prerelease
|
||||||
| LatestPrerelease
|
| LatestPrerelease
|
||||||
|
| Nightly
|
||||||
|
| LatestNightly
|
||||||
| Base PVP
|
| Base PVP
|
||||||
| Old -- ^ old versions are hidden by default in TUI
|
| Old -- ^ old versions are hidden by default in TUI
|
||||||
| UnknownTag String -- ^ used for upwardscompat
|
| UnknownTag String -- ^ used for upwardscompat
|
||||||
@@ -221,18 +174,22 @@ tagToString :: Tag -> String
|
|||||||
tagToString Recommended = "recommended"
|
tagToString Recommended = "recommended"
|
||||||
tagToString Latest = "latest"
|
tagToString Latest = "latest"
|
||||||
tagToString Prerelease = "prerelease"
|
tagToString Prerelease = "prerelease"
|
||||||
|
tagToString Nightly = "nightly"
|
||||||
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||||
tagToString (UnknownTag t ) = t
|
tagToString (UnknownTag t ) = t
|
||||||
tagToString LatestPrerelease = "latest-prerelease"
|
tagToString LatestPrerelease = "latest-prerelease"
|
||||||
|
tagToString LatestNightly = "latest-nightly"
|
||||||
tagToString Old = ""
|
tagToString Old = ""
|
||||||
|
|
||||||
instance Pretty Tag where
|
instance Pretty Tag where
|
||||||
pPrint Recommended = text "recommended"
|
pPrint Recommended = text "recommended"
|
||||||
pPrint Latest = text "latest"
|
pPrint Latest = text "latest"
|
||||||
pPrint Prerelease = text "prerelease"
|
pPrint Prerelease = text "prerelease"
|
||||||
|
pPrint Nightly = text "nightly"
|
||||||
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
|
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||||
pPrint (UnknownTag t ) = text t
|
pPrint (UnknownTag t ) = text t
|
||||||
pPrint LatestPrerelease = text "latest-prerelease"
|
pPrint LatestPrerelease = text "latest-prerelease"
|
||||||
|
pPrint LatestNightly = text "latest-prerelease"
|
||||||
pPrint Old = mempty
|
pPrint Old = mempty
|
||||||
|
|
||||||
data Architecture = A_64
|
data Architecture = A_64
|
||||||
@@ -322,6 +279,7 @@ data DownloadInfo = DownloadInfo
|
|||||||
, _dlSubdir :: Maybe TarDir
|
, _dlSubdir :: Maybe TarDir
|
||||||
, _dlHash :: Text
|
, _dlHash :: Text
|
||||||
, _dlCSize :: Maybe Integer
|
, _dlCSize :: Maybe Integer
|
||||||
|
, _dlOutput :: Maybe FilePath
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, GHC.Generic, Show)
|
deriving (Eq, Ord, GHC.Generic, Show)
|
||||||
|
|
||||||
@@ -639,6 +597,14 @@ data GHCTargetVersion = GHCTargetVersion
|
|||||||
{ _tvTarget :: Maybe Text
|
{ _tvTarget :: Maybe Text
|
||||||
, _tvVersion :: Version
|
, _tvVersion :: Version
|
||||||
}
|
}
|
||||||
|
deriving (Ord, Eq, Show, GHC.Generic)
|
||||||
|
|
||||||
|
instance NFData GHCTargetVersion
|
||||||
|
|
||||||
|
data GitBranch = GitBranch
|
||||||
|
{ ref :: String
|
||||||
|
, repo :: Maybe String
|
||||||
|
}
|
||||||
deriving (Ord, Eq, Show)
|
deriving (Ord, Eq, Show)
|
||||||
|
|
||||||
mkTVer :: Version -> GHCTargetVersion
|
mkTVer :: Version -> GHCTargetVersion
|
||||||
@@ -648,30 +614,10 @@ tVerToText :: GHCTargetVersion -> Text
|
|||||||
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
|
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
|
||||||
tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
|
tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
|
||||||
|
|
||||||
-- | A GHC identified by the target platform triple
|
|
||||||
-- and the version.
|
|
||||||
data GHCTargetVersionRev = GHCTargetVersionRev
|
|
||||||
{ _tvTargetRev :: Maybe Text
|
|
||||||
, _tvVersionRev :: VersionRev
|
|
||||||
}
|
|
||||||
deriving (Ord, Eq, Show)
|
|
||||||
|
|
||||||
mkTVerRev :: VersionRev -> GHCTargetVersionRev
|
|
||||||
mkTVerRev = GHCTargetVersionRev Nothing
|
|
||||||
|
|
||||||
tVerRevToText :: GHCTargetVersionRev -> Text
|
|
||||||
tVerRevToText (GHCTargetVersionRev (Just t) v') = t <> "-" <> showVersionRev v'
|
|
||||||
tVerRevToText (GHCTargetVersionRev Nothing v') = showVersionRev v'
|
|
||||||
|
|
||||||
-- | Assembles a path of the form: <target-triple>-<version>
|
-- | Assembles a path of the form: <target-triple>-<version>
|
||||||
instance Pretty GHCTargetVersion where
|
instance Pretty GHCTargetVersion where
|
||||||
pPrint = text . T.unpack . tVerToText
|
pPrint = text . T.unpack . tVerToText
|
||||||
|
|
||||||
data GitBranch = GitBranch
|
|
||||||
{ ref :: String
|
|
||||||
, repo :: Maybe String
|
|
||||||
}
|
|
||||||
deriving (Ord, Eq, Show)
|
|
||||||
|
|
||||||
-- | A comparator and a version.
|
-- | A comparator and a version.
|
||||||
data VersionCmp = VR_gt Versioning
|
data VersionCmp = VR_gt Versioning
|
||||||
@@ -692,6 +638,17 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
|
|||||||
|
|
||||||
instance NFData VersionRange
|
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
|
instance Pretty Versioning where
|
||||||
pPrint = text . T.unpack . prettyV
|
pPrint = text . T.unpack . prettyV
|
||||||
|
|
||||||
@@ -763,3 +720,21 @@ type PromptQuestion = Text
|
|||||||
|
|
||||||
data PromptResponse = PromptYes | PromptNo
|
data PromptResponse = PromptYes | PromptNo
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data ToolVersion = GHCVersion GHCTargetVersion
|
||||||
|
| ToolVersion Version
|
||||||
|
| ToolTag Tag
|
||||||
|
| ToolDay Day
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance Pretty ToolVersion where
|
||||||
|
pPrint (GHCVersion v) = pPrint v
|
||||||
|
pPrint (ToolVersion v) = pPrint v
|
||||||
|
pPrint (ToolTag t) = pPrint t
|
||||||
|
pPrint (ToolDay d) = text (show d)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
data BuildSystem = Hadrian
|
||||||
|
| Make
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|||||||
@@ -64,9 +64,11 @@ instance ToJSON Tag where
|
|||||||
toJSON Latest = String "Latest"
|
toJSON Latest = String "Latest"
|
||||||
toJSON Recommended = String "Recommended"
|
toJSON Recommended = String "Recommended"
|
||||||
toJSON Prerelease = String "Prerelease"
|
toJSON Prerelease = String "Prerelease"
|
||||||
|
toJSON Nightly = String "Nightly"
|
||||||
toJSON Old = String "old"
|
toJSON Old = String "old"
|
||||||
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
|
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
|
||||||
toJSON LatestPrerelease = String "LatestPrerelease"
|
toJSON LatestPrerelease = String "LatestPrerelease"
|
||||||
|
toJSON LatestNightly = String "LatestNightly"
|
||||||
toJSON (UnknownTag x ) = String (T.pack x)
|
toJSON (UnknownTag x ) = String (T.pack x)
|
||||||
|
|
||||||
instance FromJSON Tag where
|
instance FromJSON Tag where
|
||||||
@@ -74,7 +76,9 @@ instance FromJSON Tag where
|
|||||||
"Latest" -> pure Latest
|
"Latest" -> pure Latest
|
||||||
"Recommended" -> pure Recommended
|
"Recommended" -> pure Recommended
|
||||||
"Prerelease" -> pure Prerelease
|
"Prerelease" -> pure Prerelease
|
||||||
|
"Nightly" -> pure Nightly
|
||||||
"LatestPrerelease" -> pure LatestPrerelease
|
"LatestPrerelease" -> pure LatestPrerelease
|
||||||
|
"LatestNightly" -> pure LatestNightly
|
||||||
"old" -> pure Old
|
"old" -> pure Old
|
||||||
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
|
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
|
||||||
Right x -> pure $ Base x
|
Right x -> pure $ Base x
|
||||||
@@ -91,13 +95,29 @@ instance FromJSON URI where
|
|||||||
Right x -> pure x
|
Right x -> pure x
|
||||||
Left e -> fail . show $ e
|
Left e -> fail . show $ e
|
||||||
|
|
||||||
|
instance ToJSON GHCTargetVersion where
|
||||||
|
toJSON = toJSON . tVerToText
|
||||||
|
|
||||||
|
instance FromJSON GHCTargetVersion where
|
||||||
|
parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of
|
||||||
|
Right x -> pure x
|
||||||
|
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
|
||||||
|
|
||||||
|
instance ToJSONKey GHCTargetVersion where
|
||||||
|
toJSONKey = toJSONKeyText $ \x -> tVerToText x
|
||||||
|
|
||||||
|
instance FromJSONKey GHCTargetVersion where
|
||||||
|
fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of
|
||||||
|
Right x -> pure x
|
||||||
|
Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
|
||||||
|
|
||||||
instance ToJSON Versioning where
|
instance ToJSON Versioning where
|
||||||
toJSON = toJSON . prettyV
|
toJSON = toJSON . prettyV
|
||||||
|
|
||||||
instance FromJSON Versioning where
|
instance FromJSON Versioning where
|
||||||
parseJSON = withText "Versioning" $ \t -> case versioning t of
|
parseJSON = withText "Versioning" $ \t -> case versioning t of
|
||||||
Right x -> pure x
|
Right x -> pure x
|
||||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
|
||||||
|
|
||||||
instance ToJSONKey Versioning where
|
instance ToJSONKey Versioning where
|
||||||
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
||||||
@@ -320,18 +340,11 @@ instance FromJSONKey (Maybe VersionRange) where
|
|||||||
Right x -> pure $ Just x
|
Right x -> pure $ Just x
|
||||||
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionDownload
|
|
||||||
|
|
||||||
instance FromJSON VersionInfo where
|
|
||||||
parseJSON v = parseLegacy v <|> parseNew v
|
|
||||||
where
|
|
||||||
parseLegacy = fmap fromVersionInfoLegacy . parseJSON @VersionInfoLegacy
|
|
||||||
parseNew = genericParseJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel }
|
|
||||||
|
|
||||||
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||||
|
|||||||
@@ -37,7 +37,6 @@ makeLenses ''PlatformResult
|
|||||||
makeLenses ''DownloadInfo
|
makeLenses ''DownloadInfo
|
||||||
makeLenses ''Tag
|
makeLenses ''Tag
|
||||||
makeLenses ''VersionInfo
|
makeLenses ''VersionInfo
|
||||||
makeLenses ''VersionDownload
|
|
||||||
|
|
||||||
makeLenses ''GHCTargetVersion
|
makeLenses ''GHCTargetVersion
|
||||||
|
|
||||||
|
|||||||
@@ -62,7 +62,6 @@ import Control.Monad.Trans.Resource
|
|||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||||
import Data.Char ( isHexDigit )
|
import Data.Char ( isHexDigit )
|
||||||
import Data.Bifunctor ( first )
|
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
@@ -94,6 +93,7 @@ import qualified Streamly.Prelude as S
|
|||||||
import Control.DeepSeq (force)
|
import Control.DeepSeq (force)
|
||||||
import GHC.IO (evaluate)
|
import GHC.IO (evaluate)
|
||||||
import System.Environment (getEnvironment, setEnv)
|
import System.Environment (getEnvironment, setEnv)
|
||||||
|
import Data.Time (Day(..), diffDays, addDays)
|
||||||
|
|
||||||
|
|
||||||
-- $setup
|
-- $setup
|
||||||
@@ -160,7 +160,7 @@ rmMinorGHCSymlinks :: ( MonadReader env m
|
|||||||
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
|
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
files <- liftE $ ghcToolFiles tv
|
files <- liftE $ ghcToolFiles tv
|
||||||
forM_ files $ \f -> do
|
forM_ files $ \f -> do
|
||||||
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
||||||
let fullF = binDir </> f_xyz
|
let fullF = binDir </> f_xyz
|
||||||
@@ -181,7 +181,7 @@ rmPlainGHC :: ( MonadReader env m
|
|||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
rmPlainGHC target = do
|
rmPlainGHC target = do
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
mtv <- lift $ ghcSet target
|
mtv <- lift $ ghcSet target
|
||||||
forM_ mtv $ \tv -> do
|
forM_ mtv $ \tv -> do
|
||||||
files <- liftE $ ghcToolFiles tv
|
files <- liftE $ ghcToolFiles tv
|
||||||
forM_ files $ \f -> do
|
forM_ files $ \f -> do
|
||||||
@@ -228,7 +228,7 @@ rmMinorHLSSymlinks :: ( MonadReader env m
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> VersionRev
|
=> Version
|
||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
rmMinorHLSSymlinks ver = do
|
rmMinorHLSSymlinks ver = do
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
@@ -281,25 +281,18 @@ rmPlainHLS = do
|
|||||||
-----------------------------------
|
-----------------------------------
|
||||||
|
|
||||||
|
|
||||||
-- | Whether the given GHC version is installed.
|
-- | Whether the given GHC versin is installed.
|
||||||
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||||
ghcInstalled ver = do
|
ghcInstalled ver = do
|
||||||
ghcdir <- ghcupGHCDir ver
|
ghcdir <- ghcupGHCDir ver
|
||||||
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
|
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.
|
-- | Whether the given GHC version is set as the current.
|
||||||
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||||
=> Maybe Text -- ^ the target of the GHC version, if any
|
=> Maybe Text -- ^ the target of the GHC version, if any
|
||||||
-- (e.g. armv7-unknown-linux-gnueabihf)
|
-- (e.g. armv7-unknown-linux-gnueabihf)
|
||||||
-> m (Maybe GHCTargetVersionRev)
|
-> m (Maybe GHCTargetVersion)
|
||||||
ghcSet mtarget = do
|
ghcSet mtarget = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
|
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
|
||||||
@@ -311,7 +304,7 @@ ghcSet mtarget = do
|
|||||||
link <- liftIO $ getLinkTarget ghcBin
|
link <- liftIO $ getLinkTarget ghcBin
|
||||||
Just <$> ghcLinkVersion link
|
Just <$> ghcLinkVersion link
|
||||||
where
|
where
|
||||||
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersionRev
|
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
|
||||||
ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
|
ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
|
||||||
where
|
where
|
||||||
parser =
|
parser =
|
||||||
@@ -321,7 +314,7 @@ ghcSet mtarget = do
|
|||||||
r <- parseUntil1 pathSep
|
r <- parseUntil1 pathSep
|
||||||
rest <- MP.getInput
|
rest <- MP.getInput
|
||||||
MP.setInput r
|
MP.setInput r
|
||||||
x <- ghcTargetVerRevP
|
x <- ghcTargetVerP
|
||||||
MP.setInput rest
|
MP.setInput rest
|
||||||
pure x
|
pure x
|
||||||
)
|
)
|
||||||
@@ -347,13 +340,13 @@ getInstalledCabals :: ( MonadReader env m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
)
|
)
|
||||||
=> m [Either FilePath VersionRev]
|
=> m [Either FilePath Version]
|
||||||
getInstalledCabals = do
|
getInstalledCabals = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||||
binDir
|
binDir
|
||||||
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
|
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
|
||||||
vs <- forM bins $ \f -> case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
|
vs <- forM bins $ \f -> case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
|
||||||
Just (Right r) -> pure $ Right r
|
Just (Right r) -> pure $ Right r
|
||||||
Just (Left _) -> pure $ Left f
|
Just (Left _) -> pure $ Left f
|
||||||
Nothing -> pure $ Left f
|
Nothing -> pure $ Left f
|
||||||
@@ -361,14 +354,14 @@ getInstalledCabals = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Whether the given cabal version is installed.
|
-- | Whether the given cabal version is installed.
|
||||||
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
|
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||||
cabalInstalled ver = do
|
cabalInstalled ver = do
|
||||||
vers <- fmap rights getInstalledCabals
|
vers <- fmap rights getInstalledCabals
|
||||||
pure $ elem ver vers
|
pure $ elem ver vers
|
||||||
|
|
||||||
|
|
||||||
-- Return the currently set cabal version, if any.
|
-- Return the currently set cabal version, if any.
|
||||||
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
|
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||||
cabalSet = do
|
cabalSet = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
let cabalbin = binDir </> "cabal" <> exeExt
|
let cabalbin = binDir </> "cabal" <> exeExt
|
||||||
@@ -395,7 +388,7 @@ cabalSet = do
|
|||||||
-- We try to be extra permissive with link destination parsing,
|
-- We try to be extra permissive with link destination parsing,
|
||||||
-- because of:
|
-- because of:
|
||||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119
|
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119
|
||||||
linkVersion :: MonadThrow m => FilePath -> m VersionRev
|
linkVersion :: MonadThrow m => FilePath -> m Version
|
||||||
linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt
|
linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt
|
||||||
|
|
||||||
parser
|
parser
|
||||||
@@ -403,7 +396,7 @@ cabalSet = do
|
|||||||
<|> MP.try (stripRelativePath *> cabalParse)
|
<|> MP.try (stripRelativePath *> cabalParse)
|
||||||
<|> cabalParse
|
<|> cabalParse
|
||||||
-- parses the version of "cabal-3.2.0.0" -> "3.2.0.0"
|
-- parses the version of "cabal-3.2.0.0" -> "3.2.0.0"
|
||||||
cabalParse = MP.chunk "cabal-" *> versionRevP
|
cabalParse = MP.chunk "cabal-" *> version'
|
||||||
-- parses any path component ending with path separator,
|
-- parses any path component ending with path separator,
|
||||||
-- e.g. "foo/"
|
-- e.g. "foo/"
|
||||||
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
|
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
|
||||||
@@ -420,7 +413,7 @@ cabalSet = do
|
|||||||
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
|
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
|
||||||
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
|
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
|
||||||
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||||
=> m [Either FilePath VersionRev]
|
=> m [Either FilePath Version]
|
||||||
getInstalledHLSs = do
|
getInstalledHLSs = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||||
@@ -431,7 +424,7 @@ getInstalledHLSs = do
|
|||||||
)
|
)
|
||||||
legacy <- forM bins $ \f ->
|
legacy <- forM bins $ \f ->
|
||||||
case
|
case
|
||||||
versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
|
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
|
||||||
of
|
of
|
||||||
Just (Right r) -> pure $ Right r
|
Just (Right r) -> pure $ Right r
|
||||||
Just (Left _) -> pure $ Left f
|
Just (Left _) -> pure $ Left f
|
||||||
@@ -448,7 +441,7 @@ getInstalledHLSs = do
|
|||||||
-- | Get all installed stacks, by matching on
|
-- | Get all installed stacks, by matching on
|
||||||
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
||||||
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||||
=> m [Either FilePath VersionRev]
|
=> m [Either FilePath Version]
|
||||||
getInstalledStacks = do
|
getInstalledStacks = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||||
@@ -458,7 +451,7 @@ getInstalledStacks = do
|
|||||||
([s|^stack-.*$|] :: ByteString)
|
([s|^stack-.*$|] :: ByteString)
|
||||||
)
|
)
|
||||||
forM bins $ \f ->
|
forM bins $ \f ->
|
||||||
case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
|
case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
|
||||||
Just (Right r) -> pure $ Right r
|
Just (Right r) -> pure $ Right r
|
||||||
Just (Left _) -> pure $ Left f
|
Just (Left _) -> pure $ Left f
|
||||||
Nothing -> pure $ Left f
|
Nothing -> pure $ Left f
|
||||||
@@ -509,13 +502,13 @@ stackSet = do
|
|||||||
stripRelativePath = MP.many (MP.try stripPathComponet)
|
stripRelativePath = MP.many (MP.try stripPathComponet)
|
||||||
|
|
||||||
-- | Whether the given Stack version is installed.
|
-- | Whether the given Stack version is installed.
|
||||||
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
|
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||||
stackInstalled ver = do
|
stackInstalled ver = do
|
||||||
vers <- fmap rights getInstalledStacks
|
vers <- fmap rights getInstalledStacks
|
||||||
pure $ elem ver vers
|
pure $ elem ver vers
|
||||||
|
|
||||||
-- | Whether the given HLS version is installed.
|
-- | Whether the given HLS version is installed.
|
||||||
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
|
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||||
hlsInstalled ver = do
|
hlsInstalled ver = do
|
||||||
vers <- fmap rights getInstalledHLSs
|
vers <- fmap rights getInstalledHLSs
|
||||||
pure $ elem ver vers
|
pure $ elem ver vers
|
||||||
@@ -527,7 +520,7 @@ isLegacyHLS ver = do
|
|||||||
|
|
||||||
|
|
||||||
-- Return the currently set hls version, if any.
|
-- Return the currently set hls version, if any.
|
||||||
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
|
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||||
hlsSet = do
|
hlsSet = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||||
@@ -540,7 +533,7 @@ hlsSet = do
|
|||||||
link <- liftIO $ getLinkTarget hlsBin
|
link <- liftIO $ getLinkTarget hlsBin
|
||||||
Just <$> linkVersion link
|
Just <$> linkVersion link
|
||||||
where
|
where
|
||||||
linkVersion :: MonadThrow m => FilePath -> m VersionRev
|
linkVersion :: MonadThrow m => FilePath -> m Version
|
||||||
linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
|
linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
|
||||||
where
|
where
|
||||||
parser
|
parser
|
||||||
@@ -548,7 +541,7 @@ hlsSet = do
|
|||||||
<|> MP.try (stripRelativePath *> cabalParse)
|
<|> MP.try (stripRelativePath *> cabalParse)
|
||||||
<|> cabalParse
|
<|> cabalParse
|
||||||
-- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0"
|
-- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0"
|
||||||
cabalParse = MP.chunk "haskell-language-server-wrapper-" *> versionRevP
|
cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version'
|
||||||
-- parses any path component ending with path separator,
|
-- parses any path component ending with path separator,
|
||||||
-- e.g. "foo/"
|
-- e.g. "foo/"
|
||||||
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
|
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
|
||||||
@@ -567,7 +560,7 @@ hlsGHCVersions :: ( MonadReader env m
|
|||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
)
|
)
|
||||||
=> m [VersionRev]
|
=> m [Version]
|
||||||
hlsGHCVersions = do
|
hlsGHCVersions = do
|
||||||
h <- hlsSet
|
h <- hlsSet
|
||||||
fromMaybe [] <$> forM h hlsGHCVersions'
|
fromMaybe [] <$> forM h hlsGHCVersions'
|
||||||
@@ -579,12 +572,12 @@ hlsGHCVersions' :: ( MonadReader env m
|
|||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
)
|
)
|
||||||
=> VersionRev
|
=> Version
|
||||||
-> m [VersionRev]
|
-> m [Version]
|
||||||
hlsGHCVersions' v' = do
|
hlsGHCVersions' v' = do
|
||||||
bins <- hlsServerBinaries v' Nothing
|
bins <- hlsServerBinaries v' Nothing
|
||||||
let vers = fmap
|
let vers = fmap
|
||||||
(versionRev
|
(version
|
||||||
. T.pack
|
. T.pack
|
||||||
. fromJust
|
. fromJust
|
||||||
. stripPrefix "haskell-language-server-"
|
. stripPrefix "haskell-language-server-"
|
||||||
@@ -597,10 +590,10 @@ hlsGHCVersions' v' = do
|
|||||||
|
|
||||||
-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
|
-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
|
||||||
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||||
=> VersionRev
|
=> Version
|
||||||
-> Maybe Version -- ^ optional GHC version
|
-> Maybe Version -- ^ optional GHC version
|
||||||
-> m [FilePath]
|
-> m [FilePath]
|
||||||
hlsServerBinaries (VersionRev ver rv) mghcVer = do
|
hlsServerBinaries ver mghcVer = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
liftIO $ handleIO (\_ -> pure []) $ findFiles
|
liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||||
binDir
|
binDir
|
||||||
@@ -611,7 +604,6 @@ hlsServerBinaries (VersionRev ver rv) mghcVer = do
|
|||||||
<> maybe [s|.*|] escapeVerRex mghcVer
|
<> maybe [s|.*|] escapeVerRex mghcVer
|
||||||
<> [s|~|]
|
<> [s|~|]
|
||||||
<> escapeVerRex ver
|
<> escapeVerRex ver
|
||||||
<> E.encodeUtf8 (T.pack ("-r" <> show rv))
|
|
||||||
<> E.encodeUtf8 (T.pack exeExt)
|
<> E.encodeUtf8 (T.pack exeExt)
|
||||||
<> [s|$|] :: ByteString
|
<> [s|$|] :: ByteString
|
||||||
)
|
)
|
||||||
@@ -658,20 +650,16 @@ hlsInternalServerLibs ver ghcVer = do
|
|||||||
|
|
||||||
-- | Get the wrapper binary for an hls version, if any.
|
-- | Get the wrapper binary for an hls version, if any.
|
||||||
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||||
=> VersionRev
|
=> Version
|
||||||
-> m (Maybe FilePath)
|
-> m (Maybe FilePath)
|
||||||
hlsWrapperBinary (VersionRev ver rv) = do
|
hlsWrapperBinary ver = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||||
binDir
|
binDir
|
||||||
(makeRegexOpts
|
(makeRegexOpts
|
||||||
compExtended
|
compExtended
|
||||||
execBlank
|
execBlank
|
||||||
([s|^haskell-language-server-wrapper-|]
|
([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
|
||||||
<> escapeVerRex ver
|
|
||||||
<> E.encodeUtf8 (T.pack ("-r" <> show rv))
|
|
||||||
<> E.encodeUtf8 (T.pack exeExt)
|
|
||||||
<> [s|$|] :: ByteString
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
case wrapper of
|
case wrapper of
|
||||||
@@ -682,7 +670,7 @@ hlsWrapperBinary (VersionRev ver rv) = do
|
|||||||
|
|
||||||
|
|
||||||
-- | Get all binaries for an hls version, if any.
|
-- | Get all binaries for an hls version, if any.
|
||||||
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => VersionRev -> m [FilePath]
|
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
|
||||||
hlsAllBinaries ver = do
|
hlsAllBinaries ver = do
|
||||||
hls <- hlsServerBinaries ver Nothing
|
hls <- hlsServerBinaries ver Nothing
|
||||||
wrapper <- hlsWrapperBinary ver
|
wrapper <- hlsWrapperBinary ver
|
||||||
@@ -778,16 +766,16 @@ getGHCForPVP' pvpIn ghcs' mt = do
|
|||||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||||
getLatestToolFor :: MonadThrow m
|
getLatestToolFor :: MonadThrow m
|
||||||
=> Tool
|
=> Tool
|
||||||
|
-> Maybe Text
|
||||||
-> PVP
|
-> PVP
|
||||||
-> GHCupDownloads
|
-> GHCupDownloads
|
||||||
-> m (Maybe (PVP, VersionInfo))
|
-> m (Maybe (PVP, VersionInfo, Maybe Text))
|
||||||
getLatestToolFor tool pvpIn dls = do
|
getLatestToolFor tool target pvpIn dls = do
|
||||||
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
let ls :: [(GHCTargetVersion, VersionInfo)]
|
||||||
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
|
ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||||
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
|
let ps :: [((PVP, Text), VersionInfo, Maybe Text)]
|
||||||
|
ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls
|
||||||
-- type ToolVersionSpec = Map Version ToolRevisionSpec
|
pure . fmap (\((pv', _), vi, mt) -> (pv', vi, mt)) . headMay . filter (\((v, _), _, t) -> matchPVPrefix pvpIn v && t == target) $ ps
|
||||||
-- type ToolRevisionSpec = Map Int VersionInfo
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -892,23 +880,41 @@ intoSubdir bdir tardir = case tardir of
|
|||||||
-- | Get the tool version that has this tag. If multiple have it,
|
-- | Get the tool version that has this tag. If multiple have it,
|
||||||
-- picks the greatest version.
|
-- picks the greatest version.
|
||||||
getTagged :: Tag
|
getTagged :: Tag
|
||||||
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
-> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
|
||||||
getTagged tag =
|
getTagged tag =
|
||||||
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||||
% folding id
|
% folding id
|
||||||
|
|
||||||
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
|
||||||
|
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
|
||||||
|
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
|
||||||
|
maybe m (\d -> let diff = diffDays d day
|
||||||
|
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
|
||||||
|
Map.empty mvv
|
||||||
|
in case headMay (Map.toAscList mdv) of
|
||||||
|
Nothing -> Left Nothing
|
||||||
|
Just (absDiff, (diff, (k, vi)))
|
||||||
|
| absDiff == 0 -> Right (k, vi)
|
||||||
|
| otherwise -> Left (Just (addDays diff day))
|
||||||
|
|
||||||
|
getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
|
||||||
|
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
|
||||||
|
|
||||||
|
getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
||||||
|
|
||||||
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
|
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
|
||||||
|
|
||||||
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
|
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
|
||||||
|
|
||||||
|
getRecommended :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
|
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
|
||||||
|
|
||||||
|
|
||||||
-- | Gets the latest GHC with a given base version.
|
-- | Gets the latest GHC with a given base version.
|
||||||
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
|
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
getLatestBaseVersion av pvpVer =
|
getLatestBaseVersion av pvpVer =
|
||||||
headOf (ix GHC % getTagged (Base pvpVer)) av
|
headOf (ix GHC % getTagged (Base pvpVer)) av
|
||||||
|
|
||||||
@@ -935,7 +941,7 @@ ghcInternalBinDir ver = do
|
|||||||
--
|
--
|
||||||
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
|
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
|
||||||
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
||||||
=> GHCTargetVersionRev
|
=> GHCTargetVersion
|
||||||
-> Excepts '[NotInstalled] m [FilePath]
|
-> Excepts '[NotInstalled] m [FilePath]
|
||||||
ghcToolFiles ver = do
|
ghcToolFiles ver = do
|
||||||
bindir <- ghcInternalBinDir ver
|
bindir <- ghcInternalBinDir ver
|
||||||
@@ -962,11 +968,6 @@ ghcToolFiles ver = do
|
|||||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
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.
|
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||||
make :: ( MonadThrow m
|
make :: ( MonadThrow m
|
||||||
@@ -1089,11 +1090,15 @@ darwinNotarization _ _ = pure $ Right ()
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
|
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
|
||||||
getChangeLog dls tool (Left v') =
|
getChangeLog dls tool (GHCVersion v') =
|
||||||
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||||
getChangeLog dls tool (Right tag) =
|
getChangeLog dls tool (ToolVersion (mkTVer -> v')) =
|
||||||
|
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||||
|
getChangeLog dls tool (ToolTag tag) =
|
||||||
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
||||||
|
getChangeLog dls tool (ToolDay day) =
|
||||||
|
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
|
||||||
|
|
||||||
|
|
||||||
-- | Execute a build action while potentially cleaning up:
|
-- | Execute a build action while potentially cleaning up:
|
||||||
@@ -1177,7 +1182,7 @@ rmBDir dir = withRunInIO (\run -> run $
|
|||||||
$ rmPathForcibly dir)
|
$ rmPathForcibly dir)
|
||||||
|
|
||||||
|
|
||||||
getVersionInfo :: Version
|
getVersionInfo :: GHCTargetVersion
|
||||||
-> Tool
|
-> Tool
|
||||||
-> GHCupDownloads
|
-> GHCupDownloads
|
||||||
-> Maybe VersionInfo
|
-> Maybe VersionInfo
|
||||||
@@ -1207,7 +1212,7 @@ ensureGlobalTools
|
|||||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||||
dirs <- lift getDirs
|
dirs <- lift getDirs
|
||||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
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
|
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||||
void $ (\DigestError{} -> do
|
void $ (\DigestError{} -> do
|
||||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||||
@@ -1293,7 +1298,7 @@ warnAboutHlsCompatibility :: ( MonadReader env m
|
|||||||
=> m ()
|
=> m ()
|
||||||
warnAboutHlsCompatibility = do
|
warnAboutHlsCompatibility = do
|
||||||
supportedGHC <- hlsGHCVersions
|
supportedGHC <- hlsGHCVersions
|
||||||
currentGHC <- fmap _tvVersionRev <$> ghcSet Nothing
|
currentGHC <- fmap _tvVersion <$> ghcSet Nothing
|
||||||
currentHLS <- hlsSet
|
currentHLS <- hlsSet
|
||||||
|
|
||||||
case (currentGHC, currentHLS) of
|
case (currentGHC, currentHLS) of
|
||||||
|
|||||||
@@ -279,7 +279,7 @@ ghcupCacheDir
|
|||||||
Nothing -> do
|
Nothing -> do
|
||||||
home <- liftIO getHomeDirectory
|
home <- liftIO getHomeDirectory
|
||||||
pure (home </> ".cache")
|
pure (home </> ".cache")
|
||||||
pure (GHCupPath (bdir </> "ghcup"))
|
pure (GHCupPath (bdir </> "ghcup" </> "cache"))
|
||||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
|
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
|
||||||
|
|
||||||
|
|
||||||
@@ -308,19 +308,7 @@ ghcupLogsDir
|
|||||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||||
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
|
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
|
||||||
ghcupDbDir :: IO GHCupPath
|
ghcupDbDir :: IO GHCupPath
|
||||||
ghcupDbDir
|
ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
||||||
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
|
||||||
| otherwise = do
|
|
||||||
xdg <- useXDG
|
|
||||||
if xdg
|
|
||||||
then do
|
|
||||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
|
||||||
Just r -> pure r
|
|
||||||
Nothing -> do
|
|
||||||
home <- liftIO getHomeDirectory
|
|
||||||
pure (home </> ".cache")
|
|
||||||
pure (GHCupPath (bdir </> "ghcup" </> "db"))
|
|
||||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
|
||||||
|
|
||||||
|
|
||||||
-- | '~/.ghcup/trash'.
|
-- | '~/.ghcup/trash'.
|
||||||
@@ -417,9 +405,9 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
|
|||||||
parseGHCupGHCDir (T.pack -> fp) =
|
parseGHCupGHCDir (T.pack -> fp) =
|
||||||
throwEither $ MP.parse ghcTargetVerP "" fp
|
throwEither $ MP.parse ghcTargetVerP "" fp
|
||||||
|
|
||||||
parseGHCupHLSDir :: MonadThrow m => FilePath -> m VersionRev
|
parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
|
||||||
parseGHCupHLSDir (T.pack -> fp) =
|
parseGHCupHLSDir (T.pack -> fp) =
|
||||||
throwEither $ versionRev fp
|
throwEither $ MP.parse version' "" fp
|
||||||
|
|
||||||
-- TODO: inlined from GHCup.Prelude
|
-- TODO: inlined from GHCup.Prelude
|
||||||
throwEither :: (Exception a, MonadThrow m) => Either a b -> m b
|
throwEither :: (Exception a, MonadThrow m) => Either a b -> m b
|
||||||
|
|||||||
@@ -52,7 +52,7 @@ versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
|
|||||||
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
||||||
|
|
||||||
versionRange :: V.Versioning -> VersionRange -> Bool
|
versionRange :: V.Versioning -> VersionRange -> Bool
|
||||||
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
|
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
|
||||||
versionRange ver' (OrRange cmps range) =
|
versionRange ver' (OrRange cmps range) =
|
||||||
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
||||||
|
|
||||||
|
|||||||
@@ -28,7 +28,7 @@
|
|||||||
|
|
||||||
plat="$(uname -s)"
|
plat="$(uname -s)"
|
||||||
arch=$(uname -m)
|
arch=$(uname -m)
|
||||||
ghver="0.1.19.2"
|
ghver="0.1.19.4"
|
||||||
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
||||||
|
|
||||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||||
@@ -851,8 +851,8 @@ case $ask_stack_answer in
|
|||||||
;;
|
;;
|
||||||
2)
|
2)
|
||||||
(_eghcup --cache install stack) || die "Stack installation failed"
|
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||||
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
|
edo mkdir -p "${STACK_ROOT:-$HOME/.stack}"/hooks
|
||||||
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
hook_exe="${STACK_ROOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
||||||
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
||||||
|
|
||||||
if [ -e "${hook_exe}" ] ; then
|
if [ -e "${hook_exe}" ] ; then
|
||||||
|
|||||||
@@ -40,10 +40,13 @@ param (
|
|||||||
# Whether to disable use of curl.exe
|
# Whether to disable use of curl.exe
|
||||||
[switch]$DisableCurl,
|
[switch]$DisableCurl,
|
||||||
# The Msys2 version to download (e.g. 20221216)
|
# The Msys2 version to download (e.g. 20221216)
|
||||||
[string]$Msys2Version
|
[string]$Msys2Version,
|
||||||
|
# The Msys2 sha256sum hash
|
||||||
|
[string]$Msys2Hash
|
||||||
)
|
)
|
||||||
|
|
||||||
$DefaultMsys2Version = "20221216"
|
$DefaultMsys2Version = "20221216"
|
||||||
|
$DefaultMsys2Hash = "18370d32b0264915c97e3d7c618f7b32d48ad80858923883fde5145acd32ca0f"
|
||||||
|
|
||||||
$Silent = !$Interactive
|
$Silent = !$Interactive
|
||||||
|
|
||||||
@@ -430,9 +433,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
if (!($Msys2Version)) {
|
if (!($Msys2Version)) {
|
||||||
$Msys2Version = $DefaultMsys2Version
|
$Msys2Version = $DefaultMsys2Version
|
||||||
}
|
}
|
||||||
|
if (!($Msys2Hash)) {
|
||||||
|
$Msys2Hash = $DefaultMsys2Hash
|
||||||
|
}
|
||||||
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
||||||
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -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")
|
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||||
|
|
||||||
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
||||||
@@ -440,6 +446,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
} else {
|
} else {
|
||||||
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
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...'
|
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||||
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||||
@@ -448,7 +459,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||||
Exec "$Bash" '-lc' 'exit'
|
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...'
|
Print-Msg -msg 'Upgrading full system...'
|
||||||
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
||||||
|
|||||||
67
scripts/releasing/create-yaml-snippet.sh
Normal file
67
scripts/releasing/create-yaml-snippet.sh
Normal file
@@ -0,0 +1,67 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
set -eu
|
||||||
|
set -o pipefail
|
||||||
|
|
||||||
|
RELEASE=$1
|
||||||
|
|
||||||
|
get_sha() {
|
||||||
|
sha256sum "$1" | awk '{ print $1 }'
|
||||||
|
}
|
||||||
|
|
||||||
|
cd "gh-release-artifacts/v${RELEASE}"
|
||||||
|
|
||||||
|
cat <<EOF > /dev/stdout
|
||||||
|
GHCup:
|
||||||
|
${RELEASE}:
|
||||||
|
viTags:
|
||||||
|
- Recommended
|
||||||
|
- Latest
|
||||||
|
viChangeLog: https://github.com/haskell/ghcup-hs/blob/master/CHANGELOG.md
|
||||||
|
viSourceDL:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/ghcup-${RELEASE}-src.tar.gz
|
||||||
|
dlSubdir: ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "ghcup-${RELEASE}-src.tar.gz")
|
||||||
|
viArch:
|
||||||
|
A_64:
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning: &ghcup-64
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-linux-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "x86_64-linux-ghcup-${RELEASE}")
|
||||||
|
Darwin:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-apple-darwin-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "x86_64-apple-darwin-ghcup-${RELEASE}")
|
||||||
|
FreeBSD:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-portbld-freebsd-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "x86_64-portbld-freebsd-ghcup-${RELEASE}")
|
||||||
|
Windows:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-mingw64-ghcup-${RELEASE}.exe
|
||||||
|
dlHash: $(get_sha "x86_64-mingw64-ghcup-${RELEASE}.exe")
|
||||||
|
Linux_Alpine:
|
||||||
|
unknown_versioning: *ghcup-64
|
||||||
|
A_32:
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning: &ghcup-32
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/i386-linux-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "i386-linux-ghcup-${RELEASE}")
|
||||||
|
Linux_Alpine:
|
||||||
|
unknown_versioning: *ghcup-32
|
||||||
|
A_ARM64:
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-linux-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "aarch64-linux-ghcup-${RELEASE}")
|
||||||
|
Darwin:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-apple-darwin-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "aarch64-apple-darwin-ghcup-${RELEASE}")
|
||||||
|
A_ARM:
|
||||||
|
Linux_UnknownLinux:
|
||||||
|
unknown_versioning:
|
||||||
|
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/armv7-linux-ghcup-${RELEASE}
|
||||||
|
dlHash: $(get_sha "armv7-linux-ghcup-${RELEASE}")
|
||||||
|
EOF
|
||||||
|
|
||||||
@@ -29,7 +29,7 @@ gh release download "$RELEASE"
|
|||||||
|
|
||||||
# cirrus
|
# cirrus
|
||||||
curl -L -o "x86_64-portbld-freebsd-ghcup-${TAG}" \
|
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
|
sha256sum ./*-ghcup-* > SHA256SUMS
|
||||||
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
||||||
|
|||||||
50
stack.yaml
50
stack.yaml
@@ -1,52 +1,36 @@
|
|||||||
resolver: lts-18.28
|
resolver: lts-20.20
|
||||||
|
|
||||||
packages:
|
packages:
|
||||||
- .
|
- .
|
||||||
|
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
|
- Cabal-3.6.3.0
|
||||||
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
- Cabal-syntax-3.10.1.0
|
||||||
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
- aeson-2.1.2.1
|
||||||
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
- cabal-install-parsers-0.6.1
|
||||||
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
|
||||||
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
|
|
||||||
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
|
|
||||||
- chs-cabal-0.1.1.1
|
- chs-cabal-0.1.1.1
|
||||||
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
|
- chs-deps-0.1.0.0
|
||||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
|
||||||
|
- generically-0.1.1
|
||||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||||
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
|
- haskus-utils-variant-3.2.1
|
||||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
- libarchive-3.0.3.2
|
||||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
|
||||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
|
||||||
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
|
||||||
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
|
|
||||||
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
|
|
||||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
|
||||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
|
||||||
- libarchive-3.0.3.0
|
|
||||||
- libyaml-streamly-0.2.1
|
- libyaml-streamly-0.2.1
|
||||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
- lzma-static-5.2.5.5
|
||||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
- os-release-1.0.2.1
|
||||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
- parsec-3.1.15.0
|
||||||
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
|
|
||||||
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
|
|
||||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
|
||||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
|
||||||
- regex-posix-clib-2.7
|
|
||||||
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
||||||
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
|
- strict-base-0.4.0.0
|
||||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
- text-2.0.2
|
||||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
- yaml-streamly-0.12.2
|
||||||
- yaml-streamly-0.12.1
|
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
http-io-streams:
|
http-io-streams:
|
||||||
brotli: false
|
brotli: false
|
||||||
|
|
||||||
libarchive:
|
libarchive:
|
||||||
system-libarchive: false
|
system-libarchive: true
|
||||||
|
|
||||||
regex-posix:
|
regex-posix:
|
||||||
_regex-posix-clib: true
|
_regex-posix-clib: true
|
||||||
|
|||||||
@@ -11,6 +11,7 @@ import GHCup.Types
|
|||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Data.List.NonEmpty
|
import Data.List.NonEmpty
|
||||||
|
import Data.Time.Calendar ( Day(..) )
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
|
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
|
||||||
import Test.QuickCheck.Arbitrary.Generic
|
import Test.QuickCheck.Arbitrary.Generic
|
||||||
@@ -76,6 +77,9 @@ instance Arbitrary Port where
|
|||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
|
instance Arbitrary Day where
|
||||||
|
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
|
||||||
|
|
||||||
instance Arbitrary (URIRef Absolute) where
|
instance Arbitrary (URIRef Absolute) where
|
||||||
arbitrary =
|
arbitrary =
|
||||||
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
|
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
|
||||||
@@ -147,10 +151,6 @@ instance Arbitrary Architecture where
|
|||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
instance Arbitrary VersionDownload where
|
|
||||||
arbitrary = genericArbitrary
|
|
||||||
shrink = genericShrink
|
|
||||||
|
|
||||||
instance Arbitrary VersionInfo where
|
instance Arbitrary VersionInfo where
|
||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
@@ -183,6 +183,10 @@ instance Arbitrary GHCupInfo where
|
|||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
|
instance Arbitrary GHCTargetVersion where
|
||||||
|
arbitrary = GHCTargetVersion Nothing <$> arbitrary
|
||||||
|
shrink = genericShrink
|
||||||
|
|
||||||
|
|
||||||
-- our maps are nested... the default size easily blows up most ppls ram
|
-- our maps are nested... the default size easily blows up most ppls ram
|
||||||
|
|
||||||
@@ -24,7 +24,7 @@ spec = do
|
|||||||
-- https://github.com/haskell/ghcup-hs/issues/415
|
-- https://github.com/haskell/ghcup-hs/issues/415
|
||||||
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
||||||
it "readDirEnt" $ do
|
it "readDirEnt" $ do
|
||||||
dirstream <- liftIO $ openDirStreamPortable "test/data"
|
dirstream <- liftIO $ openDirStreamPortable "test/ghcup-test/data"
|
||||||
(dt1, fp1) <- readDirEntPortable dirstream
|
(dt1, fp1) <- readDirEntPortable dirstream
|
||||||
(dt2, fp2) <- readDirEntPortable dirstream
|
(dt2, fp2) <- readDirEntPortable dirstream
|
||||||
(dt3, fp3) <- readDirEntPortable dirstream
|
(dt3, fp3) <- readDirEntPortable dirstream
|
||||||
@@ -17,6 +17,6 @@ spec = do
|
|||||||
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
|
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
|
||||||
where
|
where
|
||||||
goldenDir
|
goldenDir
|
||||||
| isWindows = "test/golden/windows"
|
| isWindows = "test/ghcup-test/golden/windows"
|
||||||
| otherwise = "test/golden/unix"
|
| otherwise = "test/ghcup-test/golden/unix"
|
||||||
|
|
||||||
18950
test/ghcup-test/golden/unix/GHCupInfo.json
Normal file
18950
test/ghcup-test/golden/unix/GHCupInfo.json
Normal file
File diff suppressed because it is too large
Load Diff
20020
test/ghcup-test/golden/windows/GHCupInfo.json
Normal file
20020
test/ghcup-test/golden/windows/GHCupInfo.json
Normal file
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
49
test/optparse-test/ChangeLogTest.hs
Normal file
49
test/optparse-test/ChangeLogTest.hs
Normal file
@@ -0,0 +1,49 @@
|
|||||||
|
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
|
||||||
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
|
|
||||||
|
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
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 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
|
||||||
|
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 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
|
||||||
190
test/optparse-test/CompileTest.hs
Normal file
190
test/optparse-test/CompileTest.hs
Normal file
@@ -0,0 +1,190 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
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 $ mkVersion' "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 $ mkVersion' "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 $ mkVersion' "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 $ mkVersion' "9.4.5-p1"})
|
||||||
|
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "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 $ mkVersion' "9.4.5")
|
||||||
|
(Left $ mkVersion' "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 $ mkVersion' "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 $ mkVersion' "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 $ mkVersion' "2.0.0.0-p1"})
|
||||||
|
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "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 $ mkVersion' "2.0.0.0")
|
||||||
|
[ghc928]
|
||||||
|
|
||||||
|
ghc928 :: ToolVersion
|
||||||
|
ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8")
|
||||||
|
|
||||||
|
compileParseWith :: [String] -> IO CompileCommand
|
||||||
|
compileParseWith args = do
|
||||||
|
Compile a <- parseWith args
|
||||||
|
pure a
|
||||||
34
test/optparse-test/ConfigTest.hs
Normal file
34
test/optparse-test/ConfigTest.hs
Normal file
@@ -0,0 +1,34 @@
|
|||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
|
module ConfigTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import Test.Tasty.HUnit
|
||||||
|
import GHCup.OptParse
|
||||||
|
import Utils
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import URI.ByteString.QQ
|
||||||
|
|
||||||
|
configTests :: TestTree
|
||||||
|
configTests = testGroup "config" $ map (uncurry check) checkList
|
||||||
|
where
|
||||||
|
check :: String -> ConfigCommand -> TestTree
|
||||||
|
check args expected = testCase args $ do
|
||||||
|
res <- configParseWith (words args)
|
||||||
|
liftIO $ res @?= expected
|
||||||
|
|
||||||
|
checkList :: [(String, ConfigCommand)]
|
||||||
|
checkList =
|
||||||
|
[ ("config", ShowConfig)
|
||||||
|
, ("config init", InitConfig)
|
||||||
|
, ("config show", ShowConfig)
|
||||||
|
, ("config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
||||||
|
, AddReleaseChannel False [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|]
|
||||||
|
)
|
||||||
|
, ("config set cache true", SetConfig "cache" (Just "true"))
|
||||||
|
]
|
||||||
|
|
||||||
|
configParseWith :: [String] -> IO ConfigCommand
|
||||||
|
configParseWith args = do
|
||||||
|
Config a <- parseWith args
|
||||||
|
pure a
|
||||||
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
|
||||||
223
test/optparse-test/InstallTest.hs
Normal file
223
test/optparse-test/InstallTest.hs
Normal file
@@ -0,0 +1,223 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
|
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 (mkVersion $ (Str "head" :| []) :| [])
|
||||||
|
}
|
||||||
|
)
|
||||||
|
: mapSecond
|
||||||
|
(Right . mkInstallOptions)
|
||||||
|
[ ("install ghc-9.2", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "ghc")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
|
||||||
|
)
|
||||||
|
-- invalid
|
||||||
|
, ("install next", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "next" :| []) :| [])
|
||||||
|
)
|
||||||
|
, ("install latest", ToolTag Latest)
|
||||||
|
, ("install nightly", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
)
|
||||||
|
, ("install recommended", ToolTag Recommended)
|
||||||
|
, ("install prerelease", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "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")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
|
||||||
|
)
|
||||||
|
, ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
|
||||||
|
, ("install cabal-3.10", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "cabal")
|
||||||
|
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
)
|
||||||
|
, ("install hls-2.0.0.0", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "hls")
|
||||||
|
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
|
||||||
|
)
|
||||||
|
, ("install stack-2.9.3", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "stack")
|
||||||
|
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
installGhcCheckList :: [(String, Either InstallCommand InstallOptions)]
|
||||||
|
installGhcCheckList =
|
||||||
|
("install ghc", Left $ InstallGHC defaultOptions)
|
||||||
|
: mapSecond (Left . InstallGHC . mkInstallOptions)
|
||||||
|
[ ("install ghc 9.2", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
|
||||||
|
)
|
||||||
|
, ("install ghc next", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "next" :| []) :| [])
|
||||||
|
)
|
||||||
|
, ("install ghc latest", ToolTag Latest)
|
||||||
|
, ("install ghc nightly", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
)
|
||||||
|
, ("install ghc recommended", ToolTag Recommended)
|
||||||
|
, ("install ghc prerelease", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "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")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
|
||||||
|
)
|
||||||
|
, ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
|
||||||
|
, ("install ghc ghc-9.2", GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "ghc")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
|
||||||
|
installCabalCheckList =
|
||||||
|
("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
|
||||||
|
: mapSecond (Left . InstallCabal . mkInstallOptions')
|
||||||
|
[ ("install cabal 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
, ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
|
||||||
|
, ("install cabal latest", ToolTag Latest)
|
||||||
|
, ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
, ("install cabal recommended", ToolTag Recommended)
|
||||||
|
, ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "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
|
||||||
|
$ Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "cabal" :| []) :| []
|
||||||
|
, _vRel = [Digits 3 :| [], Digits 10 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
|
||||||
|
installHlsCheckList =
|
||||||
|
("install hls", Left $ InstallHLS defaultOptions{instSet = True})
|
||||||
|
: mapSecond (Left . InstallHLS . mkInstallOptions')
|
||||||
|
[ ("install hls 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
, ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
|
||||||
|
, ("install hls latest", ToolTag Latest)
|
||||||
|
, ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
, ("install hls recommended", ToolTag Recommended)
|
||||||
|
, ("install hls prerelease", ToolVersion $ mkVersion $ (Str "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
|
||||||
|
$ Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "hls" :| []) :| []
|
||||||
|
, _vRel = [Digits 2 :| [], Digits 0 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
|
||||||
|
installStackCheckList =
|
||||||
|
("install stack", Left $ InstallStack defaultOptions{instSet = True})
|
||||||
|
: mapSecond (Left . InstallStack . mkInstallOptions')
|
||||||
|
[ ("install stack 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
, ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
|
||||||
|
, ("install stack latest", ToolTag Latest)
|
||||||
|
, ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
, ("install stack recommended", ToolTag Recommended)
|
||||||
|
, ("install stack prerelease", ToolVersion $ mkVersion $ (Str "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
|
||||||
|
$ Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "stack" :| []) :| []
|
||||||
|
, _vRel = [Digits 2 :| [], Digits 9 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
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
|
||||||
80
test/optparse-test/RmTest.hs
Normal file
80
test/optparse-test/RmTest.hs
Normal file
@@ -0,0 +1,80 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module RmTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import GHCup.OptParse
|
||||||
|
import Utils
|
||||||
|
import GHCup.Types
|
||||||
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
|
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 (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
|
||||||
|
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
|
||||||
|
]
|
||||||
|
|
||||||
|
rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
|
||||||
|
rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
|
||||||
|
[ -- failed with ("rm ghc", xxx)
|
||||||
|
("rm ghc 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
|
||||||
|
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
|
||||||
|
]
|
||||||
|
|
||||||
|
rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
|
||||||
|
rmCabalCheckList = mapSecond (Left . RmCabal)
|
||||||
|
[ -- failed with ("rm cabal", xxx)
|
||||||
|
("rm cabal 3.10", mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
, ("rm cabal cabal-3.10", Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "cabal" :| []) :| []
|
||||||
|
, _vRel = [Digits 3 :| [], Digits 10 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
|
||||||
|
rmHlsCheckList = mapSecond (Left . RmHLS)
|
||||||
|
[ -- failed with ("rm hls", xxx)
|
||||||
|
("rm hls 2.0", mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
|
||||||
|
, ("rm hls hls-2.0", Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "hls" :| []) :| []
|
||||||
|
, _vRel = [Digits 2 :| [], Digits 0 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
rmStackCheckList :: [(String, Either RmCommand RmOptions)]
|
||||||
|
rmStackCheckList = mapSecond (Left . RmStack)
|
||||||
|
[ -- failed with ("rm stack", xxx)
|
||||||
|
("rm stack 2.9.1", mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 1 :| []])
|
||||||
|
, ("rm stack stack-2.9.1", Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "stack" :| []) :| []
|
||||||
|
, _vRel = [Digits 2 :| [], Digits 9 :| [], Digits 1 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
rmParseWith :: [String] -> IO (Either RmCommand RmOptions)
|
||||||
|
rmParseWith args = do
|
||||||
|
Rm a <- parseWith args
|
||||||
|
pure a
|
||||||
66
test/optparse-test/RunTest.hs
Normal file
66
test/optparse-test/RunTest.hs
Normal file
@@ -0,0 +1,66 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
module RunTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import GHCup.OptParse
|
||||||
|
import Utils
|
||||||
|
import GHCup.Types
|
||||||
|
|
||||||
|
|
||||||
|
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 $ mkVersion' "9.2.8"})
|
||||||
|
, ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
|
||||||
|
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"})
|
||||||
|
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"})
|
||||||
|
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "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 $ mkVersion' "3.10"
|
||||||
|
, runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"
|
||||||
|
, runStackVer = Just $ ToolVersion $ mkVersion' "2.9"
|
||||||
|
, runInstTool' = True
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
runParseWith :: [String] -> IO RunOptions
|
||||||
|
runParseWith args = do
|
||||||
|
Run a <- parseWith args
|
||||||
|
pure a
|
||||||
176
test/optparse-test/SetTest.hs
Normal file
176
test/optparse-test/SetTest.hs
Normal file
@@ -0,0 +1,176 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
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")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
|
||||||
|
)
|
||||||
|
, ("set next", SetNext)
|
||||||
|
, ("set latest", SetToolTag Latest)
|
||||||
|
, ("set nightly", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
)
|
||||||
|
-- different from `set`
|
||||||
|
, ("set recommended", SetToolTag Recommended)
|
||||||
|
, ("set prerelease", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "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")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
|
||||||
|
)
|
||||||
|
, ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
|
||||||
|
, ("set cabal-3.10", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "cabal")
|
||||||
|
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
)
|
||||||
|
, ("set hls-2.0.0.0", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "hls")
|
||||||
|
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
|
||||||
|
)
|
||||||
|
, ("set stack-2.9.3", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "stack")
|
||||||
|
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
setGhcCheckList :: [(String, Either SetCommand SetOptions)]
|
||||||
|
setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
|
||||||
|
[ ("set ghc", SetRecommended)
|
||||||
|
, ("set ghc 9.2", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
|
||||||
|
)
|
||||||
|
, ("set ghc next", SetNext)
|
||||||
|
, ("set ghc latest", SetToolTag Latest)
|
||||||
|
, ("set ghc nightly", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
)
|
||||||
|
, ("set ghc recommended", SetToolTag Recommended)
|
||||||
|
, ("set ghc prerelease", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Str "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")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
|
||||||
|
)
|
||||||
|
, ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
|
||||||
|
, ("set ghc ghc-9.2", SetGHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
(Just "ghc")
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
setCabalCheckList :: [(String, Either SetCommand SetOptions)]
|
||||||
|
setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
|
||||||
|
[ ("set cabal", SetRecommended)
|
||||||
|
, ("set cabal 3.10", SetToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||||
|
, ("set cabal next", SetNext)
|
||||||
|
, ("set cabal latest", SetToolTag Latest)
|
||||||
|
, ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
, ("set cabal recommended", SetToolTag Recommended)
|
||||||
|
, ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "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
|
||||||
|
$ Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "cabal" :| []) :| []
|
||||||
|
, _vRel = [Digits 3 :| [], Digits 10 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
setHlsCheckList :: [(String, Either SetCommand SetOptions)]
|
||||||
|
setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
|
||||||
|
[ ("set hls", SetRecommended)
|
||||||
|
, ("set hls 2.0", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
|
||||||
|
, ("set hls next", SetNext)
|
||||||
|
, ("set hls latest", SetToolTag Latest)
|
||||||
|
, ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
, ("set hls recommended", SetToolTag Recommended)
|
||||||
|
, ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "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
|
||||||
|
$ Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "hls" :| []) :| []
|
||||||
|
, _vRel = [Digits 2 :| [], Digits 0 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
setStackCheckList :: [(String, Either SetCommand SetOptions)]
|
||||||
|
setStackCheckList = mapSecond (Left . SetStack . SetOptions)
|
||||||
|
[ ("set stack", SetRecommended)
|
||||||
|
, ("set stack 2.9", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 9 :| []])
|
||||||
|
, ("set stack next", SetNext)
|
||||||
|
, ("set stack latest", SetToolTag Latest)
|
||||||
|
, ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
|
||||||
|
, ("set stack recommended", SetToolTag Recommended)
|
||||||
|
, ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "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
|
||||||
|
$ Version
|
||||||
|
{ _vEpoch = Nothing
|
||||||
|
, _vChunks = (Str "stack" :| []) :| []
|
||||||
|
, _vRel = [Digits 2 :| [], Digits 9 :| []]
|
||||||
|
, _vMeta = Nothing
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
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)
|
||||||
45
test/optparse-test/Utils.hs
Normal file
45
test/optparse-test/Utils.hs
Normal file
@@ -0,0 +1,45 @@
|
|||||||
|
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
||||||
|
module Utils where
|
||||||
|
|
||||||
|
import GHCup.OptParse as GHCup
|
||||||
|
import Options.Applicative
|
||||||
|
import Data.Bifunctor
|
||||||
|
import Data.Versions
|
||||||
|
import Data.List.NonEmpty (NonEmpty)
|
||||||
|
import Test.Tasty
|
||||||
|
import Test.Tasty.HUnit
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
mkVersion :: NonEmpty VChunk -> Version
|
||||||
|
mkVersion chunks = Version Nothing chunks [] Nothing
|
||||||
|
|
||||||
|
mkVersion' :: T.Text -> Version
|
||||||
|
mkVersion' txt =
|
||||||
|
let Right ver = version txt
|
||||||
|
in ver
|
||||||
|
|
||||||
|
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
|
||||||
40
test/optparse-test/WhereisTest.hs
Normal file
40
test/optparse-test/WhereisTest.hs
Normal file
@@ -0,0 +1,40 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module WhereisTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import GHCup.OptParse
|
||||||
|
import Utils
|
||||||
|
import GHCup.Types
|
||||||
|
|
||||||
|
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 $ mkVersion' "9.2.8"))
|
||||||
|
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") (mkVersion' "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