Compare commits
224 Commits
ghcup-impr
...
v0.1.20.0
| Author | SHA1 | Date | |
|---|---|---|---|
| a5d228ba89 | |||
| a7be1e7068 | |||
| 30a10d871a | |||
| 90b0281c1c | |||
|
|
bba92baeb1 | ||
| e06a1c03d4 | |||
| 0171f2e870 | |||
| da078c7362 | |||
| 94b4b7c455 | |||
| 6aa486594a | |||
| 2c3148abcc | |||
| dde32fa72e | |||
| 675ab17fff | |||
| 9fcacbd96b | |||
| ba4c6e5b99 | |||
| f2b139b58b | |||
| a44bf5884d | |||
| 64c1d63d33 | |||
| 0300d8f2cc | |||
|
|
bb395b652d | ||
| 59bfdd9a30 | |||
| d85accb08e | |||
| c7439d3c89 | |||
| 38cd5ad8ed | |||
| 5fd0fa8d8e | |||
| 452ca8cca2 | |||
| 5f73320b29 | |||
| d14526059b | |||
| b1cde06bd0 | |||
| 0adb602a96 | |||
| f9a2b21cb0 | |||
| e73cf4033e | |||
| 5f0c6f60b8 | |||
| 29c9611152 | |||
| e90ca97441 | |||
| 1fb0387101 | |||
|
|
1981a12e67 | ||
|
|
eae197ccb3 | ||
|
|
15c6ed2b8d | ||
| fbb648d984 | |||
|
|
c914a284de | ||
| 9a17eaa32a | |||
| 480d6be02f | |||
| 3e907bd890 | |||
|
|
d999c3dfbf | ||
| 41d44b037d | |||
| 9d8d6e3293 | |||
|
|
8696a1c710 | ||
| 2f107197d4 | |||
| 486a1bac25 | |||
| a73ce186b5 | |||
| 76204aa366 | |||
| 502f0ea62f | |||
| e7e6663017 | |||
| e27fed09f3 | |||
| 9eeac00714 | |||
| c0ffb22d6a | |||
| f0b145d8dd | |||
| bb700281a3 | |||
|
|
fcdec4ba2c | ||
| 371eda962f | |||
| 50252d8613 | |||
| 78c393a16e | |||
| 9c3478075f | |||
| 7e7c11fda4 | |||
| bff14761ac | |||
| 99ddcc938f | |||
| e2301e2fa7 | |||
| c52096671e | |||
| 64f03a2f18 | |||
|
|
a72b78ef96 | ||
|
|
b17849c258 | ||
| d759535faa | |||
|
|
c25c07aa61 | ||
|
|
5f361e1e0b | ||
|
|
bcb498de20 | ||
|
|
fd6ff9f8ec | ||
|
|
69d311f0b4 | ||
|
|
fde0e712ac | ||
|
|
c60aa767ca | ||
|
|
78df858ba1 | ||
|
|
f1f4d5e836 | ||
|
|
2726e83235 | ||
|
|
f23631054a | ||
|
|
9189f9a65a | ||
|
|
7076472bde | ||
| a2a605ad89 | |||
|
|
8fae9a5083 | ||
|
|
6f07b6a343 | ||
|
|
dfebfc9504 | ||
|
|
36463ebf97 | ||
|
|
f400f43b8c | ||
| a3748507ca | |||
|
|
c92875882a | ||
|
|
2df2e3da40 | ||
|
|
cf1e8659b0 | ||
|
|
fb2e3f2740 | ||
| 578162f461 | |||
|
|
29bc40f65b | ||
|
|
aafb77df7c | ||
|
|
dc1a813305 | ||
|
|
16c7ecabe2 | ||
|
|
e1d8ba869a | ||
|
|
38db038953 | ||
|
|
bcdf2b23f1 | ||
|
|
83b82c328b | ||
| c149ee8d2b | |||
|
|
c10924274d | ||
|
|
e13c5a99af | ||
| 6623e4b1c8 | |||
| 5170baf074 | |||
| d143daeb9a | |||
| 699b183f62 | |||
| 09d72e7c97 | |||
| d551cc8077 | |||
| 4698639da9 | |||
| e67a9c93fe | |||
| 621cc5782b | |||
| 482503ca0a | |||
| 2fb7328a6e | |||
| 06eae56646 | |||
| bdbbeb1040 | |||
| 1eed02c8c7 | |||
| 6d325a1804 | |||
| 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 | ||
|
784942ca58
|
|||
|
75de2a7bc1
|
|||
|
ea6c8d338c
|
|||
|
ae625b181c
|
|||
|
89ae54a083
|
|||
|
1bd73591ba
|
|||
|
f709f6e714
|
|||
|
3d7e07c371
|
|||
|
8bf17379ac
|
|||
|
4b1225ad71
|
|||
|
d628848af6
|
|||
|
48381be001
|
|||
|
b547324253
|
|||
|
2b1599c234
|
|||
|
7ac8989dfc
|
|||
|
cd6666ed30
|
|||
|
5b7478438a
|
|||
|
4a830d9fb7
|
|||
|
785fb895b4
|
|||
|
75e801e9e6
|
|||
|
6ffd5328a4
|
|||
|
ed509e482b
|
|||
|
420323f43b
|
|||
|
432962792c
|
|||
|
cb193f6069
|
|||
|
2f268b6a25
|
|||
|
580606af14
|
|||
|
faa1c3992b
|
|||
|
d17efef853
|
|||
|
179d4dd493
|
|||
|
e03c5ee4a1
|
|||
|
e57a8abd3d
|
|||
|
5fa10390a3
|
|||
|
e1e6f579d5
|
|||
|
72f8e53344
|
|||
|
9c464ec9fc
|
|||
|
1c9b296a5e
|
|||
|
|
275522584e | ||
|
|
804520c4bb | ||
|
|
9d25581f3c | ||
|
|
e798037d80 | ||
|
|
2afe5858cb | ||
|
f575dcdad6
|
|||
|
6cf9967e7c
|
|||
|
15a75d790a
|
|||
|
988672ea75
|
|||
|
6d3e8d65e1
|
|||
|
895e4b3f18
|
|||
|
20f0505120
|
|||
|
31e83cac5e
|
|||
|
|
9baba88f75 | ||
|
d3a1115b99
|
|||
|
6d46849fec
|
|||
|
53e324bfee
|
|||
|
2e39b7b603
|
@@ -1,5 +1,5 @@
|
||||
freebsd_instance:
|
||||
image_family: freebsd-13-1
|
||||
image_family: freebsd-13-2
|
||||
|
||||
build_task:
|
||||
name: build
|
||||
@@ -16,7 +16,9 @@ build_task:
|
||||
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
||||
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
||||
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
||||
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
||||
install_script:
|
||||
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
|
||||
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
||||
script:
|
||||
- tzsetup Etc/GMT
|
||||
- adjkerntz -a
|
||||
|
||||
11
.editorconfig
Normal file
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/bootstrap.sh
vendored
2
.github/scripts/bootstrap.sh
vendored
@@ -13,4 +13,6 @@ git describe --always
|
||||
./scripts/bootstrap/bootstrap-haskell
|
||||
|
||||
[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
|
||||
# https://github.com/actions/runner-images/issues/7061
|
||||
[ "$(ghcup config | grep --color=never meta-mode)" = "meta-mode: Lax" ]
|
||||
|
||||
|
||||
2
.github/scripts/build.sh
vendored
2
.github/scripts/build.sh
vendored
@@ -27,9 +27,11 @@ build_with_cache --project-file=cabal.project.release -w "${GHC}" --enable-tests
|
||||
mkdir -p out
|
||||
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
|
||||
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
|
||||
binary_opttest=$(cabal --project-file=cabal.project.release list-bin ghcup-optparse-test)
|
||||
ver=$("${binary}" --numeric-version)
|
||||
strip_binary "${binary}"
|
||||
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
|
||||
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
|
||||
cp "${binary_opttest}" "out/test-optparse-${ARTIFACT}-${ver}${ext}"
|
||||
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
|
||||
|
||||
|
||||
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)"
|
||||
|
||||
29
.github/scripts/common.sh
vendored
29
.github/scripts/common.sh
vendored
@@ -15,7 +15,7 @@ sync_from() {
|
||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||
fi
|
||||
|
||||
cabal-cache sync-from-archive \
|
||||
cabal-cache.sh sync-from-archive \
|
||||
--host-name-override=${S3_HOST} \
|
||||
--host-port-override=443 \
|
||||
--host-ssl-override=True \
|
||||
@@ -29,7 +29,7 @@ sync_to() {
|
||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||
fi
|
||||
|
||||
cabal-cache sync-to-archive \
|
||||
cabal-cache.sh sync-to-archive \
|
||||
--host-name-override=${S3_HOST} \
|
||||
--host-port-override=443 \
|
||||
--host-ssl-override=True \
|
||||
@@ -115,6 +115,10 @@ download_cabal_cache() {
|
||||
mv "cabal-cache${exe}" "${dest}${exe}"
|
||||
chmod +x "${dest}${exe}"
|
||||
fi
|
||||
|
||||
# install shell wrapper
|
||||
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
|
||||
chmod +x "$HOME"/.local/bin/cabal-cache.sh
|
||||
)
|
||||
}
|
||||
|
||||
@@ -129,6 +133,27 @@ build_with_cache() {
|
||||
}
|
||||
|
||||
install_ghcup() {
|
||||
case "${RUNNER_OS}" in
|
||||
"Linux")
|
||||
case "${ARCH}" in
|
||||
"ARM"*)
|
||||
if command -v ghcup ; then
|
||||
mkdir -p "$GHCUP_BIN"
|
||||
cp "$(command -v ghcup)" "$GHCUP_BIN/ghcup${ext}"
|
||||
else
|
||||
install_ghcup_curl_sh
|
||||
fi
|
||||
;;
|
||||
*) install_ghcup_curl_sh
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
*) install_ghcup_curl_sh
|
||||
;;
|
||||
esac
|
||||
}
|
||||
|
||||
install_ghcup_curl_sh() {
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes 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 ]
|
||||
|
||||
49
.github/scripts/test.sh
vendored
49
.github/scripts/test.sh
vendored
@@ -18,8 +18,10 @@ mkdir -p "${GHCUP_BIN}"
|
||||
|
||||
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
|
||||
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
|
||||
cp "out/test-optparse-${ARTIFACT}"-* "ghcup-test-optparse${ext}"
|
||||
chmod +x "$GHCUP_BIN/ghcup${ext}"
|
||||
chmod +x "ghcup-test${ext}"
|
||||
chmod +x "ghcup-test-optparse${ext}"
|
||||
|
||||
"$GHCUP_BIN/ghcup${ext}" --version
|
||||
eghcup --version
|
||||
@@ -28,31 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
|
||||
|
||||
### Haskell test suite
|
||||
|
||||
./ghcup-test${ext}
|
||||
rm ghcup-test${ext}
|
||||
./"ghcup-test${ext}"
|
||||
./"ghcup-test-optparse${ext}"
|
||||
rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VER}
|
||||
eghcup unset ghc ${GHC_VER}
|
||||
ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
|
||||
[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
|
||||
[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
|
||||
[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
|
||||
eghcup set ghc ${GHC_VER}
|
||||
eghcup install cabal ${CABAL_VER}
|
||||
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
|
||||
eghcup install ghc "${GHC_VER}"
|
||||
eghcup unset ghc "${GHC_VER}"
|
||||
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
|
||||
[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
|
||||
[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
|
||||
[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
|
||||
eghcup set ghc "${GHC_VER}"
|
||||
eghcup install cabal "${CABAL_VER}"
|
||||
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
|
||||
eghcup unset cabal
|
||||
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
||||
|
||||
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
||||
[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
|
||||
eghcup set cabal ${CABAL_VER}
|
||||
[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
|
||||
eghcup set cabal "${CABAL_VER}"
|
||||
|
||||
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
|
||||
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
|
||||
|
||||
if [ "${OS}" != "FreeBSD" ] ; then
|
||||
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
|
||||
@@ -82,10 +85,10 @@ eghcup list -t cabal
|
||||
|
||||
ghc_ver=$(ghc --numeric-version)
|
||||
ghc --version
|
||||
ghc-${ghc_ver} --version
|
||||
"ghc-${ghc_ver}" --version
|
||||
if [ "${OS}" != "Windows" ] ; then
|
||||
ghci --version
|
||||
ghci-${ghc_ver} --version
|
||||
"ghci-${ghc_ver}" --version
|
||||
fi
|
||||
|
||||
|
||||
@@ -129,11 +132,11 @@ else
|
||||
eghcup --offline set 8.10.3
|
||||
eghcup set 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
||||
eghcup set ${GHC_VER}
|
||||
eghcup set "${GHC_VER}"
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup unset ghc
|
||||
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
|
||||
eghcup set ${GHC_VER}
|
||||
eghcup set "${GHC_VER}"
|
||||
eghcup --offline rm 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
@@ -166,10 +169,10 @@ fi
|
||||
# check that lazy loading works for 'whereis'
|
||||
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
eghcup whereis ghc $(ghc --numeric-version)
|
||||
eghcup whereis ghc "$(ghc --numeric-version)"
|
||||
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
|
||||
eghcup rm $(ghc --numeric-version)
|
||||
eghcup rm "$(ghc --numeric-version)"
|
||||
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
|
||||
if [ "${OS}" = "Linux" ] ; then
|
||||
@@ -183,14 +186,14 @@ eghcup gc -c
|
||||
|
||||
# test etags
|
||||
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
|
||||
raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
|
||||
# snapshot yaml and etags file
|
||||
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
# invalidate access time timer, which is 5minutes, so we re-download
|
||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
# redownload same file with some newlines added
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
|
||||
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
|
||||
# snapshot new yaml and etags file
|
||||
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
@@ -200,7 +203,7 @@ sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
# invalidate access time timer, which is 5minutes, but don't expect a re-download
|
||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
# this time, we expect the same hash and etag
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
|
||||
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
|
||||
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
[ "${etag2}" = "${etag3}" ]
|
||||
|
||||
7
.github/workflows/bootstrap.yaml
vendored
7
.github/workflows/bootstrap.yaml
vendored
@@ -25,7 +25,7 @@ jobs:
|
||||
include:
|
||||
- os: ubuntu-latest
|
||||
DISTRO: Ubuntu
|
||||
- os: macOS-10.15
|
||||
- os: macOS-11
|
||||
DISTRO: na
|
||||
- os: windows-latest
|
||||
DISTRO: na
|
||||
@@ -51,5 +51,8 @@ jobs:
|
||||
|
||||
- if: runner.os == 'Windows'
|
||||
name: Run bootstrap
|
||||
run: ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ${GITHUB_WORKSPACE}/bootstrap-haskell -InBash
|
||||
run: |
|
||||
$curDir = Get-Location
|
||||
Write-Host "Current Working Directory: $curDir"
|
||||
./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash
|
||||
shell: pwsh
|
||||
|
||||
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
|
||||
|
||||
26
.github/workflows/docker.yaml
vendored
26
.github/workflows/docker.yaml
vendored
@@ -53,7 +53,7 @@ jobs:
|
||||
platforms: linux/amd64
|
||||
|
||||
docker-arm32:
|
||||
runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
|
||||
runs-on: [self-hosted, Linux, ARM64]
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
name: Cleanup (aarch64 linux)
|
||||
@@ -72,10 +72,18 @@ jobs:
|
||||
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
||||
password: ${{ secrets.DOCKERHUB_TOKEN }}
|
||||
|
||||
- name: Build and push
|
||||
- name: Build and push (debian buster)
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm32v7
|
||||
context: ./docker/arm32v7/buster
|
||||
push: true
|
||||
tags: hasufell/arm32v7-debian-haskell:10
|
||||
platforms: linux/arm
|
||||
|
||||
- name: Build and push (ubuntu focal)
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm32v7/focal
|
||||
push: true
|
||||
tags: hasufell/arm32v7-ubuntu-haskell:focal
|
||||
platforms: linux/arm
|
||||
@@ -100,10 +108,18 @@ jobs:
|
||||
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
||||
password: ${{ secrets.DOCKERHUB_TOKEN }}
|
||||
|
||||
- name: Build and push
|
||||
- name: Build and push (debian buster)
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm64v8/
|
||||
context: ./docker/arm64v8/buster
|
||||
push: true
|
||||
tags: hasufell/arm64v8-debian-haskell:10
|
||||
platforms: linux/arm64
|
||||
|
||||
- name: Build and push (ubuntu focal)
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm64v8/focal
|
||||
push: true
|
||||
tags: hasufell/arm64v8-ubuntu-haskell:focal
|
||||
platforms: linux/arm64
|
||||
|
||||
48
.github/workflows/release.yaml
vendored
48
.github/workflows/release.yaml
vendored
@@ -12,12 +12,16 @@ on:
|
||||
schedule:
|
||||
- cron: '0 2 * * *'
|
||||
|
||||
env:
|
||||
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
|
||||
CABAL_CACHE_NONFATAL: yes
|
||||
|
||||
jobs:
|
||||
build-linux:
|
||||
name: Build linux binary
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.8.1.0
|
||||
CABAL_VER: 3.10.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||
@@ -81,7 +85,7 @@ jobs:
|
||||
name: Build ARM binary
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.8.1.0
|
||||
CABAL_VER: 3.10.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||
@@ -90,16 +94,16 @@ jobs:
|
||||
fail-fast: true
|
||||
matrix:
|
||||
include:
|
||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
||||
- os: [self-hosted, Linux, ARM64]
|
||||
ARTIFACT: "armv7-linux-ghcup"
|
||||
GHC_VER: 9.2.2
|
||||
ARCH: ARM
|
||||
- os: [self-hosted, Linux, ARM64]
|
||||
ARTIFACT: "aarch64-linux-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
GHC_VER: 9.2.6
|
||||
ARCH: ARM64
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
- uses: docker://arm64v8/debian:10
|
||||
name: Cleanup (aarch64 linux)
|
||||
with:
|
||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||
@@ -115,7 +119,7 @@ jobs:
|
||||
submodules: 'true'
|
||||
|
||||
- if: matrix.ARCH == 'ARM'
|
||||
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
||||
uses: docker://hasufell/arm32v7-debian-haskell:10
|
||||
name: Run build (armv7 linux)
|
||||
with:
|
||||
args: sh .github/scripts/build.sh
|
||||
@@ -129,7 +133,7 @@ jobs:
|
||||
S3_HOST: ${{ env.S3_HOST }}
|
||||
|
||||
- if: matrix.ARCH == 'ARM64'
|
||||
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
||||
uses: docker://hasufell/arm64v8-debian-haskell:10
|
||||
name: Run build (aarch64 linux)
|
||||
with:
|
||||
args: sh .github/scripts/build.sh
|
||||
@@ -154,7 +158,7 @@ jobs:
|
||||
name: Build binary (Mac/Win)
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.8.1.0
|
||||
CABAL_VER: 3.10.1.0
|
||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||
JSON_VERSION: "0.0.7"
|
||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||
@@ -166,11 +170,11 @@ jobs:
|
||||
include:
|
||||
- os: [self-hosted, macOS, ARM64]
|
||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
GHC_VER: 9.2.6
|
||||
ARCH: ARM64
|
||||
- os: macOS-10.15
|
||||
- os: macOS-11
|
||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
GHC_VER: 9.2.6
|
||||
ARCH: 64
|
||||
- os: windows-latest
|
||||
ARTIFACT: "x86_64-mingw64-ghcup"
|
||||
@@ -247,7 +251,7 @@ jobs:
|
||||
needs: "build-linux"
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.8.1.0
|
||||
CABAL_VER: 3.10.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
strategy:
|
||||
matrix:
|
||||
@@ -325,24 +329,24 @@ jobs:
|
||||
needs: "build-arm"
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.8.1.0
|
||||
CABAL_VER: 3.10.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
||||
- os: [self-hosted, Linux, ARM64]
|
||||
ARTIFACT: "armv7-linux-ghcup"
|
||||
GHC_VER: 9.2.2
|
||||
ARCH: ARM
|
||||
DISTRO: Ubuntu
|
||||
- os: [self-hosted, Linux, ARM64]
|
||||
ARTIFACT: "aarch64-linux-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
GHC_VER: 9.2.6
|
||||
ARCH: ARM64
|
||||
DISTRO: Ubuntu
|
||||
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
- uses: docker://arm64v8/debian:10
|
||||
name: Cleanup (aarch64 linux)
|
||||
with:
|
||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||
@@ -358,7 +362,7 @@ jobs:
|
||||
path: ./out
|
||||
|
||||
- if: matrix.ARCH == 'ARM'
|
||||
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
||||
uses: docker://hasufell/arm32v7-debian-haskell:10
|
||||
name: Run test (armv7 linux)
|
||||
with:
|
||||
args: sh .github/scripts/test.sh
|
||||
@@ -369,7 +373,7 @@ jobs:
|
||||
DISTRO: Ubuntu
|
||||
|
||||
- if: matrix.ARCH == 'ARM64'
|
||||
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
||||
uses: docker://hasufell/arm64v8-debian-haskell:10
|
||||
name: Run test (aarch64 linux)
|
||||
with:
|
||||
args: sh .github/scripts/test.sh
|
||||
@@ -392,7 +396,7 @@ jobs:
|
||||
needs: "build-macwin"
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.8.1.0
|
||||
CABAL_VER: 3.10.1.0
|
||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||
JSON_VERSION: "0.0.7"
|
||||
strategy:
|
||||
@@ -400,12 +404,12 @@ jobs:
|
||||
include:
|
||||
- os: [self-hosted, macOS, ARM64]
|
||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
GHC_VER: 9.2.6
|
||||
ARCH: ARM64
|
||||
DISTRO: na
|
||||
- os: macOS-10.15
|
||||
- os: macOS-11
|
||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
GHC_VER: 9.2.6
|
||||
ARCH: 64
|
||||
DISTRO: na
|
||||
- os: windows-latest
|
||||
|
||||
2
.gitmodules
vendored
2
.gitmodules
vendored
@@ -1,4 +1,4 @@
|
||||
[submodule "data/metadata"]
|
||||
path = data/metadata
|
||||
url = https://github.com/haskell/ghcup-metadata.git
|
||||
branch = master
|
||||
branch = develop
|
||||
|
||||
42
CHANGELOG.md
42
CHANGELOG.md
@@ -1,5 +1,47 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.20.0 -- 2023-11-10
|
||||
|
||||
### New features
|
||||
|
||||
* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
|
||||
* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
|
||||
* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
|
||||
- you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
|
||||
|
||||
### Improvements and bug fixes
|
||||
|
||||
* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
|
||||
* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
|
||||
* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
|
||||
* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
|
||||
|
||||
## 0.1.19.4 -- 2023-7-02
|
||||
|
||||
* fix missing TUI for aarch64 linux binaries
|
||||
|
||||
## 0.1.19.3 -- 2023-6-29
|
||||
|
||||
* Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824)
|
||||
* Fix GC with XDG dirs, fixes [#810](https://github.com/haskell/ghcup-hs/issues/810)
|
||||
|
||||
## 0.1.19.2 -- 2023-2-24
|
||||
|
||||
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)
|
||||
- the previous release had a bug that invalidated that broke it
|
||||
* Implement 'latest-prerelease' tag wrt [#788](https://github.com/haskell/ghcup-hs/issues/788)
|
||||
* Fix 'Could not parse version of stray directory.DS_Store' warnings on macOs wrt [#797](https://github.com/haskell/ghcup-hs/issues/797)
|
||||
|
||||
## 0.1.19.1 -- 2023-2-19
|
||||
|
||||
* Fix GHCup on JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#766](https://github.com/haskell/ghcup-hs/issues/766)
|
||||
* Don't fail on setModificationTime, fixes [#784](https://github.com/haskell/ghcup-hs/issues/784) and many GitHub actions issues
|
||||
* Make armv7/aarch64 linux binaries more portable (built on Debian buster)
|
||||
* Improve usability on 'ghcup config add-release-channel', fixes [#751](https://github.com/haskell/ghcup-hs/issues/751)
|
||||
* Make version shortcuts work with 'ghcup set', fixes [#757](https://github.com/haskell/ghcup-hs/issues/757)
|
||||
* Don't implicitly smuggle in config options in `ghcup config set` wrt [#775](https://github.com/haskell/ghcup-hs/issues/775)
|
||||
* Fix build on unix with -ftui
|
||||
|
||||
## 0.1.19.0 -- 2023-1-13
|
||||
|
||||
* restore proper support for FreeBSD and Linux armv7
|
||||
|
||||
@@ -4,18 +4,20 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
|
||||
module BrickMain where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Types.Optics ( getDirs, getPlatformReq )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.OptParse.Common (logGHCPostRm)
|
||||
import GHCup.Prelude ( decUTF8Safe )
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
@@ -29,6 +31,7 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||
, listAttr
|
||||
)
|
||||
import Codec.Archive
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -44,10 +47,9 @@ import Data.IORef
|
||||
import Data.Vector ( Vector
|
||||
, (!?)
|
||||
)
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.FilePath
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
@@ -59,9 +61,34 @@ import qualified Data.Text.Lazy as L
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
import System.Environment (getExecutablePath)
|
||||
#if !IS_WINDOWS
|
||||
import GHCup.Prelude.File
|
||||
import System.FilePath
|
||||
import qualified System.Posix.Process as SPP
|
||||
#endif
|
||||
|
||||
|
||||
installedSign :: String
|
||||
#if IS_WINDOWS
|
||||
installedSign = "I "
|
||||
#else
|
||||
installedSign = "✓ "
|
||||
#endif
|
||||
|
||||
setSign :: String
|
||||
#if IS_WINDOWS
|
||||
setSign = "IS"
|
||||
#else
|
||||
setSign = "✔✔"
|
||||
#endif
|
||||
|
||||
notInstalledSign :: String
|
||||
#if IS_WINDOWS
|
||||
notInstalledSign = "X "
|
||||
#else
|
||||
notInstalledSign = "✗ "
|
||||
#endif
|
||||
|
||||
hiddenTools :: [Tool]
|
||||
hiddenTools = []
|
||||
|
||||
@@ -72,8 +99,8 @@ data BrickData = BrickData
|
||||
deriving Show
|
||||
|
||||
data BrickSettings = BrickSettings
|
||||
{ showAllVersions :: Bool
|
||||
, showAllTools :: Bool
|
||||
{ showAllVersions :: Bool
|
||||
, showAllTools :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@@ -93,7 +120,7 @@ data BrickState = BrickState
|
||||
|
||||
|
||||
keyHandlers :: KeyBindings
|
||||
-> [ ( Vty.Key
|
||||
-> [ ( KeyCombination
|
||||
, BrickSettings -> String
|
||||
, BrickState -> EventM String BrickState ()
|
||||
)
|
||||
@@ -130,6 +157,9 @@ showKey Vty.KUp = "↑"
|
||||
showKey Vty.KDown = "↓"
|
||||
showKey key = tail (show key)
|
||||
|
||||
showMod :: Vty.Modifier -> String
|
||||
showMod = tail . show
|
||||
|
||||
|
||||
ui :: AttrMap -> BrickState -> Widget String
|
||||
ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
@@ -146,7 +176,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
. txtWrap
|
||||
. T.pack
|
||||
. foldr1 (\x y -> x <> " " <> y)
|
||||
. fmap (\(key, s, _) -> showKey key <> ":" <> s as)
|
||||
. fmap (\(KeyCombination key mods, s, _) -> intercalate "+" (showKey key : (showMod <$> mods)) <> ":" <> s as)
|
||||
$ keyHandlers appKeys
|
||||
header =
|
||||
minHSize 2 emptyWidget
|
||||
@@ -154,12 +184,15 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
<+> minHSize 15 (str "Version")
|
||||
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
|
||||
<+> padLeft (Pad 5) (str "Notes")
|
||||
renderList' = withDefAttr listAttr . drawListElements renderItem True
|
||||
renderItem _ b listResult@ListResult{..} =
|
||||
renderList' bis@BrickInternalState{..} =
|
||||
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
|
||||
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
|
||||
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
|
||||
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
|
||||
let marks = if
|
||||
| lSet -> (withAttr (attrName "set") $ str "✔✔")
|
||||
| lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str "✗ ")
|
||||
| lSet -> (withAttr (attrName "set") $ str setSign)
|
||||
| lInstalled -> (withAttr (attrName "installed") $ str installedSign)
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str notInstalledSign)
|
||||
ver = case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
@@ -170,7 +203,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
= updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
|
||||
| otherwise = id
|
||||
hooray
|
||||
| elem Latest lTag && not lInstalled =
|
||||
| elem Latest lTag' && not lInstalled =
|
||||
withAttr (attrName "hooray")
|
||||
| otherwise = id
|
||||
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
|
||||
@@ -180,9 +213,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
( minHSize 6
|
||||
(printTool lTool)
|
||||
)
|
||||
<+> minHSize 15 (str ver)
|
||||
<+> (let l = catMaybes . fmap printTag $ sort lTag
|
||||
in padLeft (Pad 1) $ minHSize 25 $ if null l
|
||||
<+> minHSize minVerSize (str ver)
|
||||
<+> (let l = catMaybes . fmap printTag $ sort lTag'
|
||||
in padLeft (Pad 1) $ minHSize minTagSize $ if null l
|
||||
then emptyWidget
|
||||
else foldr1 (\x y -> x <+> str "," <+> y) l
|
||||
)
|
||||
@@ -198,8 +231,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
|
||||
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
|
||||
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
|
||||
printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly"
|
||||
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
printTag Old = Nothing
|
||||
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
|
||||
printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly"
|
||||
printTag (UnknownTag t) = Just $ str t
|
||||
|
||||
printTool Cabal = str "cabal"
|
||||
@@ -211,8 +247,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
printNotes ListResult {..} =
|
||||
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
|
||||
)
|
||||
++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
|
||||
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
|
||||
++ (case lReleaseDay of
|
||||
Nothing -> mempty
|
||||
Just d -> [withAttr (attrName "day") $ str (show d)])
|
||||
|
||||
-- | Draws the list elements.
|
||||
--
|
||||
@@ -267,18 +305,22 @@ app attrs dimAttrs =
|
||||
defaultAttributes :: Bool -> AttrMap
|
||||
defaultAttributes no_color = attrMap
|
||||
Vty.defAttr
|
||||
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
|
||||
, (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
||||
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
||||
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
|
||||
, (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
||||
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
||||
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||
]
|
||||
where
|
||||
withForeColor | no_color = const
|
||||
@@ -308,12 +350,12 @@ eventHandler st@BrickState{..} ev = do
|
||||
(MouseDown _ Vty.BScrollDown _ _) ->
|
||||
put (BrickState { appState = moveCursor 1 appState Down, .. })
|
||||
(VtyEvent (Vty.EvResize _ _)) -> put st
|
||||
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
|
||||
(VtyEvent (Vty.EvKey Vty.KUp [])) ->
|
||||
put BrickState{ appState = moveCursor 1 appState Up, .. }
|
||||
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
|
||||
(VtyEvent (Vty.EvKey Vty.KDown [])) ->
|
||||
put BrickState{ appState = moveCursor 1 appState Down, .. }
|
||||
(VtyEvent (Vty.EvKey key _)) ->
|
||||
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
|
||||
(VtyEvent (Vty.EvKey key mods)) ->
|
||||
case find (\(keyCombo, _, _) -> keyCombo == KeyCombination key mods) (keyHandlers kb) of
|
||||
Nothing -> put st
|
||||
Just (_, _, handler) -> handler st
|
||||
_ -> put st
|
||||
@@ -405,17 +447,21 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
|
||||
filterVisible v t e | lInstalled e = True
|
||||
| v
|
||||
, not t
|
||||
, Nightly `notElem` lTag e
|
||||
, lTool e `notElem` hiddenTools = True
|
||||
| not v
|
||||
, t
|
||||
, Old `notElem` lTag e = True
|
||||
, Old `notElem` lTag e
|
||||
, Nightly `notElem` lTag e = True
|
||||
| v
|
||||
, Nightly `notElem` lTag e
|
||||
, t = True
|
||||
| otherwise = (Old `notElem` lTag e) &&
|
||||
| otherwise = (Old `notElem` lTag e) &&
|
||||
(Nightly `notElem` lTag e) &&
|
||||
(lTool e `notElem` hiddenTools)
|
||||
|
||||
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
@@ -446,6 +492,11 @@ install' _ (_, ListResult {..}) = do
|
||||
, ToolShadowed
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
run (do
|
||||
@@ -454,19 +505,19 @@ install' _ (_, ListResult {..}) = do
|
||||
dirs <- lift getDirs
|
||||
case lTool of
|
||||
GHC -> do
|
||||
let vi = getVersionInfo lVer GHC dls
|
||||
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
|
||||
let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
|
||||
liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
|
||||
Cabal -> do
|
||||
let vi = getVersionInfo lVer Cabal dls
|
||||
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
|
||||
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
|
||||
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
Stack -> do
|
||||
let vi = getVersionInfo lVer Stack dls
|
||||
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
|
||||
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
)
|
||||
>>= \case
|
||||
@@ -474,12 +525,15 @@ install' _ (_, ListResult {..}) = do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
#if !IS_WINDOWS
|
||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
|
||||
when ((normalise <$> up) == Just (normalise ce)) $
|
||||
-- TODO: track cli arguments of previous invocation
|
||||
liftIO $ SPP.executeFile ce False ["tui"] Nothing
|
||||
#else
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
#endif
|
||||
_ -> pure ()
|
||||
pure $ Right ()
|
||||
VRight (vi, _, _) -> do
|
||||
@@ -492,7 +546,7 @@ install' _ (_, ListResult {..}) = do
|
||||
<> "Also check the logs in ~/.ghcup/logs"
|
||||
|
||||
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
@@ -547,7 +601,7 @@ del' _ (_, ListResult {..}) = do
|
||||
let run = runE @'[NotInstalled, UninstallFailed]
|
||||
|
||||
run (do
|
||||
let vi = getVersionInfo lVer lTool dls
|
||||
let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
|
||||
case lTool of
|
||||
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
|
||||
Cabal -> liftE $ rmCabalVer lVer $> vi
|
||||
@@ -557,7 +611,7 @@ del' _ (_, ListResult {..}) = do
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
logGHCPostRm (mkTVer lVer)
|
||||
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
@@ -570,7 +624,7 @@ changelog' :: (MonadReader AppState m, MonadIO m)
|
||||
-> m (Either String ())
|
||||
changelog' _ (_, ListResult {..}) = do
|
||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
case getChangeLog dls lTool (Left lVer) of
|
||||
case getChangeLog dls lTool (ToolVersion lVer) of
|
||||
Nothing -> pure $ Left $
|
||||
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
|
||||
Just uri -> do
|
||||
@@ -634,8 +688,10 @@ getGHCupInfo = do
|
||||
|
||||
r <-
|
||||
flip runReaderT settings
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE getDownloadsF
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
|
||||
$ do
|
||||
pfreq <- lift getPlatformReq
|
||||
liftE $ getDownloadsF pfreq
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
@@ -650,5 +706,5 @@ getAppData mgi = runExceptT $ do
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
flip runReaderT settings $ do
|
||||
lV <- listVersions Nothing Nothing
|
||||
lV <- listVersions Nothing [] False True (Nothing, Nothing)
|
||||
pure $ BrickData (reverse lV)
|
||||
|
||||
@@ -42,7 +42,6 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions
|
||||
import GHC.IO.Encoding
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Language.Haskell.TH
|
||||
@@ -63,7 +62,7 @@ import qualified GHCup.Types as Types
|
||||
|
||||
|
||||
|
||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
||||
toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
|
||||
toSettings options = do
|
||||
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
||||
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
||||
@@ -73,7 +72,7 @@ toSettings options = do
|
||||
pure defaultUserSettings
|
||||
_ -> do
|
||||
die "Unexpected error!"
|
||||
pure $ mergeConf options userConf noColor
|
||||
pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
|
||||
where
|
||||
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
||||
mergeConf Options{..} UserSettings{..} noColor =
|
||||
@@ -85,7 +84,7 @@ toSettings options = do
|
||||
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
||||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
|
||||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
|
||||
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
|
||||
urlSource = fromMaybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) optUrlSource
|
||||
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
||||
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
||||
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
||||
@@ -176,7 +175,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
-- create ~/.ghcup dir
|
||||
ensureDirectories dirs
|
||||
|
||||
(settings, keybindings) <- toSettings opt
|
||||
(settings, keybindings, userConf) <- toSettings opt
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- runReaderT initGHCupFileLogging dirs
|
||||
@@ -211,10 +210,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <-
|
||||
( flip runReaderT leanAppstate
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE getDownloadsF
|
||||
)
|
||||
( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do
|
||||
liftE $ getDownloadsF pfreq
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
@@ -240,7 +238,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
_
|
||||
| Just False <- optVerbose -> pure ()
|
||||
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
||||
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
||||
newTools <- lift checkForUpdates
|
||||
forM_ newTools $ \newTool@(t, l) -> do
|
||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
||||
@@ -249,7 +247,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
case t of
|
||||
GHCup -> runLogger $
|
||||
logWarn ("New GHCup version available: "
|
||||
<> prettyVer l
|
||||
<> tVerToText l
|
||||
<> ". To upgrade, run 'ghcup upgrade'")
|
||||
_ -> runLogger $
|
||||
logWarn ("New "
|
||||
@@ -258,7 +256,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
<> "If you want to install this latest version, run 'ghcup install "
|
||||
<> T.pack (prettyShow t)
|
||||
<> " "
|
||||
<> prettyVer l
|
||||
<> tVerToText l
|
||||
<> "'")
|
||||
Just _ -> pure ()
|
||||
|
||||
@@ -303,7 +301,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||
DInfo -> dinfo runAppState runLogger
|
||||
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
||||
Config configCommand -> config configCommand settings keybindings runLogger
|
||||
Config configCommand -> config configCommand settings userConf keybindings runLogger
|
||||
Whereis whereisOptions
|
||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
||||
@@ -332,17 +330,18 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Command
|
||||
-> (Tool, Version)
|
||||
-> (Tool, GHCTargetVersion)
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m Bool
|
||||
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
|
||||
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
|
||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
||||
@@ -367,12 +366,14 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
=> Tool
|
||||
-> Maybe ToolVersion
|
||||
-> Version
|
||||
-> GHCTargetVersion
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m Bool
|
||||
cmp' tool instVer ver = do
|
||||
(v, _) <- liftE $ fromVersion instVer tool
|
||||
pure (v == mkTVer ver)
|
||||
pure (v == ver)
|
||||
|
||||
|
||||
@@ -8,6 +8,11 @@ package ghcup
|
||||
constraints: http-io-streams -brotli,
|
||||
any.aeson >= 2.0.1.0
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/fosskers/versions.git
|
||||
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
@@ -23,3 +28,5 @@ package aeson
|
||||
package streamly
|
||||
flags: +use-unliftio
|
||||
|
||||
package *
|
||||
test-show-details: direct
|
||||
|
||||
@@ -4,30 +4,26 @@ optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
if os(linux)
|
||||
package ghcup
|
||||
flags: +tui
|
||||
if arch(x86_64) || arch(i386)
|
||||
package *
|
||||
ghc-options: -split-sections -optl-static
|
||||
elif os(darwin)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static
|
||||
package ghcup
|
||||
flags: +tui
|
||||
elif os(mingw32)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static,
|
||||
text -simdutf
|
||||
package ghcup
|
||||
flags: -tui
|
||||
text -simdutf,
|
||||
vty-windows >=0.1.0.3
|
||||
elif os(freebsd)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
zip +disable-zstd
|
||||
package *
|
||||
ghc-options: -split-sections -pgmc clang++14
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.aeson >= 2.0.1.0,
|
||||
|
||||
@@ -16,6 +16,11 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
|
||||
# TUI key bindings,
|
||||
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
|
||||
# for possible values.
|
||||
# It's also possible to define key+modifier, e.g.:
|
||||
# quit:
|
||||
# Key:
|
||||
# KChar: c
|
||||
# Mods: [MCtrl]
|
||||
key-bindings:
|
||||
up:
|
||||
KUp: []
|
||||
@@ -46,41 +51,45 @@ meta-cache: 300 # in seconds
|
||||
# 2. Strict: fail hard
|
||||
meta-mode: Lax # Strict | Lax
|
||||
|
||||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
||||
# check the 'URLSource' type in the code.
|
||||
# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
|
||||
# union over tool versions, preferring the later entries.
|
||||
url-source:
|
||||
## Use the internal download uri, this is the default
|
||||
GHCupURL: []
|
||||
- GHCupURL
|
||||
|
||||
## Example 1: Read download info from this location instead
|
||||
## Accepts file/http/https scheme
|
||||
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
|
||||
## which case they are merged right-biased (overwriting duplicate versions).
|
||||
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
|
||||
## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata)
|
||||
# - StackSetupURL
|
||||
|
||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
|
||||
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
|
||||
# AddSource:
|
||||
# Left:
|
||||
# globalTools: {}
|
||||
# toolRequirements: {}
|
||||
# ghcupDownloads:
|
||||
# GHC:
|
||||
# 9.10.2:
|
||||
# viTags: []
|
||||
# viArch:
|
||||
# A_64:
|
||||
# Linux_UnknownLinux:
|
||||
# unknown_versioning:
|
||||
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
|
||||
# dlSubdir: ghc-7.10.3
|
||||
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
|
||||
## Add pre-release channel
|
||||
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||
## Add nightly channel
|
||||
# - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
|
||||
## Add cross compiler channel
|
||||
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
|
||||
|
||||
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
|
||||
## versions).
|
||||
# AddSource:
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
||||
## Use dwarf bindist for 9.4.7 for ghcup metadata
|
||||
# - ghcup-info:
|
||||
# ghcupDownloads:
|
||||
# GHC:
|
||||
# 9.4.7:
|
||||
# viTags: []
|
||||
# viArch:
|
||||
# A_64:
|
||||
# Linux_UnknownLinux:
|
||||
# unknown_versioning:
|
||||
# dlUri: https://downloads.haskell.org/ghc/9.4.7/ghc-9.4.7-x86_64-deb10-linux-dwarf.tar.xz
|
||||
# dlSubdir:
|
||||
# RegexDir: "ghc-.*"
|
||||
# dlHash: b261b3438ba455e3cf757f9c8dc3a06fdc061ea8ec287a65b7809e25fe18bad4
|
||||
|
||||
## for stack metadata and the linux64-tinfo6 bindists, use static alpine for 9.8.1
|
||||
# - setup-info:
|
||||
# ghc:
|
||||
# linux64-tinfo6:
|
||||
# 9.8.1:
|
||||
# url: "https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-alpine3_12-linux-static.tar.xz"
|
||||
# content-length: 229037440
|
||||
# sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3
|
||||
|
||||
# This is a way to override platform detection, e.g. when you're running
|
||||
# a Ubuntu derivate based on 18.04, you could do:
|
||||
|
||||
Submodule data/metadata updated: 9e14e6c736...2efadd4588
@@ -37,8 +37,8 @@ RUN apk add --no-cache \
|
||||
xz-dev \
|
||||
ncurses-static
|
||||
|
||||
ARG GHCUP_VERSION=0.1.18.0
|
||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
||||
ARG GHCUP_VERSION=0.1.19.4
|
||||
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
|
||||
# install ghcup
|
||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||
|
||||
@@ -37,8 +37,9 @@ RUN apk add --no-cache \
|
||||
xz-dev \
|
||||
ncurses-static
|
||||
|
||||
ARG GHCUP_VERSION=0.1.18.0
|
||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
||||
ARG GHCUP_VERSION=0.1.19.4
|
||||
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
|
||||
|
||||
# install ghcup
|
||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||
|
||||
61
docker/arm32v7/buster/Dockerfile
Normal file
61
docker/arm32v7/buster/Dockerfile
Normal file
@@ -0,0 +1,61 @@
|
||||
FROM arm32v7/debian:10
|
||||
|
||||
ENV LANG C.UTF-8
|
||||
ENV DEBIAN_FRONTEND=noninteractive
|
||||
ENV TZ=Asia/Singapore
|
||||
|
||||
COPY update_opt.sh /usr/bin/update_opt.sh
|
||||
RUN chmod +x /usr/bin/update_opt.sh
|
||||
|
||||
RUN apt-get update && \
|
||||
apt-get install -y --no-install-recommends \
|
||||
ca-certificates \
|
||||
curl \
|
||||
dirmngr \
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libsqlite3-dev \
|
||||
libtinfo-dev \
|
||||
libgmp-dev \
|
||||
make \
|
||||
netbase \
|
||||
openssh-client \
|
||||
xz-utils \
|
||||
zlib1g-dev \
|
||||
libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
|
||||
llvm-11 clang-11 && \
|
||||
rm -rf /var/lib/apt/lists/*
|
||||
|
||||
RUN update_opt.sh 11 1
|
||||
|
||||
ARG GHCUP_VERSION=0.1.19.4
|
||||
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
|
||||
# install ghcup
|
||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/armv7-linux-ghcup-$GHCUP_VERSION && \
|
||||
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
|
||||
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
|
||||
gpg --verify SHA256SUMS.sig SHA256SUMS && \
|
||||
sha256sum -c --ignore-missing SHA256SUMS && \
|
||||
mv armv7-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
|
||||
chmod +x /usr/bin/ghcup && \
|
||||
rm -rf SHA256SUMS SHA256SUMS.sig
|
||||
|
||||
ARG GHC=8.10.7
|
||||
ARG CABAL_INSTALL=3.6.2.0
|
||||
ARG STACK=2.9.1
|
||||
|
||||
ENV GHCUP_CURL_OPTS="--silent"
|
||||
ENV NO_COLOR=1
|
||||
|
||||
# install haskell toolchain
|
||||
RUN ghcup config set gpg-setting GPGStrict && \
|
||||
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
||||
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
|
||||
ghcup gc -s -c -t
|
||||
|
||||
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
|
||||
|
||||
CMD ["ghci"]
|
||||
@@ -29,8 +29,8 @@ RUN apt-get update && \
|
||||
|
||||
RUN update_opt.sh 9 1
|
||||
|
||||
ARG GHCUP_VERSION=0.1.17.8
|
||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
||||
ARG GHCUP_VERSION=0.1.19.4
|
||||
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
|
||||
# install ghcup
|
||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||
@@ -54,10 +54,7 @@ ENV NO_COLOR=1
|
||||
RUN ghcup config set gpg-setting GPGStrict && \
|
||||
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
||||
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
|
||||
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
|
||||
rm -r "/usr/share/doc/ghc-${GHC}" && \
|
||||
rm -rf /tmp/ghcup* && \
|
||||
ghcup gc -p -s -c -t
|
||||
ghcup gc -s -c -t
|
||||
|
||||
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
|
||||
|
||||
61
docker/arm64v8/buster/Dockerfile
Normal file
61
docker/arm64v8/buster/Dockerfile
Normal file
@@ -0,0 +1,61 @@
|
||||
FROM arm64v8/debian:10
|
||||
|
||||
ENV LANG C.UTF-8
|
||||
ENV DEBIAN_FRONTEND=noninteractive
|
||||
ENV TZ=Asia/Singapore
|
||||
|
||||
COPY update_opt.sh /usr/bin/update_opt.sh
|
||||
RUN chmod +x /usr/bin/update_opt.sh
|
||||
|
||||
RUN apt-get update && \
|
||||
apt-get install -y --no-install-recommends \
|
||||
ca-certificates \
|
||||
curl \
|
||||
dirmngr \
|
||||
g++ \
|
||||
git \
|
||||
gnupg \
|
||||
libsqlite3-dev \
|
||||
libtinfo-dev \
|
||||
libgmp-dev \
|
||||
make \
|
||||
netbase \
|
||||
openssh-client \
|
||||
xz-utils \
|
||||
zlib1g-dev \
|
||||
libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
|
||||
llvm-11 clang-11 && \
|
||||
rm -rf /var/lib/apt/lists/*
|
||||
|
||||
RUN update_opt.sh 11 1
|
||||
|
||||
ARG GHCUP_VERSION=0.1.19.4
|
||||
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
|
||||
# install ghcup
|
||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/aarch64-linux-ghcup-$GHCUP_VERSION && \
|
||||
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
|
||||
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
|
||||
gpg --verify SHA256SUMS.sig SHA256SUMS && \
|
||||
sha256sum -c --ignore-missing SHA256SUMS && \
|
||||
mv aarch64-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
|
||||
chmod +x /usr/bin/ghcup && \
|
||||
rm -rf SHA256SUMS SHA256SUMS.sig
|
||||
|
||||
ARG GHC=8.10.7
|
||||
ARG CABAL_INSTALL=3.6.2.0
|
||||
ARG STACK=2.9.1
|
||||
|
||||
ENV GHCUP_CURL_OPTS="--silent"
|
||||
ENV NO_COLOR=1
|
||||
|
||||
# install haskell toolchain
|
||||
RUN ghcup config set gpg-setting GPGStrict && \
|
||||
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
||||
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
|
||||
ghcup gc -s -c -t
|
||||
|
||||
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
|
||||
|
||||
CMD ["ghci"]
|
||||
36
docker/arm64v8/buster/update_opt.sh
Executable file
36
docker/arm64v8/buster/update_opt.sh
Executable file
@@ -0,0 +1,36 @@
|
||||
#!/bin/bash
|
||||
# update_alternatives.sh
|
||||
|
||||
update_alternatives() {
|
||||
local version=${1}
|
||||
local priority=${2}
|
||||
local master=${3}
|
||||
local slaves=${4}
|
||||
local path=${5}
|
||||
local cmdln
|
||||
|
||||
cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
|
||||
for slave in ${slaves}; do
|
||||
cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
|
||||
done
|
||||
update-alternatives ${cmdln}
|
||||
}
|
||||
|
||||
if [[ ${#} -ne 2 ]]; then
|
||||
echo usage: "${0}" clang_version priority
|
||||
exit 1
|
||||
fi
|
||||
|
||||
version=${1}
|
||||
priority=${2}
|
||||
path="/usr/bin/"
|
||||
|
||||
master="llvm-config"
|
||||
slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
|
||||
|
||||
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
|
||||
|
||||
master="clang"
|
||||
slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
|
||||
|
||||
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
|
||||
@@ -29,8 +29,8 @@ RUN apt-get update && \
|
||||
|
||||
RUN update_opt.sh 9 1
|
||||
|
||||
ARG GHCUP_VERSION=0.1.18.0
|
||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
||||
ARG GHCUP_VERSION=0.1.19.4
|
||||
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
|
||||
# install ghcup
|
||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||
@@ -54,10 +54,7 @@ ENV NO_COLOR=1
|
||||
RUN ghcup config set gpg-setting GPGStrict && \
|
||||
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
||||
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
|
||||
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
|
||||
rm -r "/usr/share/doc/ghc-${GHC}" && \
|
||||
rm -rf /tmp/ghcup* && \
|
||||
ghcup gc -p -s -c -t
|
||||
ghcup gc -s -c -t
|
||||
|
||||
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
|
||||
|
||||
36
docker/arm64v8/focal/update_opt.sh
Executable file
36
docker/arm64v8/focal/update_opt.sh
Executable file
@@ -0,0 +1,36 @@
|
||||
#!/bin/bash
|
||||
# update_alternatives.sh
|
||||
|
||||
update_alternatives() {
|
||||
local version=${1}
|
||||
local priority=${2}
|
||||
local master=${3}
|
||||
local slaves=${4}
|
||||
local path=${5}
|
||||
local cmdln
|
||||
|
||||
cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
|
||||
for slave in ${slaves}; do
|
||||
cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
|
||||
done
|
||||
update-alternatives ${cmdln}
|
||||
}
|
||||
|
||||
if [[ ${#} -ne 2 ]]; then
|
||||
echo usage: "${0}" clang_version priority
|
||||
exit 1
|
||||
fi
|
||||
|
||||
version=${1}
|
||||
priority=${2}
|
||||
path="/usr/bin/"
|
||||
|
||||
master="llvm-config"
|
||||
slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
|
||||
|
||||
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
|
||||
|
||||
master="clang"
|
||||
slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
|
||||
|
||||
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
|
||||
134
docs/guide.md
134
docs/guide.md
@@ -43,6 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
|
||||
|
||||
If the argument is omitted, the default is `recommended`.
|
||||
|
||||
Other tags include:
|
||||
|
||||
- `prerelease`: a prerelease version
|
||||
- `latest-prerelease`: the latest prerelease version
|
||||
|
||||
|
||||
## Manpages
|
||||
|
||||
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
|
||||
@@ -89,7 +95,7 @@ platform-override:
|
||||
|
||||
This is the complete list of env variables that change GHCup behavior:
|
||||
|
||||
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
|
||||
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
|
||||
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
|
||||
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
|
||||
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
|
||||
@@ -147,8 +153,7 @@ To use a mirror, set the following option in `~/.ghcup/config.yaml`:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
# Accepts file/http/https scheme
|
||||
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
|
||||
- https://some-url/ghcup-0.0.6.yaml
|
||||
```
|
||||
|
||||
See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
|
||||
@@ -163,6 +168,7 @@ ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
|
||||
#### Known mirrors
|
||||
|
||||
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
|
||||
2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
|
||||
|
||||
### (Pre-)Release channels
|
||||
|
||||
@@ -177,8 +183,8 @@ This will result in `~/.ghcup/config.yaml` to contain this record:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
AddSource:
|
||||
- Right: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||
- GHCupURL
|
||||
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||
```
|
||||
|
||||
You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
|
||||
@@ -188,14 +194,13 @@ To remove the channel, delete the entire `url-source` section or set it back to
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
GHCupURL: []
|
||||
- GHCupURL
|
||||
```
|
||||
|
||||
If you want to combine your release channel with a mirror, you'd do it like so:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
OwnSource:
|
||||
# base metadata
|
||||
- "https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml"
|
||||
# prerelease channel
|
||||
@@ -207,17 +212,7 @@ url-source:
|
||||
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
||||
GHC versions there are two strategies.
|
||||
|
||||
### Strategy 1: System GHC (works on all stack versions)
|
||||
|
||||
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
|
||||
run the following commands:
|
||||
|
||||
```sh
|
||||
stack config set install-ghc false --global
|
||||
stack config set system-ghc true --global
|
||||
```
|
||||
|
||||
### Strategy 2: Stack hooks (new, recommended)
|
||||
### Strategy 1: Stack hooks (new, recommended)
|
||||
|
||||
Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
|
||||
|
||||
@@ -239,6 +234,61 @@ stack config set system-ghc false --global
|
||||
By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
|
||||
this, run `stack config set install-ghc false --global`.
|
||||
|
||||
### Strategy 2: System GHC (works on all stack versions)
|
||||
|
||||
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
|
||||
run the following commands:
|
||||
|
||||
```sh
|
||||
stack config set install-ghc false --global
|
||||
stack config set system-ghc true --global
|
||||
```
|
||||
|
||||
### Using stack's setup-info metadata to install GHC
|
||||
|
||||
You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
|
||||
to install GHC. For that, you can invoke ghcup like so as a shorthand:
|
||||
|
||||
```sh
|
||||
# ghcup will only see GHC now
|
||||
ghcup -s StackSetupURL install ghc 9.4.7
|
||||
# this combines both ghcup and stack metadata
|
||||
ghcup -s '["GHCupURL", "StackSetupURL"]' install ghc 9.4.7
|
||||
```
|
||||
|
||||
To make this permanent and combine it with the GHCup metadata, you can add the following to your `~/.ghcup/config.yaml`:
|
||||
|
||||
```yaml
|
||||
url-source:
|
||||
- GHCupURL
|
||||
# stack versions take precedence
|
||||
# you'll still have access to GHCup provided versions and tools in case they don't exist in stack metadata
|
||||
- StackSetupURL
|
||||
```
|
||||
|
||||
You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:
|
||||
|
||||
```yaml
|
||||
url-source:
|
||||
- GHCupURL
|
||||
- StackSetupURL
|
||||
- setup-info:
|
||||
ghc:
|
||||
linux64-tinfo6:
|
||||
9.4.7:
|
||||
url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
|
||||
content-length: 179117892
|
||||
sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
|
||||
```
|
||||
|
||||
#### Caveats
|
||||
|
||||
The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
|
||||
when you try to install HLS.
|
||||
|
||||
Another potential usability issue is that the `latest` and `recommended` shorthands won't work anymore, since
|
||||
Stack metadata doesn't have a concept of those and we don't try to be smart when combining the metadatas.
|
||||
|
||||
### Windows
|
||||
|
||||
On windows, you may find the following config options useful too:
|
||||
@@ -449,8 +499,48 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
|
||||
|
||||
### github workflows
|
||||
|
||||
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
|
||||
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
|
||||
On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
|
||||
Here's an example workflow with a GHC matrix:
|
||||
|
||||
```yaml
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
fail-fast: true
|
||||
matrix:
|
||||
os: [ubuntu-22.04, macOS-latest]
|
||||
ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- name: Setup toolchain
|
||||
run: |
|
||||
ghcup install cabal --set recommended
|
||||
ghcup install ghc --set ${{ matrix.ghc }}
|
||||
- name: Build
|
||||
run: |
|
||||
cabal update
|
||||
cabal test all --test-show-details=direct
|
||||
|
||||
i386:
|
||||
runs-on: ubuntu-latest
|
||||
container:
|
||||
image: i386/ubuntu:bionic
|
||||
steps:
|
||||
- name: Install GHCup in container
|
||||
run: |
|
||||
apt-get update -y
|
||||
apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
|
||||
# we just go with recommended versions of cabal and GHC
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
|
||||
- uses: actions/checkout@v1
|
||||
- name: Test
|
||||
run: |
|
||||
# in containers we need to fix PATH
|
||||
source ~/.ghcup/env
|
||||
cabal update
|
||||
cabal test all --test-show-details=direct
|
||||
```
|
||||
|
||||
## GPG verification
|
||||
|
||||
@@ -460,8 +550,10 @@ this is cryptographically secure.
|
||||
First, obtain the gpg keys:
|
||||
|
||||
```sh
|
||||
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
|
||||
```
|
||||
|
||||
Then verify the gpg key in one of these ways:
|
||||
|
||||
@@ -4,10 +4,6 @@ hide:
|
||||
- toc
|
||||
---
|
||||
|
||||
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
|
||||
<script src="javascripts/extra.js"></script>
|
||||
|
||||
|
||||
<section class="index-ghcup-hero">
|
||||
<img alt="haskell logo" src="./haskell_logo.png" />
|
||||
<h1>GHCup</h1>
|
||||
@@ -84,9 +80,6 @@ hide:
|
||||
</span>
|
||||
</p>
|
||||
|
||||
<script type="text/javascript" src="javascripts/ghcup.js"></script>
|
||||
|
||||
|
||||
----
|
||||
|
||||
|
||||
|
||||
117
docs/install.md
117
docs/install.md
@@ -38,47 +38,85 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
|
||||
|
||||
### Linux Debian
|
||||
|
||||
#### Generic
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 11 && <= 12
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 12
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
### Linux Ubuntu
|
||||
|
||||
#### Generic
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 20.04 && < 20.10
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 20.10 && < 23
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||
|
||||
#### Version >= 23
|
||||
|
||||
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
|
||||
|
||||
### Linux Fedora
|
||||
|
||||
#### Generic
|
||||
|
||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
||||
|
||||
### Linux Mageia
|
||||
|
||||
The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
|
||||
|
||||
### Linux CentOS
|
||||
|
||||
#### Generic
|
||||
|
||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
||||
|
||||
#### Version >= 7 && < 8
|
||||
|
||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses xz perl`
|
||||
|
||||
|
||||
### Linux Alpine
|
||||
|
||||
#### Generic
|
||||
|
||||
The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
|
||||
|
||||
### Linux VoidLinux
|
||||
|
||||
The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
|
||||
|
||||
### Linux (generic)
|
||||
|
||||
#### Generic
|
||||
|
||||
You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
|
||||
|
||||
### Darwin
|
||||
|
||||
#### Generic
|
||||
|
||||
On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
|
||||
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
|
||||
|
||||
### FreeBSD
|
||||
|
||||
#### Generic
|
||||
|
||||
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
|
||||
|
||||
|
||||
### Windows
|
||||
|
||||
#### Generic
|
||||
|
||||
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
|
||||
|
||||
## Next steps
|
||||
@@ -102,10 +140,21 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
||||
<table>
|
||||
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
|
||||
<tr><td>9.8.1</td><td><span style="color:blue">latest</span>, base-4.19.0.0</td></tr>
|
||||
<tr><td>9.6.3</td><td>base-4.18.1.0</td></tr>
|
||||
<tr><td>9.6.2</td><td>base-4.18.0.0</td></tr>
|
||||
<tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
|
||||
<tr><td>9.4.7</td><td><span style="color:green">recommended</span>, base-4.17.2.0</td></tr>
|
||||
<tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
|
||||
<tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
|
||||
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
|
||||
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
|
||||
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
|
||||
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
|
||||
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
|
||||
<tr><td>9.2.8</td><td>base-4.16.4.0</td></tr>
|
||||
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
|
||||
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
|
||||
<tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
|
||||
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
|
||||
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
|
||||
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
|
||||
@@ -143,7 +192,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
||||
<table>
|
||||
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>3.10.2.0</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>3.10.1.0</td><td></td></tr>
|
||||
<tr><td>3.8.1.0</td><td></td></tr>
|
||||
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>3.6.0.0</td><td></td></tr>
|
||||
<tr><td>3.4.1.0</td><td></td></tr>
|
||||
@@ -159,7 +210,16 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
||||
<table>
|
||||
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.3.0.0</td><td></td></tr>
|
||||
<tr><td>2.2.0.0</td><td></td></tr>
|
||||
<tr><td>2.1.0.0</td><td></td></tr>
|
||||
<tr><td>2.0.0.1</td><td></td></tr>
|
||||
<tr><td>2.0.0.0</td><td></td></tr>
|
||||
<tr><td>1.10.0.0</td><td></td></tr>
|
||||
<tr><td>1.9.1.0</td><td></td></tr>
|
||||
<tr><td>1.9.0.0</td><td></td></tr>
|
||||
<tr><td>1.8.0.0</td><td></td></tr>
|
||||
<tr><td>1.7.0.0</td><td></td></tr>
|
||||
<tr><td>1.6.1.0</td><td></td></tr>
|
||||
<tr><td>1.6.0.0</td><td></td></tr>
|
||||
@@ -177,7 +237,10 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
||||
<table>
|
||||
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.13.1</td><td><span style="color:blue">latest</span></td></tr>
|
||||
<tr><td>2.11.1</td><td><span style="color:green">recommended</span></td></tr>
|
||||
<tr><td>2.9.3</td><td></td></tr>
|
||||
<tr><td>2.9.1</td><td></td></tr>
|
||||
<tr><td>2.7.5</td><td></td></tr>
|
||||
<tr><td>2.7.3</td><td></td></tr>
|
||||
<tr><td>2.7.1</td><td></td></tr>
|
||||
@@ -190,7 +253,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
||||
|
||||
This list may not be exhaustive and specifies support for bindists only.
|
||||
|
||||
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
|
||||
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
|
||||
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
|
||||
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
@@ -231,8 +294,9 @@ There are various issues with GHC itself.
|
||||
|
||||
### FreeBSD
|
||||
|
||||
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
|
||||
Lacks some upstream bindists and may need compat libs (such as `misc/compat12x`).
|
||||
HLS bindists are experimental.
|
||||
Only latest FreeBSD is generally supported.
|
||||
|
||||
### Linux ARMv7/AARCH64
|
||||
|
||||
@@ -245,7 +309,14 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
|
||||
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
|
||||
and place it into your `PATH` anywhere.
|
||||
|
||||
If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
|
||||
If you want to GPG verify the binaries, import the following keys first:
|
||||
|
||||
```sh
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
|
||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
|
||||
```
|
||||
|
||||
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
|
||||
|
||||
@@ -307,6 +378,24 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
|
||||
|
||||
All set. You can run `cabal init` now in an empty directory to start a project.
|
||||
|
||||
## Esoteric distros
|
||||
|
||||
### Void Linux
|
||||
|
||||
Since void linux can be installed with glibc and musl, it's hard to support correctly with ghcup.
|
||||
One way to make ghcup work on **Void Linux musl** is to follow the [Overriding distro detection](../guide/#overriding-distro-detection)
|
||||
section and tell it to consider Alpine bindists only. E.g.:
|
||||
|
||||
```sh
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
||||
source ~/.ghcup/env
|
||||
ghcup config set platform-override '{ "arch": "A_64", "platform": { "contents": "Alpine", "tag": "Linux" }, "version": "3.17" }'
|
||||
ghcup install cabal --set latest
|
||||
ghcup install ghc --set latest
|
||||
ghcup install stack --set latest
|
||||
ghcup install hls --set latest
|
||||
```
|
||||
|
||||
## Vim integration
|
||||
|
||||
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
||||
|
||||
@@ -1,201 +0,0 @@
|
||||
<!DOCTYPE html>
|
||||
<html lang="{{ config.theme.locale|default('en') }}">
|
||||
<head>
|
||||
{%- block site_meta %}
|
||||
<meta charset="utf-8">
|
||||
<meta http-equiv="X-UA-Compatible" content="IE=edge">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
{% if page and page.is_homepage %}<meta name="description" content="{{ config['site_description'] }}">{% endif %}
|
||||
{% if config.site_author %}<meta name="author" content="{{ config.site_author }}">{% endif %}
|
||||
{% if page and page.canonical_url %}<link rel="canonical" href="{{ page.canonical_url }}">{% endif %}
|
||||
{% if config.site_favicon %}<link rel="shortcut icon" href="{{ config.site_favicon|url }}">
|
||||
{% else %}<link rel="shortcut icon" href="{{ 'img/favicon.ico'|url }}">{% endif %}
|
||||
{%- endblock %}
|
||||
|
||||
{%- block htmltitle %}
|
||||
<title>{% if page and page.title and not page.is_homepage %}{{ page.title }} - {% endif %}{{ config.site_name }}</title>
|
||||
{%- endblock %}
|
||||
|
||||
{%- block styles %}
|
||||
<link href="{{ 'css/bootstrap.min.css'|url }}" rel="stylesheet">
|
||||
<link href="{{ 'css/font-awesome.min.css'|url }}" rel="stylesheet">
|
||||
<link href="{{ 'css/base.css'|url }}" rel="stylesheet">
|
||||
{%- if config.theme.highlightjs %}
|
||||
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/styles/{{ config.theme.hljs_style }}.min.css">
|
||||
{%- endif %}
|
||||
{%- for path in extra_css %}
|
||||
<link href="{{ path }}" rel="stylesheet">
|
||||
{%- endfor %}
|
||||
{%- endblock %}
|
||||
|
||||
{%- block libs %}
|
||||
|
||||
<script src="{{ 'js/jquery-1.10.2.min.js'|url }}" defer></script>
|
||||
<script src="{{ 'js/bootstrap.min.js'|url }}" defer></script>
|
||||
{%- if config.theme.highlightjs %}
|
||||
<script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/highlight.min.js"></script>
|
||||
{%- for lang in config.theme.hljs_languages %}
|
||||
<script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/languages/{{lang}}.min.js"></script>
|
||||
{%- endfor %}
|
||||
<script>hljs.initHighlightingOnLoad();</script>
|
||||
{%- endif %}
|
||||
{%- endblock %}
|
||||
|
||||
{%- block analytics %}
|
||||
{%- if config.theme.analytics.gtag %}
|
||||
<script async src="https://www.googletagmanager.com/gtag/js?id={{ config.theme.analytics.gtag }}"></script>
|
||||
<script>
|
||||
window.dataLayer = window.dataLayer || [];
|
||||
function gtag(){dataLayer.push(arguments);}
|
||||
gtag('js', new Date());
|
||||
|
||||
gtag('config', '{{ config.theme.analytics.gtag }}');
|
||||
</script>
|
||||
{%- elif config.google_analytics %}
|
||||
<script>
|
||||
(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
|
||||
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
|
||||
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
|
||||
})(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
|
||||
|
||||
ga('create', '{{ config.google_analytics[0] }}', '{{ config.google_analytics[1] }}');
|
||||
ga('send', 'pageview');
|
||||
</script>
|
||||
{%- endif %}
|
||||
{%- endblock %}
|
||||
|
||||
{%- block extrahead %} {% endblock %}
|
||||
</head>
|
||||
|
||||
<body{% if page and page.is_homepage %} class="homepage"{% endif %}>
|
||||
<div class="navbar fixed-top navbar-expand-lg navbar-{% if config.theme.nav_style == "light" %}light{% else %}dark{% endif %} bg-{{ config.theme.nav_style }}">
|
||||
<div class="container">
|
||||
|
||||
{%- block site_name %}
|
||||
<a class="navbar-brand" href="{{ nav.homepage.url|url }}">{{ config.site_name }}</a>
|
||||
{%- endblock %}
|
||||
|
||||
{%- if nav|length>1 or (page and (page.next_page or page.previous_page)) or config.repo_url %}
|
||||
<!-- Expander button -->
|
||||
<button type="button" class="navbar-toggler" data-toggle="collapse" data-target="#navbar-collapse">
|
||||
<span class="navbar-toggler-icon"></span>
|
||||
</button>
|
||||
{%- endif %}
|
||||
|
||||
<!-- Expanded navigation -->
|
||||
<div id="navbar-collapse" class="navbar-collapse collapse">
|
||||
{%- block site_nav %}
|
||||
{%- if nav|length>1 %}
|
||||
<!-- Main navigation -->
|
||||
<ul class="nav navbar-nav">
|
||||
{%- for nav_item in nav %}
|
||||
{%- if nav_item.children %}
|
||||
<li class="dropdown{% if nav_item.active %} active{% endif %}">
|
||||
<a href="#" class="nav-link dropdown-toggle" data-toggle="dropdown">{{ nav_item.title }} <b class="caret"></b></a>
|
||||
<ul class="dropdown-menu">
|
||||
{%- for nav_item in nav_item.children %}
|
||||
{% include "nav-sub.html" %}
|
||||
{%- endfor %}
|
||||
</ul>
|
||||
</li>
|
||||
{%- else %}
|
||||
<li class="navitem{% if nav_item.active %} active{% endif %}">
|
||||
<a href="{{ nav_item.url|url }}" class="nav-link">{{ nav_item.title }}</a>
|
||||
</li>
|
||||
{%- endif %}
|
||||
{%- endfor %}
|
||||
</ul>
|
||||
{%- endif %}
|
||||
{%- endblock %}
|
||||
|
||||
<ul class="nav navbar-nav ml-auto">
|
||||
{%- block search_button %}
|
||||
{%- if 'search' in config['plugins'] %}
|
||||
<li class="nav-item">
|
||||
<a href="#" class="nav-link" data-toggle="modal" data-target="#mkdocs_search_modal">
|
||||
<i class="fa fa-search"></i> {% trans %}Search{% endtrans %}
|
||||
</a>
|
||||
</li>
|
||||
{%- endif %}
|
||||
{%- endblock %}
|
||||
|
||||
{%- block next_prev %}
|
||||
{%- endblock %}
|
||||
|
||||
{%- block repo %}
|
||||
{%- if page and page.edit_url %}
|
||||
<li class="nav-item">
|
||||
<a href="{{ page.edit_url }}" class="nav-link">
|
||||
{%- if config.repo_name == 'GitHub' -%}
|
||||
<i class="fa fa-github"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
|
||||
{%- elif config.repo_name == 'Bitbucket' -%}
|
||||
<i class="fa fa-bitbucket"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
|
||||
{%- elif config.repo_name == 'GitLab' -%}
|
||||
<i class="fa fa-gitlab"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
|
||||
{%- else -%}
|
||||
{% trans repo_name=config.repo_name%}Edit on {{ repo_name }}{% endtrans %}
|
||||
{%- endif -%}
|
||||
</a>
|
||||
</li>
|
||||
{%- elif config.repo_url %}
|
||||
<li class="nav-item">
|
||||
<a href="{{ config.repo_url }}" class="nav-link">
|
||||
{%- if config.repo_name == 'GitHub' -%}
|
||||
<i class="fa fa-github"></i> {{ config.repo_name }}
|
||||
{%- elif config.repo_name == 'Bitbucket' -%}
|
||||
<i class="fa fa-bitbucket"></i> {{ config.repo_name }}
|
||||
{%- elif config.repo_name == 'GitLab' -%}
|
||||
<i class="fa fa-gitlab"></i> {{ config.repo_name }}
|
||||
{%- else -%}
|
||||
{{ config.repo_name }}
|
||||
{%- endif -%}
|
||||
</a>
|
||||
</li>
|
||||
{%- endif %}
|
||||
{%- endblock %}
|
||||
</ul>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<div class="container">
|
||||
<div class="row">
|
||||
{%- block content %}
|
||||
<div class="col-md-3">{% include "toc.html" %}</div>
|
||||
<div class="col-md-9" role="main">{% include "content.html" %}</div>
|
||||
{%- endblock %}
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<footer class="col-md-12">
|
||||
{%- block footer %}
|
||||
<hr>
|
||||
{%- if config.copyright %}
|
||||
<p>{{ config.copyright }}</p>
|
||||
{%- endif %}
|
||||
<p>{% trans mkdocs_link='<a href="https://www.mkdocs.org/">MkDocs</a>' %}Documentation built with {{ mkdocs_link }}.{% endtrans %}</p>
|
||||
{%- endblock %}
|
||||
</footer>
|
||||
|
||||
{%- block scripts %}
|
||||
<script>
|
||||
var base_url = {{ base_url | tojson }},
|
||||
shortcuts = {{ config.theme.shortcuts | tojson }};
|
||||
</script>
|
||||
<script src="{{ 'js/base.js'|url }}" defer></script>
|
||||
{%- for path in extra_javascript %}
|
||||
<script src="{{ path }}" defer></script>
|
||||
{%- endfor %}
|
||||
{%- endblock %}
|
||||
|
||||
{% if 'search' in config['plugins'] %}{%- include "search-modal.html" %}{% endif %}
|
||||
{%- include "keyboard-modal.html" %}
|
||||
|
||||
</body>
|
||||
</html>
|
||||
{% if page and page.is_homepage %}
|
||||
<!--
|
||||
MkDocs version : {{ mkdocs_version }}
|
||||
Build Date UTC : {{ build_date_utc }}
|
||||
-->
|
||||
{% endif %}
|
||||
BIN
docs/overrides/img/favicon.ico
Normal file
BIN
docs/overrides/img/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.2 KiB |
4
docs/overrides/main.html
Normal file
4
docs/overrides/main.html
Normal file
@@ -0,0 +1,4 @@
|
||||
{% extends "base.html" %}
|
||||
<!-- Get rid of the next/prev buttons -->
|
||||
{% block next_prev %}
|
||||
{% endblock %}
|
||||
@@ -328,7 +328,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
|
||||
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
|
||||
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
|
||||
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
|
||||
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a>
|
||||
<a href="https://play.haskell.org/" class="btn btn-primary" role="button">Online playground</a>
|
||||
</div>
|
||||
|
||||
## How to learn Haskell proper
|
||||
|
||||
186
ghcup.cabal
186
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 2.4
|
||||
name: ghcup
|
||||
version: 0.1.19.0
|
||||
version: 0.1.20.0
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@@ -25,10 +25,10 @@ extra-source-files:
|
||||
cbits/dirutils.h
|
||||
data/build_mk/cross
|
||||
data/build_mk/default
|
||||
test/data/dir/.keep
|
||||
test/data/file
|
||||
test/golden/unix/GHCupInfo.json
|
||||
test/golden/windows/GHCupInfo.json
|
||||
test/ghcup-test/data/dir/.keep
|
||||
test/ghcup-test/data/file
|
||||
test/ghcup-test/golden/unix/GHCupInfo.json
|
||||
test/ghcup-test/golden/windows/GHCupInfo.json
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@@ -36,7 +36,7 @@ source-repository head
|
||||
|
||||
flag tui
|
||||
description:
|
||||
Build the brick powered tui (ghcup tui). This is disabled on windows.
|
||||
Build the brick powered tui (ghcup tui).
|
||||
|
||||
default: False
|
||||
manual: True
|
||||
@@ -53,6 +53,43 @@ flag no-exe
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
common app-common-depends
|
||||
build-depends:
|
||||
, aeson >=1.4
|
||||
, aeson-pretty ^>=0.8.8
|
||||
, async ^>=2.2.3
|
||||
, base >=4.12 && <5
|
||||
, bytestring >=0.10 && <0.12
|
||||
, cabal-install-parsers >=0.4.5
|
||||
, cabal-plan ^>=0.7.2
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.18
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, process ^>=1.6.11.0
|
||||
, resourcet ^>=1.2.2
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, tagsoup ^>=0.14
|
||||
, template-haskell >=2.7 && <2.20
|
||||
, temporary ^>=1.3
|
||||
, text ^>=2.0
|
||||
, time >=1.9.3 && <1.12
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.3 && <6.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
GHCup
|
||||
@@ -80,7 +117,9 @@ library
|
||||
GHCup.Types
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.JSON.Utils
|
||||
GHCup.Types.JSON.Versions
|
||||
GHCup.Types.Optics
|
||||
GHCup.Types.Stack
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Version
|
||||
@@ -137,7 +176,7 @@ library
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, regex-posix ^>=0.96
|
||||
, resourcet ^>=1.2.2
|
||||
, retry ^>=0.8.1.2
|
||||
, retry >=0.8.1.2 && <0.10
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, split ^>=0.2.3.4
|
||||
@@ -146,13 +185,13 @@ library
|
||||
, template-haskell >=2.7 && <2.20
|
||||
, temporary ^>=1.3
|
||||
, text ^>=2.0
|
||||
, time ^>=1.9.3
|
||||
, time >=1.9.3 && <1.12
|
||||
, transformers ^>=0.5
|
||||
, unliftio-core ^>=0.2.0.1
|
||||
, unordered-containers ^>=0.2.10.0
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.3 && <6.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml-streamly ^>=0.12.0
|
||||
, zlib ^>=0.6.2.2
|
||||
@@ -197,13 +236,13 @@ library
|
||||
, unix ^>=2.7
|
||||
, unix-bytestring ^>=0.3.7.3
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
build-depends: vty ^>=5.37
|
||||
build-depends: vty ^>=6.0
|
||||
|
||||
executable ghcup
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
library ghcup-optparse
|
||||
import: app-common-depends
|
||||
exposed-modules:
|
||||
GHCup.OptParse
|
||||
GHCup.OptParse.ChangeLog
|
||||
GHCup.OptParse.Common
|
||||
@@ -224,6 +263,40 @@ executable ghcup
|
||||
GHCup.OptParse.Upgrade
|
||||
GHCup.OptParse.Whereis
|
||||
|
||||
hs-source-dirs: lib-opt
|
||||
default-language: Haskell2010
|
||||
default-extensions:
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
PackageImports
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StrictData
|
||||
TupleSections
|
||||
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
build-depends: ghcup
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
else
|
||||
build-depends: unix ^>=2.7
|
||||
|
||||
executable ghcup
|
||||
import: app-common-depends
|
||||
main-is: Main.hs
|
||||
|
||||
hs-source-dirs: app/ghcup
|
||||
default-language: Haskell2010
|
||||
default-extensions:
|
||||
@@ -241,52 +314,19 @@ executable ghcup
|
||||
-fwarn-incomplete-record-updates -threaded
|
||||
|
||||
build-depends:
|
||||
, aeson >=1.4
|
||||
, aeson-pretty ^>=0.8.8
|
||||
, async ^>=2.2.3
|
||||
, base >=4.12 && <5
|
||||
, bytestring >=0.10 && <0.12
|
||||
, cabal-install-parsers >=0.4.5
|
||||
, cabal-plan ^>=0.7.2
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.18
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, process ^>=1.6.11.0
|
||||
, resourcet ^>=1.2.2
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, tagsoup ^>=0.14
|
||||
, template-haskell >=2.7 && <2.20
|
||||
, temporary ^>=1.3
|
||||
, text ^>=2.0
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
, ghcup-optparse
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
other-modules: BrickMain
|
||||
build-depends:
|
||||
, brick ^>=1.5
|
||||
, brick ^>=2.1
|
||||
, transformers ^>=0.5
|
||||
, unix ^>=2.7
|
||||
, vty ^>=5.37
|
||||
, vty ^>=6.0
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
@@ -301,7 +341,7 @@ test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
build-tool-depends: hspec-discover:hspec-discover -any
|
||||
hs-source-dirs: test
|
||||
hs-source-dirs: test/ghcup-test
|
||||
other-modules:
|
||||
GHCup.ArbitraryTypes
|
||||
GHCup.Prelude.File.Posix.TraversalsSpec
|
||||
@@ -336,11 +376,49 @@ test-suite ghcup-test
|
||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||
, streamly ^>=0.8.2
|
||||
, text ^>=2.0
|
||||
, time >=1.9.3 && <1.12
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, versions >=4.0.1 && <5.1
|
||||
, versions >=6.0.3 && <6.1
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
else
|
||||
build-depends: unix ^>=2.7
|
||||
|
||||
test-suite ghcup-optparse-test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test/optparse-test
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
ChangeLogTest
|
||||
CompileTest
|
||||
ConfigTest
|
||||
GCTest
|
||||
InstallTest
|
||||
ListTest
|
||||
OtherCommandTest
|
||||
RmTest
|
||||
RunTest
|
||||
SetTest
|
||||
UnsetTest
|
||||
UpgradeTest
|
||||
Utils
|
||||
WhereisTest
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
, base
|
||||
, ghcup
|
||||
, ghcup-optparse
|
||||
, optparse-applicative
|
||||
, tasty
|
||||
, tasty-hunit
|
||||
, template-haskell
|
||||
, text
|
||||
, uri-bytestring
|
||||
, versions
|
||||
|
||||
4
hie.yaml
4
hie.yaml
@@ -5,4 +5,6 @@ cradle:
|
||||
- component: "ghcup:exe:ghcup"
|
||||
path: ./app/ghcup
|
||||
- component: "ghcup:test:ghcup-test"
|
||||
path: ./test
|
||||
path: ./test/ghcup-test
|
||||
- component: "ghcup:test:ghcup-optparse-test"
|
||||
path: ./test/optparse-test
|
||||
@@ -57,16 +57,13 @@ import GHCup.Types
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
|
||||
|
||||
data Options = Options
|
||||
@@ -77,12 +74,13 @@ data Options = Options
|
||||
, optMetaCache :: Maybe Integer
|
||||
, optMetaMode :: Maybe MetaMode
|
||||
, optPlatform :: Maybe PlatformRequest
|
||||
, optUrlSource :: Maybe URI
|
||||
, optUrlSource :: Maybe URLSource
|
||||
, optNoVerify :: Maybe Bool
|
||||
, optKeepDirs :: Maybe KeepDirs
|
||||
, optsDownloader :: Maybe Downloader
|
||||
, optNoNetwork :: Maybe Bool
|
||||
, optGpg :: Maybe GPGSetting
|
||||
, optStackSetup :: Maybe Bool
|
||||
-- commands
|
||||
, optCommand :: Command
|
||||
}
|
||||
@@ -134,13 +132,13 @@ opts =
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader parseUri)
|
||||
(eitherReader parseUrlSource)
|
||||
( short 's'
|
||||
<> long "url-source"
|
||||
<> metavar "URL"
|
||||
<> help "Alternative ghcup download info url"
|
||||
<> metavar "URL_SOURCE"
|
||||
<> help "Alternative ghcup download info"
|
||||
<> internal
|
||||
<> completer fileUri
|
||||
<> completer urlSourceCompleter
|
||||
)
|
||||
)
|
||||
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
|
||||
@@ -178,10 +176,9 @@ opts =
|
||||
"GPG verification (default: none)"
|
||||
<> completer (listCompleter ["strict", "lax", "none"])
|
||||
))
|
||||
<*> invertableSwitch "stack-setup" (Just 's') False (help "Use stack's setup info for discovering and installing GHC versions")
|
||||
<*> com
|
||||
where
|
||||
parseUri s' =
|
||||
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
|
||||
|
||||
|
||||
|
||||
com :: Parser Command
|
||||
@@ -244,7 +241,8 @@ com =
|
||||
<> command
|
||||
"list"
|
||||
(info (List <$> listOpts <**> helper)
|
||||
(progDesc "Show available GHCs and other tools")
|
||||
(progDesc "Show available GHCs and other tools"
|
||||
<> footerDoc (Just $ text listToolFooter))
|
||||
)
|
||||
<> command
|
||||
"upgrade"
|
||||
@@ -35,7 +35,6 @@ import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import Data.Versions
|
||||
import URI.ByteString (serializeURIRef')
|
||||
import Data.Char (toLower)
|
||||
|
||||
@@ -50,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
|
||||
{ clOpen :: Bool
|
||||
, clTool :: Maybe Tool
|
||||
, clToolVer :: Maybe ToolVersion
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -76,12 +75,12 @@ changelogP =
|
||||
e -> Left e
|
||||
)
|
||||
)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup|stack>" <> help
|
||||
"Open changelog for given tool (default: ghc)"
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> optional (toolVersionTagArgument Nothing Nothing)
|
||||
<*> optional (toolVersionTagArgument [] Nothing)
|
||||
|
||||
|
||||
|
||||
@@ -115,20 +114,15 @@ changelog :: ( Monad m
|
||||
changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||
let tool = fromMaybe GHC clTool
|
||||
ver' = maybe
|
||||
(Right Latest)
|
||||
(\case
|
||||
GHCVersion tv -> Left (_tvVersion tv)
|
||||
ToolVersion tv -> Left tv
|
||||
ToolTag t -> Right t
|
||||
)
|
||||
ver' = fromMaybe
|
||||
(ToolTag Latest)
|
||||
clToolVer
|
||||
muri = getChangeLog dls tool ver'
|
||||
case muri of
|
||||
Nothing -> do
|
||||
runLogger
|
||||
(logWarn $
|
||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
|
||||
)
|
||||
pure ExitSuccess
|
||||
Just uri -> do
|
||||
@@ -5,6 +5,7 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module GHCup.OptParse.Common where
|
||||
|
||||
@@ -45,7 +46,9 @@ import Data.Functor
|
||||
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Time.Calendar ( Day )
|
||||
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
|
||||
import Data.Versions
|
||||
import Data.Void
|
||||
import qualified Data.Vector as V
|
||||
import GHC.IO.Exception
|
||||
@@ -61,6 +64,8 @@ import URI.ByteString
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Encoding as LE
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified System.FilePath.Posix as FP
|
||||
import GHCup.Version
|
||||
@@ -72,26 +77,27 @@ import qualified Cabal.Config as CC
|
||||
--[ Types ]--
|
||||
-------------
|
||||
|
||||
data ToolVersion = GHCVersion GHCTargetVersion
|
||||
| ToolVersion Version
|
||||
| ToolTag Tag
|
||||
|
||||
-- a superset of ToolVersion
|
||||
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||
| SetToolVersion Version
|
||||
| SetToolTag Tag
|
||||
| SetToolDay Day
|
||||
| SetRecommended
|
||||
| SetNext
|
||||
deriving (Eq, Show)
|
||||
|
||||
prettyToolVer :: ToolVersion -> String
|
||||
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
||||
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
||||
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
|
||||
prettyToolVer (ToolTag t) = show t
|
||||
prettyToolVer (ToolTag t) = show t
|
||||
prettyToolVer (ToolDay day) = show day
|
||||
|
||||
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
||||
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
|
||||
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
||||
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
||||
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
|
||||
toSetToolVer Nothing = SetRecommended
|
||||
|
||||
|
||||
@@ -102,28 +108,28 @@ toSetToolVer Nothing = SetRecommended
|
||||
--------------
|
||||
|
||||
|
||||
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionTagArgument criteria tool =
|
||||
argument (eitherReader (parser tool))
|
||||
(metavar (mv tool)
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
mv (Just GHC) = "GHC_VERSION|TAG"
|
||||
mv (Just HLS) = "HLS_VERSION|TAG"
|
||||
mv _ = "VERSION|TAG"
|
||||
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
|
||||
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
|
||||
mv _ = "VERSION|TAG|RELEASE_DATE"
|
||||
|
||||
parser (Just GHC) = ghcVersionTagEither
|
||||
parser Nothing = ghcVersionTagEither
|
||||
parser _ = toolVersionTagEither
|
||||
|
||||
|
||||
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
|
||||
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
|
||||
versionParser' criteria tool = argument
|
||||
(eitherReader (first show . version . T.pack))
|
||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
|
||||
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
|
||||
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
|
||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
|
||||
@@ -205,19 +211,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
)
|
||||
]
|
||||
distroP :: MP.Parsec Void Text LinuxDistro
|
||||
distroP = choice'
|
||||
[ MP.chunk "debian" $> Debian
|
||||
, MP.chunk "deb" $> Debian
|
||||
, MP.chunk "ubuntu" $> Ubuntu
|
||||
, MP.chunk "mint" $> Mint
|
||||
, MP.chunk "fedora" $> Fedora
|
||||
, MP.chunk "centos" $> CentOS
|
||||
, MP.chunk "redhat" $> RedHat
|
||||
, MP.chunk "alpine" $> Alpine
|
||||
, MP.chunk "gentoo" $> Gentoo
|
||||
, MP.chunk "exherbo" $> Exherbo
|
||||
, MP.chunk "unknown" $> UnknownLinux
|
||||
]
|
||||
distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
|
||||
|
||||
|
||||
uriParser :: String -> Either String URI
|
||||
@@ -237,21 +231,23 @@ isolateParser f = case isValid f && isAbsolute f of
|
||||
-- this accepts cross prefix
|
||||
ghcVersionTagEither :: String -> Either String ToolVersion
|
||||
ghcVersionTagEither s' =
|
||||
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
|
||||
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
|
||||
|
||||
-- this ignores cross prefix
|
||||
toolVersionTagEither :: String -> Either String ToolVersion
|
||||
toolVersionTagEither s' =
|
||||
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
|
||||
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
|
||||
|
||||
tagEither :: String -> Either String Tag
|
||||
tagEither s' = case fmap toLower s' of
|
||||
"recommended" -> Right Recommended
|
||||
"latest" -> Right Latest
|
||||
"recommended" -> Right Recommended
|
||||
"latest" -> Right Latest
|
||||
"latest-prerelease" -> Right LatestPrerelease
|
||||
"latest-nightly" -> Right LatestNightly
|
||||
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
||||
Right x -> Right (Base x)
|
||||
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
||||
other -> Left $ "Unknown tag " <> other
|
||||
other -> Left $ "Unknown tag " <> other
|
||||
|
||||
|
||||
ghcVersionEither :: String -> Either String GHCTargetVersion
|
||||
@@ -260,7 +256,7 @@ ghcVersionEither =
|
||||
|
||||
toolVersionEither :: String -> Either String Version
|
||||
toolVersionEither =
|
||||
first (const "Not a valid version") . MP.parse version' "" . T.pack
|
||||
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
|
||||
|
||||
|
||||
toolParser :: String -> Either String Tool
|
||||
@@ -271,12 +267,22 @@ toolParser s' | t == T.pack "ghc" = Right GHC
|
||||
| otherwise = Left ("Unknown tool: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
dayParser :: String -> Either String Day
|
||||
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
|
||||
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
|
||||
|
||||
|
||||
criteriaParser :: String -> Either String ListCriteria
|
||||
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
||||
| t == T.pack "set" = Right ListSet
|
||||
| t == T.pack "available" = Right ListAvailable
|
||||
| otherwise = Left ("Unknown criteria: " <> s')
|
||||
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
|
||||
| t == T.pack "set" = Right $ ListSet True
|
||||
| t == T.pack "available" = Right $ ListAvailable True
|
||||
| t == T.pack "+installed" = Right $ ListInstalled True
|
||||
| t == T.pack "+set" = Right $ ListSet True
|
||||
| t == T.pack "+available" = Right $ ListAvailable True
|
||||
| t == T.pack "-installed" = Right $ ListInstalled False
|
||||
| t == T.pack "-set" = Right $ ListSet False
|
||||
| t == T.pack "-available" = Right $ ListAvailable False
|
||||
| otherwise = Left ("Unknown criteria: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
@@ -318,6 +324,15 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
|
||||
gitFileUri :: [String] -> Completer
|
||||
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
|
||||
|
||||
urlSourceCompleter :: Completer
|
||||
urlSourceCompleter = mkCompleter $ urlSourceCompleter' []
|
||||
|
||||
urlSourceCompleter' :: [String] -> String -> IO [String]
|
||||
urlSourceCompleter' add str' = do
|
||||
let static = ["GHCupURL", "StackSetupURL"]
|
||||
file <- fileUri' add str'
|
||||
pure $ static ++ file
|
||||
|
||||
fileUri :: Completer
|
||||
fileUri = mkCompleter $ fileUri' []
|
||||
|
||||
@@ -351,7 +366,7 @@ fileUri' add = \case
|
||||
-- We need to do this so bash doesn't expand out any ~ or other
|
||||
-- chars we want to complete on, or emit an end of line error
|
||||
-- when seeking the close to the quote.
|
||||
--
|
||||
--
|
||||
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
|
||||
requote :: String -> String
|
||||
requote s =
|
||||
@@ -446,18 +461,20 @@ tagCompleter tool add = listIOCompleter $ do
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
|
||||
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
|
||||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (/= Old)
|
||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
|
||||
mpFreq <- flip runReaderT appState . runE $ platformRequest
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq
|
||||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (/= Old)
|
||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
|
||||
|
||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter :: [ListCriteria] -> Tool -> Completer
|
||||
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
|
||||
|
||||
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
|
||||
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
|
||||
versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
@@ -473,8 +490,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
|
||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||
let appState = AppState
|
||||
settings
|
||||
@@ -486,7 +503,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||
|
||||
runEnv = flip runReaderT appState
|
||||
|
||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
||||
installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
|
||||
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
|
||||
|
||||
|
||||
@@ -654,6 +671,7 @@ fromVersion :: ( HasLog env
|
||||
-> Tool
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
@@ -672,46 +690,58 @@ fromVersion' :: ( HasLog env
|
||||
-> Tool
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion' SetRecommended tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getRecommended dls tool
|
||||
second Just <$> getRecommended dls tool
|
||||
?? TagNotFound Recommended tool
|
||||
fromVersion' (SetGHCVersion v) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
||||
let vi = getVersionInfo v tool dls
|
||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||
Left _ -> pure (v, vi)
|
||||
Right pvpIn ->
|
||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
||||
Just (pvp_, vi') -> do
|
||||
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
|
||||
Just (pvp_, vi', mt) -> do
|
||||
v' <- lift $ pvpToVersion pvp_ ""
|
||||
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
||||
pure (GHCTargetVersion mt v', Just vi')
|
||||
Nothing -> pure (v, vi)
|
||||
fromVersion' (SetToolVersion v) tool = do
|
||||
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo v tool dls
|
||||
case pvp $ prettyVer v of -- need to be strict here
|
||||
Left _ -> pure (mkTVer v, vi)
|
||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||
Left _ -> pure (v, vi)
|
||||
Right pvpIn ->
|
||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
||||
Just (pvp_, vi') -> do
|
||||
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
|
||||
Just (pvp_, vi', mt) -> do
|
||||
v' <- lift $ pvpToVersion pvp_ ""
|
||||
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion mempty v', Just vi')
|
||||
Nothing -> pure (mkTVer v, vi)
|
||||
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion mt v', Just vi')
|
||||
Nothing -> pure (v, vi)
|
||||
fromVersion' (SetToolTag Latest) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
fromVersion' (SetToolDay day) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap id Just <$> case getByReleaseDay dls tool day of
|
||||
Left ad -> throwE $ DayNotFound day tool ad
|
||||
Right v -> pure v
|
||||
fromVersion' (SetToolTag LatestPrerelease) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
|
||||
fromVersion' (SetToolTag LatestNightly) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
|
||||
fromVersion' (SetToolTag Recommended) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
||||
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
||||
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
||||
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
||||
fromVersion' SetNext tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
next <- case tool of
|
||||
@@ -756,7 +786,7 @@ fromVersion' SetNext tool = do
|
||||
. sort
|
||||
$ stacks) ?? NoToolVersionSet tool
|
||||
GHCup -> fail "GHCup cannot be set"
|
||||
let vi = getVersionInfo (_tvVersion next) tool dls
|
||||
let vi = getVersionInfo next tool dls
|
||||
pure (next, vi)
|
||||
fromVersion' (SetToolTag t') tool =
|
||||
throwE $ TagNotFound t' tool
|
||||
@@ -772,15 +802,15 @@ checkForUpdates :: ( MonadReader env m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> m [(Tool, Version)]
|
||||
=> m [(Tool, GHCTargetVersion)]
|
||||
checkForUpdates = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||
lInstalled <- listVersions Nothing (Just ListInstalled)
|
||||
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
|
||||
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||
|
||||
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
|
||||
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
|
||||
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
|
||||
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
|
||||
|
||||
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
||||
forMM (getLatest dls t) $ \(l, _) -> do
|
||||
@@ -795,8 +825,20 @@ checkForUpdates = do
|
||||
|
||||
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
|
||||
logGHCPostRm ghcVer = do
|
||||
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
|
||||
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
|
||||
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
|
||||
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
|
||||
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
|
||||
|
||||
parseUrlSource :: String -> Either String URLSource
|
||||
parseUrlSource "GHCupURL" = pure GHCupURL
|
||||
parseUrlSource "StackSetupURL" = pure StackSetupURL
|
||||
parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
|
||||
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
|
||||
|
||||
parseNewUrlSource :: String -> Either String NewURLSource
|
||||
parseNewUrlSource "GHCupURL" = pure NewGHCupURL
|
||||
parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
|
||||
parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
|
||||
<|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
|
||||
|
||||
@@ -57,6 +57,7 @@ import Text.Read (readEither)
|
||||
|
||||
data CompileCommand = CompileGHC GHCCompileOptions
|
||||
| CompileHLS HLSCompileOptions
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -66,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
|
||||
|
||||
|
||||
data GHCCompileOptions = GHCCompileOptions
|
||||
{ targetGhc :: GHC.GHCVer Version
|
||||
{ targetGhc :: GHC.GHCVer
|
||||
, bootstrapGhc :: Either Version FilePath
|
||||
, jobs :: Maybe Int
|
||||
, buildConfig :: Maybe FilePath
|
||||
@@ -76,9 +77,9 @@ data GHCCompileOptions = GHCCompileOptions
|
||||
, setCompile :: Bool
|
||||
, ovewrwiteVer :: Maybe Version
|
||||
, buildFlavour :: Maybe String
|
||||
, hadrian :: Bool
|
||||
, buildSystem :: Maybe BuildSystem
|
||||
, isolateDir :: Maybe FilePath
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
data HLSCompileOptions = HLSCompileOptions
|
||||
@@ -93,7 +94,7 @@ data HLSCompileOptions = HLSCompileOptions
|
||||
, patches :: Maybe (Either FilePath [URI])
|
||||
, targetGHCs :: [ToolVersion]
|
||||
, cabalArgs :: [Text]
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -170,7 +171,7 @@ ghcCompileOpts =
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
<> (completer $ versionCompleter [] GHC)
|
||||
)
|
||||
) <|>
|
||||
(GHC.GitDist <$> (GitBranch <$> option
|
||||
@@ -205,7 +206,7 @@ ghcCompileOpts =
|
||||
<> metavar "BOOTSTRAP_GHC"
|
||||
<> help
|
||||
"The GHC version (or full path) to bootstrap with (must be installed)"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
<> (completer $ versionCompleter [] GHC)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
@@ -258,7 +259,7 @@ ghcCompileOpts =
|
||||
)
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
<> (completer $ versionCompleter [] GHC)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -268,16 +269,22 @@ ghcCompileOpts =
|
||||
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
||||
<*> (
|
||||
(\b -> if b then Just Hadrian else Nothing) <$> switch
|
||||
(long "hadrian" <> help "Use the hadrian build system instead of make. Tries to detect by default."
|
||||
)
|
||||
<|>
|
||||
(\b -> if b then Just Make else Nothing) <$> switch
|
||||
(long "make" <> help "Use the make build system instead of hadrian. Tries to detect by default."
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
@@ -291,7 +298,7 @@ hlsCompileOpts =
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The version to compile (pulled from hackage)"
|
||||
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
||||
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
||||
)
|
||||
)
|
||||
<|>
|
||||
@@ -311,7 +318,7 @@ hlsCompileOpts =
|
||||
)
|
||||
(long "source-dist" <> metavar "VERSION" <> help
|
||||
"The version to compile (pulled from packaged git sources)"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
<> (completer $ versionCompleter [] HLS)
|
||||
)
|
||||
))
|
||||
<|>
|
||||
@@ -343,7 +350,7 @@ hlsCompileOpts =
|
||||
)
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
<> (completer $ versionCompleter [] HLS)
|
||||
)
|
||||
)
|
||||
<|>
|
||||
@@ -360,7 +367,7 @@ hlsCompileOpts =
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
@@ -403,7 +410,7 @@ hlsCompileOpts =
|
||||
option (eitherReader ghcVersionTagEither)
|
||||
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> completer (versionCompleter Nothing GHC))
|
||||
<> completer (versionCompleter [] GHC))
|
||||
)
|
||||
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
||||
|
||||
@@ -453,6 +460,7 @@ type HLSEffects = '[ AlreadyInstalled
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, NotInstalled
|
||||
@@ -510,7 +518,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
case targetHLS of
|
||||
HLS.SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
@@ -530,7 +538,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
patches
|
||||
cabalArgs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
||||
when setCompile $ void $ liftE $
|
||||
setHLS targetVer SetHLSOnly Nothing
|
||||
pure (vi, targetVer)
|
||||
@@ -554,15 +562,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 9
|
||||
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
||||
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
||||
pure $ ExitFailure 9
|
||||
(CompileGHC GHCCompileOptions {..}) ->
|
||||
runCompileGHC runAppState (do
|
||||
case targetGhc of
|
||||
GHC.SourceDist targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
let vi = getVersionInfo (mkTVer targetVer) GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
@@ -570,10 +575,8 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
_ -> pure ()
|
||||
targetVer <- liftE $ compileGHC
|
||||
((\case
|
||||
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
|
||||
GHC.GitDist g -> GHC.GitDist g
|
||||
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
|
||||
targetGhc
|
||||
crossTarget
|
||||
ovewrwiteVer
|
||||
bootstrapGhc
|
||||
jobs
|
||||
@@ -581,10 +584,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
patches
|
||||
addConfArgs
|
||||
buildFlavour
|
||||
hadrian
|
||||
buildSystem
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
when setCompile $ void $ liftE $
|
||||
setGHC targetVer SetGHCOnly Nothing
|
||||
pure (vi, targetVer)
|
||||
@@ -32,7 +32,6 @@ import Options.Applicative hiding ( style, ParseError )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
@@ -51,7 +50,8 @@ data ConfigCommand
|
||||
= ShowConfig
|
||||
| SetConfig String (Maybe String)
|
||||
| InitConfig
|
||||
| AddReleaseChannel URI
|
||||
| AddReleaseChannel Bool NewURLSource
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -59,7 +59,7 @@ data ConfigCommand
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
configP :: Parser ConfigCommand
|
||||
configP = subparser
|
||||
( command "init" initP
|
||||
@@ -74,8 +74,8 @@ configP = subparser
|
||||
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
|
||||
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
|
||||
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
|
||||
addP = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
|
||||
(progDesc "Add a release channel from a URI")
|
||||
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader parseNewUrlSource) (metavar "URL_SOURCE" <> completer urlSourceCompleter))
|
||||
(progDesc "Add a release channel, e.g. from a URI")
|
||||
|
||||
|
||||
|
||||
@@ -120,21 +120,38 @@ formatConfig :: UserSettings -> String
|
||||
formatConfig = UTF8.toString . Y.encode
|
||||
|
||||
|
||||
updateSettings :: UserSettings -> Settings -> Settings
|
||||
updateSettings UserSettings{..} Settings{..} =
|
||||
let cache' = fromMaybe cache uCache
|
||||
metaCache' = fromMaybe metaCache uMetaCache
|
||||
metaMode' = fromMaybe metaMode uMetaMode
|
||||
noVerify' = fromMaybe noVerify uNoVerify
|
||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
||||
downloader' = fromMaybe downloader uDownloader
|
||||
verbose' = fromMaybe verbose uVerbose
|
||||
urlSource' = fromMaybe urlSource uUrlSource
|
||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||
platformOverride' = uPlatformOverride <|> platformOverride
|
||||
mirrors' = fromMaybe mirrors uMirrors
|
||||
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride' mirrors'
|
||||
updateSettings :: UserSettings -> UserSettings -> UserSettings
|
||||
updateSettings usl usr =
|
||||
let cache' = uCache usl <|> uCache usr
|
||||
metaCache' = uMetaCache usl <|> uMetaCache usr
|
||||
metaMode' = uMetaMode usl <|> uMetaMode usr
|
||||
noVerify' = uNoVerify usl <|> uNoVerify usr
|
||||
verbose' = uVerbose usl <|> uVerbose usr
|
||||
keepDirs' = uKeepDirs usl <|> uKeepDirs usr
|
||||
downloader' = uDownloader usl <|> uDownloader usr
|
||||
urlSource' = uUrlSource usl <|> uUrlSource usr
|
||||
noNetwork' = uNoNetwork usl <|> uNoNetwork usr
|
||||
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
|
||||
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
|
||||
mirrors' = uMirrors usl <|> uMirrors usr
|
||||
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
|
||||
where
|
||||
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
|
||||
updateKeyBindings Nothing Nothing = Nothing
|
||||
updateKeyBindings (Just kbl) Nothing = Just kbl
|
||||
updateKeyBindings Nothing (Just kbr) = Just kbr
|
||||
updateKeyBindings (Just kbl) (Just kbr) =
|
||||
Just $ UserKeyBindings {
|
||||
kUp = kUp kbl <|> kUp kbr
|
||||
, kDown = kDown kbl <|> kDown kbr
|
||||
, kQuit = kQuit kbl <|> kQuit kbr
|
||||
, kInstall = kInstall kbl <|> kInstall kbr
|
||||
, kUninstall = kUninstall kbl <|> kUninstall kbr
|
||||
, kSet = kSet kbl <|> kSet kbr
|
||||
, kChangelog = kChangelog kbl <|> kChangelog kbr
|
||||
, kShowAll = kShowAll kbl <|> kShowAll kbr
|
||||
, kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -142,6 +159,9 @@ updateSettings UserSettings{..} Settings{..} =
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
data Duplicate = Duplicate -- ^ there is a duplicate somewhere in the middle
|
||||
| NoDuplicate -- ^ there is no duplicate
|
||||
| DuplicateLast -- ^ there's a duplicate, but it's the last element
|
||||
|
||||
|
||||
config :: forall m. ( Monad m
|
||||
@@ -151,10 +171,11 @@ config :: forall m. ( Monad m
|
||||
)
|
||||
=> ConfigCommand
|
||||
-> Settings
|
||||
-> UserSettings
|
||||
-> KeyBindings
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
config configCommand settings keybindings runLogger = case configCommand of
|
||||
config configCommand settings userConf keybindings runLogger = case configCommand of
|
||||
InitConfig -> do
|
||||
path <- getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||
@@ -185,27 +206,34 @@ config configCommand settings keybindings runLogger = case configCommand of
|
||||
pure $ ExitFailure 65
|
||||
VLeft _ -> pure $ ExitFailure 65
|
||||
|
||||
AddReleaseChannel uri -> do
|
||||
case urlSource settings of
|
||||
AddSource xs -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
||||
pure ExitSuccess
|
||||
GHCupURL -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||
pure ExitSuccess
|
||||
OwnSource xs -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
|
||||
pure ExitSuccess
|
||||
OwnSpec spec -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
|
||||
AddReleaseChannel force new -> do
|
||||
r <- runE @'[DuplicateReleaseChannel] $ do
|
||||
let oldSources = fromURLSource (urlSource settings)
|
||||
let merged = oldSources ++ [new]
|
||||
case checkDuplicate oldSources new of
|
||||
Duplicate
|
||||
| not force -> throwE (DuplicateReleaseChannel new)
|
||||
DuplicateLast -> pure ()
|
||||
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ SimpleList merged })
|
||||
case r of
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
where
|
||||
checkDuplicate :: Eq a => [a] -> a -> Duplicate
|
||||
checkDuplicate xs a
|
||||
| last xs == a = DuplicateLast
|
||||
| a `elem` xs = Duplicate
|
||||
| otherwise = NoDuplicate
|
||||
|
||||
doConfig :: MonadIO m => UserSettings -> m ()
|
||||
doConfig usersettings = do
|
||||
let settings' = updateSettings usersettings settings
|
||||
let settings' = updateSettings usersettings userConf
|
||||
path <- liftIO getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||
liftIO $ writeFile path $ formatConfig $ settings'
|
||||
runLogger $ logDebug $ T.pack $ show settings'
|
||||
pure ()
|
||||
|
||||
@@ -47,7 +47,7 @@ data GCOptions = GCOptions
|
||||
, gcHLSNoGHC :: Bool
|
||||
, gcCache :: Bool
|
||||
, gcTmp :: Bool
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions
|
||||
| InstallCabal InstallOptions
|
||||
| InstallHLS InstallOptions
|
||||
| InstallStack InstallOptions
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -62,7 +63,6 @@ data InstallCommand = InstallGHC InstallOptions
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data InstallOptions = InstallOptions
|
||||
{ instVer :: Maybe ToolVersion
|
||||
, instBindist :: Maybe URI
|
||||
@@ -70,7 +70,7 @@ data InstallOptions = InstallOptions
|
||||
, isolateDir :: Maybe FilePath
|
||||
, forceInstall :: Bool
|
||||
, addConfArgs :: [T.Text]
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -133,7 +133,7 @@ installParser =
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> installOpts Nothing)
|
||||
<|> (Right <$> installOpts (Just GHC))
|
||||
where
|
||||
installHLSFooter :: String
|
||||
installHLSFooter = [s|Discussion:
|
||||
@@ -184,7 +184,7 @@ installOpts tool =
|
||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
||||
<*> (Just <$> toolVersionTagArgument [] tool)
|
||||
)
|
||||
<|> pure (Nothing, Nothing)
|
||||
)
|
||||
@@ -196,7 +196,7 @@ installOpts tool =
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated dir instead of the default one"
|
||||
<> help "install in an isolated absolute directory instead of the default one"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
@@ -241,6 +241,7 @@ type InstallEffects = '[ AlreadyInstalled
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
@@ -284,10 +285,16 @@ type InstallGHCEffects = '[ AlreadyInstalled
|
||||
, NotInstalled
|
||||
, ProcessError
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, TarDirDoesNotExist
|
||||
, UninstallFailed
|
||||
, UnknownArchive
|
||||
, InstallSetError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
runInstGHC :: AppState
|
||||
@@ -307,13 +314,13 @@ runInstGHC appstate' =
|
||||
|
||||
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
|
||||
install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(Right iopts) -> do
|
||||
(Right iGHCopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
|
||||
installGHC iopts
|
||||
(Left (InstallGHC iopts)) -> installGHC iopts
|
||||
(Left (InstallCabal iopts)) -> installCabal iopts
|
||||
(Left (InstallHLS iopts)) -> installHLS iopts
|
||||
(Left (InstallStack iopts)) -> installStack iopts
|
||||
installGHC iGHCopts
|
||||
(Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
|
||||
(Left (InstallCabal iopts)) -> installCabal iopts
|
||||
(Left (InstallHLS iopts)) -> installHLS iopts
|
||||
(Left (InstallStack iopts)) -> installStack iopts
|
||||
where
|
||||
installGHC :: InstallOptions -> IO ExitCode
|
||||
installGHC InstallOptions{..} = do
|
||||
@@ -322,7 +329,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
Nothing -> runInstGHC s' $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
liftE $ runBothE' (installGHCBin
|
||||
(_tvVersion v)
|
||||
v
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
addConfArgs
|
||||
@@ -333,8 +340,8 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
runInstGHC s'{ settings = settings {noVerify = True}} $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
liftE $ runBothE' (installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
|
||||
(_tvVersion v)
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
|
||||
v
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
addConfArgs
|
||||
@@ -403,7 +410,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ runBothE' (installCabalBindist
|
||||
(DownloadInfo uri Nothing "" Nothing)
|
||||
(DownloadInfo uri Nothing "" Nothing Nothing)
|
||||
v
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
@@ -453,7 +460,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||
-- TODO: support legacy
|
||||
liftE $ runBothE' (installHLSBindist
|
||||
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
|
||||
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
|
||||
v
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
@@ -502,7 +509,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ runBothE' (installStackBindist
|
||||
(DownloadInfo uri Nothing "" Nothing)
|
||||
(DownloadInfo uri Nothing "" Nothing Nothing)
|
||||
v
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
forceInstall
|
||||
@@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
@@ -14,6 +15,7 @@ import GHCup
|
||||
import GHCup.Prelude
|
||||
import GHCup.Types
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Prelude.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -24,7 +26,8 @@ import Data.Char
|
||||
import Data.List ( intercalate, sort )
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Time.Calendar ( Day )
|
||||
import Data.Versions
|
||||
import Data.Void
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
@@ -50,8 +53,12 @@ import qualified Text.Megaparsec.Char as MPC
|
||||
data ListOptions = ListOptions
|
||||
{ loTool :: Maybe Tool
|
||||
, lCriteria :: Maybe ListCriteria
|
||||
, lFrom :: Maybe Day
|
||||
, lTo :: Maybe Day
|
||||
, lHideOld :: Bool
|
||||
, lShowNightly :: Bool
|
||||
, lRawFormat :: Bool
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -60,7 +67,6 @@ data ListOptions = ListOptions
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
listOpts :: Parser ListOptions
|
||||
listOpts =
|
||||
ListOptions
|
||||
@@ -69,7 +75,7 @@ listOpts =
|
||||
(eitherReader toolParser)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||
"Tool to list versions for. Default is all"
|
||||
<> completer (toolCompleter)
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -78,15 +84,53 @@ listOpts =
|
||||
( short 'c'
|
||||
<> long "show-criteria"
|
||||
<> metavar "<installed|set|available>"
|
||||
<> help "Show only installed/set/available tool versions"
|
||||
<> completer (listCompleter ["installed", "set", "available"])
|
||||
<> help "Apply filtering criteria, prefix with + or -"
|
||||
<> completer (listCompleter
|
||||
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader dayParser)
|
||||
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
|
||||
"List only tools with release date starting at YYYY-MM-DD or later"
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader dayParser)
|
||||
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
|
||||
"List only tools with release date earlier than YYYY-MM-DD"
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
|
||||
)
|
||||
<*> switch
|
||||
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
|
||||
)
|
||||
<*> switch
|
||||
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
||||
)
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
listToolFooter :: String
|
||||
listToolFooter = [s|Discussion:
|
||||
Lists tool versions with optional criteria.
|
||||
Nightlies are by default hidden.
|
||||
|
||||
Examples:
|
||||
# query nightlies in a specific range
|
||||
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
|
||||
# show all installed GHC versions
|
||||
ghcup list -t ghc -c installed|]
|
||||
|
||||
|
||||
-----------------
|
||||
@@ -105,8 +149,11 @@ printListResult no_color raw lr = do
|
||||
printTag Recommended = color Green "recommended"
|
||||
printTag Latest = color Yellow "latest"
|
||||
printTag Prerelease = color Red "prerelease"
|
||||
printTag Nightly = color Red "nightly"
|
||||
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
printTag (UnknownTag t ) = t
|
||||
printTag LatestPrerelease = color Red "latest-prerelease"
|
||||
printTag LatestNightly = color Red "latest-nightly"
|
||||
printTag Old = ""
|
||||
|
||||
let
|
||||
@@ -133,8 +180,10 @@ printListResult no_color raw lr = do
|
||||
then [color Green "hls-powered"]
|
||||
else mempty
|
||||
)
|
||||
++ (if fromSrc then [color Blue "compiled"] else mempty)
|
||||
++ (if lStray then [color Yellow "stray"] else mempty)
|
||||
++ (case lReleaseDay of
|
||||
Nothing -> mempty
|
||||
Just d -> [color Blue (show d)])
|
||||
++ (if lNoBindist
|
||||
then [color Red "no-bindist"]
|
||||
else mempty
|
||||
@@ -259,7 +308,7 @@ list :: ( Monad m
|
||||
-> m ExitCode
|
||||
list ListOptions{..} no_color runAppState =
|
||||
runAppState (do
|
||||
l <- listVersions loTool lCriteria
|
||||
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
|
||||
liftIO $ printListResult no_color lRawFormat l
|
||||
pure ExitSuccess
|
||||
)
|
||||
@@ -76,8 +76,8 @@ nuke appState runLogger = do
|
||||
|
||||
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||
lift $ logInfo "Nuking in 3...2...1"
|
||||
|
||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
||||
|
||||
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
|
||||
|
||||
forM_ lInstalled (liftE . rmTool)
|
||||
|
||||
@@ -14,6 +14,7 @@ module GHCup.OptParse.Prefetch where
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.String.QQ
|
||||
@@ -83,7 +84,7 @@ prefetchP = subparser
|
||||
<$> (PrefetchGHCOptions
|
||||
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
||||
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
|
||||
<*> optional (toolVersionTagArgument [] (Just GHC)) )
|
||||
( progDesc "Download GHC assets for installation")
|
||||
)
|
||||
<>
|
||||
@@ -92,7 +93,7 @@ prefetchP = subparser
|
||||
(info
|
||||
(PrefetchCabal
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
|
||||
<*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
|
||||
( progDesc "Download cabal assets for installation")
|
||||
)
|
||||
<>
|
||||
@@ -101,7 +102,7 @@ prefetchP = subparser
|
||||
(info
|
||||
(PrefetchHLS
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
|
||||
<*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
|
||||
( progDesc "Download HLS assets for installation")
|
||||
)
|
||||
<>
|
||||
@@ -110,7 +111,7 @@ prefetchP = subparser
|
||||
(info
|
||||
(PrefetchStack
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
|
||||
<*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
|
||||
( progDesc "Download stack assets for installation")
|
||||
)
|
||||
<>
|
||||
@@ -148,6 +149,7 @@ Examples:
|
||||
|
||||
|
||||
type PrefetchEffects = '[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, NoDownload
|
||||
@@ -156,7 +158,9 @@ type PrefetchEffects = '[ TagNotFound
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, JSONError
|
||||
, FileDoesNotExistError ]
|
||||
, FileDoesNotExistError
|
||||
, StackPlatformDetectError
|
||||
]
|
||||
|
||||
|
||||
runPrefetch :: MonadUnliftIO m
|
||||
@@ -194,7 +198,7 @@ prefetch prefetchCommand runAppState runLogger =
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt GHC
|
||||
if pfGHCSrc
|
||||
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
|
||||
then liftE $ fetchGHCSrc v pfCacheDir
|
||||
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
||||
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
@@ -209,7 +213,8 @@ prefetch prefetchCommand runAppState runLogger =
|
||||
(v, _) <- liftE $ fromVersion mt Stack
|
||||
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
|
||||
PrefetchMetadata -> do
|
||||
_ <- liftE getDownloadsF
|
||||
pfreq <- lift getPlatformReq
|
||||
_ <- liftE $ getDownloadsF pfreq
|
||||
pure ""
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
@@ -29,7 +29,7 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
@@ -50,6 +50,7 @@ data RmCommand = RmGHC RmOptions
|
||||
| RmCabal Version
|
||||
| RmHLS Version
|
||||
| RmStack Version
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -61,7 +62,7 @@ data RmCommand = RmGHC RmOptions
|
||||
|
||||
data RmOptions = RmOptions
|
||||
{ ghcVer :: GHCTargetVersion
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -80,19 +81,19 @@ rmParser =
|
||||
<> command
|
||||
"cabal"
|
||||
( RmCabal
|
||||
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
|
||||
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
|
||||
(progDesc "Remove Cabal version")
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( RmHLS
|
||||
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
|
||||
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
|
||||
(progDesc "Remove haskell-language-server version")
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( RmStack
|
||||
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
|
||||
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
|
||||
(progDesc "Remove stack version")
|
||||
)
|
||||
)
|
||||
@@ -102,7 +103,7 @@ rmParser =
|
||||
|
||||
|
||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
|
||||
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool
|
||||
|
||||
|
||||
|
||||
@@ -170,7 +171,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
liftE $
|
||||
rmGHCVer ghcVer
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
|
||||
pure (getVersionInfo ghcVer GHC dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -186,7 +187,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
liftE $
|
||||
rmCabalVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv Cabal dls)
|
||||
pure (getVersionInfo (mkTVer tv) Cabal dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -201,7 +202,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
liftE $
|
||||
rmHLSVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv HLS dls)
|
||||
pure (getVersionInfo (mkTVer tv) HLS dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -216,7 +217,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
||||
liftE $
|
||||
rmStackVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv Stack dls)
|
||||
pure (getVersionInfo (mkTVer tv) Stack dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -68,7 +68,7 @@ data RunOptions = RunOptions
|
||||
, runBinDir :: Maybe FilePath
|
||||
, runQuick :: Bool
|
||||
, runCOMMAND :: [String]
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -92,7 +92,7 @@ runOpts =
|
||||
(eitherReader ghcVersionTagEither)
|
||||
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
<> (completer $ versionCompleter [] GHC)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -100,7 +100,7 @@ runOpts =
|
||||
(eitherReader toolVersionTagEither)
|
||||
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
||||
<> completer (tagCompleter Cabal [])
|
||||
<> (completer $ versionCompleter Nothing Cabal)
|
||||
<> (completer $ versionCompleter [] Cabal)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -108,7 +108,7 @@ runOpts =
|
||||
(eitherReader toolVersionTagEither)
|
||||
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
||||
<> completer (tagCompleter HLS [])
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
<> (completer $ versionCompleter [] HLS)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -116,7 +116,7 @@ runOpts =
|
||||
(eitherReader toolVersionTagEither)
|
||||
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
||||
<> completer (tagCompleter Stack [])
|
||||
<> (completer $ versionCompleter Nothing Stack)
|
||||
<> (completer $ versionCompleter [] Stack)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -132,7 +132,7 @@ runOpts =
|
||||
<*> switch
|
||||
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
|
||||
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -175,6 +175,7 @@ type RunEffects = '[ AlreadyInstalled
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
@@ -186,6 +187,11 @@ type RunEffects = '[ AlreadyInstalled
|
||||
, ProcessError
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
|
||||
@@ -225,6 +231,7 @@ run :: forall m .
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, Alternative m
|
||||
)
|
||||
=> RunOptions
|
||||
-> IO AppState
|
||||
@@ -254,7 +261,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
liftIO $ putStr tmp
|
||||
pure ExitSuccess
|
||||
(cmd:args) -> do
|
||||
newEnv <- liftIO $ addToPath tmp runAppendPATH
|
||||
newEnv <- liftIO $ addToPath [tmp] runAppendPATH
|
||||
let pathVar = if isWindows then "Path" else "PATH"
|
||||
forM_ (Map.lookup pathVar . Map.fromList $ newEnv) $ liftIO . setEnv pathVar
|
||||
#ifndef IS_WINDOWS
|
||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||
pure ExitSuccess
|
||||
@@ -282,6 +291,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
)
|
||||
=> Excepts
|
||||
'[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] (ResourceT (ReaderT AppState m)) Toolchain
|
||||
@@ -327,11 +337,13 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, Alternative m
|
||||
)
|
||||
=> Toolchain
|
||||
-> FilePath
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, UnknownArchive
|
||||
@@ -351,13 +363,18 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
, CopyError
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
] (ResourceT (ReaderT AppState m)) ()
|
||||
installToolChainFull Toolchain{..} tmp = do
|
||||
case ghcVer of
|
||||
Just v -> do
|
||||
isInstalled <- lift $ checkIfToolInstalled' GHC v
|
||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
v
|
||||
GHCupInternal
|
||||
False
|
||||
[]
|
||||
@@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Versions
|
||||
import GHC.Unicode
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
@@ -53,6 +53,7 @@ data SetCommand = SetGHC SetOptions
|
||||
| SetCabal SetOptions
|
||||
| SetHLS SetOptions
|
||||
| SetStack SetOptions
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -64,7 +65,7 @@ data SetCommand = SetGHC SetOptions
|
||||
|
||||
data SetOptions = SetOptions
|
||||
{ sToolVer :: SetToolVersion
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -139,9 +140,9 @@ setParser =
|
||||
setOpts :: Tool -> Parser SetOptions
|
||||
setOpts tool = SetOptions <$>
|
||||
(fromMaybe SetRecommended <$>
|
||||
optional (setVersionArgument (Just ListInstalled) tool))
|
||||
optional (setVersionArgument [ListInstalled True] tool))
|
||||
|
||||
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
|
||||
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
|
||||
setVersionArgument criteria tool =
|
||||
argument (eitherReader setEither)
|
||||
(metavar "VERSION|TAG|next"
|
||||
@@ -184,6 +185,7 @@ setFooter = [s|Discussion:
|
||||
type SetGHCEffects = '[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
@@ -198,6 +200,7 @@ runSetGHC runAppState =
|
||||
|
||||
type SetCabalEffects = '[ NotInstalled
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
@@ -212,6 +215,7 @@ runSetCabal runAppState =
|
||||
|
||||
type SetHLSEffects = '[ NotInstalled
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
@@ -226,6 +230,7 @@ runSetHLS runAppState =
|
||||
|
||||
type SetStackEffects = '[ NotInstalled
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
@@ -112,7 +112,7 @@ testOpts tool =
|
||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
||||
<*> (Just <$> toolVersionTagArgument [] tool)
|
||||
)
|
||||
<|> pure (Nothing, Nothing)
|
||||
)
|
||||
@@ -140,6 +140,7 @@ type TestGHCEffects = [ DigestError
|
||||
, TestFailed
|
||||
, NextVerNotFound
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
@@ -168,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
|
||||
(case testBindist of
|
||||
Nothing -> runTestGHC s' $ do
|
||||
(v, vi) <- liftE $ fromVersion testVer GHC
|
||||
liftE $ testGHCVer (_tvVersion v) addMakeArgs
|
||||
liftE $ testGHCVer v addMakeArgs
|
||||
pure vi
|
||||
Just uri -> do
|
||||
runTestGHC s'{ settings = settings {noVerify = True}} $ do
|
||||
(v, vi) <- liftE $ fromVersion testVer GHC
|
||||
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs
|
||||
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -48,6 +48,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
|
||||
| UnsetCabal UnsetOptions
|
||||
| UnsetHLS UnsetOptions
|
||||
| UnsetStack UnsetOptions
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -59,7 +60,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
|
||||
|
||||
data UnsetOptions = UnsetOptions
|
||||
{ sToolVer :: Maybe T.Text -- target platform triple
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -68,7 +69,7 @@ data UnsetOptions = UnsetOptions
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
unsetParser :: Parser UnsetCommand
|
||||
unsetParser =
|
||||
subparser
|
||||
@@ -113,7 +114,14 @@ unsetParser =
|
||||
unsetGHCFooter :: String
|
||||
unsetGHCFooter = [s|Discussion:
|
||||
Unsets the the current GHC version. That means there won't
|
||||
be a ~/.ghcup/bin/ghc anymore.|]
|
||||
be a ~/.ghcup/bin/ghc anymore.
|
||||
|
||||
Examples:
|
||||
# unset ghc
|
||||
ghcup unset ghc
|
||||
|
||||
# unset ghc for the target version
|
||||
ghcup unset ghc armv7-unknown-linux-gnueabihf|]
|
||||
|
||||
unsetCabalFooter :: String
|
||||
unsetCabalFooter = [s|Discussion:
|
||||
@@ -35,7 +35,7 @@ import System.Environment
|
||||
import GHCup.Utils
|
||||
import System.FilePath
|
||||
import GHCup.Types.Optics
|
||||
import Data.Versions hiding (str)
|
||||
import Data.Versions
|
||||
|
||||
|
||||
|
||||
@@ -50,7 +50,7 @@ import Data.Versions hiding (str)
|
||||
data UpgradeOpts = UpgradeInplace
|
||||
| UpgradeAt FilePath
|
||||
| UpgradeGHCupDir
|
||||
deriving Show
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -54,6 +54,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
||||
| WhereisCacheDir
|
||||
| WhereisLogsDir
|
||||
| WhereisConfDir
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -66,7 +67,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
||||
|
||||
data WhereisOptions = WhereisOptions {
|
||||
directory :: Bool
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -82,7 +83,7 @@ whereisP = subparser
|
||||
command
|
||||
"ghc"
|
||||
(WhereisTool GHC <$> info
|
||||
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
|
||||
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
|
||||
( progDesc "Get GHC location"
|
||||
<> footerDoc (Just $ text whereisGHCFooter ))
|
||||
)
|
||||
@@ -90,7 +91,7 @@ whereisP = subparser
|
||||
command
|
||||
"cabal"
|
||||
(WhereisTool Cabal <$> info
|
||||
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
|
||||
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
|
||||
( progDesc "Get cabal location"
|
||||
<> footerDoc (Just $ text whereisCabalFooter ))
|
||||
)
|
||||
@@ -98,7 +99,7 @@ whereisP = subparser
|
||||
command
|
||||
"hls"
|
||||
(WhereisTool HLS <$> info
|
||||
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
|
||||
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
|
||||
( progDesc "Get HLS location"
|
||||
<> footerDoc (Just $ text whereisHLSFooter ))
|
||||
)
|
||||
@@ -106,7 +107,7 @@ whereisP = subparser
|
||||
command
|
||||
"stack"
|
||||
(WhereisTool Stack <$> info
|
||||
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
|
||||
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
|
||||
( progDesc "Get stack location"
|
||||
<> footerDoc (Just $ text whereisStackFooter ))
|
||||
)
|
||||
@@ -222,6 +223,7 @@ type WhereisEffects = '[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
, NextVerNotFound
|
||||
, TagNotFound
|
||||
, DayNotFound
|
||||
]
|
||||
|
||||
|
||||
27
lib/GHCup.hs
27
lib/GHCup.hs
@@ -134,15 +134,24 @@ rmTool :: ( MonadReader env m
|
||||
=> ListResult
|
||||
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||
rmTool ListResult {lVer, lTool, lCross} = do
|
||||
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
|
||||
let printRmTool = logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
|
||||
case lTool of
|
||||
GHC ->
|
||||
GHC -> do
|
||||
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
||||
in rmGHCVer ghcTargetVersion
|
||||
HLS -> rmHLSVer lVer
|
||||
Cabal -> liftE $ rmCabalVer lVer
|
||||
Stack -> liftE $ rmStackVer lVer
|
||||
GHCup -> lift rmGhcup
|
||||
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
|
||||
rmGHCVer ghcTargetVersion
|
||||
HLS -> do
|
||||
printRmTool
|
||||
rmHLSVer lVer
|
||||
Cabal -> do
|
||||
printRmTool
|
||||
liftE $ rmCabalVer lVer
|
||||
Stack -> do
|
||||
printRmTool
|
||||
liftE $ rmStackVer lVer
|
||||
GHCup -> do
|
||||
printRmTool
|
||||
lift rmGhcup
|
||||
|
||||
|
||||
rmGhcupDirs :: ( MonadReader env m
|
||||
@@ -303,7 +312,7 @@ upgradeGHCup mtarget force' fatal = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
lift $ logInfo "Upgrading GHCup..."
|
||||
let latestVer = fst (fromJust (getLatest dls GHCup))
|
||||
let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
|
||||
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
|
||||
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
|
||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||
@@ -492,7 +501,7 @@ rmOldGHC :: ( MonadReader env m
|
||||
=> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||
rmOldGHC = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls
|
||||
let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls
|
||||
ghcs <- lift $ fmap rights getInstalledGHCs
|
||||
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
||||
|
||||
|
||||
@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( patch )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
@@ -280,6 +281,6 @@ rmCabalVer ver = do
|
||||
|
||||
when (Just ver == cSet) $ do
|
||||
cVers <- lift $ fmap rights getInstalledCabals
|
||||
case headMay . reverse . sort $ cVers of
|
||||
case headMay . sortBy (comparing Down) $ cVers of
|
||||
Just latestver -> setCabal latestver
|
||||
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)
|
||||
|
||||
@@ -5,7 +5,6 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
|
||||
{-|
|
||||
Module : GHCup.Download
|
||||
Description : Downloading
|
||||
@@ -31,9 +30,11 @@ import GHCup.Download.Utils
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import qualified GHCup.Types.Stack as Stack
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Platform
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger.Internal
|
||||
@@ -55,6 +56,7 @@ import Data.ByteString ( ByteString )
|
||||
import Data.CaseInsensitive ( mk )
|
||||
#endif
|
||||
import Data.Maybe
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock.POSIX
|
||||
@@ -112,24 +114,71 @@ getDownloadsF :: ( FromJSONKey Tool
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Excepts
|
||||
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
=> PlatformRequest
|
||||
-> Excepts
|
||||
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
|
||||
m
|
||||
GHCupInfo
|
||||
getDownloadsF = do
|
||||
getDownloadsF pfreq@(PlatformRequest arch plat _) = do
|
||||
Settings { urlSource } <- lift getSettings
|
||||
case urlSource of
|
||||
GHCupURL -> liftE $ getBase ghcupURL
|
||||
(OwnSource exts) -> do
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo ext
|
||||
(OwnSpec av) -> pure av
|
||||
(AddSource exts) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo (base:ext)
|
||||
|
||||
let newUrlSources = fromURLSource urlSource
|
||||
infos <- liftE $ mapM dl' newUrlSources
|
||||
keys <- if any isRight infos
|
||||
then liftE . reThrowAll @_ @_ @'[StackPlatformDetectError] StackPlatformDetectError $ getStackPlatformKey pfreq
|
||||
else pure []
|
||||
ghcupInfos <- fmap catMaybes $ forM infos $ \case
|
||||
Left gi -> pure (Just gi)
|
||||
Right si -> pure $ fromStackSetupInfo si keys
|
||||
mergeGhcupInfo ghcupInfos
|
||||
where
|
||||
|
||||
dl' :: ( FromJSONKey Tool
|
||||
, FromJSONKey Version
|
||||
, FromJSON VersionInfo
|
||||
, MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> NewURLSource
|
||||
-> Excepts
|
||||
'[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
|
||||
m (Either GHCupInfo Stack.SetupInfo)
|
||||
dl' NewGHCupURL = fmap Left $ liftE $ getBase @GHCupInfo ghcupURL
|
||||
dl' NewStackSetupURL = fmap Right $ liftE $ getBase @Stack.SetupInfo stackSetupURL
|
||||
dl' (NewGHCupInfo gi) = pure (Left gi)
|
||||
dl' (NewSetupInfo si) = pure (Right si)
|
||||
dl' (NewURI uri) = catchE @JSONError (\(JSONDecodeError _) -> Right <$> getBase @Stack.SetupInfo uri)
|
||||
$ fmap Left $ getBase @GHCupInfo uri
|
||||
|
||||
fromStackSetupInfo :: MonadThrow m
|
||||
=> Stack.SetupInfo
|
||||
-> [String]
|
||||
-> m GHCupInfo
|
||||
fromStackSetupInfo (Stack.siGHCs -> ghcDli) keys = do
|
||||
let ghcVersionsPerKey = (`M.lookup` ghcDli) <$> (T.pack <$> keys)
|
||||
ghcVersions = fromMaybe mempty . listToMaybe . catMaybes $ ghcVersionsPerKey
|
||||
(ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
|
||||
M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
|
||||
let ghcupDownloads' = M.singleton GHC (M.map fromDownloadInfo ghcupInfo')
|
||||
pure (GHCupInfo mempty ghcupDownloads' mempty)
|
||||
where
|
||||
fromDownloadInfo :: DownloadInfo -> VersionInfo
|
||||
fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
|
||||
in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
|
||||
|
||||
fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
|
||||
fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
|
||||
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
|
||||
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
|
||||
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
|
||||
|
||||
|
||||
mergeGhcupInfo :: MonadFail m
|
||||
=> [GHCupInfo]
|
||||
-> m GHCupInfo
|
||||
@@ -141,6 +190,7 @@ getDownloadsF = do
|
||||
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
|
||||
|
||||
|
||||
|
||||
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
|
||||
yamlFromCache uri = do
|
||||
Dirs{..} <- getDirs
|
||||
@@ -151,7 +201,7 @@ etagsFile :: FilePath -> FilePath
|
||||
etagsFile = (<.> "etags")
|
||||
|
||||
|
||||
getBase :: ( MonadReader env m
|
||||
getBase :: forall j m env . ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadFail m
|
||||
@@ -159,9 +209,10 @@ getBase :: ( MonadReader env m
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
, FromJSON j
|
||||
)
|
||||
=> URI
|
||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
|
||||
getBase uri = do
|
||||
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
||||
|
||||
@@ -263,10 +314,13 @@ getBase uri = do
|
||||
dlWithMod modTime json_file = do
|
||||
let (dir, fn) = splitFileName json_file
|
||||
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
|
||||
liftIO $ setModificationTime f modTime
|
||||
liftIO $ setAccessTime f modTime
|
||||
pure f
|
||||
|
||||
-- make these failures non-fatal, also see:
|
||||
-- https://github.com/actions/runner-images/issues/7061
|
||||
handleIO (\e -> logWarn $ "setModificationTime failed with: " <> T.pack (displayException e)) $ liftIO $ setModificationTime f modTime
|
||||
handleIO (\e -> logWarn $ "setAccessTime failed with: " <> T.pack (displayException e)) $ liftIO $ setAccessTime f modTime
|
||||
|
||||
pure f
|
||||
|
||||
getDownloadInfo :: ( MonadReader env m
|
||||
, HasPlatformReq env
|
||||
@@ -279,8 +333,21 @@ getDownloadInfo :: ( MonadReader env m
|
||||
'[NoDownload]
|
||||
m
|
||||
DownloadInfo
|
||||
getDownloadInfo t v = do
|
||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
||||
getDownloadInfo t v = getDownloadInfo' t (mkTVer v)
|
||||
|
||||
getDownloadInfo' :: ( MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
)
|
||||
=> Tool
|
||||
-> GHCTargetVersion
|
||||
-- ^ tool version
|
||||
-> Excepts
|
||||
'[NoDownload]
|
||||
m
|
||||
DownloadInfo
|
||||
getDownloadInfo' t v = do
|
||||
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
let distro_preview f g =
|
||||
@@ -301,7 +368,7 @@ getDownloadInfo t v = do
|
||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||
|
||||
maybe
|
||||
(throwE NoDownload)
|
||||
(throwE $ NoDownload v t (Just pfreq))
|
||||
pure
|
||||
(case p of
|
||||
-- non-musl won't work on alpine
|
||||
@@ -310,6 +377,7 @@ getDownloadInfo t v = do
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- | Tries to download from the given http or https url
|
||||
-- and saves the result in continuous memory into a file.
|
||||
-- If the filename is not provided, then we:
|
||||
@@ -629,7 +697,9 @@ downloadCached dli mfn = do
|
||||
True -> downloadCached' dli mfn Nothing
|
||||
False -> do
|
||||
tmp <- lift withGHCupTmpDir
|
||||
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
|
||||
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
|
||||
where
|
||||
outputFileName = mfn <|> _dlOutput dli
|
||||
|
||||
|
||||
downloadCached' :: ( MonadReader env m
|
||||
@@ -648,7 +718,7 @@ downloadCached' :: ( MonadReader env m
|
||||
downloadCached' dli mfn mDestDir = do
|
||||
Dirs { cacheDir } <- lift getDirs
|
||||
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
|
||||
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
|
||||
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
|
||||
let cachfile = destDir </> fn
|
||||
fileExists <- liftIO $ doesFileExist cachfile
|
||||
if
|
||||
@@ -656,7 +726,9 @@ downloadCached' dli mfn mDestDir = do
|
||||
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
|
||||
liftE $ checkDigest (view dlHash dli) cachfile
|
||||
pure cachfile
|
||||
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
|
||||
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
|
||||
where
|
||||
outputFileName = mfn <|> _dlOutput dli
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -35,7 +35,10 @@ import URI.ByteString
|
||||
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
import Data.Data (Proxy(..))
|
||||
import Data.Time (Day)
|
||||
|
||||
|
||||
|
||||
@@ -57,6 +60,7 @@ allHFError = unlines allErrors
|
||||
, let proxy = Proxy :: Proxy CopyError in format proxy
|
||||
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
|
||||
, let proxy = Proxy :: Proxy TagNotFound in format proxy
|
||||
, let proxy = Proxy :: Proxy DayNotFound in format proxy
|
||||
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
|
||||
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
|
||||
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
|
||||
@@ -82,6 +86,8 @@ allHFError = unlines allErrors
|
||||
, let proxy = Proxy :: Proxy HadrianNotFound in format proxy
|
||||
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
|
||||
, let proxy = Proxy :: Proxy ContentLengthError in format proxy
|
||||
, let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
|
||||
, let proxy = Proxy :: Proxy UnsupportedSetupCombo in format proxy
|
||||
, ""
|
||||
, "# high level errors (4000+)"
|
||||
, let proxy = Proxy :: Proxy DownloadFailed in format proxy
|
||||
@@ -94,6 +100,7 @@ allHFError = unlines allErrors
|
||||
, let proxy = Proxy :: Proxy ParseError in format proxy
|
||||
, let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
|
||||
, let proxy = Proxy :: Proxy NoUrlBase in format proxy
|
||||
, let proxy = Proxy :: Proxy DigestMissing in format proxy
|
||||
, ""
|
||||
, "# orphans (800+)"
|
||||
, let proxy = Proxy :: Proxy URIParseError in format proxy
|
||||
@@ -201,12 +208,26 @@ instance HFErrorProject NoCompatiblePlatform where
|
||||
eDesc _ = "No compatible platform could be found"
|
||||
|
||||
-- | Unable to find a download for the requested version/distro.
|
||||
data NoDownload = NoDownload
|
||||
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
|
||||
| NoDownload' GlobalTool
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoDownload where
|
||||
pPrint NoDownload =
|
||||
text (eDesc (Proxy :: Proxy NoDownload))
|
||||
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
|
||||
| (Just target) <- mtarget
|
||||
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
|
||||
= text $ "Unable to find a download for "
|
||||
<> show tool
|
||||
<> " version '"
|
||||
<> T.unpack (tVerToText tver)
|
||||
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
|
||||
<> "Perhaps you meant: 'ghcup <command> "
|
||||
<> T.unpack target
|
||||
<> " "
|
||||
<> T.unpack (prettyVer vv)
|
||||
<> "'"
|
||||
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
|
||||
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
|
||||
|
||||
instance HFErrorProject NoDownload where
|
||||
eBase _ = 10
|
||||
@@ -308,6 +329,21 @@ instance HFErrorProject TagNotFound where
|
||||
eBase _ = 90
|
||||
eDesc _ = "Unable to find a tag of a tool"
|
||||
|
||||
-- | Unable to find a release day of a tool
|
||||
data DayNotFound = DayNotFound Day Tool (Maybe Day)
|
||||
deriving Show
|
||||
|
||||
instance Pretty DayNotFound where
|
||||
pPrint (DayNotFound day tool Nothing) =
|
||||
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
|
||||
pPrint (DayNotFound day tool (Just alternateDay)) =
|
||||
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
|
||||
text "but found an alternative date" <+> text (show alternateDay)
|
||||
|
||||
instance HFErrorProject DayNotFound where
|
||||
eBase _ = 95
|
||||
eDesc _ = "Unable to find a release date of a tool"
|
||||
|
||||
-- | Unable to find the next version of a tool (the one after the currently
|
||||
-- set one).
|
||||
data NextVerNotFound = NextVerNotFound Tool
|
||||
@@ -640,6 +676,30 @@ instance HFErrorProject ContentLengthError where
|
||||
eBase _ = 340
|
||||
eDesc _ = "File content length verification failed"
|
||||
|
||||
data DuplicateReleaseChannel = DuplicateReleaseChannel NewURLSource
|
||||
deriving Show
|
||||
|
||||
instance HFErrorProject DuplicateReleaseChannel where
|
||||
eBase _ = 350
|
||||
eDesc _ = "Duplicate release channel detected when adding new source.\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
|
||||
|
||||
instance Pretty DuplicateReleaseChannel where
|
||||
pPrint (DuplicateReleaseChannel source) =
|
||||
text $ "Duplicate release channel detected when adding: \n "
|
||||
<> show source
|
||||
<> "\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
|
||||
|
||||
data UnsupportedSetupCombo = UnsupportedSetupCombo Architecture Platform
|
||||
deriving Show
|
||||
|
||||
instance Pretty UnsupportedSetupCombo where
|
||||
pPrint (UnsupportedSetupCombo arch plat) =
|
||||
text "Could not find a compatible setup combo for:" <+> pPrint arch <+> pPrint plat
|
||||
|
||||
instance HFErrorProject UnsupportedSetupCombo where
|
||||
eBase _ = 360
|
||||
eDesc _ = "Could not find a compatible setup combo"
|
||||
|
||||
-------------------------
|
||||
--[ High-level errors ]--
|
||||
-------------------------
|
||||
@@ -727,6 +787,22 @@ instance HFErrorProject GHCupSetError where
|
||||
eNum (GHCupSetError xs) = 9000 + eNum xs
|
||||
eDesc _ = "Setting the current version failed."
|
||||
|
||||
-- | Executing stacks platform detection failed.
|
||||
data StackPlatformDetectError = forall es . (ToVariantMaybe StackPlatformDetectError es, PopVariant StackPlatformDetectError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => StackPlatformDetectError (V es)
|
||||
|
||||
instance Pretty StackPlatformDetectError where
|
||||
pPrint (StackPlatformDetectError reason) =
|
||||
case reason of
|
||||
VMaybe (_ :: StackPlatformDetectError) -> pPrint reason
|
||||
_ -> text "Running stack platform detection logic failed:" <+> pPrint reason
|
||||
|
||||
deriving instance Show StackPlatformDetectError
|
||||
|
||||
instance HFErrorProject StackPlatformDetectError where
|
||||
eBase _ = 6000
|
||||
eNum (StackPlatformDetectError xs) = 6000 + eNum xs
|
||||
eDesc _ = "Running stack platform detection logic failed."
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
--[ True Exceptions (e.g. for MonadThrow) ]--
|
||||
@@ -774,6 +850,18 @@ instance HFErrorProject NoUrlBase where
|
||||
eBase _ = 520
|
||||
eDesc _ = "URL does not have a base filename."
|
||||
|
||||
data DigestMissing = DigestMissing URI
|
||||
deriving Show
|
||||
|
||||
instance Pretty DigestMissing where
|
||||
pPrint (DigestMissing uri) =
|
||||
text "Digest missing for:" <+> (text . T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
|
||||
|
||||
instance Exception DigestMissing
|
||||
|
||||
instance HFErrorProject DigestMissing where
|
||||
eBase _ = 530
|
||||
eDesc _ = "An expected digest is missing."
|
||||
|
||||
|
||||
------------------------
|
||||
|
||||
320
lib/GHCup/GHC.hs
320
lib/GHCup/GHC.hs
@@ -74,15 +74,17 @@ import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import qualified Data.ByteString.Base16 as B16
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
data GHCVer v = SourceDist v
|
||||
| GitDist GitBranch
|
||||
| RemoteDist URI
|
||||
data GHCVer = SourceDist Version
|
||||
| GitDist GitBranch
|
||||
| RemoteDist URI
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -105,7 +107,7 @@ testGHCVer :: ( MonadFail m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
=> GHCTargetVersion
|
||||
-> [T.Text]
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
@@ -125,7 +127,7 @@ testGHCVer ver addMakeArgs = do
|
||||
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||
?? NoDownload
|
||||
?? NoDownload ver GHC Nothing
|
||||
|
||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||
|
||||
@@ -145,7 +147,7 @@ testGHCBindist :: ( MonadFail m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Version
|
||||
-> GHCTargetVersion
|
||||
-> [T.Text]
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
@@ -182,7 +184,7 @@ testPackedGHC :: ( MonadMask m
|
||||
)
|
||||
=> FilePath -- ^ Path to the packed GHC bindist
|
||||
-> Maybe TarDir -- ^ Subdir of the archive
|
||||
-> Version -- ^ The GHC version
|
||||
-> GHCTargetVersion -- ^ The GHC version
|
||||
-> [T.Text] -- ^ additional make args
|
||||
-> Excepts
|
||||
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
|
||||
@@ -208,19 +210,23 @@ testUnpackedGHC :: ( MonadReader env m
|
||||
, MonadIO m
|
||||
)
|
||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
|
||||
-> Version -- ^ The GHC version
|
||||
-> GHCTargetVersion -- ^ The GHC version
|
||||
-> [T.Text] -- ^ additional configure args for bindist
|
||||
-> Excepts '[ProcessError] m ()
|
||||
testUnpackedGHC path ver addMakeArgs = do
|
||||
lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!"
|
||||
ghcDir <- lift $ ghcupGHCDir (mkTVer ver)
|
||||
testUnpackedGHC path tver addMakeArgs = do
|
||||
lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
|
||||
ghcDir <- lift $ ghcupGHCDir tver
|
||||
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
|
||||
env <- liftIO $ addToPath ghcBinDir False
|
||||
env <- liftIO $ addToPath [ghcBinDir] False
|
||||
let pathVar = if isWindows then "Path" else "PATH"
|
||||
forM_ (Map.lookup pathVar . Map.fromList $ env) $ liftIO . setEnv pathVar
|
||||
|
||||
lEM $ make' (fmap T.unpack addMakeArgs)
|
||||
(Just $ fromGHCupPath path)
|
||||
"ghc-test"
|
||||
(Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env)
|
||||
(Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver)
|
||||
<> "ghc-"
|
||||
<> T.unpack (prettyVer $ _tvVersion tver)) : env)
|
||||
pure ()
|
||||
|
||||
|
||||
@@ -243,7 +249,7 @@ fetchGHCSrc :: ( MonadFail m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
=> GHCTargetVersion
|
||||
-> Maybe FilePath
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
@@ -258,7 +264,7 @@ fetchGHCSrc v mfp = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
?? NoDownload v GHC Nothing
|
||||
liftE $ downloadCached' dlInfo Nothing mfp
|
||||
|
||||
|
||||
@@ -283,7 +289,7 @@ installGHCBindist :: ( MonadFail m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> DownloadInfo -- ^ where/how to download
|
||||
-> Version -- ^ the version to install
|
||||
-> GHCTargetVersion -- ^ the version to install
|
||||
-> InstallDir
|
||||
-> Bool -- ^ Force install
|
||||
-> [T.Text] -- ^ additional configure args for bindist
|
||||
@@ -306,10 +312,8 @@ installGHCBindist :: ( MonadFail m
|
||||
]
|
||||
m
|
||||
()
|
||||
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
||||
let tver = mkTVer ver
|
||||
|
||||
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
|
||||
installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
|
||||
lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
|
||||
|
||||
regularGHCInstalled <- lift $ ghcInstalled tver
|
||||
|
||||
@@ -317,7 +321,7 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
||||
| not forceInstall
|
||||
, regularGHCInstalled
|
||||
, GHCupInternal <- installDir -> do
|
||||
throwE $ AlreadyInstalled GHC ver
|
||||
throwE $ AlreadyInstalled GHC (_tvVersion tver)
|
||||
|
||||
| forceInstall
|
||||
, regularGHCInstalled
|
||||
@@ -336,12 +340,12 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
||||
case installDir of
|
||||
IsolateDir isoDir -> do -- isolated install
|
||||
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
|
||||
GHCupInternal -> do -- regular install
|
||||
-- prepare paths
|
||||
ghcdir <- lift $ ghcupGHCDir tver
|
||||
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
|
||||
|
||||
-- make symlinks & stuff when regular install,
|
||||
liftE $ postGHCInstall tver
|
||||
@@ -375,7 +379,7 @@ installPackedGHC :: ( MonadMask m
|
||||
=> FilePath -- ^ Path to the packed GHC bindist
|
||||
-> Maybe TarDir -- ^ Subdir of the archive
|
||||
-> InstallDirResolved
|
||||
-> Version -- ^ The GHC version
|
||||
-> GHCTargetVersion -- ^ The GHC version
|
||||
-> Bool -- ^ Force install
|
||||
-> [T.Text] -- ^ additional configure args for bindist
|
||||
-> Excepts
|
||||
@@ -423,26 +427,22 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
)
|
||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
||||
-> InstallDirResolved -- ^ Path to install to
|
||||
-> Version -- ^ The GHC version
|
||||
-> GHCTargetVersion -- ^ The GHC version
|
||||
-> Bool -- ^ Force install
|
||||
-> [T.Text] -- ^ additional configure args for bindist
|
||||
-> Excepts '[ProcessError, MergeFileTreeError] m ()
|
||||
installUnpackedGHC path inst ver forceInstall addConfArgs
|
||||
installUnpackedGHC path inst tver forceInstall addConfArgs
|
||||
| isWindows = do
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
-- Windows bindists are relocatable and don't need
|
||||
-- to run configure.
|
||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||
liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> do
|
||||
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
|
||||
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
|
||||
liftIO $ moveFilePortable source dest
|
||||
forM_ mtime $ liftIO . setModificationTime dest
|
||||
liftE $ mergeGHCFileTree path inst tver forceInstall
|
||||
| otherwise = do
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
|
||||
let ldOverride
|
||||
| ver >= [vver|8.2.2|]
|
||||
| _tvVersion tver >= [vver|8.2.2|]
|
||||
, _rPlatform `elem` [Linux Alpine, Darwin]
|
||||
= ["--disable-ld-override"]
|
||||
| otherwise
|
||||
@@ -451,7 +451,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
lEM $ execLogged "sh"
|
||||
("./configure" : ("--prefix=" <> fromInstallDir inst)
|
||||
: (ldOverride <> (T.unpack <$> addConfArgs))
|
||||
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
|
||||
)
|
||||
(Just $ fromGHCupPath path)
|
||||
"ghc-configure"
|
||||
@@ -459,17 +459,44 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
||||
tmpInstallDest <- lift withGHCupTmpDir
|
||||
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
|
||||
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
|
||||
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall
|
||||
pure ()
|
||||
|
||||
|
||||
mergeGHCFileTree :: ( MonadReader env m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, MonadMask m
|
||||
, MonadResource m
|
||||
, MonadFail m
|
||||
)
|
||||
=> GHCupPath -- ^ Path to the root of the tree
|
||||
-> InstallDirResolved -- ^ Path to install to
|
||||
-> GHCTargetVersion -- ^ The GHC version
|
||||
-> Bool -- ^ Force install
|
||||
-> Excepts '[MergeFileTreeError] m ()
|
||||
mergeGHCFileTree root inst tver forceInstall
|
||||
| isWindows = do
|
||||
liftE $ mergeFileTree root inst GHC tver $ \source dest -> do
|
||||
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
|
||||
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
|
||||
liftIO $ moveFilePortable source dest
|
||||
forM_ mtime $ liftIO . setModificationTime dest
|
||||
| otherwise = do
|
||||
liftE $ mergeFileTree root
|
||||
inst
|
||||
GHC
|
||||
(mkTVer ver)
|
||||
tver
|
||||
(\f t -> liftIO $ do
|
||||
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
|
||||
install f t (not forceInstall)
|
||||
forM_ mtime $ setModificationTime t)
|
||||
|
||||
pure ()
|
||||
|
||||
|
||||
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
||||
-- following symlinks in @~\/.ghcup\/bin@:
|
||||
@@ -488,8 +515,9 @@ installGHCBin :: ( MonadFail m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, Alternative m
|
||||
)
|
||||
=> Version -- ^ the version to install
|
||||
=> GHCTargetVersion -- ^ the version to install
|
||||
-> InstallDir
|
||||
-> Bool -- ^ force install
|
||||
-> [T.Text] -- ^ additional configure args for bindist
|
||||
@@ -509,12 +537,17 @@ installGHCBin :: ( MonadFail m
|
||||
, ProcessError
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
m
|
||||
()
|
||||
installGHCBin ver installDir forceInstall addConfArgs = do
|
||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
||||
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
|
||||
installGHCBin tver installDir forceInstall addConfArgs = do
|
||||
dlinfo <- liftE $ getDownloadInfo' GHC tver
|
||||
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
|
||||
|
||||
|
||||
|
||||
@@ -708,7 +741,7 @@ rmGHCVer ver = do
|
||||
Just files -> do
|
||||
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
||||
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
||||
removeEmptyDirsRecursive dir
|
||||
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
|
||||
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
||||
f <- recordedInstallationFile GHC ver
|
||||
lift $ recycleFile f
|
||||
@@ -755,7 +788,8 @@ compileGHC :: ( MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> GHCVer GHCTargetVersion
|
||||
=> GHCVer
|
||||
-> Maybe Text -- ^ cross target
|
||||
-> Maybe Version -- ^ overwrite version
|
||||
-> Either Version FilePath -- ^ version to bootstrap with
|
||||
-> Maybe Int -- ^ jobs
|
||||
@@ -763,7 +797,7 @@ compileGHC :: ( MonadMask m
|
||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||
-> [Text] -- ^ additional args to ./configure
|
||||
-> Maybe String -- ^ build flavour
|
||||
-> Bool
|
||||
-> Maybe BuildSystem
|
||||
-> InstallDir
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
@@ -792,20 +826,21 @@ compileGHC :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
GHCTargetVersion
|
||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
|
||||
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||
= do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
SourceDist tver -> do
|
||||
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
||||
SourceDist ver -> do
|
||||
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||
|
||||
-- download source tarball
|
||||
let tver = mkTVer ver
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
preview (ix GHC % ix tver % viSourceDL % _Just) dls
|
||||
?? NoDownload tver GHC (Just pfreq)
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
|
||||
-- unpack
|
||||
@@ -818,7 +853,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
(view dlSubdir dlInfo)
|
||||
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
||||
|
||||
pure (workdir, tmpUnpack, Just tver)
|
||||
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
|
||||
|
||||
RemoteDist uri -> do
|
||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||
@@ -842,7 +877,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||
|
||||
pure (workdir, tmpUnpack, mkTVer <$> tver)
|
||||
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||
|
||||
-- clone from git
|
||||
GitDist GitBranch{..} -> do
|
||||
@@ -899,12 +934,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
|
||||
pure tver
|
||||
|
||||
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
|
||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||
-- the version that's installed may differ from the
|
||||
-- compiled version, so the user can overwrite it
|
||||
installVer <- if | Just ov' <- ov -> pure (mkTVer ov')
|
||||
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
||||
| Just tver' <- tver -> pure tver'
|
||||
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
|
||||
| otherwise -> fail "No GHC version given and couldn't detect version. Giving up..."
|
||||
|
||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||
@@ -923,16 +958,31 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
||||
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
||||
|
||||
(mBindist, bmk) <- liftE $ runBuildAction
|
||||
mBindist <- liftE $ runBuildAction
|
||||
tmpUnpack
|
||||
(do
|
||||
b <- if hadrian
|
||||
-- prefer 'tver', because the real version carries out compatibility checks
|
||||
-- we don't want the user to do funny things with it
|
||||
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
||||
pure (b, bmk)
|
||||
-- prefer 'tver', because the real version carries out compatibility checks
|
||||
-- we don't want the user to do funny things with it
|
||||
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||
case buildSystem of
|
||||
Just Hadrian -> do
|
||||
lift $ logInfo "Requested to use Hadrian"
|
||||
liftE doHadrian
|
||||
Just Make -> do
|
||||
lift $ logInfo "Requested to use Make"
|
||||
doMake
|
||||
Nothing -> do
|
||||
supportsHadrian <- liftE $ catchE @HadrianNotFound @'[HadrianNotFound] @'[] (\_ -> return False)
|
||||
$ fmap (const True)
|
||||
$ findHadrianFile (fromGHCupPath workdir)
|
||||
if supportsHadrian
|
||||
then do
|
||||
lift $ logInfo "Detected Hadrian"
|
||||
liftE doHadrian
|
||||
else do
|
||||
lift $ logInfo "Detected Make"
|
||||
doMake
|
||||
)
|
||||
|
||||
case installDir of
|
||||
@@ -948,12 +998,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
liftE $ installPackedGHC bindist
|
||||
(Just $ RegexDir "ghc-.*")
|
||||
ghcdir
|
||||
(installVer ^. tvVersion)
|
||||
installVer
|
||||
False -- not a force install, since we already overwrite when compiling.
|
||||
[]
|
||||
|
||||
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
|
||||
|
||||
case installDir of
|
||||
-- set and make symlinks for regular (non-isolated) installs
|
||||
GHCupInternal -> do
|
||||
@@ -976,20 +1024,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
=> GHCupPath
|
||||
-> Excepts '[ProcessError, ParseError] m Version
|
||||
getGHCVer tmpUnpack = do
|
||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
CapturedProcess {..} <- lift $ makeOut
|
||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||
case _exitCode of
|
||||
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
||||
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
|
||||
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
|
||||
hasVersionFile <- liftIO $ doesFileExist versionFile
|
||||
if hasVersionFile
|
||||
then do
|
||||
lift $ logDebug "Detected VERSION file, trying to extract"
|
||||
contents <- liftIO $ readFile versionFile
|
||||
either (throwE . ParseError . show) pure . MP.parse version' "" . T.pack . stripNewlineEnd $ contents
|
||||
else do
|
||||
lift $ logDebug "Didn't detect VERSION file, trying to extract via legacy 'make'"
|
||||
CapturedProcess {..} <- lift $ makeOut
|
||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||
case _exitCode of
|
||||
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
||||
|
||||
defaultConf =
|
||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
||||
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
||||
in case targetGhc of
|
||||
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
|
||||
_ -> default_mk
|
||||
in case crossTarget of
|
||||
Just _ -> cross_mk
|
||||
_ -> default_mk
|
||||
|
||||
compileHadrianBindist :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1015,18 +1072,17 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
m
|
||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||
compileHadrianBindist tver workdir ghcdir = do
|
||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just workdir) "ghc-bootstrap"
|
||||
|
||||
liftE $ configureBindist tver workdir ghcdir
|
||||
|
||||
lift $ logInfo "Building (this may take a while)..."
|
||||
hadrian_build <- liftE $ findHadrianFile workdir
|
||||
lEM $ execWithGhcEnv hadrian_build
|
||||
lEM $ execLogged hadrian_build
|
||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
||||
++ ["binary-dist"]
|
||||
)
|
||||
(Just workdir) "ghc-make"
|
||||
Nothing
|
||||
[tar] <- liftIO $ findFiles
|
||||
(workdir </> "_build" </> "bindist")
|
||||
(makeRegexOpts compExtended
|
||||
@@ -1059,6 +1115,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadResource m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath
|
||||
@@ -1070,6 +1129,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
, PatchFailed
|
||||
, ProcessError
|
||||
, NotFoundInPATH
|
||||
, MergeFileTreeError
|
||||
, CopyError]
|
||||
m
|
||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||
@@ -1091,7 +1151,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
|
||||
if | isCross tver -> do
|
||||
lift $ logInfo "Installing cross toolchain..."
|
||||
lEM $ make ["install"] (Just workdir)
|
||||
tmpInstallDest <- lift withGHCupTmpDir
|
||||
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just workdir)
|
||||
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir ghcdir)) ghcdir tver True
|
||||
pure Nothing
|
||||
| otherwise -> do
|
||||
lift $ logInfo "Creating bindist..."
|
||||
@@ -1164,8 +1226,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
|
||||
|
||||
-- for cross, we need Stage1Only
|
||||
case targetGhc of
|
||||
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||
case crossTarget of
|
||||
Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||
(InvalidBuildConfig
|
||||
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
||||
)
|
||||
@@ -1209,64 +1271,50 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
()
|
||||
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
||||
lift $ logInfo [s|configuring build|]
|
||||
|
||||
if | _tvVersion tver >= [vver|8.8.0|] -> do
|
||||
lEM $ execWithGhcEnv
|
||||
"sh"
|
||||
("./configure" : maybe mempty
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||
++ fmap T.unpack aargs
|
||||
)
|
||||
(Just workdir)
|
||||
"ghc-conf"
|
||||
| otherwise -> do
|
||||
lEM $ execLogged
|
||||
"sh"
|
||||
( [ "./configure", "--with-ghc=" <> either id id bghc
|
||||
]
|
||||
++ maybe mempty
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||
++ fmap T.unpack aargs
|
||||
)
|
||||
(Just workdir)
|
||||
"ghc-conf"
|
||||
Nothing
|
||||
lEM $ configureWithGhcBoot (Just tver)
|
||||
(maybe mempty
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||
++ fmap T.unpack aargs
|
||||
)
|
||||
(Just workdir)
|
||||
"ghc-conf"
|
||||
pure ()
|
||||
|
||||
execWithGhcEnv :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
=> FilePath -- ^ thing to execute
|
||||
-> [String] -- ^ args for the thing
|
||||
-> Maybe FilePath -- ^ optionally chdir into this
|
||||
-> FilePath -- ^ log filename (opened in append mode)
|
||||
-> m (Either ProcessError ())
|
||||
execWithGhcEnv fp args dir logf = do
|
||||
env <- ghcEnv
|
||||
execLogged fp args dir logf (Just env)
|
||||
configureWithGhcBoot :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
=> Maybe GHCTargetVersion
|
||||
-> [String] -- ^ args for configure
|
||||
-> Maybe FilePath -- ^ optionally chdir into this
|
||||
-> FilePath -- ^ log filename (opened in append mode)
|
||||
-> m (Either ProcessError ())
|
||||
configureWithGhcBoot mtver args dir logf = do
|
||||
let execNew = execLogged
|
||||
"sh"
|
||||
("./configure" : ("GHC=" <> bghc) : args)
|
||||
dir
|
||||
logf
|
||||
Nothing
|
||||
execOld = execLogged
|
||||
"sh"
|
||||
("./configure" : ("--with-ghc=" <> bghc) : args)
|
||||
dir
|
||||
logf
|
||||
Nothing
|
||||
if | Just tver <- mtver
|
||||
, _tvVersion tver >= [vver|8.8.0|] -> execNew
|
||||
| Nothing <- mtver -> execNew -- need some default for git checkouts where we don't know yet
|
||||
| otherwise -> execOld
|
||||
|
||||
bghc = case bstrap of
|
||||
Right g -> Right g
|
||||
Left bver -> Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
||||
|
||||
ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
|
||||
ghcEnv = do
|
||||
cEnv <- liftIO getEnvironment
|
||||
bghcPath <- case bghc of
|
||||
Right ghc' -> pure ghc'
|
||||
Left bver -> do
|
||||
spaths <- liftIO getSearchPath
|
||||
throwMaybeM (NotFoundInPATH bver) $ liftIO (searchPath spaths bver)
|
||||
pure (("GHC", bghcPath) : cEnv)
|
||||
Right g -> g
|
||||
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -43,6 +43,7 @@ import Control.Monad.Trans.Resource
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
import Data.Maybe
|
||||
import Data.String ( fromString )
|
||||
import Data.Text ( Text )
|
||||
@@ -74,6 +75,7 @@ data HLSVer = SourceDist Version
|
||||
| GitDist GitBranch
|
||||
| HackageDist Version
|
||||
| RemoteDist URI
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
@@ -353,7 +355,7 @@ compileHLS :: ( MonadMask m
|
||||
, NotInstalled
|
||||
] m Version
|
||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
Dirs { .. } <- lift getDirs
|
||||
|
||||
@@ -368,8 +370,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
||||
|
||||
-- download source tarball
|
||||
dlInfo <-
|
||||
preview (ix HLS % ix tver % viSourceDL % _Just) dls
|
||||
?? NoDownload
|
||||
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
||||
?? NoDownload (mkTVer tver) HLS (Just pfreq)
|
||||
dl <- liftE $ downloadCached dlInfo Nothing
|
||||
|
||||
-- unpack
|
||||
@@ -704,7 +706,7 @@ rmHLSVer ver = do
|
||||
when (Just ver == isHlsSet) $ do
|
||||
-- set latest hls
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
case headMay . reverse . sort $ hlsVers of
|
||||
case headMay . sortBy (comparing Down) $ hlsVers of
|
||||
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
||||
Nothing -> pure ()
|
||||
|
||||
@@ -715,8 +717,10 @@ getCabalVersion fp = do
|
||||
gpd <- case parseGenericPackageDescriptionMaybe contents of
|
||||
Nothing -> fail $ "could not parse cabal file: " <> fp
|
||||
Just r -> pure r
|
||||
let tver = (\c -> Version Nothing c [] Nothing)
|
||||
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
|
||||
let tver = (\c -> Version Nothing c Nothing Nothing)
|
||||
. Chunks
|
||||
. NE.fromList
|
||||
. fmap (Numeric . fromIntegral)
|
||||
. versionNumbers
|
||||
. pkgVersion
|
||||
. package
|
||||
|
||||
@@ -36,6 +36,7 @@ import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Time.Calendar ( Day )
|
||||
import Data.Versions hiding ( patch )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
@@ -61,10 +62,10 @@ import qualified Data.Text as T
|
||||
|
||||
|
||||
-- | Filter data type for 'listVersions'.
|
||||
data ListCriteria = ListInstalled
|
||||
| ListSet
|
||||
| ListAvailable
|
||||
deriving Show
|
||||
data ListCriteria = ListInstalled Bool
|
||||
| ListSet Bool
|
||||
| ListAvailable Bool
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A list result describes a single tool version
|
||||
-- and various of its properties.
|
||||
@@ -75,16 +76,16 @@ data ListResult = ListResult
|
||||
, lTag :: [Tag]
|
||||
, lInstalled :: Bool
|
||||
, lSet :: Bool -- ^ currently active version
|
||||
, fromSrc :: Bool -- ^ compiled from source
|
||||
, lStray :: Bool -- ^ not in download info
|
||||
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
||||
, hlsPowered :: Bool
|
||||
, lReleaseDay :: Maybe Day
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
|
||||
-- | Extract all available tool versions and their tags.
|
||||
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
|
||||
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo
|
||||
availableToolVersions av tool = view
|
||||
(at tool % non Map.empty)
|
||||
av
|
||||
@@ -93,19 +94,22 @@ availableToolVersions av tool = view
|
||||
-- | List all versions from the download info, as well as stray
|
||||
-- versions.
|
||||
listVersions :: ( MonadCatch m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
)
|
||||
=> Maybe Tool
|
||||
-> Maybe ListCriteria
|
||||
-> m [ListResult]
|
||||
listVersions lt' criteria = do
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
)
|
||||
=> Maybe Tool
|
||||
-> [ListCriteria]
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> (Maybe Day, Maybe Day)
|
||||
-> m [ListResult]
|
||||
listVersions lt' criteria hideOld showNightly days = do
|
||||
-- some annoying work to avoid too much repeated IO
|
||||
cSet <- cabalSet
|
||||
cabals <- getInstalledCabals
|
||||
@@ -129,13 +133,13 @@ listVersions lt' criteria = do
|
||||
slr <- strayGHCs avTools
|
||||
pure (sort (slr ++ lr))
|
||||
Cabal -> do
|
||||
slr <- strayCabals avTools cSet cabals
|
||||
slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals
|
||||
pure (sort (slr ++ lr))
|
||||
HLS -> do
|
||||
slr <- strayHLS avTools hlsSet' hlses
|
||||
slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses
|
||||
pure (sort (slr ++ lr))
|
||||
Stack -> do
|
||||
slr <- strayStacks avTools sSet stacks
|
||||
slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks
|
||||
pure (sort (slr ++ lr))
|
||||
GHCup -> do
|
||||
let cg = maybeToList $ currentGHCup avTools
|
||||
@@ -154,42 +158,28 @@ listVersions lt' criteria = do
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
=> Map.Map GHCTargetVersion VersionInfo
|
||||
-> m [ListResult]
|
||||
strayGHCs avTools = do
|
||||
ghcs <- getInstalledGHCs
|
||||
fmap catMaybes $ forM ghcs $ \case
|
||||
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
|
||||
case Map.lookup _tvVersion avTools of
|
||||
Right tver@GHCTargetVersion{ .. } -> do
|
||||
case Map.lookup tver avTools of
|
||||
Just _ -> pure Nothing
|
||||
Nothing -> do
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
|
||||
fromSrc <- ghcSrcInstalled tver
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
||||
pure $ Just $ ListResult
|
||||
{ lTool = GHC
|
||||
, lVer = _tvVersion
|
||||
, lCross = Nothing
|
||||
, lCross = _tvTarget
|
||||
, lTag = []
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup _tvVersion avTools)
|
||||
, lStray = isNothing (Map.lookup tver avTools)
|
||||
, lNoBindist = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
}
|
||||
Right tver@GHCTargetVersion{ .. } -> do
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
||||
fromSrc <- ghcSrcInstalled tver
|
||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
||||
pure $ Just $ ListResult
|
||||
{ lTool = GHC
|
||||
, lVer = _tvVersion
|
||||
, lCross = _tvTarget
|
||||
, lTag = []
|
||||
, lInstalled = True
|
||||
, lStray = True -- NOTE: cross currently cannot be installed via bindist
|
||||
, lNoBindist = False
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
@@ -221,8 +211,8 @@ listVersions lt' criteria = do
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup ver avTools)
|
||||
, lNoBindist = False
|
||||
, fromSrc = False -- actually, we don't know :>
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
@@ -255,8 +245,8 @@ listVersions lt' criteria = do
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup ver avTools)
|
||||
, lNoBindist = False
|
||||
, fromSrc = False -- actually, we don't know :>
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
@@ -290,8 +280,8 @@ listVersions lt' criteria = do
|
||||
, lInstalled = True
|
||||
, lStray = isNothing (Map.lookup ver avTools)
|
||||
, lNoBindist = False
|
||||
, fromSrc = False -- actually, we don't know :>
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
@@ -299,24 +289,24 @@ listVersions lt' criteria = do
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
||||
currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult
|
||||
currentGHCup av =
|
||||
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
|
||||
let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer ""
|
||||
listVer = Map.lookup currentVer av
|
||||
latestVer = fst <$> headOf (getTagged Latest) av
|
||||
recommendedVer = fst <$> headOf (getTagged Latest) av
|
||||
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
||||
in if | Map.member currentVer av -> Nothing
|
||||
| otherwise -> Just $ ListResult { lVer = currentVer
|
||||
| otherwise -> Just $ ListResult { lVer = _tvVersion currentVer
|
||||
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||
, lCross = Nothing
|
||||
, lTool = GHCup
|
||||
, fromSrc = False
|
||||
, lStray = isNothing listVer
|
||||
, lSet = True
|
||||
, lInstalled = True
|
||||
, lNoBindist = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = Nothing
|
||||
}
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
@@ -335,42 +325,41 @@ listVersions lt' criteria = do
|
||||
-> [Either FilePath Version]
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
-> (Version, VersionInfo)
|
||||
-> (GHCTargetVersion, VersionInfo)
|
||||
-> m ListResult
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do
|
||||
let v = _tvVersion tver
|
||||
case t of
|
||||
GHC -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
|
||||
let tver = mkTVer v
|
||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
|
||||
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
|
||||
lInstalled <- ghcInstalled tver
|
||||
fromSrc <- ghcSrcInstalled tver
|
||||
hlsPowered <- fmap (elem v) hlsGHCVersions
|
||||
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
||||
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
|
||||
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
|
||||
Cabal -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
|
||||
let lSet = cSet == Just v
|
||||
let lInstalled = elem v $ rights cabals
|
||||
pure ListResult { lVer = v
|
||||
, lCross = Nothing
|
||||
, lTag = tags
|
||||
, lTag = _viTags
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
, ..
|
||||
}
|
||||
GHCup -> do
|
||||
let lSet = prettyPVP ghcUpVer == prettyVer v
|
||||
let lInstalled = lSet
|
||||
pure ListResult { lVer = v
|
||||
, lTag = tags
|
||||
, lTag = _viTags
|
||||
, lCross = Nothing
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, lNoBindist = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
, ..
|
||||
}
|
||||
HLS -> do
|
||||
@@ -379,11 +368,11 @@ listVersions lt' criteria = do
|
||||
let lInstalled = elem v $ rights hlses
|
||||
pure ListResult { lVer = v
|
||||
, lCross = Nothing
|
||||
, lTag = tags
|
||||
, lTag = _viTags
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
, ..
|
||||
}
|
||||
Stack -> do
|
||||
@@ -392,19 +381,42 @@ listVersions lt' criteria = do
|
||||
let lInstalled = elem v $ rights stacks
|
||||
pure ListResult { lVer = v
|
||||
, lCross = Nothing
|
||||
, lTag = tags
|
||||
, lTag = _viTags
|
||||
, lTool = t
|
||||
, fromSrc = False
|
||||
, lStray = False
|
||||
, hlsPowered = False
|
||||
, lReleaseDay = _viReleaseDay
|
||||
, ..
|
||||
}
|
||||
|
||||
|
||||
filter' :: [ListResult] -> [ListResult]
|
||||
filter' lr = case criteria of
|
||||
Nothing -> lr
|
||||
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
|
||||
Just ListSet -> filter (\ListResult {..} -> lSet) lr
|
||||
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
|
||||
filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
|
||||
|
||||
filterDays :: [ListResult] -> [ListResult]
|
||||
filterDays lrs = case days of
|
||||
(Nothing, Nothing) -> lrs
|
||||
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
|
||||
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
|
||||
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
|
||||
|
||||
fromCriteria :: ListCriteria -> ListResult -> Bool
|
||||
fromCriteria lc ListResult{..} = case lc of
|
||||
ListInstalled b -> f b lInstalled
|
||||
ListSet b -> f b lSet
|
||||
ListAvailable b -> f b $ not lNoBindist
|
||||
where
|
||||
f b
|
||||
| b = id
|
||||
| otherwise = not
|
||||
|
||||
filterOld :: [ListResult] -> [ListResult]
|
||||
filterOld lr
|
||||
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
|
||||
| otherwise = lr
|
||||
|
||||
filterNightly :: [ListResult] -> [ListResult]
|
||||
filterNightly lr
|
||||
| showNightly = lr
|
||||
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr
|
||||
|
||||
|
||||
@@ -28,6 +28,8 @@ import GHCup.Prelude
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prelude.String.QQ
|
||||
import GHCup.Prelude.Version.QQ
|
||||
import GHCup.Prelude.MegaParsec
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -48,11 +50,18 @@ import Prelude hiding ( abs
|
||||
)
|
||||
import System.Info
|
||||
import System.OsRelease
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Void
|
||||
import qualified Data.List as L
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -197,3 +206,155 @@ getLinuxDistro = do
|
||||
try_debian_version = do
|
||||
ver <- T.readFile debian_version
|
||||
pure (T.pack "debian", Just ver)
|
||||
|
||||
|
||||
getStackGhcBuilds :: (MonadReader env m, HasLog env, MonadIO m)
|
||||
=> PlatformResult
|
||||
-> Excepts '[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError] m [String]
|
||||
getStackGhcBuilds PlatformResult{..} = do
|
||||
case _platform of
|
||||
Linux _ -> do
|
||||
-- Some systems don't have ldconfig in the PATH, so make sure to look in
|
||||
-- /sbin and /usr/sbin as well
|
||||
sbinEnv <- liftIO $ addToPath sbinDirs False
|
||||
ldConfig <- lift $ executeOut' "ldconfig" ["-p"] Nothing (Just sbinEnv)
|
||||
firstWords <- case ldConfig of
|
||||
CapturedProcess ExitSuccess so _ ->
|
||||
pure . mapMaybe (listToMaybe . T.words) . T.lines . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ so
|
||||
CapturedProcess (ExitFailure _) _ _ ->
|
||||
-- throwE $ NonZeroExit c "ldconfig" ["-p" ]
|
||||
pure []
|
||||
let checkLib :: (MonadReader env m, HasLog env, MonadIO m) => String -> m Bool
|
||||
checkLib lib
|
||||
| libT `elem` firstWords = do
|
||||
logDebug $ "Found shared library " <> libT <> " in 'ldconfig -p' output"
|
||||
pure True
|
||||
| isWindows =
|
||||
-- Cannot parse /usr/lib on Windows
|
||||
pure False
|
||||
| otherwise = hasMatches lib usrLibDirs
|
||||
-- This is a workaround for the fact that libtinfo.so.x doesn't
|
||||
-- appear in the 'ldconfig -p' output on Arch or Slackware even
|
||||
-- when it exists. There doesn't seem to be an easy way to get the
|
||||
-- true list of directories to scan for shared libs, but this
|
||||
-- works for our particular cases.
|
||||
where
|
||||
libT = T.pack lib
|
||||
|
||||
hasMatches :: (MonadReader env m, HasLog env, MonadIO m) => String -> [FilePath] -> m Bool
|
||||
hasMatches lib dirs = do
|
||||
matches <- filterM (liftIO . doesFileExist . (</> lib)) dirs
|
||||
case matches of
|
||||
[] -> logDebug ("Did not find shared library " <> libT) >> pure False
|
||||
(path:_) -> logDebug ("Found shared library " <> libT <> " in " <> T.pack path) >> pure True
|
||||
where
|
||||
libT = T.pack lib
|
||||
|
||||
getLibc6Version :: MonadIO m
|
||||
=> Excepts '[ParseError, ProcessError] m Version
|
||||
getLibc6Version = do
|
||||
CapturedProcess{..} <- lift $ executeOut "ldd" ["--version"] Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> either (throwE . ParseError . show) pure
|
||||
. MP.parse lddVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure c -> throwE $ NonZeroExit c "ldd" ["--version" ]
|
||||
|
||||
-- Assumes the first line of ldd has the format:
|
||||
--
|
||||
-- ldd (...) nn.nn
|
||||
--
|
||||
-- where nn.nn corresponds to the version of libc6.
|
||||
lddVersion :: MP.Parsec Void Text Version
|
||||
lddVersion = do
|
||||
skipWhile (/= ')')
|
||||
skip (== ')')
|
||||
skipSpace
|
||||
version'
|
||||
|
||||
hasMusl <- hasMatches relFileLibcMuslx86_64So1 libDirs
|
||||
mLibc6Version <- veitherToEither <$> runE getLibc6Version
|
||||
case mLibc6Version of
|
||||
Right libc6Version -> logDebug $ "Found shared library libc6 in version: " <> prettyVer libc6Version
|
||||
Left _ -> logDebug "Did not find a version of shared library libc6."
|
||||
let hasLibc6_2_32 = either (const False) (>= [vver|2.32|]) mLibc6Version
|
||||
hastinfo5 <- checkLib relFileLibtinfoSo5
|
||||
hastinfo6 <- checkLib relFileLibtinfoSo6
|
||||
hasncurses6 <- checkLib relFileLibncurseswSo6
|
||||
hasgmp5 <- checkLib relFileLibgmpSo10
|
||||
hasgmp4 <- checkLib relFileLibgmpSo3
|
||||
let libComponents = if hasMusl
|
||||
then
|
||||
[ ["musl"] ]
|
||||
else
|
||||
concat
|
||||
[ if hastinfo6 && hasgmp5
|
||||
then
|
||||
if hasLibc6_2_32
|
||||
then [["tinfo6"]]
|
||||
else [["tinfo6-libc6-pre232"]]
|
||||
else [[]]
|
||||
, [ [] | hastinfo5 && hasgmp5 ]
|
||||
, [ ["ncurses6"] | hasncurses6 && hasgmp5 ]
|
||||
, [ ["gmp4"] | hasgmp4 ]
|
||||
]
|
||||
pure $ map
|
||||
(\c -> case c of
|
||||
[] -> []
|
||||
_ -> L.intercalate "-" c)
|
||||
libComponents
|
||||
FreeBSD ->
|
||||
case _distroVersion of
|
||||
Just fVer
|
||||
| fVer >= [vers|12|] -> pure []
|
||||
_ -> pure ["ino64"]
|
||||
Darwin -> pure []
|
||||
Windows -> pure []
|
||||
where
|
||||
|
||||
relFileLibcMuslx86_64So1 :: FilePath
|
||||
relFileLibcMuslx86_64So1 = "libc.musl-x86_64.so.1"
|
||||
libDirs :: [FilePath]
|
||||
libDirs = ["/lib", "/lib64"]
|
||||
usrLibDirs :: [FilePath]
|
||||
usrLibDirs = ["/usr/lib", "/usr/lib64"]
|
||||
sbinDirs :: [FilePath]
|
||||
sbinDirs = ["/sbin", "/usr/sbin"]
|
||||
relFileLibtinfoSo5 :: FilePath
|
||||
relFileLibtinfoSo5 = "libtinfo.so.5"
|
||||
relFileLibtinfoSo6 :: FilePath
|
||||
relFileLibtinfoSo6 = "libtinfo.so.6"
|
||||
relFileLibncurseswSo6 :: FilePath
|
||||
relFileLibncurseswSo6 = "libncursesw.so.6"
|
||||
relFileLibgmpSo10 :: FilePath
|
||||
relFileLibgmpSo10 = "libgmp.so.10"
|
||||
relFileLibgmpSo3 :: FilePath
|
||||
relFileLibgmpSo3 = "libgmp.so.3"
|
||||
|
||||
getStackOSKey :: Monad m => PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
|
||||
getStackOSKey PlatformRequest { .. } =
|
||||
case (_rArch, _rPlatform) of
|
||||
(A_32 , Linux _) -> pure "linux32"
|
||||
(A_64 , Linux _) -> pure "linux64"
|
||||
(A_32 , Darwin ) -> pure "macosx"
|
||||
(A_64 , Darwin ) -> pure "macosx"
|
||||
(A_32 , FreeBSD) -> pure "freebsd32"
|
||||
(A_64 , FreeBSD) -> pure "freebsd64"
|
||||
(A_32 , Windows) -> pure "windows32"
|
||||
(A_64 , Windows) -> pure "windows64"
|
||||
(A_ARM , Linux _) -> pure "linux-armv7"
|
||||
(A_ARM64, Linux _) -> pure "linux-aarch64"
|
||||
(A_Sparc, Linux _) -> pure "linux-sparc"
|
||||
(A_ARM64, Darwin ) -> pure "macosx-aarch64"
|
||||
(A_ARM64, FreeBSD) -> pure "freebsd-aarch64"
|
||||
(arch', os') -> throwE $ UnsupportedSetupCombo arch' os'
|
||||
|
||||
getStackPlatformKey :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||
=> PlatformRequest
|
||||
-> Excepts '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound, ProcessError] m [String]
|
||||
getStackPlatformKey pfreq@PlatformRequest{..} = do
|
||||
osKey <- liftE $ getStackOSKey pfreq
|
||||
builds <- liftE $ getStackGhcBuilds (PlatformResult _rPlatform _rVersion)
|
||||
let builds' = (\build -> if null build then osKey else osKey <> "-" <> build) <$> builds
|
||||
logDebug $ "Potential GHC builds: " <> mconcat (L.intersperse ", " $ fmap T.pack builds')
|
||||
pure builds'
|
||||
|
||||
|
||||
@@ -43,6 +43,10 @@ import Control.Monad.Reader
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass ( Pretty )
|
||||
import qualified Data.Text as T
|
||||
import System.Environment (getEnvironment)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import System.FilePath
|
||||
import Data.List (intercalate)
|
||||
|
||||
|
||||
|
||||
@@ -77,8 +81,36 @@ runBothE' a1 a2 = do
|
||||
(_ , VLeft e ) -> throwSomeE e
|
||||
(VRight _, VRight _) -> pure ()
|
||||
|
||||
-- "throwSomeE" function has been upstreamed in haskus-utils-variant-3.3
|
||||
-- So, only conditionally include this shim if
|
||||
-- haskus-utils-variant version is < 3.3
|
||||
|
||||
#if MIN_VERSION_haskus_utils_variant(3,3,0)
|
||||
#else
|
||||
-- | Throw some exception
|
||||
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
|
||||
{-# INLINABLE throwSomeE #-}
|
||||
throwSomeE = Excepts . pure . VLeft . liftVariant
|
||||
#endif
|
||||
|
||||
addToPath :: [FilePath]
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> IO [(String, String)]
|
||||
addToPath paths append = do
|
||||
cEnv <- getEnvironment
|
||||
return $ addToPath' cEnv paths append
|
||||
|
||||
addToPath' :: [(String, String)]
|
||||
-> [FilePath]
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> [(String, String)]
|
||||
addToPath' cEnv' newPaths append =
|
||||
let cEnv = Map.fromList cEnv'
|
||||
paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
{- HLINT ignore "Redundant bracket" -}
|
||||
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ newPaths) else (newPaths ++ curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
in envWithNewPath
|
||||
|
||||
@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
|
||||
|
||||
-- | Create an 'Unfold' of directory contents.
|
||||
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
|
||||
unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
|
||||
unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
|
||||
where
|
||||
{-# INLINE [0] step #-}
|
||||
step dirstream = do
|
||||
(typ, e) <- liftIO $ readDirEnt dirstream
|
||||
(typ, e) <- liftIO $ readDirEntPortable dirstream
|
||||
return $ if
|
||||
| null e -> D.Stop
|
||||
| "." == e -> D.Skip dirstream
|
||||
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
||||
step (_, Nothing, []) = return D.Stop
|
||||
|
||||
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
|
||||
(dt, f) <- liftIO $ readDirEnt dirstream
|
||||
if | FD.dtUnknown == dt -> do
|
||||
(dt, f) <- liftIO $ readDirEntPortable dirstream
|
||||
if | f == "" -> do
|
||||
runIOFinalizer finalizer
|
||||
return $ D.Skip (topdir, Nothing, dirs)
|
||||
| f == "." || f == ".."
|
||||
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
||||
|
||||
acquire dir =
|
||||
withRunInIO $ \run -> mask_ $ run $ do
|
||||
dirstream <- liftIO $ openDirStream dir
|
||||
ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
|
||||
dirstream <- liftIO $ openDirStreamPortable dir
|
||||
ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
|
||||
return (dirstream, ref)
|
||||
|
||||
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
|
||||
|
||||
@@ -10,9 +10,20 @@
|
||||
module GHCup.Prelude.File.Posix.Traversals (
|
||||
-- lower-level stuff
|
||||
readDirEnt
|
||||
, readDirEntPortable
|
||||
, openDirStreamPortable
|
||||
, closeDirStreamPortable
|
||||
, unpackDirStream
|
||||
, DirStreamPortable
|
||||
) where
|
||||
|
||||
#include <limits.h>
|
||||
#include <stdlib.h>
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>))
|
||||
@@ -28,6 +39,7 @@ import Foreign.Storable
|
||||
import System.Posix
|
||||
import Foreign (alloca)
|
||||
import System.Posix.Internals (peekFilePath)
|
||||
import System.FilePath
|
||||
|
||||
|
||||
|
||||
@@ -90,3 +102,38 @@ readDirEnt (unpackDirStream -> dirp) =
|
||||
then return (dtUnknown, mempty)
|
||||
else throwErrno "readDirEnt"
|
||||
|
||||
|
||||
newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
|
||||
|
||||
openDirStreamPortable :: FilePath -> IO DirStreamPortable
|
||||
openDirStreamPortable fp = do
|
||||
dirs <- openDirStream fp
|
||||
pure $ DirStreamPortable (fp, dirs)
|
||||
|
||||
closeDirStreamPortable :: DirStreamPortable -> IO ()
|
||||
closeDirStreamPortable (DirStreamPortable (_, dirs)) = closeDirStream dirs
|
||||
|
||||
readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
|
||||
readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
|
||||
(dt, fp) <- readDirEnt dirs
|
||||
case (dt, fp) of
|
||||
(DirType #{const DT_BLK}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_CHR}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_DIR}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_FIFO}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_REG}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
|
||||
(_, _)
|
||||
| fp /= "" -> do
|
||||
stat <- getSymbolicLinkStatus (basedir </> fp)
|
||||
pure $ (, fp) $ if | isBlockDevice stat -> DirType #{const DT_BLK}
|
||||
| isCharacterDevice stat -> DirType #{const DT_CHR}
|
||||
| isDirectory stat -> DirType #{const DT_DIR}
|
||||
| isNamedPipe stat -> DirType #{const DT_FIFO}
|
||||
| isSymbolicLink stat -> DirType #{const DT_LNK}
|
||||
| isRegularFile stat -> DirType #{const DT_REG}
|
||||
| isSocket stat -> DirType #{const DT_SOCK}
|
||||
| otherwise -> DirType #{const DT_UNKNOWN}
|
||||
| otherwise -> pure (dt, fp)
|
||||
|
||||
@@ -91,18 +91,16 @@ ghcTargetVerP =
|
||||
verP' :: MP.Parsec Void Text Text
|
||||
verP' = do
|
||||
v <- version'
|
||||
let startsWithDigists =
|
||||
let startsWithDigits =
|
||||
and
|
||||
. take 3
|
||||
. concatMap
|
||||
(map
|
||||
(\case
|
||||
(Digits _) -> True
|
||||
(Str _) -> False
|
||||
) . NE.toList)
|
||||
. map (\case
|
||||
Numeric _ -> True
|
||||
Alphanum _ -> False)
|
||||
. NE.toList
|
||||
. (\(Chunks nec) -> nec)
|
||||
$ _vChunks v
|
||||
if startsWithDigists && isNothing (_vEpoch v)
|
||||
if startsWithDigits && isNothing (_vEpoch v)
|
||||
then pure $ prettyVer v
|
||||
else fail "Oh"
|
||||
|
||||
@@ -122,3 +120,17 @@ verP suffix = do
|
||||
|
||||
pathSep :: MP.Parsec Void Text Char
|
||||
pathSep = MP.oneOf pathSeparators
|
||||
|
||||
skipWhile :: (Char -> Bool) -> MP.Parsec Void Text ()
|
||||
skipWhile f = void $ MP.takeWhileP Nothing f
|
||||
|
||||
skip :: (Char -> Bool) -> MP.Parsec Void Text ()
|
||||
skip f = void $ MP.satisfy f
|
||||
|
||||
skipSpace :: MP.Parsec Void Text ()
|
||||
skipSpace = void $ MP.satisfy isSpace
|
||||
|
||||
isSpace :: Char -> Bool
|
||||
isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')
|
||||
{-# INLINE isSpace #-}
|
||||
|
||||
|
||||
@@ -11,6 +11,7 @@ Portability : portable
|
||||
-}
|
||||
module GHCup.Prelude.Process (
|
||||
executeOut,
|
||||
executeOut',
|
||||
execLogged,
|
||||
exec,
|
||||
toProcessError,
|
||||
|
||||
@@ -70,6 +70,16 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
||||
maybe (pure ()) changeWorkingDirectory chdir
|
||||
SPP.executeFile path True args Nothing
|
||||
|
||||
executeOut' :: MonadIO m
|
||||
=> FilePath -- ^ command as filename, e.g. 'ls'
|
||||
-> [String] -- ^ arguments to the command
|
||||
-> Maybe FilePath -- ^ chdir to this path
|
||||
-> Maybe [(String, String)]
|
||||
-> m CapturedProcess
|
||||
executeOut' path args chdir env = liftIO $ captureOutStreams $ do
|
||||
maybe (pure ()) changeWorkingDirectory chdir
|
||||
SPP.executeFile path True args env
|
||||
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
@@ -169,7 +179,7 @@ execLogged exe args chdir lfile env = do
|
||||
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
|
||||
|
||||
blue :: ByteString -> ByteString
|
||||
blue bs
|
||||
blue bs
|
||||
| no_color = bs
|
||||
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
|
||||
|
||||
|
||||
@@ -140,8 +140,16 @@ executeOut :: MonadIO m
|
||||
-> [String] -- ^ arguments to the command
|
||||
-> Maybe FilePath -- ^ chdir to this path
|
||||
-> m CapturedProcess
|
||||
executeOut path args chdir = do
|
||||
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
|
||||
executeOut path args chdir = executeOut' path args chdir Nothing
|
||||
|
||||
executeOut' :: MonadIO m
|
||||
=> FilePath -- ^ command as filename, e.g. 'ls'
|
||||
-> [String] -- ^ arguments to the command
|
||||
-> Maybe FilePath -- ^ chdir to this path
|
||||
-> Maybe [(String, String)]
|
||||
-> m CapturedProcess
|
||||
executeOut' path args chdir env' = do
|
||||
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir, env = env' })
|
||||
(exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
|
||||
pure $ CapturedProcess exit out err
|
||||
|
||||
|
||||
@@ -26,36 +26,14 @@ import GHC.Base
|
||||
#endif
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
|
||||
import Language.Haskell.TH.Syntax ( Lift
|
||||
, dataToExpQ
|
||||
)
|
||||
import Language.Haskell.TH.Syntax ( dataToExpQ )
|
||||
import qualified Data.Text as T
|
||||
import qualified Language.Haskell.TH.Syntax as TH
|
||||
|
||||
|
||||
|
||||
deriving instance Data Versioning
|
||||
deriving instance Lift Versioning
|
||||
deriving instance Data Version
|
||||
deriving instance Lift Version
|
||||
deriving instance Data SemVer
|
||||
deriving instance Lift SemVer
|
||||
deriving instance Data Mess
|
||||
deriving instance Lift Mess
|
||||
deriving instance Data MChunk
|
||||
deriving instance Lift MChunk
|
||||
deriving instance Data PVP
|
||||
deriving instance Lift PVP
|
||||
deriving instance Lift VSep
|
||||
deriving instance Data VSep
|
||||
deriving instance Lift VUnit
|
||||
deriving instance Data VUnit
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
deriving instance Lift (NonEmpty Word)
|
||||
deriving instance Lift (NonEmpty VChunk)
|
||||
deriving instance Lift (NonEmpty MChunk)
|
||||
deriving instance Lift (NonEmpty VUnit)
|
||||
#endif
|
||||
|
||||
qq :: (Text -> Q Exp) -> QuasiQuoter
|
||||
|
||||
@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( patch )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
@@ -233,7 +234,7 @@ setStack ver = do
|
||||
|
||||
liftIO (isShadowed stackbin) >>= \case
|
||||
Nothing -> pure ()
|
||||
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
|
||||
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Stack pa stackbin ver)
|
||||
|
||||
pure ()
|
||||
|
||||
@@ -279,6 +280,6 @@ rmStackVer ver = do
|
||||
|
||||
when (Just ver == sSet) $ do
|
||||
sVers <- lift $ fmap rights getInstalledStacks
|
||||
case headMay . reverse . sort $ sVers of
|
||||
case headMay . sortBy (comparing Down) $ sVers of
|
||||
Just latestver -> setStack latestver
|
||||
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)
|
||||
|
||||
@@ -22,15 +22,18 @@ module GHCup.Types
|
||||
( module GHCup.Types
|
||||
#if defined(BRICK)
|
||||
, Key(..)
|
||||
, Modifier(..)
|
||||
#endif
|
||||
)
|
||||
where
|
||||
|
||||
import GHCup.Types.Stack ( SetupInfo )
|
||||
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
|
||||
|
||||
import Control.DeepSeq ( NFData, rnf )
|
||||
import Data.Map.Strict ( Map )
|
||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||
import Data.Time.Calendar ( Day )
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception ( ExitCode )
|
||||
@@ -38,13 +41,13 @@ import Optics ( makeLenses )
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||
import URI.ByteString
|
||||
#if defined(BRICK)
|
||||
import Graphics.Vty ( Key(..) )
|
||||
import Graphics.Vty ( Key(..), Modifier(..) )
|
||||
#endif
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
#if !defined(BRICK)
|
||||
data Key = KEsc | KChar Char | KBS | KEnter
|
||||
@@ -53,8 +56,15 @@ data Key = KEsc | KChar Char | KBS | KEnter
|
||||
| KFun Int | KBackTab | KPrtScr | KPause | KIns
|
||||
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
|
||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||
|
||||
data Modifier = MShift | MCtrl | MMeta | MAlt
|
||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||
#endif
|
||||
|
||||
data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
|
||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
--[ GHCInfo Tree ]--
|
||||
@@ -66,7 +76,7 @@ data GHCupInfo = GHCupInfo
|
||||
, _ghcupDownloads :: GHCupDownloads
|
||||
, _globalTools :: Map GlobalTool DownloadInfo
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
instance NFData GHCupInfo
|
||||
|
||||
@@ -87,7 +97,7 @@ data Requirements = Requirements
|
||||
{ _distroPKGs :: [Text]
|
||||
, _notes :: Text
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
instance NFData Requirements
|
||||
|
||||
@@ -103,7 +113,7 @@ instance NFData Requirements
|
||||
-- | Description of all binary and source downloads. This is a tree
|
||||
-- of nested maps.
|
||||
type GHCupDownloads = Map Tool ToolVersionSpec
|
||||
type ToolVersionSpec = Map Version VersionInfo
|
||||
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
|
||||
type ArchitectureSpec = Map Architecture PlatformSpec
|
||||
type PlatformSpec = Map Platform PlatformVersionSpec
|
||||
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
|
||||
@@ -131,11 +141,15 @@ data GlobalTool = ShimGen
|
||||
|
||||
instance NFData GlobalTool
|
||||
|
||||
instance Pretty GlobalTool where
|
||||
pPrint ShimGen = text "shimgen"
|
||||
|
||||
|
||||
-- | All necessary information of a tool version, including
|
||||
-- source download and per-architecture downloads.
|
||||
data VersionInfo = VersionInfo
|
||||
{ _viTags :: [Tag] -- ^ version specific tag
|
||||
, _viReleaseDay :: Maybe Day
|
||||
, _viChangeLog :: Maybe URI
|
||||
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
||||
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
||||
@@ -151,10 +165,17 @@ instance NFData VersionInfo
|
||||
|
||||
|
||||
-- | A tag. These are currently attached to a version of a tool.
|
||||
data Tag = Latest
|
||||
| Recommended
|
||||
| Prerelease
|
||||
| Base PVP
|
||||
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
|
||||
| Recommended -- ^ the recommended version of a tool (unique per tool)
|
||||
| Prerelease -- ^ denotes a prerelease version
|
||||
-- (a version should either be 'Prerelease' or
|
||||
-- 'LatestPrerelease', but not both)
|
||||
| LatestPrerelease -- ^ the latest prerelease (unique per tool)
|
||||
| Nightly -- ^ denotes a nightly version
|
||||
-- (a version should either be 'Nightly' or
|
||||
-- 'LatestNightly', but not both)
|
||||
| LatestNightly -- ^ the latest nightly (unique per tool)
|
||||
| Base PVP -- ^ the base version shipped with GHC
|
||||
| Old -- ^ old versions are hidden by default in TUI
|
||||
| UnknownTag String -- ^ used for upwardscompat
|
||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||
@@ -165,16 +186,22 @@ tagToString :: Tag -> String
|
||||
tagToString Recommended = "recommended"
|
||||
tagToString Latest = "latest"
|
||||
tagToString Prerelease = "prerelease"
|
||||
tagToString Nightly = "nightly"
|
||||
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
tagToString (UnknownTag t ) = t
|
||||
tagToString LatestPrerelease = "latest-prerelease"
|
||||
tagToString LatestNightly = "latest-nightly"
|
||||
tagToString Old = ""
|
||||
|
||||
instance Pretty Tag where
|
||||
pPrint Recommended = text "recommended"
|
||||
pPrint Latest = text "latest"
|
||||
pPrint Prerelease = text "prerelease"
|
||||
pPrint Nightly = text "nightly"
|
||||
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
pPrint (UnknownTag t ) = text t
|
||||
pPrint LatestPrerelease = text "latest-prerelease"
|
||||
pPrint LatestNightly = text "latest-prerelease"
|
||||
pPrint Old = mempty
|
||||
|
||||
data Architecture = A_64
|
||||
@@ -230,13 +257,18 @@ data LinuxDistro = Debian
|
||||
| RedHat
|
||||
| Alpine
|
||||
| AmazonLinux
|
||||
| Rocky
|
||||
| Void
|
||||
-- rolling
|
||||
| Gentoo
|
||||
| Exherbo
|
||||
-- not known
|
||||
| UnknownLinux
|
||||
-- ^ must exit
|
||||
deriving (Eq, GHC.Generic, Ord, Show)
|
||||
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
||||
|
||||
allDistros :: [LinuxDistro]
|
||||
allDistros = enumFromTo minBound maxBound
|
||||
|
||||
instance NFData LinuxDistro
|
||||
|
||||
@@ -249,6 +281,8 @@ distroToString CentOS = "centos"
|
||||
distroToString RedHat = "redhat"
|
||||
distroToString Alpine = "alpine"
|
||||
distroToString AmazonLinux = "amazon"
|
||||
distroToString Rocky = "rocky"
|
||||
distroToString Void = "void"
|
||||
distroToString Gentoo = "gentoo"
|
||||
distroToString Exherbo = "exherbo"
|
||||
distroToString UnknownLinux = "unknown"
|
||||
@@ -264,6 +298,7 @@ data DownloadInfo = DownloadInfo
|
||||
, _dlSubdir :: Maybe TarDir
|
||||
, _dlHash :: Text
|
||||
, _dlCSize :: Maybe Integer
|
||||
, _dlOutput :: Maybe FilePath
|
||||
}
|
||||
deriving (Eq, Ord, GHC.Generic, Show)
|
||||
|
||||
@@ -307,15 +342,41 @@ instance Pretty TarDir where
|
||||
|
||||
-- | Where to fetch GHCupDownloads from.
|
||||
data URLSource = GHCupURL
|
||||
| OwnSource [Either GHCupInfo URI] -- ^ complete source list
|
||||
| OwnSpec GHCupInfo
|
||||
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
|
||||
deriving (GHC.Generic, Show)
|
||||
| StackSetupURL
|
||||
| OwnSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ complete source list
|
||||
| OwnSpec (Either GHCupInfo SetupInfo)
|
||||
| AddSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ merge with GHCupURL
|
||||
| SimpleList [NewURLSource]
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
data NewURLSource = NewGHCupURL
|
||||
| NewStackSetupURL
|
||||
| NewGHCupInfo GHCupInfo
|
||||
| NewSetupInfo SetupInfo
|
||||
| NewURI URI
|
||||
deriving (Eq, GHC.Generic, Show)
|
||||
|
||||
instance NFData NewURLSource
|
||||
|
||||
fromURLSource :: URLSource -> [NewURLSource]
|
||||
fromURLSource GHCupURL = [NewGHCupURL]
|
||||
fromURLSource StackSetupURL = [NewStackSetupURL]
|
||||
fromURLSource (OwnSource arr) = convert' <$> arr
|
||||
fromURLSource (AddSource arr) = NewGHCupURL:(convert' <$> arr)
|
||||
fromURLSource (SimpleList arr) = arr
|
||||
fromURLSource (OwnSpec (Left gi)) = [NewGHCupInfo gi]
|
||||
fromURLSource (OwnSpec (Right si)) = [NewSetupInfo si]
|
||||
|
||||
convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
|
||||
convert' (Left (Left gi)) = NewGHCupInfo gi
|
||||
convert' (Left (Right si)) = NewSetupInfo si
|
||||
convert' (Right uri) = NewURI uri
|
||||
|
||||
instance NFData URLSource
|
||||
instance NFData (URIRef Absolute) where
|
||||
rnf (URI !_ !_ !_ !_ !_) = ()
|
||||
|
||||
|
||||
data MetaMode = Strict
|
||||
| Lax
|
||||
deriving (Show, Read, Eq, GHC.Generic)
|
||||
@@ -388,47 +449,51 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
}
|
||||
|
||||
data UserKeyBindings = UserKeyBindings
|
||||
{ kUp :: Maybe Key
|
||||
, kDown :: Maybe Key
|
||||
, kQuit :: Maybe Key
|
||||
, kInstall :: Maybe Key
|
||||
, kUninstall :: Maybe Key
|
||||
, kSet :: Maybe Key
|
||||
, kChangelog :: Maybe Key
|
||||
, kShowAll :: Maybe Key
|
||||
, kShowAllTools :: Maybe Key
|
||||
{ kUp :: Maybe KeyCombination
|
||||
, kDown :: Maybe KeyCombination
|
||||
, kQuit :: Maybe KeyCombination
|
||||
, kInstall :: Maybe KeyCombination
|
||||
, kUninstall :: Maybe KeyCombination
|
||||
, kSet :: Maybe KeyCombination
|
||||
, kChangelog :: Maybe KeyCombination
|
||||
, kShowAll :: Maybe KeyCombination
|
||||
, kShowAllTools :: Maybe KeyCombination
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
data KeyBindings = KeyBindings
|
||||
{ bUp :: Key
|
||||
, bDown :: Key
|
||||
, bQuit :: Key
|
||||
, bInstall :: Key
|
||||
, bUninstall :: Key
|
||||
, bSet :: Key
|
||||
, bChangelog :: Key
|
||||
, bShowAllVersions :: Key
|
||||
, bShowAllTools :: Key
|
||||
{ bUp :: KeyCombination
|
||||
, bDown :: KeyCombination
|
||||
, bQuit :: KeyCombination
|
||||
, bInstall :: KeyCombination
|
||||
, bUninstall :: KeyCombination
|
||||
, bSet :: KeyCombination
|
||||
, bChangelog :: KeyCombination
|
||||
, bShowAllVersions :: KeyCombination
|
||||
, bShowAllTools :: KeyCombination
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData KeyBindings
|
||||
#if defined(IS_WINDOWS) || !defined(BRICK)
|
||||
#if !defined(BRICK)
|
||||
instance NFData Key
|
||||
|
||||
instance NFData Modifier
|
||||
|
||||
#endif
|
||||
instance NFData KeyCombination
|
||||
|
||||
defaultKeyBindings :: KeyBindings
|
||||
defaultKeyBindings = KeyBindings
|
||||
{ bUp = KUp
|
||||
, bDown = KDown
|
||||
, bQuit = KChar 'q'
|
||||
, bInstall = KChar 'i'
|
||||
, bUninstall = KChar 'u'
|
||||
, bSet = KChar 's'
|
||||
, bChangelog = KChar 'c'
|
||||
, bShowAllVersions = KChar 'a'
|
||||
, bShowAllTools = KChar 't'
|
||||
{ bUp = KeyCombination { key = KUp , mods = [] }
|
||||
, bDown = KeyCombination { key = KDown , mods = [] }
|
||||
, bQuit = KeyCombination { key = KChar 'q', mods = [] }
|
||||
, bInstall = KeyCombination { key = KChar 'i', mods = [] }
|
||||
, bUninstall = KeyCombination { key = KChar 'u', mods = [] }
|
||||
, bSet = KeyCombination { key = KChar 's', mods = [] }
|
||||
, bChangelog = KeyCombination { key = KChar 'c', mods = [] }
|
||||
, bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
|
||||
, bShowAllTools = KeyCombination { key = KChar 't', mods = [] }
|
||||
}
|
||||
|
||||
data AppState = AppState
|
||||
@@ -581,7 +646,9 @@ data GHCTargetVersion = GHCTargetVersion
|
||||
{ _tvTarget :: Maybe Text
|
||||
, _tvVersion :: Version
|
||||
}
|
||||
deriving (Ord, Eq, Show)
|
||||
deriving (Ord, Eq, Show, GHC.Generic)
|
||||
|
||||
instance NFData GHCTargetVersion
|
||||
|
||||
data GitBranch = GitBranch
|
||||
{ ref :: String
|
||||
@@ -620,6 +687,17 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
|
||||
|
||||
instance NFData VersionRange
|
||||
|
||||
instance Pretty VersionCmp where
|
||||
pPrint (VR_gt v) = text "> " <> pPrint v
|
||||
pPrint (VR_gteq v) = text ">= " <> pPrint v
|
||||
pPrint (VR_lt v) = text "< " <> pPrint v
|
||||
pPrint (VR_lteq v) = text "<= " <> pPrint v
|
||||
pPrint (VR_eq v) = text "= " <> pPrint v
|
||||
|
||||
instance Pretty VersionRange where
|
||||
pPrint (SimpleRange xs) = foldl1 (\x y -> x <> text " && " <> y) $ NE.map pPrint xs
|
||||
pPrint (OrRange xs vr) = foldMap pPrint xs <> " || " <> pPrint vr
|
||||
|
||||
instance Pretty Versioning where
|
||||
pPrint = text . T.unpack . prettyV
|
||||
|
||||
@@ -691,3 +769,22 @@ type PromptQuestion = Text
|
||||
|
||||
data PromptResponse = PromptYes | PromptNo
|
||||
deriving (Show, Eq)
|
||||
|
||||
data ToolVersion = GHCVersion GHCTargetVersion
|
||||
| ToolVersion Version
|
||||
| ToolTag Tag
|
||||
| ToolDay Day
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Pretty ToolVersion where
|
||||
pPrint (GHCVersion v) = pPrint v
|
||||
pPrint (ToolVersion v) = pPrint v
|
||||
pPrint (ToolTag t) = pPrint t
|
||||
pPrint (ToolDay d) = text (show d)
|
||||
|
||||
|
||||
|
||||
data BuildSystem = Hadrian
|
||||
| Make
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
||||
@@ -22,7 +22,9 @@ Portability : portable
|
||||
module GHCup.Types.JSON where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Stack (SetupInfo)
|
||||
import GHCup.Types.JSON.Utils
|
||||
import GHCup.Types.JSON.Versions ()
|
||||
import GHCup.Prelude.MegaParsec
|
||||
|
||||
import Control.Applicative ( (<|>) )
|
||||
@@ -31,7 +33,9 @@ import Data.Aeson.TH
|
||||
import Data.Aeson.Types hiding (Key)
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List.NonEmpty ( NonEmpty(..) )
|
||||
import Data.Maybe
|
||||
import Data.Text.Encoding as E
|
||||
import Data.Foldable
|
||||
import Data.Versions
|
||||
import Data.Void
|
||||
import URI.ByteString
|
||||
@@ -48,10 +52,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
|
||||
@@ -64,8 +69,11 @@ instance ToJSON Tag where
|
||||
toJSON Latest = String "Latest"
|
||||
toJSON Recommended = String "Recommended"
|
||||
toJSON Prerelease = String "Prerelease"
|
||||
toJSON Nightly = String "Nightly"
|
||||
toJSON Old = String "old"
|
||||
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
|
||||
toJSON LatestPrerelease = String "LatestPrerelease"
|
||||
toJSON LatestNightly = String "LatestNightly"
|
||||
toJSON (UnknownTag x ) = String (T.pack x)
|
||||
|
||||
instance FromJSON Tag where
|
||||
@@ -73,6 +81,9 @@ instance FromJSON Tag where
|
||||
"Latest" -> pure Latest
|
||||
"Recommended" -> pure Recommended
|
||||
"Prerelease" -> pure Prerelease
|
||||
"Nightly" -> pure Nightly
|
||||
"LatestPrerelease" -> pure LatestPrerelease
|
||||
"LatestNightly" -> pure LatestNightly
|
||||
"old" -> pure Old
|
||||
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
|
||||
Right x -> pure $ Base x
|
||||
@@ -89,34 +100,22 @@ instance FromJSON URI where
|
||||
Right x -> pure x
|
||||
Left e -> fail . show $ e
|
||||
|
||||
instance ToJSON Versioning where
|
||||
toJSON = toJSON . prettyV
|
||||
instance ToJSON GHCTargetVersion where
|
||||
toJSON = toJSON . tVerToText
|
||||
|
||||
instance FromJSON Versioning where
|
||||
parseJSON = withText "Versioning" $ \t -> case versioning t of
|
||||
instance FromJSON GHCTargetVersion where
|
||||
parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
||||
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Versioning where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
||||
instance ToJSONKey GHCTargetVersion where
|
||||
toJSONKey = toJSONKeyText $ \x -> tVerToText x
|
||||
|
||||
instance FromJSONKey Versioning where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
|
||||
instance FromJSONKey GHCTargetVersion where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
|
||||
Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey (Maybe Versioning) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyV x
|
||||
Nothing -> T.pack "unknown_versioning"
|
||||
|
||||
instance FromJSONKey (Maybe Versioning) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_versioning" then pure Nothing else just t
|
||||
where
|
||||
just t = case versioning t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey Platform where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
@@ -153,43 +152,6 @@ instance ToJSONKey Architecture where
|
||||
instance FromJSONKey Architecture where
|
||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
||||
|
||||
instance ToJSONKey (Maybe Version) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyVer x
|
||||
Nothing -> T.pack "unknown_version"
|
||||
|
||||
instance FromJSONKey (Maybe Version) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_version" then pure Nothing else just t
|
||||
where
|
||||
just t = case version t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON Version where
|
||||
toJSON = toJSON . prettyVer
|
||||
|
||||
instance FromJSON Version where
|
||||
parseJSON = withText "Version" $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Version where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyVer x
|
||||
|
||||
instance FromJSONKey Version where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON PVP where
|
||||
toJSON = toJSON . prettyPVP
|
||||
|
||||
instance FromJSON PVP where
|
||||
parseJSON = withText "PVP" $ \t -> case pvp t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Tool where
|
||||
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
||||
|
||||
@@ -319,33 +281,64 @@ instance FromJSONKey (Maybe VersionRange) where
|
||||
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
||||
|
||||
|
||||
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
|
||||
instance FromJSON GHCupInfo where
|
||||
parseJSON = withObject "GHCupInfo" $ \o -> do
|
||||
toolRequirements' <- o .:? "toolRequirements"
|
||||
globalTools' <- o .:? "globalTools"
|
||||
ghcupDownloads' <- o .: "ghcupDownloads"
|
||||
pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads' (fromMaybe mempty globalTools'))
|
||||
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
|
||||
instance ToJSON NewURLSource where
|
||||
toJSON NewGHCupURL = String "GHCupURL"
|
||||
toJSON NewStackSetupURL = String "StackSetupURL"
|
||||
toJSON (NewGHCupInfo gi) = object [ "ghcup-info" .= gi ]
|
||||
toJSON (NewSetupInfo si) = object [ "setup-info" .= si ]
|
||||
toJSON (NewURI uri) = toJSON uri
|
||||
|
||||
instance ToJSON URLSource where
|
||||
toJSON = toJSON . fromURLSource
|
||||
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Modifier
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||
|
||||
instance FromJSON URLSource where
|
||||
parseJSON v =
|
||||
parseGHCupURL v
|
||||
<|> parseStackURL v
|
||||
<|> parseOwnSourceLegacy v
|
||||
<|> parseOwnSourceNew1 v
|
||||
<|> parseOwnSourceNew2 v
|
||||
<|> parseOwnSpec v
|
||||
<|> legacyParseAddSource v
|
||||
<|> newParseAddSource v
|
||||
-- new since Stack SetupInfo
|
||||
<|> parseOwnSpecNew v
|
||||
<|> parseOwnSourceNew3 v
|
||||
<|> newParseAddSource2 v
|
||||
-- more lenient versions
|
||||
<|> parseOwnSpecLenient v
|
||||
<|> parseOwnSourceLenient v
|
||||
<|> parseAddSourceLenient v
|
||||
-- simplified list
|
||||
<|> parseNewUrlSource v
|
||||
<|> parseNewUrlSource' v
|
||||
where
|
||||
convert'' :: Either GHCupInfo URI -> Either (Either GHCupInfo SetupInfo) URI
|
||||
convert'' (Left gi) = Left (Left gi)
|
||||
convert'' (Right uri) = Right uri
|
||||
|
||||
parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
|
||||
r :: URI <- o .: "OwnSource"
|
||||
pure (OwnSource [Right r])
|
||||
@@ -354,18 +347,100 @@ instance FromJSON URLSource where
|
||||
pure (OwnSource (fmap Right r))
|
||||
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
|
||||
pure (OwnSource r)
|
||||
pure (OwnSource (convert'' <$> r))
|
||||
parseOwnSpec = withObject "URLSource" $ \o -> do
|
||||
r :: GHCupInfo <- o .: "OwnSpec"
|
||||
pure (OwnSpec r)
|
||||
pure (OwnSpec $ Left r)
|
||||
parseGHCupURL = withObject "URLSource" $ \o -> do
|
||||
_ :: [Value] <- o .: "GHCupURL"
|
||||
pure GHCupURL
|
||||
parseStackURL = withObject "URLSource" $ \o -> do
|
||||
_ :: [Value] <- o .: "StackSetupURL"
|
||||
pure StackSetupURL
|
||||
legacyParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: Either GHCupInfo URI <- o .: "AddSource"
|
||||
pure (AddSource [r])
|
||||
pure (AddSource [convert'' r])
|
||||
newParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "AddSource"
|
||||
pure (AddSource (convert'' <$> r))
|
||||
|
||||
-- new since Stack SetupInfo
|
||||
parseOwnSpecNew = withObject "URLSource" $ \o -> do
|
||||
r :: Either GHCupInfo SetupInfo <- o .: "OwnSpec"
|
||||
pure (OwnSpec r)
|
||||
parseOwnSourceNew3 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "OwnSource"
|
||||
pure (OwnSource r)
|
||||
newParseAddSource2 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either (Either GHCupInfo SetupInfo) URI] <- o .: "AddSource"
|
||||
pure (AddSource r)
|
||||
|
||||
-- more lenient versions
|
||||
parseOwnSpecLenient = withObject "URLSource" $ \o -> do
|
||||
spec :: Object <- o .: "OwnSpec"
|
||||
OwnSpec <$> lenientInfoParser spec
|
||||
parseOwnSourceLenient = withObject "URLSource" $ \o -> do
|
||||
mown :: Array <- o .: "OwnSource"
|
||||
OwnSource . toList <$> mapM lenientInfoUriParser mown
|
||||
parseAddSourceLenient = withObject "URLSource" $ \o -> do
|
||||
madd :: Array <- o .: "AddSource"
|
||||
AddSource . toList <$> mapM lenientInfoUriParser madd
|
||||
|
||||
-- simplified
|
||||
parseNewUrlSource = withArray "URLSource" $ \a -> do
|
||||
SimpleList . toList <$> mapM parseJSON a
|
||||
parseNewUrlSource' v' = SimpleList .(:[]) <$> parseJSON v'
|
||||
|
||||
|
||||
lenientInfoUriParser :: Value -> Parser (Either (Either GHCupInfo SetupInfo) URI)
|
||||
lenientInfoUriParser (Object o) = Left <$> lenientInfoParser o
|
||||
lenientInfoUriParser v@(String _) = Right <$> parseJSON v
|
||||
lenientInfoUriParser _ = fail "Unexpected json in lenientInfoUriParser"
|
||||
|
||||
|
||||
lenientInfoParser :: Object -> Parser (Either GHCupInfo SetupInfo)
|
||||
lenientInfoParser o = do
|
||||
setup_info :: Maybe Object <- o .:? "setup-info"
|
||||
case setup_info of
|
||||
Nothing -> do
|
||||
r <- parseJSON (Object o)
|
||||
pure $ Left r
|
||||
Just setup_info' -> do
|
||||
r <- parseJSON (Object setup_info')
|
||||
pure $ Right r
|
||||
|
||||
instance FromJSON NewURLSource where
|
||||
parseJSON v = uri v <|> url v <|> gi v <|> si v
|
||||
where
|
||||
uri = withText "NewURLSource" $ \t -> NewURI <$> parseJSON (String t)
|
||||
url = withText "NewURLSource" $ \t -> case T.unpack t of
|
||||
"GHCupURL" -> pure NewGHCupURL
|
||||
"StackSetupURL" -> pure NewStackSetupURL
|
||||
t' -> fail $ "Unexpected text value in NewURLSource: " <> t'
|
||||
gi = withObject "NewURLSource" $ \o -> do
|
||||
ginfo :: GHCupInfo <- o .: "ghcup-info"
|
||||
pure $ NewGHCupInfo ginfo
|
||||
|
||||
si = withObject "NewURLSource" $ \o -> do
|
||||
sinfo :: SetupInfo <- o .: "setup-info"
|
||||
pure $ NewSetupInfo sinfo
|
||||
|
||||
|
||||
instance FromJSON KeyCombination where
|
||||
parseJSON v = proper v <|> simple v
|
||||
where
|
||||
simple = withObject "KeyCombination" $ \o -> do
|
||||
k <- parseJSON (Object o)
|
||||
pure (KeyCombination k [])
|
||||
proper = withObject "KeyCombination" $ \o -> do
|
||||
k <- o .: "Key"
|
||||
m <- o .: "Mods"
|
||||
pure $ KeyCombination k m
|
||||
|
||||
instance ToJSON KeyCombination where
|
||||
toJSON (KeyCombination k m) = object ["Key" .= k, "Mods" .= m]
|
||||
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
|
||||
|
||||
90
lib/GHCup/Types/JSON/Versions.hs
Normal file
90
lib/GHCup/Types/JSON/Versions.hs
Normal file
@@ -0,0 +1,90 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.JSON.Versions
|
||||
Description : GHCup Version JSON types/instances
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Types.JSON.Versions where
|
||||
|
||||
import Data.Aeson hiding (Key)
|
||||
import Data.Aeson.Types hiding (Key)
|
||||
import Data.Versions
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
instance ToJSON Versioning where
|
||||
toJSON = toJSON . prettyV
|
||||
|
||||
instance FromJSON Versioning where
|
||||
parseJSON = withText "Versioning" $ \t -> case versioning t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Versioning where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
||||
|
||||
instance FromJSONKey Versioning where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey (Maybe Versioning) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyV x
|
||||
Nothing -> T.pack "unknown_versioning"
|
||||
|
||||
instance FromJSONKey (Maybe Versioning) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_versioning" then pure Nothing else just t
|
||||
where
|
||||
just t = case versioning t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSONKey (Maybe Version) where
|
||||
toJSONKey = toJSONKeyText $ \case
|
||||
Just x -> prettyVer x
|
||||
Nothing -> T.pack "unknown_version"
|
||||
|
||||
instance FromJSONKey (Maybe Version) where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t ->
|
||||
if t == T.pack "unknown_version" then pure Nothing else just t
|
||||
where
|
||||
just t = case version t of
|
||||
Right x -> pure $ Just x
|
||||
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON Version where
|
||||
toJSON = toJSON . prettyVer
|
||||
|
||||
instance FromJSON Version where
|
||||
parseJSON = withText "Version" $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
||||
|
||||
instance ToJSONKey Version where
|
||||
toJSONKey = toJSONKeyText $ \x -> prettyVer x
|
||||
|
||||
instance FromJSONKey Version where
|
||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
|
||||
|
||||
instance ToJSON PVP where
|
||||
toJSON = toJSON . prettyPVP
|
||||
|
||||
instance FromJSON PVP where
|
||||
parseJSON = withText "PVP" $ \t -> case pvp t of
|
||||
Right x -> pure x
|
||||
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
|
||||
180
lib/GHCup/Types/Stack.hs
Normal file
180
lib/GHCup/Types/Stack.hs
Normal file
@@ -0,0 +1,180 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.Stack
|
||||
Description : GHCup types.Stack
|
||||
Copyright : (c) Julian Ospald, 2023
|
||||
License : LGPL-3.0
|
||||
Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
module GHCup.Types.Stack where
|
||||
|
||||
import GHCup.Types.JSON.Versions ()
|
||||
|
||||
import Control.Applicative
|
||||
import Control.DeepSeq ( NFData )
|
||||
import Data.ByteString
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import Data.Map.Strict ( Map )
|
||||
import Data.Text ( Text )
|
||||
import Data.Text.Encoding
|
||||
import Data.Versions
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
|
||||
--------------------------------------
|
||||
--[ Stack download info copy pasta ]--
|
||||
--------------------------------------
|
||||
|
||||
data SetupInfo = SetupInfo
|
||||
{ siSevenzExe :: Maybe DownloadInfo
|
||||
, siSevenzDll :: Maybe DownloadInfo
|
||||
, siMsys2 :: Map Text VersionedDownloadInfo
|
||||
, siGHCs :: Map Text (Map Version GHCDownloadInfo)
|
||||
, siStack :: Map Text (Map Version DownloadInfo)
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance NFData SetupInfo
|
||||
|
||||
instance FromJSON SetupInfo where
|
||||
parseJSON = withObject "SetupInfo" $ \o -> do
|
||||
siSevenzExe <- o .:? "sevenzexe-info"
|
||||
siSevenzDll <- o .:? "sevenzdll-info"
|
||||
siMsys2 <- o .:? "msys2" .!= mempty
|
||||
siGHCs <- o .:? "ghc" .!= mempty
|
||||
siStack <- o .:? "stack" .!= mempty
|
||||
pure SetupInfo {..}
|
||||
|
||||
instance ToJSON SetupInfo where
|
||||
toJSON (SetupInfo {..}) = object [ "sevenzexe-info" .= siSevenzExe
|
||||
, "sevenzdll-info" .= siSevenzDll
|
||||
, "msys2" .= siMsys2
|
||||
, "ghc" .= siGHCs
|
||||
, "stack" .= siStack
|
||||
]
|
||||
|
||||
-- | For the @siGHCs@ field maps are deeply merged. For all fields the values
|
||||
-- from the first @SetupInfo@ win.
|
||||
instance Semigroup SetupInfo where
|
||||
l <> r =
|
||||
SetupInfo
|
||||
{ siSevenzExe = siSevenzExe l <|> siSevenzExe r
|
||||
, siSevenzDll = siSevenzDll l <|> siSevenzDll r
|
||||
, siMsys2 = siMsys2 l <> siMsys2 r
|
||||
, siGHCs = Map.unionWith (<>) (siGHCs l) (siGHCs r)
|
||||
, siStack = Map.unionWith (<>) (siStack l) (siStack r) }
|
||||
|
||||
instance Monoid SetupInfo where
|
||||
mempty =
|
||||
SetupInfo
|
||||
{ siSevenzExe = Nothing
|
||||
, siSevenzDll = Nothing
|
||||
, siMsys2 = Map.empty
|
||||
, siGHCs = Map.empty
|
||||
, siStack = Map.empty
|
||||
}
|
||||
mappend = (<>)
|
||||
|
||||
-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)
|
||||
-- | Information for a file to download.
|
||||
data DownloadInfo = DownloadInfo
|
||||
{ downloadInfoUrl :: Text
|
||||
-- ^ URL or absolute file path
|
||||
, downloadInfoContentLength :: Maybe Int
|
||||
, downloadInfoSha1 :: Maybe ByteString
|
||||
, downloadInfoSha256 :: Maybe ByteString
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance ToJSON DownloadInfo where
|
||||
toJSON (DownloadInfo {..}) = object [ "url" .= downloadInfoUrl
|
||||
, "content-length" .= downloadInfoContentLength
|
||||
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
|
||||
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
|
||||
]
|
||||
|
||||
instance NFData DownloadInfo
|
||||
|
||||
instance FromJSON DownloadInfo where
|
||||
parseJSON = withObject "DownloadInfo" parseDownloadInfoFromObject
|
||||
|
||||
-- | Parse JSON in existing object for 'DownloadInfo'
|
||||
parseDownloadInfoFromObject :: Object -> Parser DownloadInfo
|
||||
parseDownloadInfoFromObject o = do
|
||||
url <- o .: "url"
|
||||
contentLength <- o .:? "content-length"
|
||||
sha1TextMay <- o .:? "sha1"
|
||||
sha256TextMay <- o .:? "sha256"
|
||||
pure
|
||||
DownloadInfo
|
||||
{ downloadInfoUrl = url
|
||||
, downloadInfoContentLength = contentLength
|
||||
, downloadInfoSha1 = fmap encodeUtf8 sha1TextMay
|
||||
, downloadInfoSha256 = fmap encodeUtf8 sha256TextMay
|
||||
}
|
||||
|
||||
data VersionedDownloadInfo = VersionedDownloadInfo
|
||||
{ vdiVersion :: Version
|
||||
, vdiDownloadInfo :: DownloadInfo
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance ToJSON VersionedDownloadInfo where
|
||||
toJSON (VersionedDownloadInfo {vdiDownloadInfo = DownloadInfo{..}, ..})
|
||||
= object [ "version" .= vdiVersion
|
||||
, "url" .= downloadInfoUrl
|
||||
, "content-length" .= downloadInfoContentLength
|
||||
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
|
||||
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
|
||||
]
|
||||
|
||||
instance NFData VersionedDownloadInfo
|
||||
|
||||
instance FromJSON VersionedDownloadInfo where
|
||||
parseJSON = withObject "VersionedDownloadInfo" $ \o -> do
|
||||
ver' <- o .: "version"
|
||||
downloadInfo <- parseDownloadInfoFromObject o
|
||||
pure VersionedDownloadInfo
|
||||
{ vdiVersion = ver'
|
||||
, vdiDownloadInfo = downloadInfo
|
||||
}
|
||||
|
||||
data GHCDownloadInfo = GHCDownloadInfo
|
||||
{ gdiConfigureOpts :: [Text]
|
||||
, gdiConfigureEnv :: Map Text Text
|
||||
, gdiDownloadInfo :: DownloadInfo
|
||||
}
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance NFData GHCDownloadInfo
|
||||
|
||||
instance ToJSON GHCDownloadInfo where
|
||||
toJSON (GHCDownloadInfo {gdiDownloadInfo = DownloadInfo {..}, ..})
|
||||
= object [ "configure-opts" .= gdiConfigureOpts
|
||||
, "configure-env" .= gdiConfigureEnv
|
||||
, "url" .= downloadInfoUrl
|
||||
, "content-length" .= downloadInfoContentLength
|
||||
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
|
||||
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
|
||||
]
|
||||
|
||||
instance FromJSON GHCDownloadInfo where
|
||||
parseJSON = withObject "GHCDownloadInfo" $ \o -> do
|
||||
configureOpts <- o .:? "configure-opts" .!= mempty
|
||||
configureEnv <- o .:? "configure-env" .!= mempty
|
||||
downloadInfo <- parseDownloadInfoFromObject o
|
||||
pure GHCDownloadInfo
|
||||
{ gdiConfigureOpts = configureOpts
|
||||
, gdiConfigureEnv = configureEnv
|
||||
, gdiDownloadInfo = downloadInfo
|
||||
}
|
||||
|
||||
@@ -49,7 +49,6 @@ import GHCup.Prelude.Logger.Internal
|
||||
import GHCup.Prelude.MegaParsec
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prelude.String.QQ
|
||||
|
||||
import Codec.Archive hiding ( Directory )
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
@@ -62,7 +61,6 @@ import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||
import Data.Char ( isHexDigit )
|
||||
import Data.Bifunctor ( first )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.Foldable
|
||||
@@ -91,9 +89,10 @@ import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Streamly.Prelude as S
|
||||
|
||||
import Control.DeepSeq (force)
|
||||
import GHC.IO (evaluate)
|
||||
import System.Environment (getEnvironment, setEnv)
|
||||
import Data.Time (Day(..), diffDays, addDays)
|
||||
|
||||
|
||||
-- $setup
|
||||
@@ -119,11 +118,11 @@ import System.Environment (getEnvironment, setEnv)
|
||||
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
|
||||
-- >>> dirs' <- getAllDirs
|
||||
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
|
||||
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
|
||||
-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
|
||||
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
|
||||
-- >>> cwd <- getCurrentDirectory
|
||||
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
||||
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
|
||||
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
|
||||
|
||||
|
||||
|
||||
@@ -288,13 +287,6 @@ ghcInstalled ver = do
|
||||
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
|
||||
|
||||
|
||||
-- | Whether the given GHC version is installed from source.
|
||||
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
||||
ghcSrcInstalled ver = do
|
||||
ghcdir <- ghcupGHCDir ver
|
||||
liftIO $ doesFileExist (fromGHCupPath ghcdir </> ghcUpSrcBuiltFile)
|
||||
|
||||
|
||||
-- | Whether the given GHC version is set as the current.
|
||||
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||
=> Maybe Text -- ^ the target of the GHC version, if any
|
||||
@@ -335,7 +327,7 @@ ghcSet mtarget = do
|
||||
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
||||
getInstalledGHCs = do
|
||||
ghcdir <- ghcupGHCBaseDir
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir)
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
|
||||
forM fs $ \f -> case parseGHCupGHCDir f of
|
||||
Right r -> pure $ Right r
|
||||
Left _ -> pure $ Left f
|
||||
@@ -376,7 +368,9 @@ cabalSet = do
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- liftIO $ isBrokenSymlink cabalbin
|
||||
if broken
|
||||
then pure Nothing
|
||||
then do
|
||||
logWarn $ "Broken symlink at " <> T.pack cabalbin
|
||||
pure Nothing
|
||||
else do
|
||||
link <- liftIO
|
||||
$ handleIO' InvalidArgument
|
||||
@@ -438,7 +432,7 @@ getInstalledHLSs = do
|
||||
Nothing -> pure $ Left f
|
||||
|
||||
hlsdir <- ghcupHLSBaseDir
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir)
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
|
||||
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
||||
Right r -> pure $ Right r
|
||||
Left _ -> pure $ Left f
|
||||
@@ -473,7 +467,9 @@ stackSet = do
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- liftIO $ isBrokenSymlink stackBin
|
||||
if broken
|
||||
then pure Nothing
|
||||
then do
|
||||
logWarn $ "Broken symlink at " <> T.pack stackBin
|
||||
pure Nothing
|
||||
else do
|
||||
link <- liftIO
|
||||
$ handleIO' InvalidArgument
|
||||
@@ -527,15 +523,17 @@ isLegacyHLS ver = do
|
||||
|
||||
|
||||
-- Return the currently set hls version, if any.
|
||||
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||
hlsSet = do
|
||||
Dirs {..} <- getDirs
|
||||
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||
|
||||
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- isBrokenSymlink hlsBin
|
||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||
broken <- liftIO $ isBrokenSymlink hlsBin
|
||||
if broken
|
||||
then pure Nothing
|
||||
then do
|
||||
logWarn $ "Broken symlink at " <> T.pack hlsBin
|
||||
pure Nothing
|
||||
else do
|
||||
link <- liftIO $ getLinkTarget hlsBin
|
||||
Just <$> linkVersion link
|
||||
@@ -563,6 +561,7 @@ hlsSet = do
|
||||
-- | Return the GHC versions the currently selected HLS supports.
|
||||
hlsGHCVersions :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
@@ -626,7 +625,7 @@ hlsInternalServerScripts ver mghcVer = do
|
||||
dir <- ghcupHLSDir ver
|
||||
let bdir = fromGHCupPath dir </> "bin"
|
||||
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
||||
<$> liftIO (listDirectory bdir)
|
||||
<$> liftIO (listDirectoryFiles bdir)
|
||||
|
||||
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
|
||||
-- Returns the full path.
|
||||
@@ -639,7 +638,7 @@ hlsInternalServerBinaries ver mghcVer = do
|
||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
|
||||
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
||||
<$> liftIO (listDirectory bdir)
|
||||
<$> liftIO (listDirectoryFiles bdir)
|
||||
|
||||
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
|
||||
-- directory, if any.
|
||||
@@ -652,7 +651,7 @@ hlsInternalServerLibs ver ghcVer = do
|
||||
dir <- fromGHCupPath <$> ghcupHLSDir ver
|
||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
|
||||
fmap (bdir </>) <$> liftIO (listDirectory bdir)
|
||||
fmap (bdir </>) <$> liftIO (listDirectoryFiles bdir)
|
||||
|
||||
|
||||
-- | Get the wrapper binary for an hls version, if any.
|
||||
@@ -694,10 +693,8 @@ hlsAllBinaries ver = do
|
||||
|
||||
-- | Extract (major, minor) from any version.
|
||||
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
|
||||
getMajorMinorV Version {..} = case _vChunks of
|
||||
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
|
||||
_ -> throwM $ ParseError "Could not parse X.Y from version"
|
||||
|
||||
getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
|
||||
getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
|
||||
|
||||
matchMajor :: Version -> Int -> Int -> Bool
|
||||
matchMajor v' major' minor' = case getMajorMinorV v' of
|
||||
@@ -739,7 +736,7 @@ getGHCForPVP pvpIn mt = do
|
||||
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
||||
--
|
||||
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
|
||||
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
|
||||
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "debug" :| [])), _vMeta = Just "lol"}})
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
|
||||
-- "Just 8.8.4"
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
|
||||
@@ -765,21 +762,24 @@ getGHCForPVP' pvpIn ghcs' mt = do
|
||||
-- | Get the latest available ghc for the given PVP version, which
|
||||
-- may only contain parts.
|
||||
--
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
|
||||
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [10,7]})
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
|
||||
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
|
||||
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||
getLatestToolFor :: MonadThrow m
|
||||
=> Tool
|
||||
-> Maybe Text
|
||||
-> PVP
|
||||
-> GHCupDownloads
|
||||
-> m (Maybe (PVP, VersionInfo))
|
||||
getLatestToolFor tool pvpIn dls = do
|
||||
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
|
||||
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
|
||||
-> m (Maybe (PVP, VersionInfo, Maybe Text))
|
||||
getLatestToolFor tool target pvpIn dls = do
|
||||
let ls :: [(GHCTargetVersion, VersionInfo)]
|
||||
ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||
let ps :: [((PVP, Text), VersionInfo, Maybe Text)]
|
||||
ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls
|
||||
pure . fmap (\((pv', _), vi, mt) -> (pv', vi, mt)) . headMay . filter (\((v, _), _, t) -> matchPVPrefix pvpIn v && t == target) $ ps
|
||||
|
||||
|
||||
|
||||
@@ -884,20 +884,41 @@ intoSubdir bdir tardir = case tardir of
|
||||
-- | Get the tool version that has this tag. If multiple have it,
|
||||
-- picks the greatest version.
|
||||
getTagged :: Tag
|
||||
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
||||
-> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
|
||||
getTagged tag =
|
||||
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||
% folding id
|
||||
|
||||
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
||||
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
|
||||
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
|
||||
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
|
||||
maybe m (\d -> let diff = diffDays d day
|
||||
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
|
||||
Map.empty mvv
|
||||
in case headMay (Map.toAscList mdv) of
|
||||
Nothing -> Left Nothing
|
||||
Just (absDiff, (diff, (k, vi)))
|
||||
| absDiff == 0 -> Right (k, vi)
|
||||
| otherwise -> Left (Just (addDays diff day))
|
||||
|
||||
getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
|
||||
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
|
||||
|
||||
getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
||||
|
||||
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
||||
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
|
||||
|
||||
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
|
||||
|
||||
getRecommended :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
|
||||
|
||||
|
||||
-- | Gets the latest GHC with a given base version.
|
||||
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
|
||||
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
|
||||
getLatestBaseVersion av pvpVer =
|
||||
headOf (ix GHC % getTagged (Base pvpVer)) av
|
||||
|
||||
@@ -933,7 +954,7 @@ ghcToolFiles ver = do
|
||||
whenM (fmap not $ ghcInstalled ver)
|
||||
(throwE (NotInstalled GHC ver))
|
||||
|
||||
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||
files <- liftIO (listDirectoryFiles bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
|
||||
|
||||
where
|
||||
@@ -951,11 +972,6 @@ ghcToolFiles ver = do
|
||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
||||
|
||||
|
||||
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
|
||||
-- this GHC was built from source. It contains the build config.
|
||||
ghcUpSrcBuiltFile :: FilePath
|
||||
ghcUpSrcBuiltFile = ".ghcup_src_built"
|
||||
|
||||
|
||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||
make :: ( MonadThrow m
|
||||
@@ -1021,7 +1037,7 @@ applyPatches pdir ddir = do
|
||||
|
||||
patches <- liftIO $ quilt `catchIO` (\e ->
|
||||
if isDoesNotExistError e || isPermissionError e then
|
||||
lexicographical
|
||||
lexicographical
|
||||
else throwIO e)
|
||||
forM_ patches $ \patch' -> applyPatch patch' ddir
|
||||
|
||||
@@ -1069,7 +1085,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
-> FilePath
|
||||
-> m (Either ProcessError ())
|
||||
darwinNotarization Darwin path = exec
|
||||
"xattr"
|
||||
"/usr/bin/xattr"
|
||||
["-r", "-d", "com.apple.quarantine", path]
|
||||
Nothing
|
||||
Nothing
|
||||
@@ -1078,11 +1094,15 @@ darwinNotarization _ _ = pure $ Right ()
|
||||
|
||||
|
||||
|
||||
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
|
||||
getChangeLog dls tool (Left v') =
|
||||
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
|
||||
getChangeLog dls tool (GHCVersion v') =
|
||||
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||
getChangeLog dls tool (Right tag) =
|
||||
getChangeLog dls tool (ToolVersion (mkTVer -> v')) =
|
||||
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||
getChangeLog dls tool (ToolTag tag) =
|
||||
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
||||
getChangeLog dls tool (ToolDay day) =
|
||||
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
|
||||
|
||||
|
||||
-- | Execute a build action while potentially cleaning up:
|
||||
@@ -1166,7 +1186,7 @@ rmBDir dir = withRunInIO (\run -> run $
|
||||
$ rmPathForcibly dir)
|
||||
|
||||
|
||||
getVersionInfo :: Version
|
||||
getVersionInfo :: GHCTargetVersion
|
||||
-> Tool
|
||||
-> GHCupDownloads
|
||||
-> Maybe VersionInfo
|
||||
@@ -1196,7 +1216,7 @@ ensureGlobalTools
|
||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||
dirs <- lift getDirs
|
||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\DigestError{} -> do
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
@@ -1300,22 +1320,6 @@ warnAboutHlsCompatibility = do
|
||||
|
||||
|
||||
|
||||
addToPath :: FilePath
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> IO [(String, String)]
|
||||
addToPath path append = do
|
||||
cEnv <- Map.fromList <$> getEnvironment
|
||||
let paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
{- HLINT ignore "Redundant bracket" -}
|
||||
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
liftIO $ setEnv pathVar newPath
|
||||
return envWithNewPath
|
||||
|
||||
|
||||
-----------
|
||||
--[ Git ]--
|
||||
-----------
|
||||
|
||||
@@ -42,6 +42,9 @@ module GHCup.Utils.Dirs
|
||||
, removeDirectoryRecursive
|
||||
, removePathForcibly
|
||||
|
||||
, listDirectoryFiles
|
||||
, listDirectoryDirs
|
||||
|
||||
-- System.Directory re-exports
|
||||
, createDirectory
|
||||
, createDirectoryIfMissing
|
||||
@@ -130,7 +133,7 @@ import Data.Maybe
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
import Optics hiding ( uncons )
|
||||
import Safe
|
||||
import System.Directory hiding ( removeDirectory
|
||||
, removeDirectoryRecursive
|
||||
@@ -276,7 +279,7 @@ ghcupCacheDir
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".cache")
|
||||
pure (GHCupPath (bdir </> "ghcup"))
|
||||
pure (GHCupPath (bdir </> "ghcup" </> "cache"))
|
||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
|
||||
|
||||
|
||||
@@ -305,19 +308,7 @@ ghcupLogsDir
|
||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
|
||||
ghcupDbDir :: IO GHCupPath
|
||||
ghcupDbDir
|
||||
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
||||
| otherwise = do
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".cache")
|
||||
pure (GHCupPath (bdir </> "ghcup" </> "db"))
|
||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
||||
ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
||||
|
||||
|
||||
-- | '~/.ghcup/trash'.
|
||||
@@ -529,6 +520,29 @@ cleanupTrash = do
|
||||
) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
|
||||
|
||||
|
||||
-- | List *actual files* in a directory, ignoring empty files and a couple
|
||||
-- of blacklisted files, such as '.DS_Store' on mac.
|
||||
listDirectoryFiles :: FilePath -> IO [FilePath]
|
||||
listDirectoryFiles fp = do
|
||||
listDirectory fp >>= filterM (doesFileExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
|
||||
|
||||
-- | List *actual directories* in a directory, ignoring empty directories and a couple
|
||||
-- of blacklisted files, such as '.DS_Store' on mac.
|
||||
listDirectoryDirs :: FilePath -> IO [FilePath]
|
||||
listDirectoryDirs fp = do
|
||||
listDirectory fp >>= filterM (doesDirectoryExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
|
||||
|
||||
isHidden :: FilePath -> Bool
|
||||
isHidden fp'
|
||||
| isWindows = False
|
||||
| Just ('.', _) <- uncons fp' = True
|
||||
| otherwise = False
|
||||
|
||||
isBlacklisted :: FilePath -> Bool
|
||||
{- HLINT ignore "Use ==" -}
|
||||
isBlacklisted fp' = fp' `elem` [".DS_Store"]
|
||||
|
||||
|
||||
|
||||
-- System.Directory re-exports with GHCupPath
|
||||
|
||||
|
||||
@@ -24,17 +24,20 @@ import qualified Data.Text as T
|
||||
import qualified Data.Versions as V
|
||||
import Control.Exception.Safe (MonadThrow)
|
||||
import Data.Text (Text)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import Data.List (intersperse)
|
||||
import Control.Monad.Catch (throwM)
|
||||
import GHCup.Errors (ParseError(..))
|
||||
import Text.Megaparsec
|
||||
import Data.Void (Void)
|
||||
|
||||
-- | This reflects the API version of the YAML.
|
||||
--
|
||||
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
|
||||
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
||||
ghcupURL :: URI
|
||||
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
|
||||
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]
|
||||
|
||||
stackSetupURL :: URI
|
||||
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
|
||||
|
||||
-- | The current ghcup version.
|
||||
ghcUpVer :: V.PVP
|
||||
@@ -52,8 +55,8 @@ versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
|
||||
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
||||
|
||||
versionRange :: V.Versioning -> VersionRange -> Bool
|
||||
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
|
||||
versionRange ver' (OrRange cmps range) =
|
||||
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
|
||||
versionRange ver' (OrRange cmps range) =
|
||||
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
||||
|
||||
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
|
||||
@@ -65,44 +68,15 @@ pvpToVersion pvp_ rest =
|
||||
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
|
||||
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
|
||||
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
|
||||
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v
|
||||
versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
|
||||
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
|
||||
Right r -> pure r
|
||||
where
|
||||
alternative :: MonadThrow m => V.Version -> m V.PVP
|
||||
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
|
||||
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
|
||||
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
|
||||
|
||||
rest :: V.Version -> Text
|
||||
rest (V.Version _ cs pr me) =
|
||||
let chunks = NE.dropWhile isDigit cs
|
||||
ver = intersperse (T.pack ".") . chunksAsT $ chunks
|
||||
me' = maybe [] (\m -> [T.pack "+",m]) me
|
||||
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
|
||||
prefix = case (ver, pr', me') of
|
||||
(_:_, _, _) -> T.pack "."
|
||||
_ -> T.pack ""
|
||||
in prefix <> mconcat (ver <> pr' <> me')
|
||||
where
|
||||
chunksAsT :: Functor t => t V.VChunk -> t Text
|
||||
chunksAsT = fmap (foldMap f)
|
||||
where
|
||||
f :: V.VUnit -> Text
|
||||
f (V.Digits i) = T.pack $ show i
|
||||
f (V.Str s) = s
|
||||
|
||||
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
|
||||
foldable d g f | null f = d
|
||||
| otherwise = g f
|
||||
|
||||
|
||||
|
||||
isDigit :: V.VChunk -> Bool
|
||||
isDigit (V.Digits _ :| []) = True
|
||||
isDigit _ = False
|
||||
|
||||
unsafeDigit :: V.VChunk -> Int
|
||||
unsafeDigit (V.Digits x :| []) = fromIntegral x
|
||||
unsafeDigit _ = error "unsafeDigit: wrong input"
|
||||
pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
|
||||
pvp'' = do
|
||||
p <- V.pvp'
|
||||
s <- getParserState
|
||||
pure (p, stateInput s)
|
||||
|
||||
pvpFromList :: [Int] -> V.PVP
|
||||
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral
|
||||
|
||||
@@ -2,7 +2,6 @@ site_name: GHCup
|
||||
site_url: https://www.haskell.org/ghcup
|
||||
site_description: GHCup is the main installer for the general purpose language Haskell.
|
||||
site_author: GHCup Team
|
||||
site_favicon: haskell_logo.png
|
||||
|
||||
repo_url: https://github.com/haskell/ghcup-hs
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.19.0"
|
||||
ghver="0.1.19.4"
|
||||
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -119,6 +119,10 @@ edo() {
|
||||
"$@" || die "\"$*\" failed!"
|
||||
}
|
||||
|
||||
eghcup_raw() {
|
||||
"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
_eghcup "$@"
|
||||
}
|
||||
@@ -168,9 +172,8 @@ _done() {
|
||||
green "Start a new haskell project in the current directory via:"
|
||||
green " cabal init --interactive"
|
||||
green
|
||||
green "Install other GHC versions and tools via:"
|
||||
green " ghcup list"
|
||||
green " ghcup install <tool> <version>"
|
||||
green "To install other GHC versions and tools, run:"
|
||||
green " ghcup tui"
|
||||
green
|
||||
green "To install system libraries and update msys2/mingw64,"
|
||||
green "open the \"Mingw haskell shell\""
|
||||
@@ -284,14 +287,6 @@ download_ghcup() {
|
||||
esac
|
||||
;;
|
||||
"FreeBSD"|"freebsd")
|
||||
if freebsd-version | grep -E '^12.*' ; then
|
||||
freebsd_ver=12
|
||||
elif freebsd-version | grep -E '^13.*' ; then
|
||||
freebsd_ver=13
|
||||
else
|
||||
die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
|
||||
fi
|
||||
|
||||
case "${arch}" in
|
||||
x86_64|amd64)
|
||||
;;
|
||||
@@ -301,7 +296,7 @@ download_ghcup() {
|
||||
*) die "Unknown architecture: ${arch}"
|
||||
;;
|
||||
esac
|
||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
|
||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-portbld-freebsd-ghcup-${ghver}
|
||||
;;
|
||||
"Darwin"|"darwin")
|
||||
case "${arch}" in
|
||||
@@ -389,10 +384,10 @@ download_ghcup() {
|
||||
edo . "${GHCUP_DIR}"/env
|
||||
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
||||
"curl")
|
||||
eghcup config set downloader Curl
|
||||
eghcup_raw config set downloader Curl
|
||||
;;
|
||||
"wget")
|
||||
eghcup config set downloader Wget
|
||||
eghcup_raw config set downloader Wget
|
||||
;;
|
||||
*)
|
||||
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
|
||||
@@ -855,8 +850,8 @@ case $ask_stack_answer in
|
||||
;;
|
||||
2)
|
||||
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
|
||||
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
||||
edo mkdir -p "${STACK_ROOT:-$HOME/.stack}"/hooks
|
||||
hook_exe="${STACK_ROOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
||||
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
||||
|
||||
if [ -e "${hook_exe}" ] ; then
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
* cabal - The Cabal build tool for managing Haskell software"
|
||||
* stack - (optional) A cross-platform program for developing Haskell projects"
|
||||
* hls - (optional) A language server for developers to integrate with their editor/IDE"
|
||||
|
||||
|
||||
By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
|
||||
#>
|
||||
param (
|
||||
@@ -40,10 +40,15 @@ param (
|
||||
# Whether to disable use of curl.exe
|
||||
[switch]$DisableCurl,
|
||||
# The Msys2 version to download (e.g. 20221216)
|
||||
[string]$Msys2Version
|
||||
[string]$Msys2Version,
|
||||
# The Msys2 sha256sum hash
|
||||
[string]$Msys2Hash,
|
||||
# Whether to disable creation of several desktop shortcuts
|
||||
[switch]$DontWriteDesktopShortcuts
|
||||
)
|
||||
|
||||
$DefaultMsys2Version = "20221216"
|
||||
$DefaultMsys2Hash = "18370d32b0264915c97e3d7c618f7b32d48ad80858923883fde5145acd32ca0f"
|
||||
|
||||
$Silent = !$Interactive
|
||||
|
||||
@@ -136,7 +141,7 @@ filter Get-FileSize {
|
||||
function Get-FileWCSynchronous{
|
||||
param(
|
||||
[Parameter(Mandatory=$true)]
|
||||
[string]$url,
|
||||
[string]$url,
|
||||
[string]$destinationFolder="$env:USERPROFILE\Downloads",
|
||||
[switch]$includeStats
|
||||
)
|
||||
@@ -226,7 +231,7 @@ if ($GhcupBasePrefixEnv) {
|
||||
Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
|
||||
} else {
|
||||
Print-Msg -color Red -msg "Couldn't find a writable partition with at least 5GB free disk space!"
|
||||
Exit 1
|
||||
Exit 1
|
||||
}
|
||||
}
|
||||
|
||||
@@ -271,7 +276,7 @@ Press enter to accept the default [{0}]:
|
||||
if (!($GhcupBasePrefix.EndsWith('\'))) {
|
||||
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
|
||||
}
|
||||
|
||||
|
||||
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
|
||||
if (!($GhcupBasePrefix)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
@@ -347,7 +352,7 @@ if ($CabalDir) {
|
||||
$CabDirEnv = $CabalDir
|
||||
if (!($CabDirEnv)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
Exit 1
|
||||
Exit 1
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
||||
Exit 1
|
||||
@@ -362,7 +367,7 @@ if ($CabalDir) {
|
||||
|
||||
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
|
||||
if (!($CabDirEnv)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
||||
} else {
|
||||
@@ -407,6 +412,26 @@ if (!($InstallStack)) {
|
||||
}
|
||||
}
|
||||
|
||||
if ($Interactive) {
|
||||
$DesktopDecision = $Host.UI.PromptForChoice('Create Desktop shortcuts'
|
||||
, 'Do you want to create convenience desktop shortcuts (e.g. for uninstallation and msys2 shell)?'
|
||||
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
|
||||
'&No'
|
||||
'&Abort'), 0)
|
||||
if ($DesktopDecision -eq 0) {
|
||||
$InstallDesktopShortcuts = $true
|
||||
} elseif ($DesktopDecision -eq 2) {
|
||||
Exit 0
|
||||
}
|
||||
} else {
|
||||
if ($Minimal) {
|
||||
$InstallDesktopShortcuts = $false
|
||||
} elseif ($DontWriteDesktopShortcuts) {
|
||||
$InstallDesktopShortcuts = $false
|
||||
} else {
|
||||
$InstallDesktopShortcuts = $true
|
||||
}
|
||||
}
|
||||
|
||||
# mingw foo
|
||||
Print-Msg -msg 'First checking for Msys2...'
|
||||
@@ -430,9 +455,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
if (!($Msys2Version)) {
|
||||
$Msys2Version = $DefaultMsys2Version
|
||||
}
|
||||
if (!($Msys2Hash)) {
|
||||
$Msys2Hash = $DefaultMsys2Hash
|
||||
}
|
||||
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
||||
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
||||
$msysUrl = ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
||||
$msysUrl = ('https://downloads.haskell.org/ghcup/msys2/{0}' -f "$archive")
|
||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||
|
||||
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
||||
@@ -440,6 +468,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
} else {
|
||||
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||
}
|
||||
$Msys2HashChecked = Get-FileHash -Algorithm SHA256 "${archivePath}"
|
||||
if (!($Msys2HashChecked.Hash -eq $Msys2Hash)) {
|
||||
Print-Msg -color Red -msg ("Hashes don't match, got {0}, but expected {1}" -f $Msys2HashChecked, $Msys2Hash)
|
||||
Exit 1
|
||||
}
|
||||
|
||||
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||
@@ -448,7 +481,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||
Exec "$Bash" '-lc' 'exit'
|
||||
|
||||
Exec "$env:windir\system32\taskkill.exe" /F /FI `"MODULES eq msys-2.0.dll`"
|
||||
Exec "$env:windir\system32\taskkill.exe" /F /FI "MODULES eq msys-2.0.dll"
|
||||
|
||||
Print-Msg -msg 'Upgrading full system...'
|
||||
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
||||
@@ -474,12 +507,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
$MsysDirPrompt = Read-Host
|
||||
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
|
||||
} else {
|
||||
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
|
||||
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
|
||||
$MsysDir = Read-Host
|
||||
}
|
||||
$MsysDir = $MsysDir.TrimEnd().TrimStart()
|
||||
if (!($MsysDir)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
|
||||
Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
|
||||
@@ -499,8 +532,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
Start-Sleep -s 5
|
||||
}
|
||||
|
||||
Print-Msg -msg 'Creating shortcuts...'
|
||||
$uninstallShortCut = @'
|
||||
|
||||
if ($InstallDesktopShortcuts) {
|
||||
|
||||
Print-Msg -msg 'Creating shortcuts...'
|
||||
$uninstallShortCut = @'
|
||||
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
|
||||
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
|
||||
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
|
||||
@@ -562,12 +598,13 @@ if ($Host.Name -eq "ConsoleHost")
|
||||
}
|
||||
'@
|
||||
|
||||
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
||||
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
||||
}
|
||||
|
||||
Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
|
||||
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'
|
||||
|
||||
@@ -9,8 +9,8 @@ set -eu
|
||||
|
||||
case $HOOK_GHC_TYPE in
|
||||
bindist)
|
||||
ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
|
||||
printf "%s/ghc" "${ghcdir}"
|
||||
ghc_path=$(ghcup whereis ghc "$HOOK_GHC_VERSION" || { ghcup install ghc "$HOOK_GHC_VERSION" >/dev/null && ghcup whereis ghc "$HOOK_GHC_VERSION" ; }) || { >&2 echo "Installing $HOOK_GHC_VERSION via ghcup failed" exit 3 ;}
|
||||
printf "%s" "${ghc_path}"
|
||||
;;
|
||||
git)
|
||||
# TODO: should be somewhat possible
|
||||
|
||||
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
|
||||
|
||||
@@ -7,6 +7,7 @@ shopt -s extglob
|
||||
|
||||
RELEASE=$1
|
||||
SIGNER=$2
|
||||
TAG=${RELEASE/v/}
|
||||
|
||||
echo "RELEASE: $RELEASE"
|
||||
echo "SIGNER: $SIGNER"
|
||||
@@ -18,17 +19,19 @@ done
|
||||
[ ! -e "gh-release-artifacts/${RELEASE}" ]
|
||||
|
||||
mkdir -p "gh-release-artifacts/${RELEASE}"
|
||||
|
||||
git archive --format=tar.gz -o "gh-release-artifacts/${RELEASE}/ghcup-${TAG}-src.tar.gz" --prefix="ghcup-${TAG}/" HEAD
|
||||
|
||||
cd "gh-release-artifacts/${RELEASE}"
|
||||
|
||||
# github
|
||||
gh release download $RELEASE
|
||||
|
||||
rm test-*
|
||||
gh release download "$RELEASE"
|
||||
|
||||
# cirrus
|
||||
curl -L -o x86_64-portbld-freebsd-ghcup-${RELEASE} \
|
||||
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}"
|
||||
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-${TAG}?branch=${RELEASE}"
|
||||
|
||||
sha256sum *ghcup* > SHA256SUMS
|
||||
sha256sum ./*-ghcup-* > SHA256SUMS
|
||||
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
||||
|
||||
gh release upload "$RELEASE" "ghcup-${TAG}-src.tar.gz" "x86_64-portbld-freebsd-ghcup-${TAG}" SHA256SUMS SHA256SUMS.sig
|
||||
|
||||
@@ -21,8 +21,7 @@ rm i386-linux-ghcup
|
||||
rm x86_64-apple-darwin-ghcup
|
||||
rm x86_64-linux-ghcup
|
||||
rm x86_64-mingw64-ghcup.exe
|
||||
rm x86_64-freebsd12-ghcup
|
||||
rm x86_64-freebsd13-ghcup
|
||||
rm x86_64-portbld-freebsd-ghcup
|
||||
|
||||
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
|
||||
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
|
||||
|
||||
52
stack.yaml
52
stack.yaml
@@ -1,52 +1,38 @@
|
||||
resolver: lts-18.28
|
||||
resolver: lts-20.26
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
||||
extra-deps:
|
||||
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
|
||||
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
||||
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
||||
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
||||
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
||||
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
|
||||
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
|
||||
- Cabal-3.6.3.0
|
||||
- Cabal-syntax-3.10.1.0
|
||||
- aeson-2.1.2.1
|
||||
- cabal-install-parsers-0.6.1
|
||||
- chs-cabal-0.1.1.1
|
||||
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
|
||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
||||
- chs-deps-0.1.0.0
|
||||
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
|
||||
- generically-0.1.1
|
||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
|
||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
||||
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
|
||||
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
|
||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
||||
- libarchive-3.0.3.0
|
||||
- haskus-utils-variant-3.2.1
|
||||
- libarchive-3.0.3.2
|
||||
- libyaml-streamly-0.2.1
|
||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
||||
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
|
||||
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
|
||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
||||
- regex-posix-clib-2.7
|
||||
- lzma-static-5.2.5.5
|
||||
- os-release-1.0.2.1
|
||||
- parsec-3.1.15.0
|
||||
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
||||
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- yaml-streamly-0.12.1
|
||||
- strict-base-0.4.0.0
|
||||
- text-2.0.2
|
||||
- yaml-streamly-0.12.2
|
||||
- github: fosskers/versions
|
||||
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
brotli: false
|
||||
|
||||
libarchive:
|
||||
system-libarchive: false
|
||||
system-libarchive: true
|
||||
|
||||
regex-posix:
|
||||
_regex-posix-clib: true
|
||||
|
||||
@@ -11,6 +11,7 @@ import GHCup.Types
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Versions
|
||||
import Data.List.NonEmpty
|
||||
import Data.Time.Calendar ( Day(..) )
|
||||
import Test.QuickCheck
|
||||
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
|
||||
import Test.QuickCheck.Arbitrary.Generic
|
||||
@@ -76,6 +77,9 @@ instance Arbitrary Port where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary Day where
|
||||
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
|
||||
|
||||
instance Arbitrary (URIRef Absolute) where
|
||||
arbitrary =
|
||||
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
|
||||
@@ -179,6 +183,10 @@ instance Arbitrary GHCupInfo where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary GHCTargetVersion where
|
||||
arbitrary = GHCTargetVersion Nothing <$> arbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
|
||||
-- our maps are nested... the default size easily blows up most ppls ram
|
||||
|
||||
@@ -24,11 +24,11 @@ spec = do
|
||||
-- https://github.com/haskell/ghcup-hs/issues/415
|
||||
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
||||
it "readDirEnt" $ do
|
||||
dirstream <- liftIO $ openDirStream "test/data"
|
||||
(dt1, fp1) <- readDirEnt dirstream
|
||||
(dt2, fp2) <- readDirEnt dirstream
|
||||
(dt3, fp3) <- readDirEnt dirstream
|
||||
(dt4, fp4) <- readDirEnt dirstream
|
||||
dirstream <- liftIO $ openDirStreamPortable "test/ghcup-test/data"
|
||||
(dt1, fp1) <- readDirEntPortable dirstream
|
||||
(dt2, fp2) <- readDirEntPortable dirstream
|
||||
(dt3, fp3) <- readDirEntPortable dirstream
|
||||
(dt4, fp4) <- readDirEntPortable dirstream
|
||||
let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
|
||||
, (dt3, fp3), (dt4, fp4)
|
||||
]
|
||||
@@ -17,6 +17,6 @@ spec = do
|
||||
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
|
||||
where
|
||||
goldenDir
|
||||
| isWindows = "test/golden/windows"
|
||||
| otherwise = "test/golden/unix"
|
||||
| isWindows = "test/ghcup-test/golden/windows"
|
||||
| otherwise = "test/ghcup-test/golden/unix"
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user