Compare commits
100 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
0e6688c2bc
|
|||
|
7ef1ef688f
|
|||
|
3b8f2e8307
|
|||
|
0af7aaef3c
|
|||
|
b8907335ba
|
|||
|
0073ca769b
|
|||
|
8a286156f6
|
|||
|
5a39ead523
|
|||
|
d2b4eccac2
|
|||
|
be9b3a3857
|
|||
|
a8e6fca128
|
|||
|
0483133857
|
|||
|
30d9eb5634
|
|||
|
9fe7af3335
|
|||
|
bedfb3d114
|
|||
|
c19dd5ee8b
|
|||
|
6ae3bfe395
|
|||
|
4f82e80dad
|
|||
|
8e8198546f
|
|||
|
9497e310ca
|
|||
|
02135bdbae
|
|||
|
041a341879
|
|||
|
15dd810d67
|
|||
|
7982f3aec0
|
|||
|
2fb07201c7
|
|||
|
b5ca01dc4f
|
|||
|
fa523d590e
|
|||
|
523f2f57e1
|
|||
|
d662682fb5
|
|||
|
ff2b06a5e8
|
|||
|
aece305003
|
|||
|
ef8da9bcec
|
|||
|
3cd55beab1
|
|||
|
6766501858
|
|||
|
d5b41683ca
|
|||
|
ff8dbe111d
|
|||
|
28d4071fac
|
|||
|
31a523755f
|
|||
|
3d1d8f1af7
|
|||
|
167f6d0683
|
|||
|
8580487b61
|
|||
|
a8b1c33280
|
|||
|
fca2a4134b
|
|||
|
f90741f4d3
|
|||
|
ba4b45f7fb
|
|||
|
4767f3db5b
|
|||
|
709658462c
|
|||
|
c431c0ae00
|
|||
|
6f61b5dbef
|
|||
|
c42c4b64f9
|
|||
|
d3a36c2c9a
|
|||
|
6799e9616e
|
|||
|
|
e8d962ac44 | ||
|
ac1e145028
|
|||
|
2fdf121167
|
|||
|
dcca8b0bf2
|
|||
|
b1f891b005
|
|||
|
648dcc7287
|
|||
|
2175f7dd3d
|
|||
|
aff90a52f1
|
|||
|
0f14dee72a
|
|||
|
ae2031174e
|
|||
|
c163278c64
|
|||
|
d10133f06f
|
|||
|
4377fc663e
|
|||
|
487e236882
|
|||
|
|
8fc128e89b | ||
|
|
737f72f90f | ||
|
|
c3aab65521 | ||
|
|
972474f79a | ||
| bc64d2ade0 | |||
|
|
eddda55fe6 | ||
|
|
13aca91231 | ||
|
|
6011242eae | ||
|
|
cadb5086e1 | ||
|
|
10a30bbf38 | ||
|
|
6ac7a75bab | ||
|
bbd11bfa26
|
|||
|
75548fa02d
|
|||
|
fb6956009f
|
|||
|
e029117c3e
|
|||
|
bc7c01de90
|
|||
|
cfcd8a4c20
|
|||
|
5e17eb7ca7
|
|||
|
|
756727ffe2 | ||
|
6bc602dead
|
|||
|
056c79e813
|
|||
|
68bbf31a86
|
|||
|
b58f380e75
|
|||
|
|
d60f58cf43 | ||
|
|
7a6a119829 | ||
|
|
f0fb019c70 | ||
|
|
0f98ec6b78 | ||
|
|
107fed6e60 | ||
|
|
59a9a770a5 | ||
|
|
20bcb26e3d | ||
|
|
be82565775 | ||
|
|
f8d0243146 | ||
|
|
d7f82d643c | ||
|
|
15560a06b1 |
@@ -49,6 +49,7 @@ variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "ARM"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
retry: 2
|
||||
|
||||
.linux:aarch64:
|
||||
image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV"
|
||||
@@ -75,9 +76,17 @@ variables:
|
||||
ARCH: "ARM64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.freebsd:
|
||||
.freebsd13:
|
||||
tags:
|
||||
- x86_64-freebsd
|
||||
- x86_64-freebsd13
|
||||
variables:
|
||||
OS: "FREEBSD"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.freebsd12:
|
||||
tags:
|
||||
- x86_64-freebsd12
|
||||
variables:
|
||||
OS: "FREEBSD"
|
||||
ARCH: "64"
|
||||
@@ -90,6 +99,7 @@ variables:
|
||||
OS: "WINDOWS"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
retry: 2
|
||||
|
||||
.root_cleanup:
|
||||
after_script:
|
||||
@@ -99,7 +109,7 @@ variables:
|
||||
script:
|
||||
- bash ./.gitlab/script/ghcup_version.sh
|
||||
variables:
|
||||
JSON_VERSION: "0.0.7"
|
||||
JSON_VERSION: "0.0.6"
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
@@ -173,10 +183,18 @@ variables:
|
||||
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
|
||||
runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
|
||||
|
||||
.test_ghcup_version:freebsd:
|
||||
.test_ghcup_version:freebsd12:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .freebsd
|
||||
- .freebsd12
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
|
||||
.test_ghcup_version:freebsd13:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .freebsd13
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
@@ -207,7 +225,7 @@ variables:
|
||||
only:
|
||||
- tags
|
||||
variables:
|
||||
JSON_VERSION: "0.0.7"
|
||||
JSON_VERSION: "0.0.6"
|
||||
|
||||
######## stack test ########
|
||||
|
||||
@@ -263,6 +281,23 @@ test:linux:
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
needs: []
|
||||
|
||||
test:linux:hls:
|
||||
stage: test
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .debian
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
HLS_TARGET_VERSION: "1.4.0"
|
||||
CABAL_VERSION: "3.6.0.0"
|
||||
needs: []
|
||||
when: manual
|
||||
allow_failure: true
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_hls.sh
|
||||
|
||||
test:linux:cross-armv7:
|
||||
stage: test
|
||||
extends:
|
||||
@@ -355,9 +390,19 @@ test:mac:aarch64:
|
||||
|
||||
######## freebsd test ########
|
||||
|
||||
test:freebsd:
|
||||
test:freebsd12:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:freebsd
|
||||
extends: .test_ghcup_version:freebsd12
|
||||
variables:
|
||||
GHC_VERSION: "8.10.4"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
allow_failure: true # freebsd runners are unreliable
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
test:freebsd13:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:freebsd13
|
||||
variables:
|
||||
GHC_VERSION: "8.10.4"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
@@ -491,11 +536,26 @@ release:darwin:aarch64:
|
||||
|
||||
######## freebsd release ########
|
||||
|
||||
release:freebsd:
|
||||
release:freebsd12:
|
||||
stage: release
|
||||
needs: ["test:freebsd"]
|
||||
needs: ["test:freebsd12"]
|
||||
extends:
|
||||
- .freebsd
|
||||
- .freebsd12
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
GHC_VERSION: "8.10.6"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
allow_failure: true
|
||||
|
||||
release:freebsd13:
|
||||
stage: release
|
||||
needs: ["test:freebsd13"]
|
||||
extends:
|
||||
- .freebsd13
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
|
||||
@@ -11,9 +11,9 @@ mkdir -p "${TMPDIR}"
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin -v upgrade -i -f
|
||||
./ghcup-bin -v install ${GHC_VERSION}
|
||||
./ghcup-bin -v set ${GHC_VERSION}
|
||||
./ghcup-bin -v install-cabal ${CABAL_VERSION}
|
||||
|
||||
exit 0
|
||||
|
||||
@@ -7,67 +7,21 @@ set -eux
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
|
||||
sudo apt-get install -y autoconf build-essential gcc-arm-linux-gnueabihf
|
||||
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
|
||||
fi
|
||||
|
||||
case "${ARCH}" in
|
||||
ARM*)
|
||||
case "${ARCH}" in
|
||||
"ARM")
|
||||
ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-armv7-deb10-linux.tar.xz
|
||||
cabal_url=home.smart-cactus.org/~ben/cabal-install-${CABAL_VERSION}-armv7-linux-bootstrapped.tar.xz
|
||||
;;
|
||||
"ARM64")
|
||||
ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-aarch64-deb10-linux.tar.xz
|
||||
cabal_url=https://downloads.haskell.org/~cabal/cabal-install-${CABAL_VERSION}/cabal-install-${CABAL_VERSION}-aarch64-ubuntu-18.04.tar.xz
|
||||
;;
|
||||
*)
|
||||
exit 1 ;;
|
||||
esac
|
||||
export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
|
||||
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
|
||||
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
|
||||
export BOOTSTRAP_HASKELL_VERBOSE=1
|
||||
|
||||
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
||||
|
||||
curl -O "${ghc_url}"
|
||||
tar -xf ghc-*.tar.*
|
||||
cd ghc-${GHC_VERSION}
|
||||
./configure --prefix="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}
|
||||
make install
|
||||
for i in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}/bin/*-${GHC_VERSION} ; do
|
||||
ln -s "${i}" "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/${i##*/}
|
||||
done
|
||||
for x in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/*-${GHC_VERSION} ; do
|
||||
ln -s ${x##*/} ${x%-${GHC_VERSION}}
|
||||
done
|
||||
cd ..
|
||||
rm -rf ghc-${GHC_VERSION} ghc-*.tar.*
|
||||
unset x i
|
||||
|
||||
mkdir cabal-install
|
||||
cd cabal-install
|
||||
curl -O "${cabal_url}"
|
||||
tar -xf cabal-install-*
|
||||
mv cabal "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/cabal
|
||||
cd ..
|
||||
rm -rf cabal-install
|
||||
|
||||
;;
|
||||
*)
|
||||
url=https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup
|
||||
|
||||
curl -sSfL "${url}" > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin install ghc ${GHC_VERSION}
|
||||
./ghcup-bin set ghc ${GHC_VERSION}
|
||||
./ghcup-bin install cabal ${CABAL_VERSION}
|
||||
|
||||
;;
|
||||
esac
|
||||
rm "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
|
||||
|
||||
|
||||
@@ -1,9 +1,11 @@
|
||||
if [ "${OS}" = "WINDOWS" ] ; then
|
||||
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
|
||||
export PATH="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin:$CI_PROJECT_DIR/.local/bin:$PATH"
|
||||
export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
|
||||
export TMPDIR="$CI_PROJECT_DIR/tmp"
|
||||
else
|
||||
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
|
||||
export PATH="$CI_PROJECT_DIR/.ghcup/bin:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
|
||||
export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
|
||||
export TMPDIR="$CI_PROJECT_DIR/tmp"
|
||||
fi
|
||||
|
||||
51
.gitlab/script/ghcup_hls.sh
Executable file
51
.gitlab/script/ghcup_hls.sh
Executable file
@@ -0,0 +1,51 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
}
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
ecabal update
|
||||
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
|
||||
|
||||
### cleanup
|
||||
|
||||
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
|
||||
cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
|
||||
|
||||
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
|
||||
|
||||
# nuke
|
||||
eghcup nuke
|
||||
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
|
||||
|
||||
@@ -101,6 +101,10 @@ eghcup install ghc ${GHC_VERSION}
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
|
||||
eghcup unset cabal
|
||||
"$GHCUP_BIN"/cabal --version && exit || echo yes
|
||||
eghcup set cabal ${CABAL_VERSION}
|
||||
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
|
||||
|
||||
cabal --version
|
||||
|
||||
@@ -151,9 +155,13 @@ else
|
||||
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
||||
eghcup set ${GHC_VERSION}
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup unset ghc
|
||||
"$GHCUP_BIN"/ghc --numeric-version && exit || echo yes
|
||||
eghcup set ${GHC_VERSION}
|
||||
eghcup --offline rm 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
eghcup install hls
|
||||
$(eghcup whereis hls) --version
|
||||
@@ -164,9 +172,13 @@ else
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
eghcup install hls
|
||||
haskell-language-server-wrapper --version
|
||||
eghcup unset hls
|
||||
"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit || echo yes
|
||||
|
||||
eghcup install stack
|
||||
stack --version
|
||||
eghcup unset hls
|
||||
"$GHCUP_BIN"/stack --version && exit || echo yes
|
||||
fi
|
||||
fi
|
||||
fi
|
||||
|
||||
87
README.md
87
README.md
@@ -10,13 +10,15 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
|
||||
[](https://app.element.io/#/room/#haskell-tooling:matrix.org)
|
||||
[](https://discord.gg/pKYf3zDQU7)
|
||||
[](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
|
||||
<a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
|
||||
|
||||
* [Installation](#installation)
|
||||
* [Simple bootstrap](#simple-bootstrap)
|
||||
* [Supported platforms](#supported-platforms)
|
||||
* [Manual install](#manual-install)
|
||||
* [Vim integration](#vim-integration)
|
||||
* [Usage](#usage)
|
||||
* [Configuration](#configuration)
|
||||
* [GPG verification](#gpg-verification)
|
||||
* [Manpages](#manpages)
|
||||
* [Shell-completion](#shell-completion)
|
||||
* [Compiling GHC from source](#compiling-ghc-from-source)
|
||||
@@ -34,9 +36,59 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
|
||||
|
||||
## Installation
|
||||
|
||||
### Simple bootstrap
|
||||
Most users should follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/).
|
||||
Advanced users may want to perform a [manual installation](#manual-install).
|
||||
|
||||
Follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/)
|
||||
### Supported platforms
|
||||
|
||||
This list may not be exhaustive and specifies support for bindists only.
|
||||
|
||||
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
|
||||
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
|
||||
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows Server 2022 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Windows WSL1 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
|
||||
| Windows WSL2 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| MacOS >=13 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| MacOS <13 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
|
||||
| MacOS | aarch64 | ✅ | ✅ | ✅ | ⚠️ | ❌ |
|
||||
| FreeBSD | amd64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||
| Linux generic | x86 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Linux generic | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
|
||||
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
|
||||
|
||||
#### Windows 7
|
||||
|
||||
May or may not work, several issues:
|
||||
|
||||
* https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140
|
||||
* https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197
|
||||
|
||||
#### WSL1
|
||||
|
||||
Unsupported. GHC may or may not work. Upgrade to WSL2.
|
||||
|
||||
#### MacOS <13
|
||||
|
||||
Not supported. Would require separate binaries, since >=13 binaries are incompatible.
|
||||
Please upgrade.
|
||||
|
||||
#### MacOS aarch64
|
||||
|
||||
HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
|
||||
|
||||
#### FreeBSD
|
||||
|
||||
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
|
||||
HLS bindists are experimental.
|
||||
|
||||
#### Linux ARMv7/AARCH64
|
||||
|
||||
Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
|
||||
|
||||
### Manual install
|
||||
|
||||
@@ -95,6 +147,34 @@ explaining all possible configurations can be found in this repo: [config.yaml](
|
||||
|
||||
Partial configuration is fine. Command line options always override the config file settings.
|
||||
|
||||
### GPG verification
|
||||
|
||||
GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so
|
||||
this is cryptographically secure.
|
||||
|
||||
First, obtain the gpg key:
|
||||
|
||||
```sh
|
||||
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
|
||||
```
|
||||
|
||||
Then verify the gpg key in one of these ways:
|
||||
|
||||
1. find out where I live and visit me to do offline key signing
|
||||
2. figure out my mobile phone number and call me to verify the fingerprint
|
||||
3. more boring: contact me on Libera IRC (`maerwald`) and verify the fingerprint
|
||||
|
||||
Once you've verified the key, you have to figure out if you trust me.
|
||||
|
||||
If you trust me, then you can configure gpg in `~/.ghcup/config.yaml`:
|
||||
|
||||
```yml
|
||||
gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
|
||||
```
|
||||
|
||||
In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
|
||||
You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
|
||||
|
||||
### 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.
|
||||
@@ -155,6 +235,7 @@ This is the complete list of env variables that change GHCup behavior:
|
||||
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
|
||||
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
|
||||
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
|
||||
* `GHCUP_GPG_OPTS`: additional options that can be passed to gpg
|
||||
* `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
|
||||
* `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup
|
||||
|
||||
|
||||
@@ -11,21 +11,23 @@
|
||||
module Main where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Types.JSON ( )
|
||||
|
||||
import Control.Monad.Trans.Reader ( runReaderT )
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Char ( toLower )
|
||||
import Data.Maybe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Data.Semigroup ( (<>) )
|
||||
#endif
|
||||
import Options.Applicative hiding ( style )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import System.Console.Pretty
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO ( stderr )
|
||||
import Text.Regex.Posix
|
||||
@@ -114,12 +116,14 @@ com = subparser
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
||||
, colorOutter = T.hPutStr stderr
|
||||
, rawOutter = \_ -> pure ()
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
||||
, consoleOutter = T.hPutStr stderr
|
||||
, fileOutter = \_ -> pure ()
|
||||
, fancyColors = not no_color
|
||||
}
|
||||
dirs <- liftIO getAllDirs
|
||||
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings loggerConfig
|
||||
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig
|
||||
|
||||
pfreq <- (
|
||||
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
|
||||
@@ -129,7 +133,7 @@ main = do
|
||||
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
|
||||
liftIO $ exitWith (ExitFailure 2)
|
||||
|
||||
let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
|
||||
let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
|
||||
|
||||
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
|
||||
>>= \Options {..} -> case optCommand of
|
||||
|
||||
@@ -15,6 +15,7 @@ import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Version.QQ
|
||||
|
||||
import Codec.Archive
|
||||
@@ -229,6 +230,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
downloadAll ref dli = do
|
||||
r <- runResourceT
|
||||
. runE @'[DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, UnknownArchive
|
||||
, ArchiveResult
|
||||
@@ -237,7 +239,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
case etool of
|
||||
Right (Just GHCup) -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
|
||||
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
|
||||
pure Nothing
|
||||
Right _ -> do
|
||||
p <- liftE $ downloadCached dli Nothing
|
||||
@@ -247,7 +249,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
$ p
|
||||
Left ShimGen -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
|
||||
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
|
||||
pure Nothing
|
||||
case r of
|
||||
VRight (Just basePath) -> do
|
||||
|
||||
@@ -13,9 +13,9 @@ module BrickMain where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||
import GHCup.Utils.File
|
||||
|
||||
@@ -43,7 +43,6 @@ import Data.Vector ( Vector
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
@@ -429,6 +428,7 @@ install' _ (_, ListResult {..}) = do
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, DirNotEmpty
|
||||
, NoUpdate
|
||||
@@ -440,19 +440,19 @@ install' _ (_, ListResult {..}) = do
|
||||
case lTool of
|
||||
GHC -> do
|
||||
let vi = getVersionInfo lVer GHC dls
|
||||
liftE $ installGHCBin lVer Nothing $> vi
|
||||
liftE $ installGHCBin lVer Nothing False $> vi
|
||||
Cabal -> do
|
||||
let vi = getVersionInfo lVer Cabal dls
|
||||
liftE $ installCabalBin lVer Nothing $> vi
|
||||
liftE $ installCabalBin lVer Nothing False $> vi
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False $> vi
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
liftE $ installHLSBin lVer Nothing $> vi
|
||||
liftE $ installHLSBin lVer Nothing False $> vi
|
||||
Stack -> do
|
||||
let vi = getVersionInfo lVer Stack dls
|
||||
liftE $ installStackBin lVer Nothing $> vi
|
||||
liftE $ installStackBin lVer Nothing False $> vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
@@ -536,9 +536,10 @@ settings' :: IORef AppState
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO $ do
|
||||
dirs <- getAllDirs
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, consoleOutter = \_ -> pure ()
|
||||
, fileOutter = \_ -> pure ()
|
||||
, fancyColors = True
|
||||
}
|
||||
newIORef $ AppState (Settings { cache = True
|
||||
, noVerify = False
|
||||
@@ -547,6 +548,8 @@ settings' = unsafePerformIO $ do
|
||||
, verbose = False
|
||||
, urlSource = GHCupURL
|
||||
, noNetwork = False
|
||||
, gpgSetting = GPGNone
|
||||
, noColor = False
|
||||
, ..
|
||||
})
|
||||
dirs
|
||||
@@ -562,13 +565,11 @@ brickMain :: AppState
|
||||
brickMain s = do
|
||||
writeIORef settings' s
|
||||
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
eAppData <- getAppData (Just $ ghcupInfo s)
|
||||
case eAppData of
|
||||
Right ad ->
|
||||
defaultMain
|
||||
(app (defaultAttributes no_color) (dimAttributes no_color))
|
||||
(app (defaultAttributes (noColor $ settings s)) (dimAttributes (noColor $ settings s)))
|
||||
(BrickState ad
|
||||
defaultAppSettings
|
||||
(constructList ad defaultAppSettings Nothing)
|
||||
@@ -591,7 +592,7 @@ getGHCupInfo = do
|
||||
|
||||
r <-
|
||||
flip runReaderT settings
|
||||
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
. runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
|
||||
|
||||
@@ -49,7 +49,6 @@ import Data.Char
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.List ( intercalate, nub, sort, sortBy )
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions hiding ( str )
|
||||
@@ -87,21 +86,23 @@ import qualified Text.Megaparsec.Char as MPC
|
||||
data Options = Options
|
||||
{
|
||||
-- global options
|
||||
optVerbose :: Maybe Bool
|
||||
, optCache :: Maybe Bool
|
||||
, optUrlSource :: Maybe URI
|
||||
, optNoVerify :: Maybe Bool
|
||||
, optKeepDirs :: Maybe KeepDirs
|
||||
optVerbose :: Maybe Bool
|
||||
, optCache :: Maybe Bool
|
||||
, optUrlSource :: Maybe URI
|
||||
, optNoVerify :: Maybe Bool
|
||||
, optKeepDirs :: Maybe KeepDirs
|
||||
, optsDownloader :: Maybe Downloader
|
||||
, optNoNetwork :: Maybe Bool
|
||||
, optNoNetwork :: Maybe Bool
|
||||
, optGpg :: Maybe GPGSetting
|
||||
-- commands
|
||||
, optCommand :: Command
|
||||
, optCommand :: Command
|
||||
}
|
||||
|
||||
data Command
|
||||
= Install (Either InstallCommand InstallOptions)
|
||||
| InstallCabalLegacy InstallOptions
|
||||
| Set (Either SetCommand SetOptions)
|
||||
| UnSet UnsetCommand
|
||||
| List ListOptions
|
||||
| Rm (Either RmCommand RmOptions)
|
||||
| DInfo
|
||||
@@ -116,6 +117,7 @@ data Command
|
||||
| Interactive
|
||||
#endif
|
||||
| Prefetch PrefetchCommand
|
||||
| GC GCOptions
|
||||
|
||||
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
|
||||
| ToolTag Tag
|
||||
@@ -141,6 +143,16 @@ data InstallOptions = InstallOptions
|
||||
, instBindist :: Maybe URI
|
||||
, instSet :: Bool
|
||||
, isolateDir :: Maybe FilePath
|
||||
, forceInstall :: Bool
|
||||
}
|
||||
|
||||
data GCOptions = GCOptions
|
||||
{ gcOldGHC :: Bool
|
||||
, gcProfilingLibs :: Bool
|
||||
, gcShareDir :: Bool
|
||||
, gcHLSNoGHC :: Bool
|
||||
, gcCache :: Bool
|
||||
, gcTmp :: Bool
|
||||
}
|
||||
|
||||
data SetCommand = SetGHC SetOptions
|
||||
@@ -148,6 +160,11 @@ data SetCommand = SetGHC SetOptions
|
||||
| SetHLS SetOptions
|
||||
| SetStack SetOptions
|
||||
|
||||
data UnsetCommand = UnsetGHC UnsetOptions
|
||||
| UnsetCabal UnsetOptions
|
||||
| UnsetHLS UnsetOptions
|
||||
| UnsetStack UnsetOptions
|
||||
|
||||
-- a superset of ToolVersion
|
||||
data SetToolVersion = SetToolVersion GHCTargetVersion
|
||||
| SetToolTag Tag
|
||||
@@ -158,6 +175,10 @@ data SetOptions = SetOptions
|
||||
{ sToolVer :: SetToolVersion
|
||||
}
|
||||
|
||||
data UnsetOptions = UnsetOptions
|
||||
{ sToolVer :: Maybe Text -- target platform triple
|
||||
}
|
||||
|
||||
data ListOptions = ListOptions
|
||||
{ loTool :: Maybe Tool
|
||||
, lCriteria :: Maybe ListCriteria
|
||||
@@ -175,6 +196,7 @@ data RmOptions = RmOptions
|
||||
|
||||
|
||||
data CompileCommand = CompileGHC GHCCompileOptions
|
||||
| CompileHLS HLSCompileOptions
|
||||
|
||||
data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
|
||||
|
||||
@@ -193,6 +215,18 @@ data GHCCompileOptions = GHCCompileOptions
|
||||
, isolateDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
data HLSCompileOptions = HLSCompileOptions
|
||||
{ targetHLS :: Either Version GitBranch
|
||||
, jobs :: Maybe Int
|
||||
, setCompile :: Bool
|
||||
, ovewrwiteVer :: Maybe Version
|
||||
, isolateDir :: Maybe FilePath
|
||||
, cabalProject :: Maybe FilePath
|
||||
, cabalProjectLocal :: Maybe FilePath
|
||||
, patchDir :: Maybe FilePath
|
||||
, targetGHCs :: [ToolVersion]
|
||||
}
|
||||
|
||||
data UpgradeOpts = UpgradeInplace
|
||||
| UpgradeAt FilePath
|
||||
| UpgradeGHCupDir
|
||||
@@ -309,6 +343,13 @@ opts =
|
||||
<> hidden
|
||||
))
|
||||
<*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
|
||||
<*> optional (option
|
||||
(eitherReader gpgParser)
|
||||
( long "gpg"
|
||||
<> metavar "<strict|lax|none>"
|
||||
<> help
|
||||
"GPG verification (default: none)"
|
||||
))
|
||||
<*> com
|
||||
where
|
||||
parseUri s' =
|
||||
@@ -348,6 +389,14 @@ com =
|
||||
<> footerDoc (Just $ text setFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"unset"
|
||||
(info
|
||||
(UnSet <$> unsetParser <**> helper)
|
||||
( progDesc "Unset currently active GHC/cabal version"
|
||||
<> footerDoc (Just $ text unsetFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"rm"
|
||||
(info
|
||||
@@ -399,6 +448,16 @@ com =
|
||||
(progDesc "Prefetch assets"
|
||||
<> footerDoc ( Just $ text prefetchFooter ))
|
||||
)
|
||||
<> command
|
||||
"gc"
|
||||
(info
|
||||
( (GC
|
||||
<$> gcP
|
||||
) <**> helper
|
||||
)
|
||||
(progDesc "Garbage collection"
|
||||
<> footerDoc ( Just $ text gcFooter ))
|
||||
)
|
||||
<> commandGroup "Main commands:"
|
||||
)
|
||||
<|> subparser
|
||||
@@ -445,6 +504,7 @@ com =
|
||||
(info (pure Nuke <**> helper)
|
||||
(progDesc "Completely remove ghcup from your system"))
|
||||
<> commandGroup "Nuclear Commands:"
|
||||
<> hidden
|
||||
)
|
||||
|
||||
where
|
||||
@@ -461,6 +521,10 @@ com =
|
||||
is given, sets GHC to 'recommended' version).
|
||||
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
|
||||
|
||||
unsetFooter :: String
|
||||
unsetFooter = [s|Discussion:
|
||||
Unsets the currently active GHC or cabal version.|]
|
||||
|
||||
rmFooter :: String
|
||||
rmFooter = [s|Discussion:
|
||||
Remove the given GHC or cabal version. When no command is given,
|
||||
@@ -499,6 +563,10 @@ Examples:
|
||||
ghcup prefetch ghc 8.10.5
|
||||
ghcup --offline install ghc 8.10.5|]
|
||||
|
||||
gcFooter :: String
|
||||
gcFooter = [s|Discussion:
|
||||
Performs garbage collection. If no switches are specified, does nothing.|]
|
||||
|
||||
configFooter :: String
|
||||
configFooter = [s|Examples:
|
||||
|
||||
@@ -602,7 +670,7 @@ Examples:
|
||||
|
||||
installOpts :: Maybe Tool -> Parser InstallOptions
|
||||
installOpts tool =
|
||||
(\p (u, v) b is -> InstallOptions v p u b is)
|
||||
(\p (u, v) b is f -> InstallOptions v p u b is f)
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader platformParser)
|
||||
@@ -640,6 +708,9 @@ installOpts tool =
|
||||
<> help "install in an isolated dir instead of the default one"
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
(short 'f' <> long "force" <> help "Force install")
|
||||
|
||||
|
||||
|
||||
setParser :: Parser (Either SetCommand SetOptions)
|
||||
@@ -703,19 +774,81 @@ setParser =
|
||||
setHLSFooter = [s|Discussion:
|
||||
Sets the the current haskell-language-server version.|]
|
||||
|
||||
unsetParser :: Parser UnsetCommand
|
||||
unsetParser =
|
||||
(subparser
|
||||
( command
|
||||
"ghc"
|
||||
( UnsetGHC
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset GHC version"
|
||||
<> footerDoc (Just $ text unsetGHCFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"cabal"
|
||||
( UnsetCabal
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset Cabal version"
|
||||
<> footerDoc (Just $ text unsetCabalFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( UnsetHLS
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset haskell-language-server version"
|
||||
<> footerDoc (Just $ text unsetHLSFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( UnsetStack
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset stack version"
|
||||
<> footerDoc (Just $ text unsetStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
where
|
||||
unsetGHCFooter :: String
|
||||
unsetGHCFooter = [s|Discussion:
|
||||
Unsets the the current GHC version. That means there won't
|
||||
be a ~/.ghcup/bin/ghc anymore.|]
|
||||
|
||||
unsetCabalFooter :: String
|
||||
unsetCabalFooter = [s|Discussion:
|
||||
Unsets the the current Cabal version.|]
|
||||
|
||||
unsetStackFooter :: String
|
||||
unsetStackFooter = [s|Discussion:
|
||||
Unsets the the current Stack version.|]
|
||||
|
||||
unsetHLSFooter :: String
|
||||
unsetHLSFooter = [s|Discussion:
|
||||
Unsets the the current haskell-language-server version.|]
|
||||
|
||||
|
||||
setOpts :: Maybe Tool -> Parser SetOptions
|
||||
setOpts tool = SetOptions <$>
|
||||
(fromMaybe SetRecommended <$>
|
||||
optional (setVersionArgument (Just ListInstalled) tool))
|
||||
|
||||
unsetOpts :: Parser UnsetOptions
|
||||
unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
|
||||
|
||||
listOpts :: Parser ListOptions
|
||||
listOpts =
|
||||
ListOptions
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader toolParser)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal>" <> help
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||
"Tool to list versions for. Default is all"
|
||||
)
|
||||
)
|
||||
@@ -724,8 +857,8 @@ listOpts =
|
||||
(eitherReader criteriaParser)
|
||||
( short 'c'
|
||||
<> long "show-criteria"
|
||||
<> metavar "<installed|set>"
|
||||
<> help "Show only installed or set tool versions"
|
||||
<> metavar "<installed|set|available>"
|
||||
<> help "Show only installed/set/available tool versions"
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
@@ -799,6 +932,15 @@ compileP = subparser
|
||||
<> footerDoc (Just $ text compileFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( CompileHLS
|
||||
<$> info
|
||||
(hlsCompileOpts <**> helper)
|
||||
( progDesc "Compile HLS from source"
|
||||
<> footerDoc (Just $ text compileHLSFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
where
|
||||
compileFooter = [s|Discussion:
|
||||
@@ -823,6 +965,14 @@ Examples:
|
||||
# build cross compiler
|
||||
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
|
||||
|
||||
compileHLSFooter = [s|Discussion:
|
||||
Compiles and installs the specified HLS version.
|
||||
The last argument is a list of GHC versions to compile for.
|
||||
These need to be available in PATH prior to compilation.
|
||||
|
||||
Examples:
|
||||
ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
|
||||
|
||||
configP :: Parser ConfigCommand
|
||||
configP = subparser
|
||||
( command "init" initP
|
||||
@@ -997,6 +1147,28 @@ prefetchP = subparser
|
||||
)
|
||||
)
|
||||
|
||||
gcP :: Parser GCOptions
|
||||
gcP =
|
||||
GCOptions
|
||||
<$>
|
||||
switch
|
||||
(short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'")
|
||||
<*>
|
||||
switch
|
||||
(short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions")
|
||||
<*>
|
||||
switch
|
||||
(short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)")
|
||||
<*>
|
||||
switch
|
||||
(short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version")
|
||||
<*>
|
||||
switch
|
||||
(short 'c' <> long "cache" <> help "GC the GHCup cache")
|
||||
<*>
|
||||
switch
|
||||
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
|
||||
|
||||
|
||||
ghcCompileOpts :: Parser GHCCompileOptions
|
||||
ghcCompileOpts =
|
||||
@@ -1092,6 +1264,78 @@ ghcCompileOpts =
|
||||
)
|
||||
)
|
||||
|
||||
hlsCompileOpts :: Parser HLSCompileOptions
|
||||
hlsCompileOpts =
|
||||
HLSCompileOptions
|
||||
<$> ((Left <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
str
|
||||
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
||||
"The git commit/branch/ref to build from"
|
||||
) <*>
|
||||
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
|
||||
)))
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader (readEither @Int))
|
||||
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
|
||||
"How many jobs to use for make"
|
||||
)
|
||||
)
|
||||
<*> flag
|
||||
False
|
||||
True
|
||||
(long "set" <> help
|
||||
"Set as active version after install"
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(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'"
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
str
|
||||
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
|
||||
"If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader absolutePathParser)
|
||||
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
|
||||
"Absolute path to a cabal.project.local to be used for the build. Will be copied over."
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader absolutePathParser)
|
||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
)
|
||||
)
|
||||
<*> some (toolVersionArgument Nothing (Just GHC))
|
||||
|
||||
|
||||
toolVersionParser :: Parser ToolVersion
|
||||
toolVersionParser = verP' <|> toolP
|
||||
@@ -1107,9 +1351,13 @@ toolVersionParser = verP' <|> toolP
|
||||
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionArgument criteria tool =
|
||||
argument (eitherReader toolVersionEither)
|
||||
(metavar "VERSION|TAG"
|
||||
(metavar (mv tool)
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
mv (Just GHC) = "GHC_VERSION|TAG"
|
||||
mv (Just HLS) = "HLS_VERSION|TAG"
|
||||
mv _ = "VERSION|TAG"
|
||||
|
||||
|
||||
setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
|
||||
@@ -1136,12 +1384,13 @@ tagCompleter :: Tool -> [String] -> Completer
|
||||
tagCompleter tool add = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
{ lcPrintDebug = False
|
||||
, consoleOutter = mempty
|
||||
, fileOutter = mempty
|
||||
, fancyColors = False
|
||||
}
|
||||
let appState = LeanAppState
|
||||
(Settings True False Never Curl False GHCupURL True)
|
||||
(Settings True False Never Curl False GHCupURL True GPGNone False)
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
@@ -1162,11 +1411,12 @@ versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
{ lcPrintDebug = False
|
||||
, consoleOutter = mempty
|
||||
, fileOutter = mempty
|
||||
, fancyColors = False
|
||||
}
|
||||
let settings = Settings True False Never Curl False GHCupURL True
|
||||
let settings = Settings True False Never Curl False GHCupURL True GPGNone False
|
||||
let leanAppState = LeanAppState
|
||||
settings
|
||||
dirs'
|
||||
@@ -1225,6 +1475,8 @@ toolVersionEither s' =
|
||||
toolParser :: String -> Either String Tool
|
||||
toolParser s' | t == T.pack "ghc" = Right GHC
|
||||
| t == T.pack "cabal" = Right Cabal
|
||||
| t == T.pack "hls" = Right HLS
|
||||
| t == T.pack "stack" = Right Stack
|
||||
| otherwise = Left ("Unknown tool: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
@@ -1232,6 +1484,7 @@ toolParser s' | t == T.pack "ghc" = Right GHC
|
||||
criteriaParser :: String -> Either String ListCriteria
|
||||
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
||||
| t == T.pack "set" = Right ListSet
|
||||
| t == T.pack "available" = Right ListAvailable
|
||||
| otherwise = Left ("Unknown criteria: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
@@ -1253,6 +1506,13 @@ downloaderParser s' | t == T.pack "curl" = Right Curl
|
||||
| otherwise = Left ("Unknown downloader value: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
gpgParser :: String -> Either String GPGSetting
|
||||
gpgParser s' | t == T.pack "strict" = Right GPGStrict
|
||||
| t == T.pack "lax" = Right GPGLax
|
||||
| t == T.pack "none" = Right GPGNone
|
||||
| otherwise = Left ("Unknown gpg setting value: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
platformParser :: String -> Either String PlatformRequest
|
||||
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
@@ -1311,8 +1571,14 @@ isolateParser f = case isValid f of
|
||||
True -> Right $ normalise f
|
||||
False -> Left "Please enter a valid filepath for isolate dir."
|
||||
|
||||
absolutePathParser :: FilePath -> Either String FilePath
|
||||
absolutePathParser f = case isValid f && isAbsolute f of
|
||||
True -> Right $ normalise f
|
||||
False -> Left "Please enter a valid absolute filepath."
|
||||
|
||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
||||
toSettings options = do
|
||||
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
||||
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft (V (JSONDecodeError e)) -> do
|
||||
@@ -1320,10 +1586,10 @@ toSettings options = do
|
||||
pure defaultUserSettings
|
||||
_ -> do
|
||||
die "Unexpected error!"
|
||||
pure $ mergeConf options userConf
|
||||
pure $ mergeConf options userConf noColor
|
||||
where
|
||||
mergeConf :: Options -> UserSettings -> (Settings, KeyBindings)
|
||||
mergeConf Options{..} UserSettings{..} =
|
||||
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
||||
mergeConf Options{..} UserSettings{..} noColor =
|
||||
let cache = fromMaybe (fromMaybe False uCache) optCache
|
||||
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
|
||||
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
|
||||
@@ -1332,6 +1598,7 @@ toSettings options = do
|
||||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
|
||||
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
|
||||
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
|
||||
gpgSetting = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg
|
||||
in (Settings {..}, keyBindings)
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
defaultDownloader = Internal
|
||||
@@ -1367,7 +1634,8 @@ updateSettings config settings = do
|
||||
verbose' = fromMaybe verbose uVerbose
|
||||
urlSource' = fromMaybe urlSource uUrlSource
|
||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork'
|
||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
|
||||
|
||||
upgradeOptsP :: Parser UpgradeOpts
|
||||
upgradeOptsP =
|
||||
@@ -1392,7 +1660,7 @@ describe_result = $( LitE . StringL <$>
|
||||
runIO (do
|
||||
CapturedProcess{..} <- do
|
||||
dirs <- liftIO getAllDirs
|
||||
let settings = AppState (Settings True False Never Curl False GHCupURL False)
|
||||
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False)
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
flip runReaderT settings $ executeOut "git" ["describe"] Nothing
|
||||
@@ -1472,17 +1740,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- flip runReaderT dirs initGHCupFileLogging
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = verbose settings
|
||||
, colorOutter = T.hPutStr stderr
|
||||
, rawOutter =
|
||||
, consoleOutter = T.hPutStr stderr
|
||||
, fileOutter =
|
||||
case optCommand of
|
||||
Nuke -> \_ -> pure ()
|
||||
_ -> T.appendFile logfile
|
||||
, fancyColors = not no_color
|
||||
}
|
||||
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
|
||||
let runLogger = flip runReaderT leanAppstate
|
||||
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
|
||||
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { consoleOutter = \_ -> pure () } } :: LeanAppState)
|
||||
|
||||
|
||||
-------------------------
|
||||
@@ -1502,7 +1772,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
ghcupInfo <-
|
||||
( flip runReaderT leanAppstate
|
||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
. runE @'[DigestError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
)
|
||||
@@ -1523,6 +1793,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
DInfo -> pure ()
|
||||
ToolRequirements -> pure ()
|
||||
ChangeLog _ -> pure ()
|
||||
UnSet _ -> pure ()
|
||||
#if defined(BRICK)
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
@@ -1575,6 +1846,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, TarDirDoesNotExist
|
||||
, NextVerNotFound
|
||||
@@ -1607,6 +1879,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
runUnsetGHC =
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled ]
|
||||
|
||||
let
|
||||
runLeanSetCabal =
|
||||
runLeanAppState
|
||||
@@ -1665,6 +1942,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
@'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, GHCupSetError
|
||||
, NoDownload
|
||||
@@ -1677,6 +1955,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, ArchiveResult
|
||||
]
|
||||
|
||||
let runCompileHLS =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, GHCupSetError
|
||||
, NoDownload
|
||||
, NotFoundInPATH
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, NotInstalled
|
||||
, DirNotEmpty
|
||||
, ArchiveResult
|
||||
]
|
||||
|
||||
let
|
||||
runLeanWhereIs =
|
||||
-- Don't use runLeanAppState here, which is disabled on windows.
|
||||
@@ -1703,6 +2004,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ DigestError
|
||||
, GPGError
|
||||
, NoDownload
|
||||
, NoUpdate
|
||||
, FileDoesNotExistError
|
||||
@@ -1719,11 +2021,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, NoToolVersionSet
|
||||
, NoDownload
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, JSONError
|
||||
, FileDoesNotExistError
|
||||
]
|
||||
|
||||
let runGC =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
]
|
||||
|
||||
|
||||
-----------------------
|
||||
-- Command functions --
|
||||
@@ -1733,7 +2043,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
liftE $ installGHCBin (_tvVersion v) isolateDir
|
||||
liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||
pure vi
|
||||
Just uri -> do
|
||||
@@ -1741,9 +2054,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
liftE $ installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||
pure vi
|
||||
)
|
||||
@@ -1755,8 +2069,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
|
||||
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (DirNotEmpty fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
|
||||
pure $ ExitFailure 3
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger $ (logError $ T.pack $ prettyShow err)
|
||||
@@ -1775,16 +2093,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ installCabalBin (_tvVersion v) isolateDir
|
||||
liftE $ installCabalBin
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- appState
|
||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
liftE $ installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -1795,8 +2117,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal " <> prettyVer v <> "' first"
|
||||
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
@@ -1807,16 +2133,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||
liftE $ installHLSBin (_tvVersion v) isolateDir
|
||||
liftE $ installHLSBin
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- appState
|
||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||
liftE $ installHLSBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -1829,10 +2159,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ logWarn $
|
||||
"HLS ver "
|
||||
<> prettyVer v
|
||||
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls "
|
||||
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
|
||||
<> prettyVer v
|
||||
<> "' first"
|
||||
<> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
@@ -1843,16 +2177,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ installStackBin (_tvVersion v) isolateDir
|
||||
liftE $ installStackBin
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
Just uri -> do
|
||||
s' <- appState
|
||||
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -1863,8 +2201,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack " <> prettyVer v <> "' first"
|
||||
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
@@ -2032,10 +2374,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Set (Left (SetHLS sopts)) -> setHLS' sopts
|
||||
Set (Left (SetStack sopts)) -> setStack' sopts
|
||||
|
||||
UnSet (UnsetGHC (UnsetOptions triple)) -> runUnsetGHC (unsetGHC triple)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
runLogger $ logInfo "GHC successfully unset"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
UnSet (UnsetCabal (UnsetOptions _)) -> do
|
||||
runAppState unsetCabal
|
||||
runLogger $ logInfo "Cabal successfully unset"
|
||||
pure ExitSuccess
|
||||
UnSet (UnsetHLS (UnsetOptions _)) -> do
|
||||
runAppState unsetHLS
|
||||
runLogger $ logInfo "HLS successfully unset"
|
||||
pure ExitSuccess
|
||||
UnSet (UnsetStack (UnsetOptions _)) -> do
|
||||
runAppState unsetStack
|
||||
runLogger $ logInfo "Stack successfully unset"
|
||||
pure ExitSuccess
|
||||
|
||||
List ListOptions {..} ->
|
||||
runListGHC (do
|
||||
l <- listVersions loTool lCriteria
|
||||
liftIO $ printListResult lRawFormat l
|
||||
liftIO $ printListResult no_color lRawFormat l
|
||||
pure ExitSuccess
|
||||
)
|
||||
|
||||
@@ -2057,6 +2420,53 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 8
|
||||
|
||||
Compile (CompileHLS HLSCompileOptions { .. }) -> do
|
||||
runCompileHLS (do
|
||||
case targetHLS of
|
||||
Left targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
|
||||
targetVer <- liftE $ compileHLS
|
||||
targetHLS
|
||||
ghcs
|
||||
jobs
|
||||
ovewrwiteVer
|
||||
isolateDir
|
||||
cabalProject
|
||||
cabalProjectLocal
|
||||
patchDir
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
when setCompile $ void $ liftE $
|
||||
setHLS targetVer
|
||||
pure (vi, targetVer)
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, tv) -> do
|
||||
runLogger $ logInfo
|
||||
"HLS successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
putStr (T.unpack $ prettyVer tv)
|
||||
pure ExitSuccess
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack logsDir <> " and the build directory "
|
||||
<> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 9
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 9
|
||||
Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
||||
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
||||
pure $ ExitFailure 9
|
||||
@@ -2099,8 +2509,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
|
||||
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (DirNotEmpty fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
|
||||
pure $ ExitFailure 3
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||
@@ -2339,6 +2753,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
GC GCOptions{..} ->
|
||||
runGC (do
|
||||
when gcOldGHC rmOldGHC
|
||||
lift $ when gcProfilingLibs rmProfilingLibs
|
||||
lift $ when gcShareDir rmShareDir
|
||||
lift $ when gcHLSNoGHC rmHLSNoGHC
|
||||
lift $ when gcCache rmCache
|
||||
lift $ when gcTmp rmTmp
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 27
|
||||
|
||||
|
||||
case res of
|
||||
@@ -2389,13 +2817,15 @@ fromVersion' SetRecommended tool = do
|
||||
fromVersion' (SetToolVersion v) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
||||
case pvp $ prettyVer (_tvVersion v) of
|
||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||
Left _ -> pure (v, vi)
|
||||
Right (PVP (major' :|[minor'])) ->
|
||||
case getLatestGHCFor (fromIntegral major') (fromIntegral minor') dls of
|
||||
Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
||||
Right pvpIn ->
|
||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
||||
Just (pvp_, vi') -> do
|
||||
v' <- lift $ pvpToVersion pvp_
|
||||
when (v' /= (_tvVersion v)) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
||||
Nothing -> pure (v, vi)
|
||||
Right _ -> pure (v, vi)
|
||||
fromVersion' (SetToolTag Latest) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
(\(x, y) -> (mkTVer x, Just y)) <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
@@ -2455,9 +2885,8 @@ fromVersion' (SetToolTag t') tool =
|
||||
throwE $ TagNotFound t' tool
|
||||
|
||||
|
||||
printListResult :: Bool -> [ListResult] -> IO ()
|
||||
printListResult raw lr = do
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
printListResult :: Bool -> Bool -> [ListResult] -> IO ()
|
||||
printListResult no_color raw lr = do
|
||||
|
||||
let
|
||||
color | raw || no_color = flip const
|
||||
|
||||
@@ -8,11 +8,6 @@ package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
|
||||
@@ -8,6 +8,10 @@ verbose: False
|
||||
keep-dirs: Errors # Always | Never | Errors
|
||||
# Which downloader to use
|
||||
downloader: Curl # Curl | Wget | Internal
|
||||
# whether to run in offline mode
|
||||
no-network: False
|
||||
# whether/how to do gpg verification
|
||||
gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
|
||||
|
||||
# TUI key bindings,
|
||||
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
|
||||
|
||||
@@ -72,7 +72,6 @@ toolRequirements:
|
||||
'( >= 7 && < 8 )':
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -83,7 +82,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -96,7 +94,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -111,14 +108,15 @@ toolRequirements:
|
||||
- binutils-gold
|
||||
- curl
|
||||
- gcc
|
||||
- g++
|
||||
- gmp-dev
|
||||
- ncurses-dev
|
||||
- libc-dev
|
||||
- libffi-dev
|
||||
- make
|
||||
- xz
|
||||
- tar
|
||||
- musl-dev
|
||||
- ncurses-dev
|
||||
- perl
|
||||
- tar
|
||||
- xz
|
||||
notes: ''
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
@@ -1495,6 +1493,7 @@ ghcupDownloads:
|
||||
dlHash: b823b58cae36fbac0741680ca7605180fa4cf4c6ae439123d282184b94d32fd6
|
||||
8.10.4:
|
||||
viTags:
|
||||
- old
|
||||
- base-4.14.1.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.4/docs/html/users_guide/8.10.4-notes.html
|
||||
viSourceDL:
|
||||
@@ -1590,6 +1589,7 @@ ghcupDownloads:
|
||||
dlHash: 0d18ef83593272f6196a41cc3abdc48dfe5e14372db75d71ea19fe35320c4e81
|
||||
8.10.5:
|
||||
viTags:
|
||||
- old
|
||||
- base-4.14.2.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.5/docs/html/users_guide/8.10.5-notes.html
|
||||
viSourceDL:
|
||||
@@ -1598,6 +1598,11 @@ ghcupDownloads:
|
||||
dlHash: f10941f16e4fbd98580ab5241b9271bb0851304560c4d5ca127e3b0e20e3076f
|
||||
viPostRemove: *ghc-post-remove
|
||||
viPreCompile: *ghc-pre-compile
|
||||
viPostInstall: &ghc-8105-post-install |
|
||||
GHC 8.10.5 and 8.10.6 have several issues on Darwin, e.g.
|
||||
https://gitlab.haskell.org/ghc/ghc/-/issues/19950
|
||||
Consider upgrading to 8.10.7 via
|
||||
ghcup install ghc --set 8.10.7
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_Debian:
|
||||
@@ -1690,6 +1695,7 @@ ghcupDownloads:
|
||||
dlHash: 56170d1a8450e18b7eb9c23c94723da352815b27ec250bb23742a62f16dcab6c
|
||||
8.10.6:
|
||||
viTags:
|
||||
- old
|
||||
- base-4.14.3.0
|
||||
viChangeLog: https://downloads.haskell.org/~ghc/8.10.6/docs/html/users_guide/8.10.6-notes.html
|
||||
viSourceDL:
|
||||
@@ -1698,6 +1704,7 @@ ghcupDownloads:
|
||||
dlHash: 43afba72a533408b42c1492bd047b5e37e5f7204e41a5cedd3182cc841610ce9
|
||||
viPostRemove: *ghc-post-remove
|
||||
viPreCompile: *ghc-pre-compile
|
||||
viPostInstall: *ghc-8105-post-install
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_Debian:
|
||||
@@ -2053,6 +2060,11 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~ghc/9.2.1-rc1/ghc-9.2.0.20210821-aarch64-deb10-linux.tar.xz
|
||||
dlSubdir: ghc-9.2.0.20210821
|
||||
dlHash: 289fc361be4a3199ac15449e30405a9831454811dd454e81eab73bfcdd2c4088
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghc/9.2.1-rc1/ghc-9.2.0.20210821-aarch64-apple-darwin.tar.xz
|
||||
dlSubdir: ghc-9.2.0.20210821-aarch64-apple-darwin
|
||||
dlHash: 0d763fb619cfa32fa37c113c446e13bebc2215db5946e5fa8fd8400559cf4152
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
@@ -2170,9 +2182,7 @@ ghcupDownloads:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz
|
||||
dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93
|
||||
3.4.0.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viTags: []
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
@@ -2221,8 +2231,53 @@ ghcupDownloads:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
|
||||
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
|
||||
3.6.0.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux.tar.xz
|
||||
dlHash: bfcb7350966dafe95051b5fc9fcb989c5708ab9e78191e71fc04647061668a11
|
||||
Linux_Alpine:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux-alpine.tar.xz
|
||||
dlHash: 3203d71b7ee87fc9dce74b452ae07f420afe8817b5e6f84e54798442f4ccdda8
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-darwin.tar.xz
|
||||
dlHash: 8e1367a4a1fc86ff0fd82ee057320a7b974595ba7999457b42035467ba06190c
|
||||
FreeBSD:
|
||||
'( >= 12 && < 13 )':
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd.tar.xz
|
||||
dlHash: 56b5b37396c16a29f164a6963f24bd88f09e1d37448542ed61a683325f0a868b
|
||||
'( >= 13 )':
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd13.tar.xz
|
||||
dlHash: a283aa498702a3e286aa08e004c2a389538cbb47ec7096a25682fb7d57f6bb7f
|
||||
Windows:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-windows.zip
|
||||
dlSubdir:
|
||||
dlHash: 8222b49b6eac3d06aaa390bc688f467e8f949a38943567f46246f8320fd72ded
|
||||
A_ARM64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-aarch64-linux-deb10.tar.xz
|
||||
dlHash: 534f71cd4e1d9758dc73066cc5733c5838874710aeb3aa88541de6c6d042d9ec
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-aarch64-darwin-big-sur.tar.xz
|
||||
dlHash: 7acf740946d996ede835edf68887e6b2f1e16d1b95e94054d266463f38d136d9
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
|
||||
dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
|
||||
GHCup:
|
||||
0.1.16.2:
|
||||
0.1.17.1:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
@@ -2232,46 +2287,47 @@ ghcupDownloads:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning: &ghcup-64
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
|
||||
dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-linux-ghcup-0.1.17.1
|
||||
dlHash: 2824687fe3965374f463ae49f9d8abd9d3d556a0f63880bc78b5ee02098ba142
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
|
||||
dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-apple-darwin-ghcup-0.1.17.1
|
||||
dlHash: 0dd4e5afc7d93bdef20ba16085ae9f2aa5e4acd6b34e75a3b31b1fcc8ea451a9
|
||||
FreeBSD:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
|
||||
dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-freebsd-ghcup-0.1.17.1
|
||||
dlHash: a480ba827c07ed50d9ab724bd80198722a85b7bb683c5bcc1e8b1df2be7ad0e5
|
||||
Windows:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-mingw64-ghcup-0.1.16.2.exe
|
||||
dlHash: ec78872a84213968c490675127b9aad2285980b747c68207801ae824b98c7948
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/x86_64-mingw64-ghcup-0.1.17.1.exe
|
||||
dlHash: dabd8c545401b038407a01168a9fda977f17cb326f43c6b3129e76bee3b113d6
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *ghcup-64
|
||||
A_32:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning: &ghcup-32
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
|
||||
dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/i386-linux-ghcup-0.1.17.1
|
||||
dlHash: 04ec4ffd8fab1931e53f70beb3497770b42f4d37d7469c1973a0eeeccd5e8989
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *ghcup-32
|
||||
A_ARM64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2
|
||||
dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/aarch64-linux-ghcup-0.1.17.1
|
||||
dlHash: d14539dbbbb2269b6c3e105b83fa7dac744c1cfaf39f7eb2760293fec856e738
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2
|
||||
dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/aarch64-apple-darwin-ghcup-0.1.17.1
|
||||
dlHash: 80cb12af6eaeab2839e13f9cd428c0152fcb38fffc62954a3f5eccca7b06b6d9
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2
|
||||
dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
|
||||
dlUri: https://downloads.haskell.org/~ghcup/0.1.17.1/armv7-linux-ghcup-0.1.17.1
|
||||
dlHash: 2b1e63cbd62cce1a15c7cf0635f85b6bc7de880563cdf4b3a20422c9c30a616c
|
||||
HLS:
|
||||
1.1.0:
|
||||
viTags: []
|
||||
viTags:
|
||||
- old
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
|
||||
viPostInstall: &hls-post-install |
|
||||
This is just the server part of your LSP configuration. Consult the README on how to
|
||||
@@ -2294,7 +2350,8 @@ ghcupDownloads:
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-110-64
|
||||
1.2.0:
|
||||
viTags: []
|
||||
viTags:
|
||||
- old
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
|
||||
viPostInstall: *hls-post-install
|
||||
viArch:
|
||||
@@ -2314,9 +2371,7 @@ ghcupDownloads:
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-120-64
|
||||
1.3.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viTags: []
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
|
||||
viPostInstall: *hls-post-install
|
||||
viArch:
|
||||
@@ -2335,6 +2390,50 @@ ghcupDownloads:
|
||||
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-130-64
|
||||
1.4.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
|
||||
viPostInstall: *hls-post-install
|
||||
viSourceDL:
|
||||
dlUri: https://downloads.haskell.org/ghcup/src/haskell-language-server/1.4.0/haskell-language-server-1.4.0.tar.gz
|
||||
dlSubdir: haskell-language-server-1.4.0
|
||||
dlHash: c5d7dbf7fae9aa3ed2c1184b49e82d8ac623ca786494ef6602cfe11735d28db0
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning: &hls-140-64
|
||||
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Linux-1.4.0.tar.gz
|
||||
dlHash: f93c114441911ccce55649702adc9553cb4c9f953c37878321d2806a3525fee8
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-macOS-1.4.0.tar.gz
|
||||
dlHash: a7f0ac6be93ffb08cc239e5f5fead99b061061825f99566c1be33ee60cab62a4
|
||||
FreeBSD:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-freebsd-1.4.0.tar.gz
|
||||
dlHash: 6b2ad2398ed8c3964dea017e3d5e553b54c10ba1373d7653d2edd019854f4da2
|
||||
Windows:
|
||||
unknown_versioning:
|
||||
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.4.0/haskell-language-server-Windows-1.4.0.tar.gz
|
||||
dlHash: 0ec77cee750037b7a0ede817b46a913a702821f4098c6a858bcb686cb30f7efd
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-140-64
|
||||
A_ARM64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-aarch64-1.4.0.tar.gz
|
||||
dlHash: 8ad97e2bf1c538e637edec194e1cd9939019955bb749cb470f34bbe5a067b001
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-macOS-aarch64-1.4.0.tar.gz
|
||||
dlHash: 70c6fe38e987ba44c1e19173486c01f666ffb30a74cd5a7968296a5aba4c2dd0
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/haskell-language-server/1.4.0/haskell-language-server-linux-armv7-1.4.0.tar.gz
|
||||
dlHash: 4a921fbca06b02f3b1c0930cec5e65e9362b603e7715680ec7b150f18bd703d6
|
||||
Stack:
|
||||
2.5.1:
|
||||
viTags:
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,35 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.17.2 -- 2021-09-30
|
||||
|
||||
* Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250)
|
||||
* Speed up `unset` command
|
||||
* Fix `--overwrite-version` for `ghcup compile ghc` wrt [#253](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/253)
|
||||
* Apply patches before bootstrap
|
||||
|
||||
## 0.1.17.1 -- 2021-09-26
|
||||
|
||||
* Fix `NO_COLOR`
|
||||
* Fix `ghcup list -t` for hls/stack, wrt [#244](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/244)
|
||||
* Get rid of concurrent-output
|
||||
* Improve cli interface with partial versions (e.g. `ghcup install ghc 8`)
|
||||
* Fix HLS compilation builds
|
||||
* Implement `ghcup gc` (garbage collection) command
|
||||
|
||||
## 0.1.17 -- 2021-09-20
|
||||
|
||||
* Add `--force` option to install/compile wrt [#210](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/210) by Arjun Kathuria
|
||||
* Implement compiling HLS from source wrt [#201](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/201)
|
||||
* Implement experimental GPG verification of the metadata file (see README) wrt [#263](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/236)
|
||||
* Add `ghcup unset` command wrt [#145](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/145)
|
||||
* Add `ghcup whereis bindir` etc wrt [#221](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/221)
|
||||
* Greatly reduce dependency footprint wrt [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/212)
|
||||
* Add `ghcup --plan-json`
|
||||
* Improve `--patchdir` option for GHC compilation wrt [#226](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/226)
|
||||
* Try to improve logging and failure modes, especially during downloads
|
||||
* Add descriptive warnings when HLS and GHC versions are incompatible
|
||||
* Improve curl header parsing wrt [#213](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/213)
|
||||
|
||||
## 0.1.16.2 -- 2021-08-12
|
||||
|
||||
* Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria
|
||||
|
||||
51
ghcup.cabal
51
ghcup.cabal
@@ -1,34 +1,33 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.16.2
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
maintainer: hasufell@posteo.de
|
||||
author: Julian Ospald
|
||||
homepage: https://gitlab.haskell.org/haskell/ghcup-hs
|
||||
bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
|
||||
synopsis: ghc toolchain installer
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17.2
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
maintainer: hasufell@posteo.de
|
||||
author: Julian Ospald
|
||||
homepage: https://gitlab.haskell.org/haskell/ghcup-hs
|
||||
bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
|
||||
synopsis: ghc toolchain installer
|
||||
description:
|
||||
A rewrite of the shell script ghcup, for providing
|
||||
a more stable user experience and exposing an API.
|
||||
|
||||
category: System
|
||||
build-type: Simple
|
||||
category: System
|
||||
build-type: Simple
|
||||
extra-doc-files:
|
||||
README.md
|
||||
docs/CHANGELOG.md
|
||||
docs/HACKING.md
|
||||
docs/RELEASING.md
|
||||
data/config.yaml
|
||||
data/metadata/ghcup-0.0.4.yaml
|
||||
data/metadata/ghcup-0.0.5.yaml
|
||||
data/metadata/ghcup-0.0.6.yaml
|
||||
data/metadata/ghcup-0.0.7.yaml
|
||||
docs/CHANGELOG.md
|
||||
docs/HACKING.md
|
||||
docs/RELEASING.md
|
||||
README.md
|
||||
|
||||
extra-source-files:
|
||||
data/build_mk/default
|
||||
data/build_mk/cross
|
||||
data/build_mk/default
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@@ -100,9 +99,9 @@ library
|
||||
, base16-bytestring >=0.1.1.6 && <1.1
|
||||
, binary ^>=0.8.6.0
|
||||
, bytestring ^>=0.10
|
||||
, Cabal
|
||||
, case-insensitive ^>=1.2.1.0
|
||||
, casing ^>=0.1.4.1
|
||||
, concurrent-output ^>=1.10.11
|
||||
, containers ^>=0.6
|
||||
, cryptohash-sha256 ^>=0.11.101.0
|
||||
, deepseq ^>=1.4.4.0
|
||||
@@ -111,6 +110,7 @@ library
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, libarchive ^>=3.0.0.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
@@ -136,7 +136,6 @@ library
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, word8 ^>=0.1.3
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, zlib ^>=0.6.2.2
|
||||
|
||||
if (flag(internal-downloader) && !os(windows))
|
||||
@@ -158,7 +157,11 @@ library
|
||||
, Win32 ^>=2.10
|
||||
|
||||
else
|
||||
other-modules: GHCup.Utils.File.Posix
|
||||
other-modules:
|
||||
GHCup.Utils.File.Posix
|
||||
System.Console.Terminal.Common
|
||||
System.Console.Terminal.Posix
|
||||
|
||||
build-depends:
|
||||
, bz2 >=0.5.0.5 && <1.1
|
||||
, unix ^>=2.7
|
||||
@@ -198,6 +201,7 @@ executable ghcup
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, libarchive ^>=3.0.0.0
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, mtl ^>=2.2
|
||||
@@ -212,7 +216,6 @@ executable ghcup
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, versions >=4.0.1 && <5.1
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
@@ -260,6 +263,7 @@ executable ghcup-gen
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, libarchive ^>=3.0.0.0
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
@@ -272,7 +276,6 @@ executable ghcup-gen
|
||||
, text ^>=1.2.4.0
|
||||
, transformers ^>=0.5
|
||||
, versions >=4.0.1 && <5.1
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
704
lib/GHCup.hs
704
lib/GHCup.hs
File diff suppressed because it is too large
Load Diff
@@ -35,6 +35,7 @@ import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Version
|
||||
|
||||
@@ -114,7 +115,7 @@ getDownloadsF :: ( FromJSONKey Tool
|
||||
, MonadMask m
|
||||
)
|
||||
=> Excepts
|
||||
'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
m
|
||||
GHCupInfo
|
||||
getDownloadsF = do
|
||||
@@ -165,7 +166,7 @@ getBase :: ( MonadReader env m
|
||||
, MonadMask m
|
||||
)
|
||||
=> URI
|
||||
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
-> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
getBase uri = do
|
||||
Settings { noNetwork, downloader } <- lift getSettings
|
||||
|
||||
@@ -176,7 +177,6 @@ getBase uri = do
|
||||
then pure Nothing
|
||||
else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
|
||||
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
|
||||
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
|
||||
. fmap Just
|
||||
. smartDl
|
||||
$ uri
|
||||
@@ -234,6 +234,7 @@ getBase uri = do
|
||||
-> Excepts
|
||||
'[ DownloadFailed
|
||||
, DigestError
|
||||
, GPGError
|
||||
]
|
||||
m1
|
||||
FilePath
|
||||
@@ -245,7 +246,7 @@ getBase uri = do
|
||||
Dirs { cacheDir } <- lift getDirs
|
||||
|
||||
-- for local files, let's short-circuit and ignore access time
|
||||
if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
|
||||
if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
|
||||
| e -> do
|
||||
accessTime <- liftIO $ getAccessTime json_file
|
||||
|
||||
@@ -258,7 +259,7 @@ getBase uri = do
|
||||
where
|
||||
dlWithMod modTime json_file = do
|
||||
let (dir, fn) = splitFileName json_file
|
||||
f <- liftE $ download uri' Nothing dir (Just fn) True
|
||||
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing dir (Just fn) True
|
||||
liftIO $ setModificationTime f modTime
|
||||
liftIO $ setAccessTime f modTime
|
||||
pure f
|
||||
@@ -322,16 +323,17 @@ download :: ( MonadReader env m
|
||||
, MonadIO m
|
||||
)
|
||||
=> URI
|
||||
-> Maybe URI -- ^ URI for gpg sig
|
||||
-> Maybe T.Text -- ^ expected hash
|
||||
-> FilePath -- ^ destination dir (ignored for file:// scheme)
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Bool -- ^ whether to read an write etags
|
||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||
download uri eDigest dest mfn etags
|
||||
-> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
|
||||
download uri gpgUri eDigest dest mfn etags
|
||||
| scheme == "https" = dl
|
||||
| scheme == "http" = dl
|
||||
| scheme == "file" = do
|
||||
let destFile' = T.unpack . decUTF8Safe $ path
|
||||
let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
|
||||
lift $ logDebug $ "using local file: " <> T.pack destFile'
|
||||
forM_ eDigest (liftE . flip checkDigest destFile')
|
||||
pure destFile'
|
||||
@@ -340,115 +342,179 @@ download uri eDigest dest mfn etags
|
||||
where
|
||||
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||
dl = do
|
||||
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
|
||||
lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile
|
||||
baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
|
||||
lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
|
||||
|
||||
-- destination dir must exist
|
||||
liftIO $ createDirRecursive' dest
|
||||
|
||||
|
||||
-- download
|
||||
flip onException
|
||||
(lift $ hideError doesNotExistErrorType $ recycleFile destFile)
|
||||
$ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
|
||||
(\e ->
|
||||
lift (hideError doesNotExistErrorType $ recycleFile destFile)
|
||||
>> (throwE . DownloadFailed $ e)
|
||||
(lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile))
|
||||
$ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError] @'[DigestError, DownloadFailed, GPGError]
|
||||
(\e' -> do
|
||||
lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)
|
||||
case e' of
|
||||
V e@GPGError {} -> throwE e
|
||||
V e@DigestError {} -> throwE e
|
||||
_ -> throwE (DownloadFailed e')
|
||||
) $ do
|
||||
Settings{ downloader, noNetwork } <- lift getSettings
|
||||
Settings{ downloader, noNetwork, gpgSetting } <- lift getSettings
|
||||
when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork]))
|
||||
case downloader of
|
||||
Curl -> do
|
||||
o' <- liftIO getCurlOpts
|
||||
if etags
|
||||
then do
|
||||
dh <- liftIO $ emptySystemTempFile "curl-header"
|
||||
flip finally (try @_ @SomeException $ rmFile dh) $
|
||||
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
|
||||
metag <- lift $ readETag destFile
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ (if etags then ["--dump-header", dh] else [])
|
||||
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
|
||||
++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
|
||||
headers <- liftIO $ T.readFile dh
|
||||
|
||||
-- this nonsense is necessary, because some older versions of curl would overwrite
|
||||
-- the destination file when 304 is returned
|
||||
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
|
||||
Just (http':sc:_)
|
||||
| sc == "304"
|
||||
, T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
|
||||
| T.pack "HTTP" `T.isPrefixOf` http' -> do
|
||||
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||
liftIO $ copyFile (destFile <.> "tmp") destFile
|
||||
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
||||
:: V '[MalformedHeaders]))
|
||||
|
||||
lift $ writeEtags destFile (parseEtags headers)
|
||||
else
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
||||
Wget -> do
|
||||
destFileTemp <- liftIO $ emptySystemTempFile "wget-tmp"
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
o' <- liftIO getWgetOpts
|
||||
if etags
|
||||
then do
|
||||
metag <- lift $ readETag destFile
|
||||
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
|
||||
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
|
||||
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> do
|
||||
liftIO $ copyFile destFileTemp destFile
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
ExitFailure i'
|
||||
| i' == 8
|
||||
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
||||
-> do
|
||||
lift $ logDebug "Not modified, skipping download"
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
||||
else do
|
||||
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
|
||||
liftIO $ copyFile destFileTemp destFile
|
||||
downloadAction <- case downloader of
|
||||
Curl -> do
|
||||
o' <- liftIO getCurlOpts
|
||||
if etags
|
||||
then pure $ curlEtagsDL o'
|
||||
else pure $ curlDL o'
|
||||
Wget -> do
|
||||
o' <- liftIO getWgetOpts
|
||||
if etags
|
||||
then pure $ wgetEtagsDL o'
|
||||
else pure $ wgetDL o'
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
Internal -> do
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri
|
||||
if etags
|
||||
then do
|
||||
metag <- lift $ readETag destFile
|
||||
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
||||
, E.encodeUtf8 etag)]) metag
|
||||
liftE
|
||||
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
||||
$ do
|
||||
r <- downloadToFile https host fullPath port destFile addHeaders
|
||||
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
||||
else void $ liftE $ catchE @HTTPNotModified
|
||||
@'[DownloadFailed]
|
||||
(\e@(HTTPNotModified _) ->
|
||||
throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
|
||||
$ downloadToFile https host fullPath port destFile mempty
|
||||
Internal -> do
|
||||
if etags
|
||||
then pure (\fp -> liftE . internalEtagsDL fp)
|
||||
else pure (\fp -> liftE . internalDL fp)
|
||||
#endif
|
||||
liftE $ downloadAction baseDestFile uri
|
||||
case (gpgUri, gpgSetting) of
|
||||
(_, GPGNone) -> pure ()
|
||||
(Just gpgUri', _) -> do
|
||||
gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing
|
||||
liftE $ flip onException
|
||||
(lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
|
||||
$ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
|
||||
(\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyShow (GPGError e))
|
||||
) $ do
|
||||
o' <- liftIO getGpgOpts
|
||||
lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
|
||||
liftE $ downloadAction gpgDestFile gpgUri'
|
||||
lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
|
||||
let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
|
||||
cp <- lift $ executeOut "gpg" args Nothing
|
||||
case cp of
|
||||
CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
|
||||
lift $ logDebug $ decUTF8Safe' _stdErr
|
||||
throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
|
||||
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
|
||||
_ -> pure ()
|
||||
|
||||
forM_ eDigest (liftE . flip checkDigest destFile)
|
||||
pure destFile
|
||||
forM_ eDigest (liftE . flip checkDigest baseDestFile)
|
||||
pure baseDestFile
|
||||
|
||||
curlDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
|
||||
curlDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
|
||||
let destFileTemp = tmpFile destFile
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
|
||||
liftIO $ renameFile destFileTemp destFile
|
||||
|
||||
curlEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
|
||||
=> [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
|
||||
curlEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
|
||||
let destFileTemp = tmpFile destFile
|
||||
dh <- liftIO $ emptySystemTempFile "curl-header"
|
||||
flip finally (try @_ @SomeException $ rmFile dh) $
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
metag <- lift $ readETag destFile
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ (if etags then ["--dump-header", dh] else [])
|
||||
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
|
||||
++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
|
||||
headers <- liftIO $ T.readFile dh
|
||||
|
||||
-- this nonsense is necessary, because some older versions of curl would overwrite
|
||||
-- the destination file when 304 is returned
|
||||
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
|
||||
Just (http':sc:_)
|
||||
| sc == "304"
|
||||
, T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
|
||||
| T.pack "HTTP" `T.isPrefixOf` http' -> do
|
||||
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||
liftIO $ renameFile destFileTemp destFile
|
||||
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
||||
:: V '[MalformedHeaders]))
|
||||
|
||||
lift $ writeEtags destFile (parseEtags headers)
|
||||
|
||||
wgetDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
|
||||
wgetDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
|
||||
let destFileTemp = tmpFile destFile
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
|
||||
liftIO $ renameFile destFileTemp destFile
|
||||
|
||||
|
||||
wgetEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
|
||||
=> [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
|
||||
wgetEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
|
||||
let destFileTemp = tmpFile destFile
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
metag <- lift $ readETag destFile
|
||||
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
|
||||
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
|
||||
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> do
|
||||
liftIO $ renameFile destFileTemp destFile
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
ExitFailure i'
|
||||
| i' == 8
|
||||
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
||||
-> do
|
||||
lift $ logDebug "Not modified, skipping download"
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
||||
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
internalDL :: (MonadCatch m, MonadMask m, MonadIO m)
|
||||
=> FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
|
||||
internalDL destFile uri' = do
|
||||
let destFileTemp = tmpFile destFile
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
|
||||
void $ liftE $ catchE @HTTPNotModified
|
||||
@'[DownloadFailed]
|
||||
(\e@(HTTPNotModified _) ->
|
||||
throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
|
||||
$ downloadToFile https host fullPath port destFileTemp mempty
|
||||
liftIO $ renameFile destFileTemp destFile
|
||||
|
||||
|
||||
internalEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
|
||||
=> FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
|
||||
internalEtagsDL destFile uri' = do
|
||||
let destFileTemp = tmpFile destFile
|
||||
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri'
|
||||
metag <- lift $ readETag destFile
|
||||
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
||||
, E.encodeUtf8 etag)]) metag
|
||||
liftE
|
||||
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
||||
$ do
|
||||
r <- downloadToFile https host fullPath port destFileTemp addHeaders
|
||||
liftIO $ renameFile destFileTemp destFile
|
||||
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
||||
#endif
|
||||
|
||||
|
||||
-- Manage to find a file we can write the body into.
|
||||
getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
|
||||
getDestFile =
|
||||
case mfn of
|
||||
getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
|
||||
getDestFile uri' mfn' =
|
||||
let path = view pathL' uri'
|
||||
in case mfn' of
|
||||
Just fn -> pure (dest </> fn)
|
||||
Nothing
|
||||
| let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
|
||||
, not (null urlBase) -> pure (dest </> urlBase)
|
||||
-- TODO: remove this once we use hpath again
|
||||
| otherwise -> throwE $ NoUrlBase uri'
|
||||
|
||||
path = view pathL' uri
|
||||
uri' = decUTF8Safe (serializeURIRef' uri)
|
||||
| otherwise -> throwE $ NoUrlBase (decUTF8Safe . serializeURIRef' $ uri')
|
||||
|
||||
parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
|
||||
parseEtags stderr = do
|
||||
@@ -509,14 +575,14 @@ downloadCached :: ( MonadReader env m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||
-> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
|
||||
downloadCached dli mfn = do
|
||||
Settings{ cache } <- lift getSettings
|
||||
case cache of
|
||||
True -> downloadCached' dli mfn Nothing
|
||||
False -> do
|
||||
tmp <- lift withGHCupTmpDir
|
||||
liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False
|
||||
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmp mfn False
|
||||
|
||||
|
||||
downloadCached' :: ( MonadReader env m
|
||||
@@ -531,7 +597,7 @@ downloadCached' :: ( MonadReader env m
|
||||
=> DownloadInfo
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Maybe FilePath -- ^ optional destination dir (default: cacheDir)
|
||||
-> Excepts '[DigestError , DownloadFailed] m FilePath
|
||||
-> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
|
||||
downloadCached' dli mfn mDestDir = do
|
||||
Dirs { cacheDir } <- lift getDirs
|
||||
let destDir = fromMaybe cacheDir mDestDir
|
||||
@@ -542,7 +608,7 @@ downloadCached' dli mfn mDestDir = do
|
||||
| fileExists -> do
|
||||
liftE $ checkDigest (view dlHash dli) cachfile
|
||||
pure cachfile
|
||||
| otherwise -> liftE $ download (_dlUri dli) (Just (_dlHash dli)) destDir mfn False
|
||||
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) destDir mfn False
|
||||
|
||||
|
||||
|
||||
@@ -571,7 +637,7 @@ checkDigest eDigest file = do
|
||||
lift $ logInfo $ "verifying digest of: " <> T.pack p'
|
||||
c <- liftIO $ L.readFile file
|
||||
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
|
||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
|
||||
|
||||
|
||||
-- | Get additional curl args from env. This is an undocumented option.
|
||||
@@ -589,6 +655,12 @@ getWgetOpts =
|
||||
Just r -> pure $ splitOn " " r
|
||||
Nothing -> pure []
|
||||
|
||||
-- | Get additional gpg args from env. This is an undocumented option.
|
||||
getGpgOpts :: IO [String]
|
||||
getGpgOpts =
|
||||
lookupEnv "GHCUP_GPG_OPTS" >>= \case
|
||||
Just r -> pure $ splitOn " " r
|
||||
Nothing -> pure []
|
||||
|
||||
-- | Get the url base name.
|
||||
--
|
||||
@@ -610,3 +682,7 @@ urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
|
||||
-- "HTTP/1.1 304 Not Modified\n"
|
||||
getLastHeader :: T.Text -> T.Text
|
||||
getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines
|
||||
|
||||
|
||||
tmpFile :: FilePath -> FilePath
|
||||
tmpFile = (<.> "tmp")
|
||||
|
||||
@@ -188,12 +188,22 @@ instance Pretty TarDirDoesNotExist where
|
||||
text "Tar directory does not exist:" <+> pPrint dir
|
||||
|
||||
-- | File digest verification failed.
|
||||
data DigestError = DigestError Text Text
|
||||
data DigestError = DigestError FilePath Text Text
|
||||
deriving Show
|
||||
|
||||
instance Pretty DigestError where
|
||||
pPrint (DigestError currentDigest expectedDigest) =
|
||||
text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
|
||||
pPrint (DigestError fp currentDigest expectedDigest) =
|
||||
text "Digest error for" <+> text (fp <> ": expected")
|
||||
<+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
|
||||
"\nConsider removing the file in case it's cached and try again."
|
||||
|
||||
-- | File digest verification failed.
|
||||
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
|
||||
|
||||
deriving instance Show GPGError
|
||||
|
||||
instance Pretty GPGError where
|
||||
pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason
|
||||
|
||||
-- | Unexpected HTTP status.
|
||||
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
|
||||
|
||||
@@ -23,6 +23,7 @@ import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
@@ -138,7 +139,6 @@ getLinuxDistro = do
|
||||
| hasWord name ["exherbo"] -> Exherbo
|
||||
| hasWord name ["gentoo"] -> Gentoo
|
||||
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
|
||||
| hasWord name ["solus"] -> Solus
|
||||
| otherwise -> UnknownLinux
|
||||
pure (distro, parsedVer)
|
||||
where
|
||||
|
||||
@@ -60,9 +60,10 @@ getCommonRequirements pr tr =
|
||||
prettyRequirements :: Requirements -> T.Text
|
||||
prettyRequirements Requirements {..} =
|
||||
let d = if not . null $ _distroPKGs
|
||||
then
|
||||
"\n Please install the following distro packages: "
|
||||
<> T.intercalate " " _distroPKGs
|
||||
then "\n Please ensure the following distro packages "
|
||||
<> "are installed before continuing (you can exit ghcup "
|
||||
<> "and return at any time): "
|
||||
<> T.intercalate " " _distroPKGs
|
||||
else ""
|
||||
n = if not . T.null $ _notes then "\n Note: " <> _notes else ""
|
||||
in "System requirements " <> d <> n
|
||||
|
||||
@@ -223,7 +223,6 @@ data LinuxDistro = Debian
|
||||
| RedHat
|
||||
| Alpine
|
||||
| AmazonLinux
|
||||
| Solus
|
||||
-- rolling
|
||||
| Gentoo
|
||||
| Exherbo
|
||||
@@ -243,7 +242,6 @@ distroToString CentOS = "centos"
|
||||
distroToString RedHat = "redhat"
|
||||
distroToString Alpine = "alpine"
|
||||
distroToString AmazonLinux = "amazon"
|
||||
distroToString Solus = "solus"
|
||||
distroToString Gentoo = "gentoo"
|
||||
distroToString Exherbo = "exherbo"
|
||||
distroToString UnknownLinux = "unknown"
|
||||
@@ -303,11 +301,12 @@ data UserSettings = UserSettings
|
||||
, uKeyBindings :: Maybe UserKeyBindings
|
||||
, uUrlSource :: Maybe URLSource
|
||||
, uNoNetwork :: Maybe Bool
|
||||
, uGPGSetting :: Maybe GPGSetting
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
defaultUserSettings :: UserSettings
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
||||
fromSettings Settings{..} Nothing =
|
||||
@@ -320,6 +319,7 @@ fromSettings Settings{..} Nothing =
|
||||
, uNoNetwork = Just noNetwork
|
||||
, uKeyBindings = Nothing
|
||||
, uUrlSource = Just urlSource
|
||||
, uGPGSetting = Just gpgSetting
|
||||
}
|
||||
fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
let ukb = UserKeyBindings
|
||||
@@ -342,6 +342,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
, uNoNetwork = Just noNetwork
|
||||
, uKeyBindings = Just ukb
|
||||
, uUrlSource = Just urlSource
|
||||
, uGPGSetting = Just gpgSetting
|
||||
}
|
||||
|
||||
data UserKeyBindings = UserKeyBindings
|
||||
@@ -415,6 +416,8 @@ data Settings = Settings
|
||||
, verbose :: Bool
|
||||
, urlSource :: URLSource
|
||||
, noNetwork :: Bool
|
||||
, gpgSetting :: GPGSetting
|
||||
, noColor :: Bool -- this also exists in LoggerConfig
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
@@ -448,6 +451,13 @@ data Downloader = Curl
|
||||
|
||||
instance NFData Downloader
|
||||
|
||||
data GPGSetting = GPGStrict
|
||||
| GPGLax
|
||||
| GPGNone
|
||||
deriving (Eq, Show, Ord, GHC.Generic)
|
||||
|
||||
instance NFData GPGSetting
|
||||
|
||||
data DebugInfo = DebugInfo
|
||||
{ diBaseDir :: FilePath
|
||||
, diBinDir :: FilePath
|
||||
@@ -567,11 +577,12 @@ data LogLevel = Warn
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data LoggerConfig = LoggerConfig
|
||||
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
|
||||
, colorOutter :: T.Text -> IO () -- ^ how to write the color output
|
||||
, rawOutter :: T.Text -> IO () -- ^ how to write the full raw output
|
||||
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
|
||||
, consoleOutter :: T.Text -> IO () -- ^ how to write the console output
|
||||
, fileOutter :: T.Text -> IO () -- ^ how to write the file output
|
||||
, fancyColors :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
instance NFData LoggerConfig where
|
||||
rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug
|
||||
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
|
||||
|
||||
@@ -24,6 +24,8 @@ module GHCup.Types.JSON where
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
|
||||
-- This is due to the boot file.
|
||||
|
||||
import Control.Applicative ( (<|>) )
|
||||
import Data.Aeson
|
||||
@@ -54,6 +56,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
|
||||
|
||||
instance ToJSON Tag where
|
||||
toJSON Latest = String "Latest"
|
||||
|
||||
@@ -23,12 +23,9 @@ import GHCup.Types
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
import URI.ByteString
|
||||
import System.Console.Pretty
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
makePrisms ''Tool
|
||||
makePrisms ''Architecture
|
||||
@@ -117,80 +114,6 @@ getDirs :: ( MonadReader env m
|
||||
getDirs = gets @"dirs"
|
||||
|
||||
|
||||
logInfo :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logInfo = logInternal Info
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logWarn = logInternal Warn
|
||||
|
||||
logDebug :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logDebug = logInternal Debug
|
||||
|
||||
logError :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logError = logInternal Error
|
||||
|
||||
|
||||
logInternal :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
) => LogLevel
|
||||
-> Text
|
||||
-> m ()
|
||||
logInternal logLevel msg = do
|
||||
LoggerConfig {..} <- gets @"loggerConfig"
|
||||
let style' = case logLevel of
|
||||
Debug -> style Bold . color Blue
|
||||
Info -> style Bold . color Green
|
||||
Warn -> style Bold . color Yellow
|
||||
Error -> style Bold . color Red
|
||||
let l = case logLevel of
|
||||
Debug -> style' "[ Debug ]"
|
||||
Info -> style' "[ Info ]"
|
||||
Warn -> style' "[ Warn ]"
|
||||
Error -> style' "[ Error ]"
|
||||
let strs = T.split (== '\n') msg
|
||||
let out = case strs of
|
||||
[] -> T.empty
|
||||
(x:xs) ->
|
||||
foldr (\a b -> a <> "\n" <> b) mempty
|
||||
. ((l <> " " <> x) :)
|
||||
. fmap (\line' -> style' "[ ... ] " <> line' )
|
||||
$ xs
|
||||
|
||||
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
|
||||
$ liftIO $ colorOutter out
|
||||
|
||||
-- raw output
|
||||
let lr = case logLevel of
|
||||
Debug -> "Debug:"
|
||||
Info -> "Info:"
|
||||
Warn -> "Warn:"
|
||||
Error -> "Error:"
|
||||
let outr = lr <> " " <> msg <> "\n"
|
||||
liftIO $ rawOutter outr
|
||||
|
||||
|
||||
|
||||
getLogCleanup :: ( MonadReader env m
|
||||
, LabelOptic' "logCleanup" A_Lens env (IO ())
|
||||
)
|
||||
|
||||
@@ -35,6 +35,7 @@ import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
@@ -85,8 +86,37 @@ import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
-- >>> :set -XDataKinds
|
||||
-- >>> :set -XTypeApplications
|
||||
-- >>> :set -XQuasiQuotes
|
||||
-- >>> import System.Directory
|
||||
-- >>> import URI.ByteString
|
||||
-- >>> import qualified Data.Text as T
|
||||
-- >>> import GHCup.Utils.Prelude
|
||||
-- >>> import GHCup.Download
|
||||
-- >>> import GHCup.Version
|
||||
-- >>> import GHCup.Errors
|
||||
-- >>> import GHCup.Types
|
||||
-- >>> import GHCup.Types.Optics
|
||||
-- >>> import Optics
|
||||
-- >>> import GHCup.Utils.Version.QQ
|
||||
-- >>> import qualified Data.Text.Encoding as E
|
||||
-- >>> import Control.Monad.Reader
|
||||
-- >>> import Haskus.Utils.Variant.Excepts
|
||||
-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
|
||||
-- >>> dirs' <- getAllDirs
|
||||
-- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ]
|
||||
-- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False
|
||||
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
|
||||
-- >>> cwd <- getCurrentDirectory
|
||||
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
||||
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
|
||||
|
||||
|
||||
|
||||
@@ -250,7 +280,6 @@ getInstalledGHCs = do
|
||||
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
||||
getInstalledCabals :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
@@ -268,7 +297,7 @@ getInstalledCabals = do
|
||||
|
||||
|
||||
-- | Whether the given cabal version is installed.
|
||||
cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||
cabalInstalled ver = do
|
||||
vers <- fmap rights getInstalledCabals
|
||||
pure $ elem ver vers
|
||||
@@ -463,33 +492,50 @@ hlsGHCVersions :: ( MonadReader env m
|
||||
)
|
||||
=> m [Version]
|
||||
hlsGHCVersions = do
|
||||
h <- hlsSet
|
||||
vers <- forM h $ \h' -> do
|
||||
bins <- hlsServerBinaries h'
|
||||
pure $ fmap
|
||||
(version
|
||||
. T.pack
|
||||
. fromJust
|
||||
. stripPrefix "haskell-language-server-"
|
||||
. head
|
||||
. splitOn "~"
|
||||
)
|
||||
bins
|
||||
pure . rights . concat . maybeToList $ vers
|
||||
h <- hlsSet
|
||||
fromMaybe [] <$> forM h hlsGHCVersions'
|
||||
|
||||
|
||||
hlsGHCVersions' :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Version
|
||||
-> m [Version]
|
||||
hlsGHCVersions' v' = do
|
||||
bins <- hlsServerBinaries v' Nothing
|
||||
let vers = fmap
|
||||
(version
|
||||
. T.pack
|
||||
. fromJust
|
||||
. stripPrefix "haskell-language-server-"
|
||||
. head
|
||||
. splitOn "~"
|
||||
)
|
||||
bins
|
||||
pure . sortBy (flip compare) . rights $ vers
|
||||
|
||||
|
||||
-- | Get all server binaries for an hls version, if any.
|
||||
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
=> Version
|
||||
-> Maybe Version -- ^ optional GHC version
|
||||
-> m [FilePath]
|
||||
hlsServerBinaries ver = do
|
||||
hlsServerBinaries ver mghcVer = do
|
||||
Dirs {..} <- getDirs
|
||||
liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts
|
||||
compExtended
|
||||
execBlank
|
||||
([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
|
||||
([s|^haskell-language-server-|]
|
||||
<> maybe [s|.*|] escapeVerRex mghcVer
|
||||
<> [s|~|]
|
||||
<> escapeVerRex ver
|
||||
<> E.encodeUtf8 (T.pack exeExt)
|
||||
<> [s|$|] :: ByteString
|
||||
)
|
||||
)
|
||||
|
||||
@@ -518,7 +564,7 @@ hlsWrapperBinary ver = do
|
||||
-- | Get all binaries for an hls version, if any.
|
||||
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
|
||||
hlsAllBinaries ver = do
|
||||
hls <- hlsServerBinaries ver
|
||||
hls <- hlsServerBinaries ver Nothing
|
||||
wrapper <- hlsWrapperBinary ver
|
||||
pure (maybeToList wrapper ++ hls)
|
||||
|
||||
@@ -559,34 +605,83 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
|
||||
Just (x, y) -> x == major' && y == minor'
|
||||
Nothing -> False
|
||||
|
||||
-- | Match PVP prefix.
|
||||
--
|
||||
-- >>> matchPVPrefix [pver|8.8|] [pver|8.8.4|]
|
||||
-- True
|
||||
-- >>> matchPVPrefix [pver|8|] [pver|8.8.4|]
|
||||
-- True
|
||||
-- >>> matchPVPrefix [pver|8.10|] [pver|8.8.4|]
|
||||
-- False
|
||||
-- >>> matchPVPrefix [pver|8.10|] [pver|8.10.7|]
|
||||
-- True
|
||||
matchPVPrefix :: PVP -> PVP -> Bool
|
||||
matchPVPrefix (toL -> prefix) (toL -> full) = and $ zipWith (==) prefix full
|
||||
|
||||
-- | Get the latest installed full GHC version that satisfies X.Y.
|
||||
-- This reads `ghcupGHCBaseDir`.
|
||||
getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||
=> Int -- ^ major version component
|
||||
-> Int -- ^ minor version component
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForMajor major' minor' mt = do
|
||||
toL :: PVP -> [Int]
|
||||
toL (PVP inner) = fmap fromIntegral $ NE.toList inner
|
||||
|
||||
|
||||
-- | Get the latest installed full GHC version that satisfies the given (possibly partial)
|
||||
-- PVP version.
|
||||
getGHCForPVP :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||
=> PVP
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForPVP pvpIn mt = do
|
||||
ghcs <- rights <$> getInstalledGHCs
|
||||
-- we're permissive here... failed parse just means we have no match anyway
|
||||
let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
|
||||
pvp_ <- versionToPVP _tvVersion
|
||||
pure (pvp_, _tvTarget)
|
||||
|
||||
pure
|
||||
. lastMay
|
||||
. sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
|
||||
. filter
|
||||
(\GHCTargetVersion {..} ->
|
||||
_tvTarget == mt && matchMajor _tvVersion major' minor'
|
||||
)
|
||||
$ ghcs
|
||||
getGHCForPVP' pvpIn ghcs' mt
|
||||
|
||||
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
||||
--
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
|
||||
-- "Just 8.10.7"
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
|
||||
-- "Just 8.8.4"
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
|
||||
-- "Just 8.10.4"
|
||||
getGHCForPVP' :: MonadThrow m
|
||||
=> PVP
|
||||
-> [(PVP, Maybe Text)] -- ^ installed GHCs
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForPVP' pvpIn ghcs' mt = do
|
||||
let mResult = lastMay
|
||||
. sortBy (\(x, _) (y, _) -> compare x y)
|
||||
. filter
|
||||
(\(pvp_, target) ->
|
||||
target == mt && matchPVPrefix pvp_ pvpIn
|
||||
)
|
||||
$ ghcs'
|
||||
forM mResult $ \(pvp_, target) -> do
|
||||
ver' <- pvpToVersion pvp_
|
||||
pure (GHCTargetVersion target ver')
|
||||
|
||||
|
||||
-- | Get the latest available ghc for X.Y major version.
|
||||
getLatestGHCFor :: Int -- ^ major version component
|
||||
-> Int -- ^ minor version component
|
||||
-> GHCupDownloads
|
||||
-> Maybe (Version, VersionInfo)
|
||||
getLatestGHCFor major' minor' dls =
|
||||
preview (ix GHC % to Map.toDescList) dls >>= lastMay . filter (\(v, _) -> matchMajor v major' minor')
|
||||
-- | Get the latest available ghc for the given PVP version, which
|
||||
-- may only contain parts.
|
||||
--
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [10,7]})
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
|
||||
-- Just (PVP {_pComponents = 8 :| [8,4]})
|
||||
getLatestToolFor :: MonadThrow m
|
||||
=> Tool
|
||||
-> PVP
|
||||
-> GHCupDownloads
|
||||
-> m (Maybe (PVP, VersionInfo))
|
||||
getLatestToolFor tool pvpIn dls = do
|
||||
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
|
||||
pure . headMay . filter (\(v, _) -> matchPVPrefix pvpIn v) $ ps
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -690,11 +785,10 @@ intoSubdir bdir tardir = case tardir of
|
||||
-- | Get the tool version that has this tag. If multiple have it,
|
||||
-- picks the greatest version.
|
||||
getTagged :: Tag
|
||||
-> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
||||
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
|
||||
getTagged tag =
|
||||
to (Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||
% to Map.toDescList
|
||||
% _head
|
||||
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
|
||||
% folding id
|
||||
|
||||
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
|
||||
getLatest av tool = headOf (ix tool % getTagged Latest) av
|
||||
@@ -825,7 +919,7 @@ getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
|
||||
getChangeLog dls tool (Left v') =
|
||||
preview (ix tool % ix v' % viChangeLog % _Just) dls
|
||||
getChangeLog dls tool (Right tag) =
|
||||
preview (ix tool % getTagged tag % to snd % viChangeLog % _Just) dls
|
||||
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
|
||||
|
||||
|
||||
-- | Execute a build action while potentially cleaning up:
|
||||
@@ -843,6 +937,8 @@ runBuildAction :: ( Pretty (V e)
|
||||
, MonadMask m
|
||||
, HasLog env
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> FilePath -- ^ build directory (cleaned up depending on Settings)
|
||||
-> Maybe FilePath -- ^ dir to *always* clean up on exception
|
||||
@@ -1032,7 +1128,7 @@ ensureGlobalTools :: ( MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Excepts '[DigestError , DownloadFailed, NoDownload] m ()
|
||||
=> Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
|
||||
ensureGlobalTools = do
|
||||
#if defined(IS_WINDOWS)
|
||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||
@@ -1040,12 +1136,12 @@ ensureGlobalTools = do
|
||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\(DigestError _ _) -> do
|
||||
void $ (\(DigestError _ _ _) -> do
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
|
||||
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
||||
liftE @'[DigestError , DownloadFailed] $ dl
|
||||
) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
|
||||
liftE @'[GPGError, DigestError , DownloadFailed] $ dl
|
||||
) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl)
|
||||
pure ()
|
||||
#else
|
||||
pure ()
|
||||
|
||||
@@ -38,6 +38,7 @@ import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
import Control.Exception.Safe
|
||||
|
||||
@@ -9,6 +9,8 @@ import GHCup.Utils.Prelude
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Void
|
||||
import GHC.IO.Exception
|
||||
import Optics hiding ((<|), (|>))
|
||||
import System.Directory
|
||||
@@ -16,7 +18,9 @@ import System.FilePath
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
|
||||
@@ -101,6 +105,16 @@ findFiles path regex = do
|
||||
contents <- listDirectory path
|
||||
pure $ filter (match regex) contents
|
||||
|
||||
findFilesDeep :: FilePath -> Regex -> IO [FilePath]
|
||||
findFilesDeep path regex = do
|
||||
contents <- getDirectoryContentsRecursive path
|
||||
pure $ filter (match regex) contents
|
||||
|
||||
findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
|
||||
findFiles' path parser = do
|
||||
contents <- listDirectory path
|
||||
pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
|
||||
|
||||
|
||||
checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
|
||||
checkFileAlreadyExists fp = liftIO $ doesFileExist fp
|
||||
|
||||
5
lib/GHCup/Utils/File/Common.hs-boot
Normal file
5
lib/GHCup/Utils/File/Common.hs-boot
Normal file
@@ -0,0 +1,5 @@
|
||||
module GHCup.Utils.File.Common where
|
||||
|
||||
import Text.Regex.Posix
|
||||
|
||||
findFiles :: FilePath -> Regex -> IO [FilePath]
|
||||
@@ -17,6 +17,7 @@ module GHCup.Utils.File.Posix where
|
||||
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
|
||||
@@ -34,8 +35,7 @@ import Data.Sequence ( Seq, (|>) )
|
||||
import Data.List
|
||||
import Data.Word8
|
||||
import GHC.IO.Exception
|
||||
import System.Console.Pretty hiding ( Pretty )
|
||||
import System.Console.Regions
|
||||
import System.Console.Terminal.Common
|
||||
import System.IO.Error
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
@@ -51,6 +51,7 @@ import qualified Data.Sequence as Sq
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified System.Posix.Process as SPP
|
||||
import qualified System.Console.Terminal.Posix as TP
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified "unix-bytestring" System.Posix.IO.ByteString
|
||||
@@ -87,9 +88,9 @@ execLogged exe args chdir lfile env = do
|
||||
let logfile = logsDir </> lfile <> ".log"
|
||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
closeFd
|
||||
(action verbose)
|
||||
(action verbose noColor)
|
||||
where
|
||||
action verbose fd = do
|
||||
action verbose no_color fd = do
|
||||
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
|
||||
-- start the thread that logs to stdout
|
||||
pState <- newEmptyMVar
|
||||
@@ -100,7 +101,7 @@ execLogged exe args chdir lfile env = do
|
||||
$ EX.finally
|
||||
(if verbose
|
||||
then tee fd stdoutRead
|
||||
else printToRegion fd stdoutRead 6 pState
|
||||
else printToRegion fd stdoutRead 6 pState no_color
|
||||
)
|
||||
(putMVar done ())
|
||||
|
||||
@@ -137,46 +138,57 @@ execLogged exe args chdir lfile env = do
|
||||
|
||||
-- Reads fdIn and logs the output in a continous scrolling area
|
||||
-- of 'size' terminal lines. Also writes to a log file.
|
||||
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
|
||||
printToRegion fileFd fdIn size pState = do
|
||||
void $ displayConsoleRegions $ do
|
||||
rs <-
|
||||
liftIO
|
||||
. fmap Sq.fromList
|
||||
. sequence
|
||||
. replicate size
|
||||
. openConsoleRegion
|
||||
$ Linear
|
||||
flip runStateT mempty
|
||||
$ handle
|
||||
(\(ex :: SomeException) -> do
|
||||
ps <- liftIO $ takeMVar pState
|
||||
when ps (forM_ rs (liftIO . closeConsoleRegion))
|
||||
throw ex
|
||||
)
|
||||
$ readTilEOF (lineAction rs) fdIn
|
||||
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
|
||||
printToRegion fileFd fdIn size pState no_color = do
|
||||
-- init region
|
||||
forM_ [1..size] $ \_ -> BS.putStr "\n"
|
||||
|
||||
void $ flip runStateT mempty
|
||||
$ do
|
||||
handle
|
||||
(\(ex :: SomeException) -> do
|
||||
ps <- liftIO $ takeMVar pState
|
||||
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen))
|
||||
throw ex
|
||||
) $ readTilEOF lineAction fdIn
|
||||
|
||||
where
|
||||
clearScreen :: ByteString
|
||||
clearScreen = "\x1b[0J"
|
||||
clearLine :: ByteString
|
||||
clearLine = "\x1b[2K"
|
||||
moveLineUp :: Int -> ByteString
|
||||
moveLineUp n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "A"
|
||||
moveLineDown :: Int -> ByteString
|
||||
moveLineDown n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "B"
|
||||
pos1 :: ByteString
|
||||
pos1 = "\r"
|
||||
overwriteNthLine :: Int -> ByteString -> ByteString
|
||||
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
|
||||
|
||||
blue :: ByteString -> ByteString
|
||||
blue bs
|
||||
| no_color = bs
|
||||
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
|
||||
|
||||
-- action to perform line by line
|
||||
-- TODO: do this with vty for efficiency
|
||||
lineAction :: (MonadMask m, MonadIO m)
|
||||
=> Seq ConsoleRegion
|
||||
-> ByteString
|
||||
=> ByteString
|
||||
-> StateT (Seq ByteString) m ()
|
||||
lineAction rs = \bs' -> do
|
||||
lineAction = \bs' -> do
|
||||
void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
|
||||
modify (swapRegs bs')
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
|
||||
w <- consoleWidth
|
||||
return
|
||||
. T.pack
|
||||
. color Blue
|
||||
. T.unpack
|
||||
. decUTF8Safe
|
||||
. trim w
|
||||
. (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
|
||||
$ bs
|
||||
liftIO TP.size >>= \case
|
||||
Nothing -> pure ()
|
||||
Just (Window _ w) -> do
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
|
||||
BS.putStr
|
||||
. overwriteNthLine (size - i)
|
||||
. trim w
|
||||
. blue
|
||||
. (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
|
||||
$ bs
|
||||
|
||||
swapRegs :: a -> Seq a -> Seq a
|
||||
swapRegs bs = \regs -> if
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Logger
|
||||
@@ -16,21 +18,97 @@ module GHCup.Utils.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils.File
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Console.Pretty
|
||||
import System.FilePath
|
||||
import System.IO.Error
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import GHCup.Utils.Prelude
|
||||
import qualified Data.Text as T
|
||||
|
||||
logInfo :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logInfo = logInternal Info
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logWarn = logInternal Warn
|
||||
|
||||
logDebug :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logDebug = logInternal Debug
|
||||
|
||||
logError :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logError = logInternal Error
|
||||
|
||||
|
||||
logInternal :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
) => LogLevel
|
||||
-> Text
|
||||
-> m ()
|
||||
logInternal logLevel msg = do
|
||||
LoggerConfig {..} <- gets @"loggerConfig"
|
||||
let color' c = if fancyColors then color c else id
|
||||
let style' = case logLevel of
|
||||
Debug -> style Bold . color' Blue
|
||||
Info -> style Bold . color' Green
|
||||
Warn -> style Bold . color' Yellow
|
||||
Error -> style Bold . color' Red
|
||||
let l = case logLevel of
|
||||
Debug -> style' "[ Debug ]"
|
||||
Info -> style' "[ Info ]"
|
||||
Warn -> style' "[ Warn ]"
|
||||
Error -> style' "[ Error ]"
|
||||
let strs = T.split (== '\n') msg
|
||||
let out = case strs of
|
||||
[] -> T.empty
|
||||
(x:xs) ->
|
||||
foldr (\a b -> a <> "\n" <> b) mempty
|
||||
. ((l <> " " <> x) :)
|
||||
. fmap (\line' -> style' "[ ... ] " <> line' )
|
||||
$ xs
|
||||
|
||||
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
|
||||
$ liftIO $ consoleOutter out
|
||||
|
||||
-- raw output
|
||||
let lr = case logLevel of
|
||||
Debug -> "Debug:"
|
||||
Info -> "Info:"
|
||||
Warn -> "Warn:"
|
||||
Error -> "Error:"
|
||||
let outr = lr <> " " <> msg <> "\n"
|
||||
liftIO $ fileOutter outr
|
||||
|
||||
|
||||
initGHCupFileLogging :: ( MonadReader env m
|
||||
|
||||
21
lib/GHCup/Utils/Logger.hs-boot
Normal file
21
lib/GHCup/Utils/Logger.hs-boot
Normal file
@@ -0,0 +1,21 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Utils.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
|
||||
@@ -22,7 +22,9 @@ module GHCup.Utils.Prelude where
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Types
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.Logger
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
@@ -31,13 +33,14 @@ import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
|
||||
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
|
||||
import Data.Maybe
|
||||
import Data.Foldable
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
import Data.String
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Data.Word8
|
||||
import Data.Word8 hiding ( isDigit )
|
||||
import Haskus.Utils.Types.List
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
|
||||
@@ -58,6 +61,7 @@ import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.Strict.Maybe as S
|
||||
import qualified Data.List.Split as Split
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
@@ -295,12 +299,28 @@ removeLensFieldLabel str' =
|
||||
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
|
||||
|
||||
|
||||
pvpToVersion :: PVP -> Version
|
||||
pvpToVersion :: MonadThrow m => PVP -> m Version
|
||||
pvpToVersion =
|
||||
either (\_ -> error "Couldn't convert PVP to Version") id
|
||||
. version
|
||||
. prettyPVP
|
||||
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
|
||||
|
||||
versionToPVP :: MonadThrow m => Version -> m PVP
|
||||
versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
|
||||
where
|
||||
alternative :: MonadThrow m => Version -> m PVP
|
||||
alternative v' = case NE.takeWhile isDigit (_vChunks v') of
|
||||
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
|
||||
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
|
||||
|
||||
isDigit :: VChunk -> Bool
|
||||
isDigit (Digits _ :| []) = True
|
||||
isDigit _ = False
|
||||
|
||||
unsafeDigit :: VChunk -> Int
|
||||
unsafeDigit (Digits x :| []) = fromIntegral x
|
||||
unsafeDigit _ = error "unsafeDigit: wrong input"
|
||||
|
||||
pvpFromList :: [Int] -> PVP
|
||||
pvpFromList = PVP . NE.fromList . fmap fromIntegral
|
||||
|
||||
-- | Safe 'decodeUtf8With'. Replaces an invalid input byte with
|
||||
-- the Unicode replacement character U+FFFD.
|
||||
@@ -508,6 +528,10 @@ recover action =
|
||||
#endif
|
||||
|
||||
|
||||
copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
|
||||
copyFileE from = handleIO (throwE . CopyError . show) . liftIO . copyFile from
|
||||
|
||||
|
||||
-- | Gathering monoidal values
|
||||
--
|
||||
-- >>> traverseFold (pure . (:["0"])) ["1","2"]
|
||||
@@ -528,6 +552,8 @@ forFold = \t -> (`traverseFold` t)
|
||||
--
|
||||
-- >>> stripNewline "foo\n\n\n"
|
||||
-- "foo"
|
||||
-- >>> stripNewline "foo\n\n\nfoo"
|
||||
-- "foofoo"
|
||||
-- >>> stripNewline "foo\r"
|
||||
-- "foo"
|
||||
-- >>> stripNewline "foo"
|
||||
@@ -539,10 +565,29 @@ stripNewline :: String -> String
|
||||
stripNewline = filter (`notElem` "\n\r")
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from end of 'String'.
|
||||
--
|
||||
-- >>> stripNewlineEnd "foo\n\n\n"
|
||||
-- "foo"
|
||||
-- >>> stripNewlineEnd "foo\n\n\nfoo"
|
||||
-- "foo\n\n\nfoo"
|
||||
-- >>> stripNewlineEnd "foo\r"
|
||||
-- "foo"
|
||||
-- >>> stripNewlineEnd "foo"
|
||||
-- "foo"
|
||||
--
|
||||
-- prop> \t -> stripNewlineEnd (t <> "\n") === stripNewlineEnd t
|
||||
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewlineEnd t == t
|
||||
stripNewlineEnd :: String -> String
|
||||
stripNewlineEnd = dropWhileEnd (`elem` "\n\r")
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from 'Text's
|
||||
--
|
||||
-- >>> stripNewline' "foo\n\n\n"
|
||||
-- "foo"
|
||||
-- >>> stripNewline' "foo\n\n\nfoo"
|
||||
-- "foofoo"
|
||||
-- >>> stripNewline' "foo\r"
|
||||
-- "foo"
|
||||
-- >>> stripNewline' "foo"
|
||||
|
||||
@@ -28,7 +28,7 @@ import qualified Data.Text as T
|
||||
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
|
||||
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
||||
ghcupURL :: URI
|
||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
|
||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
|
||||
|
||||
-- | The current ghcup version.
|
||||
ghcUpVer :: PVP
|
||||
|
||||
43
lib/System/Console/Terminal/Common.hs
Normal file
43
lib/System/Console/Terminal/Common.hs
Normal file
@@ -0,0 +1,43 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 702
|
||||
#define LANGUAGE_DeriveGeneric
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
#endif
|
||||
|
||||
module System.Console.Terminal.Common
|
||||
( Window(..)
|
||||
) where
|
||||
|
||||
import Data.Data (Typeable, Data)
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Data.Foldable (Foldable)
|
||||
import Data.Traversable (Traversable)
|
||||
#endif
|
||||
|
||||
#ifdef LANGUAGE_DeriveGeneric
|
||||
import GHC.Generics
|
||||
( Generic
|
||||
#if __GLASGOW_HASKELL__ >= 706
|
||||
, Generic1
|
||||
#endif
|
||||
)
|
||||
#endif
|
||||
|
||||
-- | Terminal window width and height
|
||||
data Window a = Window
|
||||
{ height :: !a
|
||||
, width :: !a
|
||||
} deriving
|
||||
( Show, Eq, Read, Data, Typeable
|
||||
, Foldable, Functor, Traversable
|
||||
#ifdef LANGUAGE_DeriveGeneric
|
||||
, Generic
|
||||
#if __GLASGOW_HASKELL__ >= 706
|
||||
, Generic1
|
||||
#endif
|
||||
#endif
|
||||
)
|
||||
65
lib/System/Console/Terminal/Posix.hsc
Normal file
65
lib/System/Console/Terminal/Posix.hsc
Normal file
@@ -0,0 +1,65 @@
|
||||
{-# LANGUAGE CApiFFI #-}
|
||||
|
||||
module System.Console.Terminal.Posix
|
||||
( size, fdSize, hSize
|
||||
) where
|
||||
|
||||
import System.Console.Terminal.Common
|
||||
import Control.Exception (catch)
|
||||
import Data.Typeable (cast)
|
||||
import Foreign
|
||||
import Foreign.C.Error
|
||||
import Foreign.C.Types
|
||||
import GHC.IO.FD (FD(FD, fdFD))
|
||||
import GHC.IO.Handle.Internals (withHandle_)
|
||||
import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
|
||||
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
|
||||
import Prelude hiding (catch)
|
||||
#endif
|
||||
import System.Posix.Types (Fd(Fd))
|
||||
|
||||
#include <sys/ioctl.h>
|
||||
#include <unistd.h>
|
||||
|
||||
|
||||
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
|
||||
|
||||
|
||||
-- Interesting part of @struct winsize@
|
||||
data CWin = CWin CUShort CUShort
|
||||
|
||||
instance Storable CWin where
|
||||
sizeOf _ = (#size struct winsize)
|
||||
alignment _ = (#alignment struct winsize)
|
||||
peek ptr = do
|
||||
row <- (#peek struct winsize, ws_row) ptr
|
||||
col <- (#peek struct winsize, ws_col) ptr
|
||||
return $ CWin row col
|
||||
poke ptr (CWin row col) = do
|
||||
(#poke struct winsize, ws_row) ptr row
|
||||
(#poke struct winsize, ws_col) ptr col
|
||||
|
||||
|
||||
fdSize :: Integral n => Fd -> IO (Maybe (Window n))
|
||||
fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
|
||||
_ <- throwErrnoIfMinus1 "ioctl" $
|
||||
ioctl fd (#const TIOCGWINSZ) ws
|
||||
CWin row col <- peek ws
|
||||
return . Just $ Window (fromIntegral row) (fromIntegral col)
|
||||
`catch`
|
||||
handler
|
||||
where
|
||||
handler :: IOError -> IO (Maybe (Window h))
|
||||
handler _ = return Nothing
|
||||
|
||||
foreign import capi "sys/ioctl.h ioctl"
|
||||
ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
|
||||
|
||||
size :: Integral n => IO (Maybe (Window n))
|
||||
size = fdSize (Fd (#const STDOUT_FILENO))
|
||||
|
||||
hSize :: Integral n => Handle -> IO (Maybe (Window n))
|
||||
hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
|
||||
case cast dev of
|
||||
Nothing -> return Nothing
|
||||
Just FD { fdFD = fd } -> fdSize (Fd fd)
|
||||
@@ -1,5 +1,9 @@
|
||||
#!/bin/sh
|
||||
|
||||
# This script downloads the 'ghcup' binary into '~/.ghcup/bin/' and then runs an interactive
|
||||
# installation that lets you choose various options. Below is a list of environment variables
|
||||
# that affect the installation procedure.
|
||||
|
||||
# Main settings:
|
||||
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
|
||||
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
|
||||
@@ -21,7 +25,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.16.2"
|
||||
ghver="0.1.17.1"
|
||||
base_url="https://downloads.haskell.org/~ghcup"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -52,41 +56,57 @@ esac
|
||||
|
||||
|
||||
die() {
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
(>&2 printf "%s\\n" "$1")
|
||||
else
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
fi
|
||||
exit 2
|
||||
}
|
||||
|
||||
warn() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;35m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;35m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;35m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;35m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
yellow() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;33m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;33m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;33m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;33m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
green() {
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;32m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
printf "%s\\n" "$1"
|
||||
else
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
echo -e "\\033[0;32m$1\\033[0m"
|
||||
;;
|
||||
*)
|
||||
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
edo() {
|
||||
@@ -100,7 +120,7 @@ eghcup() {
|
||||
_eghcup() {
|
||||
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
|
||||
args="-s ${BOOTSTRAP_HASKELL_YAML}"
|
||||
fi
|
||||
fi
|
||||
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
|
||||
"${GHCUP_BIN}/ghcup" ${args} "$@"
|
||||
else
|
||||
@@ -176,7 +196,15 @@ download_ghcup() {
|
||||
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
|
||||
;;
|
||||
aarch64|arm64|armv8l)
|
||||
_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver}
|
||||
# we could be in a 32bit docker container, in which
|
||||
# case uname doesn't give us what we want
|
||||
if [ "$(getconf LONG_BIT)" = "32" ] ; then
|
||||
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
|
||||
elif [ "$(getconf LONG_BIT)" = "64" ] ; then
|
||||
_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver}
|
||||
else
|
||||
die "Unknown long bit size: $(getconf LONG_BIT)"
|
||||
fi
|
||||
;;
|
||||
*) die "Unknown architecture: ${arch}"
|
||||
;;
|
||||
@@ -397,7 +425,7 @@ warn_path() {
|
||||
echo
|
||||
[ -n "$1" ] && warn "$1"
|
||||
yellow "In order to run ghc and cabal, you need to adjust your PATH variable."
|
||||
yellow "To do so, you may want run 'source $GHCUP_DIR/env' in your current terminal"
|
||||
yellow "To do so, you may want to run 'source $GHCUP_DIR/env' in your current terminal"
|
||||
yellow "session as well as your shell configuration (e.g. ~/.bashrc)."
|
||||
|
||||
}
|
||||
@@ -669,4 +697,3 @@ _done
|
||||
)
|
||||
|
||||
# vim: tabstop=4 shiftwidth=4 expandtab
|
||||
|
||||
|
||||
@@ -11,6 +11,8 @@
|
||||
* cabal - The Cabal build tool for managing Haskell software"
|
||||
* stack - (optional) A cross-platform program for developing Haskell projects"
|
||||
* hls - (optional) A language server for developers to integrate with their editor/IDE"
|
||||
|
||||
By default, the installation is non-interactive, unless you run it with 'Interactive $true'.
|
||||
#>
|
||||
param (
|
||||
# Run an interactive installation
|
||||
|
||||
@@ -4,9 +4,6 @@ packages:
|
||||
- .
|
||||
|
||||
extra-deps:
|
||||
- git: https://github.com/bgamari/terminal-size
|
||||
commit: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
- git: https://github.com/hasufell/libarchive
|
||||
commit: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
|
||||
@@ -174,7 +174,17 @@ span.code {
|
||||
line-height: 2rem;
|
||||
}
|
||||
|
||||
#help {
|
||||
margin-bottom: 0px !important;
|
||||
}
|
||||
|
||||
#collective {
|
||||
margin-top: 1em !important;
|
||||
margin-bottom: 0px !important;
|
||||
}
|
||||
|
||||
#about {
|
||||
margin-top: 0.5em !important;
|
||||
font-size: 16px;
|
||||
line-height: 2em;
|
||||
}
|
||||
|
||||
@@ -24,30 +24,29 @@
|
||||
</p>
|
||||
|
||||
<div id="platform-instructions-linux" class="instructions" style="display: none;">
|
||||
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running Linux. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p>On Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Linux</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-mac" class="instructions" style="display: none;">
|
||||
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<p>On macOS, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-normal">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running macOS</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-freebsd" class="instructions" style="display: none;">
|
||||
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<p>On FreeBSD Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running FreeBSD. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running FreeBSD</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-win32" class="instructions">
|
||||
<p>
|
||||
To install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
On Windows, to install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div>
|
||||
<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-powershell">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
</div>
|
||||
<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
</p>
|
||||
@@ -58,18 +57,19 @@
|
||||
</div>
|
||||
</p>
|
||||
<hr/>
|
||||
<p class="other-help">You appear to be running Windows 32-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-win64" class="instructions" style="display: none;">
|
||||
<p>
|
||||
To install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
On Windows, to install Haskell,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run an non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
|
||||
</div>
|
||||
</p>
|
||||
<hr/>
|
||||
<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
|
||||
</p>
|
||||
<div>
|
||||
@@ -77,7 +77,7 @@
|
||||
</div>
|
||||
<p class="other-help">WSL1 does not work with ghcup, follow <a href="https://docs.microsoft.com/en-us/windows/wsl/install-win10">the instructions here</a> to upgrade to WSL2 if needed.</p>
|
||||
</div>
|
||||
<p class="other-help">You appear to be running Windows 64-bit. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a class="default-platform-button" href="#">I'm not running Windows</a></p>
|
||||
</div>
|
||||
|
||||
<div id="platform-instructions-unknown" class="instructions" style="display: none;">
|
||||
@@ -101,7 +101,7 @@
|
||||
<div>
|
||||
<p>If you are running Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a></p>
|
||||
</div>
|
||||
|
||||
<hr/>
|
||||
@@ -120,7 +120,7 @@
|
||||
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run the following
|
||||
in your terminal (as a user other than root), then follow the onscreen instructions.</p>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">I don't like curl | sh</a></p>
|
||||
</div>
|
||||
|
||||
<hr/>
|
||||
@@ -130,25 +130,30 @@
|
||||
If you are running Windows,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
<p class="other-help"><a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a></p>
|
||||
</div>
|
||||
</p>
|
||||
</div>
|
||||
|
||||
</div>
|
||||
|
||||
<p>
|
||||
<p id="help">
|
||||
Need help? Ask on <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup"><img src="irc.svg" height="18px" alt="" />IRC</a>, <a href="https://discord.gg/pKYf3zDQU7"><img src="Discord-Logo-Black.svg" height="18px" alt="" />Discord</a>, <a href="https://app.element.io/#/room/#haskell-tooling:matrix.org"><img src="Matrix_logo.svg" height="25px" alt="" style="top:5px;position:relative;" /></a> or <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">report a bug <img src="Octicons-bug.svg" height="18px" alt="" /></a>.
|
||||
</p>
|
||||
<p id="collective">
|
||||
<a id="collective" href="https://opencollective.com/ghcup#category-CONTRIBUTE" target="_blank">
|
||||
<img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" width=200 />
|
||||
</a>
|
||||
</p>
|
||||
|
||||
<p id="about">
|
||||
<img src="haskell-logo.svg" alt="" />
|
||||
ghcup is a haskell.org supported project.
|
||||
<br/>
|
||||
<a href="https://www.haskell.org/downloads/">other installation options</a>
|
||||
·
|
||||
<b> · </b>
|
||||
<a href="https://gitlab.haskell.org/haskell/ghcup-hs">about ghcup</a>
|
||||
·
|
||||
<b> · </b>
|
||||
<a href="https://github.com/rust-lang/rustup.rs/tree/master/www">web design from rustup</a>
|
||||
</p>
|
||||
<script type="text/javascript" src="ghcup.js"></script>
|
||||
|
||||
Reference in New Issue
Block a user