Compare commits
284 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 55030d83da | |||
| c680a9f33b | |||
| df192ee18e | |||
|
|
008def2ff4 | ||
|
|
3976daddb7 | ||
| 524cdbbeb1 | |||
| a01c5acfe2 | |||
|
|
6689312ac5 | ||
| e214695a3e | |||
| 3cea6ef97c | |||
| 3b0f131a65 | |||
|
|
e0a3020e34 | ||
|
|
0e46b9509a | ||
|
|
d3474d0cd9 | ||
|
|
5c3dad1bb9 | ||
|
|
987cdaf313 | ||
|
|
835352428a | ||
|
|
8f4246e716 | ||
|
|
1353a2fd20 | ||
|
|
aa9fbdbfc2 | ||
| 3a8cdf9967 | |||
| 2caf491e9d | |||
| d277e56121 | |||
| 335099ad19 | |||
| b1106985ec | |||
| cd8ce9aaa9 | |||
| 18f0cb086b | |||
| dee54445bf | |||
|
|
2df59fd1b3 | ||
| 2e5dee8e1a | |||
| c6aa5c3ed7 | |||
| 47ef380ebd | |||
| d6601b0353 | |||
| 0eba225723 | |||
| e7d91d138b | |||
| 0103e2771e | |||
| b6246734e4 | |||
| 6146c3494f | |||
| e5a7a2da70 | |||
| 6047614a16 | |||
| 6a86e9e77e | |||
| 4132447e04 | |||
| 9d223730de | |||
| ad9199568b | |||
| 0d91c2ac14 | |||
| 8644ca41e1 | |||
|
|
6051c0cfbc | ||
| 67d977ce39 | |||
| 8b6b3d2fbe | |||
| 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
|
|||
|
048932bf50
|
|||
|
69d325bf90
|
|||
|
3d1b8859cd
|
|||
|
db89ca9942
|
|||
|
bba009d98c
|
|||
|
9d954ea174
|
|||
|
da9c9049d2
|
|||
|
a4c00d2c56
|
|||
|
|
b30f565871 | ||
|
|
fa378a1d34 | ||
|
|
119efb1ff4 |
@@ -1,5 +1,5 @@
|
|||||||
freebsd_instance:
|
freebsd_instance:
|
||||||
image_family: freebsd-13-1
|
image_family: freebsd-13-2
|
||||||
|
|
||||||
build_task:
|
build_task:
|
||||||
name: build
|
name: build
|
||||||
@@ -16,7 +16,9 @@ build_task:
|
|||||||
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
||||||
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
||||||
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
||||||
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
install_script:
|
||||||
|
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
|
||||||
|
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
||||||
script:
|
script:
|
||||||
- tzsetup Etc/GMT
|
- tzsetup Etc/GMT
|
||||||
- adjkerntz -a
|
- adjkerntz -a
|
||||||
|
|||||||
11
.editorconfig
Normal file
11
.editorconfig
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
root = true
|
||||||
|
|
||||||
|
[*]
|
||||||
|
end_of_line = LF
|
||||||
|
trim_trailing_whitespace = true
|
||||||
|
insert_final_newline = true
|
||||||
|
|
||||||
|
[*.hs]
|
||||||
|
indent_style = space
|
||||||
|
indent_size = 2
|
||||||
|
max_line_length = 80
|
||||||
2
.github/scripts/bootstrap.sh
vendored
2
.github/scripts/bootstrap.sh
vendored
@@ -13,4 +13,6 @@ git describe --always
|
|||||||
./scripts/bootstrap/bootstrap-haskell
|
./scripts/bootstrap/bootstrap-haskell
|
||||||
|
|
||||||
[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
|
[ "$(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
|
mkdir -p out
|
||||||
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
|
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
|
||||||
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
|
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
|
||||||
|
binary_opttest=$(cabal --project-file=cabal.project.release list-bin ghcup-optparse-test)
|
||||||
ver=$("${binary}" --numeric-version)
|
ver=$("${binary}" --numeric-version)
|
||||||
strip_binary "${binary}"
|
strip_binary "${binary}"
|
||||||
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
|
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
|
||||||
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
|
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
|
||||||
|
cp "${binary_opttest}" "out/test-optparse-${ARTIFACT}-${ver}${ext}"
|
||||||
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
|
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
|
||||||
|
|
||||||
|
|||||||
13
.github/scripts/cabal-cache.sh
vendored
Normal file
13
.github/scripts/cabal-cache.sh
vendored
Normal file
@@ -0,0 +1,13 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
case "$(uname -s)" in
|
||||||
|
MSYS_*|MINGW*)
|
||||||
|
ext=".exe"
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
ext=""
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
|
||||||
|
echo "cabal-cache disabled (CABAL_CACHE_DISABLE set)"
|
||||||
|
|
||||||
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"
|
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
cabal-cache sync-from-archive \
|
cabal-cache.sh sync-from-archive \
|
||||||
--host-name-override=${S3_HOST} \
|
--host-name-override=${S3_HOST} \
|
||||||
--host-port-override=443 \
|
--host-port-override=443 \
|
||||||
--host-ssl-override=True \
|
--host-ssl-override=True \
|
||||||
@@ -29,7 +29,7 @@ sync_to() {
|
|||||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
cabal-cache sync-to-archive \
|
cabal-cache.sh sync-to-archive \
|
||||||
--host-name-override=${S3_HOST} \
|
--host-name-override=${S3_HOST} \
|
||||||
--host-port-override=443 \
|
--host-port-override=443 \
|
||||||
--host-ssl-override=True \
|
--host-ssl-override=True \
|
||||||
@@ -115,6 +115,10 @@ download_cabal_cache() {
|
|||||||
mv "cabal-cache${exe}" "${dest}${exe}"
|
mv "cabal-cache${exe}" "${dest}${exe}"
|
||||||
chmod +x "${dest}${exe}"
|
chmod +x "${dest}${exe}"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
# install shell wrapper
|
||||||
|
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
|
||||||
|
chmod +x "$HOME"/.local/bin/cabal-cache.sh
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -129,6 +133,27 @@ build_with_cache() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
install_ghcup() {
|
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
|
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/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
|
||||||
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
|
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
|
||||||
|
cp "out/test-optparse-${ARTIFACT}"-* "ghcup-test-optparse${ext}"
|
||||||
chmod +x "$GHCUP_BIN/ghcup${ext}"
|
chmod +x "$GHCUP_BIN/ghcup${ext}"
|
||||||
chmod +x "ghcup-test${ext}"
|
chmod +x "ghcup-test${ext}"
|
||||||
|
chmod +x "ghcup-test-optparse${ext}"
|
||||||
|
|
||||||
"$GHCUP_BIN/ghcup${ext}" --version
|
"$GHCUP_BIN/ghcup${ext}" --version
|
||||||
eghcup --version
|
eghcup --version
|
||||||
@@ -28,31 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
|
|||||||
|
|
||||||
### Haskell test suite
|
### Haskell test suite
|
||||||
|
|
||||||
./ghcup-test${ext}
|
./"ghcup-test${ext}"
|
||||||
rm ghcup-test${ext}
|
./"ghcup-test-optparse${ext}"
|
||||||
|
rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
|
||||||
|
|
||||||
### manual cli based testing
|
### manual cli based testing
|
||||||
|
|
||||||
eghcup --numeric-version
|
eghcup --numeric-version
|
||||||
|
|
||||||
eghcup install ghc ${GHC_VER}
|
eghcup install ghc "${GHC_VER}"
|
||||||
eghcup unset ghc ${GHC_VER}
|
eghcup unset ghc "${GHC_VER}"
|
||||||
ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
|
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
|
||||||
[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
|
[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
|
||||||
[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
|
[ "$(eghcup run -q --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)'`" ]
|
[ "$(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 set ghc "${GHC_VER}"
|
||||||
eghcup install cabal ${CABAL_VER}
|
eghcup install cabal "${CABAL_VER}"
|
||||||
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
|
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
|
||||||
eghcup unset cabal
|
eghcup unset cabal
|
||||||
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
||||||
|
|
||||||
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
|
# 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
|
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
||||||
[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
|
[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
|
||||||
eghcup set cabal ${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 [ "${OS}" != "FreeBSD" ] ; then
|
||||||
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
|
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
|
||||||
@@ -82,10 +85,10 @@ eghcup list -t cabal
|
|||||||
|
|
||||||
ghc_ver=$(ghc --numeric-version)
|
ghc_ver=$(ghc --numeric-version)
|
||||||
ghc --version
|
ghc --version
|
||||||
ghc-${ghc_ver} --version
|
"ghc-${ghc_ver}" --version
|
||||||
if [ "${OS}" != "Windows" ] ; then
|
if [ "${OS}" != "Windows" ] ; then
|
||||||
ghci --version
|
ghci --version
|
||||||
ghci-${ghc_ver} --version
|
"ghci-${ghc_ver}" --version
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
@@ -129,11 +132,11 @@ else
|
|||||||
eghcup --offline set 8.10.3
|
eghcup --offline set 8.10.3
|
||||||
eghcup set 8.10.3
|
eghcup set 8.10.3
|
||||||
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
||||||
eghcup set ${GHC_VER}
|
eghcup set "${GHC_VER}"
|
||||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||||
eghcup unset ghc
|
eghcup unset ghc
|
||||||
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
|
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
|
||||||
eghcup set ${GHC_VER}
|
eghcup set "${GHC_VER}"
|
||||||
eghcup --offline rm 8.10.3
|
eghcup --offline rm 8.10.3
|
||||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||||
|
|
||||||
@@ -166,10 +169,10 @@ fi
|
|||||||
# check that lazy loading works for 'whereis'
|
# 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"
|
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"
|
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"
|
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
|
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
|
||||||
if [ "${OS}" = "Linux" ] ; then
|
if [ "${OS}" = "Linux" ] ; then
|
||||||
@@ -183,14 +186,14 @@ eghcup gc -c
|
|||||||
|
|
||||||
# test etags
|
# test etags
|
||||||
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
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
|
# snapshot yaml and etags file
|
||||||
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||||
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||||
# invalidate access time timer, which is 5minutes, so we re-download
|
# invalidate access time timer, which is 5minutes, so we re-download
|
||||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||||
# redownload same file with some newlines added
|
# 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
|
# snapshot new yaml and etags file
|
||||||
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||||
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
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
|
# 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"
|
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||||
# this time, we expect the same hash and etag
|
# 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")
|
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||||
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||||
[ "${etag2}" = "${etag3}" ]
|
[ "${etag2}" = "${etag3}" ]
|
||||||
|
|||||||
7
.github/workflows/bootstrap.yaml
vendored
7
.github/workflows/bootstrap.yaml
vendored
@@ -25,7 +25,7 @@ jobs:
|
|||||||
include:
|
include:
|
||||||
- os: ubuntu-latest
|
- os: ubuntu-latest
|
||||||
DISTRO: Ubuntu
|
DISTRO: Ubuntu
|
||||||
- os: macOS-10.15
|
- os: macOS-11
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
- os: windows-latest
|
- os: windows-latest
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
@@ -51,5 +51,8 @@ jobs:
|
|||||||
|
|
||||||
- if: runner.os == 'Windows'
|
- if: runner.os == 'Windows'
|
||||||
name: Run bootstrap
|
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
|
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
|
||||||
|
|
||||||
30
.github/workflows/docker.yaml
vendored
30
.github/workflows/docker.yaml
vendored
@@ -26,7 +26,9 @@ jobs:
|
|||||||
context: ./docker/alpine32
|
context: ./docker/alpine32
|
||||||
push: true
|
push: true
|
||||||
tags: hasufell/i386-alpine-haskell:3.12
|
tags: hasufell/i386-alpine-haskell:3.12
|
||||||
platforms: linux/i386
|
platforms: |
|
||||||
|
linux/i386
|
||||||
|
linux/amd64
|
||||||
|
|
||||||
docker-alpine:
|
docker-alpine:
|
||||||
runs-on: ubuntu-latest
|
runs-on: ubuntu-latest
|
||||||
@@ -51,7 +53,7 @@ jobs:
|
|||||||
platforms: linux/amd64
|
platforms: linux/amd64
|
||||||
|
|
||||||
docker-arm32:
|
docker-arm32:
|
||||||
runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
|
runs-on: [self-hosted, Linux, ARM64]
|
||||||
steps:
|
steps:
|
||||||
- uses: docker://arm64v8/ubuntu:focal
|
- uses: docker://arm64v8/ubuntu:focal
|
||||||
name: Cleanup (aarch64 linux)
|
name: Cleanup (aarch64 linux)
|
||||||
@@ -70,10 +72,18 @@ jobs:
|
|||||||
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
||||||
password: ${{ secrets.DOCKERHUB_TOKEN }}
|
password: ${{ secrets.DOCKERHUB_TOKEN }}
|
||||||
|
|
||||||
- name: Build and push
|
- name: Build and push (debian buster)
|
||||||
uses: docker/build-push-action@v3
|
uses: docker/build-push-action@v3
|
||||||
with:
|
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
|
push: true
|
||||||
tags: hasufell/arm32v7-ubuntu-haskell:focal
|
tags: hasufell/arm32v7-ubuntu-haskell:focal
|
||||||
platforms: linux/arm
|
platforms: linux/arm
|
||||||
@@ -98,10 +108,18 @@ jobs:
|
|||||||
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
username: ${{ secrets.DOCKERHUB_USERNAME }}
|
||||||
password: ${{ secrets.DOCKERHUB_TOKEN }}
|
password: ${{ secrets.DOCKERHUB_TOKEN }}
|
||||||
|
|
||||||
- name: Build and push
|
- name: Build and push (debian buster)
|
||||||
uses: docker/build-push-action@v3
|
uses: docker/build-push-action@v3
|
||||||
with:
|
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
|
push: true
|
||||||
tags: hasufell/arm64v8-ubuntu-haskell:focal
|
tags: hasufell/arm64v8-ubuntu-haskell:focal
|
||||||
platforms: linux/arm64
|
platforms: linux/arm64
|
||||||
|
|||||||
56
.github/workflows/release.yaml
vendored
56
.github/workflows/release.yaml
vendored
@@ -12,12 +12,16 @@ on:
|
|||||||
schedule:
|
schedule:
|
||||||
- cron: '0 2 * * *'
|
- cron: '0 2 * * *'
|
||||||
|
|
||||||
|
env:
|
||||||
|
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
|
||||||
|
CABAL_CACHE_NONFATAL: yes
|
||||||
|
|
||||||
jobs:
|
jobs:
|
||||||
build-linux:
|
build-linux:
|
||||||
name: Build linux binary
|
name: Build linux binary
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||||
@@ -81,7 +85,7 @@ jobs:
|
|||||||
name: Build ARM binary
|
name: Build ARM binary
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||||
@@ -90,16 +94,16 @@ jobs:
|
|||||||
fail-fast: true
|
fail-fast: true
|
||||||
matrix:
|
matrix:
|
||||||
include:
|
include:
|
||||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
- os: [self-hosted, Linux, ARM64]
|
||||||
ARTIFACT: "armv7-linux-ghcup"
|
ARTIFACT: "armv7-linux-ghcup"
|
||||||
GHC_VER: 9.2.2
|
GHC_VER: 9.2.2
|
||||||
ARCH: ARM
|
ARCH: ARM
|
||||||
- os: [self-hosted, Linux, ARM64]
|
- os: [self-hosted, Linux, ARM64]
|
||||||
ARTIFACT: "aarch64-linux-ghcup"
|
ARTIFACT: "aarch64-linux-ghcup"
|
||||||
GHC_VER: 9.2.5
|
GHC_VER: 9.2.6
|
||||||
ARCH: ARM64
|
ARCH: ARM64
|
||||||
steps:
|
steps:
|
||||||
- uses: docker://arm64v8/ubuntu:focal
|
- uses: docker://arm64v8/debian:10
|
||||||
name: Cleanup (aarch64 linux)
|
name: Cleanup (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||||
@@ -115,7 +119,7 @@ jobs:
|
|||||||
submodules: 'true'
|
submodules: 'true'
|
||||||
|
|
||||||
- if: matrix.ARCH == 'ARM'
|
- if: matrix.ARCH == 'ARM'
|
||||||
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
uses: docker://hasufell/arm32v7-debian-haskell:10
|
||||||
name: Run build (armv7 linux)
|
name: Run build (armv7 linux)
|
||||||
with:
|
with:
|
||||||
args: sh .github/scripts/build.sh
|
args: sh .github/scripts/build.sh
|
||||||
@@ -129,7 +133,7 @@ jobs:
|
|||||||
S3_HOST: ${{ env.S3_HOST }}
|
S3_HOST: ${{ env.S3_HOST }}
|
||||||
|
|
||||||
- if: matrix.ARCH == 'ARM64'
|
- if: matrix.ARCH == 'ARM64'
|
||||||
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
uses: docker://hasufell/arm64v8-debian-haskell:10
|
||||||
name: Run build (aarch64 linux)
|
name: Run build (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: sh .github/scripts/build.sh
|
args: sh .github/scripts/build.sh
|
||||||
@@ -154,7 +158,7 @@ jobs:
|
|||||||
name: Build binary (Mac/Win)
|
name: Build binary (Mac/Win)
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
@@ -166,11 +170,11 @@ jobs:
|
|||||||
include:
|
include:
|
||||||
- os: [self-hosted, macOS, ARM64]
|
- os: [self-hosted, macOS, ARM64]
|
||||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.5
|
GHC_VER: 9.2.6
|
||||||
ARCH: ARM64
|
ARCH: ARM64
|
||||||
- os: macOS-10.15
|
- os: macOS-11
|
||||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.5
|
GHC_VER: 9.2.6
|
||||||
ARCH: 64
|
ARCH: 64
|
||||||
- os: windows-latest
|
- os: windows-latest
|
||||||
ARTIFACT: "x86_64-mingw64-ghcup"
|
ARTIFACT: "x86_64-mingw64-ghcup"
|
||||||
@@ -247,7 +251,7 @@ jobs:
|
|||||||
needs: "build-linux"
|
needs: "build-linux"
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
strategy:
|
strategy:
|
||||||
matrix:
|
matrix:
|
||||||
@@ -318,31 +322,31 @@ jobs:
|
|||||||
with:
|
with:
|
||||||
name: testfiles
|
name: testfiles
|
||||||
path: |
|
path: |
|
||||||
./test/golden/unix/GHCupInfo*json
|
./test/ghcup-test/golden/unix/GHCupInfo*json
|
||||||
|
|
||||||
test-arm:
|
test-arm:
|
||||||
name: Test ARM
|
name: Test ARM
|
||||||
needs: "build-arm"
|
needs: "build-arm"
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
strategy:
|
strategy:
|
||||||
matrix:
|
matrix:
|
||||||
include:
|
include:
|
||||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
- os: [self-hosted, Linux, ARM64]
|
||||||
ARTIFACT: "armv7-linux-ghcup"
|
ARTIFACT: "armv7-linux-ghcup"
|
||||||
GHC_VER: 9.2.2
|
GHC_VER: 9.2.2
|
||||||
ARCH: ARM
|
ARCH: ARM
|
||||||
DISTRO: Ubuntu
|
DISTRO: Ubuntu
|
||||||
- os: [self-hosted, Linux, ARM64]
|
- os: [self-hosted, Linux, ARM64]
|
||||||
ARTIFACT: "aarch64-linux-ghcup"
|
ARTIFACT: "aarch64-linux-ghcup"
|
||||||
GHC_VER: 9.2.5
|
GHC_VER: 9.2.6
|
||||||
ARCH: ARM64
|
ARCH: ARM64
|
||||||
DISTRO: Ubuntu
|
DISTRO: Ubuntu
|
||||||
|
|
||||||
steps:
|
steps:
|
||||||
- uses: docker://arm64v8/ubuntu:focal
|
- uses: docker://arm64v8/debian:10
|
||||||
name: Cleanup (aarch64 linux)
|
name: Cleanup (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||||
@@ -358,7 +362,7 @@ jobs:
|
|||||||
path: ./out
|
path: ./out
|
||||||
|
|
||||||
- if: matrix.ARCH == 'ARM'
|
- if: matrix.ARCH == 'ARM'
|
||||||
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
uses: docker://hasufell/arm32v7-debian-haskell:10
|
||||||
name: Run test (armv7 linux)
|
name: Run test (armv7 linux)
|
||||||
with:
|
with:
|
||||||
args: sh .github/scripts/test.sh
|
args: sh .github/scripts/test.sh
|
||||||
@@ -369,7 +373,7 @@ jobs:
|
|||||||
DISTRO: Ubuntu
|
DISTRO: Ubuntu
|
||||||
|
|
||||||
- if: matrix.ARCH == 'ARM64'
|
- if: matrix.ARCH == 'ARM64'
|
||||||
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
uses: docker://hasufell/arm64v8-debian-haskell:10
|
||||||
name: Run test (aarch64 linux)
|
name: Run test (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
args: sh .github/scripts/test.sh
|
args: sh .github/scripts/test.sh
|
||||||
@@ -385,14 +389,14 @@ jobs:
|
|||||||
with:
|
with:
|
||||||
name: testfiles
|
name: testfiles
|
||||||
path: |
|
path: |
|
||||||
./test/golden/unix/GHCupInfo*json
|
./test/ghcup-test/golden/unix/GHCupInfo*json
|
||||||
|
|
||||||
test-macwin:
|
test-macwin:
|
||||||
name: Test Mac/Win
|
name: Test Mac/Win
|
||||||
needs: "build-macwin"
|
needs: "build-macwin"
|
||||||
runs-on: ${{ matrix.os }}
|
runs-on: ${{ matrix.os }}
|
||||||
env:
|
env:
|
||||||
CABAL_VER: 3.8.1.0
|
CABAL_VER: 3.10.1.0
|
||||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||||
JSON_VERSION: "0.0.7"
|
JSON_VERSION: "0.0.7"
|
||||||
strategy:
|
strategy:
|
||||||
@@ -400,12 +404,12 @@ jobs:
|
|||||||
include:
|
include:
|
||||||
- os: [self-hosted, macOS, ARM64]
|
- os: [self-hosted, macOS, ARM64]
|
||||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.5
|
GHC_VER: 9.2.6
|
||||||
ARCH: ARM64
|
ARCH: ARM64
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
- os: macOS-10.15
|
- os: macOS-11
|
||||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||||
GHC_VER: 9.2.5
|
GHC_VER: 9.2.6
|
||||||
ARCH: 64
|
ARCH: 64
|
||||||
DISTRO: na
|
DISTRO: na
|
||||||
- os: windows-latest
|
- os: windows-latest
|
||||||
@@ -454,7 +458,7 @@ jobs:
|
|||||||
with:
|
with:
|
||||||
name: testfiles
|
name: testfiles
|
||||||
path: |
|
path: |
|
||||||
./test/golden/windows/GHCupInfo*json
|
./test/ghcup-test/golden/windows/GHCupInfo*json
|
||||||
|
|
||||||
- if: failure() && runner.os != 'Windows'
|
- if: failure() && runner.os != 'Windows'
|
||||||
name: Upload artifact
|
name: Upload artifact
|
||||||
@@ -462,7 +466,7 @@ jobs:
|
|||||||
with:
|
with:
|
||||||
name: testfiles
|
name: testfiles
|
||||||
path: |
|
path: |
|
||||||
./test/golden/unix/GHCupInfo*json
|
./test/ghcup-test/golden/unix/GHCupInfo*json
|
||||||
hls:
|
hls:
|
||||||
name: hls
|
name: hls
|
||||||
needs: build-linux
|
needs: build-linux
|
||||||
|
|||||||
2
.gitmodules
vendored
2
.gitmodules
vendored
@@ -1,4 +1,4 @@
|
|||||||
[submodule "data/metadata"]
|
[submodule "data/metadata"]
|
||||||
path = data/metadata
|
path = data/metadata
|
||||||
url = https://github.com/haskell/ghcup-metadata.git
|
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
|
# 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
|
## 0.1.19.0 -- 2023-1-13
|
||||||
|
|
||||||
* restore proper support for FreeBSD and Linux armv7
|
* restore proper support for FreeBSD and Linux armv7
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -42,7 +42,6 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
|
|||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions
|
|
||||||
import GHC.IO.Encoding
|
import GHC.IO.Encoding
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Language.Haskell.TH
|
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
|
toSettings options = do
|
||||||
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
||||||
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
||||||
@@ -73,7 +72,7 @@ toSettings options = do
|
|||||||
pure defaultUserSettings
|
pure defaultUserSettings
|
||||||
_ -> do
|
_ -> do
|
||||||
die "Unexpected error!"
|
die "Unexpected error!"
|
||||||
pure $ mergeConf options userConf noColor
|
pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
|
||||||
where
|
where
|
||||||
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
||||||
mergeConf Options{..} UserSettings{..} noColor =
|
mergeConf Options{..} UserSettings{..} noColor =
|
||||||
@@ -85,7 +84,7 @@ toSettings options = do
|
|||||||
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
||||||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
|
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
|
||||||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
|
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
|
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
||||||
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
||||||
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
||||||
@@ -108,7 +107,6 @@ toSettings options = do
|
|||||||
, bSet = fromMaybe bSet kSet
|
, bSet = fromMaybe bSet kSet
|
||||||
, bChangelog = fromMaybe bChangelog kChangelog
|
, bChangelog = fromMaybe bChangelog kChangelog
|
||||||
, bShowAllVersions = fromMaybe bShowAllVersions kShowAll
|
, bShowAllVersions = fromMaybe bShowAllVersions kShowAll
|
||||||
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@@ -176,7 +174,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
-- create ~/.ghcup dir
|
-- create ~/.ghcup dir
|
||||||
ensureDirectories dirs
|
ensureDirectories dirs
|
||||||
|
|
||||||
(settings, keybindings) <- toSettings opt
|
(settings, keybindings, userConf) <- toSettings opt
|
||||||
|
|
||||||
-- logger interpreter
|
-- logger interpreter
|
||||||
logfile <- runReaderT initGHCupFileLogging dirs
|
logfile <- runReaderT initGHCupFileLogging dirs
|
||||||
@@ -211,10 +209,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
exitWith (ExitFailure 2)
|
exitWith (ExitFailure 2)
|
||||||
|
|
||||||
ghcupInfo <-
|
ghcupInfo <-
|
||||||
( flip runReaderT leanAppstate
|
( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do
|
||||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
|
liftE $ getDownloadsF pfreq
|
||||||
$ liftE getDownloadsF
|
)
|
||||||
)
|
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight r -> pure r
|
VRight r -> pure r
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
@@ -240,7 +237,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
_
|
_
|
||||||
| Just False <- optVerbose -> pure ()
|
| Just False <- optVerbose -> pure ()
|
||||||
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||||
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
|
||||||
newTools <- lift checkForUpdates
|
newTools <- lift checkForUpdates
|
||||||
forM_ newTools $ \newTool@(t, l) -> do
|
forM_ newTools $ \newTool@(t, l) -> do
|
||||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
|
||||||
@@ -249,7 +246,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
case t of
|
case t of
|
||||||
GHCup -> runLogger $
|
GHCup -> runLogger $
|
||||||
logWarn ("New GHCup version available: "
|
logWarn ("New GHCup version available: "
|
||||||
<> prettyVer l
|
<> tVerToText l
|
||||||
<> ". To upgrade, run 'ghcup upgrade'")
|
<> ". To upgrade, run 'ghcup upgrade'")
|
||||||
_ -> runLogger $
|
_ -> runLogger $
|
||||||
logWarn ("New "
|
logWarn ("New "
|
||||||
@@ -258,12 +255,12 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
<> "If you want to install this latest version, run 'ghcup install "
|
<> "If you want to install this latest version, run 'ghcup install "
|
||||||
<> T.pack (prettyShow t)
|
<> T.pack (prettyShow t)
|
||||||
<> " "
|
<> " "
|
||||||
<> prettyVer l
|
<> tVerToText l
|
||||||
<> "'")
|
<> "'")
|
||||||
Just _ -> pure ()
|
Just _ -> pure ()
|
||||||
|
|
||||||
-- TODO: always run for windows
|
-- TODO: always run for windows
|
||||||
siletRunLogger (flip runReaderT s' $ runE ensureGlobalTools) >>= \case
|
siletRunLogger (flip runReaderT s' $ runE ensureShimGen) >>= \case
|
||||||
VRight _ -> pure ()
|
VRight _ -> pure ()
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger
|
runLogger
|
||||||
@@ -303,7 +300,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||||
DInfo -> dinfo runAppState runLogger
|
DInfo -> dinfo runAppState runLogger
|
||||||
Compile compileCommand -> compile compileCommand settings dirs 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
|
Whereis whereisOptions
|
||||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||||
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
||||||
@@ -332,17 +329,18 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
)
|
)
|
||||||
=> Command
|
=> Command
|
||||||
-> (Tool, Version)
|
-> (Tool, GHCTargetVersion)
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m Bool
|
] m Bool
|
||||||
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
|
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
|
||||||
alreadyInstalling (Install (Left (InstallGHC 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 (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS 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 (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||||
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
||||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
||||||
@@ -367,12 +365,14 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
)
|
)
|
||||||
=> Tool
|
=> Tool
|
||||||
-> Maybe ToolVersion
|
-> Maybe ToolVersion
|
||||||
-> Version
|
-> GHCTargetVersion
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m Bool
|
] m Bool
|
||||||
cmp' tool instVer ver = do
|
cmp' tool instVer ver = do
|
||||||
(v, _) <- liftE $ fromVersion instVer tool
|
(v, _) <- liftE $ fromVersion instVer tool
|
||||||
pure (v == mkTVer ver)
|
pure (v == ver)
|
||||||
|
|
||||||
|
|||||||
@@ -8,6 +8,11 @@ package ghcup
|
|||||||
constraints: http-io-streams -brotli,
|
constraints: http-io-streams -brotli,
|
||||||
any.aeson >= 2.0.1.0
|
any.aeson >= 2.0.1.0
|
||||||
|
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://github.com/fosskers/versions.git
|
||||||
|
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||||
|
|
||||||
package libarchive
|
package libarchive
|
||||||
flags: -system-libarchive
|
flags: -system-libarchive
|
||||||
|
|
||||||
@@ -23,3 +28,5 @@ package aeson
|
|||||||
package streamly
|
package streamly
|
||||||
flags: +use-unliftio
|
flags: +use-unliftio
|
||||||
|
|
||||||
|
package *
|
||||||
|
test-show-details: direct
|
||||||
|
|||||||
@@ -4,30 +4,26 @@ optional-packages: ./vendored/*/*.cabal
|
|||||||
|
|
||||||
optimization: 2
|
optimization: 2
|
||||||
|
|
||||||
|
package ghcup
|
||||||
|
flags: +tui
|
||||||
|
|
||||||
if os(linux)
|
if os(linux)
|
||||||
package ghcup
|
|
||||||
flags: +tui
|
|
||||||
if arch(x86_64) || arch(i386)
|
if arch(x86_64) || arch(i386)
|
||||||
package *
|
package *
|
||||||
ghc-options: -split-sections -optl-static
|
ghc-options: -split-sections -optl-static
|
||||||
elif os(darwin)
|
elif os(darwin)
|
||||||
constraints: zlib +bundled-c-zlib,
|
constraints: zlib +bundled-c-zlib,
|
||||||
lzma +static
|
lzma +static
|
||||||
package ghcup
|
|
||||||
flags: +tui
|
|
||||||
elif os(mingw32)
|
elif os(mingw32)
|
||||||
constraints: zlib +bundled-c-zlib,
|
constraints: zlib +bundled-c-zlib,
|
||||||
lzma +static,
|
lzma +static,
|
||||||
text -simdutf
|
text -simdutf,
|
||||||
package ghcup
|
vty-windows >=0.1.0.3
|
||||||
flags: -tui
|
|
||||||
elif os(freebsd)
|
elif os(freebsd)
|
||||||
constraints: zlib +bundled-c-zlib,
|
constraints: zlib +bundled-c-zlib,
|
||||||
zip +disable-zstd
|
zip +disable-zstd
|
||||||
package *
|
package *
|
||||||
ghc-options: -split-sections -pgmc clang++14
|
ghc-options: -split-sections -pgmc clang++14
|
||||||
package ghcup
|
|
||||||
flags: +tui
|
|
||||||
|
|
||||||
constraints: http-io-streams -brotli,
|
constraints: http-io-streams -brotli,
|
||||||
any.aeson >= 2.0.1.0,
|
any.aeson >= 2.0.1.0,
|
||||||
|
|||||||
@@ -16,6 +16,11 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
|
|||||||
# TUI key bindings,
|
# TUI key bindings,
|
||||||
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
|
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
|
||||||
# for possible values.
|
# for possible values.
|
||||||
|
# It's also possible to define key+modifier, e.g.:
|
||||||
|
# quit:
|
||||||
|
# Key:
|
||||||
|
# KChar: c
|
||||||
|
# Mods: [MCtrl]
|
||||||
key-bindings:
|
key-bindings:
|
||||||
up:
|
up:
|
||||||
KUp: []
|
KUp: []
|
||||||
@@ -46,41 +51,45 @@ meta-cache: 300 # in seconds
|
|||||||
# 2. Strict: fail hard
|
# 2. Strict: fail hard
|
||||||
meta-mode: Lax # Strict | Lax
|
meta-mode: Lax # Strict | Lax
|
||||||
|
|
||||||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
|
||||||
# check the 'URLSource' type in the code.
|
# union over tool versions, preferring the later entries.
|
||||||
url-source:
|
url-source:
|
||||||
## Use the internal download uri, this is the default
|
## Use the internal download uri, this is the default
|
||||||
GHCupURL: []
|
- GHCupURL
|
||||||
|
|
||||||
## Example 1: Read download info from this location instead
|
## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata)
|
||||||
## Accepts file/http/https scheme
|
# - StackSetupURL
|
||||||
## 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"
|
|
||||||
|
|
||||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
|
## Add pre-release channel
|
||||||
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
|
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||||
# AddSource:
|
## Add nightly channel
|
||||||
# Left:
|
# - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
|
||||||
# globalTools: {}
|
## Add cross compiler channel
|
||||||
# toolRequirements: {}
|
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
|
||||||
# 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
|
|
||||||
|
|
||||||
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
|
## Use dwarf bindist for 9.4.7 for ghcup metadata
|
||||||
## versions).
|
# - ghcup-info:
|
||||||
# AddSource:
|
# ghcupDownloads:
|
||||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
|
# GHC:
|
||||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
# 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
|
# This is a way to override platform detection, e.g. when you're running
|
||||||
# a Ubuntu derivate based on 18.04, you could do:
|
# a Ubuntu derivate based on 18.04, you could do:
|
||||||
|
|||||||
Submodule data/metadata updated: 9e14e6c736...7e1a50cfff
@@ -1,4 +1,4 @@
|
|||||||
FROM i386/alpine:3.12
|
FROM --platform=linux/i386 i386/alpine:3.12
|
||||||
|
|
||||||
ENV LANG C.UTF-8
|
ENV LANG C.UTF-8
|
||||||
|
|
||||||
@@ -37,8 +37,8 @@ RUN apk add --no-cache \
|
|||||||
xz-dev \
|
xz-dev \
|
||||||
ncurses-static
|
ncurses-static
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||||
|
|||||||
@@ -37,8 +37,9 @@ RUN apk add --no-cache \
|
|||||||
xz-dev \
|
xz-dev \
|
||||||
ncurses-static
|
ncurses-static
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||||
|
|||||||
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
|
RUN update_opt.sh 9 1
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.17.8
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||||
@@ -54,10 +54,7 @@ ENV NO_COLOR=1
|
|||||||
RUN ghcup config set gpg-setting GPGStrict && \
|
RUN ghcup config set gpg-setting GPGStrict && \
|
||||||
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
||||||
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
|
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 && \
|
ghcup gc -s -c -t
|
||||||
rm -r "/usr/share/doc/ghc-${GHC}" && \
|
|
||||||
rm -rf /tmp/ghcup* && \
|
|
||||||
ghcup gc -p -s -c -t
|
|
||||||
|
|
||||||
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
|
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
|
RUN update_opt.sh 9 1
|
||||||
|
|
||||||
ARG GHCUP_VERSION=0.1.18.0
|
ARG GHCUP_VERSION=0.1.19.4
|
||||||
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
|
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
|
|
||||||
# install ghcup
|
# install ghcup
|
||||||
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
|
||||||
@@ -54,10 +54,7 @@ ENV NO_COLOR=1
|
|||||||
RUN ghcup config set gpg-setting GPGStrict && \
|
RUN ghcup config set gpg-setting GPGStrict && \
|
||||||
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
|
||||||
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
|
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 && \
|
ghcup gc -s -c -t
|
||||||
rm -r "/usr/share/doc/ghc-${GHC}" && \
|
|
||||||
rm -rf /tmp/ghcup* && \
|
|
||||||
ghcup gc -p -s -c -t
|
|
||||||
|
|
||||||
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
|
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}"
|
||||||
347
docs/guide.md
347
docs/guide.md
@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
|
|||||||
|
|
||||||
## Basic usage
|
## Basic usage
|
||||||
|
|
||||||
For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
|
For the simple, interactive, text-based user interface (TUI), run:
|
||||||
|
|
||||||
```sh
|
```sh
|
||||||
ghcup tui
|
ghcup tui
|
||||||
@@ -43,6 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
|
|||||||
|
|
||||||
If the argument is omitted, the default is `recommended`.
|
If the argument is omitted, the default is `recommended`.
|
||||||
|
|
||||||
|
Other tags include:
|
||||||
|
|
||||||
|
- `prerelease`: a prerelease version
|
||||||
|
- `latest-prerelease`: the latest prerelease version
|
||||||
|
|
||||||
|
|
||||||
## Manpages
|
## 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.
|
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.
|
||||||
@@ -61,8 +67,7 @@ and make sure your bashrc sources the startup script
|
|||||||
|
|
||||||
`ghcup` is very portable. There are a few exceptions though:
|
`ghcup` is very portable. There are a few exceptions though:
|
||||||
|
|
||||||
1. `ghcup tui` is only available on non-windows platforms
|
1. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
|
||||||
2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
|
|
||||||
|
|
||||||
# Configuration
|
# Configuration
|
||||||
|
|
||||||
@@ -89,7 +94,7 @@ platform-override:
|
|||||||
|
|
||||||
This is the complete list of env variables that change GHCup behavior:
|
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_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
|
||||||
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
|
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
|
||||||
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
|
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
|
||||||
@@ -136,49 +141,29 @@ If you experience problems, consider clearing the cache via `ghcup gc --cache`.
|
|||||||
|
|
||||||
## Metadata
|
## Metadata
|
||||||
|
|
||||||
The metadata are the files that describe tool versions, where to download them etc. and
|
Metadata files are also called release or distribution channels. They describe tool versions, where to download them etc. and
|
||||||
can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)
|
can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata).
|
||||||
|
|
||||||
### Mirrors
|
See the [description](https://github.com/haskell/ghcup-metadata#metadata-variants-distribution-channels)
|
||||||
|
of metadata files to understand their purpose. These can be combined.
|
||||||
|
|
||||||
GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
|
For example, if you want access to both prerelease and cross bindists, you'd do:
|
||||||
|
|
||||||
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"
|
|
||||||
```
|
|
||||||
|
|
||||||
See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
|
|
||||||
for more options.
|
|
||||||
|
|
||||||
Alternatively you can do it via a cli switch:
|
|
||||||
|
|
||||||
```sh
|
|
||||||
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)
|
|
||||||
|
|
||||||
### (Pre-)Release channels
|
|
||||||
|
|
||||||
A release channel is basically just a metadata file location. You can add additional release
|
|
||||||
channels that complement the default one, such as the **prerelease channel** like so:
|
|
||||||
|
|
||||||
```sh
|
```sh
|
||||||
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
||||||
|
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
|
||||||
```
|
```
|
||||||
|
|
||||||
This will result in `~/.ghcup/config.yaml` to contain this record:
|
This results in the following configuration in `~/.ghcup/config.yaml`:
|
||||||
|
|
||||||
```yml
|
```yaml
|
||||||
url-source:
|
url-source:
|
||||||
AddSource:
|
# the base url that contains all the release bindists
|
||||||
- Right: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
|
- GHCupURL
|
||||||
|
# prereleases
|
||||||
|
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml
|
||||||
|
# cross bindists
|
||||||
|
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
|
||||||
```
|
```
|
||||||
|
|
||||||
You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
|
You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
|
||||||
@@ -188,18 +173,68 @@ To remove the channel, delete the entire `url-source` section or set it back to
|
|||||||
|
|
||||||
```yml
|
```yml
|
||||||
url-source:
|
url-source:
|
||||||
GHCupURL: []
|
- GHCupURL
|
||||||
```
|
```
|
||||||
|
|
||||||
If you want to combine your release channel with a mirror, you'd do it like so:
|
Also see [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
|
||||||
|
for more options.
|
||||||
|
|
||||||
|
You can also use an alternative metadata via one-shot cli option:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
ghcup --url-source=https://some-url/ghcup-0.0.8.yaml tui
|
||||||
|
```
|
||||||
|
|
||||||
|
One main caveat of using URLs is that you might need to check whether there are new versions
|
||||||
|
of the file (e.g. `ghcup-0.0.7.yaml` vs `ghcup-0.0.8.yaml`). Although old metadata files
|
||||||
|
are supported for some time, they are not so indefinitely.
|
||||||
|
|
||||||
|
### Mirrors
|
||||||
|
|
||||||
|
Metadata files can also be used to operate 3rd party mirrors, in which case you want to use
|
||||||
|
a URL instead of the `GHCupURL` alias. E.g. in `~/.ghcup/config.yaml`, you'd do:
|
||||||
|
|
||||||
```yml
|
```yml
|
||||||
url-source:
|
url-source:
|
||||||
OwnSource:
|
- https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml
|
||||||
# base metadata
|
```
|
||||||
- "https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml"
|
|
||||||
# prerelease channel
|
Note that later versions of GHCup allow more sophisticated mirror support, see [here](./#mirrors-proper).
|
||||||
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
|
|
||||||
|
#### 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)
|
||||||
|
|
||||||
|
### Git based metadata config
|
||||||
|
|
||||||
|
If you don't like the way ghcup updates its metadata with caching and fetching via curl, you can also do as follows:
|
||||||
|
|
||||||
|
Clone the metadata git repo:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
mkdir -p /home/user/git/
|
||||||
|
cd /home/user/git/
|
||||||
|
git clone -b master https://github.com/haskell/ghcup-metadata.git
|
||||||
|
```
|
||||||
|
|
||||||
|
Then tell ghcup to use file locations in `~/.ghcup/config.yaml`, e.g.:
|
||||||
|
|
||||||
|
```yaml
|
||||||
|
url-source:
|
||||||
|
- file:///home/user/git/ghcup-metadata/ghcup-0.0.8.yaml
|
||||||
|
- file:///home/user/git/ghcup-metadata/ghcup-cross-0.0.8.yaml
|
||||||
|
- file:///home/user/git/ghcup-metadata/ghcup-prereleases-0.0.8.yaml
|
||||||
|
```
|
||||||
|
|
||||||
|
Now, if you invoke `ghcup tui`, it will open instantly without any download, since it just
|
||||||
|
reads the metadata from local disk.
|
||||||
|
|
||||||
|
You'll have to update the metadata manually though, like so:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
cd /home/user/git/
|
||||||
|
git pull --ff-only origin master
|
||||||
```
|
```
|
||||||
|
|
||||||
## Stack integration
|
## Stack integration
|
||||||
@@ -207,17 +242,7 @@ url-source:
|
|||||||
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
Stack manages GHC versions internally by default. In order to make it use ghcup installed
|
||||||
GHC versions there are two strategies.
|
GHC versions there are two strategies.
|
||||||
|
|
||||||
### Strategy 1: System GHC (works on all stack versions)
|
### Strategy 1: Stack hooks (new, recommended)
|
||||||
|
|
||||||
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)
|
|
||||||
|
|
||||||
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).
|
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 +264,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
|
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`.
|
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
|
### Windows
|
||||||
|
|
||||||
On windows, you may find the following config options useful too:
|
On windows, you may find the following config options useful too:
|
||||||
@@ -246,6 +326,39 @@ On windows, you may find the following config options useful too:
|
|||||||
|
|
||||||
Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
|
Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
|
||||||
|
|
||||||
|
## Mirrors (proper)
|
||||||
|
|
||||||
|
Mirrors are now supported via configuration, instead of specifying alternative metadata files.
|
||||||
|
|
||||||
|
As an example, this would be a complete mirror configuration in `~/.ghcup/config.yaml`:
|
||||||
|
|
||||||
|
```yaml
|
||||||
|
mirrors:
|
||||||
|
# yaml download location, would result in:
|
||||||
|
# https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.8.yaml
|
||||||
|
# -> https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml
|
||||||
|
"raw.githubusercontent.com":
|
||||||
|
authority:
|
||||||
|
host: "mirror.sjtu.edu.cn"
|
||||||
|
pathPrefix: "ghcup/yaml"
|
||||||
|
# for stack and some older HLS versions, would result in e.g.
|
||||||
|
# https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
|
||||||
|
# -> https://mirror.sjtu.edu.cn/ghcup/github/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
|
||||||
|
"github.com":
|
||||||
|
authority:
|
||||||
|
host: "mirror.sjtu.edu.cn"
|
||||||
|
pathPrefix: "ghcup/github"
|
||||||
|
# for all haskell.org hosted bindists, would result in e.g.
|
||||||
|
# https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
|
||||||
|
# -> https://mirror.sjtu.edu.cn/ghcup/haskell-downloads/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
|
||||||
|
"downloads.haskell.org":
|
||||||
|
authority:
|
||||||
|
host: "mirror.sjtu.edu.cn"
|
||||||
|
pathPrefix: "downloads.haskell.org"
|
||||||
|
```
|
||||||
|
|
||||||
|
The configuration depends on the host of the mirror and they have to provide the correct configuration.
|
||||||
|
|
||||||
# More on installation
|
# More on installation
|
||||||
|
|
||||||
## Customisation of the installation scripts
|
## Customisation of the installation scripts
|
||||||
@@ -382,9 +495,9 @@ ghcup compile hls --git-ref master --git-describe-version --ghc 8.10.7 --ghc 9.2
|
|||||||
|
|
||||||
This however will create a new HLS version in ghcup, e.g. `1.7.0.0-105-gdc682ba1`, for both 8.10.7 and 9.2.4. If you want to switch back to the official bindists, run `ghcup set hls 1.7.0.0`.
|
This however will create a new HLS version in ghcup, e.g. `1.7.0.0-105-gdc682ba1`, for both 8.10.7 and 9.2.4. If you want to switch back to the official bindists, run `ghcup set hls 1.7.0.0`.
|
||||||
|
|
||||||
### Cross support
|
## Cross support
|
||||||
|
|
||||||
ghcup can compile and install a cross GHC for any target. However, this
|
ghcup can compile a cross GHC for any target. However, this
|
||||||
requires that the build host has a complete cross toolchain and various
|
requires that the build host has a complete cross toolchain and various
|
||||||
libraries installed for the target platform.
|
libraries installed for the target platform.
|
||||||
|
|
||||||
@@ -393,6 +506,76 @@ For distributions with non-standard locations of cross toolchain and
|
|||||||
libraries, this may need some tweaking of `build.mk` or configure args.
|
libraries, this may need some tweaking of `build.mk` or configure args.
|
||||||
See `ghcup compile ghc --help` for further information.
|
See `ghcup compile ghc --help` for further information.
|
||||||
|
|
||||||
|
Since ghcup version 0.1.20.0, we provide cross bindists for GHC JS and WASM. These can be installed conveniently.
|
||||||
|
However, these are intended as a developer preview only. By using these GHC variants, you are implicitly signing up to participate in GHC development!
|
||||||
|
If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org.
|
||||||
|
|
||||||
|
First, add the cross release channel:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-cross-0.0.8.yaml
|
||||||
|
```
|
||||||
|
|
||||||
|
The next sections explain how to install each cross bindist.
|
||||||
|
|
||||||
|
### GHC JS cross bindists (experimental)
|
||||||
|
|
||||||
|
You need the required emscripten JS toolchain:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
git clone https://github.com/emscripten-core/emsdk.git
|
||||||
|
cd emsdk
|
||||||
|
./emsdk install latest
|
||||||
|
./emsdk activate latest
|
||||||
|
source ./emsdk_env.sh
|
||||||
|
```
|
||||||
|
|
||||||
|
Instructions are also here: [Download and install — Emscripten 3.1.43-git (dev) documentation](https://emscripten.org/docs/getting_started/downloads.html).
|
||||||
|
|
||||||
|
To install we need to invoke ghcup like so:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
emconfigure ghcup install ghc --set javascript-unknown-ghcjs-9.6.2
|
||||||
|
```
|
||||||
|
|
||||||
|
You'll now have the compiler `javascript-unknown-ghcjs-ghc`. To build a hello world, do e.g.:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
echo 'main = putStrLn "hello world"' > hello.hs
|
||||||
|
javascript-unknown-ghcjs-ghc -fforce-recomp hello.hs
|
||||||
|
./hello
|
||||||
|
```
|
||||||
|
|
||||||
|
You can follow the instructions [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/building#compiling-hello-world).
|
||||||
|
|
||||||
|
### GHC WASM cross bindists (experimental)
|
||||||
|
|
||||||
|
You need the required wasm toolchain:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta.git
|
||||||
|
cd ghc-wasm-meta/
|
||||||
|
export SKIP_GHC=yes
|
||||||
|
./setup.sh
|
||||||
|
source ~/.ghc-wasm/env
|
||||||
|
```
|
||||||
|
|
||||||
|
To install, we need to invoke ghcup like so also passing the `--host=<host>` flag (adjust as needed):
|
||||||
|
|
||||||
|
```sh
|
||||||
|
ghcup install ghc --set wasm32-wasi-9.6.3.20230927 -- --host=x86_64-linux --with-intree-gmp --with-system-libffi
|
||||||
|
```
|
||||||
|
|
||||||
|
Also check the documentation here: [Glasgow Haskell Compiler / ghc-wasm-meta](https://gitlab.haskell.org/ghc/ghc-wasm-meta).
|
||||||
|
|
||||||
|
You'll now have the compiler `wasm32-wasi-ghc`. To build a hello world, do e.g.:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
echo 'main = putStrLn "hello world"' > hello.hs
|
||||||
|
wasm32-wasi-ghc hello.hs -o hello.wasm
|
||||||
|
wasmtime ./hello.wasm
|
||||||
|
```
|
||||||
|
|
||||||
## Isolated installs
|
## Isolated installs
|
||||||
|
|
||||||
**Before using isolated installs, make sure to have at least GHCup version 0.1.17.8!**
|
**Before using isolated installs, make sure to have at least GHCup version 0.1.17.8!**
|
||||||
@@ -449,8 +632,48 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
|
|||||||
|
|
||||||
### github workflows
|
### github workflows
|
||||||
|
|
||||||
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
|
On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
|
||||||
GHCup itself is also 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
|
## GPG verification
|
||||||
|
|
||||||
@@ -460,8 +683,10 @@ this is cryptographically secure.
|
|||||||
First, obtain the gpg keys:
|
First, obtain the gpg keys:
|
||||||
|
|
||||||
```sh
|
```sh
|
||||||
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
|
||||||
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
|
||||||
|
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
|
||||||
```
|
```
|
||||||
|
|
||||||
Then verify the gpg key in one of these ways:
|
Then verify the gpg key in one of these ways:
|
||||||
|
|||||||
@@ -4,10 +4,6 @@ hide:
|
|||||||
- toc
|
- 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">
|
<section class="index-ghcup-hero">
|
||||||
<img alt="haskell logo" src="./haskell_logo.png" />
|
<img alt="haskell logo" src="./haskell_logo.png" />
|
||||||
<h1>GHCup</h1>
|
<h1>GHCup</h1>
|
||||||
@@ -35,7 +31,7 @@ hide:
|
|||||||
<span>
|
<span>
|
||||||
</span>
|
</span>
|
||||||
<div class="footer">
|
<div class="footer">
|
||||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
@@ -51,7 +47,7 @@ hide:
|
|||||||
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
|
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
|
||||||
</div>
|
</div>
|
||||||
<div class="footer">
|
<div class="footer">
|
||||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||||
</div>
|
</div>
|
||||||
</div>
|
</div>
|
||||||
</section>
|
</section>
|
||||||
@@ -84,9 +80,6 @@ hide:
|
|||||||
</span>
|
</span>
|
||||||
</p>
|
</p>
|
||||||
|
|
||||||
<script type="text/javascript" src="javascripts/ghcup.js"></script>
|
|
||||||
|
|
||||||
|
|
||||||
----
|
----
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
132
docs/install.md
132
docs/install.md
@@ -1,7 +1,7 @@
|
|||||||
# Installation
|
# Installation
|
||||||
|
|
||||||
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
|
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
|
||||||
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
|
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
|
||||||
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
|
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
|
||||||
|
|
||||||
## How to install
|
## How to install
|
||||||
@@ -24,7 +24,7 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
|
|||||||
|
|
||||||
There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
|
There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
|
||||||
|
|
||||||
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
|
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-installation) and GPG verify the binaries.
|
||||||
|
|
||||||
### Which versions get installed?
|
### Which versions get installed?
|
||||||
|
|
||||||
@@ -38,47 +38,85 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
|
|||||||
|
|
||||||
### Linux Debian
|
### Linux Debian
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
#### Version >= 11 && <= 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
|
### Linux Ubuntu
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
#### Version >= 20.04 && < 20.10
|
||||||
|
|
||||||
|
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
|
||||||
|
|
||||||
|
#### Version >= 20.10 && < 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
|
### Linux Fedora
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
||||||
|
|
||||||
### Linux Mageia
|
|
||||||
|
|
||||||
The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
|
|
||||||
|
|
||||||
### Linux CentOS
|
### Linux CentOS
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
||||||
|
|
||||||
|
#### Version >= 7 && < 8
|
||||||
|
|
||||||
|
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses xz perl`
|
||||||
|
|
||||||
|
|
||||||
### Linux Alpine
|
### Linux Alpine
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
|
The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
|
||||||
|
|
||||||
### Linux VoidLinux
|
|
||||||
|
|
||||||
The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
|
|
||||||
|
|
||||||
### Linux (generic)
|
### Linux (generic)
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
|
You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
|
||||||
|
|
||||||
### Darwin
|
### Darwin
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
|
On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
|
||||||
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
|
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
|
||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
|
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
|
||||||
|
|
||||||
|
|
||||||
### Windows
|
### Windows
|
||||||
|
|
||||||
|
#### Generic
|
||||||
|
|
||||||
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
|
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
|
||||||
|
|
||||||
## Next steps
|
## Next steps
|
||||||
@@ -102,10 +140,21 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
|
<tr><td>9.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.2</td><td>base-4.17.0.0</td></tr>
|
||||||
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
|
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
|
||||||
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
|
<tr><td>9.2.8</td><td>base-4.16.4.0</td></tr>
|
||||||
|
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
|
||||||
|
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
|
||||||
|
<tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
|
||||||
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
|
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
|
||||||
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
|
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
|
||||||
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
|
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
|
||||||
@@ -143,7 +192,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
|
<tr><td>3.10.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.2.0</td><td><span style="color:green">recommended</span></td></tr>
|
||||||
<tr><td>3.6.0.0</td><td></td></tr>
|
<tr><td>3.6.0.0</td><td></td></tr>
|
||||||
<tr><td>3.4.1.0</td><td></td></tr>
|
<tr><td>3.4.1.0</td><td></td></tr>
|
||||||
@@ -159,7 +210,16 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
<tr><td>2.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.7.0.0</td><td></td></tr>
|
||||||
<tr><td>1.6.1.0</td><td></td></tr>
|
<tr><td>1.6.1.0</td><td></td></tr>
|
||||||
<tr><td>1.6.0.0</td><td></td></tr>
|
<tr><td>1.6.0.0</td><td></td></tr>
|
||||||
@@ -177,7 +237,10 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
<table>
|
<table>
|
||||||
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
||||||
<tbody>
|
<tbody>
|
||||||
<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
<tr><td>2.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.5</td><td></td></tr>
|
||||||
<tr><td>2.7.3</td><td></td></tr>
|
<tr><td>2.7.3</td><td></td></tr>
|
||||||
<tr><td>2.7.1</td><td></td></tr>
|
<tr><td>2.7.1</td><td></td></tr>
|
||||||
@@ -190,9 +253,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
|
|||||||
|
|
||||||
This list may not be exhaustive and specifies support for bindists only.
|
This list may not be exhaustive and specifies support for bindists only.
|
||||||
|
|
||||||
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
|
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
|
||||||
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
|
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
|
||||||
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
|
| Windows 8.1 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||||
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||||
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||||
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||||
@@ -208,12 +271,11 @@ This list may not be exhaustive and specifies support for bindists only.
|
|||||||
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||||
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||||
|
|
||||||
### Windows 7
|
### Windows <8.1
|
||||||
|
|
||||||
May or may not work, several issues:
|
No longer supported for recent GHCs, according to manual testing of GHC 9.8.1 on Windows 7.
|
||||||
|
According to [msys2 documentation](https://www.msys2.org/docs/windows_support), the minimum Windows
|
||||||
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
|
version is now 8.1.
|
||||||
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
|
|
||||||
|
|
||||||
### WSL1
|
### WSL1
|
||||||
|
|
||||||
@@ -231,8 +293,9 @@ There are various issues with GHC itself.
|
|||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
|
|
||||||
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
|
Lacks some upstream bindists and may need compat libs (such as `misc/compat12x`).
|
||||||
HLS bindists are experimental.
|
HLS bindists are experimental.
|
||||||
|
Only latest FreeBSD is generally supported.
|
||||||
|
|
||||||
### Linux ARMv7/AARCH64
|
### Linux ARMv7/AARCH64
|
||||||
|
|
||||||
@@ -245,7 +308,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/)
|
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
|
||||||
and place it into your `PATH` anywhere.
|
and place it into your `PATH` anywhere.
|
||||||
|
|
||||||
If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
|
If you want to GPG verify the binaries, import the following keys first:
|
||||||
|
|
||||||
|
```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:
|
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
|
||||||
|
|
||||||
@@ -307,6 +377,24 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
|
|||||||
|
|
||||||
All set. You can run `cabal init` now in an empty directory to start a project.
|
All set. You can run `cabal init` now in an empty directory to start a project.
|
||||||
|
|
||||||
|
## Esoteric distros
|
||||||
|
|
||||||
|
### Void Linux
|
||||||
|
|
||||||
|
Since void linux can be installed with glibc and musl, it's hard to support correctly with ghcup.
|
||||||
|
One way to make ghcup work on **Void Linux musl** is to follow the [Overriding distro detection](../guide/#overriding-distro-detection)
|
||||||
|
section and tell it to consider Alpine bindists only. E.g.:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
||||||
|
source ~/.ghcup/env
|
||||||
|
ghcup config set platform-override '{ "arch": "A_64", "platform": { "contents": "Alpine", "tag": "Linux" }, "version": "3.17" }'
|
||||||
|
ghcup install cabal --set latest
|
||||||
|
ghcup install ghc --set latest
|
||||||
|
ghcup install stack --set latest
|
||||||
|
ghcup install hls --set latest
|
||||||
|
```
|
||||||
|
|
||||||
## Vim integration
|
## Vim integration
|
||||||
|
|
||||||
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
|
Before Width: | Height: | Size: 40 KiB After Width: | Height: | Size: 27 KiB |
File diff suppressed because it is too large
Load Diff
|
Before Width: | Height: | Size: 40 KiB After Width: | Height: | Size: 28 KiB |
@@ -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/" class="btn btn-primary" role="button">Discover Haskell packages</a>
|
||||||
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
|
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
|
||||||
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
|
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
|
||||||
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a>
|
<a href="https://play.haskell.org/" class="btn btn-primary" role="button">Online playground</a>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
## How to learn Haskell proper
|
## How to learn Haskell proper
|
||||||
|
|||||||
186
ghcup.cabal
186
ghcup.cabal
@@ -1,6 +1,6 @@
|
|||||||
cabal-version: 2.4
|
cabal-version: 2.4
|
||||||
name: ghcup
|
name: ghcup
|
||||||
version: 0.1.19.0
|
version: 0.1.20.0
|
||||||
license: LGPL-3.0-only
|
license: LGPL-3.0-only
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
copyright: Julian Ospald 2020
|
copyright: Julian Ospald 2020
|
||||||
@@ -25,10 +25,10 @@ extra-source-files:
|
|||||||
cbits/dirutils.h
|
cbits/dirutils.h
|
||||||
data/build_mk/cross
|
data/build_mk/cross
|
||||||
data/build_mk/default
|
data/build_mk/default
|
||||||
test/data/dir/.keep
|
test/ghcup-test/data/dir/.keep
|
||||||
test/data/file
|
test/ghcup-test/data/file
|
||||||
test/golden/unix/GHCupInfo.json
|
test/ghcup-test/golden/unix/GHCupInfo.json
|
||||||
test/golden/windows/GHCupInfo.json
|
test/ghcup-test/golden/windows/GHCupInfo.json
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
@@ -36,7 +36,7 @@ source-repository head
|
|||||||
|
|
||||||
flag tui
|
flag tui
|
||||||
description:
|
description:
|
||||||
Build the brick powered tui (ghcup tui). This is disabled on windows.
|
Build the brick powered tui (ghcup tui).
|
||||||
|
|
||||||
default: False
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
@@ -53,6 +53,43 @@ flag no-exe
|
|||||||
default: False
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
|
|
||||||
|
common app-common-depends
|
||||||
|
build-depends:
|
||||||
|
, aeson >=1.4
|
||||||
|
, aeson-pretty ^>=0.8.8
|
||||||
|
, async ^>=2.2.3
|
||||||
|
, base >=4.12 && <5
|
||||||
|
, bytestring >=0.10 && <0.12
|
||||||
|
, cabal-install-parsers >=0.4.5
|
||||||
|
, cabal-plan ^>=0.7.2
|
||||||
|
, containers ^>=0.6
|
||||||
|
, deepseq ^>=1.4
|
||||||
|
, directory ^>=1.3.6.0
|
||||||
|
, filepath ^>=1.4.2.1
|
||||||
|
, haskus-utils-types ^>=1.5
|
||||||
|
, haskus-utils-variant ^>=3.2.1
|
||||||
|
, libarchive ^>=3.0.3.0
|
||||||
|
, megaparsec >=8.0.0 && <9.3
|
||||||
|
, mtl ^>=2.2
|
||||||
|
, optparse-applicative >=0.15.1.0 && <0.18
|
||||||
|
, pretty ^>=1.1.3.1
|
||||||
|
, pretty-terminal ^>=0.1.0.0
|
||||||
|
, process ^>=1.6.11.0
|
||||||
|
, resourcet ^>=1.2.2
|
||||||
|
, safe ^>=0.3.18
|
||||||
|
, safe-exceptions ^>=0.1
|
||||||
|
, tagsoup ^>=0.14
|
||||||
|
, template-haskell >=2.7 && <2.20
|
||||||
|
, temporary ^>=1.3
|
||||||
|
, text ^>=2.0
|
||||||
|
, time >=1.9.3 && <1.12
|
||||||
|
, unordered-containers ^>=0.2
|
||||||
|
, uri-bytestring ^>=0.3.2.2
|
||||||
|
, utf8-string ^>=1.0
|
||||||
|
, vector >=0.12 && <0.14
|
||||||
|
, versions >=6.0.3 && <6.1
|
||||||
|
, yaml-streamly ^>=0.12.0
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
GHCup
|
GHCup
|
||||||
@@ -80,7 +117,9 @@ library
|
|||||||
GHCup.Types
|
GHCup.Types
|
||||||
GHCup.Types.JSON
|
GHCup.Types.JSON
|
||||||
GHCup.Types.JSON.Utils
|
GHCup.Types.JSON.Utils
|
||||||
|
GHCup.Types.JSON.Versions
|
||||||
GHCup.Types.Optics
|
GHCup.Types.Optics
|
||||||
|
GHCup.Types.Stack
|
||||||
GHCup.Utils
|
GHCup.Utils
|
||||||
GHCup.Utils.Dirs
|
GHCup.Utils.Dirs
|
||||||
GHCup.Version
|
GHCup.Version
|
||||||
@@ -137,7 +176,7 @@ library
|
|||||||
, pretty-terminal ^>=0.1.0.0
|
, pretty-terminal ^>=0.1.0.0
|
||||||
, regex-posix ^>=0.96
|
, regex-posix ^>=0.96
|
||||||
, resourcet ^>=1.2.2
|
, resourcet ^>=1.2.2
|
||||||
, retry ^>=0.8.1.2
|
, retry >=0.8.1.2 && <0.10
|
||||||
, safe ^>=0.3.18
|
, safe ^>=0.3.18
|
||||||
, safe-exceptions ^>=0.1
|
, safe-exceptions ^>=0.1
|
||||||
, split ^>=0.2.3.4
|
, split ^>=0.2.3.4
|
||||||
@@ -146,13 +185,13 @@ library
|
|||||||
, template-haskell >=2.7 && <2.20
|
, template-haskell >=2.7 && <2.20
|
||||||
, temporary ^>=1.3
|
, temporary ^>=1.3
|
||||||
, text ^>=2.0
|
, text ^>=2.0
|
||||||
, time ^>=1.9.3
|
, time >=1.9.3 && <1.12
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, unliftio-core ^>=0.2.0.1
|
, unliftio-core ^>=0.2.0.1
|
||||||
, unordered-containers ^>=0.2.10.0
|
, unordered-containers ^>=0.2.10.0
|
||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, vector ^>=0.12
|
, vector >=0.12 && <0.14
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=6.0.3 && <6.1
|
||||||
, word8 ^>=0.1.3
|
, word8 ^>=0.1.3
|
||||||
, yaml-streamly ^>=0.12.0
|
, yaml-streamly ^>=0.12.0
|
||||||
, zlib ^>=0.6.2.2
|
, zlib ^>=0.6.2.2
|
||||||
@@ -197,13 +236,13 @@ library
|
|||||||
, unix ^>=2.7
|
, unix ^>=2.7
|
||||||
, unix-bytestring ^>=0.3.7.3
|
, unix-bytestring ^>=0.3.7.3
|
||||||
|
|
||||||
if (flag(tui) && !os(windows))
|
if flag(tui)
|
||||||
cpp-options: -DBRICK
|
cpp-options: -DBRICK
|
||||||
build-depends: vty ^>=5.37
|
build-depends: vty ^>=6.0
|
||||||
|
|
||||||
executable ghcup
|
library ghcup-optparse
|
||||||
main-is: Main.hs
|
import: app-common-depends
|
||||||
other-modules:
|
exposed-modules:
|
||||||
GHCup.OptParse
|
GHCup.OptParse
|
||||||
GHCup.OptParse.ChangeLog
|
GHCup.OptParse.ChangeLog
|
||||||
GHCup.OptParse.Common
|
GHCup.OptParse.Common
|
||||||
@@ -224,6 +263,40 @@ executable ghcup
|
|||||||
GHCup.OptParse.Upgrade
|
GHCup.OptParse.Upgrade
|
||||||
GHCup.OptParse.Whereis
|
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
|
hs-source-dirs: app/ghcup
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions:
|
default-extensions:
|
||||||
@@ -241,52 +314,21 @@ executable ghcup
|
|||||||
-fwarn-incomplete-record-updates -threaded
|
-fwarn-incomplete-record-updates -threaded
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
, aeson >=1.4
|
|
||||||
, aeson-pretty ^>=0.8.8
|
|
||||||
, async ^>=2.2.3
|
|
||||||
, base >=4.12 && <5
|
|
||||||
, bytestring >=0.10 && <0.12
|
|
||||||
, cabal-install-parsers >=0.4.5
|
|
||||||
, cabal-plan ^>=0.7.2
|
|
||||||
, containers ^>=0.6
|
|
||||||
, deepseq ^>=1.4
|
|
||||||
, directory ^>=1.3.6.0
|
|
||||||
, filepath ^>=1.4.2.1
|
|
||||||
, ghcup
|
, ghcup
|
||||||
, haskus-utils-types ^>=1.5
|
, ghcup-optparse
|
||||||
, haskus-utils-variant ^>=3.2.1
|
|
||||||
, libarchive ^>=3.0.3.0
|
|
||||||
, megaparsec >=8.0.0 && <9.3
|
|
||||||
, mtl ^>=2.2
|
|
||||||
, optparse-applicative >=0.15.1.0 && <0.18
|
|
||||||
, pretty ^>=1.1.3.1
|
|
||||||
, pretty-terminal ^>=0.1.0.0
|
|
||||||
, process ^>=1.6.11.0
|
|
||||||
, resourcet ^>=1.2.2
|
|
||||||
, safe ^>=0.3.18
|
|
||||||
, safe-exceptions ^>=0.1
|
|
||||||
, tagsoup ^>=0.14
|
|
||||||
, template-haskell >=2.7 && <2.20
|
|
||||||
, temporary ^>=1.3
|
|
||||||
, text ^>=2.0
|
|
||||||
, unordered-containers ^>=0.2
|
|
||||||
, uri-bytestring ^>=0.3.2.2
|
|
||||||
, utf8-string ^>=1.0
|
|
||||||
, vector ^>=0.12
|
|
||||||
, versions >=4.0.1 && <5.1
|
|
||||||
, yaml-streamly ^>=0.12.0
|
|
||||||
|
|
||||||
if flag(internal-downloader)
|
if flag(internal-downloader)
|
||||||
cpp-options: -DINTERNAL_DOWNLOADER
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
|
|
||||||
if (flag(tui) && !os(windows))
|
if flag(tui)
|
||||||
cpp-options: -DBRICK
|
cpp-options: -DBRICK
|
||||||
other-modules: BrickMain
|
other-modules: BrickMain
|
||||||
build-depends:
|
build-depends:
|
||||||
, brick ^>=1.5
|
, brick ^>=2.1
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
|
, vty ^>=6.0
|
||||||
, unix ^>=2.7
|
, unix ^>=2.7
|
||||||
, vty ^>=5.37
|
, optics ^>=0.4
|
||||||
|
|
||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
@@ -301,7 +343,7 @@ test-suite ghcup-test
|
|||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
build-tool-depends: hspec-discover:hspec-discover -any
|
build-tool-depends: hspec-discover:hspec-discover -any
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test/ghcup-test
|
||||||
other-modules:
|
other-modules:
|
||||||
GHCup.ArbitraryTypes
|
GHCup.ArbitraryTypes
|
||||||
GHCup.Prelude.File.Posix.TraversalsSpec
|
GHCup.Prelude.File.Posix.TraversalsSpec
|
||||||
@@ -336,11 +378,49 @@ test-suite ghcup-test
|
|||||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||||
, streamly ^>=0.8.2
|
, streamly ^>=0.8.2
|
||||||
, text ^>=2.0
|
, text ^>=2.0
|
||||||
|
, time >=1.9.3 && <1.12
|
||||||
, uri-bytestring ^>=0.3.2.2
|
, uri-bytestring ^>=0.3.2.2
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=6.0.3 && <6.1
|
||||||
|
|
||||||
if os(windows)
|
if os(windows)
|
||||||
cpp-options: -DIS_WINDOWS
|
cpp-options: -DIS_WINDOWS
|
||||||
|
|
||||||
else
|
else
|
||||||
build-depends: unix ^>=2.7
|
build-depends: unix ^>=2.7
|
||||||
|
|
||||||
|
test-suite ghcup-optparse-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
hs-source-dirs: test/optparse-test
|
||||||
|
main-is: Main.hs
|
||||||
|
other-modules:
|
||||||
|
ChangeLogTest
|
||||||
|
CompileTest
|
||||||
|
ConfigTest
|
||||||
|
GCTest
|
||||||
|
InstallTest
|
||||||
|
ListTest
|
||||||
|
OtherCommandTest
|
||||||
|
RmTest
|
||||||
|
RunTest
|
||||||
|
SetTest
|
||||||
|
UnsetTest
|
||||||
|
UpgradeTest
|
||||||
|
Utils
|
||||||
|
WhereisTest
|
||||||
|
|
||||||
|
if os(windows)
|
||||||
|
cpp-options: -DIS_WINDOWS
|
||||||
|
|
||||||
|
default-language: Haskell2010
|
||||||
|
ghc-options: -Wall
|
||||||
|
build-depends:
|
||||||
|
, base
|
||||||
|
, ghcup
|
||||||
|
, ghcup-optparse
|
||||||
|
, optparse-applicative
|
||||||
|
, tasty
|
||||||
|
, tasty-hunit
|
||||||
|
, template-haskell
|
||||||
|
, text
|
||||||
|
, uri-bytestring
|
||||||
|
, versions
|
||||||
|
|||||||
4
hie.yaml
4
hie.yaml
@@ -5,4 +5,6 @@ cradle:
|
|||||||
- component: "ghcup:exe:ghcup"
|
- component: "ghcup:exe:ghcup"
|
||||||
path: ./app/ghcup
|
path: ./app/ghcup
|
||||||
- component: "ghcup:test:ghcup-test"
|
- component: "ghcup:test:ghcup-test"
|
||||||
path: ./test
|
path: ./test/ghcup-test
|
||||||
|
- component: "ghcup:test:ghcup-optparse-test"
|
||||||
|
path: ./test/optparse-test
|
||||||
@@ -57,16 +57,13 @@ import GHCup.Types
|
|||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Bifunctor
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Options.Applicative.Help.Pretty ( text )
|
import Options.Applicative.Help.Pretty ( text )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import URI.ByteString
|
|
||||||
|
|
||||||
import qualified Data.ByteString.UTF8 as UTF8
|
|
||||||
|
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
@@ -77,12 +74,13 @@ data Options = Options
|
|||||||
, optMetaCache :: Maybe Integer
|
, optMetaCache :: Maybe Integer
|
||||||
, optMetaMode :: Maybe MetaMode
|
, optMetaMode :: Maybe MetaMode
|
||||||
, optPlatform :: Maybe PlatformRequest
|
, optPlatform :: Maybe PlatformRequest
|
||||||
, optUrlSource :: Maybe URI
|
, optUrlSource :: Maybe URLSource
|
||||||
, optNoVerify :: Maybe Bool
|
, optNoVerify :: Maybe Bool
|
||||||
, optKeepDirs :: Maybe KeepDirs
|
, optKeepDirs :: Maybe KeepDirs
|
||||||
, optsDownloader :: Maybe Downloader
|
, optsDownloader :: Maybe Downloader
|
||||||
, optNoNetwork :: Maybe Bool
|
, optNoNetwork :: Maybe Bool
|
||||||
, optGpg :: Maybe GPGSetting
|
, optGpg :: Maybe GPGSetting
|
||||||
|
, optStackSetup :: Maybe Bool
|
||||||
-- commands
|
-- commands
|
||||||
, optCommand :: Command
|
, optCommand :: Command
|
||||||
}
|
}
|
||||||
@@ -134,13 +132,13 @@ opts =
|
|||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader parseUri)
|
(eitherReader parseUrlSource)
|
||||||
( short 's'
|
( short 's'
|
||||||
<> long "url-source"
|
<> long "url-source"
|
||||||
<> metavar "URL"
|
<> metavar "URL_SOURCE"
|
||||||
<> help "Alternative ghcup download info url"
|
<> help "Alternative ghcup download info"
|
||||||
<> internal
|
<> internal
|
||||||
<> completer fileUri
|
<> completer urlSourceCompleter
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
|
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
|
||||||
@@ -178,10 +176,9 @@ opts =
|
|||||||
"GPG verification (default: none)"
|
"GPG verification (default: none)"
|
||||||
<> completer (listCompleter ["strict", "lax", "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
|
<*> com
|
||||||
where
|
|
||||||
parseUri s' =
|
|
||||||
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
|
|
||||||
|
|
||||||
|
|
||||||
com :: Parser Command
|
com :: Parser Command
|
||||||
@@ -244,7 +241,8 @@ com =
|
|||||||
<> command
|
<> command
|
||||||
"list"
|
"list"
|
||||||
(info (List <$> listOpts <**> helper)
|
(info (List <$> listOpts <**> helper)
|
||||||
(progDesc "Show available GHCs and other tools")
|
(progDesc "Show available GHCs and other tools"
|
||||||
|
<> footerDoc (Just $ text listToolFooter))
|
||||||
)
|
)
|
||||||
<> command
|
<> command
|
||||||
"upgrade"
|
"upgrade"
|
||||||
@@ -29,13 +29,13 @@ import Data.Maybe
|
|||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
import System.Process ( system )
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Control.Exception.Safe (MonadMask)
|
import Control.Exception.Safe (MonadMask)
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import Data.Versions
|
|
||||||
import URI.ByteString (serializeURIRef')
|
import URI.ByteString (serializeURIRef')
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
|
|
||||||
@@ -50,7 +50,7 @@ data ChangeLogOptions = ChangeLogOptions
|
|||||||
{ clOpen :: Bool
|
{ clOpen :: Bool
|
||||||
, clTool :: Maybe Tool
|
, clTool :: Maybe Tool
|
||||||
, clToolVer :: Maybe ToolVersion
|
, clToolVer :: Maybe ToolVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -76,12 +76,12 @@ changelogP =
|
|||||||
e -> Left e
|
e -> Left e
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
|
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup|stack>" <> help
|
||||||
"Open changelog for given tool (default: ghc)"
|
"Open changelog for given tool (default: ghc)"
|
||||||
<> completer toolCompleter
|
<> completer toolCompleter
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional (toolVersionTagArgument Nothing Nothing)
|
<*> optional (toolVersionTagArgument [] Nothing)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -115,40 +115,36 @@ changelog :: ( Monad m
|
|||||||
changelog ChangeLogOptions{..} runAppState runLogger = do
|
changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||||
let tool = fromMaybe GHC clTool
|
let tool = fromMaybe GHC clTool
|
||||||
ver' = maybe
|
ver' = fromMaybe
|
||||||
(Right Latest)
|
(ToolTag Latest)
|
||||||
(\case
|
|
||||||
GHCVersion tv -> Left (_tvVersion tv)
|
|
||||||
ToolVersion tv -> Left tv
|
|
||||||
ToolTag t -> Right t
|
|
||||||
)
|
|
||||||
clToolVer
|
clToolVer
|
||||||
muri = getChangeLog dls tool ver'
|
muri = getChangeLog dls tool ver'
|
||||||
case muri of
|
case muri of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
runLogger
|
runLogger
|
||||||
(logWarn $
|
(logWarn $
|
||||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
|
||||||
)
|
)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
pfreq <- runAppState getPlatformReq
|
pfreq <- runAppState getPlatformReq
|
||||||
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
|
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
|
||||||
cmd = case _rPlatform pfreq of
|
|
||||||
Darwin -> "open"
|
|
||||||
Linux _ -> "xdg-open"
|
|
||||||
FreeBSD -> "xdg-open"
|
|
||||||
Windows -> "start"
|
|
||||||
|
|
||||||
if clOpen
|
if clOpen
|
||||||
then do
|
then do
|
||||||
runAppState $
|
runAppState $
|
||||||
exec cmd
|
case _rPlatform pfreq of
|
||||||
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
|
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||||
Nothing
|
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||||
Nothing
|
FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||||
|
Windows -> do
|
||||||
|
let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
|
||||||
|
c <- liftIO $ system $ args
|
||||||
|
case c of
|
||||||
|
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
|
||||||
|
ExitSuccess -> pure $ Right ()
|
||||||
>>= \case
|
>>= \case
|
||||||
Right _ -> pure ExitSuccess
|
Right _ -> pure ExitSuccess
|
||||||
Left e -> logError (T.pack $ prettyHFError e)
|
Left e -> logError (T.pack $ prettyHFError e)
|
||||||
>> pure (ExitFailure 13)
|
>> pure (ExitFailure 13)
|
||||||
else liftIO $ putStrLn uri' >> pure ExitSuccess
|
else liftIO $ putStrLn uri' >> pure ExitSuccess
|
||||||
|
|
||||||
@@ -5,6 +5,7 @@
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE NumericUnderscores #-}
|
{-# LANGUAGE NumericUnderscores #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
module GHCup.OptParse.Common where
|
module GHCup.OptParse.Common where
|
||||||
|
|
||||||
@@ -45,7 +46,9 @@ import Data.Functor
|
|||||||
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions hiding ( str )
|
import Data.Time.Calendar ( Day )
|
||||||
|
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
|
||||||
|
import Data.Versions
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
@@ -61,6 +64,8 @@ import URI.ByteString
|
|||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
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 Text.Megaparsec as MP
|
||||||
import qualified System.FilePath.Posix as FP
|
import qualified System.FilePath.Posix as FP
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
@@ -72,26 +77,27 @@ import qualified Cabal.Config as CC
|
|||||||
--[ Types ]--
|
--[ Types ]--
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
data ToolVersion = GHCVersion GHCTargetVersion
|
|
||||||
| ToolVersion Version
|
|
||||||
| ToolTag Tag
|
|
||||||
|
|
||||||
-- a superset of ToolVersion
|
-- a superset of ToolVersion
|
||||||
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||||
| SetToolVersion Version
|
| SetToolVersion Version
|
||||||
| SetToolTag Tag
|
| SetToolTag Tag
|
||||||
|
| SetToolDay Day
|
||||||
| SetRecommended
|
| SetRecommended
|
||||||
| SetNext
|
| SetNext
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
prettyToolVer :: ToolVersion -> String
|
prettyToolVer :: ToolVersion -> String
|
||||||
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
|
||||||
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
|
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
|
||||||
prettyToolVer (ToolTag t) = show t
|
prettyToolVer (ToolTag t) = show t
|
||||||
|
prettyToolVer (ToolDay day) = show day
|
||||||
|
|
||||||
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
||||||
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
|
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
|
||||||
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
||||||
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
||||||
|
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
|
||||||
toSetToolVer Nothing = SetRecommended
|
toSetToolVer Nothing = SetRecommended
|
||||||
|
|
||||||
|
|
||||||
@@ -102,28 +108,28 @@ toSetToolVer Nothing = SetRecommended
|
|||||||
--------------
|
--------------
|
||||||
|
|
||||||
|
|
||||||
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
|
||||||
toolVersionTagArgument criteria tool =
|
toolVersionTagArgument criteria tool =
|
||||||
argument (eitherReader (parser tool))
|
argument (eitherReader (parser tool))
|
||||||
(metavar (mv tool)
|
(metavar (mv tool)
|
||||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||||
<> foldMap (completer . versionCompleter criteria) tool)
|
<> foldMap (completer . versionCompleter criteria) tool)
|
||||||
where
|
where
|
||||||
mv (Just GHC) = "GHC_VERSION|TAG"
|
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
|
||||||
mv (Just HLS) = "HLS_VERSION|TAG"
|
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
|
||||||
mv _ = "VERSION|TAG"
|
mv _ = "VERSION|TAG|RELEASE_DATE"
|
||||||
|
|
||||||
parser (Just GHC) = ghcVersionTagEither
|
parser (Just GHC) = ghcVersionTagEither
|
||||||
parser Nothing = ghcVersionTagEither
|
parser Nothing = ghcVersionTagEither
|
||||||
parser _ = toolVersionTagEither
|
parser _ = toolVersionTagEither
|
||||||
|
|
||||||
|
|
||||||
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
|
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
|
||||||
versionParser' criteria tool = argument
|
versionParser' criteria tool = argument
|
||||||
(eitherReader (first show . version . T.pack))
|
(eitherReader (first show . version . T.pack))
|
||||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
|
||||||
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
|
||||||
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
|
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
|
||||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||||
|
|
||||||
@@ -205,19 +211,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
|||||||
)
|
)
|
||||||
]
|
]
|
||||||
distroP :: MP.Parsec Void Text LinuxDistro
|
distroP :: MP.Parsec Void Text LinuxDistro
|
||||||
distroP = choice'
|
distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
|
||||||
[ 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
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
uriParser :: String -> Either String URI
|
uriParser :: String -> Either String URI
|
||||||
@@ -237,21 +231,23 @@ isolateParser f = case isValid f && isAbsolute f of
|
|||||||
-- this accepts cross prefix
|
-- this accepts cross prefix
|
||||||
ghcVersionTagEither :: String -> Either String ToolVersion
|
ghcVersionTagEither :: String -> Either String ToolVersion
|
||||||
ghcVersionTagEither s' =
|
ghcVersionTagEither s' =
|
||||||
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
|
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
|
||||||
|
|
||||||
-- this ignores cross prefix
|
-- this ignores cross prefix
|
||||||
toolVersionTagEither :: String -> Either String ToolVersion
|
toolVersionTagEither :: String -> Either String ToolVersion
|
||||||
toolVersionTagEither s' =
|
toolVersionTagEither s' =
|
||||||
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
|
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
|
||||||
|
|
||||||
tagEither :: String -> Either String Tag
|
tagEither :: String -> Either String Tag
|
||||||
tagEither s' = case fmap toLower s' of
|
tagEither s' = case fmap toLower s' of
|
||||||
"recommended" -> Right Recommended
|
"recommended" -> Right Recommended
|
||||||
"latest" -> Right Latest
|
"latest" -> Right Latest
|
||||||
|
"latest-prerelease" -> Right LatestPrerelease
|
||||||
|
"latest-nightly" -> Right LatestNightly
|
||||||
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
||||||
Right x -> Right (Base x)
|
Right x -> Right (Base x)
|
||||||
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
||||||
other -> Left $ "Unknown tag " <> other
|
other -> Left $ "Unknown tag " <> other
|
||||||
|
|
||||||
|
|
||||||
ghcVersionEither :: String -> Either String GHCTargetVersion
|
ghcVersionEither :: String -> Either String GHCTargetVersion
|
||||||
@@ -260,7 +256,7 @@ ghcVersionEither =
|
|||||||
|
|
||||||
toolVersionEither :: String -> Either String Version
|
toolVersionEither :: String -> Either String Version
|
||||||
toolVersionEither =
|
toolVersionEither =
|
||||||
first (const "Not a valid version") . MP.parse version' "" . T.pack
|
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
|
||||||
|
|
||||||
|
|
||||||
toolParser :: String -> Either String Tool
|
toolParser :: String -> Either String Tool
|
||||||
@@ -271,12 +267,22 @@ toolParser s' | t == T.pack "ghc" = Right GHC
|
|||||||
| otherwise = Left ("Unknown tool: " <> s')
|
| otherwise = Left ("Unknown tool: " <> s')
|
||||||
where t = T.toLower (T.pack s')
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
dayParser :: String -> Either String Day
|
||||||
|
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
|
||||||
|
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
|
||||||
|
|
||||||
|
|
||||||
criteriaParser :: String -> Either String ListCriteria
|
criteriaParser :: String -> Either String ListCriteria
|
||||||
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
|
||||||
| t == T.pack "set" = Right ListSet
|
| t == T.pack "set" = Right $ ListSet True
|
||||||
| t == T.pack "available" = Right ListAvailable
|
| t == T.pack "available" = Right $ ListAvailable True
|
||||||
| otherwise = Left ("Unknown criteria: " <> s')
|
| t == T.pack "+installed" = Right $ ListInstalled True
|
||||||
|
| t == T.pack "+set" = Right $ ListSet True
|
||||||
|
| t == T.pack "+available" = Right $ ListAvailable True
|
||||||
|
| t == T.pack "-installed" = Right $ ListInstalled False
|
||||||
|
| t == T.pack "-set" = Right $ ListSet False
|
||||||
|
| t == T.pack "-available" = Right $ ListAvailable False
|
||||||
|
| otherwise = Left ("Unknown criteria: " <> s')
|
||||||
where t = T.toLower (T.pack s')
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
|
||||||
@@ -318,6 +324,15 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
|
|||||||
gitFileUri :: [String] -> Completer
|
gitFileUri :: [String] -> Completer
|
||||||
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
|
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 :: Completer
|
||||||
fileUri = mkCompleter $ fileUri' []
|
fileUri = mkCompleter $ fileUri' []
|
||||||
|
|
||||||
@@ -351,7 +366,7 @@ fileUri' add = \case
|
|||||||
-- We need to do this so bash doesn't expand out any ~ or other
|
-- 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
|
-- chars we want to complete on, or emit an end of line error
|
||||||
-- when seeking the close to the quote.
|
-- 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
|
-- 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 :: String -> String
|
||||||
requote s =
|
requote s =
|
||||||
@@ -446,18 +461,20 @@ tagCompleter tool add = listIOCompleter $ do
|
|||||||
defaultKeyBindings
|
defaultKeyBindings
|
||||||
loggerConfig
|
loggerConfig
|
||||||
|
|
||||||
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
|
mpFreq <- flip runReaderT appState . runE $ platformRequest
|
||||||
case mGhcUpInfo of
|
forFold mpFreq $ \pfreq -> do
|
||||||
VRight ghcupInfo -> do
|
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq
|
||||||
let allTags = filter (/= Old)
|
case mGhcUpInfo of
|
||||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
VRight ghcupInfo -> do
|
||||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
let allTags = filter (/= Old)
|
||||||
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
|
$ _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 criteria tool = versionCompleter' criteria tool (const True)
|
||||||
|
|
||||||
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
|
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
|
||||||
versionCompleter' criteria tool filter' = listIOCompleter $ do
|
versionCompleter' criteria tool filter' = listIOCompleter $ do
|
||||||
dirs' <- liftIO getAllDirs
|
dirs' <- liftIO getAllDirs
|
||||||
let loggerConfig = LoggerConfig
|
let loggerConfig = LoggerConfig
|
||||||
@@ -473,8 +490,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
|
|||||||
defaultKeyBindings
|
defaultKeyBindings
|
||||||
loggerConfig
|
loggerConfig
|
||||||
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
|
||||||
forFold mpFreq $ \pfreq -> do
|
forFold mpFreq $ \pfreq -> do
|
||||||
|
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
|
||||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||||
let appState = AppState
|
let appState = AppState
|
||||||
settings
|
settings
|
||||||
@@ -486,7 +503,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
|
|||||||
|
|
||||||
runEnv = flip runReaderT appState
|
runEnv = flip runReaderT appState
|
||||||
|
|
||||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
|
||||||
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
|
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
|
||||||
|
|
||||||
|
|
||||||
@@ -654,6 +671,7 @@ fromVersion :: ( HasLog env
|
|||||||
-> Tool
|
-> Tool
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||||
@@ -672,46 +690,58 @@ fromVersion' :: ( HasLog env
|
|||||||
-> Tool
|
-> Tool
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||||
fromVersion' SetRecommended tool = do
|
fromVersion' SetRecommended tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getRecommended dls tool
|
second Just <$> getRecommended dls tool
|
||||||
?? TagNotFound Recommended tool
|
?? TagNotFound Recommended tool
|
||||||
fromVersion' (SetGHCVersion v) tool = do
|
fromVersion' (SetGHCVersion v) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
let vi = getVersionInfo v tool dls
|
||||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||||
Left _ -> pure (v, vi)
|
Left _ -> pure (v, vi)
|
||||||
Right pvpIn ->
|
Right pvpIn ->
|
||||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
|
||||||
Just (pvp_, vi') -> do
|
Just (pvp_, vi', mt) -> do
|
||||||
v' <- lift $ pvpToVersion pvp_ ""
|
v' <- lift $ pvpToVersion pvp_ ""
|
||||||
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||||
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
pure (GHCTargetVersion mt v', Just vi')
|
||||||
Nothing -> pure (v, vi)
|
Nothing -> pure (v, vi)
|
||||||
fromVersion' (SetToolVersion v) tool = do
|
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo v tool dls
|
let vi = getVersionInfo v tool dls
|
||||||
case pvp $ prettyVer v of -- need to be strict here
|
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||||
Left _ -> pure (mkTVer v, vi)
|
Left _ -> pure (v, vi)
|
||||||
Right pvpIn ->
|
Right pvpIn ->
|
||||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
|
||||||
Just (pvp_, vi') -> do
|
Just (pvp_, vi', mt) -> do
|
||||||
v' <- lift $ pvpToVersion pvp_ ""
|
v' <- lift $ pvpToVersion pvp_ ""
|
||||||
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||||
pure (GHCTargetVersion mempty v', Just vi')
|
pure (GHCTargetVersion mt v', Just vi')
|
||||||
Nothing -> pure (mkTVer v, vi)
|
Nothing -> pure (v, vi)
|
||||||
fromVersion' (SetToolTag Latest) tool = do
|
fromVersion' (SetToolTag Latest) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||||
|
fromVersion' (SetToolDay day) tool = do
|
||||||
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
bimap id Just <$> case getByReleaseDay dls tool day of
|
||||||
|
Left ad -> throwE $ DayNotFound day tool ad
|
||||||
|
Right v -> pure v
|
||||||
|
fromVersion' (SetToolTag LatestPrerelease) tool = do
|
||||||
|
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
|
fromVersion' (SetToolTag Recommended) tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
||||||
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
||||||
fromVersion' SetNext tool = do
|
fromVersion' SetNext tool = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
next <- case tool of
|
next <- case tool of
|
||||||
@@ -756,7 +786,7 @@ fromVersion' SetNext tool = do
|
|||||||
. sort
|
. sort
|
||||||
$ stacks) ?? NoToolVersionSet tool
|
$ stacks) ?? NoToolVersionSet tool
|
||||||
GHCup -> fail "GHCup cannot be set"
|
GHCup -> fail "GHCup cannot be set"
|
||||||
let vi = getVersionInfo (_tvVersion next) tool dls
|
let vi = getVersionInfo next tool dls
|
||||||
pure (next, vi)
|
pure (next, vi)
|
||||||
fromVersion' (SetToolTag t') tool =
|
fromVersion' (SetToolTag t') tool =
|
||||||
throwE $ TagNotFound t' tool
|
throwE $ TagNotFound t' tool
|
||||||
@@ -772,15 +802,15 @@ checkForUpdates :: ( MonadReader env m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> m [(Tool, Version)]
|
=> m [(Tool, GHCTargetVersion)]
|
||||||
checkForUpdates = do
|
checkForUpdates = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||||
lInstalled <- listVersions Nothing (Just ListInstalled)
|
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
|
||||||
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||||
|
|
||||||
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
|
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
|
||||||
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||||
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
|
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
|
||||||
|
|
||||||
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
||||||
forMM (getLatest dls t) $ \(l, _) -> do
|
forMM (getLatest dls t) $ \(l, _) -> do
|
||||||
@@ -795,8 +825,20 @@ checkForUpdates = do
|
|||||||
|
|
||||||
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
|
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
|
||||||
logGHCPostRm ghcVer = do
|
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)
|
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
|
||||||
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
|
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
|
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
|
data CompileCommand = CompileGHC GHCCompileOptions
|
||||||
| CompileHLS HLSCompileOptions
|
| CompileHLS HLSCompileOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -66,7 +67,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
|
|||||||
|
|
||||||
|
|
||||||
data GHCCompileOptions = GHCCompileOptions
|
data GHCCompileOptions = GHCCompileOptions
|
||||||
{ targetGhc :: GHC.GHCVer Version
|
{ targetGhc :: GHC.GHCVer
|
||||||
, bootstrapGhc :: Either Version FilePath
|
, bootstrapGhc :: Either Version FilePath
|
||||||
, jobs :: Maybe Int
|
, jobs :: Maybe Int
|
||||||
, buildConfig :: Maybe FilePath
|
, buildConfig :: Maybe FilePath
|
||||||
@@ -76,9 +77,9 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, hadrian :: Bool
|
, buildSystem :: Maybe BuildSystem
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
data HLSCompileOptions = HLSCompileOptions
|
data HLSCompileOptions = HLSCompileOptions
|
||||||
@@ -93,7 +94,7 @@ data HLSCompileOptions = HLSCompileOptions
|
|||||||
, patches :: Maybe (Either FilePath [URI])
|
, patches :: Maybe (Either FilePath [URI])
|
||||||
, targetGHCs :: [ToolVersion]
|
, targetGHCs :: [ToolVersion]
|
||||||
, cabalArgs :: [Text]
|
, cabalArgs :: [Text]
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -170,7 +171,7 @@ ghcCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||||
"The tool version to compile"
|
"The tool version to compile"
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
) <|>
|
) <|>
|
||||||
(GHC.GitDist <$> (GitBranch <$> option
|
(GHC.GitDist <$> (GitBranch <$> option
|
||||||
@@ -205,7 +206,7 @@ ghcCompileOpts =
|
|||||||
<> metavar "BOOTSTRAP_GHC"
|
<> metavar "BOOTSTRAP_GHC"
|
||||||
<> help
|
<> help
|
||||||
"The GHC version (or full path) to bootstrap with (must be installed)"
|
"The GHC version (or full path) to bootstrap with (must be installed)"
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
@@ -258,7 +259,7 @@ ghcCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -268,16 +269,22 @@ ghcCompileOpts =
|
|||||||
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> switch
|
<*> (
|
||||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
(\b -> if b then Just Hadrian else Nothing) <$> switch
|
||||||
|
(long "hadrian" <> help "Use the hadrian build system instead of make. Tries to detect by default."
|
||||||
)
|
)
|
||||||
|
<|>
|
||||||
|
(\b -> if b then Just Make else Nothing) <$> switch
|
||||||
|
(long "make" <> help "Use the make build system instead of hadrian. Tries to detect by default."
|
||||||
|
)
|
||||||
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader isolateParser)
|
(eitherReader isolateParser)
|
||||||
( short 'i'
|
( short 'i'
|
||||||
<> long "isolate"
|
<> long "isolate"
|
||||||
<> metavar "DIR"
|
<> metavar "DIR"
|
||||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
|
||||||
<> completer (bashCompleter "directory")
|
<> completer (bashCompleter "directory")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -291,7 +298,7 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||||
"The version to compile (pulled from hackage)"
|
"The version to compile (pulled from hackage)"
|
||||||
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|>
|
<|>
|
||||||
@@ -311,7 +318,7 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
(long "source-dist" <> metavar "VERSION" <> help
|
(long "source-dist" <> metavar "VERSION" <> help
|
||||||
"The version to compile (pulled from packaged git sources)"
|
"The version to compile (pulled from packaged git sources)"
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
))
|
))
|
||||||
<|>
|
<|>
|
||||||
@@ -343,7 +350,7 @@ hlsCompileOpts =
|
|||||||
)
|
)
|
||||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|>
|
<|>
|
||||||
@@ -360,7 +367,7 @@ hlsCompileOpts =
|
|||||||
( short 'i'
|
( short 'i'
|
||||||
<> long "isolate"
|
<> long "isolate"
|
||||||
<> metavar "DIR"
|
<> metavar "DIR"
|
||||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
|
||||||
<> completer (bashCompleter "directory")
|
<> completer (bashCompleter "directory")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -403,7 +410,7 @@ hlsCompileOpts =
|
|||||||
option (eitherReader ghcVersionTagEither)
|
option (eitherReader ghcVersionTagEither)
|
||||||
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
||||||
<> completer (tagCompleter GHC [])
|
<> completer (tagCompleter GHC [])
|
||||||
<> completer (versionCompleter Nothing GHC))
|
<> completer (versionCompleter [] GHC))
|
||||||
)
|
)
|
||||||
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
||||||
|
|
||||||
@@ -453,6 +460,7 @@ type HLSEffects = '[ AlreadyInstalled
|
|||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
@@ -510,7 +518,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
case targetHLS of
|
case targetHLS of
|
||||||
HLS.SourceDist targetVer -> do
|
HLS.SourceDist targetVer -> do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
||||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
lift $ logInfo msg
|
lift $ logInfo msg
|
||||||
lift $ logInfo
|
lift $ logInfo
|
||||||
@@ -530,7 +538,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
patches
|
patches
|
||||||
cabalArgs
|
cabalArgs
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer HLS dls
|
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
setHLS targetVer SetHLSOnly Nothing
|
setHLS targetVer SetHLSOnly Nothing
|
||||||
pure (vi, targetVer)
|
pure (vi, targetVer)
|
||||||
@@ -554,15 +562,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ logError $ T.pack $ prettyHFError e
|
runLogger $ logError $ T.pack $ prettyHFError e
|
||||||
pure $ ExitFailure 9
|
pure $ ExitFailure 9
|
||||||
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
|
||||||
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
|
||||||
pure $ ExitFailure 9
|
|
||||||
(CompileGHC GHCCompileOptions {..}) ->
|
(CompileGHC GHCCompileOptions {..}) ->
|
||||||
runCompileGHC runAppState (do
|
runCompileGHC runAppState (do
|
||||||
case targetGhc of
|
case targetGhc of
|
||||||
GHC.SourceDist targetVer -> do
|
GHC.SourceDist targetVer -> do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer GHC dls
|
let vi = getVersionInfo (mkTVer targetVer) GHC dls
|
||||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||||
lift $ logInfo msg
|
lift $ logInfo msg
|
||||||
lift $ logInfo
|
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
|
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
targetVer <- liftE $ compileGHC
|
targetVer <- liftE $ compileGHC
|
||||||
((\case
|
targetGhc
|
||||||
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
|
crossTarget
|
||||||
GHC.GitDist g -> GHC.GitDist g
|
|
||||||
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
|
|
||||||
ovewrwiteVer
|
ovewrwiteVer
|
||||||
bootstrapGhc
|
bootstrapGhc
|
||||||
jobs
|
jobs
|
||||||
@@ -581,10 +584,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
patches
|
patches
|
||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
buildSystem
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
let vi = getVersionInfo targetVer GHC dls
|
||||||
when setCompile $ void $ liftE $
|
when setCompile $ void $ liftE $
|
||||||
setGHC targetVer SetGHCOnly Nothing
|
setGHC targetVer SetGHCOnly Nothing
|
||||||
pure (vi, targetVer)
|
pure (vi, targetVer)
|
||||||
@@ -32,7 +32,6 @@ import Options.Applicative hiding ( style, ParseError )
|
|||||||
import Options.Applicative.Help.Pretty ( text )
|
import Options.Applicative.Help.Pretty ( text )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import URI.ByteString hiding ( uriParser )
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
@@ -51,7 +50,8 @@ data ConfigCommand
|
|||||||
= ShowConfig
|
= ShowConfig
|
||||||
| SetConfig String (Maybe String)
|
| SetConfig String (Maybe String)
|
||||||
| InitConfig
|
| InitConfig
|
||||||
| AddReleaseChannel URI
|
| AddReleaseChannel Bool NewURLSource
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -59,7 +59,7 @@ data ConfigCommand
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
configP :: Parser ConfigCommand
|
configP :: Parser ConfigCommand
|
||||||
configP = subparser
|
configP = subparser
|
||||||
( command "init" initP
|
( command "init" initP
|
||||||
@@ -67,15 +67,14 @@ configP = subparser
|
|||||||
<> command "show" showP
|
<> command "show" showP
|
||||||
<> command "add-release-channel" addP
|
<> command "add-release-channel" addP
|
||||||
)
|
)
|
||||||
<|> argsP -- add show for a single option
|
|
||||||
<|> pure ShowConfig
|
<|> pure ShowConfig
|
||||||
where
|
where
|
||||||
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
|
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
|
||||||
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
|
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))
|
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"))
|
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))
|
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 from a URI")
|
(progDesc "Add a release channel, e.g. from a URI")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -120,21 +119,37 @@ formatConfig :: UserSettings -> String
|
|||||||
formatConfig = UTF8.toString . Y.encode
|
formatConfig = UTF8.toString . Y.encode
|
||||||
|
|
||||||
|
|
||||||
updateSettings :: UserSettings -> Settings -> Settings
|
updateSettings :: UserSettings -> UserSettings -> UserSettings
|
||||||
updateSettings UserSettings{..} Settings{..} =
|
updateSettings usl usr =
|
||||||
let cache' = fromMaybe cache uCache
|
let cache' = uCache usl <|> uCache usr
|
||||||
metaCache' = fromMaybe metaCache uMetaCache
|
metaCache' = uMetaCache usl <|> uMetaCache usr
|
||||||
metaMode' = fromMaybe metaMode uMetaMode
|
metaMode' = uMetaMode usl <|> uMetaMode usr
|
||||||
noVerify' = fromMaybe noVerify uNoVerify
|
noVerify' = uNoVerify usl <|> uNoVerify usr
|
||||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
verbose' = uVerbose usl <|> uVerbose usr
|
||||||
downloader' = fromMaybe downloader uDownloader
|
keepDirs' = uKeepDirs usl <|> uKeepDirs usr
|
||||||
verbose' = fromMaybe verbose uVerbose
|
downloader' = uDownloader usl <|> uDownloader usr
|
||||||
urlSource' = fromMaybe urlSource uUrlSource
|
urlSource' = uUrlSource usl <|> uUrlSource usr
|
||||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
noNetwork' = uNoNetwork usl <|> uNoNetwork usr
|
||||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
|
||||||
platformOverride' = uPlatformOverride <|> platformOverride
|
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
|
||||||
mirrors' = fromMaybe mirrors uMirrors
|
mirrors' = uMirrors usl <|> uMirrors usr
|
||||||
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride' mirrors'
|
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
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -142,6 +157,9 @@ updateSettings UserSettings{..} Settings{..} =
|
|||||||
--[ Entrypoint ]--
|
--[ 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
|
config :: forall m. ( Monad m
|
||||||
@@ -151,10 +169,11 @@ config :: forall m. ( Monad m
|
|||||||
)
|
)
|
||||||
=> ConfigCommand
|
=> ConfigCommand
|
||||||
-> Settings
|
-> Settings
|
||||||
|
-> UserSettings
|
||||||
-> KeyBindings
|
-> KeyBindings
|
||||||
-> (ReaderT LeanAppState m () -> m ())
|
-> (ReaderT LeanAppState m () -> m ())
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
config configCommand settings keybindings runLogger = case configCommand of
|
config configCommand settings userConf keybindings runLogger = case configCommand of
|
||||||
InitConfig -> do
|
InitConfig -> do
|
||||||
path <- getConfigFilePath
|
path <- getConfigFilePath
|
||||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||||
@@ -172,10 +191,14 @@ config configCommand settings keybindings runLogger = case configCommand of
|
|||||||
throwE $ ParseError "Empty values are not allowed"
|
throwE $ ParseError "Empty values are not allowed"
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
usersettings <- decodeSettings k
|
usersettings <- decodeSettings k
|
||||||
|
when (usersettings == defaultUserSettings)
|
||||||
|
$ throwE $ ParseError ("Failed to parse setting (maybe typo?): " <> k)
|
||||||
lift $ doConfig usersettings
|
lift $ doConfig usersettings
|
||||||
pure ()
|
pure ()
|
||||||
Just v -> do
|
Just v -> do
|
||||||
usersettings <- decodeSettings (k <> ": " <> v <> "\n")
|
usersettings <- decodeSettings (k <> ": " <> v <> "\n")
|
||||||
|
when (usersettings == defaultUserSettings)
|
||||||
|
$ throwE $ ParseError ("Failed to parse key '" <> k <> "' with value '" <> v <> "' as user setting. Maybe typo?")
|
||||||
lift $ doConfig usersettings
|
lift $ doConfig usersettings
|
||||||
pure ()
|
pure ()
|
||||||
case r of
|
case r of
|
||||||
@@ -183,29 +206,38 @@ config configCommand settings keybindings runLogger = case configCommand of
|
|||||||
VLeft (V (JSONDecodeError e)) -> do
|
VLeft (V (JSONDecodeError e)) -> do
|
||||||
runLogger $ logError $ "Error decoding config: " <> T.pack e
|
runLogger $ logError $ "Error decoding config: " <> T.pack e
|
||||||
pure $ ExitFailure 65
|
pure $ ExitFailure 65
|
||||||
VLeft _ -> pure $ ExitFailure 65
|
VLeft e -> do
|
||||||
|
runLogger (logError $ T.pack $ prettyHFError e)
|
||||||
|
pure $ ExitFailure 65
|
||||||
|
|
||||||
AddReleaseChannel uri -> do
|
AddReleaseChannel force new -> do
|
||||||
case urlSource settings of
|
r <- runE @'[DuplicateReleaseChannel] $ do
|
||||||
AddSource xs -> do
|
let oldSources = fromURLSource (urlSource settings)
|
||||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
let merged = oldSources ++ [new]
|
||||||
pure ExitSuccess
|
case checkDuplicate oldSources new of
|
||||||
GHCupURL -> do
|
Duplicate
|
||||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
| not force -> throwE (DuplicateReleaseChannel new)
|
||||||
pure ExitSuccess
|
DuplicateLast -> pure ()
|
||||||
OwnSource xs -> do
|
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ SimpleList merged })
|
||||||
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
|
case r of
|
||||||
pure ExitSuccess
|
VRight _ -> do
|
||||||
OwnSpec spec -> do
|
|
||||||
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
|
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
VLeft e -> do
|
||||||
|
runLogger $ logError $ T.pack $ prettyHFError e
|
||||||
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
where
|
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 :: MonadIO m => UserSettings -> m ()
|
||||||
doConfig usersettings = do
|
doConfig usersettings = do
|
||||||
let settings' = updateSettings usersettings settings
|
let settings' = updateSettings usersettings userConf
|
||||||
path <- liftIO getConfigFilePath
|
path <- liftIO getConfigFilePath
|
||||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
liftIO $ writeFile path $ formatConfig $ settings'
|
||||||
runLogger $ logDebug $ T.pack $ show settings'
|
runLogger $ logDebug $ T.pack $ show settings'
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
@@ -47,7 +47,7 @@ data GCOptions = GCOptions
|
|||||||
, gcHLSNoGHC :: Bool
|
, gcHLSNoGHC :: Bool
|
||||||
, gcCache :: Bool
|
, gcCache :: Bool
|
||||||
, gcTmp :: Bool
|
, gcTmp :: Bool
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -54,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions
|
|||||||
| InstallCabal InstallOptions
|
| InstallCabal InstallOptions
|
||||||
| InstallHLS InstallOptions
|
| InstallHLS InstallOptions
|
||||||
| InstallStack InstallOptions
|
| InstallStack InstallOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -62,7 +63,6 @@ data InstallCommand = InstallGHC InstallOptions
|
|||||||
--[ Options ]--
|
--[ Options ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
data InstallOptions = InstallOptions
|
data InstallOptions = InstallOptions
|
||||||
{ instVer :: Maybe ToolVersion
|
{ instVer :: Maybe ToolVersion
|
||||||
, instBindist :: Maybe URI
|
, instBindist :: Maybe URI
|
||||||
@@ -70,7 +70,7 @@ data InstallOptions = InstallOptions
|
|||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
, forceInstall :: Bool
|
, forceInstall :: Bool
|
||||||
, addConfArgs :: [T.Text]
|
, addConfArgs :: [T.Text]
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -133,7 +133,7 @@ installParser =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<|> (Right <$> installOpts Nothing)
|
<|> (Right <$> installOpts (Just GHC))
|
||||||
where
|
where
|
||||||
installHLSFooter :: String
|
installHLSFooter :: String
|
||||||
installHLSFooter = [s|Discussion:
|
installHLSFooter = [s|Discussion:
|
||||||
@@ -184,7 +184,7 @@ installOpts tool =
|
|||||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
<*> (Just <$> toolVersionTagArgument [] tool)
|
||||||
)
|
)
|
||||||
<|> pure (Nothing, Nothing)
|
<|> pure (Nothing, Nothing)
|
||||||
)
|
)
|
||||||
@@ -196,7 +196,7 @@ installOpts tool =
|
|||||||
( short 'i'
|
( short 'i'
|
||||||
<> long "isolate"
|
<> long "isolate"
|
||||||
<> metavar "DIR"
|
<> metavar "DIR"
|
||||||
<> help "install in an isolated dir instead of the default one"
|
<> help "install in an isolated absolute directory instead of the default one"
|
||||||
<> completer (bashCompleter "directory")
|
<> completer (bashCompleter "directory")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -241,6 +241,7 @@ type InstallEffects = '[ AlreadyInstalled
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, DigestError
|
, DigestError
|
||||||
, ContentLengthError
|
, ContentLengthError
|
||||||
, GPGError
|
, GPGError
|
||||||
@@ -284,10 +285,16 @@ type InstallGHCEffects = '[ AlreadyInstalled
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, ProcessError
|
, ProcessError
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, TarDirDoesNotExist
|
, TarDirDoesNotExist
|
||||||
, UninstallFailed
|
, UninstallFailed
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
, InstallSetError
|
, InstallSetError
|
||||||
|
, NoCompatiblePlatform
|
||||||
|
, GHCup.Errors.ParseError
|
||||||
|
, UnsupportedSetupCombo
|
||||||
|
, DistroNotFound
|
||||||
|
, NoCompatibleArch
|
||||||
]
|
]
|
||||||
|
|
||||||
runInstGHC :: AppState
|
runInstGHC :: AppState
|
||||||
@@ -307,13 +314,13 @@ runInstGHC appstate' =
|
|||||||
|
|
||||||
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
|
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
|
||||||
install installCommand settings getAppState' runLogger = case installCommand of
|
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.")
|
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
|
||||||
installGHC iopts
|
installGHC iGHCopts
|
||||||
(Left (InstallGHC iopts)) -> installGHC iopts
|
(Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
|
||||||
(Left (InstallCabal iopts)) -> installCabal iopts
|
(Left (InstallCabal iopts)) -> installCabal iopts
|
||||||
(Left (InstallHLS iopts)) -> installHLS iopts
|
(Left (InstallHLS iopts)) -> installHLS iopts
|
||||||
(Left (InstallStack iopts)) -> installStack iopts
|
(Left (InstallStack iopts)) -> installStack iopts
|
||||||
where
|
where
|
||||||
installGHC :: InstallOptions -> IO ExitCode
|
installGHC :: InstallOptions -> IO ExitCode
|
||||||
installGHC InstallOptions{..} = do
|
installGHC InstallOptions{..} = do
|
||||||
@@ -322,7 +329,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
Nothing -> runInstGHC s' $ do
|
Nothing -> runInstGHC s' $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
liftE $ runBothE' (installGHCBin
|
liftE $ runBothE' (installGHCBin
|
||||||
(_tvVersion v)
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
addConfArgs
|
addConfArgs
|
||||||
@@ -333,8 +340,8 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
runInstGHC s'{ settings = settings {noVerify = True}} $ do
|
runInstGHC s'{ settings = settings {noVerify = True}} $ do
|
||||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||||
liftE $ runBothE' (installGHCBindist
|
liftE $ runBothE' (installGHCBindist
|
||||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
|
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
|
||||||
(_tvVersion v)
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
addConfArgs
|
addConfArgs
|
||||||
@@ -403,7 +410,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
||||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||||
liftE $ runBothE' (installCabalBindist
|
liftE $ runBothE' (installCabalBindist
|
||||||
(DownloadInfo uri Nothing "" Nothing)
|
(DownloadInfo uri Nothing "" Nothing Nothing)
|
||||||
v
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
@@ -453,7 +460,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||||
-- TODO: support legacy
|
-- TODO: support legacy
|
||||||
liftE $ runBothE' (installHLSBindist
|
liftE $ runBothE' (installHLSBindist
|
||||||
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
|
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
|
||||||
v
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
@@ -502,7 +509,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
|||||||
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
runInstTool s'{ settings = settings { noVerify = True}} $ do
|
||||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||||
liftE $ runBothE' (installStackBindist
|
liftE $ runBothE' (installStackBindist
|
||||||
(DownloadInfo uri Nothing "" Nothing)
|
(DownloadInfo uri Nothing "" Nothing Nothing)
|
||||||
v
|
v
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
forceInstall
|
forceInstall
|
||||||
@@ -2,6 +2,7 @@
|
|||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
|
||||||
@@ -14,6 +15,7 @@ import GHCup
|
|||||||
import GHCup.Prelude
|
import GHCup.Prelude
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.OptParse.Common
|
import GHCup.OptParse.Common
|
||||||
|
import GHCup.Prelude.String.QQ
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
@@ -24,7 +26,8 @@ import Data.Char
|
|||||||
import Data.List ( intercalate, sort )
|
import Data.List ( intercalate, sort )
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( str )
|
import Data.Time.Calendar ( Day )
|
||||||
|
import Data.Versions
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
@@ -50,8 +53,12 @@ import qualified Text.Megaparsec.Char as MPC
|
|||||||
data ListOptions = ListOptions
|
data ListOptions = ListOptions
|
||||||
{ loTool :: Maybe Tool
|
{ loTool :: Maybe Tool
|
||||||
, lCriteria :: Maybe ListCriteria
|
, lCriteria :: Maybe ListCriteria
|
||||||
|
, lFrom :: Maybe Day
|
||||||
|
, lTo :: Maybe Day
|
||||||
|
, lHideOld :: Bool
|
||||||
|
, lShowNightly :: Bool
|
||||||
, lRawFormat :: Bool
|
, lRawFormat :: Bool
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -60,7 +67,6 @@ data ListOptions = ListOptions
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
listOpts :: Parser ListOptions
|
listOpts :: Parser ListOptions
|
||||||
listOpts =
|
listOpts =
|
||||||
ListOptions
|
ListOptions
|
||||||
@@ -69,7 +75,7 @@ listOpts =
|
|||||||
(eitherReader toolParser)
|
(eitherReader toolParser)
|
||||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||||
"Tool to list versions for. Default is all"
|
"Tool to list versions for. Default is all"
|
||||||
<> completer (toolCompleter)
|
<> completer toolCompleter
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -78,15 +84,53 @@ listOpts =
|
|||||||
( short 'c'
|
( short 'c'
|
||||||
<> long "show-criteria"
|
<> long "show-criteria"
|
||||||
<> metavar "<installed|set|available>"
|
<> metavar "<installed|set|available>"
|
||||||
<> help "Show only installed/set/available tool versions"
|
<> help "Apply filtering criteria, prefix with + or -"
|
||||||
<> completer (listCompleter ["installed", "set", "available"])
|
<> completer (listCompleter
|
||||||
|
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader dayParser)
|
||||||
|
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
|
||||||
|
"List only tools with release date starting at YYYY-MM-DD or later"
|
||||||
|
<> completer toolCompleter
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<*> optional
|
||||||
|
(option
|
||||||
|
(eitherReader dayParser)
|
||||||
|
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
|
||||||
|
"List only tools with release date earlier than YYYY-MM-DD"
|
||||||
|
<> completer toolCompleter
|
||||||
|
)
|
||||||
|
)
|
||||||
|
<*> switch
|
||||||
|
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
|
||||||
|
)
|
||||||
|
<*> switch
|
||||||
|
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
|
||||||
|
)
|
||||||
<*> switch
|
<*> switch
|
||||||
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
--------------
|
||||||
|
--[ Footer ]--
|
||||||
|
--------------
|
||||||
|
|
||||||
|
|
||||||
|
listToolFooter :: String
|
||||||
|
listToolFooter = [s|Discussion:
|
||||||
|
Lists tool versions with optional criteria.
|
||||||
|
Nightlies are by default hidden.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
# query nightlies in a specific range
|
||||||
|
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
|
||||||
|
# show all installed GHC versions
|
||||||
|
ghcup list -t ghc -c installed|]
|
||||||
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
@@ -105,8 +149,11 @@ printListResult no_color raw lr = do
|
|||||||
printTag Recommended = color Green "recommended"
|
printTag Recommended = color Green "recommended"
|
||||||
printTag Latest = color Yellow "latest"
|
printTag Latest = color Yellow "latest"
|
||||||
printTag Prerelease = color Red "prerelease"
|
printTag Prerelease = color Red "prerelease"
|
||||||
|
printTag Nightly = color Red "nightly"
|
||||||
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||||
printTag (UnknownTag t ) = t
|
printTag (UnknownTag t ) = t
|
||||||
|
printTag LatestPrerelease = color Red "latest-prerelease"
|
||||||
|
printTag LatestNightly = color Red "latest-nightly"
|
||||||
printTag Old = ""
|
printTag Old = ""
|
||||||
|
|
||||||
let
|
let
|
||||||
@@ -133,8 +180,10 @@ printListResult no_color raw lr = do
|
|||||||
then [color Green "hls-powered"]
|
then [color Green "hls-powered"]
|
||||||
else mempty
|
else mempty
|
||||||
)
|
)
|
||||||
++ (if fromSrc then [color Blue "compiled"] else mempty)
|
|
||||||
++ (if lStray then [color Yellow "stray"] else mempty)
|
++ (if lStray then [color Yellow "stray"] else mempty)
|
||||||
|
++ (case lReleaseDay of
|
||||||
|
Nothing -> mempty
|
||||||
|
Just d -> [color Blue (show d)])
|
||||||
++ (if lNoBindist
|
++ (if lNoBindist
|
||||||
then [color Red "no-bindist"]
|
then [color Red "no-bindist"]
|
||||||
else mempty
|
else mempty
|
||||||
@@ -259,7 +308,7 @@ list :: ( Monad m
|
|||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
list ListOptions{..} no_color runAppState =
|
list ListOptions{..} no_color runAppState =
|
||||||
runAppState (do
|
runAppState (do
|
||||||
l <- listVersions loTool lCriteria
|
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
|
||||||
liftIO $ printListResult no_color lRawFormat l
|
liftIO $ printListResult no_color lRawFormat l
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
)
|
)
|
||||||
@@ -76,8 +76,8 @@ nuke appState runLogger = do
|
|||||||
|
|
||||||
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||||
lift $ logInfo "Nuking in 3...2...1"
|
lift $ logInfo "Nuking in 3...2...1"
|
||||||
|
|
||||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
|
||||||
|
|
||||||
forM_ lInstalled (liftE . rmTool)
|
forM_ lInstalled (liftE . rmTool)
|
||||||
|
|
||||||
@@ -14,6 +14,7 @@ module GHCup.OptParse.Prefetch where
|
|||||||
import GHCup
|
import GHCup
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import GHCup.Types.Optics
|
||||||
import GHCup.Prelude.File
|
import GHCup.Prelude.File
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
@@ -83,7 +84,7 @@ prefetchP = subparser
|
|||||||
<$> (PrefetchGHCOptions
|
<$> (PrefetchGHCOptions
|
||||||
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
||||||
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
|
<*> optional (toolVersionTagArgument [] (Just GHC)) )
|
||||||
( progDesc "Download GHC assets for installation")
|
( progDesc "Download GHC assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -92,7 +93,7 @@ prefetchP = subparser
|
|||||||
(info
|
(info
|
||||||
(PrefetchCabal
|
(PrefetchCabal
|
||||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
|
<*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
|
||||||
( progDesc "Download cabal assets for installation")
|
( progDesc "Download cabal assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -101,7 +102,7 @@ prefetchP = subparser
|
|||||||
(info
|
(info
|
||||||
(PrefetchHLS
|
(PrefetchHLS
|
||||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
|
<*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
|
||||||
( progDesc "Download HLS assets for installation")
|
( progDesc "Download HLS assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -110,7 +111,7 @@ prefetchP = subparser
|
|||||||
(info
|
(info
|
||||||
(PrefetchStack
|
(PrefetchStack
|
||||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||||
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
|
<*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
|
||||||
( progDesc "Download stack assets for installation")
|
( progDesc "Download stack assets for installation")
|
||||||
)
|
)
|
||||||
<>
|
<>
|
||||||
@@ -148,6 +149,7 @@ Examples:
|
|||||||
|
|
||||||
|
|
||||||
type PrefetchEffects = '[ TagNotFound
|
type PrefetchEffects = '[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, NoDownload
|
, NoDownload
|
||||||
@@ -156,7 +158,9 @@ type PrefetchEffects = '[ TagNotFound
|
|||||||
, GPGError
|
, GPGError
|
||||||
, DownloadFailed
|
, DownloadFailed
|
||||||
, JSONError
|
, JSONError
|
||||||
, FileDoesNotExistError ]
|
, FileDoesNotExistError
|
||||||
|
, StackPlatformDetectError
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
runPrefetch :: MonadUnliftIO m
|
runPrefetch :: MonadUnliftIO m
|
||||||
@@ -194,22 +198,23 @@ prefetch prefetchCommand runAppState runLogger =
|
|||||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||||
(v, _) <- liftE $ fromVersion mt GHC
|
(v, _) <- liftE $ fromVersion mt GHC
|
||||||
if pfGHCSrc
|
if pfGHCSrc
|
||||||
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
|
then liftE $ fetchGHCSrc v pfCacheDir
|
||||||
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
else liftE $ fetchToolBindist v GHC pfCacheDir
|
||||||
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
||||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||||
(v, _) <- liftE $ fromVersion mt Cabal
|
(v, _) <- liftE $ fromVersion mt Cabal
|
||||||
liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
|
liftE $ fetchToolBindist v Cabal pfCacheDir
|
||||||
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
|
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
|
||||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||||
(v, _) <- liftE $ fromVersion mt HLS
|
(v, _) <- liftE $ fromVersion mt HLS
|
||||||
liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
|
liftE $ fetchToolBindist v HLS pfCacheDir
|
||||||
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
|
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
|
||||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||||
(v, _) <- liftE $ fromVersion mt Stack
|
(v, _) <- liftE $ fromVersion mt Stack
|
||||||
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
|
liftE $ fetchToolBindist v Stack pfCacheDir
|
||||||
PrefetchMetadata -> do
|
PrefetchMetadata -> do
|
||||||
_ <- liftE getDownloadsF
|
pfreq <- lift getPlatformReq
|
||||||
|
_ <- liftE $ getDownloadsF pfreq
|
||||||
pure ""
|
pure ""
|
||||||
) >>= \case
|
) >>= \case
|
||||||
VRight _ -> do
|
VRight _ -> do
|
||||||
@@ -29,7 +29,7 @@ import Control.Monad.Reader
|
|||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( str )
|
import Data.Versions
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
@@ -50,6 +50,7 @@ data RmCommand = RmGHC RmOptions
|
|||||||
| RmCabal Version
|
| RmCabal Version
|
||||||
| RmHLS Version
|
| RmHLS Version
|
||||||
| RmStack Version
|
| RmStack Version
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -61,7 +62,7 @@ data RmCommand = RmGHC RmOptions
|
|||||||
|
|
||||||
data RmOptions = RmOptions
|
data RmOptions = RmOptions
|
||||||
{ ghcVer :: GHCTargetVersion
|
{ ghcVer :: GHCTargetVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -80,19 +81,19 @@ rmParser =
|
|||||||
<> command
|
<> command
|
||||||
"cabal"
|
"cabal"
|
||||||
( RmCabal
|
( RmCabal
|
||||||
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
|
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
|
||||||
(progDesc "Remove Cabal version")
|
(progDesc "Remove Cabal version")
|
||||||
)
|
)
|
||||||
<> command
|
<> command
|
||||||
"hls"
|
"hls"
|
||||||
( RmHLS
|
( RmHLS
|
||||||
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
|
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
|
||||||
(progDesc "Remove haskell-language-server version")
|
(progDesc "Remove haskell-language-server version")
|
||||||
)
|
)
|
||||||
<> command
|
<> command
|
||||||
"stack"
|
"stack"
|
||||||
( RmStack
|
( RmStack
|
||||||
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
|
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
|
||||||
(progDesc "Remove stack version")
|
(progDesc "Remove stack version")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -102,7 +103,7 @@ rmParser =
|
|||||||
|
|
||||||
|
|
||||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||||
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
|
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -170,7 +171,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmGHCVer ghcVer
|
rmGHCVer ghcVer
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
|
pure (getVersionInfo ghcVer GHC dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -186,7 +187,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmCabalVer tv
|
rmCabalVer tv
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo tv Cabal dls)
|
pure (getVersionInfo (mkTVer tv) Cabal dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -201,7 +202,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmHLSVer tv
|
rmHLSVer tv
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo tv HLS dls)
|
pure (getVersionInfo (mkTVer tv) HLS dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -216,7 +217,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
liftE $
|
liftE $
|
||||||
rmStackVer tv
|
rmStackVer tv
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
pure (getVersionInfo tv Stack dls)
|
pure (getVersionInfo (mkTVer tv) Stack dls)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
@@ -68,7 +68,7 @@ data RunOptions = RunOptions
|
|||||||
, runBinDir :: Maybe FilePath
|
, runBinDir :: Maybe FilePath
|
||||||
, runQuick :: Bool
|
, runQuick :: Bool
|
||||||
, runCOMMAND :: [String]
|
, runCOMMAND :: [String]
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -92,7 +92,7 @@ runOpts =
|
|||||||
(eitherReader ghcVersionTagEither)
|
(eitherReader ghcVersionTagEither)
|
||||||
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
||||||
<> completer (tagCompleter GHC [])
|
<> completer (tagCompleter GHC [])
|
||||||
<> (completer $ versionCompleter Nothing GHC)
|
<> (completer $ versionCompleter [] GHC)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -100,7 +100,7 @@ runOpts =
|
|||||||
(eitherReader toolVersionTagEither)
|
(eitherReader toolVersionTagEither)
|
||||||
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
||||||
<> completer (tagCompleter Cabal [])
|
<> completer (tagCompleter Cabal [])
|
||||||
<> (completer $ versionCompleter Nothing Cabal)
|
<> (completer $ versionCompleter [] Cabal)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -108,7 +108,7 @@ runOpts =
|
|||||||
(eitherReader toolVersionTagEither)
|
(eitherReader toolVersionTagEither)
|
||||||
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
||||||
<> completer (tagCompleter HLS [])
|
<> completer (tagCompleter HLS [])
|
||||||
<> (completer $ versionCompleter Nothing HLS)
|
<> (completer $ versionCompleter [] HLS)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -116,7 +116,7 @@ runOpts =
|
|||||||
(eitherReader toolVersionTagEither)
|
(eitherReader toolVersionTagEither)
|
||||||
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
||||||
<> completer (tagCompleter Stack [])
|
<> completer (tagCompleter Stack [])
|
||||||
<> (completer $ versionCompleter Nothing Stack)
|
<> (completer $ versionCompleter [] Stack)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> optional
|
<*> optional
|
||||||
@@ -132,7 +132,7 @@ runOpts =
|
|||||||
<*> switch
|
<*> switch
|
||||||
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
|
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
|
||||||
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
|
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -175,6 +175,7 @@ type RunEffects = '[ AlreadyInstalled
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
, BuildFailed
|
, BuildFailed
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, DigestError
|
, DigestError
|
||||||
, ContentLengthError
|
, ContentLengthError
|
||||||
, GPGError
|
, GPGError
|
||||||
@@ -186,6 +187,11 @@ type RunEffects = '[ AlreadyInstalled
|
|||||||
, ProcessError
|
, ProcessError
|
||||||
, UninstallFailed
|
, UninstallFailed
|
||||||
, MergeFileTreeError
|
, MergeFileTreeError
|
||||||
|
, NoCompatiblePlatform
|
||||||
|
, GHCup.Errors.ParseError
|
||||||
|
, UnsupportedSetupCombo
|
||||||
|
, DistroNotFound
|
||||||
|
, NoCompatibleArch
|
||||||
]
|
]
|
||||||
|
|
||||||
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
|
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
|
||||||
@@ -225,6 +231,7 @@ run :: forall m .
|
|||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
|
, Alternative m
|
||||||
)
|
)
|
||||||
=> RunOptions
|
=> RunOptions
|
||||||
-> IO AppState
|
-> IO AppState
|
||||||
@@ -254,7 +261,9 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
liftIO $ putStr tmp
|
liftIO $ putStr tmp
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
(cmd:args) -> do
|
(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
|
#ifndef IS_WINDOWS
|
||||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
@@ -282,6 +291,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
)
|
)
|
||||||
=> Excepts
|
=> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
] (ResourceT (ReaderT AppState m)) Toolchain
|
] (ResourceT (ReaderT AppState m)) Toolchain
|
||||||
@@ -327,11 +337,13 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
|
, Alternative m
|
||||||
)
|
)
|
||||||
=> Toolchain
|
=> Toolchain
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ TagNotFound
|
'[ TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, UnknownArchive
|
, UnknownArchive
|
||||||
@@ -351,13 +363,18 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
|||||||
, CopyError
|
, CopyError
|
||||||
, UninstallFailed
|
, UninstallFailed
|
||||||
, MergeFileTreeError
|
, MergeFileTreeError
|
||||||
|
, NoCompatiblePlatform
|
||||||
|
, GHCup.Errors.ParseError
|
||||||
|
, UnsupportedSetupCombo
|
||||||
|
, DistroNotFound
|
||||||
|
, NoCompatibleArch
|
||||||
] (ResourceT (ReaderT AppState m)) ()
|
] (ResourceT (ReaderT AppState m)) ()
|
||||||
installToolChainFull Toolchain{..} tmp = do
|
installToolChainFull Toolchain{..} tmp = do
|
||||||
case ghcVer of
|
case ghcVer of
|
||||||
Just v -> do
|
Just v -> do
|
||||||
isInstalled <- lift $ checkIfToolInstalled' GHC v
|
isInstalled <- lift $ checkIfToolInstalled' GHC v
|
||||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||||
(_tvVersion v)
|
v
|
||||||
GHCupInternal
|
GHCupInternal
|
||||||
False
|
False
|
||||||
[]
|
[]
|
||||||
@@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
|
|||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( str )
|
import Data.Versions
|
||||||
import GHC.Unicode
|
import GHC.Unicode
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Options.Applicative hiding ( style )
|
import Options.Applicative hiding ( style )
|
||||||
@@ -53,6 +53,7 @@ data SetCommand = SetGHC SetOptions
|
|||||||
| SetCabal SetOptions
|
| SetCabal SetOptions
|
||||||
| SetHLS SetOptions
|
| SetHLS SetOptions
|
||||||
| SetStack SetOptions
|
| SetStack SetOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -64,7 +65,7 @@ data SetCommand = SetGHC SetOptions
|
|||||||
|
|
||||||
data SetOptions = SetOptions
|
data SetOptions = SetOptions
|
||||||
{ sToolVer :: SetToolVersion
|
{ sToolVer :: SetToolVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -139,9 +140,9 @@ setParser =
|
|||||||
setOpts :: Tool -> Parser SetOptions
|
setOpts :: Tool -> Parser SetOptions
|
||||||
setOpts tool = SetOptions <$>
|
setOpts tool = SetOptions <$>
|
||||||
(fromMaybe SetRecommended <$>
|
(fromMaybe SetRecommended <$>
|
||||||
optional (setVersionArgument (Just ListInstalled) tool))
|
optional (setVersionArgument [ListInstalled True] tool))
|
||||||
|
|
||||||
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
|
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
|
||||||
setVersionArgument criteria tool =
|
setVersionArgument criteria tool =
|
||||||
argument (eitherReader setEither)
|
argument (eitherReader setEither)
|
||||||
(metavar "VERSION|TAG|next"
|
(metavar "VERSION|TAG|next"
|
||||||
@@ -184,6 +185,7 @@ setFooter = [s|Discussion:
|
|||||||
type SetGHCEffects = '[ FileDoesNotExistError
|
type SetGHCEffects = '[ FileDoesNotExistError
|
||||||
, NotInstalled
|
, NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -198,6 +200,7 @@ runSetGHC runAppState =
|
|||||||
|
|
||||||
type SetCabalEffects = '[ NotInstalled
|
type SetCabalEffects = '[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -212,6 +215,7 @@ runSetCabal runAppState =
|
|||||||
|
|
||||||
type SetHLSEffects = '[ NotInstalled
|
type SetHLSEffects = '[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -226,6 +230,7 @@ runSetHLS runAppState =
|
|||||||
|
|
||||||
type SetStackEffects = '[ NotInstalled
|
type SetStackEffects = '[ NotInstalled
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, NoToolVersionSet]
|
, NoToolVersionSet]
|
||||||
|
|
||||||
@@ -259,7 +264,7 @@ set :: forall m env.
|
|||||||
-> m (VEither eff GHCTargetVersion))
|
-> m (VEither eff GHCTargetVersion))
|
||||||
-> (ReaderT LeanAppState m () -> m ())
|
-> (ReaderT LeanAppState m () -> m ())
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
set setCommand runAppState _ runLogger = case setCommand of
|
||||||
(Right sopts) -> do
|
(Right sopts) -> do
|
||||||
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
||||||
setGHC' sopts
|
setGHC' sopts
|
||||||
@@ -271,10 +276,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
where
|
where
|
||||||
setGHC' :: SetOptions
|
setGHC' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setGHC' SetOptions{ sToolVer } =
|
setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
|
|
||||||
_ -> runSetGHC runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||||
liftE $ setGHC v SetGHCOnly Nothing
|
liftE $ setGHC v SetGHCOnly Nothing
|
||||||
)
|
)
|
||||||
@@ -291,10 +293,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
|
|
||||||
setCabal' :: SetOptions
|
setCabal' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setCabal' SetOptions{ sToolVer } =
|
setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
|
|
||||||
_ -> runSetCabal runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||||
liftE $ setCabal (_tvVersion v)
|
liftE $ setCabal (_tvVersion v)
|
||||||
pure v
|
pure v
|
||||||
@@ -311,10 +310,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
|
|
||||||
setHLS' :: SetOptions
|
setHLS' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setHLS' SetOptions{ sToolVer } =
|
setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
|
|
||||||
_ -> runSetHLS runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||||
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
||||||
pure v
|
pure v
|
||||||
@@ -332,10 +328,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
|||||||
|
|
||||||
setStack' :: SetOptions
|
setStack' :: SetOptions
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
setStack' SetOptions{ sToolVer } =
|
setStack' SetOptions{ sToolVer } = runSetStack runAppState (do
|
||||||
case sToolVer of
|
|
||||||
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
|
|
||||||
_ -> runSetStack runAppState (do
|
|
||||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||||
liftE $ setStack (_tvVersion v)
|
liftE $ setStack (_tvVersion v)
|
||||||
pure v
|
pure v
|
||||||
@@ -112,7 +112,7 @@ testOpts tool =
|
|||||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> (Just <$> toolVersionTagArgument Nothing tool)
|
<*> (Just <$> toolVersionTagArgument [] tool)
|
||||||
)
|
)
|
||||||
<|> pure (Nothing, Nothing)
|
<|> pure (Nothing, Nothing)
|
||||||
)
|
)
|
||||||
@@ -140,6 +140,7 @@ type TestGHCEffects = [ DigestError
|
|||||||
, TestFailed
|
, TestFailed
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -168,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
|
|||||||
(case testBindist of
|
(case testBindist of
|
||||||
Nothing -> runTestGHC s' $ do
|
Nothing -> runTestGHC s' $ do
|
||||||
(v, vi) <- liftE $ fromVersion testVer GHC
|
(v, vi) <- liftE $ fromVersion testVer GHC
|
||||||
liftE $ testGHCVer (_tvVersion v) addMakeArgs
|
liftE $ testGHCVer v addMakeArgs
|
||||||
pure vi
|
pure vi
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
runTestGHC s'{ settings = settings {noVerify = True}} $ do
|
runTestGHC s'{ settings = settings {noVerify = True}} $ do
|
||||||
(v, vi) <- liftE $ fromVersion testVer GHC
|
(v, vi) <- liftE $ fromVersion testVer GHC
|
||||||
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs
|
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
|
||||||
pure vi
|
pure vi
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
@@ -48,6 +48,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
|
|||||||
| UnsetCabal UnsetOptions
|
| UnsetCabal UnsetOptions
|
||||||
| UnsetHLS UnsetOptions
|
| UnsetHLS UnsetOptions
|
||||||
| UnsetStack UnsetOptions
|
| UnsetStack UnsetOptions
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -59,7 +60,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
|
|||||||
|
|
||||||
data UnsetOptions = UnsetOptions
|
data UnsetOptions = UnsetOptions
|
||||||
{ sToolVer :: Maybe T.Text -- target platform triple
|
{ sToolVer :: Maybe T.Text -- target platform triple
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -68,7 +69,7 @@ data UnsetOptions = UnsetOptions
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
unsetParser :: Parser UnsetCommand
|
unsetParser :: Parser UnsetCommand
|
||||||
unsetParser =
|
unsetParser =
|
||||||
subparser
|
subparser
|
||||||
@@ -113,7 +114,14 @@ unsetParser =
|
|||||||
unsetGHCFooter :: String
|
unsetGHCFooter :: String
|
||||||
unsetGHCFooter = [s|Discussion:
|
unsetGHCFooter = [s|Discussion:
|
||||||
Unsets the the current GHC version. That means there won't
|
Unsets the the current GHC version. That means there won't
|
||||||
be a ~/.ghcup/bin/ghc anymore.|]
|
be a ~/.ghcup/bin/ghc anymore.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
# unset ghc
|
||||||
|
ghcup unset ghc
|
||||||
|
|
||||||
|
# unset ghc for the target version
|
||||||
|
ghcup unset ghc armv7-unknown-linux-gnueabihf|]
|
||||||
|
|
||||||
unsetCabalFooter :: String
|
unsetCabalFooter :: String
|
||||||
unsetCabalFooter = [s|Discussion:
|
unsetCabalFooter = [s|Discussion:
|
||||||
@@ -35,7 +35,7 @@ import System.Environment
|
|||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import Data.Versions hiding (str)
|
import Data.Versions
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -50,7 +50,7 @@ import Data.Versions hiding (str)
|
|||||||
data UpgradeOpts = UpgradeInplace
|
data UpgradeOpts = UpgradeInplace
|
||||||
| UpgradeAt FilePath
|
| UpgradeAt FilePath
|
||||||
| UpgradeGHCupDir
|
| UpgradeGHCupDir
|
||||||
deriving Show
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -54,6 +54,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
|||||||
| WhereisCacheDir
|
| WhereisCacheDir
|
||||||
| WhereisLogsDir
|
| WhereisLogsDir
|
||||||
| WhereisConfDir
|
| WhereisConfDir
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -66,7 +67,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
|||||||
|
|
||||||
data WhereisOptions = WhereisOptions {
|
data WhereisOptions = WhereisOptions {
|
||||||
directory :: Bool
|
directory :: Bool
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -82,7 +83,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"ghc"
|
"ghc"
|
||||||
(WhereisTool GHC <$> info
|
(WhereisTool GHC <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
|
||||||
( progDesc "Get GHC location"
|
( progDesc "Get GHC location"
|
||||||
<> footerDoc (Just $ text whereisGHCFooter ))
|
<> footerDoc (Just $ text whereisGHCFooter ))
|
||||||
)
|
)
|
||||||
@@ -90,7 +91,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"cabal"
|
"cabal"
|
||||||
(WhereisTool Cabal <$> info
|
(WhereisTool Cabal <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
|
||||||
( progDesc "Get cabal location"
|
( progDesc "Get cabal location"
|
||||||
<> footerDoc (Just $ text whereisCabalFooter ))
|
<> footerDoc (Just $ text whereisCabalFooter ))
|
||||||
)
|
)
|
||||||
@@ -98,7 +99,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"hls"
|
"hls"
|
||||||
(WhereisTool HLS <$> info
|
(WhereisTool HLS <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
|
||||||
( progDesc "Get HLS location"
|
( progDesc "Get HLS location"
|
||||||
<> footerDoc (Just $ text whereisHLSFooter ))
|
<> footerDoc (Just $ text whereisHLSFooter ))
|
||||||
)
|
)
|
||||||
@@ -106,7 +107,7 @@ whereisP = subparser
|
|||||||
command
|
command
|
||||||
"stack"
|
"stack"
|
||||||
(WhereisTool Stack <$> info
|
(WhereisTool Stack <$> info
|
||||||
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
|
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
|
||||||
( progDesc "Get stack location"
|
( progDesc "Get stack location"
|
||||||
<> footerDoc (Just $ text whereisStackFooter ))
|
<> footerDoc (Just $ text whereisStackFooter ))
|
||||||
)
|
)
|
||||||
@@ -222,6 +223,7 @@ type WhereisEffects = '[ NotInstalled
|
|||||||
, NoToolVersionSet
|
, NoToolVersionSet
|
||||||
, NextVerNotFound
|
, NextVerNotFound
|
||||||
, TagNotFound
|
, TagNotFound
|
||||||
|
, DayNotFound
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
31
lib/GHCup.hs
31
lib/GHCup.hs
@@ -100,7 +100,7 @@ fetchToolBindist :: ( MonadFail m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version
|
=> GHCTargetVersion
|
||||||
-> Tool
|
-> Tool
|
||||||
-> Maybe FilePath
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
@@ -113,7 +113,7 @@ fetchToolBindist :: ( MonadFail m
|
|||||||
m
|
m
|
||||||
FilePath
|
FilePath
|
||||||
fetchToolBindist v t mfp = do
|
fetchToolBindist v t mfp = do
|
||||||
dlinfo <- liftE $ getDownloadInfo t v
|
dlinfo <- liftE $ getDownloadInfo' t v
|
||||||
liftE $ downloadCached' dlinfo Nothing mfp
|
liftE $ downloadCached' dlinfo Nothing mfp
|
||||||
|
|
||||||
|
|
||||||
@@ -134,15 +134,24 @@ rmTool :: ( MonadReader env m
|
|||||||
=> ListResult
|
=> ListResult
|
||||||
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||||
rmTool ListResult {lVer, lTool, lCross} = do
|
rmTool ListResult {lVer, lTool, lCross} = do
|
||||||
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
|
let printRmTool = logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
|
||||||
case lTool of
|
case lTool of
|
||||||
GHC ->
|
GHC -> do
|
||||||
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
||||||
in rmGHCVer ghcTargetVersion
|
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
|
||||||
HLS -> rmHLSVer lVer
|
rmGHCVer ghcTargetVersion
|
||||||
Cabal -> liftE $ rmCabalVer lVer
|
HLS -> do
|
||||||
Stack -> liftE $ rmStackVer lVer
|
printRmTool
|
||||||
GHCup -> lift rmGhcup
|
rmHLSVer lVer
|
||||||
|
Cabal -> do
|
||||||
|
printRmTool
|
||||||
|
liftE $ rmCabalVer lVer
|
||||||
|
Stack -> do
|
||||||
|
printRmTool
|
||||||
|
liftE $ rmStackVer lVer
|
||||||
|
GHCup -> do
|
||||||
|
printRmTool
|
||||||
|
lift rmGhcup
|
||||||
|
|
||||||
|
|
||||||
rmGhcupDirs :: ( MonadReader env m
|
rmGhcupDirs :: ( MonadReader env m
|
||||||
@@ -303,7 +312,7 @@ upgradeGHCup mtarget force' fatal = do
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
lift $ logInfo "Upgrading GHCup..."
|
lift $ logInfo "Upgrading GHCup..."
|
||||||
let latestVer = fst (fromJust (getLatest dls GHCup))
|
let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
|
||||||
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
|
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
|
||||||
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
|
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
|
||||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||||
@@ -492,7 +501,7 @@ rmOldGHC :: ( MonadReader env m
|
|||||||
=> Excepts '[NotInstalled, UninstallFailed] m ()
|
=> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||||
rmOldGHC = do
|
rmOldGHC = do
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls
|
let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls
|
||||||
ghcs <- lift $ fmap rights getInstalledGHCs
|
ghcs <- lift $ fmap rights getInstalledGHCs
|
||||||
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
||||||
|
|
||||||
|
|||||||
@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
|
|||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Ord
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( patch )
|
import Data.Versions hiding ( patch )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@@ -280,6 +281,6 @@ rmCabalVer ver = do
|
|||||||
|
|
||||||
when (Just ver == cSet) $ do
|
when (Just ver == cSet) $ do
|
||||||
cVers <- lift $ fmap rights getInstalledCabals
|
cVers <- lift $ fmap rights getInstalledCabals
|
||||||
case headMay . reverse . sort $ cVers of
|
case headMay . sortBy (comparing Down) $ cVers of
|
||||||
Just latestver -> setCabal latestver
|
Just latestver -> setCabal latestver
|
||||||
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)
|
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)
|
||||||
|
|||||||
@@ -5,7 +5,6 @@
|
|||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module : GHCup.Download
|
Module : GHCup.Download
|
||||||
Description : Downloading
|
Description : Downloading
|
||||||
@@ -31,9 +30,11 @@ import GHCup.Download.Utils
|
|||||||
#endif
|
#endif
|
||||||
import GHCup.Errors
|
import GHCup.Errors
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import qualified GHCup.Types.Stack as Stack
|
||||||
import GHCup.Types.Optics
|
import GHCup.Types.Optics
|
||||||
import GHCup.Types.JSON ( )
|
import GHCup.Types.JSON ( )
|
||||||
import GHCup.Utils.Dirs
|
import GHCup.Utils.Dirs
|
||||||
|
import GHCup.Platform
|
||||||
import GHCup.Prelude
|
import GHCup.Prelude
|
||||||
import GHCup.Prelude.File
|
import GHCup.Prelude.File
|
||||||
import GHCup.Prelude.Logger.Internal
|
import GHCup.Prelude.Logger.Internal
|
||||||
@@ -55,6 +56,7 @@ import Data.ByteString ( ByteString )
|
|||||||
import Data.CaseInsensitive ( mk )
|
import Data.CaseInsensitive ( mk )
|
||||||
#endif
|
#endif
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
@@ -112,33 +114,84 @@ getDownloadsF :: ( FromJSONKey Tool
|
|||||||
, MonadFail m
|
, MonadFail m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> Excepts
|
=> PlatformRequest
|
||||||
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
-> Excepts
|
||||||
|
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
|
||||||
m
|
m
|
||||||
GHCupInfo
|
GHCupInfo
|
||||||
getDownloadsF = do
|
getDownloadsF pfreq@(PlatformRequest arch plat _) = do
|
||||||
Settings { urlSource } <- lift getSettings
|
Settings { urlSource } <- lift getSettings
|
||||||
case urlSource of
|
let newUrlSources = fromURLSource urlSource
|
||||||
GHCupURL -> liftE $ getBase ghcupURL
|
infos <- liftE $ mapM dl' newUrlSources
|
||||||
(OwnSource exts) -> do
|
keys <- if any isRight infos
|
||||||
ext <- liftE $ mapM (either pure getBase) exts
|
then liftE . reThrowAll @_ @_ @'[StackPlatformDetectError] StackPlatformDetectError $ getStackPlatformKey pfreq
|
||||||
mergeGhcupInfo ext
|
else pure []
|
||||||
(OwnSpec av) -> pure av
|
ghcupInfos <- fmap catMaybes $ forM infos $ \case
|
||||||
(AddSource exts) -> do
|
Left gi -> pure (Just gi)
|
||||||
base <- liftE $ getBase ghcupURL
|
Right si -> pure $ fromStackSetupInfo si keys
|
||||||
ext <- liftE $ mapM (either pure getBase) exts
|
mergeGhcupInfo ghcupInfos
|
||||||
mergeGhcupInfo (base:ext)
|
|
||||||
|
|
||||||
where
|
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 ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
|
||||||
|
dl' NewStackSetupURL = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo
|
||||||
|
dl' (NewGHCupInfo gi) = pure (Left gi)
|
||||||
|
dl' (NewSetupInfo si) = pure (Right si)
|
||||||
|
dl' (NewURI uri) = do
|
||||||
|
base <- liftE $ getBase uri
|
||||||
|
catchE @JSONError (\(JSONDecodeError _) -> do
|
||||||
|
logDebug $ "Couldn't decode " <> T.pack base <> " as GHCupInfo, trying as SetupInfo: "
|
||||||
|
Right <$> decodeMetadata @Stack.SetupInfo base)
|
||||||
|
$ fmap Left (decodeMetadata @GHCupInfo base >>= \gI -> warnOnMetadataUpdate uri gI >> pure gI)
|
||||||
|
|
||||||
|
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' Nothing)
|
||||||
|
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
|
mergeGhcupInfo :: MonadFail m
|
||||||
=> [GHCupInfo]
|
=> [GHCupInfo]
|
||||||
-> m GHCupInfo
|
-> m GHCupInfo
|
||||||
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
|
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
|
||||||
mergeGhcupInfo xs@(GHCupInfo{}: _) =
|
mergeGhcupInfo xs@(GHCupInfo{}: _) =
|
||||||
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
|
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
|
||||||
newGlobalTools = M.unionsWith (\_ a2 -> a2 ) (_globalTools <$> xs)
|
|
||||||
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
|
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
|
||||||
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
|
in pure $ GHCupInfo newToolReqs newDownloads Nothing
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
|
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
|
||||||
@@ -151,7 +204,7 @@ etagsFile :: FilePath -> FilePath
|
|||||||
etagsFile = (<.> "etags")
|
etagsFile = (<.> "etags")
|
||||||
|
|
||||||
|
|
||||||
getBase :: ( MonadReader env m
|
getBase :: forall m env . ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
@@ -161,7 +214,7 @@ getBase :: ( MonadReader env m
|
|||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
|
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath
|
||||||
getBase uri = do
|
getBase uri = do
|
||||||
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
||||||
|
|
||||||
@@ -181,25 +234,8 @@ getBase uri = do
|
|||||||
$ uri
|
$ uri
|
||||||
|
|
||||||
-- if we didn't get a filepath from the download, use the cached yaml
|
-- if we didn't get a filepath from the download, use the cached yaml
|
||||||
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
maybe (lift $ yamlFromCache uri) pure mYaml
|
||||||
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
|
||||||
|
|
||||||
liftE
|
|
||||||
. onE_ (onError actualYaml)
|
|
||||||
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
|
||||||
. liftIO
|
|
||||||
. Y.decodeFileEither
|
|
||||||
$ actualYaml
|
|
||||||
where
|
where
|
||||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
|
||||||
-- may re-download and succeed.
|
|
||||||
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
|
|
||||||
onError fp = do
|
|
||||||
let efp = etagsFile fp
|
|
||||||
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
|
||||||
(hideError doesNotExistErrorType $ rmFile efp)
|
|
||||||
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
|
||||||
|
|
||||||
warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
|
warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
|
||||||
warnCache s downloader' = do
|
warnCache s downloader' = do
|
||||||
let tryDownloder = case downloader' of
|
let tryDownloder = case downloader' of
|
||||||
@@ -263,10 +299,76 @@ getBase uri = do
|
|||||||
dlWithMod modTime json_file = do
|
dlWithMod modTime json_file = do
|
||||||
let (dir, fn) = splitFileName json_file
|
let (dir, fn) = splitFileName json_file
|
||||||
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
|
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
|
||||||
liftIO $ setModificationTime f modTime
|
|
||||||
liftIO $ setAccessTime f modTime
|
-- 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
|
pure f
|
||||||
|
|
||||||
|
warnOnMetadataUpdate ::
|
||||||
|
( MonadReader env m
|
||||||
|
, MonadIO m
|
||||||
|
, HasLog env
|
||||||
|
, HasDirs env
|
||||||
|
)
|
||||||
|
=> URI
|
||||||
|
-> GHCupInfo
|
||||||
|
-> m ()
|
||||||
|
warnOnMetadataUpdate uri (GHCupInfo { _metadataUpdate = Just newUri })
|
||||||
|
| scheme' uri == "file"
|
||||||
|
, urlBase' uri /= urlBase' newUri = do
|
||||||
|
confFile <- getConfigFilePath'
|
||||||
|
logWarn $ "New metadata version detected"
|
||||||
|
<> "\n old URI: " <> (decUTF8Safe . serializeURIRef') uri
|
||||||
|
<> "\n new URI: " <> (decUTF8Safe . serializeURIRef') newUri
|
||||||
|
<> "\nYou might need to update your " <> T.pack confFile
|
||||||
|
| scheme' uri /= "file"
|
||||||
|
, uri /= newUri = do
|
||||||
|
confFile <- getConfigFilePath'
|
||||||
|
logWarn $ "New metadata version detected"
|
||||||
|
<> "\n old URI: " <> (decUTF8Safe . serializeURIRef') uri
|
||||||
|
<> "\n new URI: " <> (decUTF8Safe . serializeURIRef') newUri
|
||||||
|
<> "\nYou might need to update your " <> T.pack confFile
|
||||||
|
where
|
||||||
|
scheme' = view (uriSchemeL' % schemeBSL')
|
||||||
|
urlBase' = T.unpack . decUTF8Safe . urlBaseName . view pathL'
|
||||||
|
warnOnMetadataUpdate _ _ = pure ()
|
||||||
|
|
||||||
|
|
||||||
|
decodeMetadata :: forall j m env .
|
||||||
|
( MonadReader env m
|
||||||
|
, HasDirs env
|
||||||
|
, HasSettings env
|
||||||
|
, MonadFail m
|
||||||
|
, MonadIO m
|
||||||
|
, MonadCatch m
|
||||||
|
, HasLog env
|
||||||
|
, MonadMask m
|
||||||
|
, FromJSON j
|
||||||
|
)
|
||||||
|
=> FilePath
|
||||||
|
-> Excepts '[JSONError, FileDoesNotExistError] m j
|
||||||
|
decodeMetadata actualYaml = do
|
||||||
|
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||||
|
|
||||||
|
liftE
|
||||||
|
. onE_ (onError actualYaml)
|
||||||
|
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||||
|
. liftIO
|
||||||
|
. Y.decodeFileEither
|
||||||
|
$ actualYaml
|
||||||
|
where
|
||||||
|
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||||
|
-- may re-download and succeed.
|
||||||
|
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
|
||||||
|
onError fp = do
|
||||||
|
let efp = etagsFile fp
|
||||||
|
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
|
||||||
|
(hideError doesNotExistErrorType $ rmFile efp)
|
||||||
|
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
|
||||||
|
|
||||||
|
|
||||||
getDownloadInfo :: ( MonadReader env m
|
getDownloadInfo :: ( MonadReader env m
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
@@ -279,8 +381,21 @@ getDownloadInfo :: ( MonadReader env m
|
|||||||
'[NoDownload]
|
'[NoDownload]
|
||||||
m
|
m
|
||||||
DownloadInfo
|
DownloadInfo
|
||||||
getDownloadInfo t v = do
|
getDownloadInfo t v = getDownloadInfo' t (mkTVer v)
|
||||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
|
||||||
|
getDownloadInfo' :: ( MonadReader env m
|
||||||
|
, HasPlatformReq env
|
||||||
|
, HasGHCupInfo env
|
||||||
|
)
|
||||||
|
=> Tool
|
||||||
|
-> GHCTargetVersion
|
||||||
|
-- ^ tool version
|
||||||
|
-> Excepts
|
||||||
|
'[NoDownload]
|
||||||
|
m
|
||||||
|
DownloadInfo
|
||||||
|
getDownloadInfo' t v = do
|
||||||
|
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
let distro_preview f g =
|
let distro_preview f g =
|
||||||
@@ -301,7 +416,7 @@ getDownloadInfo t v = do
|
|||||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||||
|
|
||||||
maybe
|
maybe
|
||||||
(throwE NoDownload)
|
(throwE $ NoDownload v t (Just pfreq))
|
||||||
pure
|
pure
|
||||||
(case p of
|
(case p of
|
||||||
-- non-musl won't work on alpine
|
-- non-musl won't work on alpine
|
||||||
@@ -310,6 +425,7 @@ getDownloadInfo t v = do
|
|||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Tries to download from the given http or https url
|
-- | Tries to download from the given http or https url
|
||||||
-- and saves the result in continuous memory into a file.
|
-- and saves the result in continuous memory into a file.
|
||||||
-- If the filename is not provided, then we:
|
-- If the filename is not provided, then we:
|
||||||
@@ -629,7 +745,9 @@ downloadCached dli mfn = do
|
|||||||
True -> downloadCached' dli mfn Nothing
|
True -> downloadCached' dli mfn Nothing
|
||||||
False -> do
|
False -> do
|
||||||
tmp <- lift withGHCupTmpDir
|
tmp <- lift withGHCupTmpDir
|
||||||
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
|
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
|
||||||
|
where
|
||||||
|
outputFileName = mfn <|> _dlOutput dli
|
||||||
|
|
||||||
|
|
||||||
downloadCached' :: ( MonadReader env m
|
downloadCached' :: ( MonadReader env m
|
||||||
@@ -648,7 +766,7 @@ downloadCached' :: ( MonadReader env m
|
|||||||
downloadCached' dli mfn mDestDir = do
|
downloadCached' dli mfn mDestDir = do
|
||||||
Dirs { cacheDir } <- lift getDirs
|
Dirs { cacheDir } <- lift getDirs
|
||||||
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
|
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
|
||||||
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
|
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
|
||||||
let cachfile = destDir </> fn
|
let cachfile = destDir </> fn
|
||||||
fileExists <- liftIO $ doesFileExist cachfile
|
fileExists <- liftIO $ doesFileExist cachfile
|
||||||
if
|
if
|
||||||
@@ -656,7 +774,9 @@ downloadCached' dli mfn mDestDir = do
|
|||||||
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
|
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
|
||||||
liftE $ checkDigest (view dlHash dli) cachfile
|
liftE $ checkDigest (view dlHash dli) cachfile
|
||||||
pure cachfile
|
pure cachfile
|
||||||
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
|
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
|
||||||
|
where
|
||||||
|
outputFileName = mfn <|> _dlOutput dli
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -35,7 +35,10 @@ import URI.ByteString
|
|||||||
|
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
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.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 CopyError in format proxy
|
||||||
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
|
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
|
||||||
, let proxy = Proxy :: Proxy TagNotFound in format proxy
|
, let proxy = Proxy :: Proxy TagNotFound in format proxy
|
||||||
|
, let proxy = Proxy :: Proxy DayNotFound in format proxy
|
||||||
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
|
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
|
||||||
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
|
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
|
||||||
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
|
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
|
||||||
@@ -82,6 +86,8 @@ allHFError = unlines allErrors
|
|||||||
, let proxy = Proxy :: Proxy HadrianNotFound in format proxy
|
, let proxy = Proxy :: Proxy HadrianNotFound in format proxy
|
||||||
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
|
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
|
||||||
, let proxy = Proxy :: Proxy ContentLengthError 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+)"
|
, "# high level errors (4000+)"
|
||||||
, let proxy = Proxy :: Proxy DownloadFailed in format proxy
|
, 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 ParseError in format proxy
|
||||||
, let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
|
, let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
|
||||||
, let proxy = Proxy :: Proxy NoUrlBase in format proxy
|
, let proxy = Proxy :: Proxy NoUrlBase in format proxy
|
||||||
|
, let proxy = Proxy :: Proxy DigestMissing in format proxy
|
||||||
, ""
|
, ""
|
||||||
, "# orphans (800+)"
|
, "# orphans (800+)"
|
||||||
, let proxy = Proxy :: Proxy URIParseError in format proxy
|
, let proxy = Proxy :: Proxy URIParseError in format proxy
|
||||||
@@ -201,12 +208,24 @@ instance HFErrorProject NoCompatiblePlatform where
|
|||||||
eDesc _ = "No compatible platform could be found"
|
eDesc _ = "No compatible platform could be found"
|
||||||
|
|
||||||
-- | Unable to find a download for the requested version/distro.
|
-- | Unable to find a download for the requested version/distro.
|
||||||
data NoDownload = NoDownload
|
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty NoDownload where
|
instance Pretty NoDownload where
|
||||||
pPrint NoDownload =
|
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
|
||||||
text (eDesc (Proxy :: Proxy NoDownload))
|
| (Just target) <- mtarget
|
||||||
|
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
|
||||||
|
= text $ "Unable to find a download for "
|
||||||
|
<> show tool
|
||||||
|
<> " version '"
|
||||||
|
<> T.unpack (tVerToText tver)
|
||||||
|
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
|
||||||
|
<> "Perhaps you meant: 'ghcup <command> "
|
||||||
|
<> T.unpack target
|
||||||
|
<> " "
|
||||||
|
<> T.unpack (prettyVer vv)
|
||||||
|
<> "'"
|
||||||
|
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
|
||||||
|
|
||||||
instance HFErrorProject NoDownload where
|
instance HFErrorProject NoDownload where
|
||||||
eBase _ = 10
|
eBase _ = 10
|
||||||
@@ -308,6 +327,21 @@ instance HFErrorProject TagNotFound where
|
|||||||
eBase _ = 90
|
eBase _ = 90
|
||||||
eDesc _ = "Unable to find a tag of a tool"
|
eDesc _ = "Unable to find a tag of a tool"
|
||||||
|
|
||||||
|
-- | Unable to find a release day of a tool
|
||||||
|
data DayNotFound = DayNotFound Day Tool (Maybe Day)
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance Pretty DayNotFound where
|
||||||
|
pPrint (DayNotFound day tool Nothing) =
|
||||||
|
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
|
||||||
|
pPrint (DayNotFound day tool (Just alternateDay)) =
|
||||||
|
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
|
||||||
|
text "but found an alternative date" <+> text (show alternateDay)
|
||||||
|
|
||||||
|
instance HFErrorProject DayNotFound where
|
||||||
|
eBase _ = 95
|
||||||
|
eDesc _ = "Unable to find a release date of a tool"
|
||||||
|
|
||||||
-- | Unable to find the next version of a tool (the one after the currently
|
-- | Unable to find the next version of a tool (the one after the currently
|
||||||
-- set one).
|
-- set one).
|
||||||
data NextVerNotFound = NextVerNotFound Tool
|
data NextVerNotFound = NextVerNotFound Tool
|
||||||
@@ -640,6 +674,30 @@ instance HFErrorProject ContentLengthError where
|
|||||||
eBase _ = 340
|
eBase _ = 340
|
||||||
eDesc _ = "File content length verification failed"
|
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 ]--
|
--[ High-level errors ]--
|
||||||
-------------------------
|
-------------------------
|
||||||
@@ -664,7 +722,7 @@ data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorPr
|
|||||||
|
|
||||||
instance Pretty InstallSetError where
|
instance Pretty InstallSetError where
|
||||||
pPrint (InstallSetError reason1 reason2) =
|
pPrint (InstallSetError reason1 reason2) =
|
||||||
text "Both installation and setting the tool failed. Install error was:"
|
text "Both installation and setting the tool failed.\nInstall error was:"
|
||||||
<+> pPrint reason1
|
<+> pPrint reason1
|
||||||
<+> text "\nSet error was:"
|
<+> text "\nSet error was:"
|
||||||
<+> pPrint reason2
|
<+> pPrint reason2
|
||||||
@@ -727,6 +785,22 @@ instance HFErrorProject GHCupSetError where
|
|||||||
eNum (GHCupSetError xs) = 9000 + eNum xs
|
eNum (GHCupSetError xs) = 9000 + eNum xs
|
||||||
eDesc _ = "Setting the current version failed."
|
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) ]--
|
--[ True Exceptions (e.g. for MonadThrow) ]--
|
||||||
@@ -774,6 +848,18 @@ instance HFErrorProject NoUrlBase where
|
|||||||
eBase _ = 520
|
eBase _ = 520
|
||||||
eDesc _ = "URL does not have a base filename."
|
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."
|
||||||
|
|
||||||
|
|
||||||
------------------------
|
------------------------
|
||||||
|
|||||||
323
lib/GHCup/GHC.hs
323
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.Base16 as B16
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
|
|
||||||
|
|
||||||
data GHCVer v = SourceDist v
|
data GHCVer = SourceDist Version
|
||||||
| GitDist GitBranch
|
| GitDist GitBranch
|
||||||
| RemoteDist URI
|
| RemoteDist URI
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -105,7 +107,7 @@ testGHCVer :: ( MonadFail m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version
|
=> GHCTargetVersion
|
||||||
-> [T.Text]
|
-> [T.Text]
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ DigestError
|
'[ DigestError
|
||||||
@@ -125,7 +127,7 @@ testGHCVer ver addMakeArgs = do
|
|||||||
|
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload ver GHC Nothing
|
||||||
|
|
||||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||||
|
|
||||||
@@ -145,7 +147,7 @@ testGHCBindist :: ( MonadFail m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> DownloadInfo
|
=> DownloadInfo
|
||||||
-> Version
|
-> GHCTargetVersion
|
||||||
-> [T.Text]
|
-> [T.Text]
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ DigestError
|
'[ DigestError
|
||||||
@@ -182,7 +184,7 @@ testPackedGHC :: ( MonadMask m
|
|||||||
)
|
)
|
||||||
=> FilePath -- ^ Path to the packed GHC bindist
|
=> FilePath -- ^ Path to the packed GHC bindist
|
||||||
-> Maybe TarDir -- ^ Subdir of the archive
|
-> Maybe TarDir -- ^ Subdir of the archive
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> [T.Text] -- ^ additional make args
|
-> [T.Text] -- ^ additional make args
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
|
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
|
||||||
@@ -208,19 +210,23 @@ testUnpackedGHC :: ( MonadReader env m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
|
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
-> Excepts '[ProcessError] m ()
|
-> Excepts '[ProcessError] m ()
|
||||||
testUnpackedGHC path ver addMakeArgs = do
|
testUnpackedGHC path tver addMakeArgs = do
|
||||||
lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!"
|
lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
|
||||||
ghcDir <- lift $ ghcupGHCDir (mkTVer ver)
|
ghcDir <- lift $ ghcupGHCDir tver
|
||||||
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
|
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
|
||||||
env <- liftIO $ addToPath ghcBinDir False
|
env <- liftIO $ addToPath [ghcBinDir] False
|
||||||
|
let pathVar = if isWindows then "Path" else "PATH"
|
||||||
|
forM_ (Map.lookup pathVar . Map.fromList $ env) $ liftIO . setEnv pathVar
|
||||||
|
|
||||||
lEM $ make' (fmap T.unpack addMakeArgs)
|
lEM $ make' (fmap T.unpack addMakeArgs)
|
||||||
(Just $ fromGHCupPath path)
|
(Just $ fromGHCupPath path)
|
||||||
"ghc-test"
|
"ghc-test"
|
||||||
(Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env)
|
(Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver)
|
||||||
|
<> "ghc-"
|
||||||
|
<> T.unpack (prettyVer $ _tvVersion tver)) : env)
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
@@ -243,7 +249,7 @@ fetchGHCSrc :: ( MonadFail m
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> Version
|
=> GHCTargetVersion
|
||||||
-> Maybe FilePath
|
-> Maybe FilePath
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ DigestError
|
'[ DigestError
|
||||||
@@ -258,7 +264,7 @@ fetchGHCSrc v mfp = do
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload v GHC Nothing
|
||||||
liftE $ downloadCached' dlInfo Nothing mfp
|
liftE $ downloadCached' dlInfo Nothing mfp
|
||||||
|
|
||||||
|
|
||||||
@@ -283,7 +289,7 @@ installGHCBindist :: ( MonadFail m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
)
|
)
|
||||||
=> DownloadInfo -- ^ where/how to download
|
=> DownloadInfo -- ^ where/how to download
|
||||||
-> Version -- ^ the version to install
|
-> GHCTargetVersion -- ^ the version to install
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Bool -- ^ Force install
|
-> Bool -- ^ Force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
@@ -306,10 +312,8 @@ installGHCBindist :: ( MonadFail m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
|
||||||
let tver = mkTVer ver
|
lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
|
||||||
|
|
||||||
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
|
|
||||||
|
|
||||||
regularGHCInstalled <- lift $ ghcInstalled tver
|
regularGHCInstalled <- lift $ ghcInstalled tver
|
||||||
|
|
||||||
@@ -317,7 +321,7 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
|||||||
| not forceInstall
|
| not forceInstall
|
||||||
, regularGHCInstalled
|
, regularGHCInstalled
|
||||||
, GHCupInternal <- installDir -> do
|
, GHCupInternal <- installDir -> do
|
||||||
throwE $ AlreadyInstalled GHC ver
|
throwE $ AlreadyInstalled GHC (_tvVersion tver)
|
||||||
|
|
||||||
| forceInstall
|
| forceInstall
|
||||||
, regularGHCInstalled
|
, regularGHCInstalled
|
||||||
@@ -336,12 +340,12 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
|
|||||||
case installDir of
|
case installDir of
|
||||||
IsolateDir isoDir -> do -- isolated install
|
IsolateDir isoDir -> do -- isolated install
|
||||||
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
|
||||||
GHCupInternal -> do -- regular install
|
GHCupInternal -> do -- regular install
|
||||||
-- prepare paths
|
-- prepare paths
|
||||||
ghcdir <- lift $ ghcupGHCDir tver
|
ghcdir <- lift $ ghcupGHCDir tver
|
||||||
|
|
||||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
|
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
|
||||||
|
|
||||||
-- make symlinks & stuff when regular install,
|
-- make symlinks & stuff when regular install,
|
||||||
liftE $ postGHCInstall tver
|
liftE $ postGHCInstall tver
|
||||||
@@ -375,7 +379,7 @@ installPackedGHC :: ( MonadMask m
|
|||||||
=> FilePath -- ^ Path to the packed GHC bindist
|
=> FilePath -- ^ Path to the packed GHC bindist
|
||||||
-> Maybe TarDir -- ^ Subdir of the archive
|
-> Maybe TarDir -- ^ Subdir of the archive
|
||||||
-> InstallDirResolved
|
-> InstallDirResolved
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> Bool -- ^ Force install
|
-> Bool -- ^ Force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
-> Excepts
|
-> Excepts
|
||||||
@@ -423,26 +427,22 @@ installUnpackedGHC :: ( MonadReader env m
|
|||||||
)
|
)
|
||||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
|
||||||
-> InstallDirResolved -- ^ Path to install to
|
-> InstallDirResolved -- ^ Path to install to
|
||||||
-> Version -- ^ The GHC version
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
-> Bool -- ^ Force install
|
-> Bool -- ^ Force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
-> Excepts '[ProcessError, MergeFileTreeError] m ()
|
-> Excepts '[ProcessError, MergeFileTreeError] m ()
|
||||||
installUnpackedGHC path inst ver forceInstall addConfArgs
|
installUnpackedGHC path inst tver forceInstall addConfArgs
|
||||||
| isWindows = do
|
| isWindows = do
|
||||||
lift $ logInfo "Installing GHC (this may take a while)"
|
lift $ logInfo "Installing GHC (this may take a while)"
|
||||||
-- Windows bindists are relocatable and don't need
|
-- Windows bindists are relocatable and don't need
|
||||||
-- to run configure.
|
-- to run configure.
|
||||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||||
liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> do
|
liftE $ mergeGHCFileTree path inst tver forceInstall
|
||||||
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
|
|
||||||
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
|
|
||||||
liftIO $ moveFilePortable source dest
|
|
||||||
forM_ mtime $ liftIO . setModificationTime dest
|
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
|
|
||||||
let ldOverride
|
let ldOverride
|
||||||
| ver >= [vver|8.2.2|]
|
| _tvVersion tver >= [vver|8.2.2|]
|
||||||
, _rPlatform `elem` [Linux Alpine, Darwin]
|
, _rPlatform `elem` [Linux Alpine, Darwin]
|
||||||
= ["--disable-ld-override"]
|
= ["--disable-ld-override"]
|
||||||
| otherwise
|
| otherwise
|
||||||
@@ -451,7 +451,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
|||||||
lift $ logInfo "Installing GHC (this may take a while)"
|
lift $ logInfo "Installing GHC (this may take a while)"
|
||||||
lEM $ execLogged "sh"
|
lEM $ execLogged "sh"
|
||||||
("./configure" : ("--prefix=" <> fromInstallDir inst)
|
("./configure" : ("--prefix=" <> fromInstallDir inst)
|
||||||
: (ldOverride <> (T.unpack <$> addConfArgs))
|
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
|
||||||
)
|
)
|
||||||
(Just $ fromGHCupPath path)
|
(Just $ fromGHCupPath path)
|
||||||
"ghc-configure"
|
"ghc-configure"
|
||||||
@@ -459,17 +459,44 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
|
|||||||
tmpInstallDest <- lift withGHCupTmpDir
|
tmpInstallDest <- lift withGHCupTmpDir
|
||||||
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
|
||||||
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
|
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
|
mergeGHCFileTree :: ( MonadReader env m
|
||||||
|
, HasPlatformReq env
|
||||||
|
, HasDirs env
|
||||||
|
, HasSettings env
|
||||||
|
, MonadThrow m
|
||||||
|
, HasLog env
|
||||||
|
, MonadIO m
|
||||||
|
, MonadUnliftIO m
|
||||||
|
, MonadMask m
|
||||||
|
, MonadResource m
|
||||||
|
, MonadFail m
|
||||||
|
)
|
||||||
|
=> GHCupPath -- ^ Path to the root of the tree
|
||||||
|
-> InstallDirResolved -- ^ Path to install to
|
||||||
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
|
-> Bool -- ^ Force install
|
||||||
|
-> Excepts '[MergeFileTreeError] m ()
|
||||||
|
mergeGHCFileTree root inst tver forceInstall
|
||||||
|
| isWindows = do
|
||||||
|
liftE $ mergeFileTree root inst GHC tver $ \source dest -> do
|
||||||
|
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
|
||||||
|
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
|
||||||
|
liftIO $ moveFilePortable source dest
|
||||||
|
forM_ mtime $ liftIO . setModificationTime dest
|
||||||
|
| otherwise = do
|
||||||
|
liftE $ mergeFileTree root
|
||||||
inst
|
inst
|
||||||
GHC
|
GHC
|
||||||
(mkTVer ver)
|
tver
|
||||||
(\f t -> liftIO $ do
|
(\f t -> liftIO $ do
|
||||||
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
|
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
|
||||||
install f t (not forceInstall)
|
install f t (not forceInstall)
|
||||||
forM_ mtime $ setModificationTime t)
|
forM_ mtime $ setModificationTime t)
|
||||||
|
|
||||||
pure ()
|
|
||||||
|
|
||||||
|
|
||||||
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
||||||
-- following symlinks in @~\/.ghcup\/bin@:
|
-- following symlinks in @~\/.ghcup\/bin@:
|
||||||
@@ -488,8 +515,9 @@ installGHCBin :: ( MonadFail m
|
|||||||
, MonadResource m
|
, MonadResource m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
|
, Alternative m
|
||||||
)
|
)
|
||||||
=> Version -- ^ the version to install
|
=> GHCTargetVersion -- ^ the version to install
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Bool -- ^ force install
|
-> Bool -- ^ force install
|
||||||
-> [T.Text] -- ^ additional configure args for bindist
|
-> [T.Text] -- ^ additional configure args for bindist
|
||||||
@@ -509,12 +537,17 @@ installGHCBin :: ( MonadFail m
|
|||||||
, ProcessError
|
, ProcessError
|
||||||
, UninstallFailed
|
, UninstallFailed
|
||||||
, MergeFileTreeError
|
, MergeFileTreeError
|
||||||
|
, NoCompatiblePlatform
|
||||||
|
, ParseError
|
||||||
|
, UnsupportedSetupCombo
|
||||||
|
, DistroNotFound
|
||||||
|
, NoCompatibleArch
|
||||||
]
|
]
|
||||||
m
|
m
|
||||||
()
|
()
|
||||||
installGHCBin ver installDir forceInstall addConfArgs = do
|
installGHCBin tver installDir forceInstall addConfArgs = do
|
||||||
dlinfo <- liftE $ getDownloadInfo GHC ver
|
dlinfo <- liftE $ getDownloadInfo' GHC tver
|
||||||
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
|
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -708,7 +741,7 @@ rmGHCVer ver = do
|
|||||||
Just files -> do
|
Just files -> do
|
||||||
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
||||||
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
||||||
removeEmptyDirsRecursive dir
|
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
|
||||||
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
||||||
f <- recordedInstallationFile GHC ver
|
f <- recordedInstallationFile GHC ver
|
||||||
lift $ recycleFile f
|
lift $ recycleFile f
|
||||||
@@ -730,7 +763,8 @@ rmGHCVer ver = do
|
|||||||
|
|
||||||
Dirs {..} <- lift getDirs
|
Dirs {..} <- lift getDirs
|
||||||
|
|
||||||
lift $ hideError doesNotExistErrorType $ rmDirectoryLink (fromGHCupPath baseDir </> "share")
|
when isSetGHC $ do
|
||||||
|
lift $ hideError doesNotExistErrorType $ rmDirectoryLink (fromGHCupPath baseDir </> "share")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -755,7 +789,8 @@ compileGHC :: ( MonadMask m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> GHCVer GHCTargetVersion
|
=> GHCVer
|
||||||
|
-> Maybe Text -- ^ cross target
|
||||||
-> Maybe Version -- ^ overwrite version
|
-> Maybe Version -- ^ overwrite version
|
||||||
-> Either Version FilePath -- ^ version to bootstrap with
|
-> Either Version FilePath -- ^ version to bootstrap with
|
||||||
-> Maybe Int -- ^ jobs
|
-> Maybe Int -- ^ jobs
|
||||||
@@ -763,7 +798,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Maybe BuildSystem
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
@@ -792,20 +827,21 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
|
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||||
-- unpack from version tarball
|
-- unpack from version tarball
|
||||||
SourceDist tver -> do
|
SourceDist ver -> do
|
||||||
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
|
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
|
let tver = mkTVer ver
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
|
preview (ix GHC % ix tver % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload tver GHC (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@@ -818,7 +854,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, Just tver)
|
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
|
||||||
|
|
||||||
RemoteDist uri -> do
|
RemoteDist uri -> do
|
||||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||||
@@ -842,7 +878,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, mkTVer <$> tver)
|
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||||
|
|
||||||
-- clone from git
|
-- clone from git
|
||||||
GitDist GitBranch{..} -> do
|
GitDist GitBranch{..} -> do
|
||||||
@@ -899,12 +935,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
pure tver
|
pure tver
|
||||||
|
|
||||||
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
|
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||||
-- the version that's installed may differ from the
|
-- the version that's installed may differ from the
|
||||||
-- compiled version, so the user can overwrite it
|
-- compiled version, so the user can overwrite it
|
||||||
installVer <- if | Just ov' <- ov -> pure (mkTVer ov')
|
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
||||||
| Just tver' <- tver -> pure tver'
|
| Just tver' <- tver -> pure tver'
|
||||||
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
|
| otherwise -> fail "No GHC version given and couldn't detect version. Giving up..."
|
||||||
|
|
||||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||||
@@ -923,16 +959,31 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
||||||
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
||||||
|
|
||||||
(mBindist, bmk) <- liftE $ runBuildAction
|
mBindist <- liftE $ runBuildAction
|
||||||
tmpUnpack
|
tmpUnpack
|
||||||
(do
|
(do
|
||||||
b <- if hadrian
|
-- prefer 'tver', because the real version carries out compatibility checks
|
||||||
-- prefer 'tver', because the real version carries out compatibility checks
|
-- we don't want the user to do funny things with it
|
||||||
-- we don't want the user to do funny things with it
|
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
case buildSystem of
|
||||||
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
Just Hadrian -> do
|
||||||
pure (b, bmk)
|
lift $ logInfo "Requested to use Hadrian"
|
||||||
|
liftE doHadrian
|
||||||
|
Just Make -> do
|
||||||
|
lift $ logInfo "Requested to use Make"
|
||||||
|
doMake
|
||||||
|
Nothing -> do
|
||||||
|
supportsHadrian <- liftE $ catchE @HadrianNotFound @'[HadrianNotFound] @'[] (\_ -> return False)
|
||||||
|
$ fmap (const True)
|
||||||
|
$ findHadrianFile (fromGHCupPath workdir)
|
||||||
|
if supportsHadrian
|
||||||
|
then do
|
||||||
|
lift $ logInfo "Detected Hadrian"
|
||||||
|
liftE doHadrian
|
||||||
|
else do
|
||||||
|
lift $ logInfo "Detected Make"
|
||||||
|
doMake
|
||||||
)
|
)
|
||||||
|
|
||||||
case installDir of
|
case installDir of
|
||||||
@@ -948,12 +999,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
liftE $ installPackedGHC bindist
|
liftE $ installPackedGHC bindist
|
||||||
(Just $ RegexDir "ghc-.*")
|
(Just $ RegexDir "ghc-.*")
|
||||||
ghcdir
|
ghcdir
|
||||||
(installVer ^. tvVersion)
|
installVer
|
||||||
False -- not a force install, since we already overwrite when compiling.
|
False -- not a force install, since we already overwrite when compiling.
|
||||||
[]
|
[]
|
||||||
|
|
||||||
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
|
|
||||||
|
|
||||||
case installDir of
|
case installDir of
|
||||||
-- set and make symlinks for regular (non-isolated) installs
|
-- set and make symlinks for regular (non-isolated) installs
|
||||||
GHCupInternal -> do
|
GHCupInternal -> do
|
||||||
@@ -976,20 +1025,29 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
=> GHCupPath
|
=> GHCupPath
|
||||||
-> Excepts '[ProcessError, ParseError] m Version
|
-> Excepts '[ProcessError, ParseError] m Version
|
||||||
getGHCVer tmpUnpack = do
|
getGHCVer tmpUnpack = do
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
|
||||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
CapturedProcess {..} <- lift $ makeOut
|
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
|
||||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
hasVersionFile <- liftIO $ doesFileExist versionFile
|
||||||
case _exitCode of
|
if hasVersionFile
|
||||||
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
then do
|
||||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
lift $ logDebug "Detected VERSION file, trying to extract"
|
||||||
|
contents <- liftIO $ readFile versionFile
|
||||||
|
either (throwE . ParseError . show) pure . MP.parse version' "" . T.pack . stripNewlineEnd $ contents
|
||||||
|
else do
|
||||||
|
lift $ logDebug "Didn't detect VERSION file, trying to extract via legacy 'make'"
|
||||||
|
CapturedProcess {..} <- lift $ makeOut
|
||||||
|
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||||
|
case _exitCode of
|
||||||
|
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||||
|
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
||||||
|
|
||||||
defaultConf =
|
defaultConf =
|
||||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
||||||
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
||||||
in case targetGhc of
|
in case crossTarget of
|
||||||
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
|
Just _ -> cross_mk
|
||||||
_ -> default_mk
|
_ -> default_mk
|
||||||
|
|
||||||
compileHadrianBindist :: ( MonadReader env m
|
compileHadrianBindist :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
@@ -1015,18 +1073,17 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
m
|
m
|
||||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||||
compileHadrianBindist tver workdir ghcdir = do
|
compileHadrianBindist tver workdir ghcdir = do
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just workdir) "ghc-bootstrap"
|
|
||||||
|
|
||||||
liftE $ configureBindist tver workdir ghcdir
|
liftE $ configureBindist tver workdir ghcdir
|
||||||
|
|
||||||
lift $ logInfo "Building (this may take a while)..."
|
lift $ logInfo "Building (this may take a while)..."
|
||||||
hadrian_build <- liftE $ findHadrianFile workdir
|
hadrian_build <- liftE $ findHadrianFile workdir
|
||||||
lEM $ execWithGhcEnv hadrian_build
|
lEM $ execLogged hadrian_build
|
||||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||||
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
||||||
++ ["binary-dist"]
|
++ ["binary-dist"]
|
||||||
)
|
)
|
||||||
(Just workdir) "ghc-make"
|
(Just workdir) "ghc-make"
|
||||||
|
Nothing
|
||||||
[tar] <- liftIO $ findFiles
|
[tar] <- liftIO $ findFiles
|
||||||
(workdir </> "_build" </> "bindist")
|
(workdir </> "_build" </> "bindist")
|
||||||
(makeRegexOpts compExtended
|
(makeRegexOpts compExtended
|
||||||
@@ -1059,6 +1116,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
|
, MonadMask m
|
||||||
|
, MonadUnliftIO m
|
||||||
|
, MonadResource m
|
||||||
)
|
)
|
||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> FilePath
|
-> FilePath
|
||||||
@@ -1070,6 +1130,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
, PatchFailed
|
, PatchFailed
|
||||||
, ProcessError
|
, ProcessError
|
||||||
, NotFoundInPATH
|
, NotFoundInPATH
|
||||||
|
, MergeFileTreeError
|
||||||
, CopyError]
|
, CopyError]
|
||||||
m
|
m
|
||||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||||
@@ -1091,7 +1152,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
|
|
||||||
if | isCross tver -> do
|
if | isCross tver -> do
|
||||||
lift $ logInfo "Installing cross toolchain..."
|
lift $ logInfo "Installing cross toolchain..."
|
||||||
lEM $ make ["install"] (Just workdir)
|
tmpInstallDest <- lift withGHCupTmpDir
|
||||||
|
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just workdir)
|
||||||
|
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir ghcdir)) ghcdir tver True
|
||||||
pure Nothing
|
pure Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
lift $ logInfo "Creating bindist..."
|
lift $ logInfo "Creating bindist..."
|
||||||
@@ -1164,8 +1227,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
|
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
|
||||||
|
|
||||||
-- for cross, we need Stage1Only
|
-- for cross, we need Stage1Only
|
||||||
case targetGhc of
|
case crossTarget of
|
||||||
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
|
||||||
(InvalidBuildConfig
|
(InvalidBuildConfig
|
||||||
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
|
||||||
)
|
)
|
||||||
@@ -1209,64 +1272,50 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
()
|
()
|
||||||
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
||||||
lift $ logInfo [s|configuring build|]
|
lift $ logInfo [s|configuring build|]
|
||||||
|
lEM $ configureWithGhcBoot (Just tver)
|
||||||
if | _tvVersion tver >= [vver|8.8.0|] -> do
|
(maybe mempty
|
||||||
lEM $ execWithGhcEnv
|
(\x -> ["--target=" <> T.unpack x])
|
||||||
"sh"
|
(_tvTarget tver)
|
||||||
("./configure" : maybe mempty
|
++ ["--prefix=" <> ghcdir]
|
||||||
(\x -> ["--target=" <> T.unpack x])
|
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||||
(_tvTarget tver)
|
++ fmap T.unpack aargs
|
||||||
++ ["--prefix=" <> ghcdir]
|
)
|
||||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
(Just workdir)
|
||||||
++ fmap T.unpack aargs
|
"ghc-conf"
|
||||||
)
|
|
||||||
(Just workdir)
|
|
||||||
"ghc-conf"
|
|
||||||
| otherwise -> do
|
|
||||||
lEM $ execLogged
|
|
||||||
"sh"
|
|
||||||
( [ "./configure", "--with-ghc=" <> either id id bghc
|
|
||||||
]
|
|
||||||
++ maybe mempty
|
|
||||||
(\x -> ["--target=" <> T.unpack x])
|
|
||||||
(_tvTarget tver)
|
|
||||||
++ ["--prefix=" <> ghcdir]
|
|
||||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
|
||||||
++ fmap T.unpack aargs
|
|
||||||
)
|
|
||||||
(Just workdir)
|
|
||||||
"ghc-conf"
|
|
||||||
Nothing
|
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
execWithGhcEnv :: ( MonadReader env m
|
configureWithGhcBoot :: ( MonadReader env m
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m)
|
, MonadThrow m)
|
||||||
=> FilePath -- ^ thing to execute
|
=> Maybe GHCTargetVersion
|
||||||
-> [String] -- ^ args for the thing
|
-> [String] -- ^ args for configure
|
||||||
-> Maybe FilePath -- ^ optionally chdir into this
|
-> Maybe FilePath -- ^ optionally chdir into this
|
||||||
-> FilePath -- ^ log filename (opened in append mode)
|
-> FilePath -- ^ log filename (opened in append mode)
|
||||||
-> m (Either ProcessError ())
|
-> m (Either ProcessError ())
|
||||||
execWithGhcEnv fp args dir logf = do
|
configureWithGhcBoot mtver args dir logf = do
|
||||||
env <- ghcEnv
|
let execNew = execLogged
|
||||||
execLogged fp args dir logf (Just env)
|
"sh"
|
||||||
|
("./configure" : ("GHC=" <> bghc) : args)
|
||||||
|
dir
|
||||||
|
logf
|
||||||
|
Nothing
|
||||||
|
execOld = execLogged
|
||||||
|
"sh"
|
||||||
|
("./configure" : ("--with-ghc=" <> bghc) : args)
|
||||||
|
dir
|
||||||
|
logf
|
||||||
|
Nothing
|
||||||
|
if | Just tver <- mtver
|
||||||
|
, _tvVersion tver >= [vver|8.8.0|] -> execNew
|
||||||
|
| Nothing <- mtver -> execNew -- need some default for git checkouts where we don't know yet
|
||||||
|
| otherwise -> execOld
|
||||||
|
|
||||||
bghc = case bstrap of
|
bghc = case bstrap of
|
||||||
Right g -> Right g
|
Right g -> g
|
||||||
Left bver -> Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt
|
||||||
|
|
||||||
ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
|
|
||||||
ghcEnv = do
|
|
||||||
cEnv <- liftIO getEnvironment
|
|
||||||
bghcPath <- case bghc of
|
|
||||||
Right ghc' -> pure ghc'
|
|
||||||
Left bver -> do
|
|
||||||
spaths <- liftIO getSearchPath
|
|
||||||
throwMaybeM (NotFoundInPATH bver) $ liftIO (searchPath spaths bver)
|
|
||||||
pure (("GHC", bghcPath) : cEnv)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -43,6 +43,7 @@ import Control.Monad.Trans.Resource
|
|||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Ord
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String ( fromString )
|
import Data.String ( fromString )
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
@@ -74,6 +75,7 @@ data HLSVer = SourceDist Version
|
|||||||
| GitDist GitBranch
|
| GitDist GitBranch
|
||||||
| HackageDist Version
|
| HackageDist Version
|
||||||
| RemoteDist URI
|
| RemoteDist URI
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -353,7 +355,7 @@ compileHLS :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] m Version
|
||||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
Dirs { .. } <- lift getDirs
|
Dirs { .. } <- lift getDirs
|
||||||
|
|
||||||
@@ -368,8 +370,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix HLS % ix tver % viSourceDL % _Just) dls
|
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload (mkTVer tver) HLS (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@@ -704,7 +706,7 @@ rmHLSVer ver = do
|
|||||||
when (Just ver == isHlsSet) $ do
|
when (Just ver == isHlsSet) $ do
|
||||||
-- set latest hls
|
-- set latest hls
|
||||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||||
case headMay . reverse . sort $ hlsVers of
|
case headMay . sortBy (comparing Down) $ hlsVers of
|
||||||
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
|
||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
|
|
||||||
@@ -715,8 +717,10 @@ getCabalVersion fp = do
|
|||||||
gpd <- case parseGenericPackageDescriptionMaybe contents of
|
gpd <- case parseGenericPackageDescriptionMaybe contents of
|
||||||
Nothing -> fail $ "could not parse cabal file: " <> fp
|
Nothing -> fail $ "could not parse cabal file: " <> fp
|
||||||
Just r -> pure r
|
Just r -> pure r
|
||||||
let tver = (\c -> Version Nothing c [] Nothing)
|
let tver = (\c -> Version Nothing c Nothing Nothing)
|
||||||
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
|
. Chunks
|
||||||
|
. NE.fromList
|
||||||
|
. fmap (Numeric . fromIntegral)
|
||||||
. versionNumbers
|
. versionNumbers
|
||||||
. pkgVersion
|
. pkgVersion
|
||||||
. package
|
. package
|
||||||
|
|||||||
@@ -36,6 +36,7 @@ import Data.Either
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
import Data.Versions hiding ( patch )
|
import Data.Versions hiding ( patch )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics
|
||||||
@@ -61,10 +62,10 @@ import qualified Data.Text as T
|
|||||||
|
|
||||||
|
|
||||||
-- | Filter data type for 'listVersions'.
|
-- | Filter data type for 'listVersions'.
|
||||||
data ListCriteria = ListInstalled
|
data ListCriteria = ListInstalled Bool
|
||||||
| ListSet
|
| ListSet Bool
|
||||||
| ListAvailable
|
| ListAvailable Bool
|
||||||
deriving Show
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | A list result describes a single tool version
|
-- | A list result describes a single tool version
|
||||||
-- and various of its properties.
|
-- and various of its properties.
|
||||||
@@ -75,16 +76,16 @@ data ListResult = ListResult
|
|||||||
, lTag :: [Tag]
|
, lTag :: [Tag]
|
||||||
, lInstalled :: Bool
|
, lInstalled :: Bool
|
||||||
, lSet :: Bool -- ^ currently active version
|
, lSet :: Bool -- ^ currently active version
|
||||||
, fromSrc :: Bool -- ^ compiled from source
|
|
||||||
, lStray :: Bool -- ^ not in download info
|
, lStray :: Bool -- ^ not in download info
|
||||||
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
||||||
, hlsPowered :: Bool
|
, hlsPowered :: Bool
|
||||||
|
, lReleaseDay :: Maybe Day
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
|
||||||
-- | Extract all available tool versions and their tags.
|
-- | Extract all available tool versions and their tags.
|
||||||
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
|
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo
|
||||||
availableToolVersions av tool = view
|
availableToolVersions av tool = view
|
||||||
(at tool % non Map.empty)
|
(at tool % non Map.empty)
|
||||||
av
|
av
|
||||||
@@ -93,19 +94,22 @@ availableToolVersions av tool = view
|
|||||||
-- | List all versions from the download info, as well as stray
|
-- | List all versions from the download info, as well as stray
|
||||||
-- versions.
|
-- versions.
|
||||||
listVersions :: ( MonadCatch m
|
listVersions :: ( MonadCatch m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasPlatformReq env
|
, HasPlatformReq env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
)
|
)
|
||||||
=> Maybe Tool
|
=> Maybe Tool
|
||||||
-> Maybe ListCriteria
|
-> [ListCriteria]
|
||||||
-> m [ListResult]
|
-> Bool
|
||||||
listVersions lt' criteria = do
|
-> Bool
|
||||||
|
-> (Maybe Day, Maybe Day)
|
||||||
|
-> m [ListResult]
|
||||||
|
listVersions lt' criteria hideOld showNightly days = do
|
||||||
-- some annoying work to avoid too much repeated IO
|
-- some annoying work to avoid too much repeated IO
|
||||||
cSet <- cabalSet
|
cSet <- cabalSet
|
||||||
cabals <- getInstalledCabals
|
cabals <- getInstalledCabals
|
||||||
@@ -129,13 +133,13 @@ listVersions lt' criteria = do
|
|||||||
slr <- strayGHCs avTools
|
slr <- strayGHCs avTools
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
slr <- strayCabals avTools cSet cabals
|
slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
HLS -> do
|
HLS -> do
|
||||||
slr <- strayHLS avTools hlsSet' hlses
|
slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
Stack -> do
|
Stack -> do
|
||||||
slr <- strayStacks avTools sSet stacks
|
slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks
|
||||||
pure (sort (slr ++ lr))
|
pure (sort (slr ++ lr))
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let cg = maybeToList $ currentGHCup avTools
|
let cg = maybeToList $ currentGHCup avTools
|
||||||
@@ -154,42 +158,28 @@ listVersions lt' criteria = do
|
|||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> Map.Map Version VersionInfo
|
=> Map.Map GHCTargetVersion VersionInfo
|
||||||
-> m [ListResult]
|
-> m [ListResult]
|
||||||
strayGHCs avTools = do
|
strayGHCs avTools = do
|
||||||
ghcs <- getInstalledGHCs
|
ghcs <- getInstalledGHCs
|
||||||
fmap catMaybes $ forM ghcs $ \case
|
fmap catMaybes $ forM ghcs $ \case
|
||||||
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
|
Right tver@GHCTargetVersion{ .. } -> do
|
||||||
case Map.lookup _tvVersion avTools of
|
case Map.lookup tver avTools of
|
||||||
Just _ -> pure Nothing
|
Just _ -> pure Nothing
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
|
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
||||||
fromSrc <- ghcSrcInstalled tver
|
|
||||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
||||||
pure $ Just $ ListResult
|
pure $ Just $ ListResult
|
||||||
{ lTool = GHC
|
{ lTool = GHC
|
||||||
, lVer = _tvVersion
|
, lVer = _tvVersion
|
||||||
, lCross = Nothing
|
, lCross = _tvTarget
|
||||||
, lTag = []
|
, lTag = []
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup _tvVersion avTools)
|
, lStray = isNothing (Map.lookup tver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Right tver@GHCTargetVersion{ .. } -> do
|
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
|
||||||
fromSrc <- ghcSrcInstalled tver
|
|
||||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
|
||||||
pure $ Just $ ListResult
|
|
||||||
{ lTool = GHC
|
|
||||||
, lVer = _tvVersion
|
|
||||||
, lCross = _tvTarget
|
|
||||||
, lTag = []
|
|
||||||
, lInstalled = True
|
|
||||||
, lStray = True -- NOTE: cross currently cannot be installed via bindist
|
|
||||||
, lNoBindist = False
|
|
||||||
, ..
|
|
||||||
}
|
|
||||||
Left e -> do
|
Left e -> do
|
||||||
logWarn
|
logWarn
|
||||||
$ "Could not parse version of stray directory" <> T.pack e
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
@@ -221,8 +211,8 @@ listVersions lt' criteria = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -255,8 +245,8 @@ listVersions lt' criteria = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -290,8 +280,8 @@ listVersions lt' criteria = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -299,24 +289,24 @@ listVersions lt' criteria = do
|
|||||||
$ "Could not parse version of stray directory" <> T.pack e
|
$ "Could not parse version of stray directory" <> T.pack e
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult
|
||||||
currentGHCup av =
|
currentGHCup av =
|
||||||
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
|
let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer ""
|
||||||
listVer = Map.lookup currentVer av
|
listVer = Map.lookup currentVer av
|
||||||
latestVer = fst <$> headOf (getTagged Latest) av
|
latestVer = fst <$> headOf (getTagged Latest) av
|
||||||
recommendedVer = fst <$> headOf (getTagged Latest) av
|
recommendedVer = fst <$> headOf (getTagged Latest) av
|
||||||
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
||||||
in if | Map.member currentVer av -> Nothing
|
in if | Map.member currentVer av -> Nothing
|
||||||
| otherwise -> Just $ ListResult { lVer = currentVer
|
| otherwise -> Just $ ListResult { lVer = _tvVersion currentVer
|
||||||
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTool = GHCup
|
, lTool = GHCup
|
||||||
, fromSrc = False
|
|
||||||
, lStray = isNothing listVer
|
, lStray = isNothing listVer
|
||||||
, lSet = True
|
, lSet = True
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
-- NOTE: this are not cross ones, because no bindists
|
-- NOTE: this are not cross ones, because no bindists
|
||||||
@@ -335,42 +325,41 @@ listVersions lt' criteria = do
|
|||||||
-> [Either FilePath Version]
|
-> [Either FilePath Version]
|
||||||
-> Maybe Version
|
-> Maybe Version
|
||||||
-> [Either FilePath Version]
|
-> [Either FilePath Version]
|
||||||
-> (Version, VersionInfo)
|
-> (GHCTargetVersion, VersionInfo)
|
||||||
-> m ListResult
|
-> m ListResult
|
||||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
|
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do
|
||||||
|
let v = _tvVersion tver
|
||||||
case t of
|
case t of
|
||||||
GHC -> do
|
GHC -> do
|
||||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
|
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
|
||||||
let tver = mkTVer v
|
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
|
|
||||||
lInstalled <- ghcInstalled tver
|
lInstalled <- ghcInstalled tver
|
||||||
fromSrc <- ghcSrcInstalled tver
|
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
|
||||||
hlsPowered <- fmap (elem v) hlsGHCVersions
|
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
|
||||||
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
|
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
|
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
|
||||||
let lSet = cSet == Just v
|
let lSet = cSet == Just v
|
||||||
let lInstalled = elem v $ rights cabals
|
let lInstalled = elem v $ rights cabals
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
GHCup -> do
|
GHCup -> do
|
||||||
let lSet = prettyPVP ghcUpVer == prettyVer v
|
let lSet = prettyPVP ghcUpVer == prettyVer v
|
||||||
let lInstalled = lSet
|
let lInstalled = lSet
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
HLS -> do
|
HLS -> do
|
||||||
@@ -379,11 +368,11 @@ listVersions lt' criteria = do
|
|||||||
let lInstalled = elem v $ rights hlses
|
let lInstalled = elem v $ rights hlses
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
Stack -> do
|
Stack -> do
|
||||||
@@ -392,19 +381,42 @@ listVersions lt' criteria = do
|
|||||||
let lInstalled = elem v $ rights stacks
|
let lInstalled = elem v $ rights stacks
|
||||||
pure ListResult { lVer = v
|
pure ListResult { lVer = v
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = tags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
|
, lReleaseDay = _viReleaseDay
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
filter' :: [ListResult] -> [ListResult]
|
filter' :: [ListResult] -> [ListResult]
|
||||||
filter' lr = case criteria of
|
filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
|
||||||
Nothing -> lr
|
|
||||||
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
|
filterDays :: [ListResult] -> [ListResult]
|
||||||
Just ListSet -> filter (\ListResult {..} -> lSet) lr
|
filterDays lrs = case days of
|
||||||
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
|
(Nothing, Nothing) -> lrs
|
||||||
|
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
|
||||||
|
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
|
||||||
|
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
|
||||||
|
|
||||||
|
fromCriteria :: ListCriteria -> ListResult -> Bool
|
||||||
|
fromCriteria lc ListResult{..} = case lc of
|
||||||
|
ListInstalled b -> f b lInstalled
|
||||||
|
ListSet b -> f b lSet
|
||||||
|
ListAvailable b -> f b $ not lNoBindist
|
||||||
|
where
|
||||||
|
f b
|
||||||
|
| b = id
|
||||||
|
| otherwise = not
|
||||||
|
|
||||||
|
filterOld :: [ListResult] -> [ListResult]
|
||||||
|
filterOld lr
|
||||||
|
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
|
||||||
|
| otherwise = lr
|
||||||
|
|
||||||
|
filterNightly :: [ListResult] -> [ListResult]
|
||||||
|
filterNightly lr
|
||||||
|
| showNightly = lr
|
||||||
|
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr
|
||||||
|
|
||||||
|
|||||||
@@ -28,6 +28,8 @@ import GHCup.Prelude
|
|||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
import GHCup.Prelude.Process
|
import GHCup.Prelude.Process
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
|
import GHCup.Prelude.Version.QQ
|
||||||
|
import GHCup.Prelude.MegaParsec
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
@@ -48,11 +50,18 @@ import Prelude hiding ( abs
|
|||||||
)
|
)
|
||||||
import System.Info
|
import System.Info
|
||||||
import System.OsRelease
|
import System.OsRelease
|
||||||
|
import System.Exit
|
||||||
|
import System.FilePath
|
||||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
|
|
||||||
|
import qualified Text.Megaparsec as MP
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
|
import Data.Void
|
||||||
|
import qualified Data.List as L
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -143,6 +152,9 @@ getLinuxDistro = do
|
|||||||
| hasWord name ["exherbo"] -> Exherbo
|
| hasWord name ["exherbo"] -> Exherbo
|
||||||
| hasWord name ["gentoo"] -> Gentoo
|
| hasWord name ["gentoo"] -> Gentoo
|
||||||
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
|
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
|
||||||
|
| hasWord name ["rocky", "Rocky Linux"] -> Rocky
|
||||||
|
-- https://github.com/void-linux/void-packages/blob/master/srcpkgs/base-files/files/os-release
|
||||||
|
| hasWord name ["void", "Void Linux"] -> Void
|
||||||
| otherwise -> UnknownLinux
|
| otherwise -> UnknownLinux
|
||||||
pure (distro, parsedVer)
|
pure (distro, parsedVer)
|
||||||
where
|
where
|
||||||
@@ -197,3 +209,155 @@ getLinuxDistro = do
|
|||||||
try_debian_version = do
|
try_debian_version = do
|
||||||
ver <- T.readFile debian_version
|
ver <- T.readFile debian_version
|
||||||
pure (T.pack "debian", Just ver)
|
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 Haskus.Utils.Variant.Excepts
|
||||||
import Text.PrettyPrint.HughesPJClass ( Pretty )
|
import Text.PrettyPrint.HughesPJClass ( Pretty )
|
||||||
import qualified Data.Text as T
|
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
|
(_ , VLeft e ) -> throwSomeE e
|
||||||
(VRight _, VRight _) -> pure ()
|
(VRight _, VRight _) -> pure ()
|
||||||
|
|
||||||
|
-- "throwSomeE" function has been upstreamed in haskus-utils-variant-3.3
|
||||||
|
-- So, only conditionally include this shim if
|
||||||
|
-- haskus-utils-variant version is < 3.3
|
||||||
|
|
||||||
|
#if MIN_VERSION_haskus_utils_variant(3,3,0)
|
||||||
|
#else
|
||||||
-- | Throw some exception
|
-- | Throw some exception
|
||||||
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
|
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
|
||||||
{-# INLINABLE throwSomeE #-}
|
{-# INLINABLE throwSomeE #-}
|
||||||
throwSomeE = Excepts . pure . VLeft . liftVariant
|
throwSomeE = Excepts . pure . VLeft . liftVariant
|
||||||
|
#endif
|
||||||
|
|
||||||
|
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
|
||||||
|
|||||||
@@ -387,7 +387,7 @@ rmLink fp
|
|||||||
--
|
--
|
||||||
-- This overwrites previously existing files.
|
-- This overwrites previously existing files.
|
||||||
--
|
--
|
||||||
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
|
-- On windows, this requires that 'ensureShimGen' was run beforehand.
|
||||||
createLink :: ( MonadMask m
|
createLink :: ( MonadMask m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
|
|||||||
@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
|
|||||||
|
|
||||||
-- | Create an 'Unfold' of directory contents.
|
-- | Create an 'Unfold' of directory contents.
|
||||||
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
|
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
|
where
|
||||||
{-# INLINE [0] step #-}
|
{-# INLINE [0] step #-}
|
||||||
step dirstream = do
|
step dirstream = do
|
||||||
(typ, e) <- liftIO $ readDirEnt dirstream
|
(typ, e) <- liftIO $ readDirEntPortable dirstream
|
||||||
return $ if
|
return $ if
|
||||||
| null e -> D.Stop
|
| null e -> D.Stop
|
||||||
| "." == e -> D.Skip dirstream
|
| "." == e -> D.Skip dirstream
|
||||||
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
|||||||
step (_, Nothing, []) = return D.Stop
|
step (_, Nothing, []) = return D.Stop
|
||||||
|
|
||||||
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
|
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
|
||||||
(dt, f) <- liftIO $ readDirEnt dirstream
|
(dt, f) <- liftIO $ readDirEntPortable dirstream
|
||||||
if | FD.dtUnknown == dt -> do
|
if | f == "" -> do
|
||||||
runIOFinalizer finalizer
|
runIOFinalizer finalizer
|
||||||
return $ D.Skip (topdir, Nothing, dirs)
|
return $ D.Skip (topdir, Nothing, dirs)
|
||||||
| f == "." || f == ".."
|
| f == "." || f == ".."
|
||||||
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
|||||||
|
|
||||||
acquire dir =
|
acquire dir =
|
||||||
withRunInIO $ \run -> mask_ $ run $ do
|
withRunInIO $ \run -> mask_ $ run $ do
|
||||||
dirstream <- liftIO $ openDirStream dir
|
dirstream <- liftIO $ openDirStreamPortable dir
|
||||||
ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
|
ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
|
||||||
return (dirstream, ref)
|
return (dirstream, ref)
|
||||||
|
|
||||||
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
|
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
|
||||||
|
|||||||
@@ -10,9 +10,20 @@
|
|||||||
module GHCup.Prelude.File.Posix.Traversals (
|
module GHCup.Prelude.File.Posix.Traversals (
|
||||||
-- lower-level stuff
|
-- lower-level stuff
|
||||||
readDirEnt
|
readDirEnt
|
||||||
|
, readDirEntPortable
|
||||||
|
, openDirStreamPortable
|
||||||
|
, closeDirStreamPortable
|
||||||
, unpackDirStream
|
, unpackDirStream
|
||||||
|
, DirStreamPortable
|
||||||
) where
|
) 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
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
@@ -28,6 +39,7 @@ import Foreign.Storable
|
|||||||
import System.Posix
|
import System.Posix
|
||||||
import Foreign (alloca)
|
import Foreign (alloca)
|
||||||
import System.Posix.Internals (peekFilePath)
|
import System.Posix.Internals (peekFilePath)
|
||||||
|
import System.FilePath
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -90,3 +102,38 @@ readDirEnt (unpackDirStream -> dirp) =
|
|||||||
then return (dtUnknown, mempty)
|
then return (dtUnknown, mempty)
|
||||||
else throwErrno "readDirEnt"
|
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)
|
||||||
|
|
||||||
@@ -80,7 +80,7 @@ logInternal logLevel msg = do
|
|||||||
Info -> style' "[ Info ]"
|
Info -> style' "[ Info ]"
|
||||||
Warn -> style' "[ Warn ]"
|
Warn -> style' "[ Warn ]"
|
||||||
Error -> style' "[ Error ]"
|
Error -> style' "[ Error ]"
|
||||||
let strs = T.split (== '\n') msg
|
let strs = T.split (== '\n') . T.dropWhileEnd (`elem` ("\n\r" :: String)) $ msg
|
||||||
let out = case strs of
|
let out = case strs of
|
||||||
[] -> T.empty
|
[] -> T.empty
|
||||||
(x:xs) ->
|
(x:xs) ->
|
||||||
|
|||||||
@@ -91,18 +91,16 @@ ghcTargetVerP =
|
|||||||
verP' :: MP.Parsec Void Text Text
|
verP' :: MP.Parsec Void Text Text
|
||||||
verP' = do
|
verP' = do
|
||||||
v <- version'
|
v <- version'
|
||||||
let startsWithDigists =
|
let startsWithDigits =
|
||||||
and
|
and
|
||||||
. take 3
|
. take 3
|
||||||
. concatMap
|
. map (\case
|
||||||
(map
|
Numeric _ -> True
|
||||||
(\case
|
Alphanum _ -> False)
|
||||||
(Digits _) -> True
|
|
||||||
(Str _) -> False
|
|
||||||
) . NE.toList)
|
|
||||||
. NE.toList
|
. NE.toList
|
||||||
|
. (\(Chunks nec) -> nec)
|
||||||
$ _vChunks v
|
$ _vChunks v
|
||||||
if startsWithDigists && isNothing (_vEpoch v)
|
if startsWithDigits && isNothing (_vEpoch v)
|
||||||
then pure $ prettyVer v
|
then pure $ prettyVer v
|
||||||
else fail "Oh"
|
else fail "Oh"
|
||||||
|
|
||||||
@@ -122,3 +120,17 @@ verP suffix = do
|
|||||||
|
|
||||||
pathSep :: MP.Parsec Void Text Char
|
pathSep :: MP.Parsec Void Text Char
|
||||||
pathSep = MP.oneOf pathSeparators
|
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 (
|
module GHCup.Prelude.Process (
|
||||||
executeOut,
|
executeOut,
|
||||||
|
executeOut',
|
||||||
execLogged,
|
execLogged,
|
||||||
exec,
|
exec,
|
||||||
toProcessError,
|
toProcessError,
|
||||||
|
|||||||
@@ -70,6 +70,16 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
|||||||
maybe (pure ()) changeWorkingDirectory chdir
|
maybe (pure ()) changeWorkingDirectory chdir
|
||||||
SPP.executeFile path True args Nothing
|
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
|
execLogged :: ( MonadReader env m
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
@@ -169,7 +179,7 @@ execLogged exe args chdir lfile env = do
|
|||||||
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
|
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
|
||||||
|
|
||||||
blue :: ByteString -> ByteString
|
blue :: ByteString -> ByteString
|
||||||
blue bs
|
blue bs
|
||||||
| no_color = bs
|
| no_color = bs
|
||||||
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
|
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
|
||||||
|
|
||||||
|
|||||||
@@ -140,8 +140,16 @@ executeOut :: MonadIO m
|
|||||||
-> [String] -- ^ arguments to the command
|
-> [String] -- ^ arguments to the command
|
||||||
-> Maybe FilePath -- ^ chdir to this path
|
-> Maybe FilePath -- ^ chdir to this path
|
||||||
-> m CapturedProcess
|
-> m CapturedProcess
|
||||||
executeOut path args chdir = do
|
executeOut path args chdir = executeOut' path args chdir Nothing
|
||||||
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
|
|
||||||
|
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 ""
|
(exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
|
||||||
pure $ CapturedProcess exit out err
|
pure $ CapturedProcess exit out err
|
||||||
|
|
||||||
|
|||||||
@@ -26,36 +26,14 @@ import GHC.Base
|
|||||||
#endif
|
#endif
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH
|
||||||
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
|
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
|
||||||
import Language.Haskell.TH.Syntax ( Lift
|
import Language.Haskell.TH.Syntax ( dataToExpQ )
|
||||||
, dataToExpQ
|
|
||||||
)
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Language.Haskell.TH.Syntax as TH
|
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)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
deriving instance Lift (NonEmpty Word)
|
deriving instance Lift (NonEmpty Word)
|
||||||
deriving instance Lift (NonEmpty VChunk)
|
|
||||||
deriving instance Lift (NonEmpty MChunk)
|
deriving instance Lift (NonEmpty MChunk)
|
||||||
deriving instance Lift (NonEmpty VUnit)
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
qq :: (Text -> Q Exp) -> QuasiQuoter
|
qq :: (Text -> Q Exp) -> QuasiQuoter
|
||||||
|
|||||||
@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
|
|||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.Ord
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Versions hiding ( patch )
|
import Data.Versions hiding ( patch )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
@@ -233,7 +234,7 @@ setStack ver = do
|
|||||||
|
|
||||||
liftIO (isShadowed stackbin) >>= \case
|
liftIO (isShadowed stackbin) >>= \case
|
||||||
Nothing -> pure ()
|
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 ()
|
pure ()
|
||||||
|
|
||||||
@@ -279,6 +280,6 @@ rmStackVer ver = do
|
|||||||
|
|
||||||
when (Just ver == sSet) $ do
|
when (Just ver == sSet) $ do
|
||||||
sVers <- lift $ fmap rights getInstalledStacks
|
sVers <- lift $ fmap rights getInstalledStacks
|
||||||
case headMay . reverse . sort $ sVers of
|
case headMay . sortBy (comparing Down) $ sVers of
|
||||||
Just latestver -> setStack latestver
|
Just latestver -> setStack latestver
|
||||||
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)
|
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)
|
||||||
|
|||||||
@@ -22,15 +22,18 @@ module GHCup.Types
|
|||||||
( module GHCup.Types
|
( module GHCup.Types
|
||||||
#if defined(BRICK)
|
#if defined(BRICK)
|
||||||
, Key(..)
|
, Key(..)
|
||||||
|
, Modifier(..)
|
||||||
#endif
|
#endif
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import GHCup.Types.Stack ( SetupInfo )
|
||||||
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
|
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
|
||||||
|
|
||||||
import Control.DeepSeq ( NFData, rnf )
|
import Control.DeepSeq ( NFData, rnf )
|
||||||
import Data.Map.Strict ( Map )
|
import Data.Map.Strict ( Map )
|
||||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
import Data.Text ( Text )
|
import Data.Text ( Text )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import GHC.IO.Exception ( ExitCode )
|
import GHC.IO.Exception ( ExitCode )
|
||||||
@@ -38,13 +41,13 @@ import Optics ( makeLenses )
|
|||||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
#if defined(BRICK)
|
#if defined(BRICK)
|
||||||
import Graphics.Vty ( Key(..) )
|
import Graphics.Vty ( Key(..), Modifier(..) )
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
|
import qualified Data.List.NonEmpty as NE
|
||||||
|
|
||||||
#if !defined(BRICK)
|
#if !defined(BRICK)
|
||||||
data Key = KEsc | KChar Char | KBS | KEnter
|
data Key = KEsc | KChar Char | KBS | KEnter
|
||||||
@@ -53,8 +56,15 @@ data Key = KEsc | KChar Char | KBS | KEnter
|
|||||||
| KFun Int | KBackTab | KPrtScr | KPause | KIns
|
| KFun Int | KBackTab | KPrtScr | KPause | KIns
|
||||||
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
|
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
|
||||||
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||||
|
|
||||||
|
data Modifier = MShift | MCtrl | MMeta | MAlt
|
||||||
|
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
|
||||||
|
deriving (Eq,Show,Read,Ord,GHC.Generic)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
--------------------
|
--------------------
|
||||||
--[ GHCInfo Tree ]--
|
--[ GHCInfo Tree ]--
|
||||||
@@ -64,9 +74,9 @@ data Key = KEsc | KChar Char | KBS | KEnter
|
|||||||
data GHCupInfo = GHCupInfo
|
data GHCupInfo = GHCupInfo
|
||||||
{ _toolRequirements :: ToolRequirements
|
{ _toolRequirements :: ToolRequirements
|
||||||
, _ghcupDownloads :: GHCupDownloads
|
, _ghcupDownloads :: GHCupDownloads
|
||||||
, _globalTools :: Map GlobalTool DownloadInfo
|
, _metadataUpdate :: Maybe URI
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic, Eq)
|
||||||
|
|
||||||
instance NFData GHCupInfo
|
instance NFData GHCupInfo
|
||||||
|
|
||||||
@@ -87,7 +97,7 @@ data Requirements = Requirements
|
|||||||
{ _distroPKGs :: [Text]
|
{ _distroPKGs :: [Text]
|
||||||
, _notes :: Text
|
, _notes :: Text
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic, Eq)
|
||||||
|
|
||||||
instance NFData Requirements
|
instance NFData Requirements
|
||||||
|
|
||||||
@@ -103,7 +113,7 @@ instance NFData Requirements
|
|||||||
-- | Description of all binary and source downloads. This is a tree
|
-- | Description of all binary and source downloads. This is a tree
|
||||||
-- of nested maps.
|
-- of nested maps.
|
||||||
type GHCupDownloads = Map Tool ToolVersionSpec
|
type GHCupDownloads = Map Tool ToolVersionSpec
|
||||||
type ToolVersionSpec = Map Version VersionInfo
|
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
|
||||||
type ArchitectureSpec = Map Architecture PlatformSpec
|
type ArchitectureSpec = Map Architecture PlatformSpec
|
||||||
type PlatformSpec = Map Platform PlatformVersionSpec
|
type PlatformSpec = Map Platform PlatformVersionSpec
|
||||||
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
|
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
|
||||||
@@ -126,16 +136,12 @@ instance Pretty Tool where
|
|||||||
|
|
||||||
instance NFData Tool
|
instance NFData Tool
|
||||||
|
|
||||||
data GlobalTool = ShimGen
|
|
||||||
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
|
||||||
|
|
||||||
instance NFData GlobalTool
|
|
||||||
|
|
||||||
|
|
||||||
-- | All necessary information of a tool version, including
|
-- | All necessary information of a tool version, including
|
||||||
-- source download and per-architecture downloads.
|
-- source download and per-architecture downloads.
|
||||||
data VersionInfo = VersionInfo
|
data VersionInfo = VersionInfo
|
||||||
{ _viTags :: [Tag] -- ^ version specific tag
|
{ _viTags :: [Tag] -- ^ version specific tag
|
||||||
|
, _viReleaseDay :: Maybe Day
|
||||||
, _viChangeLog :: Maybe URI
|
, _viChangeLog :: Maybe URI
|
||||||
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
||||||
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
||||||
@@ -151,10 +157,17 @@ instance NFData VersionInfo
|
|||||||
|
|
||||||
|
|
||||||
-- | A tag. These are currently attached to a version of a tool.
|
-- | A tag. These are currently attached to a version of a tool.
|
||||||
data Tag = Latest
|
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
|
||||||
| Recommended
|
| Recommended -- ^ the recommended version of a tool (unique per tool)
|
||||||
| Prerelease
|
| Prerelease -- ^ denotes a prerelease version
|
||||||
| Base PVP
|
-- (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
|
| Old -- ^ old versions are hidden by default in TUI
|
||||||
| UnknownTag String -- ^ used for upwardscompat
|
| UnknownTag String -- ^ used for upwardscompat
|
||||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||||
@@ -165,16 +178,22 @@ tagToString :: Tag -> String
|
|||||||
tagToString Recommended = "recommended"
|
tagToString Recommended = "recommended"
|
||||||
tagToString Latest = "latest"
|
tagToString Latest = "latest"
|
||||||
tagToString Prerelease = "prerelease"
|
tagToString Prerelease = "prerelease"
|
||||||
|
tagToString Nightly = "nightly"
|
||||||
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||||
tagToString (UnknownTag t ) = t
|
tagToString (UnknownTag t ) = t
|
||||||
|
tagToString LatestPrerelease = "latest-prerelease"
|
||||||
|
tagToString LatestNightly = "latest-nightly"
|
||||||
tagToString Old = ""
|
tagToString Old = ""
|
||||||
|
|
||||||
instance Pretty Tag where
|
instance Pretty Tag where
|
||||||
pPrint Recommended = text "recommended"
|
pPrint Recommended = text "recommended"
|
||||||
pPrint Latest = text "latest"
|
pPrint Latest = text "latest"
|
||||||
pPrint Prerelease = text "prerelease"
|
pPrint Prerelease = text "prerelease"
|
||||||
|
pPrint Nightly = text "nightly"
|
||||||
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
|
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||||
pPrint (UnknownTag t ) = text t
|
pPrint (UnknownTag t ) = text t
|
||||||
|
pPrint LatestPrerelease = text "latest-prerelease"
|
||||||
|
pPrint LatestNightly = text "latest-prerelease"
|
||||||
pPrint Old = mempty
|
pPrint Old = mempty
|
||||||
|
|
||||||
data Architecture = A_64
|
data Architecture = A_64
|
||||||
@@ -230,13 +249,18 @@ data LinuxDistro = Debian
|
|||||||
| RedHat
|
| RedHat
|
||||||
| Alpine
|
| Alpine
|
||||||
| AmazonLinux
|
| AmazonLinux
|
||||||
|
| Rocky
|
||||||
|
| Void
|
||||||
-- rolling
|
-- rolling
|
||||||
| Gentoo
|
| Gentoo
|
||||||
| Exherbo
|
| Exherbo
|
||||||
-- not known
|
-- not known
|
||||||
| UnknownLinux
|
| UnknownLinux
|
||||||
-- ^ must exit
|
-- ^ 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
|
instance NFData LinuxDistro
|
||||||
|
|
||||||
@@ -249,6 +273,8 @@ distroToString CentOS = "centos"
|
|||||||
distroToString RedHat = "redhat"
|
distroToString RedHat = "redhat"
|
||||||
distroToString Alpine = "alpine"
|
distroToString Alpine = "alpine"
|
||||||
distroToString AmazonLinux = "amazon"
|
distroToString AmazonLinux = "amazon"
|
||||||
|
distroToString Rocky = "rocky"
|
||||||
|
distroToString Void = "void"
|
||||||
distroToString Gentoo = "gentoo"
|
distroToString Gentoo = "gentoo"
|
||||||
distroToString Exherbo = "exherbo"
|
distroToString Exherbo = "exherbo"
|
||||||
distroToString UnknownLinux = "unknown"
|
distroToString UnknownLinux = "unknown"
|
||||||
@@ -264,6 +290,7 @@ data DownloadInfo = DownloadInfo
|
|||||||
, _dlSubdir :: Maybe TarDir
|
, _dlSubdir :: Maybe TarDir
|
||||||
, _dlHash :: Text
|
, _dlHash :: Text
|
||||||
, _dlCSize :: Maybe Integer
|
, _dlCSize :: Maybe Integer
|
||||||
|
, _dlOutput :: Maybe FilePath
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, GHC.Generic, Show)
|
deriving (Eq, Ord, GHC.Generic, Show)
|
||||||
|
|
||||||
@@ -307,15 +334,41 @@ instance Pretty TarDir where
|
|||||||
|
|
||||||
-- | Where to fetch GHCupDownloads from.
|
-- | Where to fetch GHCupDownloads from.
|
||||||
data URLSource = GHCupURL
|
data URLSource = GHCupURL
|
||||||
| OwnSource [Either GHCupInfo URI] -- ^ complete source list
|
| StackSetupURL
|
||||||
| OwnSpec GHCupInfo
|
| OwnSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ complete source list
|
||||||
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
|
| OwnSpec (Either GHCupInfo SetupInfo)
|
||||||
deriving (GHC.Generic, Show)
|
| 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 URLSource
|
||||||
instance NFData (URIRef Absolute) where
|
instance NFData (URIRef Absolute) where
|
||||||
rnf (URI !_ !_ !_ !_ !_) = ()
|
rnf (URI !_ !_ !_ !_ !_) = ()
|
||||||
|
|
||||||
|
|
||||||
data MetaMode = Strict
|
data MetaMode = Strict
|
||||||
| Lax
|
| Lax
|
||||||
deriving (Show, Read, Eq, GHC.Generic)
|
deriving (Show, Read, Eq, GHC.Generic)
|
||||||
@@ -337,7 +390,7 @@ data UserSettings = UserSettings
|
|||||||
, uPlatformOverride :: Maybe PlatformRequest
|
, uPlatformOverride :: Maybe PlatformRequest
|
||||||
, uMirrors :: Maybe DownloadMirrors
|
, uMirrors :: Maybe DownloadMirrors
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic, Eq)
|
||||||
|
|
||||||
defaultUserSettings :: UserSettings
|
defaultUserSettings :: UserSettings
|
||||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||||
@@ -369,7 +422,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
|||||||
, kSet = Just bSet
|
, kSet = Just bSet
|
||||||
, kChangelog = Just bChangelog
|
, kChangelog = Just bChangelog
|
||||||
, kShowAll = Just bShowAllVersions
|
, kShowAll = Just bShowAllVersions
|
||||||
, kShowAllTools = Just bShowAllTools
|
|
||||||
}
|
}
|
||||||
in UserSettings {
|
in UserSettings {
|
||||||
uCache = Just cache
|
uCache = Just cache
|
||||||
@@ -388,47 +440,48 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
|||||||
}
|
}
|
||||||
|
|
||||||
data UserKeyBindings = UserKeyBindings
|
data UserKeyBindings = UserKeyBindings
|
||||||
{ kUp :: Maybe Key
|
{ kUp :: Maybe KeyCombination
|
||||||
, kDown :: Maybe Key
|
, kDown :: Maybe KeyCombination
|
||||||
, kQuit :: Maybe Key
|
, kQuit :: Maybe KeyCombination
|
||||||
, kInstall :: Maybe Key
|
, kInstall :: Maybe KeyCombination
|
||||||
, kUninstall :: Maybe Key
|
, kUninstall :: Maybe KeyCombination
|
||||||
, kSet :: Maybe Key
|
, kSet :: Maybe KeyCombination
|
||||||
, kChangelog :: Maybe Key
|
, kChangelog :: Maybe KeyCombination
|
||||||
, kShowAll :: Maybe Key
|
, kShowAll :: Maybe KeyCombination
|
||||||
, kShowAllTools :: Maybe Key
|
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic, Eq)
|
||||||
|
|
||||||
data KeyBindings = KeyBindings
|
data KeyBindings = KeyBindings
|
||||||
{ bUp :: Key
|
{ bUp :: KeyCombination
|
||||||
, bDown :: Key
|
, bDown :: KeyCombination
|
||||||
, bQuit :: Key
|
, bQuit :: KeyCombination
|
||||||
, bInstall :: Key
|
, bInstall :: KeyCombination
|
||||||
, bUninstall :: Key
|
, bUninstall :: KeyCombination
|
||||||
, bSet :: Key
|
, bSet :: KeyCombination
|
||||||
, bChangelog :: Key
|
, bChangelog :: KeyCombination
|
||||||
, bShowAllVersions :: Key
|
, bShowAllVersions :: KeyCombination
|
||||||
, bShowAllTools :: Key
|
|
||||||
}
|
}
|
||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
instance NFData KeyBindings
|
instance NFData KeyBindings
|
||||||
#if defined(IS_WINDOWS) || !defined(BRICK)
|
#if !defined(BRICK)
|
||||||
instance NFData Key
|
instance NFData Key
|
||||||
|
|
||||||
|
instance NFData Modifier
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
instance NFData KeyCombination
|
||||||
|
|
||||||
defaultKeyBindings :: KeyBindings
|
defaultKeyBindings :: KeyBindings
|
||||||
defaultKeyBindings = KeyBindings
|
defaultKeyBindings = KeyBindings
|
||||||
{ bUp = KUp
|
{ bUp = KeyCombination { key = KUp , mods = [] }
|
||||||
, bDown = KDown
|
, bDown = KeyCombination { key = KDown , mods = [] }
|
||||||
, bQuit = KChar 'q'
|
, bQuit = KeyCombination { key = KChar 'q', mods = [] }
|
||||||
, bInstall = KChar 'i'
|
, bInstall = KeyCombination { key = KChar 'i', mods = [] }
|
||||||
, bUninstall = KChar 'u'
|
, bUninstall = KeyCombination { key = KChar 'u', mods = [] }
|
||||||
, bSet = KChar 's'
|
, bSet = KeyCombination { key = KChar 's', mods = [] }
|
||||||
, bChangelog = KChar 'c'
|
, bChangelog = KeyCombination { key = KChar 'c', mods = [] }
|
||||||
, bShowAllVersions = KChar 'a'
|
, bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
|
||||||
, bShowAllTools = KChar 't'
|
|
||||||
}
|
}
|
||||||
|
|
||||||
data AppState = AppState
|
data AppState = AppState
|
||||||
@@ -581,7 +634,9 @@ data GHCTargetVersion = GHCTargetVersion
|
|||||||
{ _tvTarget :: Maybe Text
|
{ _tvTarget :: Maybe Text
|
||||||
, _tvVersion :: Version
|
, _tvVersion :: Version
|
||||||
}
|
}
|
||||||
deriving (Ord, Eq, Show)
|
deriving (Ord, Eq, Show, GHC.Generic)
|
||||||
|
|
||||||
|
instance NFData GHCTargetVersion
|
||||||
|
|
||||||
data GitBranch = GitBranch
|
data GitBranch = GitBranch
|
||||||
{ ref :: String
|
{ ref :: String
|
||||||
@@ -620,6 +675,17 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
|
|||||||
|
|
||||||
instance NFData VersionRange
|
instance NFData VersionRange
|
||||||
|
|
||||||
|
instance Pretty VersionCmp where
|
||||||
|
pPrint (VR_gt v) = text "> " <> pPrint v
|
||||||
|
pPrint (VR_gteq v) = text ">= " <> pPrint v
|
||||||
|
pPrint (VR_lt v) = text "< " <> pPrint v
|
||||||
|
pPrint (VR_lteq v) = text "<= " <> pPrint v
|
||||||
|
pPrint (VR_eq v) = text "= " <> pPrint v
|
||||||
|
|
||||||
|
instance Pretty VersionRange where
|
||||||
|
pPrint (SimpleRange xs) = foldl1 (\x y -> x <> text " && " <> y) $ NE.map pPrint xs
|
||||||
|
pPrint (OrRange xs vr) = foldMap pPrint xs <> " || " <> pPrint vr
|
||||||
|
|
||||||
instance Pretty Versioning where
|
instance Pretty Versioning where
|
||||||
pPrint = text . T.unpack . prettyV
|
pPrint = text . T.unpack . prettyV
|
||||||
|
|
||||||
@@ -691,3 +757,22 @@ type PromptQuestion = Text
|
|||||||
|
|
||||||
data PromptResponse = PromptYes | PromptNo
|
data PromptResponse = PromptYes | PromptNo
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data ToolVersion = GHCVersion GHCTargetVersion
|
||||||
|
| ToolVersion Version
|
||||||
|
| ToolTag Tag
|
||||||
|
| ToolDay Day
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance Pretty ToolVersion where
|
||||||
|
pPrint (GHCVersion v) = pPrint v
|
||||||
|
pPrint (ToolVersion v) = pPrint v
|
||||||
|
pPrint (ToolTag t) = pPrint t
|
||||||
|
pPrint (ToolDay d) = text (show d)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
data BuildSystem = Hadrian
|
||||||
|
| Make
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
|||||||
@@ -22,7 +22,9 @@ Portability : portable
|
|||||||
module GHCup.Types.JSON where
|
module GHCup.Types.JSON where
|
||||||
|
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
|
import GHCup.Types.Stack (SetupInfo)
|
||||||
import GHCup.Types.JSON.Utils
|
import GHCup.Types.JSON.Utils
|
||||||
|
import GHCup.Types.JSON.Versions ()
|
||||||
import GHCup.Prelude.MegaParsec
|
import GHCup.Prelude.MegaParsec
|
||||||
|
|
||||||
import Control.Applicative ( (<|>) )
|
import Control.Applicative ( (<|>) )
|
||||||
@@ -31,7 +33,9 @@ import Data.Aeson.TH
|
|||||||
import Data.Aeson.Types hiding (Key)
|
import Data.Aeson.Types hiding (Key)
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.List.NonEmpty ( NonEmpty(..) )
|
import Data.List.NonEmpty ( NonEmpty(..) )
|
||||||
|
import Data.Maybe
|
||||||
import Data.Text.Encoding as E
|
import Data.Text.Encoding as E
|
||||||
|
import Data.Foldable
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
@@ -48,13 +52,13 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
|
|||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
|
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
|
||||||
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
|
||||||
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
|
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
|
||||||
@@ -64,8 +68,11 @@ instance ToJSON Tag where
|
|||||||
toJSON Latest = String "Latest"
|
toJSON Latest = String "Latest"
|
||||||
toJSON Recommended = String "Recommended"
|
toJSON Recommended = String "Recommended"
|
||||||
toJSON Prerelease = String "Prerelease"
|
toJSON Prerelease = String "Prerelease"
|
||||||
|
toJSON Nightly = String "Nightly"
|
||||||
toJSON Old = String "old"
|
toJSON Old = String "old"
|
||||||
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
|
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
|
||||||
|
toJSON LatestPrerelease = String "LatestPrerelease"
|
||||||
|
toJSON LatestNightly = String "LatestNightly"
|
||||||
toJSON (UnknownTag x ) = String (T.pack x)
|
toJSON (UnknownTag x ) = String (T.pack x)
|
||||||
|
|
||||||
instance FromJSON Tag where
|
instance FromJSON Tag where
|
||||||
@@ -73,6 +80,9 @@ instance FromJSON Tag where
|
|||||||
"Latest" -> pure Latest
|
"Latest" -> pure Latest
|
||||||
"Recommended" -> pure Recommended
|
"Recommended" -> pure Recommended
|
||||||
"Prerelease" -> pure Prerelease
|
"Prerelease" -> pure Prerelease
|
||||||
|
"Nightly" -> pure Nightly
|
||||||
|
"LatestPrerelease" -> pure LatestPrerelease
|
||||||
|
"LatestNightly" -> pure LatestNightly
|
||||||
"old" -> pure Old
|
"old" -> pure Old
|
||||||
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
|
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
|
||||||
Right x -> pure $ Base x
|
Right x -> pure $ Base x
|
||||||
@@ -89,34 +99,22 @@ instance FromJSON URI where
|
|||||||
Right x -> pure x
|
Right x -> pure x
|
||||||
Left e -> fail . show $ e
|
Left e -> fail . show $ e
|
||||||
|
|
||||||
instance ToJSON Versioning where
|
instance ToJSON GHCTargetVersion where
|
||||||
toJSON = toJSON . prettyV
|
toJSON = toJSON . tVerToText
|
||||||
|
|
||||||
instance FromJSON Versioning where
|
instance FromJSON GHCTargetVersion where
|
||||||
parseJSON = withText "Versioning" $ \t -> case versioning t of
|
parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of
|
||||||
Right x -> pure x
|
Right x -> pure x
|
||||||
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
|
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
|
||||||
|
|
||||||
instance ToJSONKey Versioning where
|
instance ToJSONKey GHCTargetVersion where
|
||||||
toJSONKey = toJSONKeyText $ \x -> prettyV x
|
toJSONKey = toJSONKeyText $ \x -> tVerToText x
|
||||||
|
|
||||||
instance FromJSONKey Versioning where
|
instance FromJSONKey GHCTargetVersion where
|
||||||
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
|
fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of
|
||||||
Right x -> pure x
|
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
|
instance ToJSONKey Platform where
|
||||||
toJSONKey = toJSONKeyText $ \case
|
toJSONKey = toJSONKeyText $ \case
|
||||||
@@ -153,55 +151,12 @@ instance ToJSONKey Architecture where
|
|||||||
instance FromJSONKey Architecture where
|
instance FromJSONKey Architecture where
|
||||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
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
|
instance ToJSONKey Tool where
|
||||||
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
||||||
|
|
||||||
instance FromJSONKey Tool where
|
instance FromJSONKey Tool where
|
||||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
||||||
|
|
||||||
instance ToJSONKey GlobalTool where
|
|
||||||
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
|
||||||
|
|
||||||
instance FromJSONKey GlobalTool where
|
|
||||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
|
||||||
|
|
||||||
instance ToJSON TarDir where
|
instance ToJSON TarDir where
|
||||||
toJSON (RealDir p) = toJSON p
|
toJSON (RealDir p) = toJSON p
|
||||||
toJSON (RegexDir r) = object ["RegexDir" .= r]
|
toJSON (RegexDir r) = object ["RegexDir" .= r]
|
||||||
@@ -319,33 +274,64 @@ instance FromJSONKey (Maybe VersionRange) where
|
|||||||
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
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"
|
||||||
|
metadataUpdate <- o .:? "metadataUpdate"
|
||||||
|
ghcupDownloads' <- o .: "ghcupDownloads"
|
||||||
|
pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads' metadataUpdate)
|
||||||
|
|
||||||
|
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 { 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 } ''Port
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
|
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 = \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 } ''DownloadMirror
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
|
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
|
instance FromJSON URLSource where
|
||||||
parseJSON v =
|
parseJSON v =
|
||||||
parseGHCupURL v
|
parseGHCupURL v
|
||||||
|
<|> parseStackURL v
|
||||||
<|> parseOwnSourceLegacy v
|
<|> parseOwnSourceLegacy v
|
||||||
<|> parseOwnSourceNew1 v
|
<|> parseOwnSourceNew1 v
|
||||||
<|> parseOwnSourceNew2 v
|
<|> parseOwnSourceNew2 v
|
||||||
<|> parseOwnSpec v
|
<|> parseOwnSpec v
|
||||||
<|> legacyParseAddSource v
|
<|> legacyParseAddSource v
|
||||||
<|> newParseAddSource 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
|
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
|
parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
|
||||||
r :: URI <- o .: "OwnSource"
|
r :: URI <- o .: "OwnSource"
|
||||||
pure (OwnSource [Right r])
|
pure (OwnSource [Right r])
|
||||||
@@ -354,18 +340,100 @@ instance FromJSON URLSource where
|
|||||||
pure (OwnSource (fmap Right r))
|
pure (OwnSource (fmap Right r))
|
||||||
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
|
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
|
||||||
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
|
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
|
||||||
pure (OwnSource r)
|
pure (OwnSource (convert'' <$> r))
|
||||||
parseOwnSpec = withObject "URLSource" $ \o -> do
|
parseOwnSpec = withObject "URLSource" $ \o -> do
|
||||||
r :: GHCupInfo <- o .: "OwnSpec"
|
r :: GHCupInfo <- o .: "OwnSpec"
|
||||||
pure (OwnSpec r)
|
pure (OwnSpec $ Left r)
|
||||||
parseGHCupURL = withObject "URLSource" $ \o -> do
|
parseGHCupURL = withObject "URLSource" $ \o -> do
|
||||||
_ :: [Value] <- o .: "GHCupURL"
|
_ :: [Value] <- o .: "GHCupURL"
|
||||||
pure GHCupURL
|
pure GHCupURL
|
||||||
|
parseStackURL = withObject "URLSource" $ \o -> do
|
||||||
|
_ :: [Value] <- o .: "StackSetupURL"
|
||||||
|
pure StackSetupURL
|
||||||
legacyParseAddSource = withObject "URLSource" $ \o -> do
|
legacyParseAddSource = withObject "URLSource" $ \o -> do
|
||||||
r :: Either GHCupInfo URI <- o .: "AddSource"
|
r :: Either GHCupInfo URI <- o .: "AddSource"
|
||||||
pure (AddSource [r])
|
pure (AddSource [convert'' r])
|
||||||
newParseAddSource = withObject "URLSource" $ \o -> do
|
newParseAddSource = withObject "URLSource" $ \o -> do
|
||||||
r :: [Either GHCupInfo URI] <- o .: "AddSource"
|
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)
|
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
|
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"
|
||||||
|
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.MegaParsec
|
||||||
import GHCup.Prelude.Process
|
import GHCup.Prelude.Process
|
||||||
import GHCup.Prelude.String.QQ
|
import GHCup.Prelude.String.QQ
|
||||||
|
|
||||||
import Codec.Archive hiding ( Directory )
|
import Codec.Archive hiding ( Directory )
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
@@ -62,7 +61,6 @@ import Control.Monad.Trans.Resource
|
|||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||||
import Data.Char ( isHexDigit )
|
import Data.Char ( isHexDigit )
|
||||||
import Data.Bifunctor ( first )
|
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
@@ -91,9 +89,10 @@ import qualified Data.Text.Encoding as E
|
|||||||
import qualified Text.Megaparsec as MP
|
import qualified Text.Megaparsec as MP
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import qualified Streamly.Prelude as S
|
import qualified Streamly.Prelude as S
|
||||||
|
|
||||||
import Control.DeepSeq (force)
|
import Control.DeepSeq (force)
|
||||||
import GHC.IO (evaluate)
|
import GHC.IO (evaluate)
|
||||||
import System.Environment (getEnvironment, setEnv)
|
import Data.Time (Day(..), diffDays, addDays)
|
||||||
|
|
||||||
|
|
||||||
-- $setup
|
-- $setup
|
||||||
@@ -119,11 +118,11 @@ import System.Environment (getEnvironment, setEnv)
|
|||||||
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
|
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
|
||||||
-- >>> dirs' <- getAllDirs
|
-- >>> 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 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
|
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
|
||||||
-- >>> cwd <- getCurrentDirectory
|
-- >>> cwd <- getCurrentDirectory
|
||||||
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
-- >>> (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)
|
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
|
||||||
|
|
||||||
|
|
||||||
-- | Whether the given GHC version is installed from source.
|
|
||||||
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
|
||||||
ghcSrcInstalled ver = do
|
|
||||||
ghcdir <- ghcupGHCDir ver
|
|
||||||
liftIO $ doesFileExist (fromGHCupPath ghcdir </> ghcUpSrcBuiltFile)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Whether the given GHC version is set as the current.
|
-- | Whether the given GHC version is set as the current.
|
||||||
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||||
=> Maybe Text -- ^ the target of the GHC version, if any
|
=> Maybe Text -- ^ the target of the GHC version, if any
|
||||||
@@ -335,7 +327,7 @@ ghcSet mtarget = do
|
|||||||
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
|
||||||
getInstalledGHCs = do
|
getInstalledGHCs = do
|
||||||
ghcdir <- ghcupGHCBaseDir
|
ghcdir <- ghcupGHCBaseDir
|
||||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir)
|
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
|
||||||
forM fs $ \f -> case parseGHCupGHCDir f of
|
forM fs $ \f -> case parseGHCupGHCDir f of
|
||||||
Right r -> pure $ Right r
|
Right r -> pure $ Right r
|
||||||
Left _ -> pure $ Left f
|
Left _ -> pure $ Left f
|
||||||
@@ -376,7 +368,9 @@ cabalSet = do
|
|||||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||||
broken <- liftIO $ isBrokenSymlink cabalbin
|
broken <- liftIO $ isBrokenSymlink cabalbin
|
||||||
if broken
|
if broken
|
||||||
then pure Nothing
|
then do
|
||||||
|
logWarn $ "Broken symlink at " <> T.pack cabalbin
|
||||||
|
pure Nothing
|
||||||
else do
|
else do
|
||||||
link <- liftIO
|
link <- liftIO
|
||||||
$ handleIO' InvalidArgument
|
$ handleIO' InvalidArgument
|
||||||
@@ -438,7 +432,7 @@ getInstalledHLSs = do
|
|||||||
Nothing -> pure $ Left f
|
Nothing -> pure $ Left f
|
||||||
|
|
||||||
hlsdir <- ghcupHLSBaseDir
|
hlsdir <- ghcupHLSBaseDir
|
||||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir)
|
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
|
||||||
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
||||||
Right r -> pure $ Right r
|
Right r -> pure $ Right r
|
||||||
Left _ -> pure $ Left f
|
Left _ -> pure $ Left f
|
||||||
@@ -473,7 +467,9 @@ stackSet = do
|
|||||||
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||||
broken <- liftIO $ isBrokenSymlink stackBin
|
broken <- liftIO $ isBrokenSymlink stackBin
|
||||||
if broken
|
if broken
|
||||||
then pure Nothing
|
then do
|
||||||
|
logWarn $ "Broken symlink at " <> T.pack stackBin
|
||||||
|
pure Nothing
|
||||||
else do
|
else do
|
||||||
link <- liftIO
|
link <- liftIO
|
||||||
$ handleIO' InvalidArgument
|
$ handleIO' InvalidArgument
|
||||||
@@ -527,15 +523,17 @@ isLegacyHLS ver = do
|
|||||||
|
|
||||||
|
|
||||||
-- Return the currently set hls version, if any.
|
-- Return the currently set hls version, if any.
|
||||||
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
|
||||||
hlsSet = do
|
hlsSet = do
|
||||||
Dirs {..} <- getDirs
|
Dirs {..} <- getDirs
|
||||||
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||||
|
|
||||||
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
|
||||||
broken <- isBrokenSymlink hlsBin
|
broken <- liftIO $ isBrokenSymlink hlsBin
|
||||||
if broken
|
if broken
|
||||||
then pure Nothing
|
then do
|
||||||
|
logWarn $ "Broken symlink at " <> T.pack hlsBin
|
||||||
|
pure Nothing
|
||||||
else do
|
else do
|
||||||
link <- liftIO $ getLinkTarget hlsBin
|
link <- liftIO $ getLinkTarget hlsBin
|
||||||
Just <$> linkVersion link
|
Just <$> linkVersion link
|
||||||
@@ -563,6 +561,7 @@ hlsSet = do
|
|||||||
-- | Return the GHC versions the currently selected HLS supports.
|
-- | Return the GHC versions the currently selected HLS supports.
|
||||||
hlsGHCVersions :: ( MonadReader env m
|
hlsGHCVersions :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadCatch m
|
, MonadCatch m
|
||||||
@@ -626,7 +625,7 @@ hlsInternalServerScripts ver mghcVer = do
|
|||||||
dir <- ghcupHLSDir ver
|
dir <- ghcupHLSDir ver
|
||||||
let bdir = fromGHCupPath dir </> "bin"
|
let bdir = fromGHCupPath dir </> "bin"
|
||||||
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
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.
|
-- | 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.
|
-- Returns the full path.
|
||||||
@@ -639,7 +638,7 @@ hlsInternalServerBinaries ver mghcVer = do
|
|||||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||||
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
|
(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)
|
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>/
|
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
|
||||||
-- directory, if any.
|
-- directory, if any.
|
||||||
@@ -652,7 +651,7 @@ hlsInternalServerLibs ver ghcVer = do
|
|||||||
dir <- fromGHCupPath <$> ghcupHLSDir ver
|
dir <- fromGHCupPath <$> ghcupHLSDir ver
|
||||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
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))]
|
(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.
|
-- | Get the wrapper binary for an hls version, if any.
|
||||||
@@ -694,10 +693,8 @@ hlsAllBinaries ver = do
|
|||||||
|
|
||||||
-- | Extract (major, minor) from any version.
|
-- | Extract (major, minor) from any version.
|
||||||
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
|
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
|
||||||
getMajorMinorV Version {..} = case _vChunks of
|
getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
|
||||||
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
|
getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
|
||||||
_ -> throwM $ ParseError "Could not parse X.Y from version"
|
|
||||||
|
|
||||||
|
|
||||||
matchMajor :: Version -> Int -> Int -> Bool
|
matchMajor :: Version -> Int -> Int -> Bool
|
||||||
matchMajor v' major' minor' = case getMajorMinorV v' of
|
matchMajor v' major' minor' = case getMajorMinorV v' of
|
||||||
@@ -739,7 +736,7 @@ getGHCForPVP pvpIn mt = do
|
|||||||
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
||||||
--
|
--
|
||||||
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
|
-- >>> 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
|
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
|
||||||
-- "Just 8.8.4"
|
-- "Just 8.8.4"
|
||||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
|
-- >>> 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
|
-- | Get the latest available ghc for the given PVP version, which
|
||||||
-- may only contain parts.
|
-- 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]})
|
-- 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]})
|
-- 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]})
|
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||||
getLatestToolFor :: MonadThrow m
|
getLatestToolFor :: MonadThrow m
|
||||||
=> Tool
|
=> Tool
|
||||||
|
-> Maybe Text
|
||||||
-> PVP
|
-> PVP
|
||||||
-> GHCupDownloads
|
-> GHCupDownloads
|
||||||
-> m (Maybe (PVP, VersionInfo))
|
-> m (Maybe (PVP, VersionInfo, Maybe Text))
|
||||||
getLatestToolFor tool pvpIn dls = do
|
getLatestToolFor tool target pvpIn dls = do
|
||||||
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
let ls :: [(GHCTargetVersion, VersionInfo)]
|
||||||
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
|
ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||||
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
|
let ps :: [((PVP, Text), VersionInfo, Maybe Text)]
|
||||||
|
ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls
|
||||||
|
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,
|
-- | Get the tool version that has this tag. If multiple have it,
|
||||||
-- picks the greatest version.
|
-- picks the greatest version.
|
||||||
getTagged :: Tag
|
getTagged :: Tag
|
||||||
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
-> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
|
||||||
getTagged tag =
|
getTagged tag =
|
||||||
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||||
% folding id
|
% folding id
|
||||||
|
|
||||||
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
|
||||||
|
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
|
||||||
|
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
|
||||||
|
maybe m (\d -> let diff = diffDays d day
|
||||||
|
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
|
||||||
|
Map.empty mvv
|
||||||
|
in case headMay (Map.toAscList mdv) of
|
||||||
|
Nothing -> Left Nothing
|
||||||
|
Just (absDiff, (diff, (k, vi)))
|
||||||
|
| absDiff == 0 -> Right (k, vi)
|
||||||
|
| otherwise -> Left (Just (addDays diff day))
|
||||||
|
|
||||||
|
getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
|
||||||
|
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
|
||||||
|
|
||||||
|
getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
||||||
|
|
||||||
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
|
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
|
||||||
|
|
||||||
|
|
||||||
-- | Gets the latest GHC with a given base version.
|
-- | Gets the latest GHC with a given base version.
|
||||||
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
|
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
|
||||||
getLatestBaseVersion av pvpVer =
|
getLatestBaseVersion av pvpVer =
|
||||||
headOf (ix GHC % getTagged (Base pvpVer)) av
|
headOf (ix GHC % getTagged (Base pvpVer)) av
|
||||||
|
|
||||||
@@ -933,7 +954,7 @@ ghcToolFiles ver = do
|
|||||||
whenM (fmap not $ ghcInstalled ver)
|
whenM (fmap not $ ghcInstalled ver)
|
||||||
(throwE (NotInstalled GHC 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)
|
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
|
||||||
|
|
||||||
where
|
where
|
||||||
@@ -951,11 +972,6 @@ ghcToolFiles ver = do
|
|||||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
||||||
|
|
||||||
|
|
||||||
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
|
|
||||||
-- this GHC was built from source. It contains the build config.
|
|
||||||
ghcUpSrcBuiltFile :: FilePath
|
|
||||||
ghcUpSrcBuiltFile = ".ghcup_src_built"
|
|
||||||
|
|
||||||
|
|
||||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||||
make :: ( MonadThrow m
|
make :: ( MonadThrow m
|
||||||
@@ -1021,7 +1037,7 @@ applyPatches pdir ddir = do
|
|||||||
|
|
||||||
patches <- liftIO $ quilt `catchIO` (\e ->
|
patches <- liftIO $ quilt `catchIO` (\e ->
|
||||||
if isDoesNotExistError e || isPermissionError e then
|
if isDoesNotExistError e || isPermissionError e then
|
||||||
lexicographical
|
lexicographical
|
||||||
else throwIO e)
|
else throwIO e)
|
||||||
forM_ patches $ \patch' -> applyPatch patch' ddir
|
forM_ patches $ \patch' -> applyPatch patch' ddir
|
||||||
|
|
||||||
@@ -1069,7 +1085,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
|
|||||||
-> FilePath
|
-> FilePath
|
||||||
-> m (Either ProcessError ())
|
-> m (Either ProcessError ())
|
||||||
darwinNotarization Darwin path = exec
|
darwinNotarization Darwin path = exec
|
||||||
"xattr"
|
"/usr/bin/xattr"
|
||||||
["-r", "-d", "com.apple.quarantine", path]
|
["-r", "-d", "com.apple.quarantine", path]
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
@@ -1078,11 +1094,15 @@ darwinNotarization _ _ = pure $ Right ()
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
|
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
|
||||||
getChangeLog dls tool (Left v') =
|
getChangeLog dls tool (GHCVersion v') =
|
||||||
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||||
getChangeLog dls tool (Right tag) =
|
getChangeLog dls tool (ToolVersion (mkTVer -> v')) =
|
||||||
|
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||||
|
getChangeLog dls tool (ToolTag tag) =
|
||||||
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
||||||
|
getChangeLog dls tool (ToolDay day) =
|
||||||
|
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
|
||||||
|
|
||||||
|
|
||||||
-- | Execute a build action while potentially cleaning up:
|
-- | Execute a build action while potentially cleaning up:
|
||||||
@@ -1166,7 +1186,7 @@ rmBDir dir = withRunInIO (\run -> run $
|
|||||||
$ rmPathForcibly dir)
|
$ rmPathForcibly dir)
|
||||||
|
|
||||||
|
|
||||||
getVersionInfo :: Version
|
getVersionInfo :: GHCTargetVersion
|
||||||
-> Tool
|
-> Tool
|
||||||
-> GHCupDownloads
|
-> GHCupDownloads
|
||||||
-> Maybe VersionInfo
|
-> Maybe VersionInfo
|
||||||
@@ -1179,24 +1199,22 @@ getVersionInfo v' tool =
|
|||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
ensureGlobalTools :: ( MonadMask m
|
ensureShimGen :: ( MonadMask m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadReader env m
|
, MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasGHCupInfo env
|
, HasGHCupInfo env
|
||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
)
|
)
|
||||||
=> Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
|
=> Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
|
||||||
ensureGlobalTools
|
ensureShimGen
|
||||||
| isWindows = do
|
| isWindows = do
|
||||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
|
||||||
dirs <- lift getDirs
|
dirs <- lift getDirs
|
||||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
let shimDownload = DownloadInfo shimGenURL Nothing shimGenSHA Nothing Nothing
|
||||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
|
||||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||||
void $ (\DigestError{} -> do
|
void $ (\DigestError{} -> do
|
||||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||||
@@ -1300,22 +1318,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 ]--
|
--[ Git ]--
|
||||||
-----------
|
-----------
|
||||||
|
|||||||
@@ -29,6 +29,7 @@ module GHCup.Utils.Dirs
|
|||||||
, relativeSymlink
|
, relativeSymlink
|
||||||
, withGHCupTmpDir
|
, withGHCupTmpDir
|
||||||
, getConfigFilePath
|
, getConfigFilePath
|
||||||
|
, getConfigFilePath'
|
||||||
, useXDG
|
, useXDG
|
||||||
, cleanupTrash
|
, cleanupTrash
|
||||||
|
|
||||||
@@ -42,6 +43,9 @@ module GHCup.Utils.Dirs
|
|||||||
, removeDirectoryRecursive
|
, removeDirectoryRecursive
|
||||||
, removePathForcibly
|
, removePathForcibly
|
||||||
|
|
||||||
|
, listDirectoryFiles
|
||||||
|
, listDirectoryDirs
|
||||||
|
|
||||||
-- System.Directory re-exports
|
-- System.Directory re-exports
|
||||||
, createDirectory
|
, createDirectory
|
||||||
, createDirectoryIfMissing
|
, createDirectoryIfMissing
|
||||||
@@ -130,7 +134,7 @@ import Data.Maybe
|
|||||||
import Data.Versions
|
import Data.Versions
|
||||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Optics
|
import Optics hiding ( uncons )
|
||||||
import Safe
|
import Safe
|
||||||
import System.Directory hiding ( removeDirectory
|
import System.Directory hiding ( removeDirectory
|
||||||
, removeDirectoryRecursive
|
, removeDirectoryRecursive
|
||||||
@@ -276,7 +280,7 @@ ghcupCacheDir
|
|||||||
Nothing -> do
|
Nothing -> do
|
||||||
home <- liftIO getHomeDirectory
|
home <- liftIO getHomeDirectory
|
||||||
pure (home </> ".cache")
|
pure (home </> ".cache")
|
||||||
pure (GHCupPath (bdir </> "ghcup"))
|
pure (GHCupPath (bdir </> "ghcup" </> "cache"))
|
||||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
|
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
|
||||||
|
|
||||||
|
|
||||||
@@ -305,19 +309,7 @@ ghcupLogsDir
|
|||||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||||
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
|
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
|
||||||
ghcupDbDir :: IO GHCupPath
|
ghcupDbDir :: IO GHCupPath
|
||||||
ghcupDbDir
|
ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
||||||
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
|
||||||
| otherwise = do
|
|
||||||
xdg <- useXDG
|
|
||||||
if xdg
|
|
||||||
then do
|
|
||||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
|
||||||
Just r -> pure r
|
|
||||||
Nothing -> do
|
|
||||||
home <- liftIO getHomeDirectory
|
|
||||||
pure (home </> ".cache")
|
|
||||||
pure (GHCupPath (bdir </> "ghcup" </> "db"))
|
|
||||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
|
|
||||||
|
|
||||||
|
|
||||||
-- | '~/.ghcup/trash'.
|
-- | '~/.ghcup/trash'.
|
||||||
@@ -369,6 +361,12 @@ getConfigFilePath = do
|
|||||||
confDir <- liftIO ghcupConfigDir
|
confDir <- liftIO ghcupConfigDir
|
||||||
pure $ fromGHCupPath confDir </> "config.yaml"
|
pure $ fromGHCupPath confDir </> "config.yaml"
|
||||||
|
|
||||||
|
getConfigFilePath' :: (MonadReader env m, HasDirs env) => m FilePath
|
||||||
|
getConfigFilePath' = do
|
||||||
|
Dirs {..} <- getDirs
|
||||||
|
pure $ fromGHCupPath confDir </> "config.yaml"
|
||||||
|
|
||||||
|
|
||||||
ghcupConfigFile :: (MonadIO m)
|
ghcupConfigFile :: (MonadIO m)
|
||||||
=> Excepts '[JSONError] m UserSettings
|
=> Excepts '[JSONError] m UserSettings
|
||||||
ghcupConfigFile = do
|
ghcupConfigFile = do
|
||||||
@@ -529,6 +527,29 @@ cleanupTrash = do
|
|||||||
) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
|
) $ 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
|
-- System.Directory re-exports with GHCupPath
|
||||||
|
|
||||||
|
|||||||
@@ -24,17 +24,26 @@ import qualified Data.Text as T
|
|||||||
import qualified Data.Versions as V
|
import qualified Data.Versions as V
|
||||||
import Control.Exception.Safe (MonadThrow)
|
import Control.Exception.Safe (MonadThrow)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
|
||||||
import Data.List (intersperse)
|
|
||||||
import Control.Monad.Catch (throwM)
|
import Control.Monad.Catch (throwM)
|
||||||
import GHCup.Errors (ParseError(..))
|
import GHCup.Errors (ParseError(..))
|
||||||
|
import Text.Megaparsec
|
||||||
|
import Data.Void (Void)
|
||||||
|
|
||||||
-- | This reflects the API version of the YAML.
|
-- | 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
|
-- 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.
|
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
||||||
ghcupURL :: URI
|
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|]
|
||||||
|
|
||||||
|
shimGenURL :: URI
|
||||||
|
shimGenURL = [uri|https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe|]
|
||||||
|
|
||||||
|
shimGenSHA :: T.Text
|
||||||
|
shimGenSHA = T.pack "7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70"
|
||||||
|
|
||||||
-- | The current ghcup version.
|
-- | The current ghcup version.
|
||||||
ghcUpVer :: V.PVP
|
ghcUpVer :: V.PVP
|
||||||
@@ -52,8 +61,8 @@ versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
|
|||||||
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
|
||||||
|
|
||||||
versionRange :: V.Versioning -> VersionRange -> Bool
|
versionRange :: V.Versioning -> VersionRange -> Bool
|
||||||
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
|
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
|
||||||
versionRange ver' (OrRange cmps range) =
|
versionRange ver' (OrRange cmps range) =
|
||||||
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
versionRange ver' (SimpleRange cmps) || versionRange ver' range
|
||||||
|
|
||||||
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
|
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
|
||||||
@@ -65,44 +74,15 @@ pvpToVersion pvp_ rest =
|
|||||||
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
|
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
|
||||||
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
|
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
|
||||||
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
|
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
|
where
|
||||||
alternative :: MonadThrow m => V.Version -> m V.PVP
|
pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
|
||||||
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
|
pvp'' = do
|
||||||
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
|
p <- V.pvp'
|
||||||
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
|
s <- getParserState
|
||||||
|
pure (p, stateInput s)
|
||||||
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"
|
|
||||||
|
|
||||||
pvpFromList :: [Int] -> V.PVP
|
pvpFromList :: [Int] -> V.PVP
|
||||||
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral
|
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral
|
||||||
|
|||||||
@@ -2,7 +2,6 @@ site_name: GHCup
|
|||||||
site_url: https://www.haskell.org/ghcup
|
site_url: https://www.haskell.org/ghcup
|
||||||
site_description: GHCup is the main installer for the general purpose language Haskell.
|
site_description: GHCup is the main installer for the general purpose language Haskell.
|
||||||
site_author: GHCup Team
|
site_author: GHCup Team
|
||||||
site_favicon: haskell_logo.png
|
|
||||||
|
|
||||||
repo_url: https://github.com/haskell/ghcup-hs
|
repo_url: https://github.com/haskell/ghcup-hs
|
||||||
|
|
||||||
|
|||||||
@@ -28,14 +28,14 @@
|
|||||||
|
|
||||||
plat="$(uname -s)"
|
plat="$(uname -s)"
|
||||||
arch=$(uname -m)
|
arch=$(uname -m)
|
||||||
ghver="0.1.19.0"
|
ghver="0.1.20.0"
|
||||||
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
||||||
|
|
||||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||||
: "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
|
: "${BOOTSTRAP_HASKELL_DOWNLOADER:=curl}"
|
||||||
|
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
: "${GHCUP_INSTALL_BASE_PREFIX:=/c}"
|
: "${GHCUP_INSTALL_BASE_PREFIX:=/c}"
|
||||||
GHCUP_DIR=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup")
|
GHCUP_DIR=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup")
|
||||||
GHCUP_BIN=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup/bin")
|
GHCUP_BIN=$(cygpath -u "${GHCUP_INSTALL_BASE_PREFIX}/ghcup/bin")
|
||||||
@@ -72,7 +72,7 @@ warn() {
|
|||||||
printf "%s\\n" "$1"
|
printf "%s\\n" "$1"
|
||||||
else
|
else
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
# shellcheck disable=SC3037
|
# shellcheck disable=SC3037
|
||||||
echo -e "\\033[0;35m$1\\033[0m"
|
echo -e "\\033[0;35m$1\\033[0m"
|
||||||
;;
|
;;
|
||||||
@@ -88,7 +88,7 @@ yellow() {
|
|||||||
printf "%s\\n" "$1"
|
printf "%s\\n" "$1"
|
||||||
else
|
else
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
# shellcheck disable=SC3037
|
# shellcheck disable=SC3037
|
||||||
echo -e "\\033[0;33m$1\\033[0m"
|
echo -e "\\033[0;33m$1\\033[0m"
|
||||||
;;
|
;;
|
||||||
@@ -104,7 +104,7 @@ green() {
|
|||||||
printf "%s\\n" "$1"
|
printf "%s\\n" "$1"
|
||||||
else
|
else
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
# shellcheck disable=SC3037
|
# shellcheck disable=SC3037
|
||||||
echo -e "\\033[0;32m$1\\033[0m"
|
echo -e "\\033[0;32m$1\\033[0m"
|
||||||
;;
|
;;
|
||||||
@@ -119,20 +119,26 @@ edo() {
|
|||||||
"$@" || die "\"$*\" failed!"
|
"$@" || die "\"$*\" failed!"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
eghcup_raw() {
|
||||||
|
"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
|
||||||
|
}
|
||||||
|
|
||||||
eghcup() {
|
eghcup() {
|
||||||
edo _eghcup "$@"
|
_eghcup "$@"
|
||||||
}
|
}
|
||||||
|
|
||||||
_eghcup() {
|
_eghcup() {
|
||||||
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
|
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
|
||||||
args="-s ${BOOTSTRAP_HASKELL_YAML}"
|
args="-s ${BOOTSTRAP_HASKELL_YAML} --metadata-fetching-mode=Strict"
|
||||||
|
else
|
||||||
|
args="--metadata-fetching-mode=Strict"
|
||||||
fi
|
fi
|
||||||
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
|
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
|
||||||
# shellcheck disable=SC2086
|
# shellcheck disable=SC2086
|
||||||
"${GHCUP_BIN}/ghcup" ${args} "$@"
|
"${GHCUP_BIN}/ghcup" ${args} "$@" || die "\"ghcup ${args} $*\" failed!"
|
||||||
else
|
else
|
||||||
# shellcheck disable=SC2086
|
# shellcheck disable=SC2086
|
||||||
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@"
|
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@" || die "\"ghcup ${args} --verbose $*\" failed!"
|
||||||
fi
|
fi
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -147,14 +153,14 @@ _ecabal() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
ecabal() {
|
ecabal() {
|
||||||
edo _ecabal "$@"
|
_ecabal "$@" || die "\"cabal $*\" failed!"
|
||||||
}
|
}
|
||||||
|
|
||||||
_done() {
|
_done() {
|
||||||
echo
|
echo
|
||||||
echo "==============================================================================="
|
echo "==============================================================================="
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
green
|
green
|
||||||
green "All done!"
|
green "All done!"
|
||||||
green
|
green
|
||||||
@@ -166,9 +172,8 @@ _done() {
|
|||||||
green "Start a new haskell project in the current directory via:"
|
green "Start a new haskell project in the current directory via:"
|
||||||
green " cabal init --interactive"
|
green " cabal init --interactive"
|
||||||
green
|
green
|
||||||
green "Install other GHC versions and tools via:"
|
green "To install other GHC versions and tools, run:"
|
||||||
green " ghcup list"
|
green " ghcup tui"
|
||||||
green " ghcup install <tool> <version>"
|
|
||||||
green
|
green
|
||||||
green "To install system libraries and update msys2/mingw64,"
|
green "To install system libraries and update msys2/mingw64,"
|
||||||
green "open the \"Mingw haskell shell\""
|
green "open the \"Mingw haskell shell\""
|
||||||
@@ -282,14 +287,6 @@ download_ghcup() {
|
|||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
"FreeBSD"|"freebsd")
|
"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
|
case "${arch}" in
|
||||||
x86_64|amd64)
|
x86_64|amd64)
|
||||||
;;
|
;;
|
||||||
@@ -299,7 +296,7 @@ download_ghcup() {
|
|||||||
*) die "Unknown architecture: ${arch}"
|
*) die "Unknown architecture: ${arch}"
|
||||||
;;
|
;;
|
||||||
esac
|
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")
|
"Darwin"|"darwin")
|
||||||
case "${arch}" in
|
case "${arch}" in
|
||||||
@@ -316,7 +313,7 @@ download_ghcup() {
|
|||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
;;
|
;;
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
case "${arch}" in
|
case "${arch}" in
|
||||||
x86_64|amd64)
|
x86_64|amd64)
|
||||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe
|
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe
|
||||||
@@ -329,7 +326,7 @@ download_ghcup() {
|
|||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
||||||
"curl")
|
"curl")
|
||||||
# shellcheck disable=SC2086
|
# shellcheck disable=SC2086
|
||||||
@@ -387,10 +384,10 @@ download_ghcup() {
|
|||||||
edo . "${GHCUP_DIR}"/env
|
edo . "${GHCUP_DIR}"/env
|
||||||
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
||||||
"curl")
|
"curl")
|
||||||
eghcup config set downloader Curl
|
eghcup_raw config set downloader Curl
|
||||||
;;
|
;;
|
||||||
"wget")
|
"wget")
|
||||||
eghcup config set downloader Wget
|
eghcup_raw config set downloader Wget
|
||||||
;;
|
;;
|
||||||
*)
|
*)
|
||||||
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
|
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
|
||||||
@@ -548,7 +545,7 @@ adjust_bashrc() {
|
|||||||
printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
||||||
fi
|
fi
|
||||||
;;
|
;;
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
if [ ! -e "${HOME}/.bash_profile" ] ; then
|
if [ ! -e "${HOME}/.bash_profile" ] ; then
|
||||||
echo '# generated by ghcup' > "${HOME}/.bash_profile"
|
echo '# generated by ghcup' > "${HOME}/.bash_profile"
|
||||||
echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
|
echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
|
||||||
@@ -598,7 +595,7 @@ adjust_cabal_config() {
|
|||||||
|
|
||||||
ask_cabal_config_init() {
|
ask_cabal_config_init() {
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
if [ -n "${BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG}" ] ; then
|
if [ -n "${BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG}" ] ; then
|
||||||
return 1
|
return 1
|
||||||
fi
|
fi
|
||||||
@@ -639,7 +636,7 @@ ask_cabal_config_init() {
|
|||||||
|
|
||||||
do_cabal_config_init() {
|
do_cabal_config_init() {
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
case $1 in
|
case $1 in
|
||||||
1)
|
1)
|
||||||
adjust_cabal_config
|
adjust_cabal_config
|
||||||
@@ -759,7 +756,7 @@ if [ -z "${GHCUP_USE_XDG_DIRS}" ] ; then
|
|||||||
echo "ghcup installs only into the following directory,"
|
echo "ghcup installs only into the following directory,"
|
||||||
echo "which can be removed anytime:"
|
echo "which can be removed anytime:"
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
echo " $(cygpath -w "$GHCUP_DIR")"
|
echo " $(cygpath -w "$GHCUP_DIR")"
|
||||||
;;
|
;;
|
||||||
*)
|
*)
|
||||||
@@ -795,7 +792,7 @@ edo mkdir -p "${GHCUP_BIN}"
|
|||||||
|
|
||||||
if command -V "ghcup" >/dev/null 2>&1 ; then
|
if command -V "ghcup" >/dev/null 2>&1 ; then
|
||||||
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
|
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
|
||||||
_eghcup upgrade || download_ghcup
|
( _eghcup upgrade ) || download_ghcup
|
||||||
fi
|
fi
|
||||||
else
|
else
|
||||||
download_ghcup
|
download_ghcup
|
||||||
@@ -826,7 +823,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
|||||||
edo cabal update --ignore-project
|
edo cabal update --ignore-project
|
||||||
else # don't install ghc and cabal
|
else # don't install ghc and cabal
|
||||||
case "${plat}" in
|
case "${plat}" in
|
||||||
MSYS*|MINGW*)
|
MSYS*|MINGW*|CYGWIN*)
|
||||||
# need to bootstrap cabal to initialize config on windows
|
# need to bootstrap cabal to initialize config on windows
|
||||||
# we'll remove it afterwards
|
# we'll remove it afterwards
|
||||||
tmp_dir="$(mktemp -d)"
|
tmp_dir="$(mktemp -d)"
|
||||||
@@ -842,19 +839,19 @@ fi
|
|||||||
|
|
||||||
case $ask_hls_answer in
|
case $ask_hls_answer in
|
||||||
1)
|
1)
|
||||||
_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
|
(_eghcup --cache install hls) || warn "HLS installation failed, continuing anyway"
|
||||||
;;
|
;;
|
||||||
*) ;;
|
*) ;;
|
||||||
esac
|
esac
|
||||||
|
|
||||||
case $ask_stack_answer in
|
case $ask_stack_answer in
|
||||||
1)
|
1)
|
||||||
_eghcup --cache install stack || die "Stack installation failed"
|
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||||
;;
|
;;
|
||||||
2)
|
2)
|
||||||
_eghcup --cache install stack || die "Stack installation failed"
|
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||||
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
|
edo mkdir -p "${STACK_ROOT:-$HOME/.stack}"/hooks
|
||||||
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
hook_exe="${STACK_ROOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
||||||
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
||||||
|
|
||||||
if [ -e "${hook_exe}" ] ; then
|
if [ -e "${hook_exe}" ] ; then
|
||||||
|
|||||||
@@ -11,7 +11,7 @@
|
|||||||
* cabal - The Cabal build tool for managing Haskell software"
|
* cabal - The Cabal build tool for managing Haskell software"
|
||||||
* stack - (optional) A cross-platform program for developing Haskell projects"
|
* stack - (optional) A cross-platform program for developing Haskell projects"
|
||||||
* hls - (optional) A language server for developers to integrate with their editor/IDE"
|
* 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'.
|
By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
|
||||||
#>
|
#>
|
||||||
param (
|
param (
|
||||||
@@ -40,10 +40,15 @@ param (
|
|||||||
# Whether to disable use of curl.exe
|
# Whether to disable use of curl.exe
|
||||||
[switch]$DisableCurl,
|
[switch]$DisableCurl,
|
||||||
# The Msys2 version to download (e.g. 20221216)
|
# The Msys2 version to download (e.g. 20221216)
|
||||||
[string]$Msys2Version
|
[string]$Msys2Version,
|
||||||
|
# The Msys2 sha256sum hash
|
||||||
|
[string]$Msys2Hash,
|
||||||
|
# Whether to disable creation of several desktop shortcuts
|
||||||
|
[switch]$DontWriteDesktopShortcuts
|
||||||
)
|
)
|
||||||
|
|
||||||
$DefaultMsys2Version = "20221216"
|
$DefaultMsys2Version = "20221216"
|
||||||
|
$DefaultMsys2Hash = "18370d32b0264915c97e3d7c618f7b32d48ad80858923883fde5145acd32ca0f"
|
||||||
|
|
||||||
$Silent = !$Interactive
|
$Silent = !$Interactive
|
||||||
|
|
||||||
@@ -136,7 +141,7 @@ filter Get-FileSize {
|
|||||||
function Get-FileWCSynchronous{
|
function Get-FileWCSynchronous{
|
||||||
param(
|
param(
|
||||||
[Parameter(Mandatory=$true)]
|
[Parameter(Mandatory=$true)]
|
||||||
[string]$url,
|
[string]$url,
|
||||||
[string]$destinationFolder="$env:USERPROFILE\Downloads",
|
[string]$destinationFolder="$env:USERPROFILE\Downloads",
|
||||||
[switch]$includeStats
|
[switch]$includeStats
|
||||||
)
|
)
|
||||||
@@ -226,7 +231,7 @@ if ($GhcupBasePrefixEnv) {
|
|||||||
Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
|
Print-Msg -color Green -msg ("Picked {0} as default Install prefix!" -f $defaultGhcupBasePrefix)
|
||||||
} else {
|
} else {
|
||||||
Print-Msg -color Red -msg "Couldn't find a writable partition with at least 5GB free disk space!"
|
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('\'))) {
|
if (!($GhcupBasePrefix.EndsWith('\'))) {
|
||||||
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
|
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
|
||||||
}
|
}
|
||||||
|
|
||||||
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
|
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
|
||||||
if (!($GhcupBasePrefix)) {
|
if (!($GhcupBasePrefix)) {
|
||||||
Print-Msg -color Red -msg "No directory specified!"
|
Print-Msg -color Red -msg "No directory specified!"
|
||||||
@@ -347,7 +352,7 @@ if ($CabalDir) {
|
|||||||
$CabDirEnv = $CabalDir
|
$CabDirEnv = $CabalDir
|
||||||
if (!($CabDirEnv)) {
|
if (!($CabDirEnv)) {
|
||||||
Print-Msg -color Red -msg "No directory specified!"
|
Print-Msg -color Red -msg "No directory specified!"
|
||||||
Exit 1
|
Exit 1
|
||||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||||
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
||||||
Exit 1
|
Exit 1
|
||||||
@@ -362,7 +367,7 @@ if ($CabalDir) {
|
|||||||
|
|
||||||
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
|
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
|
||||||
if (!($CabDirEnv)) {
|
if (!($CabDirEnv)) {
|
||||||
Print-Msg -color Red -msg "No directory specified!"
|
Print-Msg -color Red -msg "No directory specified!"
|
||||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||||
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
|
||||||
} else {
|
} 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
|
# mingw foo
|
||||||
Print-Msg -msg 'First checking for Msys2...'
|
Print-Msg -msg 'First checking for Msys2...'
|
||||||
@@ -430,9 +455,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
if (!($Msys2Version)) {
|
if (!($Msys2Version)) {
|
||||||
$Msys2Version = $DefaultMsys2Version
|
$Msys2Version = $DefaultMsys2Version
|
||||||
}
|
}
|
||||||
|
if (!($Msys2Hash)) {
|
||||||
|
$Msys2Hash = $DefaultMsys2Hash
|
||||||
|
}
|
||||||
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
||||||
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
||||||
$msysUrl = ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
$msysUrl = ('https://downloads.haskell.org/ghcup/msys2/{0}' -f "$archive")
|
||||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||||
|
|
||||||
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
||||||
@@ -440,15 +468,22 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
} else {
|
} else {
|
||||||
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||||
}
|
}
|
||||||
|
$Msys2HashChecked = Get-FileHash -Algorithm SHA256 "${archivePath}"
|
||||||
|
if (!($Msys2HashChecked.Hash -eq $Msys2Hash)) {
|
||||||
|
Print-Msg -color Red -msg ("Hashes don't match, got {0}, but expected {1}" -f $Msys2HashChecked, $Msys2Hash)
|
||||||
|
Exit 1
|
||||||
|
}
|
||||||
|
|
||||||
Print-Msg -msg 'Extracting Msys2 archive...'
|
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||||
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||||
Remove-Item -Path "$archivePath"
|
# We ignore errors because we don't want the installation script to fail just because a temporary file can't be removed.
|
||||||
|
# Relevant issue: https://github.com/haskell/ghcup-hs/issues/952
|
||||||
|
Remove-Item -Path "$archivePath" -ErrorAction Continue
|
||||||
|
|
||||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||||
Exec "$Bash" '-lc' 'exit'
|
Exec "$Bash" '-lc' 'exit'
|
||||||
|
|
||||||
Exec "$env:windir\system32\taskkill.exe" /F /FI `"MODULES eq msys-2.0.dll`"
|
Exec "$env:windir\system32\taskkill.exe" /F /FI "MODULES eq msys-2.0.dll"
|
||||||
|
|
||||||
Print-Msg -msg 'Upgrading full system...'
|
Print-Msg -msg 'Upgrading full system...'
|
||||||
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
||||||
@@ -474,12 +509,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
$MsysDirPrompt = Read-Host
|
$MsysDirPrompt = Read-Host
|
||||||
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
|
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
|
||||||
} else {
|
} 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 = Read-Host
|
||||||
}
|
}
|
||||||
$MsysDir = $MsysDir.TrimEnd().TrimStart()
|
$MsysDir = $MsysDir.TrimEnd().TrimStart()
|
||||||
if (!($MsysDir)) {
|
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))) {
|
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
|
||||||
Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
|
Print-Msg -color Red -msg ('MSys2 installation at ''{0}'' could not be found!' -f $MsysDir)
|
||||||
} elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
|
} elseif (!(Split-Path -IsAbsolute -Path "$MsysDir")) {
|
||||||
@@ -499,8 +534,11 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
Start-Sleep -s 5
|
Start-Sleep -s 5
|
||||||
}
|
}
|
||||||
|
|
||||||
Print-Msg -msg 'Creating shortcuts...'
|
|
||||||
$uninstallShortCut = @'
|
if ($InstallDesktopShortcuts) {
|
||||||
|
|
||||||
|
Print-Msg -msg 'Creating shortcuts...'
|
||||||
|
$uninstallShortCut = @'
|
||||||
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
|
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
|
||||||
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
|
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
|
||||||
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
|
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
|
||||||
@@ -562,12 +600,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"'
|
$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 $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 ('{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
|
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
|
||||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
$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)
|
Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
|
||||||
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'
|
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'
|
||||||
|
|||||||
8
scripts/dev/update-shell-completions.sh
Executable file
8
scripts/dev/update-shell-completions.sh
Executable file
@@ -0,0 +1,8 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
set -xue
|
||||||
|
|
||||||
|
cabal --verbose=0 run ghcup:exe:ghcup -- --bash-completion-script ghcup > scripts/shell-completions/bash
|
||||||
|
cabal --verbose=0 run ghcup:exe:ghcup -- --zsh-completion-script ghcup > scripts/shell-completions/zsh
|
||||||
|
cabal --verbose=0 run ghcup:exe:ghcup -- --fish-completion-script ghcup > scripts/shell-completions/fish
|
||||||
|
|
||||||
@@ -9,8 +9,8 @@ set -eu
|
|||||||
|
|
||||||
case $HOOK_GHC_TYPE in
|
case $HOOK_GHC_TYPE in
|
||||||
bindist)
|
bindist)
|
||||||
ghcdir=$(ghcup whereis --directory ghc "$HOOK_GHC_VERSION" || ghcup run --ghc "$HOOK_GHC_VERSION" --install) || exit 3
|
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" "${ghcdir}"
|
printf "%s" "${ghc_path}"
|
||||||
;;
|
;;
|
||||||
git)
|
git)
|
||||||
# TODO: should be somewhat possible
|
# 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
|
RELEASE=$1
|
||||||
SIGNER=$2
|
SIGNER=$2
|
||||||
|
TAG=${RELEASE/v/}
|
||||||
|
|
||||||
echo "RELEASE: $RELEASE"
|
echo "RELEASE: $RELEASE"
|
||||||
echo "SIGNER: $SIGNER"
|
echo "SIGNER: $SIGNER"
|
||||||
@@ -18,17 +19,19 @@ done
|
|||||||
[ ! -e "gh-release-artifacts/${RELEASE}" ]
|
[ ! -e "gh-release-artifacts/${RELEASE}" ]
|
||||||
|
|
||||||
mkdir -p "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}"
|
cd "gh-release-artifacts/${RELEASE}"
|
||||||
|
|
||||||
# github
|
# github
|
||||||
gh release download $RELEASE
|
gh release download "$RELEASE"
|
||||||
|
|
||||||
rm test-*
|
|
||||||
|
|
||||||
# cirrus
|
# cirrus
|
||||||
curl -L -o x86_64-portbld-freebsd-ghcup-${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-${RELEASE}?branch=${RELEASE}"
|
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${TAG}?branch=${RELEASE}"
|
||||||
|
|
||||||
sha256sum *ghcup* > SHA256SUMS
|
sha256sum ./*-ghcup-* > SHA256SUMS
|
||||||
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
||||||
|
|
||||||
|
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-apple-darwin-ghcup
|
||||||
rm x86_64-linux-ghcup
|
rm x86_64-linux-ghcup
|
||||||
rm x86_64-mingw64-ghcup.exe
|
rm x86_64-mingw64-ghcup.exe
|
||||||
rm x86_64-freebsd12-ghcup
|
rm x86_64-portbld-freebsd-ghcup
|
||||||
rm x86_64-freebsd13-ghcup
|
|
||||||
|
|
||||||
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
|
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
|
||||||
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-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:
|
packages:
|
||||||
- .
|
- .
|
||||||
|
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
|
- Cabal-3.6.3.0
|
||||||
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
- Cabal-syntax-3.10.1.0
|
||||||
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
- aeson-2.1.2.1
|
||||||
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
- cabal-install-parsers-0.6.1
|
||||||
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
|
||||||
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
|
|
||||||
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
|
|
||||||
- chs-cabal-0.1.1.1
|
- chs-cabal-0.1.1.1
|
||||||
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
|
- chs-deps-0.1.0.0
|
||||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
|
||||||
|
- generically-0.1.1
|
||||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||||
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
|
- haskus-utils-variant-3.2.1
|
||||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
- libarchive-3.0.3.2
|
||||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
|
||||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
|
||||||
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
|
||||||
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
|
|
||||||
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
|
|
||||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
|
||||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
|
||||||
- libarchive-3.0.3.0
|
|
||||||
- libyaml-streamly-0.2.1
|
- libyaml-streamly-0.2.1
|
||||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
- lzma-static-5.2.5.5
|
||||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
- os-release-1.0.2.1
|
||||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
- parsec-3.1.15.0
|
||||||
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
|
|
||||||
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
|
|
||||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
|
||||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
|
||||||
- regex-posix-clib-2.7
|
|
||||||
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
||||||
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
|
- strict-base-0.4.0.0
|
||||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
- text-2.0.2
|
||||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
- yaml-streamly-0.12.2
|
||||||
- yaml-streamly-0.12.1
|
- github: fosskers/versions
|
||||||
|
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
http-io-streams:
|
http-io-streams:
|
||||||
brotli: false
|
brotli: false
|
||||||
|
|
||||||
libarchive:
|
libarchive:
|
||||||
system-libarchive: false
|
system-libarchive: true
|
||||||
|
|
||||||
regex-posix:
|
regex-posix:
|
||||||
_regex-posix-clib: true
|
_regex-posix-clib: true
|
||||||
|
|||||||
@@ -11,6 +11,7 @@ import GHCup.Types
|
|||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Data.List.NonEmpty
|
import Data.List.NonEmpty
|
||||||
|
import Data.Time.Calendar ( Day(..) )
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
|
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
|
||||||
import Test.QuickCheck.Arbitrary.Generic
|
import Test.QuickCheck.Arbitrary.Generic
|
||||||
@@ -76,6 +77,9 @@ instance Arbitrary Port where
|
|||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
|
instance Arbitrary Day where
|
||||||
|
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
|
||||||
|
|
||||||
instance Arbitrary (URIRef Absolute) where
|
instance Arbitrary (URIRef Absolute) where
|
||||||
arbitrary =
|
arbitrary =
|
||||||
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
|
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
|
||||||
@@ -171,12 +175,12 @@ instance Arbitrary Tool where
|
|||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
instance Arbitrary GlobalTool where
|
instance Arbitrary GHCupInfo where
|
||||||
arbitrary = genericArbitrary
|
arbitrary = genericArbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
instance Arbitrary GHCupInfo where
|
instance Arbitrary GHCTargetVersion where
|
||||||
arbitrary = genericArbitrary
|
arbitrary = GHCTargetVersion Nothing <$> arbitrary
|
||||||
shrink = genericShrink
|
shrink = genericShrink
|
||||||
|
|
||||||
|
|
||||||
@@ -24,11 +24,11 @@ spec = do
|
|||||||
-- https://github.com/haskell/ghcup-hs/issues/415
|
-- https://github.com/haskell/ghcup-hs/issues/415
|
||||||
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
||||||
it "readDirEnt" $ do
|
it "readDirEnt" $ do
|
||||||
dirstream <- liftIO $ openDirStream "test/data"
|
dirstream <- liftIO $ openDirStreamPortable "test/ghcup-test/data"
|
||||||
(dt1, fp1) <- readDirEnt dirstream
|
(dt1, fp1) <- readDirEntPortable dirstream
|
||||||
(dt2, fp2) <- readDirEnt dirstream
|
(dt2, fp2) <- readDirEntPortable dirstream
|
||||||
(dt3, fp3) <- readDirEnt dirstream
|
(dt3, fp3) <- readDirEntPortable dirstream
|
||||||
(dt4, fp4) <- readDirEnt dirstream
|
(dt4, fp4) <- readDirEntPortable dirstream
|
||||||
let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
|
let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
|
||||||
, (dt3, fp3), (dt4, fp4)
|
, (dt3, fp3), (dt4, fp4)
|
||||||
]
|
]
|
||||||
@@ -17,6 +17,6 @@ spec = do
|
|||||||
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
|
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
|
||||||
where
|
where
|
||||||
goldenDir
|
goldenDir
|
||||||
| isWindows = "test/golden/windows"
|
| isWindows = "test/ghcup-test/golden/windows"
|
||||||
| otherwise = "test/golden/unix"
|
| otherwise = "test/ghcup-test/golden/unix"
|
||||||
|
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user