Compare commits

...

74 Commits

Author SHA1 Message Date
0f14dee72a Bump HLS to 1.4.0 2021-09-15 22:41:57 +02:00
ae2031174e Improve warnAboutHlsCompatibility 2021-09-14 12:36:14 +02:00
c163278c64 Merge remote-tracking branch 'origin/merge-requests/172' 2021-09-14 12:26:41 +02:00
d10133f06f Clean up toolRequirements 2021-09-13 22:33:46 +02:00
4377fc663e Merge branch 'opencollective' 2021-09-13 08:43:10 +02:00
487e236882 Add opencollective button 2021-09-13 08:34:13 +02:00
Chris Smith
737f72f90f Lint fix. 2021-09-11 23:35:39 -04:00
Chris Smith
c3aab65521 Rewording 2021-09-11 23:24:21 -04:00
Chris Smith
972474f79a Add version numbers to error message.
Fixes after formatting changes.
2021-09-11 23:17:14 -04:00
bc64d2ade0 Apply 3 suggestion(s) to 1 file(s) 2021-09-12 03:09:36 +00:00
Chris Smith
eddda55fe6 Fix hlint warnings 2021-09-11 19:57:42 -04:00
Chris Smith
13aca91231 Add a warning when the installed HLS and GHC versions are not compatible.
This is triggered when:

1. The user has just set either the GHC or HLS version.
2. There is an HLS version set (so some GHC version is compatible).
3. There is a GHC version.
4. The HLS version doesn't support that GHC version.

Fixes #234
2021-09-11 19:33:27 -04:00
bbd11bfa26 Merge branch 'freebsd13' 2021-09-11 09:22:44 +02:00
75548fa02d Merge branch 'improve-ci' 2021-09-10 20:59:14 +02:00
fb6956009f Add cabal freebsd13 bindists 2021-09-10 20:58:26 +02:00
e029117c3e Fix freebsd runner getting stuck (maybe) 2021-09-10 19:48:42 +02:00
bc7c01de90 Add aarch64-darwin and armv7-linux cabal-3.6.0.0 bindists 2021-09-10 19:07:07 +02:00
cfcd8a4c20 Merge remote-tracking branch 'origin/merge-requests/170' 2021-09-10 18:29:37 +02:00
5e17eb7ca7 Bump FreeBSD runner 2021-09-10 15:46:19 +02:00
amesgen
756727ffe2 Add cabal 3.6.0.0 2021-09-10 15:40:42 +02:00
6bc602dead Merge branch 'fix-boot' 2021-09-10 15:15:59 +02:00
056c79e813 Improve CI 2021-09-10 15:14:40 +02:00
68bbf31a86 Fix download for armv7 container on arm64 host 2021-09-10 14:59:26 +02:00
b58f380e75 Merge branch 'bootstrap' 2021-09-10 13:55:55 +02:00
48c54bf374 Don't unconditionally adjust .bashrc on windows 2021-09-10 13:34:22 +02:00
51da1578f4 Merge remote-tracking branch 'origin/merge-requests/166' 2021-09-08 22:16:02 +02:00
jneira
488f25aed6 Include stack and minor correction 2021-09-08 14:14:05 +02:00
d355c46250 Merge branch 'issue-228' 2021-09-07 00:05:30 +02:00
787c927de6 Improve logging, fixes #228 2021-09-06 23:01:49 +02:00
d15ff7bc67 Improve README 2021-09-05 22:43:44 +02:00
7c5c35f1b0 Fix typo 2021-09-05 22:23:08 +02:00
001b090bc6 Merge branch 'ghc-compile-patch' 2021-09-05 22:21:42 +02:00
db8207f8b9 Fixup 2021-09-04 16:06:33 +02:00
e5918de7af Update README 2021-09-04 15:59:14 +02:00
d2346a543a Fixup 2021-09-04 15:53:29 +02:00
c057b4ae5c Improve documentation about building 2021-09-04 15:14:32 +02:00
b962bf4af9 Add missing qAddDependentFiles 2021-09-04 15:10:07 +02:00
c54dc05d92 Read build.mk from files at build time 2021-09-04 15:09:14 +02:00
8c72bf697e Move files into nicer subdirectories 2021-09-04 15:08:58 +02:00
cc8cf3d12a Improve --patchdir documentation wrt #226 2021-09-04 14:31:05 +02:00
9bdf6bde17 Only consider .diff/.patch for patch files wrt #226 2021-09-04 14:25:24 +02:00
8363495843 Update known users 2021-09-03 23:58:28 +02:00
bc80b1048f Fix debug logs 2021-09-03 21:00:39 +02:00
d61981bc1b Update doc on ghcupURL 2021-09-02 21:27:31 +02:00
4ccdc5dd6c Update RELEASING.md 2021-09-02 21:23:37 +02:00
3240118226 Simplify CI section 2021-09-02 21:11:13 +02:00
254989d63d Merge branch 'issue-221' 2021-09-02 16:22:38 +02:00
283f2a6e46 Add ghcup whereis bindir and friends, fixes #221 2021-09-02 15:37:03 +02:00
94637dfbab Merge branch 'updates' 2021-09-01 01:00:20 +02:00
3e26d7057c Update ghc file 2021-09-01 00:44:52 +02:00
3f710112f3 Rather do it in bootstrap-haskell 2021-08-31 23:23:59 +02:00
34df41b44a Update debian image 2021-08-31 23:04:57 +02:00
3897434ef0 Create .bash_profile on windows if it doesn't exist 2021-08-31 22:59:32 +02:00
375dba9dd1 Improve hlint job 2021-08-31 22:59:32 +02:00
2edd1fb583 Merge branch 'fix-bootstrap-win' 2021-08-31 19:28:21 +02:00
11326060fb Smaller fixes to windows bootstrap 2021-08-31 18:57:38 +02:00
d343c01737 Add CI section 2021-08-31 02:17:38 +02:00
3925f78721 Merge branch 'drop-monad-logger' 2021-08-30 23:55:31 +02:00
d98e54a743 Drop yaml/libyaml 2021-08-30 23:36:11 +02:00
13143b8e4d Drop monad-logger 2021-08-30 23:36:11 +02:00
3a7895e5ea Reorder 2021-08-30 13:59:30 +02:00
2893b2e2d2 Adjust argumentlist 2021-08-30 13:49:48 +02:00
987436fed2 Adjust switch order 2021-08-30 13:47:08 +02:00
96ac66e909 Merge branch 'issue-222' 2021-08-30 11:42:28 +02:00
e5947f3490 Add BOOTSTRAP_HASKELL_MINIMAL wrt #222 2021-08-30 11:19:43 +02:00
b35fe15703 Merge branch 'remove-zipp' 2021-08-29 23:11:03 +02:00
a269b60282 Remove extra 2021-08-29 22:37:16 +02:00
fc6f7ffd73 Update stack.yaml 2021-08-29 21:21:03 +02:00
430dc2d20b Remove zip dependency 2021-08-29 20:56:17 +02:00
77c464870f Refreeze 2021-08-29 17:46:53 +02:00
dda38ec52b Merge remote-tracking branch 'origin/merge-requests/158' 2021-08-29 17:43:01 +02:00
Jan Hrček
f6b6b36eb7 Apply hlint 3.3.2 suggestions 2021-08-29 17:08:06 +02:00
Jan Hrček
3986677b06 Fix typos and simplify code 2021-08-29 14:50:49 +02:00
1fb048777c Merge branch 'cabal-plan' 2021-08-27 15:19:17 +02:00
62 changed files with 9892 additions and 9516 deletions

View File

@@ -14,7 +14,7 @@ variables:
############################################################ ############################################################
.debian: .debian:
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
tags: tags:
- x86_64-linux - x86_64-linux
variables: variables:
@@ -77,7 +77,7 @@ variables:
.freebsd: .freebsd:
tags: tags:
- x86_64-freebsd - x86_64-freebsd13
variables: variables:
OS: "FREEBSD" OS: "FREEBSD"
ARCH: "64" ARCH: "64"
@@ -103,7 +103,7 @@ variables:
artifacts: artifacts:
expire_in: 2 week expire_in: 2 week
paths: paths:
- golden - test/golden
- dist-newstyle/cache/ - dist-newstyle/cache/
when: on_failure when: on_failure
@@ -240,7 +240,7 @@ test:linux:bootstrap_script:
test:windows:bootstrap_powershell_script: test:windows:bootstrap_powershell_script:
stage: test stage: test
script: script:
- ./bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash - ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash
after_script: after_script:
- "[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)" - "[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)"
- "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)" - "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)"
@@ -527,15 +527,9 @@ release:windows:
hlint: hlint:
stage: hlint stage: hlint
extends: extends:
- .alpine:64bit - .debian
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
script: script:
- ./.gitlab/script/hlint.sh - curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
variables:
GHC_VERSION: "8.10.6"
CABAL_VERSION: "3.4.0.0"
JSON_VERSION: "0.0.4"
allow_failure: true allow_failure: true
artifacts: artifacts:
expire_in: 2 week expire_in: 2 week

View File

@@ -11,9 +11,9 @@ mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin upgrade -i -f ./ghcup-bin -v upgrade -i -f
./ghcup-bin install ${GHC_VERSION} ./ghcup-bin -v install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION} ./ghcup-bin -v set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-bin -v install-cabal ${CABAL_VERSION}
exit 0 exit 0

View File

@@ -7,67 +7,21 @@ set -eux
mkdir -p "${TMPDIR}" mkdir -p "${TMPDIR}"
sudo apt-get update -y 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 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 dpkg --add-architecture armhf
sudo apt-get update -y sudo apt-get update -y
sudo apt-get install -y libncurses-dev:armhf sudo apt-get install -y libncurses-dev:armhf
fi fi
case "${ARCH}" in export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
ARM*) export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
case "${ARCH}" in export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
"ARM") export BOOTSTRAP_HASKELL_VERBOSE=1
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
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
curl -O "${ghc_url}" rm "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
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

File diff suppressed because it is too large Load Diff

View File

@@ -24,7 +24,7 @@ export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
./bootstrap-haskell ./scripts/bootstrap/bootstrap-haskell
[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ] [ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]

View File

@@ -13,7 +13,7 @@ ecabal() {
} }
eghcup() { eghcup() {
ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@" ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
} }
git describe --always git describe --always

View File

@@ -13,7 +13,7 @@ ecabal() {
} }
eghcup() { eghcup() {
ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@" ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
} }
git describe --always git describe --always

View File

@@ -18,9 +18,9 @@ raw_eghcup() {
eghcup() { eghcup() {
if [ "${OS}" = "WINDOWS" ] ; then if [ "${OS}" = "WINDOWS" ] ; then
ghcup -v -c -s file:/$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@" ghcup -v -c -s file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
else else
ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@" ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
fi fi
} }
@@ -92,7 +92,7 @@ rm -rf "${GHCUP_DIR}"
### manual cli based testing ### manual cli based testing
ghcup-gen check -f ghcup-${JSON_VERSION}.yaml ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
eghcup --numeric-version eghcup --numeric-version
@@ -172,10 +172,10 @@ else
fi fi
# check that lazy loading works for 'whereis' # check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak" cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml" echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc $(ghc --numeric-version) eghcup whereis ghc $(ghc --numeric-version)
mv -f "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml" mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup rm $(ghc --numeric-version) eghcup rm $(ghc --numeric-version)

108
README.md
View File

@@ -10,6 +10,7 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
[![Join the chat at Matrix.org](https://img.shields.io/matrix/haskell-tooling:matrix.org?label=chat%20on%20matrix.org)](https://app.element.io/#/room/#haskell-tooling:matrix.org) [![Join the chat at Matrix.org](https://img.shields.io/matrix/haskell-tooling:matrix.org?label=chat%20on%20matrix.org)](https://app.element.io/#/room/#haskell-tooling:matrix.org)
[![Join the chat at Discord](https://img.shields.io/discord/280033776820813825?label=chat%20on%20discord)](https://discord.gg/pKYf3zDQU7) [![Join the chat at Discord](https://img.shields.io/discord/280033776820813825?label=chat%20on%20discord)](https://discord.gg/pKYf3zDQU7)
[![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](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) * [Installation](#installation)
* [Simple bootstrap](#simple-bootstrap) * [Simple bootstrap](#simple-bootstrap)
@@ -19,11 +20,12 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
* [Configuration](#configuration) * [Configuration](#configuration)
* [Manpages](#manpages) * [Manpages](#manpages)
* [Shell-completion](#shell-completion) * [Shell-completion](#shell-completion)
* [Cross support](#cross-support) * [Compiling GHC from source](#compiling-ghc-from-source)
* [XDG support](#xdg-support) * [XDG support](#xdg-support)
* [Env variables](#env-variables) * [Env variables](#env-variables)
* [Installing custom bindists](#installing-custom-bindists) * [Installing custom bindists](#installing-custom-bindists)
* [Isolated Installs](#isolated-installs) * [Isolated Installs](#isolated-installs)
* [CI](#ci)
* [Tips and tricks](#tips-and-tricks) * [Tips and tricks](#tips-and-tricks)
* [Design goals](#design-goals) * [Design goals](#design-goals)
* [How](#how) * [How](#how)
@@ -90,7 +92,7 @@ handles your haskell packages and can demand that [a specific version](https://c
### Configuration ### Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
explaining all possible configurations can be found in this repo: [config.yaml](./config.yaml). explaining all possible configurations can be found in this repo: [config.yaml](./data/config.yaml).
Partial configuration is fine. Command line options always override the config file settings. Partial configuration is fine. Command line options always override the config file settings.
@@ -101,14 +103,26 @@ For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man`
### Shell-completion ### Shell-completion
Shell completions are in `shell-completions`. Shell completions are in [scripts/shell-completions](./scripts/shell-completions) directory of this repository.
For bash: install `shell-completions/bash` For bash: install `shell-completions/bash`
as e.g. `/etc/bash_completion.d/ghcup` (depending on distro) as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros). (`/usr/share/bash-completion/bash_completion` on some distros).
### Cross support ### Compiling GHC from source
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
for a list of all available options.
If you need to overwrite the existing `build.mk`, check the default files
in [data/build_mk](./data/build_mk), copy them somewhere, adjust them and
pass `--config path/to/build.mk` to `ghcup compile ghc`.
Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/using#build-configuration).
Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
#### Cross support
ghcup can compile and install a cross GHC for any target. However, this ghcup can compile and install a cross GHC for any target. However, this
requires that the build host has a complete cross toolchain and various requires that the build host has a complete cross toolchain and various
@@ -190,6 +204,83 @@ Examples:-
5. you can even compile ghc to an isolated location. 5. you can even compile ghc to an isolated location.
- `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc` - `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc`
--- ---
### CI
On windows, ghcup can be installed automatically on a CI runner like so:
```ps
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 $false,$true,$true,$false,$false,$false,$false,"C:\"
```
On linux/darwin/freebsd, run the following on your runner:
```sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
```
This will just install `ghcup` and on windows additionally `msys2`.
#### Example github workflow
On github workflows you can use https://github.com/haskell/actions/
If you want to install ghcup manually though, here's an example config:
```yml
name: Haskell CI
on:
push:
branches: [ master ]
pull_request:
branches: [ master ]
jobs:
build-cabal:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-latest, macOS-latest, windows-latest]
ghc: ['8.10.7', '9.0.1']
cabal: ['3.4.0.0']
steps:
- uses: actions/checkout@v2
- if: matrix.os == 'windows-latest'
name: Install ghcup on windows
run: 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 $false,$true,$true,$false,$false,$false,$false,"C:\"
- if: matrix.os == 'windows-latest'
name: Add ghcup to PATH
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
shell: bash
- if: matrix.os != 'windows-latest'
name: Install ghcup on non-windows
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
- name: Install ghc/cabal
run: |
ghcup install ghc ${{ matrix.ghc }}
ghcup install cabal ${{ matrix.cabal }}
shell: bash
- name: Update cabal index
run: cabal update
shell: bash
- name: Build
run: cabal build --enable-tests --enable-benchmarks
shell: bash
- name: Run tests
run: cabal test
shell: bash
```
### Tips and tricks ### Tips and tricks
@@ -266,8 +357,13 @@ In addition this script can also install `cabal-install`.
## Known users ## Known users
* Github action [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup) * Github actions:
* [vabal](https://github.com/Franciman/vabal) - [actions/virtual-environments](https://github.com/actions/virtual-environments)
- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
* mirrors:
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
* tools:
- [vabal](https://github.com/Franciman/vabal)
## Known problems ## Known problems

View File

@@ -1,19 +0,0 @@
# RELEASING
1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version.
2. Update version in ghcup.cabal
3. Add ChangeLog entry
4. Add/fix downloads in `ghcup-<ver>.yaml`, then verify with `ghcup-gen check -f ghcup-<ver>.yaml`
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
6. Download release artifacts and upload them `downloads.haskell.org/ghcup`
7. Add release artifacts to yaml file (see point 4.)
8. Upload the final `ghcup-<ver>.yaml` to `webhost.haskell.org/ghcup/data/`.
9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup`

View File

@@ -11,22 +11,31 @@
module Main where module Main where
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics
import GHCup.Errors
import GHCup.Platform
import GHCup.Utils.Dirs
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.IO.Class
import Data.Char ( toLower ) import Data.Char ( toLower )
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) ) import Data.Semigroup ( (<>) )
#endif #endif
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Haskus.Utils.Variant.Excepts
import System.Console.Pretty import System.Console.Pretty
import System.Exit import System.Exit
import System.IO ( stdout ) import System.IO ( stderr )
import Text.Regex.Posix import Text.Regex.Posix
import Validate import Validate
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Yaml as Y import qualified Data.YAML.Aeson as Y
data Options = Options data Options = Options
@@ -105,10 +114,27 @@ com = subparser
main :: IO () main :: IO ()
main = do main = do
let loggerConfig = LoggerConfig { lcPrintDebug = True
, colorOutter = T.hPutStr stderr
, rawOutter = \_ -> pure ()
}
dirs <- liftIO getAllDirs
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings loggerConfig
pfreq <- (
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
) >>= \case
VRight r -> pure r
VLeft e -> 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
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of >>= \Options {..} -> case optCommand of
ValidateYAML vopts -> withValidateYamlOpts vopts validate ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (validateTarballs tarballFilter) ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
pure () pure ()
where where
@@ -120,8 +146,8 @@ main = do
ValidateYAMLOpts { vInput = Just (FileInput file) } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit f B.readFile file >>= valAndExit f
valAndExit f contents = do valAndExit f contents = do
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of (GHCupInfo _ av gt) <- case Y.decode1Strict contents of
Right r -> pure r Right r -> pure r
Left e -> die (color Red $ show e) Left (_, e) -> die (color Red $ show e)
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av gt) f av gt
>>= exitWith >>= exitWith

View File

@@ -12,11 +12,9 @@ module Validate where
import GHCup import GHCup
import GHCup.Download import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Platform import GHCup.Types
import GHCup.Types hiding ( LeanAppState (..) )
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
import Codec.Archive import Codec.Archive
@@ -24,7 +22,6 @@ import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader.Class import Control.Monad.Reader.Class
import Control.Monad.Trans.Class ( lift ) import Control.Monad.Trans.Class ( lift )
import Control.Monad.Trans.Reader ( runReaderT ) import Control.Monad.Trans.Reader ( runReaderT )
@@ -39,12 +36,10 @@ import Haskus.Utils.Variant.Excepts
import Optics import Optics
import System.FilePath import System.FilePath
import System.Exit import System.Exit
import System.IO
import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadP
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix import Text.Regex.Posix
import qualified Data.ByteString as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Version as V import qualified Data.Version as V
@@ -62,7 +57,7 @@ addError = do
liftIO $ modifyIORef ref (+ 1) liftIO $ modifyIORef ref (+ 1)
validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m) validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m)
=> GHCupDownloads => GHCupDownloads
-> M.Map GlobalTool DownloadInfo -> M.Map GlobalTool DownloadInfo
-> m ExitCode -> m ExitCode
@@ -89,23 +84,23 @@ validate dls _ = do
if e > 0 if e > 0
then pure $ ExitFailure e then pure $ ExitFailure e
else do else do
lift $ $(logInfo) "All good" lift $ logInfo "All good"
pure ExitSuccess pure ExitSuccess
where where
checkHasRequiredPlatforms t v tags arch pspecs = do checkHasRequiredPlatforms t v tags arch pspecs = do
let v' = prettyVer v let v' = prettyVer v
arch' = prettyShow arch arch' = prettyShow arch
when (notElem (Linux UnknownLinux) pspecs) $ do when (notElem (Linux UnknownLinux) pspecs) $ do
lift $ $(logError) $ lift $ logError $
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError addError
when ((notElem Darwin pspecs) && arch == A_64) $ do when ((notElem Darwin pspecs) && arch == A_64) $ do
lift $ $(logError) $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError addError
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn) $ when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
when (notElem Windows pspecs && arch == A_64) $ do when (notElem Windows pspecs && arch == A_64) $ do
lift $ $(logError) $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch' lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError addError
-- alpine needs to be set explicitly, because -- alpine needs to be set explicitly, because
@@ -113,12 +108,12 @@ validate dls _ = do
-- (although it could be static) -- (although it could be static)
when (notElem (Linux Alpine) pspecs) $ when (notElem (Linux Alpine) pspecs) $
case t of case t of
GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
Cabal | v > [vver|2.4.1.0|] Cabal | v > [vver|2.4.1.0|]
, arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
GHC | Latest `elem` tags || Recommended `elem` tags GHC | Latest `elem` tags || Recommended `elem` tags
, arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) , arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
_ -> lift $ $(logWarn) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch) _ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
checkUniqueTags tool = do checkUniqueTags tool = do
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
@@ -138,7 +133,7 @@ validate dls _ = do
case join nonUnique of case join nonUnique of
[] -> pure () [] -> pure ()
xs -> do xs -> do
lift $ $(logError) $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs) lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
addError addError
where where
isUniqueTag Latest = True isUniqueTag Latest = True
@@ -154,7 +149,7 @@ validate dls _ = do
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
[_] -> pure () [_] -> pure ()
_ -> do _ -> do
lift $ $(logError) $ "GHC version " <> prettyVer v <> " is not valid" lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
addError addError
-- a tool must have at least one of each mandatory tags -- a tool must have at least one of each mandatory tags
@@ -162,7 +157,7 @@ validate dls _ = do
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
forM_ [Latest, Recommended] $ \t -> case elem t allTags of forM_ [Latest, Recommended] $ \t -> case elem t allTags of
False -> do False -> do
lift $ $(logError) $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool) lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
addError addError
True -> pure () True -> pure ()
@@ -171,7 +166,7 @@ validate dls _ = do
let allTags = M.toList $ availableToolVersions dls GHC let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
False -> do False -> do
lift $ $(logError) $ "Base tag missing from GHC ver " <> prettyVer ver lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
addError addError
True -> pure () True -> pure ()
@@ -184,7 +179,10 @@ data TarballFilter = TarballFilter
} }
validateTarballs :: ( Monad m validateTarballs :: ( Monad m
, MonadLogger m , MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadThrow m , MonadThrow m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -199,45 +197,37 @@ validateTarballs :: ( Monad m
validateTarballs (TarballFilter etool versionRegex) dls gt = do validateTarballs (TarballFilter etool versionRegex) dls gt = do
ref <- liftIO $ newIORef 0 ref <- liftIO $ newIORef 0
flip runReaderT ref $ do -- download/verify all tarballs
-- download/verify all tarballs let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool let gdlis = nubOrd $ gt ^.. each
let gdlis = nubOrd $ gt ^.. each let allDls = either (const gdlis) (const dlis) etool
let allDls = either (const gdlis) (const dlis) etool when (null allDls) $ logError "no tarballs selected by filter" *> (flip runReaderT ref addError)
when (null allDls) $ $(logError) "no tarballs selected by filter" *> addError forM_ allDls (downloadAll ref)
forM_ allDls downloadAll
-- exit -- exit
e <- liftIO $ readIORef ref e <- liftIO $ readIORef ref
if e > 0 if e > 0
then pure $ ExitFailure e then pure $ ExitFailure e
else do else do
lift $ $(logInfo) "All good" logInfo "All good"
pure ExitSuccess pure ExitSuccess
where where
runLogger = myLoggerT LoggerConfig { lcPrintDebug = True downloadAll :: ( MonadUnliftIO m
, colorOutter = B.hPut stderr , MonadIO m
, rawOutter = \_ -> pure () , MonadReader env m
} , HasLog env
downloadAll dli = do , HasDirs env
dirs <- liftIO getAllDirs , HasSettings env
, MonadCatch m
pfreq <- ( , MonadMask m
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest , MonadThrow m
) >>= \case )
VRight r -> pure r => IORef Int
VLeft e -> do -> DownloadInfo
lift $ runLogger -> m ()
($(logError) $ T.pack $ prettyShow e) downloadAll ref dli = do
liftIO $ exitWith (ExitFailure 2) r <- runResourceT
let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
r <-
runLogger
. flip runReaderT appstate
. runResourceT
. runE @'[DigestError . runE @'[DigestError
, DownloadFailed , DownloadFailed
, UnknownArchive , UnknownArchive
@@ -263,26 +253,26 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
VRight (Just basePath) -> do VRight (Just basePath) -> do
case _dlSubdir dli of case _dlSubdir dli of
Just (RealDir prel) -> do Just (RealDir prel) -> do
lift $ $(logInfo) logInfo
$ " verifying subdir: " <> T.pack prel $ " verifying subdir: " <> T.pack prel
when (basePath /= prel) $ do when (basePath /= prel) $ do
lift $ $(logError) $ logError $
"Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
addError (flip runReaderT ref addError)
Just (RegexDir regexString) -> do Just (RegexDir regexString) -> do
lift $ $(logInfo) $ logInfo $
"verifying subdir (regex): " <> T.pack regexString "verifying subdir (regex): " <> T.pack regexString
let regex = makeRegexOpts let regex = makeRegexOpts
compIgnoreCase compIgnoreCase
execBlank execBlank
regexString regexString
when (not (match regex basePath)) $ do when (not (match regex basePath)) $ do
lift $ $(logError) $ logError $
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
addError (flip runReaderT ref addError)
Nothing -> pure () Nothing -> pure ()
VRight Nothing -> pure () VRight Nothing -> pure ()
VLeft e -> do VLeft e -> do
lift $ $(logError) $ logError $
"Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e) "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
addError (flip runReaderT ref addError)

View File

@@ -13,11 +13,11 @@ module BrickMain where
import GHCup import GHCup
import GHCup.Download import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics hiding ( getGHCupInfo )
import GHCup.Types hiding ( LeanAppState(..) ) import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Prelude ( decUTF8Safe ) import GHCup.Utils.Prelude ( decUTF8Safe )
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Logger
import Brick import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
@@ -29,7 +29,6 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
) )
import Codec.Archive import Codec.Archive
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
@@ -417,12 +416,8 @@ install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, Monad
install' _ (_, ListResult {..}) = do install' _ (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
l <- liftIO $ readIORef logger'
let runLogger = myLoggerT l
let run = let run =
runLogger runResourceT
. runResourceT
. runE . runE
@'[ AlreadyInstalled @'[ AlreadyInstalled
, ArchiveResult , ArchiveResult
@@ -462,7 +457,7 @@ install' _ (_, ListResult {..}) = do
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
myLoggerT l $ $(logInfo) msg logInfo msg
pure $ Right () pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right () VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right () VLeft (V NoUpdate) -> pure $ Right ()
@@ -473,12 +468,9 @@ install' _ (_, ListResult {..}) = do
set' :: BrickState -> (Int, ListResult) -> IO (Either String ()) set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
set' _ (_, ListResult {..}) = do set' _ (_, ListResult {..}) = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
let run = let run =
runLogger flip runReaderT settings
. flip runReaderT settings
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound] . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
run (do run (do
@@ -501,9 +493,7 @@ del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnlif
del' _ (_, ListResult {..}) = do del' _ (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
l <- liftIO $ readIORef logger' let run = runE @'[NotInstalled]
let runLogger = myLoggerT l
let run = myLoggerT l . runE @'[NotInstalled]
run (do run (do
let vi = getVersionInfo lVer lTool dls let vi = getVersionInfo lVer lTool dls
@@ -517,7 +507,7 @@ del' _ (_, ListResult {..}) = do
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (join $ fmap _viPostRemove vi) $ \msg -> forM_ (join $ fmap _viPostRemove vi) $ \msg ->
runLogger $ $(logInfo) msg logInfo msg
pure $ Right () pure $ Right ()
VLeft e -> pure $ Left (prettyShow e) VLeft e -> pure $ Left (prettyShow e)
@@ -546,6 +536,10 @@ settings' :: IORef AppState
{-# NOINLINE settings' #-} {-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do settings' = unsafePerformIO $ do
dirs <- getAllDirs dirs <- getAllDirs
let loggerConfig = LoggerConfig { lcPrintDebug = False
, colorOutter = \_ -> pure ()
, rawOutter = \_ -> pure ()
}
newIORef $ AppState (Settings { cache = True newIORef $ AppState (Settings { cache = True
, noVerify = False , noVerify = False
, keepDirs = Never , keepDirs = Never
@@ -559,27 +553,14 @@ settings' = unsafePerformIO $ do
defaultKeyBindings defaultKeyBindings
(GHCupInfo mempty mempty mempty) (GHCupInfo mempty mempty mempty)
(PlatformRequest A_64 Darwin Nothing) (PlatformRequest A_64 Darwin Nothing)
loggerConfig
logger' :: IORef LoggerConfig
{-# NOINLINE logger' #-}
logger' = unsafePerformIO
(newIORef $ LoggerConfig { lcPrintDebug = False
, colorOutter = \_ -> pure ()
, rawOutter = \_ -> pure ()
}
)
brickMain :: AppState brickMain :: AppState
-> LoggerConfig
-> IO () -> IO ()
brickMain s l = do brickMain s = do
writeIORef settings' s writeIORef settings' s
-- logger interpreter
writeIORef logger' l
let runLogger = myLoggerT l
no_color <- isJust <$> lookupEnv "NO_COLOR" no_color <- isJust <$> lookupEnv "NO_COLOR"
@@ -596,7 +577,7 @@ brickMain s l = do
) )
$> () $> ()
Left e -> do Left e -> do
runLogger ($(logError) $ "Error building app state: " <> T.pack (show e)) flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
exitWith $ ExitFailure 2 exitWith $ ExitFailure 2
@@ -607,12 +588,9 @@ defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = Fal
getGHCupInfo :: IO (Either String GHCupInfo) getGHCupInfo :: IO (Either String GHCupInfo)
getGHCupInfo = do getGHCupInfo = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
r <- r <-
runLogger flip runReaderT settings
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError] . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
$ liftE $ liftE
$ getDownloadsF $ getDownloadsF
@@ -625,14 +603,11 @@ getGHCupInfo = do
getAppData :: Maybe GHCupInfo getAppData :: Maybe GHCupInfo
-> IO (Either String BrickData) -> IO (Either String BrickData)
getAppData mgi = runExceptT $ do getAppData mgi = runExceptT $ do
l <- liftIO $ readIORef logger'
let runLogger = myLoggerT l
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r }) liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
settings <- liftIO $ readIORef settings' settings <- liftIO $ readIORef settings'
runLogger . flip runReaderT settings $ do flip runReaderT settings $ do
lV <- listVersions Nothing Nothing lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV) pure $ BrickData (reverse lV)

View File

@@ -40,7 +40,6 @@ import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Aeson ( decodeStrict', Value ) import Data.Aeson ( decodeStrict', Value )
@@ -58,6 +57,7 @@ import Data.Void
import GHC.IO.Encoding import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH import Language.Haskell.TH
import Language.Haskell.TH.Syntax ( Quasi(qAddDependentFile) )
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
@@ -78,8 +78,7 @@ import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y import qualified Data.YAML.Aeson as Y
import qualified Data.Yaml.Pretty as YP
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC import qualified Text.Megaparsec.Char as MPC
@@ -207,6 +206,11 @@ data ChangeLogOptions = ChangeLogOptions
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion) data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
| WhereisBaseDir
| WhereisBinDir
| WhereisCacheDir
| WhereisLogsDir
| WhereisConfDir
data WhereisOptions = WhereisOptions { data WhereisOptions = WhereisOptions {
directory :: Bool directory :: Bool
@@ -332,7 +336,7 @@ com =
( Install ( Install
<$> info <$> info
(installParser <**> helper) (installParser <**> helper)
( progDesc "Install or update GHC/cabal/HLS" ( progDesc "Install or update GHC/cabal/HLS/stack"
<> footerDoc (Just $ text installToolFooter) <> footerDoc (Just $ text installToolFooter)
) )
) )
@@ -348,7 +352,7 @@ com =
"rm" "rm"
(info (info
(Rm <$> rmParser <**> helper) (Rm <$> rmParser <**> helper)
( progDesc "Remove a GHC/cabal/HLS version" ( progDesc "Remove a GHC/cabal/HLS/stack version"
<> footerDoc (Just $ text rmFooter) <> footerDoc (Just $ text rmFooter)
) )
) )
@@ -448,20 +452,20 @@ com =
installToolFooter = [s|Discussion: installToolFooter = [s|Discussion:
Installs GHC or cabal. When no command is given, installs GHC Installs GHC or cabal. When no command is given, installs GHC
with the specified version/tag. with the specified version/tag.
It is recommended to always specify a subcommand (ghc/cabal/hls).|] It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
setFooter :: String setFooter :: String
setFooter = [s|Discussion: setFooter = [s|Discussion:
Sets the currently active GHC or cabal version. When no command is given, Sets the currently active GHC or cabal version. When no command is given,
defaults to setting GHC with the specified version/tag (if no tag defaults to setting GHC with the specified version/tag (if no tag
is given, sets GHC to 'recommended' version). is given, sets GHC to 'recommended' version).
It is recommended to always specify a subcommand (ghc/cabal/hls).|] It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
rmFooter :: String rmFooter :: String
rmFooter = [s|Discussion: rmFooter = [s|Discussion:
Remove the given GHC or cabal version. When no command is given, Remove the given GHC or cabal version. When no command is given,
defaults to removing GHC with the specified version. defaults to removing GHC with the specified version.
It is recommended to always specify a subcommand (ghc/cabal/hls).|] It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
changeLogFooter :: String changeLogFooter :: String
changeLogFooter = [s|Discussion: changeLogFooter = [s|Discussion:
@@ -542,7 +546,7 @@ installParser =
( InstallHLS ( InstallHLS
<$> info <$> info
(installOpts (Just HLS) <**> helper) (installOpts (Just HLS) <**> helper)
( progDesc "Install haskell-languge-server" ( progDesc "Install haskell-language-server"
<> footerDoc (Just $ text installHLSFooter) <> footerDoc (Just $ text installHLSFooter)
) )
) )
@@ -835,7 +839,8 @@ configP = subparser
whereisP :: Parser WhereisCommand whereisP :: Parser WhereisCommand
whereisP = subparser whereisP = subparser
( command (commandGroup "Tools locations:" <>
command
"ghc" "ghc"
(WhereisTool GHC <$> info (WhereisTool GHC <$> info
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper ) ( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
@@ -870,6 +875,37 @@ whereisP = subparser
command command
"ghcup" "ghcup"
(WhereisTool GHCup <$> info ( (pure Nothing) <**> helper ) ( progDesc "Get ghcup location" )) (WhereisTool GHCup <$> info ( (pure Nothing) <**> helper ) ( progDesc "Get ghcup location" ))
) <|> subparser ( commandGroup "Directory locations:"
<>
command
"basedir"
(info (pure WhereisBaseDir <**> helper)
( progDesc "Get ghcup base directory location" )
)
<>
command
"bindir"
(info (pure WhereisBinDir <**> helper)
( progDesc "Get ghcup binary directory location" )
)
<>
command
"cachedir"
(info (pure WhereisCacheDir <**> helper)
( progDesc "Get ghcup cache directory location" )
)
<>
command
"logsdir"
(info (pure WhereisLogsDir <**> helper)
( progDesc "Get ghcup logs directory location" )
)
<>
command
"confdir"
(info (pure WhereisConfDir <**> helper)
( progDesc "Get ghcup config directory location" )
)
) )
where where
whereisGHCFooter = [s|Discussion: whereisGHCFooter = [s|Discussion:
@@ -1010,7 +1046,7 @@ ghcCompileOpts =
(option (option
str str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applied in order, uses -p1)" "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
) )
) )
<*> optional <*> optional
@@ -1099,19 +1135,18 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
tagCompleter :: Tool -> [String] -> Completer tagCompleter :: Tool -> [String] -> Completer
tagCompleter tool add = listIOCompleter $ do tagCompleter tool add = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True)
dirs'
defaultKeyBindings
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = False { lcPrintDebug = False
, colorOutter = mempty , colorOutter = mempty
, rawOutter = mempty , rawOutter = mempty
} }
let runLogger = myLoggerT loggerConfig let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True)
dirs'
defaultKeyBindings
loggerConfig
mGhcUpInfo <- runLogger . flip runReaderT appState . runE $ getDownloadsF mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
case mGhcUpInfo of case mGhcUpInfo of
VRight ghcupInfo -> do VRight ghcupInfo -> do
let allTags = filter (\t -> t /= Old) let allTags = filter (\t -> t /= Old)
@@ -1131,14 +1166,14 @@ versionCompleter criteria tool = listIOCompleter $ do
, colorOutter = mempty , colorOutter = mempty
, rawOutter = mempty , rawOutter = mempty
} }
let runLogger = myLoggerT loggerConfig let settings = Settings True False Never Curl False GHCupURL True
settings = Settings True False Never Curl False GHCupURL True
let leanAppState = LeanAppState let leanAppState = LeanAppState
settings settings
dirs' dirs'
defaultKeyBindings defaultKeyBindings
mpFreq <- runLogger . flip runReaderT leanAppState . runE $ platformRequest loggerConfig
mGhcUpInfo <- runLogger . flip runReaderT leanAppState . runE $ getDownloadsF mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
forFold mpFreq $ \pfreq -> do forFold mpFreq $ \pfreq -> do
forFold mGhcUpInfo $ \ghcupInfo -> do forFold mGhcUpInfo $ \ghcupInfo -> do
let appState = AppState let appState = AppState
@@ -1147,8 +1182,9 @@ versionCompleter criteria tool = listIOCompleter $ do
defaultKeyBindings defaultKeyBindings
ghcupInfo ghcupInfo
pfreq pfreq
loggerConfig
runEnv = runLogger . flip runReaderT appState runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria installedVersions <- runEnv $ listVersions (Just tool) criteria
return $ T.unpack . prettyVer . lVer <$> installedVersions return $ T.unpack . prettyVer . lVer <$> installedVersions
@@ -1319,7 +1355,7 @@ toSettings options = do
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
updateSettings config settings = do updateSettings config settings = do
settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config
pure $ mergeConf settings' settings pure $ mergeConf settings' settings
where where
mergeConf :: UserSettings -> Settings -> Settings mergeConf :: UserSettings -> Settings -> Settings
@@ -1367,20 +1403,18 @@ describe_result = $( LitE . StringL <$>
) )
plan_json :: String plan_json :: String
plan_json = $( LitE . StringL <$> plan_json = $( do
runIO (handleIO (\_ -> pure "") $ do (fp, c) <- runIO (handleIO (\_ -> pure ("", "")) $ do
fp <- findPlanJson (ProjectRelativeToDir ".") fp <- findPlanJson (ProjectRelativeToDir ".")
c <- B.readFile fp c <- B.readFile fp
(Just res) <- pure $ decodeStrict' @Value c (Just res) <- pure $ decodeStrict' @Value c
pure $ T.unpack $ decUTF8Safe' $ encodePretty res pure (fp, T.unpack $ decUTF8Safe' $ encodePretty res))
) when (not . null $ fp ) $ qAddDependentFile fp
) pure . LitE . StringL $ c)
formatConfig :: UserSettings -> String formatConfig :: UserSettings -> String
formatConfig settings formatConfig settings
= UTF8.toString . YP.encodePretty yamlConfig $ settings = UTF8.toString . Y.encode1Strict $ settings
where
yamlConfig = YP.setConfCompare compare YP.defConfig
main :: IO () main :: IO ()
main = do main = do
@@ -1435,18 +1469,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(settings, keybindings) <- toSettings opt (settings, keybindings) <- toSettings opt
-- logger interpreter -- logger interpreter
logfile <- flip runReaderT dirs $ initGHCupFileLogging logfile <- flip runReaderT dirs initGHCupFileLogging
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = verbose settings { lcPrintDebug = verbose settings
, colorOutter = B.hPut stderr , colorOutter = T.hPutStr stderr
, rawOutter = , rawOutter =
case optCommand of case optCommand of
Nuke -> \_ -> pure () Nuke -> \_ -> pure ()
_ -> B.appendFile logfile _ -> T.appendFile logfile
} }
let runLogger = myLoggerT loggerConfig let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () } let runLogger = flip runReaderT leanAppstate
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState)
------------------------- -------------------------
@@ -1454,7 +1490,6 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
------------------------- -------------------------
let leanAppstate = LeanAppState settings dirs keybindings
appState = do appState = do
pfreq <- ( pfreq <- (
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
@@ -1462,12 +1497,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
VRight r -> pure r VRight r -> pure r
VLeft e -> do VLeft e -> do
runLogger runLogger
($(logError) $ T.pack $ prettyShow e) (logError $ T.pack $ prettyShow e)
exitWith (ExitFailure 2) exitWith (ExitFailure 2)
ghcupInfo <- ghcupInfo <-
( runLogger ( flip runReaderT leanAppstate
. flip runReaderT leanAppstate
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError] . runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
$ liftE $ liftE
$ getDownloadsF $ getDownloadsF
@@ -1476,12 +1510,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
VRight r -> pure r VRight r -> pure r
VLeft e -> do VLeft e -> do
runLogger runLogger
($(logError) $ T.pack $ prettyShow e) (logError $ T.pack $ prettyShow e)
exitWith (ExitFailure 2) exitWith (ExitFailure 2)
let s' = AppState settings dirs keybindings ghcupInfo pfreq let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash) race_ (liftIO $ flip runReaderT s' cleanupTrash)
(threadDelay 5000000 >> runLogger ($(logWarn) $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually")) (threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
case optCommand of case optCommand of
Nuke -> pure () Nuke -> pure ()
@@ -1493,7 +1527,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Interactive -> pure () Interactive -> pure ()
#endif #endif
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates Nothing -> flip runReaderT s' checkForUpdates
Just _ -> pure () Just _ -> pure ()
-- TODO: always run for windows -- TODO: always run for windows
@@ -1501,7 +1535,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
VRight _ -> pure () VRight _ -> pure ()
VLeft e -> do VLeft e -> do
runLogger runLogger
($(logError) $ T.pack $ prettyShow e) (logError $ T.pack $ prettyShow e)
exitWith (ExitFailure 30) exitWith (ExitFailure 30)
pure s' pure s'
@@ -1526,8 +1560,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let runInstTool' appstate' mInstPlatform = let runInstTool' appstate' mInstPlatform =
runLogger flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. runResourceT . runResourceT
. runE . runE
@'[ AlreadyInstalled @'[ AlreadyInstalled
@@ -1555,8 +1588,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let let
runLeanSetGHC = runLeanSetGHC =
runLogger runLeanAppState
. runLeanAppState
. runE . runE
@'[ FileDoesNotExistError @'[ FileDoesNotExistError
, NotInstalled , NotInstalled
@@ -1566,8 +1598,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
] ]
runSetGHC = runSetGHC =
runLogger runAppState
. runAppState
. runE . runE
@'[ FileDoesNotExistError @'[ FileDoesNotExistError
, NotInstalled , NotInstalled
@@ -1578,8 +1609,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let let
runLeanSetCabal = runLeanSetCabal =
runLogger runLeanAppState
. runLeanAppState
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, TagNotFound , TagNotFound
@@ -1588,8 +1618,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
] ]
runSetCabal = runSetCabal =
runLogger runAppState
. runAppState
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, TagNotFound , TagNotFound
@@ -1599,8 +1628,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let let
runSetHLS = runSetHLS =
runLogger runAppState
. runAppState
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, TagNotFound , TagNotFound
@@ -1609,8 +1637,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
] ]
runLeanSetHLS = runLeanSetHLS =
runLogger runLeanAppState
. runLeanAppState
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, TagNotFound , TagNotFound
@@ -1618,23 +1645,21 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, NoToolVersionSet , NoToolVersionSet
] ]
let runListGHC = runLogger . runAppState let runListGHC = runAppState
let runRm = let runRm =
runLogger . runAppState . runE @'[NotInstalled] runAppState . runE @'[NotInstalled]
let runNuke s' = let runNuke s' =
runLogger . flip runReaderT s' . runE @'[NotInstalled] flip runReaderT s' . runE @'[NotInstalled]
let runDebugInfo = let runDebugInfo =
runLogger runAppState
. runAppState
. runE . runE
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] @'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
let runCompileGHC = let runCompileGHC =
runLogger runAppState
. runAppState
. runResourceT . runResourceT
. runE . runE
@'[ AlreadyInstalled @'[ AlreadyInstalled
@@ -1654,10 +1679,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let let
runLeanWhereIs = runLeanWhereIs =
runLogger
-- Don't use runLeanAppState here, which is disabled on windows. -- Don't use runLeanAppState here, which is disabled on windows.
-- This is the only command on all platforms that doesn't need full appstate. -- This is the only command on all platforms that doesn't need full appstate.
. flip runReaderT leanAppstate flip runReaderT leanAppstate
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, NoToolVersionSet , NoToolVersionSet
@@ -1666,8 +1690,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
] ]
runWhereIs = runWhereIs =
runLogger runAppState
. runAppState
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, NoToolVersionSet , NoToolVersionSet
@@ -1676,8 +1699,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
] ]
let runUpgrade = let runUpgrade =
runLogger runAppState
. runAppState
. runResourceT . runResourceT
. runE . runE
@'[ DigestError @'[ DigestError
@@ -1689,8 +1711,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
] ]
let runPrefetch = let runPrefetch =
runLogger runAppState
. runAppState
. runResourceT . runResourceT
. runE . runE
@'[ TagNotFound @'[ TagNotFound
@@ -1728,25 +1749,25 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ $(logInfo) "GHC installation successful" runLogger $ logInfo "GHC installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) $ 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 rm ghc " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err) Never -> runLogger $ (logError $ T.pack $ prettyShow err)
_ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <> _ -> 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" <> "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.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
$(logError) $ "Also check the logs in " <> T.pack logsDir logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 3 pure $ ExitFailure 3
@@ -1768,18 +1789,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ $(logInfo) "Cabal installation successful" runLogger $ logInfo "Cabal installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) $ 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 rm cabal " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
$(logError) $ "Also check the logs in " <> T.pack logsDir logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
let installHLS InstallOptions{..} = let installHLS InstallOptions{..} =
@@ -1800,12 +1821,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ $(logInfo) "HLS installation successful" runLogger $ logInfo "HLS installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) $ runLogger $ logWarn $
"HLS ver " "HLS ver "
<> prettyVer v <> 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 rm hls "
@@ -1814,8 +1835,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
$(logError) $ "Also check the logs in " <> T.pack logsDir logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
let installStack InstallOptions{..} = let installStack InstallOptions{..} =
@@ -1836,18 +1857,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ $(logInfo) "Stack installation successful" runLogger $ logInfo "Stack installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) $ 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 rm stack " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
$(logError) $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
$(logError) $ "Also check the logs in " <> T.pack logsDir logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
@@ -1861,11 +1882,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $ logInfo $
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget "GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 5 pure $ ExitFailure 5
let setCabal' SetOptions{ sToolVer } = let setCabal' SetOptions{ sToolVer } =
@@ -1879,11 +1900,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $ logInfo $
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version" "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
let setHLS' SetOptions{ sToolVer } = let setHLS' SetOptions{ sToolVer } =
@@ -1897,11 +1918,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $ logInfo $
"HLS " <> prettyVer _tvVersion <> " successfully set as default version" "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
let setStack' SetOptions{ sToolVer } = let setStack' SetOptions{ sToolVer } =
@@ -1915,11 +1936,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ $(logInfo) $ $ logInfo $
"Stack " <> prettyVer _tvVersion <> " successfully set as default version" "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
let rmGHC' RmOptions{..} = let rmGHC' RmOptions{..} =
@@ -1932,10 +1953,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 7 pure $ ExitFailure 7
let rmCabal' tv = let rmCabal' tv =
@@ -1948,10 +1969,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
let rmHLS' tv = let rmHLS' tv =
@@ -1964,10 +1985,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
let rmStack' tv = let rmStack' tv =
@@ -1980,31 +2001,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight vi -> do VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
res <- case optCommand of res <- case optCommand of
#if defined(BRICK) #if defined(BRICK)
Interactive -> do Interactive -> do
s' <- appState s' <- appState
liftIO $ brickMain s' loggerConfig >> pure ExitSuccess liftIO $ brickMain s' >> pure ExitSuccess
#endif #endif
Install (Right iopts) -> do Install (Right iopts) -> do
runLogger ($(logWarn) "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.") runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
installGHC iopts installGHC iopts
Install (Left (InstallGHC iopts)) -> installGHC iopts Install (Left (InstallGHC iopts)) -> installGHC iopts
Install (Left (InstallCabal iopts)) -> installCabal iopts Install (Left (InstallCabal iopts)) -> installCabal iopts
Install (Left (InstallHLS iopts)) -> installHLS iopts Install (Left (InstallHLS iopts)) -> installHLS iopts
Install (Left (InstallStack iopts)) -> installStack iopts Install (Left (InstallStack iopts)) -> installStack iopts
InstallCabalLegacy iopts -> do InstallCabalLegacy iopts -> do
runLogger ($(logWarn) "This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.") runLogger (logWarn "This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.")
installCabal iopts installCabal iopts
Set (Right sopts) -> do Set (Right sopts) -> do
runLogger ($(logWarn) "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.") runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
setGHC' sopts setGHC' sopts
Set (Left (SetGHC sopts)) -> setGHC' sopts Set (Left (SetGHC sopts)) -> setGHC' sopts
Set (Left (SetCabal sopts)) -> setCabal' sopts Set (Left (SetCabal sopts)) -> setCabal' sopts
@@ -2019,7 +2040,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
Rm (Right rmopts) -> do Rm (Right rmopts) -> do
runLogger ($(logWarn) "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.") runLogger (logWarn "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
rmGHC' rmopts rmGHC' rmopts
Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
@@ -2033,11 +2054,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
putStrLn $ prettyDebugInfo dinfo putStrLn $ prettyDebugInfo dinfo
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 8 pure $ ExitFailure 8
Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do Compile (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
runLogger $ $(logError) "Hadrian cross compile support is not yet implemented!" runLogger $ logError "Hadrian cross compile support is not yet implemented!"
pure $ ExitFailure 9 pure $ ExitFailure 9
Compile (CompileGHC GHCCompileOptions {..}) -> Compile (CompileGHC GHCCompileOptions {..}) ->
runCompileGHC (do runCompileGHC (do
@@ -2046,8 +2067,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls let vi = getVersionInfo targetVer GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ $(logInfo) msg lift $ logInfo msg
lift $ $(logInfo) lift $ logInfo
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
Right _ -> pure () Right _ -> pure ()
@@ -2070,32 +2091,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) )
>>= \case >>= \case
VRight (vi, tv) -> do VRight (vi, tv) -> do
runLogger $ $(logInfo) runLogger $ logInfo
"GHC successfully compiled and installed" "GHC successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
putStr (T.unpack $ tVerToText tv) putStr (T.unpack $ tVerToText tv)
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) $ 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 rm ghc " <> prettyVer v <> "' first"
pure ExitSuccess pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err Never -> runLogger $ logError $ T.pack $ prettyShow err
_ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <> _ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory " "Check the logs at " <> T.pack logsDir <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <> <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9 pure $ ExitFailure 9
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 9 pure $ ExitFailure 9
Config InitConfig -> do Config InitConfig -> do
path <- getConfigFilePath path <- getConfigFilePath
writeFile path $ formatConfig $ fromSettings settings (Just keybindings) writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
runLogger $ $(logDebug) $ "config.yaml initialized at " <> T.pack path runLogger $ logDebug $ "config.yaml initialized at " <> T.pack path
pure ExitSuccess pure ExitSuccess
Config ShowConfig -> do Config ShowConfig -> do
@@ -2105,20 +2126,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Config (SetConfig k v) -> do Config (SetConfig k v) -> do
case v of case v of
"" -> do "" -> do
runLogger $ $(logError) "Empty values are not allowed" runLogger $ logError "Empty values are not allowed"
pure $ ExitFailure 55 pure $ ExitFailure 55
_ -> do _ -> do
r <- runE @'[JSONError] $ do r <- runE @'[JSONError] $ do
settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
path <- liftIO getConfigFilePath path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings) liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
runLogger $ $(logDebug) $ T.pack $ show settings' runLogger $ logDebug $ T.pack $ show settings'
pure () pure ()
case r of case r of
VRight _ -> pure ExitSuccess VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do VLeft (V (JSONDecodeError e)) -> do
runLogger $ $(logError) $ "Error decoding config: " <> T.pack e runLogger $ logError $ "Error decoding config: " <> T.pack e
pure $ ExitFailure 65 pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65 VLeft _ -> pure $ ExitFailure 65
@@ -2134,7 +2155,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
putStr r putStr r
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30 pure $ ExitFailure 30
Whereis WhereisOptions{..} (WhereisTool tool whereVer) -> Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
@@ -2150,9 +2171,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
putStr r putStr r
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30 pure $ ExitFailure 30
Whereis _ WhereisBaseDir -> do
putStr baseDir
pure ExitSuccess
Whereis _ WhereisBinDir -> do
putStr binDir
pure ExitSuccess
Whereis _ WhereisCacheDir -> do
putStr cacheDir
pure ExitSuccess
Whereis _ WhereisLogsDir -> do
putStr logsDir
pure ExitSuccess
Whereis _ WhereisConfDir -> do
putStr confDir
pure ExitSuccess
Upgrade uOpts force' -> do Upgrade uOpts force' -> do
target <- case uOpts of target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath UpgradeInplace -> Just <$> liftIO getExecutablePath
@@ -2167,23 +2208,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
VRight (v', dls) -> do VRight (v', dls) -> do
let pretty_v = prettyVer v' let pretty_v = prettyVer v'
let vi = fromJust $ snd <$> getLatest dls GHCup let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo) $ runLogger $ logInfo $
"Successfully upgraded GHCup to version " <> pretty_v "Successfully upgraded GHCup to version " <> pretty_v
forM_ (_viPostInstall vi) $ \msg -> forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V NoUpdate) -> do VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) "No GHCup update available" runLogger $ logWarn "No GHCup update available"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 11 pure $ ExitFailure 11
ToolRequirements -> do ToolRequirements -> do
s' <- appState s' <- appState
flip runReaderT s' flip runReaderT s'
$ runLogger $ (runE
(runE
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements] @'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
$ do $ do
GHCupInfo { .. } <- lift getGHCupInfo GHCupInfo { .. } <- lift getGHCupInfo
@@ -2194,7 +2234,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight _ -> pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 12 pure $ ExitFailure 12
ChangeLog ChangeLogOptions{..} -> do ChangeLog ChangeLogOptions{..} -> do
@@ -2211,7 +2251,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
case muri of case muri of
Nothing -> do Nothing -> do
runLogger runLogger
($(logWarn) $ (logWarn $
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver' "Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
) )
pure ExitSuccess pure ExitSuccess
@@ -2234,7 +2274,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Nothing Nothing
>>= \case >>= \case
Right _ -> pure ExitSuccess Right _ -> pure ExitSuccess
Left e -> runLogger ($(logError) (T.pack $ prettyShow e)) Left e -> logError (T.pack $ prettyShow e)
>> pure (ExitFailure 13) >> pure (ExitFailure 13)
else putStrLn uri' >> pure ExitSuccess else putStrLn uri' >> pure ExitSuccess
@@ -2242,12 +2282,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
s' <- liftIO appState s' <- liftIO appState
void $ liftIO $ evaluate $ force s' void $ liftIO $ evaluate $ force s'
runNuke s' (do runNuke s' (do
lift $ $logWarn "WARNING: This will remove GHCup and all installed components from your system." lift $ logWarn "WARNING: This will remove GHCup and all installed components from your system."
lift $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time." lift $ logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
liftIO $ threadDelay 10000000 -- wait 10s liftIO $ threadDelay 10000000 -- wait 10s
lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀" lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ $logInfo "Nuking in 3...2...1" lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing (Just ListInstalled) lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
@@ -2258,15 +2298,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
) >>= \case ) >>= \case
VRight leftOverFiles VRight leftOverFiles
| null leftOverFiles -> do | null leftOverFiles -> do
runLogger $ $logInfo "Nuclear Annihilation complete!" runLogger $ logInfo "Nuclear Annihilation complete!"
pure ExitSuccess pure ExitSuccess
| otherwise -> do | otherwise -> do
runLogger $ $logError "These Files have survived Nuclear Annihilation, you may remove them manually." runLogger $ logError "These Files have survived Nuclear Annihilation, you may remove them manually."
forM_ leftOverFiles putStrLn forM_ leftOverFiles putStrLn
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
Prefetch pfCom -> Prefetch pfCom ->
runPrefetch (do runPrefetch (do
@@ -2297,7 +2337,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
VRight _ -> do VRight _ -> do
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
@@ -2308,7 +2348,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure () pure ()
fromVersion :: ( MonadLogger m fromVersion :: ( HasLog env
, MonadFail m , MonadFail m
, MonadReader env m , MonadReader env m
, HasGHCupInfo env , HasGHCupInfo env
@@ -2326,7 +2366,7 @@ fromVersion :: ( MonadLogger m
] m (GHCTargetVersion, Maybe VersionInfo) ] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion tv = fromVersion' (toSetToolVer tv) fromVersion tv = fromVersion' (toSetToolVer tv)
fromVersion' :: ( MonadLogger m fromVersion' :: ( HasLog env
, MonadFail m , MonadFail m
, MonadReader env m , MonadReader env m
, HasGHCupInfo env , HasGHCupInfo env
@@ -2572,11 +2612,10 @@ checkForUpdates :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasPlatformReq env , HasPlatformReq env
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
, MonadLogger m
) )
=> m () => m ()
checkForUpdates = do checkForUpdates = do
@@ -2587,35 +2626,35 @@ checkForUpdates = do
forM_ (getLatest dls GHCup) $ \(l, _) -> do forM_ (getLatest dls GHCup) $ \(l, _) -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver) when (l > ghc_ver)
$ $(logWarn) $ $ logWarn $
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'" "New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
forM_ (getLatest dls GHC) $ \(l, _) -> do forM_ (getLatest dls GHC) $ \(l, _) -> do
let mghc_ver = latestInstalled GHC let mghc_ver = latestInstalled GHC
forM mghc_ver $ \ghc_ver -> forM mghc_ver $ \ghc_ver ->
when (l > ghc_ver) when (l > ghc_ver)
$ $(logWarn) $ $ logWarn $
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'" "New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
forM_ (getLatest dls Cabal) $ \(l, _) -> do forM_ (getLatest dls Cabal) $ \(l, _) -> do
let mcabal_ver = latestInstalled Cabal let mcabal_ver = latestInstalled Cabal
forM mcabal_ver $ \cabal_ver -> forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver) when (l > cabal_ver)
$ $(logWarn) $ $ logWarn $
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'" "New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
forM_ (getLatest dls HLS) $ \(l, _) -> do forM_ (getLatest dls HLS) $ \(l, _) -> do
let mhls_ver = latestInstalled HLS let mhls_ver = latestInstalled HLS
forM mhls_ver $ \hls_ver -> forM mhls_ver $ \hls_ver ->
when (l > hls_ver) when (l > hls_ver)
$ $(logWarn) $ $ logWarn $
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'" "New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
forM_ (getLatest dls Stack) $ \(l, _) -> do forM_ (getLatest dls Stack) $ \(l, _) -> do
let mstack_ver = latestInstalled Stack let mstack_ver = latestInstalled Stack
forM mstack_ver $ \stack_ver -> forM mstack_ver $ \stack_ver ->
when (l > stack_ver) when (l > stack_ver)
$ $(logWarn) $ $ logWarn $
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'" "New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"

View File

@@ -8,26 +8,27 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package
type: git
location: https://github.com/Bodigrim/tar
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
source-repository-package source-repository-package
type: git type: git
location: https://github.com/bgamari/terminal-size location: https://github.com/bgamari/terminal-size
tag: 34ea816bd63f75f800eedac12c6908c6f3736036 tag: 34ea816bd63f75f800eedac12c6908c6f3736036
source-repository-package
type: git
location: https://github.com/hasufell/libarchive
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
constraints: http-io-streams -brotli constraints: http-io-streams -brotli
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-8.10.5 with-compiler: ghc-8.10.7

View File

@@ -1,15 +1,18 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0, constraints: any.Cabal ==3.2.1.0,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7, any.HsOpenSSL ==0.11.7.1,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
any.aeson ==1.5.6.0, any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast, aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8, any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only, aeson-pretty +lib-only,
any.alex ==3.2.6, any.alex ==3.2.6,
alex +small_base, alex +small_base,
any.ansi-terminal ==0.11, any.ansi-terminal ==0.11,
@@ -22,8 +25,7 @@ constraints: any.Cabal ==3.2.1.0,
async -bench, async -bench,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.auto-update ==0.1.6, any.base ==4.14.3.0,
any.base ==4.14.2.0,
any.base-compat ==0.11.2, any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2, any.base-compat-batteries ==0.11.2,
any.base-orphans ==0.8.4, any.base-orphans ==0.8.4,
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.2.1.0,
any.bifunctors ==5.5.11, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.1,
any.brick ==0.63, any.brick ==0.64,
brick -demos, brick -demos,
any.bytestring ==0.10.12.0, any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib, bz2 -cross +with-bzlib,
any.bzlib-conduit ==0.3.0.2,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1, any.casing ==0.1.4.1,
any.cereal ==0.5.8.1,
cereal -bytestring-builder,
any.chs-cabal ==0.1.1.0, any.chs-cabal ==0.1.1.0,
any.chs-deps ==0.1.0.0, any.chs-deps ==0.1.0.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.2, any.clock ==0.8.2,
clock -llvm, clock -llvm,
any.cmdargs ==0.10.21,
cmdargs +quotation -testprog,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable, comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2, any.composition-prelude ==3.0.0.2,
composition-prelude -development, composition-prelude -development,
any.concurrent-output ==1.10.12, any.concurrent-output ==1.10.12,
any.conduit ==1.3.4.1,
any.conduit-extra ==1.3.5,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.4.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.4.1, any.containers ==0.6.5.1,
any.contravariant ==1.5.4, any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
@@ -74,44 +69,32 @@ constraints: any.Cabal ==3.2.1.0,
any.cryptohash-sha256 ==0.11.102.0, any.cryptohash-sha256 ==0.11.102.0,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3, any.data-clist ==0.1.2.3,
any.data-default-class ==0.1.2.0, any.data-fix ==0.3.2,
any.data-fix ==0.3.1,
any.deepseq ==1.4.4.0, any.deepseq ==1.4.4.0,
any.digest ==0.0.1.3,
digest -bytestring-in-base,
any.directory ==1.3.6.0, any.directory ==1.3.6.0,
any.disk-free-space ==0.1.0.1, any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1, any.distributive ==0.6.2.1,
distributive +semigroups +tagged, distributive +semigroups +tagged,
any.dlist ==1.0, any.dlist ==1.0,
dlist -werror, dlist -werror,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.extra ==1.7.9,
any.fast-logger ==3.0.5,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.7, any.free ==5.1.7,
any.generic-arbitrary ==0.1.0, any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.1, any.ghc-boot-th ==8.10.7,
any.ghc-boot-th ==8.10.5,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1, any.ghc-prim ==0.6.1,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.2.0, any.hashable ==1.3.3.0,
hashable +integer-gmp -random-initial-seed, hashable +integer-gmp -random-initial-seed,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.7,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.1,
any.hpath-filepath ==0.10.4,
any.hpath-posix ==0.13.3,
any.hsc2hs ==0.68.7, any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10 || ==2.8.2, any.hspec-discover ==2.7.10 || ==2.8.3,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
@@ -128,34 +111,22 @@ constraints: any.Cabal ==3.2.1.0,
language-c -allwarnings +iecfpextension +usebytestrings, language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.2.2, any.libarchive ==3.0.2.2,
libarchive -cross -low-memory -system-libarchive, libarchive -cross -low-memory -system-libarchive,
any.libyaml ==0.1.2,
libyaml -no-unicode -system-libyaml,
any.lifted-base ==0.2.3.12,
any.lzma-static ==5.2.5.4, any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1, any.megaparsec ==9.0.1,
megaparsec -dev, megaparsec -dev,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3,
any.monad-logger ==0.3.36,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2, any.mtl ==2.2.2,
any.network ==3.1.2.2, any.network ==3.1.2.2,
network -devel, network -devel,
any.network-uri ==2.6.4.1, any.network-uri ==2.6.4.1,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.openssl-streams ==1.2.3.0, any.openssl-streams ==1.2.3.0,
any.optics ==0.4, any.optics ==0.4,
any.optics-core ==0.4, any.optics-core ==0.4,
optics-core -explicit-generic-labels, optics-core -explicit-generic-labels,
any.optics-extra ==0.4, any.optics-extra ==0.4,
any.optics-th ==0.4, any.optics-th ==0.4,
any.optics-vl ==0.2.1,
any.optparse-applicative ==0.16.1.0, any.optparse-applicative ==0.16.1.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2, any.os-release ==1.0.2,
@@ -167,8 +138,8 @@ constraints: any.Cabal ==3.2.1.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.1.0, any.primitive ==0.7.2.0,
any.process ==1.6.9.0, any.process ==1.6.13.2,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
@@ -178,7 +149,7 @@ constraints: any.Cabal ==3.2.1.0,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2, any.resourcet ==1.2.4.3,
any.rts ==1.0.1, any.rts ==1.0.1,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.2.1.0,
any.semigroupoids ==5.3.5, any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.sop-core ==0.5.0.1,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.3,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.1, any.stm ==2.5.0.1,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.2.1,
streaming-commons -use-bytestring-builder,
any.strict ==0.4.0.1, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.1.1,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1, any.tagged ==0.8.6.1,
tagged +deepseq +transformers, tagged +deepseq +transformers,
any.tar ==0.6.0.0,
any.template-haskell ==2.16.0.0, any.template-haskell ==2.16.0.0,
any.temporary ==1.3, any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1, any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.4,
any.text ==1.2.4.1, any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-zipper ==0.11, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0, any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1.2, any.th-compat ==0.1.2,
any.th-expand-syns ==0.4.8.0,
any.th-lift ==0.8.2, any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18, any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
any.th-reify-many ==0.1.9,
any.these ==1.1.1.1, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
any.time-compat ==1.9.6, any.time-compat ==1.9.6,
time-compat -old-locale, time-compat -old-locale,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3, any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.3,
unix-compat -old-time, unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0, any.unordered-containers ==0.2.14.0,
unordered-containers -debug, unordered-containers -debug,
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.2.1.0,
any.uuid-types ==1.0.5, any.uuid-types ==1.0.5,
any.vector ==0.12.3.0, any.vector ==0.12.3.0,
vector +boundschecks -internalchecks -unsafechecks -wall, vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.4,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.versions ==5.0.0, any.versions ==5.0.0,
any.vty ==5.33, any.vty ==5.33,
any.word-wrap ==0.4.1, any.word-wrap ==0.4.1,
any.word8 ==0.1.3, any.word8 ==0.1.3,
any.xor ==0.0.1.0, any.xor ==0.0.1.0,
any.yaml ==0.11.5.0,
yaml +no-examples +no-exe,
any.zip ==1.7.1,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.2.3, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5, any.zlib-bindings ==0.1.1.5
any.zstd ==0.1.2.0, index-state: hackage.haskell.org 2021-08-29T16:24:29Z
zstd +standalone
index-state: hackage.haskell.org 2021-07-27T07:59:57Z

View File

@@ -8,26 +8,27 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package
type: git
location: https://github.com/Bodigrim/tar
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
source-repository-package source-repository-package
type: git type: git
location: https://github.com/bgamari/terminal-size location: https://github.com/bgamari/terminal-size
tag: 34ea816bd63f75f800eedac12c6908c6f3736036 tag: 34ea816bd63f75f800eedac12c6908c6f3736036
source-repository-package
type: git
location: https://github.com/hasufell/libarchive
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
constraints: http-io-streams -brotli constraints: http-io-streams -brotli
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.1 with-compiler: ghc-9.0.1

View File

@@ -1,15 +1,18 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.4.0.0, constraints: any.Cabal ==3.4.0.0,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7, any.HsOpenSSL ==0.11.7.1,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
any.aeson ==1.5.6.0, any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast, aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8, any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only, aeson-pretty +lib-only,
any.alex ==3.2.6, any.alex ==3.2.6,
alex +small_base, alex +small_base,
any.ansi-terminal ==0.11, any.ansi-terminal ==0.11,
@@ -22,7 +25,6 @@ constraints: any.Cabal ==3.4.0.0,
async -bench, async -bench,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.15.0.0, any.base ==4.15.0.0,
any.base-compat ==0.11.2, any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2, any.base-compat-batteries ==0.11.2,
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.4.0.0,
any.bifunctors ==5.5.11, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.1,
any.brick ==0.63, any.brick ==0.64,
brick -demos, brick -demos,
any.bytestring ==0.10.12.1, any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib, bz2 -cross +with-bzlib,
any.bzlib-conduit ==0.3.0.2,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1, any.casing ==0.1.4.1,
any.cereal ==0.5.8.1,
cereal -bytestring-builder,
any.chs-cabal ==0.1.1.0, any.chs-cabal ==0.1.1.0,
any.chs-deps ==0.1.0.0, any.chs-deps ==0.1.0.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.2, any.clock ==0.8.2,
clock -llvm, clock -llvm,
any.cmdargs ==0.10.21,
cmdargs +quotation -testprog,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable, comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2, any.composition-prelude ==3.0.0.2,
composition-prelude -development, composition-prelude -development,
any.concurrent-output ==1.10.12, any.concurrent-output ==1.10.12,
any.conduit ==1.3.4.1,
any.conduit-extra ==1.3.5,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.4.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.4.1, any.containers ==0.6.4.1,
any.contravariant ==1.5.4, any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
@@ -74,45 +69,33 @@ constraints: any.Cabal ==3.4.0.0,
any.cryptohash-sha256 ==0.11.102.0, any.cryptohash-sha256 ==0.11.102.0,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3, any.data-clist ==0.1.2.3,
any.data-default-class ==0.1.2.0, any.data-fix ==0.3.2,
any.data-fix ==0.3.1,
any.deepseq ==1.4.5.0, any.deepseq ==1.4.5.0,
any.digest ==0.0.1.3,
digest -bytestring-in-base,
any.directory ==1.3.6.1, any.directory ==1.3.6.1,
any.disk-free-space ==0.1.0.1, any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1, any.distributive ==0.6.2.1,
distributive +semigroups +tagged, distributive +semigroups +tagged,
any.dlist ==1.0, any.dlist ==1.0,
dlist -werror, dlist -werror,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.extra ==1.7.9,
any.fast-logger ==3.0.5,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.7, any.free ==5.1.7,
any.generic-arbitrary ==0.1.0, any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.1,
any.ghc-bignum ==1.0, any.ghc-bignum ==1.0,
any.ghc-boot-th ==9.0.1, any.ghc-boot-th ==9.0.1,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0, any.ghc-prim ==0.7.0,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.2.0, any.hashable ==1.3.3.0,
hashable +integer-gmp -random-initial-seed, hashable +integer-gmp -random-initial-seed,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.7,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.1,
any.hpath-filepath ==0.10.4,
any.hpath-posix ==0.13.3,
any.hsc2hs ==0.68.7, any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10 || ==2.8.2, any.hspec-discover ==2.7.10 || ==2.8.3,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
@@ -128,34 +111,22 @@ constraints: any.Cabal ==3.4.0.0,
language-c -allwarnings +iecfpextension +usebytestrings, language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.2.2, any.libarchive ==3.0.2.2,
libarchive -cross -low-memory -system-libarchive, libarchive -cross -low-memory -system-libarchive,
any.libyaml ==0.1.2,
libyaml -no-unicode -system-libyaml,
any.lifted-base ==0.2.3.12,
any.lzma-static ==5.2.5.4, any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1, any.megaparsec ==9.0.1,
megaparsec -dev, megaparsec -dev,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3,
any.monad-logger ==0.3.36,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2, any.mtl ==2.2.2,
any.network ==3.1.2.2, any.network ==3.1.2.2,
network -devel, network -devel,
any.network-uri ==2.6.4.1, any.network-uri ==2.6.4.1,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.openssl-streams ==1.2.3.0, any.openssl-streams ==1.2.3.0,
any.optics ==0.4, any.optics ==0.4,
any.optics-core ==0.4, any.optics-core ==0.4,
optics-core -explicit-generic-labels, optics-core -explicit-generic-labels,
any.optics-extra ==0.4, any.optics-extra ==0.4,
any.optics-th ==0.4, any.optics-th ==0.4,
any.optics-vl ==0.2.1,
any.optparse-applicative ==0.16.1.0, any.optparse-applicative ==0.16.1.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2, any.os-release ==1.0.2,
@@ -167,7 +138,7 @@ constraints: any.Cabal ==3.4.0.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.1.0, any.primitive ==0.7.2.0,
any.process ==1.6.11.0, any.process ==1.6.11.0,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
@@ -178,7 +149,7 @@ constraints: any.Cabal ==3.4.0.0,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2, any.resourcet ==1.2.4.3,
any.rts ==1.0, any.rts ==1.0,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.4.0.0,
any.semigroupoids ==5.3.5, any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.sop-core ==0.5.0.1,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.3,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.0, any.stm ==2.5.0.0,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.2.1,
streaming-commons -use-bytestring-builder,
any.strict ==0.4.0.1, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.1.1,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1, any.tagged ==0.8.6.1,
tagged +deepseq +transformers, tagged +deepseq +transformers,
any.tar ==0.6.0.0,
any.template-haskell ==2.17.0.0, any.template-haskell ==2.17.0.0,
any.temporary ==1.3, any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1, any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.4,
any.text ==1.2.4.1, any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-zipper ==0.11, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0, any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1.2, any.th-compat ==0.1.2,
any.th-expand-syns ==0.4.8.0,
any.th-lift ==0.8.2, any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18, any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
any.th-reify-many ==0.1.9,
any.these ==1.1.1.1, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
any.time-compat ==1.9.6, any.time-compat ==1.9.6,
time-compat -old-locale, time-compat -old-locale,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3, any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.3,
unix-compat -old-time, unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0, any.unordered-containers ==0.2.14.0,
unordered-containers -debug, unordered-containers -debug,
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.4.0.0,
any.uuid-types ==1.0.5, any.uuid-types ==1.0.5,
any.vector ==0.12.3.0, any.vector ==0.12.3.0,
vector +boundschecks -internalchecks -unsafechecks -wall, vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.4,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.versions ==5.0.0, any.versions ==5.0.0,
any.vty ==5.33, any.vty ==5.33,
any.word-wrap ==0.4.1, any.word-wrap ==0.4.1,
any.word8 ==0.1.3, any.word8 ==0.1.3,
any.xor ==0.0.1.0, any.xor ==0.0.1.0,
any.yaml ==0.11.5.0,
yaml +no-examples +no-exe,
any.zip ==1.7.1,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.2.3, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5, any.zlib-bindings ==0.1.1.5
any.zstd ==0.1.2.0, index-state: hackage.haskell.org 2021-08-29T16:24:29Z
zstd +standalone
index-state: hackage.haskell.org 2021-07-27T07:59:57Z

View File

@@ -16,7 +16,7 @@ source-repository-package
source-repository-package source-repository-package
type: git type: git
location: https://github.com/hasufell/libarchive location: https://github.com/hasufell/libarchive
tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99 tag: 8587aab78dd515928024ecd82c8f215e06db85cd
constraints: http-io-streams -brotli constraints: http-io-streams -brotli

9
data/build_mk/cross Normal file
View File

@@ -0,0 +1,9 @@
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO
ifneq "$(BuildFlavour)" ""
include mk/flavours/$(BuildFlavour).mk
endif
Stage1Only = YES

8
data/build_mk/default Normal file
View File

@@ -0,0 +1,8 @@
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES
ifneq "$(BuildFlavour)" ""
include mk/flavours/$(BuildFlavour).mk
endif

View File

@@ -72,7 +72,6 @@ toolRequirements:
'( >= 7 && < 8 )': '( >= 7 && < 8 )':
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -83,7 +82,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -96,7 +94,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -111,14 +108,15 @@ toolRequirements:
- binutils-gold - binutils-gold
- curl - curl
- gcc - gcc
- g++
- gmp-dev - gmp-dev
- ncurses-dev - libc-dev
- libffi-dev - libffi-dev
- make - make
- xz - musl-dev
- tar - ncurses-dev
- perl - perl
- tar
- xz
notes: '' notes: ''
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
@@ -2172,7 +2170,6 @@ ghcupDownloads:
3.4.0.0: 3.4.0.0:
viTags: viTags:
- Recommended - Recommended
- Latest
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
viArch: viArch:
A_64: A_64:
@@ -2221,6 +2218,50 @@ ghcupDownloads:
unknown_versioning: 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 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 dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
3.6.0.0:
viTags:
- 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: GHCup:
0.1.16.2: 0.1.16.2:
viTags: viTags:
@@ -2314,9 +2355,7 @@ ghcupDownloads:
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-120-64 unknown_versioning: *hls-120-64
1.3.0: 1.3.0:
viTags: viTags: []
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viArch: viArch:
@@ -2335,6 +2374,28 @@ ghcupDownloads:
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-130-64 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
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
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
Stack: Stack:
2.5.1: 2.5.1:
viTags: viTags:

View File

@@ -72,7 +72,6 @@ toolRequirements:
'( >= 7 && < 8 )': '( >= 7 && < 8 )':
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -83,7 +82,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -96,7 +94,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- gcc-c++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -109,7 +106,6 @@ toolRequirements:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- gcc - gcc
- g++
- gmp - gmp
- gmp-devel - gmp-devel
- make - make
@@ -125,14 +121,15 @@ toolRequirements:
- binutils-gold - binutils-gold
- curl - curl
- gcc - gcc
- g++
- gmp-dev - gmp-dev
- ncurses-dev - libc-dev
- libffi-dev - libffi-dev
- make - make
- xz - musl-dev
- tar - ncurses-dev
- perl - perl
- tar
- xz
notes: '' notes: ''
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
@@ -2234,7 +2231,6 @@ ghcupDownloads:
3.4.0.0: 3.4.0.0:
viTags: viTags:
- Recommended - Recommended
- Latest
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
viArch: viArch:
A_64: A_64:
@@ -2283,6 +2279,50 @@ ghcupDownloads:
unknown_versioning: 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 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 dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
3.6.0.0:
viTags:
- 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: GHCup:
0.1.16.2: 0.1.16.2:
viTags: viTags:
@@ -2376,9 +2416,7 @@ ghcupDownloads:
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-120-64 unknown_versioning: *hls-120-64
1.3.0: 1.3.0:
viTags: viTags: []
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
viPostInstall: *hls-post-install viPostInstall: *hls-post-install
viArch: viArch:
@@ -2397,6 +2435,28 @@ ghcupDownloads:
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-130-64 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
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
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
Stack: Stack:
2.5.1: 2.5.1:
viTags: viTags:

21
docs/RELEASING.md Normal file
View File

@@ -0,0 +1,21 @@
# RELEASING
1. Update version in `ghcup.cabal` and `boostrap-haskell` (`ghver` variable at the top of the script)
2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`.
3. Add ChangeLog entry
4. Add/fix downloads in `ghcup-<ver>.yaml` (under `data/metadata`), then verify with `ghcup-gen check -f ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f ghcup-<ver>.yaml -u 'ghc-8.10.7'`. Generally, new GHC/cabal/stack/hls versions are only added to the latest yaml file. New GHCup versions are added to all (great care must be taken here to not break the parser... e.g. ARM platforms don't parse in all older formats).
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
6. Download release artifacts and upload them `downloads.haskell.org/ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`)
7. Add ghcup release artifacts to ALL yaml files (see point 4.)
8. Upload the final `ghcup-<ver>.yaml` to `webhost.haskell.org/ghcup/data/`.
9. Update `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
10. Update the ghcup symlinks at `downloads.haskell.org/ghcup`

View File

@@ -16,15 +16,19 @@ description:
category: System category: System
build-type: Simple build-type: Simple
extra-doc-files: extra-doc-files:
CHANGELOG.md
config.yaml
ghcup-0.0.4.yaml
ghcup-0.0.5.yaml
ghcup-0.0.6.yaml
ghcup-0.0.7.yaml
HACKING.md
README.md README.md
RELEASING.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
extra-source-files:
data/build_mk/default
data/build_mk/cross
source-repository head source-repository head
type: git type: git
@@ -104,14 +108,12 @@ library
, deepseq ^>=1.4.4.0 , deepseq ^>=1.4.4.0
, directory ^>=1.3.6.0 , directory ^>=1.3.6.0
, disk-free-space ^>=0.1.0.1 , disk-free-space ^>=0.1.0.1
, extra ^>=1.7.9
, filepath ^>=1.4.2.1 , filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5 , haskus-utils-types ^>=1.5
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant >=3.0 && <3.2
, libarchive ^>=3.0.0.0 , libarchive ^>=3.0.0.0
, lzma-static ^>=5.2.5.3 , lzma-static ^>=5.2.5.3
, megaparsec >=8.0.0 && <9.1 , megaparsec >=8.0.0 && <9.1
, monad-logger ^>=0.3.31
, mtl ^>=2.2 , mtl ^>=2.2
, optics ^>=0.4 , optics ^>=0.4
, os-release ^>=1.0.0 , os-release ^>=1.0.0
@@ -134,8 +136,7 @@ library
, vector ^>=0.12 , vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml ^>=0.11.4.0 , HsYAML-aeson ^>=0.2.0.0
, zip ^>=1.7.1
, zlib ^>=0.6.2.2 , zlib ^>=0.6.2.2
if (flag(internal-downloader) && !os(windows)) if (flag(internal-downloader) && !os(windows))
@@ -199,7 +200,6 @@ executable ghcup
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant >=3.0 && <3.2
, libarchive ^>=3.0.0.0 , libarchive ^>=3.0.0.0
, megaparsec >=8.0.0 && <9.1 , megaparsec >=8.0.0 && <9.1
, monad-logger ^>=0.3.31
, mtl ^>=2.2 , mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.17 , optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1 , pretty ^>=1.1.3.1
@@ -212,7 +212,7 @@ executable ghcup
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, yaml ^>=0.11.4.0 , HsYAML-aeson ^>=0.2.0.0
if flag(internal-downloader) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
@@ -261,7 +261,6 @@ executable ghcup-gen
, ghcup , ghcup
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant >=3.0 && <3.2
, libarchive ^>=3.0.0.0 , libarchive ^>=3.0.0.0
, monad-logger ^>=0.3.31
, mtl ^>=2.2 , mtl ^>=2.2
, optics ^>=0.4 , optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.17 , optparse-applicative >=0.15.1.0 && <0.17
@@ -273,7 +272,7 @@ executable ghcup-gen
, text ^>=1.2.4.0 , text ^>=1.2.4.0
, transformers ^>=0.5 , transformers ^>=0.5
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, yaml ^>=0.11.4.0 , HsYAML-aeson ^>=0.2.0.0
test-suite ghcup-test test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0

View File

@@ -48,7 +48,6 @@ import Control.Monad
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
@@ -58,7 +57,6 @@ import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.List import Data.List
import Data.List.Extra
import Data.Maybe import Data.Maybe
import Data.String ( fromString ) import Data.String ( fromString )
import Data.Text ( Text ) import Data.Text ( Text )
@@ -67,9 +65,10 @@ import Data.Time.Format.ISO8601
import Data.Versions import Data.Versions
import GHC.IO.Exception import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH
import Language.Haskell.TH.Syntax ( Quasi(qAddDependentFile) )
import Optics import Optics
import Prelude hiding ( abs import Prelude hiding ( abs
, readFile
, writeFile , writeFile
) )
import Safe hiding ( at ) import Safe hiding ( at )
@@ -112,7 +111,7 @@ fetchToolBindist :: ( MonadFail m
, HasSettings env , HasSettings env
, HasPlatformReq env , HasPlatformReq env
, HasGHCupInfo env , HasGHCupInfo env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -140,7 +139,7 @@ fetchGHCSrc :: ( MonadFail m
, HasSettings env , HasSettings env
, HasPlatformReq env , HasPlatformReq env
, HasGHCupInfo env , HasGHCupInfo env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -177,7 +176,7 @@ installGHCBindist :: ( MonadFail m
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, HasPlatformReq env , HasPlatformReq env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -202,7 +201,7 @@ installGHCBindist :: ( MonadFail m
installGHCBindist dlinfo ver isoFilepath = do installGHCBindist dlinfo ver isoFilepath = do
let tver = mkTVer ver let tver = mkTVer ver
lift $ $(logDebug) $ "Requested to install GHC with " <> prettyVer ver lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
case isoFilepath of case isoFilepath of
-- we only care for already installed errors in regular (non-isolated) installs -- we only care for already installed errors in regular (non-isolated) installs
@@ -219,7 +218,7 @@ installGHCBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) $ "isolated installing GHC to " <> T.pack isoDir lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
@@ -233,9 +232,9 @@ installGHCBindist dlinfo ver isoFilepath = do
case catMaybes r of case catMaybes r of
[] -> pure () [] -> pure ()
_ -> do _ -> do
lift $ $(logWarn) "CC/LD environment variable is set. This will change the compiler/linker" lift $ logWarn $ "CC/LD environment variable is set. This will change the compiler/linker"
lift $ $(logWarn) "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda" <> "\n" <> "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall." <> "\n" <> "environments). If you encounter problems, unset CC and LD and reinstall."
-- | Install a packed GHC distribution. This only deals with unpacking and the GHC -- | Install a packed GHC distribution. This only deals with unpacking and the GHC
@@ -247,7 +246,7 @@ installPackedGHC :: ( MonadMask m
, HasPlatformReq env , HasPlatformReq env
, HasSettings env , HasSettings env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
@@ -305,7 +304,7 @@ installUnpackedGHC :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
, MonadMask m , MonadMask m
@@ -316,7 +315,7 @@ installUnpackedGHC :: ( MonadReader env m
-> Excepts '[ProcessError] m () -> Excepts '[ProcessError] m ()
installUnpackedGHC path inst ver = do installUnpackedGHC path inst ver = do
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
lift $ $(logInfo) "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need -- Windows bindists are relocatable and don't need
-- to run configure. -- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg. -- We also must make sure to preserve mtime to not confuse ghc-pkg.
@@ -333,7 +332,7 @@ installUnpackedGHC path inst ver = do
| otherwise | otherwise
= [] = []
lift $ $(logInfo) "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh" lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> inst) ("./configure" : ("--prefix=" <> inst)
: alpineArgs : alpineArgs
@@ -359,7 +358,7 @@ installGHCBin :: ( MonadFail m
, HasGHCupInfo env , HasGHCupInfo env
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -393,7 +392,7 @@ installCabalBindist :: ( MonadMask m
, HasPlatformReq env , HasPlatformReq env
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -417,7 +416,7 @@ installCabalBindist :: ( MonadMask m
m m
() ()
installCabalBindist dlinfo ver isoFilepath = do installCabalBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -448,7 +447,7 @@ installCabalBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
liftE $ installCabalUnpacked workdir isoDir Nothing liftE $ installCabalUnpacked workdir isoDir Nothing
Nothing -> do -- regular install Nothing -> do -- regular install
@@ -460,13 +459,13 @@ installCabalBindist dlinfo ver isoFilepath = do
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
-- | Install an unpacked cabal distribution. -- | Install an unpacked cabal distribution.
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Maybe Version -- ^ Nothing for isolated install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst mver' = do installCabalUnpacked path inst mver' = do
lift $ $(logInfo) "Installing cabal" lift $ logInfo "Installing cabal"
let cabalFile = "cabal" let cabalFile = "cabal"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
let destFileName = cabalFile let destFileName = cabalFile
@@ -491,7 +490,7 @@ installCabalBin :: ( MonadMask m
, HasGHCupInfo env , HasGHCupInfo env
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -526,7 +525,7 @@ installHLSBindist :: ( MonadMask m
, HasPlatformReq env , HasPlatformReq env
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -550,7 +549,7 @@ installHLSBindist :: ( MonadMask m
m m
() ()
installHLSBindist dlinfo ver isoFilepath = do installHLSBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) $ "Requested to install hls version " <> prettyVer ver lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -576,7 +575,7 @@ installHLSBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do Just isoDir -> do
lift $ $(logInfo) $ "isolated installing HLS to " <> T.pack isoDir lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpacked workdir isoDir Nothing liftE $ installHLSUnpacked workdir isoDir Nothing
Nothing -> do Nothing -> do
@@ -589,13 +588,13 @@ installHLSBindist dlinfo ver isoFilepath = do
-- | Install an unpacked hls distribution. -- | Install an unpacked hls distribution.
installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Maybe Version -- ^ Nothing for isolated install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked path inst mver' = do installHLSUnpacked path inst mver' = do
lift $ $(logInfo) "Installing HLS" lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
-- install haskell-language-server-<ghcver> -- install haskell-language-server-<ghcver>
@@ -645,7 +644,7 @@ installHLSBin :: ( MonadMask m
, HasGHCupInfo env , HasGHCupInfo env
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -682,7 +681,7 @@ installStackBin :: ( MonadMask m
, HasSettings env , HasSettings env
, HasPlatformReq env , HasPlatformReq env
, HasGHCupInfo env , HasGHCupInfo env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -717,7 +716,7 @@ installStackBindist :: ( MonadMask m
, HasPlatformReq env , HasPlatformReq env
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadLogger m , HasLog env
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
@@ -741,7 +740,7 @@ installStackBindist :: ( MonadMask m
m m
() ()
installStackBindist dlinfo ver isoFilepath = do installStackBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) $ "Requested to install stack version " <> prettyVer ver lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -766,7 +765,7 @@ installStackBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) $ "isolated installing Stack to " <> T.pack isoDir lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
liftE $ installStackUnpacked workdir isoDir Nothing liftE $ installStackUnpacked workdir isoDir Nothing
Nothing -> do -- regular install Nothing -> do -- regular install
liftE $ installStackUnpacked workdir binDir (Just ver) liftE $ installStackUnpacked workdir binDir (Just ver)
@@ -778,13 +777,13 @@ installStackBindist dlinfo ver isoFilepath = do
-- | Install an unpacked stack distribution. -- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated installs -> Maybe Version -- ^ Nothing for isolated installs
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked path inst mver' = do installStackUnpacked path inst mver' = do
lift $ $(logInfo) "Installing stack" lift $ logInfo "Installing stack"
let stackFile = "stack" let stackFile = "stack"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
let destFileName = stackFile let destFileName = stackFile
@@ -817,7 +816,7 @@ installStackUnpacked path inst mver' = do
-- for 'SetGHCOnly' constructor. -- for 'SetGHCOnly' constructor.
setGHC :: ( MonadReader env m setGHC :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
@@ -851,7 +850,7 @@ setGHC ver sghc = do
SetGHCOnly -> pure $ Just file SetGHCOnly -> pure $ Just file
SetGHC_XY -> do SetGHC_XY -> do
handle handle
(\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing) (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
$ do $ do
(mj, mi) <- getMajorMinorV (_tvVersion ver) (mj, mi) <- getMajorMinorV (_tvVersion ver)
let major' = intToText mj <> "." <> intToText mi let major' = intToText mj <> "." <> intToText mi
@@ -869,6 +868,8 @@ setGHC ver sghc = do
-- create symlink for share dir -- create symlink for share dir
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
pure ver pure ver
where where
@@ -876,7 +877,7 @@ setGHC ver sghc = do
symlinkShareDir :: ( MonadReader env m symlinkShareDir :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadLogger m , HasLog env
, MonadCatch m , MonadCatch m
, MonadMask m , MonadMask m
) )
@@ -893,9 +894,9 @@ setGHC ver sghc = do
whenM (liftIO $ doesDirectoryExist fullsharedir) $ do whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
let fullF = destdir </> sharedir let fullF = destdir </> sharedir
let targetF = "." </> "ghc" </> ver' </> sharedir let targetF = "." </> "ghc" </> ver' </> sharedir
$(logDebug) $ "rm -f " <> T.pack fullF logDebug $ "rm -f " <> T.pack fullF
hideError doesNotExistErrorType $ rmDirectoryLink fullF hideError doesNotExistErrorType $ rmDirectoryLink fullF
$(logDebug) $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
liftIO liftIO
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
-- On windows we need to be more permissive -- On windows we need to be more permissive
@@ -913,7 +914,7 @@ setGHC ver sghc = do
setCabal :: ( MonadMask m setCabal :: ( MonadMask m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
@@ -945,7 +946,7 @@ setCabal ver = do
setHLS :: ( MonadCatch m setHLS :: ( MonadCatch m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
@@ -961,7 +962,7 @@ setHLS ver = do
-- selected version, so we could end up with stray or incorrect symlinks. -- selected version, so we could end up with stray or incorrect symlinks.
oldSyms <- lift hlsSymlinks oldSyms <- lift hlsSymlinks
forM_ oldSyms $ \f -> do forM_ oldSyms $ \f -> do
lift $ $(logDebug) $ "rm " <> T.pack (binDir </> f) lift $ logDebug $ "rm " <> T.pack (binDir </> f)
lift $ rmLink (binDir </> f) lift $ rmLink (binDir </> f)
-- set haskell-language-server-<ghcver> symlinks -- set haskell-language-server-<ghcver> symlinks
@@ -979,6 +980,8 @@ setHLS ver = do
lift $ createLink destL wrapper lift $ createLink destL wrapper
lift warnAboutHlsCompatibility
pure () pure ()
@@ -986,7 +989,7 @@ setHLS ver = do
setStack :: ( MonadMask m setStack :: ( MonadMask m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
@@ -1011,6 +1014,31 @@ setStack ver = do
pure () pure ()
-- | Warn if the installed and set HLS is not compatible with the installed and
-- set GHC version.
warnAboutHlsCompatibility :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadCatch m
, MonadIO m
)
=> m ()
warnAboutHlsCompatibility = do
supportedGHC <- hlsGHCVersions
currentGHC <- fmap _tvVersion <$> ghcSet Nothing
currentHLS <- hlsSet
case (currentGHC, currentHLS) of
(Just gv, Just hv) | gv `notElem` supportedGHC -> do
logWarn $
"GHC " <> T.pack (prettyShow gv) <> " is not compatible with " <>
"Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
"Haskell IDE support may not work until this is fixed." <> "\n" <>
"Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
T.pack (prettyShow supportedGHC)
_ -> return ()
------------------ ------------------
--[ List tools ]-- --[ List tools ]--
@@ -1049,9 +1077,9 @@ availableToolVersions av tool = view
-- | List all versions from the download info, as well as stray -- | List all versions from the download info, as well as stray
-- versions. -- versions.
listVersions :: ( MonadCatch m listVersions :: ( MonadCatch m
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
@@ -1107,7 +1135,7 @@ listVersions lt' criteria = do
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
) )
=> Map.Map Version VersionInfo => Map.Map Version VersionInfo
@@ -1147,7 +1175,7 @@ listVersions lt' criteria = do
, .. , ..
} }
Left e -> do Left e -> do
$(logWarn) logWarn
$ "Could not parse version of stray directory" <> T.pack e $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
@@ -1155,7 +1183,7 @@ listVersions lt' criteria = do
, HasDirs env , HasDirs env
, MonadCatch m , MonadCatch m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
) )
=> Map.Map Version VersionInfo => Map.Map Version VersionInfo
@@ -1182,7 +1210,7 @@ listVersions lt' criteria = do
, .. , ..
} }
Left e -> do Left e -> do
$(logWarn) logWarn
$ "Could not parse version of stray directory" <> T.pack e $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
@@ -1190,7 +1218,7 @@ listVersions lt' criteria = do
, HasDirs env , HasDirs env
, MonadCatch m , MonadCatch m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m) , MonadIO m)
=> Map.Map Version VersionInfo => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
@@ -1216,7 +1244,7 @@ listVersions lt' criteria = do
, .. , ..
} }
Left e -> do Left e -> do
$(logWarn) logWarn
$ "Could not parse version of stray directory" <> T.pack e $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
@@ -1224,7 +1252,7 @@ listVersions lt' criteria = do
, HasDirs env , HasDirs env
, MonadCatch m , MonadCatch m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
) )
=> Map.Map Version VersionInfo => Map.Map Version VersionInfo
@@ -1251,7 +1279,7 @@ listVersions lt' criteria = do
, .. , ..
} }
Left e -> do Left e -> do
$(logWarn) logWarn
$ "Could not parse version of stray directory" <> T.pack e $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
@@ -1276,7 +1304,7 @@ listVersions lt' criteria = do
} }
-- NOTE: this are not cross ones, because no bindists -- NOTE: this are not cross ones, because no bindists
toListResult :: ( MonadLogger m toListResult :: ( HasLog env
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, HasGHCupInfo env , HasGHCupInfo env
@@ -1378,7 +1406,7 @@ listVersions lt' criteria = do
rmGHCVer :: ( MonadReader env m rmGHCVer :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
, MonadCatch m , MonadCatch m
@@ -1395,23 +1423,23 @@ rmGHCVer ver = do
-- this isn't atomic, order matters -- this isn't atomic, order matters
when isSetGHC $ do when isSetGHC $ do
lift $ $(logInfo) "Removing ghc symlinks" lift $ logInfo "Removing ghc symlinks"
liftE $ rmPlain (_tvTarget ver) liftE $ rmPlain (_tvTarget ver)
lift $ $(logInfo) "Removing ghc-x.y.z symlinks" lift $ logInfo "Removing ghc-x.y.z symlinks"
liftE $ rmMinorSymlinks ver liftE $ rmMinorSymlinks ver
lift $ $(logInfo) "Removing/rewiring ghc-x.y symlinks" lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
-- first remove -- first remove
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
-- then fix them (e.g. with an earlier version) -- then fix them (e.g. with an earlier version)
lift $ $(logInfo) $ "Removing directory recursively: " <> T.pack dir lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
lift $ recyclePathForcibly dir lift $ recyclePathForcibly dir
v' <- v' <-
handle handle
(\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing) (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
$ fmap Just $ fmap Just
$ getMajorMinorV (_tvVersion ver) $ getMajorMinorV (_tvVersion ver)
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver)) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
@@ -1428,7 +1456,7 @@ rmCabalVer :: ( MonadMask m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
, MonadCatch m , MonadCatch m
@@ -1459,7 +1487,7 @@ rmHLSVer :: ( MonadMask m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
, MonadCatch m , MonadCatch m
@@ -1482,7 +1510,7 @@ rmHLSVer ver = do
oldSyms <- lift hlsSymlinks oldSyms <- lift hlsSymlinks
forM_ oldSyms $ \f -> do forM_ oldSyms $ \f -> do
let fullF = binDir </> f let fullF = binDir </> f
lift $ $(logDebug) $ "rm " <> T.pack fullF lift $ logDebug $ "rm " <> T.pack fullF
lift $ rmLink fullF lift $ rmLink fullF
-- set latest hls -- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs hlsVers <- lift $ fmap rights getInstalledHLSs
@@ -1497,7 +1525,7 @@ rmStackVer :: ( MonadMask m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
, MonadCatch m , MonadCatch m
@@ -1527,7 +1555,7 @@ rmGhcup :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadMask m , MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
) )
@@ -1552,7 +1580,7 @@ rmGhcup = do
let areEqualPaths = equalFilePath p1 p2 let areEqualPaths = equalFilePath p1 p2
unless areEqualPaths $ $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
-- since it doesn't seem possible to delete a running exe on windows -- since it doesn't seem possible to delete a running exe on windows
@@ -1568,7 +1596,7 @@ rmGhcup = do
where where
handlePathNotPresent fp _err = do handlePathNotPresent fp _err = do
$logDebug $ "Error: The path does not exist, " <> T.pack fp logDebug $ "Error: The path does not exist, " <> T.pack fp
pure fp pure fp
nonStandardInstallLocationMsg path = T.pack $ nonStandardInstallLocationMsg path = T.pack $
@@ -1578,7 +1606,7 @@ rmGhcup = do
rmTool :: ( MonadReader env m rmTool :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
, MonadUnliftIO m) , MonadUnliftIO m)
@@ -1598,7 +1626,7 @@ rmTool ListResult {lVer, lTool, lCross} = do
rmGhcupDirs :: ( MonadReader env m rmGhcupDirs :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadLogger m , HasLog env
, MonadCatch m , MonadCatch m
, MonadMask m ) , MonadMask m )
=> m [FilePath] => m [FilePath]
@@ -1625,7 +1653,7 @@ rmGhcupDirs = do
handleRm $ rmBinDir binDir handleRm $ rmBinDir binDir
handleRm $ rmDir recycleDir handleRm $ rmDir recycleDir
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
$logInfo $ "removing " <> T.pack (baseDir </> "msys64") logInfo $ "removing " <> T.pack (baseDir </> "msys64")
handleRm $ rmPathForcibly (baseDir </> "msys64") handleRm $ rmPathForcibly (baseDir </> "msys64")
#endif #endif
@@ -1636,27 +1664,27 @@ rmGhcupDirs = do
hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
where where
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m () handleRm :: (MonadReader env m, MonadCatch m, HasLog env, MonadIO m) => m () -> m ()
handleRm = handleIO (\e -> $logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n" handleRm = handleIO (\e -> logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
<> "continuing regardless...") <> "continuing regardless...")
rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmEnvFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmEnvFile enFilePath = do rmEnvFile enFilePath = do
$logInfo "Removing Ghcup Environment File" logInfo "Removing Ghcup Environment File"
hideErrorDef [permissionErrorType] () $ deleteFile enFilePath hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmConfFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmConfFile confFilePath = do rmConfFile confFilePath = do
$logInfo "removing Ghcup Config File" logInfo "removing Ghcup Config File"
hideErrorDef [permissionErrorType] () $ deleteFile confFilePath hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmDir :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmDir dir = rmDir dir =
-- 'getDirectoryContentsRecursive' is lazy IO. In case -- 'getDirectoryContentsRecursive' is lazy IO. In case
-- an error leaks through, we catch it here as well, -- an error leaks through, we catch it here as well,
-- althought 'deleteFile' should already handle it. -- althought 'deleteFile' should already handle it.
hideErrorDef [doesNotExistErrorType] () $ do hideErrorDef [doesNotExistErrorType] () $ do
$logInfo $ "removing " <> T.pack dir logInfo $ "removing " <> T.pack dir
contents <- liftIO $ getDirectoryContentsRecursive dir contents <- liftIO $ getDirectoryContentsRecursive dir
forM_ contents (deleteFile . (dir </>)) forM_ contents (deleteFile . (dir </>))
@@ -1729,7 +1757,7 @@ getDebugInfo :: ( Alternative m
, MonadFail m , MonadFail m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadCatch m , MonadCatch m
, MonadIO m , MonadIO m
) )
@@ -1765,7 +1793,7 @@ compileGHC :: ( MonadMask m
, HasSettings env , HasSettings env
, MonadThrow m , MonadThrow m
, MonadResource m , MonadResource m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
@@ -1805,7 +1833,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(workdir, tmpUnpack, tver) <- case targetGhc of (workdir, tmpUnpack, tver) <- case targetGhc of
-- unpack from version tarball -- unpack from version tarball
Left tver -> do Left tver -> do
lift $ $(logDebug) $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
-- download source tarball -- download source tarball
dlInfo <- dlInfo <-
@@ -1830,7 +1858,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
lift $ $(logInfo) $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)" lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ] lEM $ git [ "init" ]
lEM $ git [ "remote" lEM $ git [ "remote"
, "add" , "add"
@@ -1857,7 +1885,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr)) ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
lift $ $(logInfo) $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver) pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
-- the version that's installed may differ from the -- the version that's installed may differ from the
@@ -1869,10 +1897,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
when alreadyInstalled $ do when alreadyInstalled $ do
case isolateDir of case isolateDir of
Just isoDir -> Just isoDir ->
lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
Nothing -> Nothing ->
lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version." lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
lift $ $(logWarn) lift $ logWarn
"...waiting for 10 seconds before continuing, you can still abort..." "...waiting for 10 seconds before continuing, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene liftIO $ threadDelay 10000000 -- give the user a sec to intervene
@@ -1899,7 +1927,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
Nothing -> Nothing ->
-- only remove old ghc in regular installs -- only remove old ghc in regular installs
when alreadyInstalled $ do when alreadyInstalled $ do
lift $ $(logInfo) "Deleting existing installation" lift $ logInfo "Deleting existing installation"
liftE $ rmGHCVer tver liftE $ rmGHCVer tver
_ -> pure () _ -> pure ()
@@ -1924,26 +1952,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
pure tver pure tver
where where
defaultConf = case targetGhc of defaultConf =
Left (GHCTargetVersion (Just _) _) -> [s| let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
V=0 default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
BUILD_MAN = NO in case targetGhc of
BUILD_SPHINX_HTML = NO Left (GHCTargetVersion (Just _) _) -> cross_mk
BUILD_SPHINX_PDF = NO _ -> default_mk
HADDOCK_DOCS = NO
ifneq "$(BuildFlavour)" ""
include mk/flavours/$(BuildFlavour).mk
endif
Stage1Only = YES|]
_ -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES
ifneq "$(BuildFlavour)" ""
include mk/flavours/$(BuildFlavour).mk
endif|]
compileHadrianBindist :: ( MonadReader env m compileHadrianBindist :: ( MonadReader env m
, HasDirs env , HasDirs env
@@ -1951,7 +1965,7 @@ endif|]
, HasPlatformReq env , HasPlatformReq env
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
@@ -1974,7 +1988,7 @@ endif|]
liftE $ configureBindist bghc tver workdir ghcdir liftE $ configureBindist bghc tver workdir ghcdir
lift $ $(logInfo) "Building (this may take a while)..." lift $ logInfo "Building (this may take a while)..."
hadrian_build <- liftE $ findHadrianFile workdir hadrian_build <- liftE $ findHadrianFile workdir
lEM $ execLogged hadrian_build lEM $ execLogged hadrian_build
( maybe [] (\j -> ["-j" <> show j] ) jobs ( maybe [] (\j -> ["-j" <> show j] ) jobs
@@ -2013,7 +2027,7 @@ endif|]
, HasPlatformReq env , HasPlatformReq env
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
@@ -2044,15 +2058,15 @@ endif|]
liftE $ checkBuildConfig (build_mk workdir) liftE $ checkBuildConfig (build_mk workdir)
lift $ $(logInfo) "Building (this may take a while)..." lift $ logInfo "Building (this may take a while)..."
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir) lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
if | isCross tver -> do if | isCross tver -> do
lift $ $(logInfo) "Installing cross toolchain..." lift $ logInfo "Installing cross toolchain..."
lEM $ make ["install"] (Just workdir) lEM $ make ["install"] (Just workdir)
pure Nothing pure Nothing
| otherwise -> do | otherwise -> do
lift $ $(logInfo) "Creating bindist..." lift $ logInfo "Creating bindist..."
lEM $ make ["binary-dist"] (Just workdir) lEM $ make ["binary-dist"] (Just workdir)
[tar] <- liftIO $ findFiles [tar] <- liftIO $ findFiles
workdir workdir
@@ -2071,7 +2085,7 @@ endif|]
, MonadIO m , MonadIO m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
) )
=> GHCTargetVersion => GHCTargetVersion
-> FilePath -- ^ tar file -> FilePath -- ^ tar file
@@ -2106,10 +2120,10 @@ endif|]
let tarPath = cacheDir </> tarName let tarPath = cacheDir </> tarName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
tarPath tarPath
lift $ $(logInfo) $ "Copied bindist to " <> T.pack tarPath lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
pure tarPath pure tarPath
checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m) checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
=> FilePath => FilePath
-> Excepts -> Excepts
'[FileDoesNotExistError, InvalidBuildConfig] '[FileDoesNotExistError, InvalidBuildConfig]
@@ -2132,7 +2146,7 @@ endif|]
forM_ buildFlavour $ \bf -> forM_ buildFlavour $ \bf ->
when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do
lift $ $(logWarn) $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..." lift $ logWarn $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
liftIO $ threadDelay 5000000 liftIO $ threadDelay 5000000
addBuildFlavourToConf bc = case buildFlavour of addBuildFlavourToConf bc = case buildFlavour of
@@ -2149,7 +2163,7 @@ endif|]
, HasPlatformReq env , HasPlatformReq env
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
@@ -2168,7 +2182,7 @@ endif|]
m m
() ()
configureBindist bghc tver workdir ghcdir = do configureBindist bghc tver workdir ghcdir = do
lift $ $(logInfo) [s|configuring build|] lift $ logInfo [s|configuring build|]
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir) forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
@@ -2232,7 +2246,7 @@ upgradeGHCup :: ( MonadMask m
, HasGHCupInfo env , HasGHCupInfo env
, HasSettings env , HasSettings env
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -2254,7 +2268,7 @@ upgradeGHCup mtarget force' = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ $(logInfo) "Upgrading GHCup..." lift $ logInfo "Upgrading GHCup..."
let latestVer = fromJust $ fst <$> getLatest dls GHCup let latestVer = fromJust $ fst <$> getLatest dls GHCup
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -2263,20 +2277,20 @@ upgradeGHCup mtarget force' = do
p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
let destDir = takeDirectory destFile let destDir = takeDirectory destFile
destFile = fromMaybe (binDir </> fn) mtarget destFile = fromMaybe (binDir </> fn) mtarget
lift $ $(logDebug) $ "mkdir -p " <> T.pack destDir lift $ logDebug $ "mkdir -p " <> T.pack destDir
liftIO $ createDirRecursive' destDir liftIO $ createDirRecursive' destDir
lift $ $(logDebug) $ "rm -f " <> T.pack destFile lift $ logDebug $ "rm -f " <> T.pack destFile
lift $ hideError NoSuchThing $ recycleFile destFile lift $ hideError NoSuchThing $ recycleFile destFile
lift $ $(logDebug) $ "cp " <> T.pack p <> " " <> T.pack destFile lift $ logDebug $ "cp " <> T.pack p <> " " <> T.pack destFile
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
destFile destFile
lift $ chmod_755 destFile lift $ chmod_755 destFile
liftIO (isInPath destFile) >>= \b -> unless b $ liftIO (isInPath destFile) >>= \b -> unless b $
lift $ $(logWarn) $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup." lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
liftIO (isShadowed destFile) >>= \case liftIO (isShadowed destFile) >>= \case
Nothing -> pure () Nothing -> pure ()
Just pa -> lift $ $(logWarn) $ "ghcup is shadowed by " Just pa -> lift $ logWarn $ "ghcup is shadowed by "
<> T.pack pa <> T.pack pa
<> ". The upgrade will not be in effect, unless you remove " <> ". The upgrade will not be in effect, unless you remove "
<> T.pack pa <> T.pack pa
@@ -2300,7 +2314,7 @@ upgradeGHCup mtarget force' = do
-- both installing from source and bindist. -- both installing from source and bindist.
postGHCInstall :: ( MonadReader env m postGHCInstall :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
@@ -2316,7 +2330,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
-- Create ghc-x.y symlinks. This may not be the current -- Create ghc-x.y symlinks. This may not be the current
-- version, create it regardless. -- version, create it regardless.
v' <- v' <-
handle (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing) handle (\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
$ fmap Just $ fmap Just
$ getMajorMinorV _tvVersion $ getMajorMinorV _tvVersion
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
@@ -2332,7 +2346,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
-- * for ghcup, this reports the location of the currently running executable -- * for ghcup, this reports the location of the currently running executable
whereIsTool :: ( MonadReader env m whereIsTool :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m

View File

@@ -1,10 +1,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
@@ -34,8 +31,8 @@ import GHCup.Download.Utils
#endif #endif
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
@@ -47,7 +44,6 @@ import Control.Monad
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
@@ -57,8 +53,8 @@ import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( mk ) import Data.CaseInsensitive ( mk )
#endif #endif
import Data.List.Extra
import Data.Maybe import Data.Maybe
import Data.List
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Data.Versions import Data.Versions
@@ -72,6 +68,7 @@ import Prelude hiding ( abs
, readFile , readFile
, writeFile , writeFile
) )
import Safe
import System.Directory import System.Directory
import System.Environment import System.Environment
import System.Exit import System.Exit
@@ -89,7 +86,7 @@ import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y import qualified Data.YAML.Aeson as Y
@@ -111,7 +108,7 @@ getDownloadsF :: ( FromJSONKey Tool
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
@@ -164,21 +161,21 @@ getBase :: ( MonadReader env m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
, MonadCatch m , MonadCatch m
, MonadLogger m , HasLog env
, MonadMask m , MonadMask m
) )
=> URI => URI
-> Excepts '[JSONError] m GHCupInfo -> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
getBase uri = do getBase uri = do
Settings { noNetwork } <- lift getSettings Settings { noNetwork, downloader } <- lift getSettings
-- try to download yaml... usually this writes it into cache dir, -- try to download yaml... usually this writes it into cache dir,
-- but in some cases not (e.g. when using file://), so we honour -- but in some cases not (e.g. when using file://), so we honour
-- the return filepath, if any -- the return filepath, if any
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
then pure Nothing then pure Nothing
else handleIO (\e -> warnCache (displayException e) >> pure Nothing) else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing) . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
. fmap Just . fmap Just
. smartDl . smartDl
@@ -186,28 +183,37 @@ getBase uri = do
-- if we didn't get a filepath from the download, use the cached yaml -- if we didn't get a filepath from the download, use the cached yaml
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
lift $ $(logDebug) $ "Decoding yaml at: " <> T.pack actualYaml yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE liftE
. onE_ (onError actualYaml) . onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] JSONDecodeError . lE' @_ @_ @'[JSONError] JSONDecodeError
. fmap (first (\e -> unlines [displayException e . first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
,"Consider removing " <> actualYaml <> " manually."])) . Y.decode1
. liftIO $ yamlContents
. Y.decodeFileEither
$ actualYaml
where where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed. -- may re-download and succeed.
onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m () onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do onError fp = do
let efp = etagsFile fp let efp = etagsFile fp
handleIO (\e -> $(logWarn) $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e)) handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
(hideError doesNotExistErrorType $ rmFile efp) (hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0)) liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
warnCache s = do
lift $ $(logWarn) "Could not get download info, trying cached version (this may not be recent!)" warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
lift $ $(logDebug) $ "Error was: " <> T.pack s warnCache s downloader' = do
let tryDownloder = case downloader' of
Curl -> "Wget"
Wget -> "Curl"
#if defined(INTERNAL_DOWNLOADER)
Internal -> "Curl"
#endif
logWarn $ "Could not get download info, trying cached version (this may not be recent!)" <> "\n" <>
"If this problem persists, consider switching downloader via: " <> "\n " <>
"ghcup config set downloader " <> tryDownloder
logDebug $ "Error was: " <> T.pack s
-- First check if the json file is in the ~/.ghcup/cache dir -- First check if the json file is in the ~/.ghcup/cache dir
-- and check it's access time. If it has been accessed within the -- and check it's access time. If it has been accessed within the
@@ -221,7 +227,7 @@ getBase uri = do
, MonadCatch m1 , MonadCatch m1
, MonadIO m1 , MonadIO m1
, MonadFail m1 , MonadFail m1
, MonadLogger m1 , HasLog env1
, MonadMask m1 , MonadMask m1
) )
=> URI => URI
@@ -312,7 +318,7 @@ download :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadMask m , MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
) )
=> URI => URI
@@ -326,7 +332,7 @@ download uri eDigest dest mfn etags
| scheme == "http" = dl | scheme == "http" = dl
| scheme == "file" = do | scheme == "file" = do
let destFile' = T.unpack . decUTF8Safe $ path let destFile' = T.unpack . decUTF8Safe $ path
lift $ $(logDebug) $ "using local file: " <> T.pack destFile' lift $ logDebug $ "using local file: " <> T.pack destFile'
forM_ eDigest (liftE . flip checkDigest destFile') forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile' pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
@@ -335,7 +341,7 @@ download uri eDigest dest mfn etags
scheme = view (uriSchemeL' % schemeBSL') uri scheme = view (uriSchemeL' % schemeBSL') uri
dl = do dl = do
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
lift $ $(logInfo) $ "downloading: " <> uri' <> " as file " <> T.pack destFile lift $ logInfo $ "downloading: " <> uri' <> " as file " <> T.pack destFile
-- destination dir must exist -- destination dir must exist
liftIO $ createDirRecursive' dest liftIO $ createDirRecursive' dest
@@ -358,7 +364,7 @@ download uri eDigest dest mfn etags
dh <- liftIO $ emptySystemTempFile "curl-header" dh <- liftIO $ emptySystemTempFile "curl-header"
flip finally (try @_ @SomeException $ rmFile dh) $ flip finally (try @_ @SomeException $ rmFile dh) $
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
metag <- readETag destFile metag <- lift $ readETag destFile
liftE $ lEM @_ @'[ProcessError] $ exec "curl" liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ (if etags then ["--dump-header", dh] else []) (o' ++ (if etags then ["--dump-header", dh] else [])
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
@@ -370,14 +376,14 @@ download uri eDigest dest mfn etags
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
Just (http':sc:_) Just (http':sc:_)
| sc == "304" | sc == "304"
, T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug "Status code was 304, not overwriting" , T.pack "HTTP" `T.isPrefixOf` http' -> lift $ logDebug "Status code was 304, not overwriting"
| T.pack "HTTP" `T.isPrefixOf` http' -> do | T.pack "HTTP" `T.isPrefixOf` http' -> do
$logDebug $ "Status code was " <> sc <> ", overwriting" lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
liftIO $ copyFile (destFile <.> "tmp") destFile liftIO $ copyFile (destFile <.> "tmp") destFile
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers) _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
:: V '[MalformedHeaders])) :: V '[MalformedHeaders]))
writeEtags destFile (parseEtags headers) lift $ writeEtags destFile (parseEtags headers)
else else
liftE $ lEM @_ @'[ProcessError] $ exec "curl" liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing (o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
@@ -387,20 +393,20 @@ download uri eDigest dest mfn etags
o' <- liftIO getWgetOpts o' <- liftIO getWgetOpts
if etags if etags
then do then do
metag <- readETag destFile metag <- lift $ readETag destFile
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri'] ++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
case _exitCode of case _exitCode of
ExitSuccess -> do ExitSuccess -> do
liftIO $ copyFile destFileTemp destFile liftIO $ copyFile destFileTemp destFile
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr)) lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
ExitFailure i' ExitFailure i'
| i' == 8 | i' == 8
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr , Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
-> do -> do
$logDebug "Not modified, skipping download" lift $ logDebug "Not modified, skipping download"
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr)) lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
| otherwise -> throwE (NonZeroExit i' "wget" opts) | otherwise -> throwE (NonZeroExit i' "wget" opts)
else do else do
let opts = o' ++ ["-O", destFileTemp , T.unpack uri'] let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
@@ -411,14 +417,14 @@ download uri eDigest dest mfn etags
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri (https, host, fullPath, port) <- liftE $ uriToQuadruple uri
if etags if etags
then do then do
metag <- readETag destFile metag <- lift $ readETag destFile
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match" let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
, E.encodeUtf8 etag)]) metag , E.encodeUtf8 etag)]) metag
liftE liftE
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag)) $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
$ do $ do
r <- downloadToFile https host fullPath port destFile addHeaders r <- downloadToFile https host fullPath port destFile addHeaders
writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag") lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
else void $ liftE $ catchE @HTTPNotModified else void $ liftE $ catchE @HTTPNotModified
@'[DownloadFailed] @'[DownloadFailed]
(\e@(HTTPNotModified _) -> (\e@(HTTPNotModified _) ->
@@ -444,33 +450,33 @@ download uri eDigest dest mfn etags
path = view pathL' uri path = view pathL' uri
uri' = decUTF8Safe (serializeURIRef' uri) uri' = decUTF8Safe (serializeURIRef' uri)
parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text) parseEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
parseEtags stderr = do parseEtags stderr = do
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
case T.words <$> mEtag of case T.words <$> mEtag of
(Just []) -> do (Just []) -> do
$logDebug "Couldn't parse etags, no input: " logDebug "Couldn't parse etags, no input: "
pure Nothing pure Nothing
(Just [_, etag']) -> do (Just [_, etag']) -> do
$logDebug $ "Parsed etag: " <> etag' logDebug $ "Parsed etag: " <> etag'
pure (Just etag') pure (Just etag')
(Just xs) -> do (Just xs) -> do
$logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs) logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
pure Nothing pure Nothing
Nothing -> do Nothing -> do
$logDebug "No etags header found" logDebug "No etags header found"
pure Nothing pure Nothing
writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m () writeEtags :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
writeEtags destFile getTags = do writeEtags destFile getTags = do
getTags >>= \case getTags >>= \case
Just t -> do Just t -> do
$logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile) logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
liftIO $ T.writeFile (etagsFile destFile) t liftIO $ T.writeFile (etagsFile destFile) t
Nothing -> Nothing ->
$logDebug "No etags files written" logDebug "No etags files written"
readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text) readETag :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
readETag fp = do readETag fp = do
e <- liftIO $ doesFileExist fp e <- liftIO $ doesFileExist fp
if e if e
@@ -478,13 +484,13 @@ download uri eDigest dest mfn etags
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp) rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
case rE of case rE of
(Right et) -> do (Right et) -> do
$logDebug $ "Read etag: " <> et logDebug $ "Read etag: " <> et
pure (Just et) pure (Just et)
(Left _) -> do (Left _) -> do
$logDebug "Etag file doesn't exist (yet)" logDebug "Etag file doesn't exist (yet)"
pure Nothing pure Nothing
else do else do
$logDebug $ "Skipping and deleting etags file because destination file " <> T.pack fp <> " doesn't exist" logDebug $ "Skipping and deleting etags file because destination file " <> T.pack fp <> " doesn't exist"
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp) liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
pure Nothing pure Nothing
@@ -497,7 +503,7 @@ downloadCached :: ( MonadReader env m
, MonadMask m , MonadMask m
, MonadResource m , MonadResource m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
@@ -518,7 +524,7 @@ downloadCached' :: ( MonadReader env m
, HasSettings env , HasSettings env
, MonadMask m , MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
@@ -552,7 +558,7 @@ checkDigest :: ( MonadReader env m
, HasSettings env , HasSettings env
, MonadIO m , MonadIO m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
) )
=> T.Text -- ^ the hash => T.Text -- ^ the hash
-> FilePath -> FilePath
@@ -562,7 +568,7 @@ checkDigest eDigest file = do
let verify = not noVerify let verify = not noVerify
when verify $ do when verify $ do
let p' = takeFileName file let p' = takeFileName file
lift $ $(logInfo) $ "verifying digest of: " <> T.pack p' lift $ logInfo $ "verifying digest of: " <> T.pack p'
c <- liftIO $ L.readFile file c <- liftIO $ L.readFile file
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)

View File

@@ -50,7 +50,7 @@ instance Pretty NoCompatiblePlatform where
pPrint (NoCompatiblePlatform str') = pPrint (NoCompatiblePlatform str') =
text ("Could not find a compatible platform. Got: " ++ str') text ("Could not find a compatible platform. Got: " ++ str')
-- | Unable to find a download for the requested versio/distro. -- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload data NoDownload = NoDownload
deriving Show deriving Show
@@ -285,31 +285,37 @@ instance Pretty HadrianNotFound where
------------------------- -------------------------
-- | A download failed. The underlying error is encapsulated. -- | A download failed. The underlying error is encapsulated.
data DownloadFailed = forall x xs . (Show x, Show (V xs), Pretty x, Pretty (V xs)) => DownloadFailed (V (x ': xs)) data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
instance Pretty DownloadFailed where instance Pretty DownloadFailed where
pPrint (DownloadFailed reason) = pPrint (DownloadFailed reason) =
text "Download failed:" <+> pPrint reason case reason of
VMaybe (_ :: DownloadFailed) -> pPrint reason
_ -> text "Download failed:" <+> pPrint reason
deriving instance Show DownloadFailed deriving instance Show DownloadFailed
-- | A build failed. -- | A build failed.
data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FilePath (V es) data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
instance Pretty BuildFailed where instance Pretty BuildFailed where
pPrint (BuildFailed path reason) = pPrint (BuildFailed path reason) =
text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason case reason of
VMaybe (_ :: BuildFailed) -> pPrint reason
_ -> text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
deriving instance Show BuildFailed deriving instance Show BuildFailed
-- | Setting the current GHC version failed. -- | Setting the current GHC version failed.
data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es) data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
instance Pretty GHCupSetError where instance Pretty GHCupSetError where
pPrint (GHCupSetError reason) = pPrint (GHCupSetError reason) =
text "Setting the current GHC version failed:" <+> pPrint reason case reason of
VMaybe (_ :: GHCupSetError) -> pPrint reason
_ -> text "Setting the current GHC version failed:" <+> pPrint reason
deriving instance Show GHCupSetError deriving instance Show GHCupSetError

View File

@@ -20,6 +20,7 @@ module GHCup.Platform where
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
@@ -28,7 +29,6 @@ import GHCup.Utils.String.QQ
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Foldable import Data.Foldable
@@ -57,7 +57,7 @@ import qualified Data.Text.IO as T
-- | Get the full platform request, consisting of architecture, distro, ... -- | Get the full platform request, consisting of architecture, distro, ...
platformRequest :: (Alternative m, MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) platformRequest :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> Excepts => Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m m
@@ -82,7 +82,7 @@ getArchitecture = case arch of
what -> Left (NoCompatibleArch what) what -> Left (NoCompatibleArch what)
getPlatform :: (Alternative m, MonadLogger m, MonadCatch m, MonadIO m, MonadFail m) getPlatform :: (Alternative m, MonadReader env m, HasLog env, MonadCatch m, MonadIO m, MonadFail m)
=> Excepts => Excepts
'[NoCompatiblePlatform, DistroNotFound] '[NoCompatiblePlatform, DistroNotFound]
m m
@@ -107,7 +107,7 @@ getPlatform = do
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing } "mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
what -> throwE $ NoCompatiblePlatform what what -> throwE $ NoCompatiblePlatform what
lift $ $(logDebug) $ "Identified Platform as: " <> T.pack (prettyShow pfr) lift $ logDebug $ "Identified Platform as: " <> T.pack (prettyShow pfr)
pure pfr pure pfr
where where
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
@@ -142,9 +142,7 @@ getLinuxDistro = do
| otherwise -> UnknownLinux | otherwise -> UnknownLinux
pure (distro, parsedVer) pure (distro, parsedVer)
where where
hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y) hasWord t = any (\x -> match (regex x) (T.unpack t))
False
matches
where where
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|]) regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])

View File

@@ -25,21 +25,17 @@ module GHCup.Types
) )
where where
import Control.Applicative
import Control.DeepSeq ( NFData, rnf ) import Control.DeepSeq ( NFData, rnf )
import Control.Monad.Logger
import Data.Map.Strict ( Map ) import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) ) import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import Haskus.Utils.Variant.Excepts
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text) import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
import URI.ByteString import URI.ByteString
#if defined(BRICK) #if defined(BRICK)
import Graphics.Vty ( Key(..) ) import Graphics.Vty ( Key(..) )
#endif #endif
import qualified Control.Monad.Trans.Class as Trans
import qualified Data.Text as T import qualified Data.Text as T
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
@@ -152,7 +148,7 @@ data Tag = Latest
| Recommended | Recommended
| Prerelease | Prerelease
| Base PVP | Base PVP
| Old -- ^ old version are hidden by default in TUI | Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -241,7 +237,7 @@ instance NFData LinuxDistro
distroToString :: LinuxDistro -> String distroToString :: LinuxDistro -> String
distroToString Debian = "debian" distroToString Debian = "debian"
distroToString Ubuntu = "ubuntu" distroToString Ubuntu = "ubuntu"
distroToString Mint= "mint" distroToString Mint = "mint"
distroToString Fedora = "fedora" distroToString Fedora = "fedora"
distroToString CentOS = "centos" distroToString CentOS = "centos"
distroToString RedHat = "redhat" distroToString RedHat = "redhat"
@@ -396,6 +392,7 @@ data AppState = AppState
, keyBindings :: KeyBindings , keyBindings :: KeyBindings
, ghcupInfo :: GHCupInfo , ghcupInfo :: GHCupInfo
, pfreq :: PlatformRequest , pfreq :: PlatformRequest
, loggerConfig :: LoggerConfig
} deriving (Show, GHC.Generic) } deriving (Show, GHC.Generic)
instance NFData AppState instance NFData AppState
@@ -404,6 +401,7 @@ data LeanAppState = LeanAppState
{ settings :: Settings { settings :: Settings
, dirs :: Dirs , dirs :: Dirs
, keyBindings :: KeyBindings , keyBindings :: KeyBindings
, loggerConfig :: LoggerConfig
} deriving (Show, GHC.Generic) } deriving (Show, GHC.Generic)
instance NFData LeanAppState instance NFData LeanAppState
@@ -555,14 +553,25 @@ instance Pretty Versioning where
instance Pretty Version where instance Pretty Version where
pPrint = text . T.unpack . prettyVer pPrint = text . T.unpack . prettyVer
instance Show (a -> b) where
show _ = "<function>"
instance (Monad m, Alternative m) => Alternative (LoggingT m) where instance Show (IO ()) where
empty = Trans.lift empty show _ = "<io>"
{-# INLINE empty #-}
m <|> n = LoggingT $ \ r -> runLoggingT m r <|> runLoggingT n r
{-# INLINE (<|>) #-}
instance MonadLogger m => MonadLogger (Excepts e m) where data LogLevel = Warn
monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d | Info
| Debug
| Error
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
}
deriving Show
instance NFData LoggerConfig where
rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug

View File

@@ -42,7 +42,7 @@ import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC import qualified Text.Megaparsec.Char as MPC
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit

View File

@@ -6,6 +6,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-| {-|
Module : GHCup.Types.Optics Module : GHCup.Types.Optics
@@ -21,9 +22,13 @@ module GHCup.Types.Optics where
import GHCup.Types import GHCup.Types
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Text ( Text )
import Optics import Optics
import URI.ByteString import URI.ByteString
import System.Console.Pretty
import qualified Data.Text as T
makePrisms ''Tool makePrisms ''Tool
makePrisms ''Architecture makePrisms ''Architecture
@@ -87,13 +92,15 @@ getLeanAppState :: ( MonadReader env m
, LabelOptic' "settings" A_Lens env Settings , LabelOptic' "settings" A_Lens env Settings
, LabelOptic' "dirs" A_Lens env Dirs , LabelOptic' "dirs" A_Lens env Dirs
, LabelOptic' "keyBindings" A_Lens env KeyBindings , LabelOptic' "keyBindings" A_Lens env KeyBindings
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
) )
=> m LeanAppState => m LeanAppState
getLeanAppState = do getLeanAppState = do
s <- gets @"settings" s <- gets @"settings"
d <- gets @"dirs" d <- gets @"dirs"
k <- gets @"keyBindings" k <- gets @"keyBindings"
pure (LeanAppState s d k) l <- gets @"loggerConfig"
pure (LeanAppState s d k l)
getSettings :: ( MonadReader env m getSettings :: ( MonadReader env m
@@ -110,6 +117,87 @@ getDirs :: ( MonadReader env m
getDirs = gets @"dirs" 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 ())
)
=> m (IO ())
getLogCleanup = gets @"logCleanup"
getKeyBindings :: ( MonadReader env m getKeyBindings :: ( MonadReader env m
, LabelOptic' "keyBindings" A_Lens env KeyBindings , LabelOptic' "keyBindings" A_Lens env KeyBindings
) )
@@ -136,6 +224,7 @@ type HasDirs env = (LabelOptic' "dirs" A_Lens env Dirs)
type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings) type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest) type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
type HasLog env = (LabelOptic' "loggerConfig" A_Lens env LoggerConfig)
getCache :: (MonadReader env m, HasSettings env) => m Bool getCache :: (MonadReader env m, HasSettings env) => m Bool

View File

@@ -40,14 +40,12 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import Codec.Archive hiding ( Directory ) import Codec.Archive hiding ( Directory )
import Codec.Archive.Zip
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
@@ -59,7 +57,6 @@ import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.Foldable import Data.Foldable
import Data.List import Data.List
import Data.List.Extra
import Data.List.NonEmpty ( NonEmpty( (:|) )) import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
@@ -115,7 +112,7 @@ ghcLinkDestination tool ver = do
rmMinorSymlinks :: ( MonadReader env m rmMinorSymlinks :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
@@ -129,14 +126,14 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
forM_ files $ \f -> do forM_ files $ \f -> do
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
let fullF = binDir </> f_xyz let fullF = binDir </> f_xyz
lift $ $(logDebug) ("rm -f " <> T.pack fullF) lift $ logDebug ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
-- | Removes the set ghc version for the given target, if any. -- | Removes the set ghc version for the given target, if any.
rmPlain :: ( MonadReader env m rmPlain :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
@@ -151,11 +148,11 @@ rmPlain target = do
files <- liftE $ ghcToolFiles tv files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do forM_ files $ \f -> do
let fullF = binDir </> f <> exeExt let fullF = binDir </> f <> exeExt
lift $ $(logDebug) ("rm -f " <> T.pack fullF) lift $ logDebug ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
-- old ghcup -- old ghcup
let hdc_file = binDir </> "haddock-ghc" <> exeExt let hdc_file = binDir </> "haddock-ghc" <> exeExt
lift $ $(logDebug) ("rm -f " <> T.pack hdc_file) lift $ logDebug ("rm -f " <> T.pack hdc_file)
lift $ hideError doesNotExistErrorType $ rmLink hdc_file lift $ hideError doesNotExistErrorType $ rmLink hdc_file
@@ -163,7 +160,7 @@ rmPlain target = do
rmMajorSymlinks :: ( MonadReader env m rmMajorSymlinks :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadLogger m , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
@@ -179,7 +176,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
forM_ files $ \f -> do forM_ files $ \f -> do
let f_xy = f <> "-" <> T.unpack v' <> exeExt let f_xy = f <> "-" <> T.unpack v' <> exeExt
let fullF = binDir </> f_xy let fullF = binDir </> f_xy
lift $ $(logDebug) "rm -f #{fullF}" lift $ logDebug ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
@@ -251,9 +248,9 @@ getInstalledGHCs = do
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@. -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
getInstalledCabals :: ( MonadLogger m getInstalledCabals :: ( MonadReader env m
, MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, MonadIO m , MonadIO m
, MonadCatch m , MonadCatch m
) )
@@ -271,14 +268,14 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed. -- | Whether the given cabal version is installed.
cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
cabalInstalled ver = do cabalInstalled ver = do
vers <- fmap rights getInstalledCabals vers <- fmap rights getInstalledCabals
pure $ elem ver vers pure $ elem ver vers
-- Return the currently set cabal version, if any. -- Return the currently set cabal version, if any.
cabalSet :: (MonadLogger m, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet = do cabalSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let cabalbin = binDir </> "cabal" <> exeExt let cabalbin = binDir </> "cabal" <> exeExt
@@ -295,7 +292,7 @@ cabalSet = do
case linkVersion =<< link of case linkVersion =<< link of
Right v -> pure $ Just v Right v -> pure $ Just v
Left err -> do Left err -> do
$(logWarn) $ "Failed to parse cabal symlink target with: " logWarn $ "Failed to parse cabal symlink target with: "
<> T.pack (displayException err) <> T.pack (displayException err)
<> ". The symlink " <> ". The symlink "
<> T.pack cabalbin <> T.pack cabalbin
@@ -366,7 +363,7 @@ getInstalledStacks = do
-- Return the currently set stack version, if any. -- Return the currently set stack version, if any.
-- TODO: there's a lot of code duplication here :> -- TODO: there's a lot of code duplication here :>
stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version) stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, HasLog env) => m (Maybe Version)
stackSet = do stackSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let stackBin = binDir </> "stack" <> exeExt let stackBin = binDir </> "stack" <> exeExt
@@ -383,7 +380,7 @@ stackSet = do
case linkVersion =<< link of case linkVersion =<< link of
Right v -> pure $ Just v Right v -> pure $ Just v
Left err -> do Left err -> do
$(logWarn) $ "Failed to parse stack symlink target with: " logWarn $ "Failed to parse stack symlink target with: "
<> T.pack (displayException err) <> T.pack (displayException err)
<> ". The symlink " <> ". The symlink "
<> T.pack stackBin <> T.pack stackBin
@@ -478,7 +475,7 @@ hlsGHCVersions = do
. splitOn "~" . splitOn "~"
) )
bins bins
pure . rights . concat . maybeToList $ vers pure . sortBy (flip compare) . rights . concat . maybeToList $ vers
-- | Get all server binaries for an hls version, if any. -- | Get all server binaries for an hls version, if any.
@@ -601,7 +598,7 @@ getLatestGHCFor major' minor' dls =
-- | Unpack an archive to a temporary directory and return that path. -- | Unpack an archive to a temporary directory and return that path.
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m) unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath -- ^ destination dir => FilePath -- ^ destination dir
-> FilePath -- ^ archive path -> FilePath -- ^ archive path
-> Excepts '[UnknownArchive -> Excepts '[UnknownArchive
@@ -609,7 +606,7 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
] m () ] m ()
unpackToDir dfp av = do unpackToDir dfp av = do
let fn = takeFileName av let fn = takeFileName av
lift $ $(logInfo) $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m () let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
@@ -628,12 +625,11 @@ unpackToDir dfp av = do
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (untar . BZip.decompress =<< rf av) liftE (untar . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av) | ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
| ".zip" `isSuffixOf` fn -> | ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
withArchive av (unpackInto dfp)
| otherwise -> throwE $ UnknownArchive fn | otherwise -> throwE $ UnknownArchive fn
getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m) getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath -- ^ archive path => FilePath -- ^ archive path
-> Excepts '[UnknownArchive -> Excepts '[UnknownArchive
, ArchiveResult , ArchiveResult
@@ -658,14 +654,11 @@ getArchiveFiles av = do
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (entries . BZip.decompress =<< rf av) liftE (entries . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av) | ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
| ".zip" `isSuffixOf` fn -> | ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
withArchive av $ do
entries' <- getEntries
pure $ fmap unEntrySelector $ Map.keys entries'
| otherwise -> throwE $ UnknownArchive fn | otherwise -> throwE $ UnknownArchive fn
intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
=> FilePath -- ^ unpacked tar dir => FilePath -- ^ unpacked tar dir
-> TarDir -- ^ how to descend -> TarDir -- ^ how to descend
-> Excepts '[TarDirDoesNotExist] m FilePath -> Excepts '[TarDirDoesNotExist] m FilePath
@@ -793,14 +786,19 @@ makeOut args workdir = do
-- | Try to apply patches in order. Fails with 'PatchFailed' -- | Try to apply patches in order. Fails with 'PatchFailed'
-- on first failure. -- on first failure.
applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m) applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath -- ^ dir containing patches => FilePath -- ^ dir containing patches
-> FilePath -- ^ dir to apply patches in -> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m () -> Excepts '[PatchFailed] m ()
applyPatches pdir ddir = do applyPatches pdir ddir = do
patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles
pdir
(makeRegexOpts compExtended
execBlank
([s|.+\.(patch|diff)$|] :: ByteString)
)
forM_ (sort patches) $ \patch' -> do forM_ (sort patches) $ \patch' -> do
lift $ $(logInfo) $ "Applying patch " <> T.pack patch' lift $ logInfo $ "Applying patch " <> T.pack patch'
fmap (either (const Nothing) Just) fmap (either (const Nothing) Just)
(exec (exec
"patch" "patch"
@@ -836,12 +834,14 @@ getChangeLog dls tool (Right tag) =
-- 2. the install destination, depending on whether the build failed -- 2. the install destination, depending on whether the build failed
runBuildAction :: ( Pretty (V e) runBuildAction :: ( Pretty (V e)
, Show (V e) , Show (V e)
, PopVariant BuildFailed e
, ToVariantMaybe BuildFailed e
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadIO m , MonadIO m
, MonadMask m , MonadMask m
, MonadLogger m , HasLog env
, MonadUnliftIO m , MonadUnliftIO m
) )
=> FilePath -- ^ build directory (cleaned up depending on Settings) => FilePath -- ^ build directory (cleaned up depending on Settings)
@@ -869,9 +869,9 @@ runBuildAction bdir instdir action = do
-- | Remove a build directory, ignoring if it doesn't exist and gracefully -- | Remove a build directory, ignoring if it doesn't exist and gracefully
-- printing other errors without crashing. -- printing other errors without crashing.
rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m () rmBDir :: (MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
rmBDir dir = withRunInIO (\run -> run $ rmBDir dir = withRunInIO (\run -> run $
liftIO $ handleIO (\e -> run $ $(logWarn) $ liftIO $ handleIO (\e -> run $ logWarn $
"Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e)) "Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
$ hideError doesNotExistErrorType $ hideError doesNotExistErrorType
$ rmPathForcibly dir) $ rmPathForcibly dir)
@@ -984,7 +984,7 @@ rmLink = hideError doesNotExistErrorType . recycleFile
-- On windows, this requires that 'ensureGlobalTools' was run beforehand. -- On windows, this requires that 'ensureGlobalTools' was run beforehand.
createLink :: ( MonadMask m createLink :: ( MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
@@ -1006,24 +1006,24 @@ createLink link exe = do
fullLink = takeDirectory exe </> link fullLink = takeDirectory exe </> link
shimContents = "path = " <> fullLink shimContents = "path = " <> fullLink
$(logDebug) $ "rm -f " <> T.pack exe logDebug $ "rm -f " <> T.pack exe
rmLink exe rmLink exe
$(logDebug) $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
liftIO $ copyFile shimGen exe liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents liftIO $ writeFile shim shimContents
#else #else
$(logDebug) $ "rm -f " <> T.pack exe logDebug $ "rm -f " <> T.pack exe
hideError doesNotExistErrorType $ recycleFile exe hideError doesNotExistErrorType $ recycleFile exe
$(logDebug) $ "ln -s " <> T.pack link <> " " <> T.pack exe logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
liftIO $ createFileLink link exe liftIO $ createFileLink link exe
#endif #endif
ensureGlobalTools :: ( MonadMask m ensureGlobalTools :: ( MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , HasLog env
, MonadIO m , MonadIO m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
@@ -1041,8 +1041,8 @@ ensureGlobalTools = do
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _) -> do void $ (\(DigestError _ _) -> do
lift $ $(logWarn) "Digest doesn't match, redownloading gs.exe..." lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ $(logDebug) "rm -f #{shimDownload}" lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe") lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[DigestError , DownloadFailed] $ dl liftE @'[DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[DigestError , DownloadFailed] dl) ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)

View File

@@ -2,9 +2,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-| {-|
Module : GHCup.Utils.Dirs Module : GHCup.Utils.Dirs
@@ -45,7 +43,6 @@ import GHCup.Utils.Prelude
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.IO.Unlift import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource hiding (throwM) import Control.Monad.Trans.Resource hiding (throwM)
import Data.Bifunctor import Data.Bifunctor
@@ -61,7 +58,7 @@ import System.IO.Temp
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Yaml as Y import qualified Data.YAML.Aeson as Y
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
@@ -224,7 +221,7 @@ ghcupConfigFile = do
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
case contents of case contents of
Nothing -> pure defaultUserSettings Nothing -> pure defaultUserSettings
Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents' Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
------------------------- -------------------------
@@ -261,7 +258,7 @@ parseGHCupGHCDir (T.pack -> fp) =
mkGhcupTmpDir :: ( MonadReader env m mkGhcupTmpDir :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadUnliftIO m , MonadUnliftIO m
, MonadLogger m , HasLog env
, MonadCatch m , MonadCatch m
, MonadThrow m , MonadThrow m
, MonadMask m , MonadMask m
@@ -273,14 +270,14 @@ mkGhcupTmpDir = do
let minSpace = 5000 -- a rough guess, aight? let minSpace = 5000 -- a rough guess, aight?
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
when (maybe False (toBytes minSpace >) space) $ do when (maybe False (toBytes minSpace >) space) $ do
$(logWarn) ("Possibly insufficient disk space on " logWarn ("Possibly insufficient disk space on "
<> T.pack tmpdir <> T.pack tmpdir
<> ". At least " <> ". At least "
<> T.pack (show minSpace) <> T.pack (show minSpace)
<> " MB are recommended, but only " <> " MB are recommended, but only "
<> toMB (fromJust space) <> toMB (fromJust space)
<> " are free. Consider freeing up disk space or setting TMPDIR env variable.") <> " are free. Consider freeing up disk space or setting TMPDIR env variable.")
$(logWarn) logWarn
"...waiting for 10 seconds before continuing anyway, you can still abort..." "...waiting for 10 seconds before continuing anyway, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene liftIO $ threadDelay 10000000 -- give the user a sec to intervene
@@ -295,8 +292,9 @@ mkGhcupTmpDir = do
withGHCupTmpDir :: ( MonadReader env m withGHCupTmpDir :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, HasSettings env
, MonadUnliftIO m , MonadUnliftIO m
, MonadLogger m
, MonadCatch m , MonadCatch m
, MonadResource m , MonadResource m
, MonadThrow m , MonadThrow m
@@ -309,7 +307,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
(run mkGhcupTmpDir) (run mkGhcupTmpDir)
(\fp -> (\fp ->
handleIO (\e -> run handleIO (\e -> run
$ $(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))) $ logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
. rmPathForcibly . rmPathForcibly
$ fp)) $ fp))
@@ -341,9 +339,10 @@ relativeSymlink p1 p2 =
cleanupTrash :: ( MonadIO m cleanupTrash :: ( MonadIO m
, MonadMask m , MonadMask m
, MonadLogger m
, MonadReader env m , MonadReader env m
, HasLog env
, HasDirs env , HasDirs env
, HasSettings env
) )
=> m () => m ()
cleanupTrash = do cleanupTrash = do
@@ -352,8 +351,8 @@ cleanupTrash = do
if null contents if null contents
then pure () then pure ()
else do else do
$(logWarn) ("Removing leftover files in " <> T.pack recycleDir) logWarn ("Removing leftover files in " <> T.pack recycleDir)
forM_ contents (\fp -> handleIO (\e -> forM_ contents (\fp -> handleIO (\e ->
$(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)) logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
) $ liftIO $ removePathForcibly (recycleDir </> fp)) ) $ liftIO $ removePathForcibly (recycleDir </> fp))

View File

@@ -7,7 +7,6 @@ module GHCup.Utils.File.Common where
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.Monad.Extra
import Control.Monad.Reader import Control.Monad.Reader
import Data.Maybe import Data.Maybe
import GHC.IO.Exception import GHC.IO.Exception
@@ -29,11 +28,11 @@ data ProcessError = NonZeroExit Int FilePath [String]
instance Pretty ProcessError where instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) = pPrint (NonZeroExit e exe args) =
text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "." text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) = pPrint (PTerminated exe args) =
text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated." text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) = pPrint (PStopped exe args) =
text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped." text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) = pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "." text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."

View File

@@ -1,8 +1,5 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-| {-|
Module : GHCup.Utils.File.Posix Module : GHCup.Utils.File.Posix
@@ -28,7 +25,6 @@ import Control.Concurrent.Async
import Control.Exception ( evaluate ) import Control.Exception ( evaluate )
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.State.Strict import Control.Monad.Trans.State.Strict
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
@@ -131,7 +127,7 @@ execLogged exe args chdir lfile env = do
pure e pure e
tee :: Fd -> Fd -> IO () tee :: Fd -> Fd -> IO ()
tee fileFd fdIn = readTilEOF lineAction fdIn tee fileFd = readTilEOF lineAction
where where
lineAction :: ByteString -> IO () lineAction :: ByteString -> IO ()
@@ -350,7 +346,7 @@ toProcessError exe args mps = case mps of
chmod_755 :: (MonadLogger m, MonadIO m) => FilePath -> m () chmod_755 :: (MonadReader env m, HasLog env, MonadIO m) => FilePath -> m ()
chmod_755 fp = do chmod_755 fp = do
let exe_mode = let exe_mode =
nullFileMode nullFileMode
@@ -361,7 +357,7 @@ chmod_755 fp = do
`unionFileModes` groupReadMode `unionFileModes` groupReadMode
`unionFileModes` otherExecuteMode `unionFileModes` otherExecuteMode
`unionFileModes` otherReadMode `unionFileModes` otherReadMode
$(logDebug) ("chmod 755 " <> T.pack fp) logDebug ("chmod 755 " <> T.pack fp)
liftIO $ setFileMode fp exe_mode liftIO $ setFileMode fp exe_mode

View File

@@ -22,11 +22,8 @@ import GHCup.Utils.String.QQ
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader import Control.Monad.Reader
import Data.Char ( ord )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Console.Pretty
import System.FilePath import System.FilePath
import System.IO.Error import System.IO.Error
import Text.Regex.Posix import Text.Regex.Posix
@@ -35,53 +32,6 @@ import qualified Data.ByteString as B
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
data LoggerConfig = LoggerConfig
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
, colorOutter :: B.ByteString -> IO () -- ^ how to write the color output
, rawOutter :: B.ByteString -> IO () -- ^ how to write the full raw output
}
myLoggerT :: LoggerConfig -> LoggingT m a -> m a
myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
where
mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
mylogger _ _ level str' = do
-- color output
let style' = case level of
LevelDebug -> style Bold . color Blue
LevelInfo -> style Bold . color Green
LevelWarn -> style Bold . color Yellow
LevelError -> style Bold . color Red
LevelOther _ -> id
let l = case level of
LevelDebug -> toLogStr (style' "[ Debug ]")
LevelInfo -> toLogStr (style' "[ Info ]")
LevelWarn -> toLogStr (style' "[ Warn ]")
LevelError -> toLogStr (style' "[ Error ]")
LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
let strs = fmap toLogStr . B.split (fromIntegral $ ord '\n') . fromLogStr $ str'
let out = case strs of
[] -> B.empty
(x:xs) -> fromLogStr
. foldr (\a b -> a <> toLogStr "\n" <> b) mempty
. ((l <> toLogStr " " <> x) :)
. fmap (\line' -> toLogStr (style' "[ ... ] ") <> line' )
$ xs
when (lcPrintDebug || (not lcPrintDebug && (level /= LevelDebug)))
$ colorOutter out
-- raw output
let lr = case level of
LevelDebug -> toLogStr "Debug:"
LevelInfo -> toLogStr "Info:"
LevelWarn -> toLogStr "Warn:"
LevelError -> toLogStr "Error:"
LevelOther t -> toLogStr t <> toLogStr ":"
let outr = fromLogStr (lr <> toLogStr " " <> str' <> toLogStr "\n")
rawOutter outr
initGHCupFileLogging :: ( MonadReader env m initGHCupFileLogging :: ( MonadReader env m
, HasDirs env , HasDirs env

View File

@@ -5,7 +5,6 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-| {-|
Module : GHCup.Utils.Prelude Module : GHCup.Utils.Prelude
@@ -30,10 +29,10 @@ import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Logger
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.List ( nub, intercalate ) import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
import Data.Maybe
import Data.Foldable import Data.Foldable
import Data.String import Data.String
import Data.Text ( Text ) import Data.Text ( Text )
@@ -75,8 +74,9 @@ import qualified System.Win32.File as Win32
-- >>> import Data.ByteString.Internal (c2w, w2c) -- >>> import Data.ByteString.Internal (c2w, w2c)
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> import Data.Word8 -- >>> import Data.Word8
-- >>> import Data.Word8
-- >>> import qualified Data.Text as T -- >>> import qualified Data.Text as T
-- >>> import qualified Data.Char as C
-- >>> import Data.List
-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary -- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
@@ -174,8 +174,12 @@ lEM' :: forall e' e es a m
lEM' f em = lift em >>= lE . first f lEM' f em = lift em >>= lE . first f
-- for some obscure reason... this won't type-check if we move it to a different module -- for some obscure reason... this won't type-check if we move it to a different module
catchWarn :: forall es m . (Pretty (V es), MonadLogger m, Monad m) => Excepts es m () -> Excepts '[] m () catchWarn :: forall es m env . ( Pretty (V es)
catchWarn = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v)) , MonadReader env m
, HasLog env
, MonadIO m
, Monad m) => Excepts es m () -> Excepts '[] m ()
catchWarn = catchAllE @_ @es (\v -> lift $ logWarn (T.pack . prettyShow $ v))
fromEither :: Either a b -> VEither '[a] b fromEither :: Either a b -> VEither '[a] b
fromEither = either (VLeft . V) VRight fromEither = either (VLeft . V) VRight
@@ -520,7 +524,7 @@ forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
forFold = \t -> (`traverseFold` t) forFold = \t -> (`traverseFold` t)
-- | Strip @\\r@ and @\\n@ from 'ByteString's -- | Strip @\\r@ and @\\n@ from 'String's
-- --
-- >>> stripNewline "foo\n\n\n" -- >>> stripNewline "foo\n\n\n"
-- "foo" -- "foo"
@@ -532,13 +536,10 @@ forFold = \t -> (`traverseFold` t)
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t -- prop> \t -> stripNewline (t <> "\n") === stripNewline t
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t -- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
stripNewline :: String -> String stripNewline :: String -> String
stripNewline s stripNewline = filter (`notElem` "\n\r")
| null s = []
| head s `elem` "\n\r" = stripNewline (tail s)
| otherwise = head s : stripNewline (tail s)
-- | Strip @\\r@ and @\\n@ from 'ByteString's -- | Strip @\\r@ and @\\n@ from 'Text's
-- --
-- >>> stripNewline' "foo\n\n\n" -- >>> stripNewline' "foo\n\n\n"
-- "foo" -- "foo"
@@ -550,10 +551,7 @@ stripNewline s
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t -- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t -- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
stripNewline' :: T.Text -> T.Text stripNewline' :: T.Text -> T.Text
stripNewline' s stripNewline' = T.filter (`notElem` "\n\r")
| T.null s = mempty
| T.head s `elem` "\n\r" = stripNewline' (T.tail s)
| otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s)
-- | Is the word8 a newline? -- | Is the word8 a newline?
@@ -587,3 +585,117 @@ splitOnPVP c s = case Split.splitOn c s of
| otherwise -> def | otherwise -> def
where where
def = (s, "") def = (s, "")
-- | Like 'find', but where the test can be monadic.
--
-- >>> findM (Just . C.isUpper) "teST"
-- Just (Just 'S')
-- >>> findM (Just . C.isUpper) "test"
-- Just Nothing
-- >>> findM (Just . const True) ["x",undefined]
-- Just (Just "x")
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
-- | Drops the given suffix from a list.
-- It returns the original sequence if the sequence doesn't end with the given suffix.
--
-- >>> dropSuffix "!" "Hello World!"
-- "Hello World"
-- >>> dropSuffix "!" "Hello World!!"
-- "Hello World!"
-- >>> dropSuffix "!" "Hello World."
-- "Hello World."
dropSuffix :: Eq a => [a] -> [a] -> [a]
dropSuffix a b = fromMaybe b $ stripSuffix a b
-- | Return the prefix of the second list if its suffix
-- matches the entire first list.
--
-- >>> stripSuffix "bar" "foobar"
-- Just "foo"
-- >>> stripSuffix "" "baz"
-- Just "baz"
-- >>> stripSuffix "foo" "quux"
-- Nothing
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b)
-- | Drops the given prefix from a list.
-- It returns the original sequence if the sequence doesn't start with the given prefix.
--
-- >>> dropPrefix "Mr. " "Mr. Men"
-- "Men"
-- >>> dropPrefix "Mr. " "Dr. Men"
-- "Dr. Men"
dropPrefix :: Eq a => [a] -> [a] -> [a]
dropPrefix a b = fromMaybe b $ stripPrefix a b
-- | Break a list into pieces separated by the first
-- list argument, consuming the delimiter. An empty delimiter is
-- invalid, and will cause an error to be raised.
--
-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
-- ["a","b","d","e"]
-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
-- ["","X","X","X",""]
-- >>> splitOn "x" "x"
-- ["",""]
-- >>> splitOn "x" ""
-- [""]
--
-- prop> \s x -> s /= "" ==> intercalate s (splitOn s x) == x
-- prop> \c x -> splitOn [c] x == split (==c) x
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn [] _ = error "splitOn, needle may not be empty"
splitOn _ [] = [[]]
splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
where (a,b) = breakOn needle haystack
-- | Splits a list into components delimited by separators,
-- where the predicate returns True for a separator element. The
-- resulting components do not contain the separators. Two adjacent
-- separators result in an empty component in the output.
--
-- >>> split (== 'a') "aabbaca"
-- ["","","bb","c",""]
-- >>> split (== 'a') ""
-- [""]
-- >>> split (== ':') "::xyz:abc::123::"
-- ["","","xyz","abc","","123","",""]
-- >>> split (== ',') "my,list,here"
-- ["my","list","here"]
split :: (a -> Bool) -> [a] -> [[a]]
split _ [] = [[]]
split f (x:xs)
| f x = [] : split f xs
| y:ys <- split f xs = (x:y) : ys
| otherwise = [[]]
-- | Find the first instance of @needle@ in @haystack@.
-- The first element of the returned tuple
-- is the prefix of @haystack@ before @needle@ is matched. The second
-- is the remainder of @haystack@, starting with the match.
-- If you want the remainder /without/ the match, use 'stripInfix'.
--
-- >>> breakOn "::" "a::b::c"
-- ("a","::b::c")
-- >>> breakOn "/" "foobar"
-- ("foobar","")
--
-- prop> \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn _ [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs

View File

@@ -44,15 +44,14 @@ import Language.Haskell.TH.Quote
-- The pattern portion is undefined. -- The pattern portion is undefined.
s :: QuasiQuoter s :: QuasiQuoter
s = QuasiQuoter s = QuasiQuoter
(\s' -> case and $ fmap isAscii s' of (\s' -> case all isAscii s' of
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s' True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
False -> fail "Not ascii" False -> fail "Not ascii"
) )
(error "Cannot use q as a pattern") (error "Cannot use s as a pattern")
(error "Cannot use q as a type") (error "Cannot use s as a type")
(error "Cannot use q as a dec") (error "Cannot use s as a dec")
where where
removeCRs = filter (/= '\r') removeCRs = filter (/= '\r')
trimLeadingNewline ('\n' : xs) = xs trimLeadingNewline ('\n' : xs) = xs
trimLeadingNewline xs = xs trimLeadingNewline xs = xs

View File

@@ -24,6 +24,9 @@ import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T import qualified Data.Text as T
-- | This reflects the API version of the YAML. -- | This reflects the API version of the YAML.
--
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI 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.7.yaml|]

View File

@@ -3,6 +3,7 @@
# Main settings: # Main settings:
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation # * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade # * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
# * BOOTSTRAP_HASKELL_MINIMAL - any nonzero value to only install ghcup
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification # * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation # * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
# * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install # * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
@@ -175,7 +176,15 @@ download_ghcup() {
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver} _url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
;; ;;
aarch64|arm64|armv8l) 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}" *) die "Unknown architecture: ${arch}"
;; ;;
@@ -292,16 +301,7 @@ ask_bashrc() {
read -r bashrc_answer </dev/tty read -r bashrc_answer </dev/tty
else else
# On windows .bashrc isn't an important user config, so we adjust it return 0
# always. On other platforms, let's be a bit more conservative.
case "${plat}" in
MSYS*|MINGW*)
return 1
;;
*)
return 0
;;
esac
fi fi
case $bashrc_answer in case $bashrc_answer in
[Pp]* | "") [Pp]* | "")
@@ -371,6 +371,13 @@ adjust_bashrc() {
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile" echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
fi fi
;; ;;
MSYS*|MINGW*)
if [ ! -e "${HOME}/.bash_profile" ] ; then
echo '# generated by ghcup' > "${HOME}/.bash_profile"
echo 'test -f ~/.profile && . ~/.profile' >> "${HOME}/.bash_profile"
echo 'test -f ~/.bashrc && . ~/.bashrc' >> "${HOME}/.bash_profile"
fi
;;
esac esac
break ;; break ;;
@@ -591,10 +598,12 @@ ask_bashrc
ask_bashrc_answer=$? ask_bashrc_answer=$?
ask_cabal_config_init ask_cabal_config_init
ask_cabal_config_init_answer=$? ask_cabal_config_init_answer=$?
ask_hls if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
ask_hls_answer=$? ask_hls
ask_stack ask_hls_answer=$?
ask_stack_answer=$? ask_stack
ask_stack_answer=$?
fi
edo mkdir -p "${GHCUP_BIN}" edo mkdir -p "${GHCUP_BIN}"
@@ -620,14 +629,30 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
read -r answer </dev/tty read -r answer </dev/tty
fi fi
eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}" eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
do_cabal_config_init $ask_cabal_config_init_answer do_cabal_config_init $ask_cabal_config_init_answer
edo cabal new-update edo cabal new-update
else # don't install ghc and cabal
case "${plat}" in
MSYS*|MINGW*)
# need to bootstrap cabal to initialize config on windows
# we'll remove it afterwards
tmp_dir="$(mktemp -d)"
eghcup --cache install cabal -i "${tmp_dir}" "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
PATH="${tmp_dir}:$PATH" do_cabal_config_init $ask_cabal_config_init_answer
rm "${tmp_dir}/cabal"
unset tmp_dir
;;
*)
;;
esac
fi
case $ask_hls_answer in case $ask_hls_answer in
1) 1)

View File

@@ -15,24 +15,26 @@
param ( param (
# Run an interactive installation # Run an interactive installation
[switch]$Interactive, [switch]$Interactive,
# Specify the install root (default: 'C:\') # Do minimal installation of ghcup and msys2 only
[string]$InstallDir, [switch]$Minimal,
# Instead of installing a new MSys2, use an existing installation
[string]$ExistingMsys2Dir,
# Specify the cabal root directory (default: '$InstallDir\cabal')
[string]$CabalDir,
# Overwrite (or rather backup) a previous install
[switch]$Overwrite,
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[string]$BootstrapUrl,
# Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell # Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
[switch]$InBash, [switch]$InBash,
# Overwrite (or rather backup) a previous install
[switch]$Overwrite,
# Skip adjusting cabal.config with mingw paths
[switch]$NoAdjustCabalConfig,
# Whether to install stack as well # Whether to install stack as well
[switch]$InstallStack, [switch]$InstallStack,
# Whether to install hls as well # Whether to install hls as well
[switch]$InstallHLS, [switch]$InstallHLS,
# Skip adjusting cabal.config with mingw paths # Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[switch]$NoAdjustCabalConfig [string]$InstallDir,
# Instead of installing a new MSys2, use an existing installation
[string]$BootstrapUrl,
# Specify the install root (default: 'C:\')
[string]$ExistingMsys2Dir,
# Specify the cabal root directory (default: '$InstallDir\cabal')
[string]$CabalDir
) )
$Silent = !$Interactive $Silent = !$Interactive
@@ -180,7 +182,7 @@ elevated command prompt:
if ($GhcupBasePrefixEnv) { if ($GhcupBasePrefixEnv) {
$defaultGhcupBasePrefix = $GhcupBasePrefixEnv $defaultGhcupBasePrefix = $GhcupBasePrefixEnv
} else { } elseif (!($InstallDir)) {
$partitions = Get-CimInstance win32_logicaldisk $partitions = Get-CimInstance win32_logicaldisk
$defaultGhcupBasePrefix = $null $defaultGhcupBasePrefix = $null
foreach ($p in $partitions){ foreach ($p in $partitions){
@@ -209,10 +211,10 @@ if ($Silent -and !($InstallDir)) {
$GhcupBasePrefix = $defaultGhcupBasePrefix $GhcupBasePrefix = $defaultGhcupBasePrefix
} elseif ($InstallDir) { } elseif ($InstallDir) {
if (!(Test-Path -LiteralPath ('{0}' -f $InstallDir) -IsValid)) { if (!(Test-Path -LiteralPath ('{0}' -f $InstallDir) -IsValid)) {
Print-Msg -color Red -msg "Not a valid directory!" Print-Msg -color Red -msg "Not a valid directory! (InstallDir)"
Exit 1 Exit 1
} elseif (!(Split-Path -IsAbsolute -Path "$InstallDir")) { } elseif (!(Split-Path -IsAbsolute -Path "$InstallDir")) {
Print-Msg -color Red -msg "Non-absolute Path specified!" Print-Msg -color Red -msg "Non-absolute Path specified! (InstallDir)"
Exit 1 Exit 1
} else { } else {
$GhcupBasePrefix = $InstallDir $GhcupBasePrefix = $InstallDir
@@ -243,7 +245,20 @@ $null = [Environment]::SetEnvironmentVariable("GHCUP_INSTALL_BASE_PREFIX", $Ghcu
$GhcupDir = ('{0}\ghcup' -f $GhcupBasePrefix) $GhcupDir = ('{0}\ghcup' -f $GhcupBasePrefix)
$MsysDir = ('{0}\msys64' -f $GhcupDir) if ($ExistingMsys2Dir) {
if (!(Test-Path -LiteralPath ('{0}' -f $ExistingMsys2Dir) -IsValid)) {
Print-Msg -color Red -msg "Not a valid directory! (ExistingMsys2Dir)"
Exit 1
} elseif (!(Split-Path -IsAbsolute -Path "$ExistingMsys2Dir")) {
Print-Msg -color Red -msg "Non-absolute Path specified! (ExistingMsys2Dir)"
Exit 1
} else {
$MsysDir = $ExistingMsys2Dir
}
} else {
$MsysDir = ('{0}\msys64' -f $GhcupDir)
}
$Bash = ('{0}\usr\bin\bash' -f $MsysDir) $Bash = ('{0}\usr\bin\bash' -f $MsysDir)
if (!($BootstrapUrl)) { if (!($BootstrapUrl)) {
$BootstrapUrl = 'https://www.haskell.org/ghcup/sh/bootstrap-haskell' $BootstrapUrl = 'https://www.haskell.org/ghcup/sh/bootstrap-haskell'
@@ -398,6 +413,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -msg 'Setting default home directory...' Print-Msg -msg 'Setting default home directory...'
Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf" Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf"
} elseif ($msys2Decision -eq 1) { } elseif ($msys2Decision -eq 1) {
Print-Msg -color Yellow -msg 'Skipping MSys2 installation.' Print-Msg -color Yellow -msg 'Skipping MSys2 installation.'
while ($true) { while ($true) {
@@ -529,10 +545,14 @@ if (!($NoAdjustCabalConfig)) {
$AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;' $AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;'
} }
if ($Minimal) {
$MinimalExport = 'export BOOTSTRAP_HASKELL_MINIMAL=1 ;'
}
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) { if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
Exec "$Bash" '-lc' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport) Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
} else { } else {
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport) Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport)
} }

View File

@@ -1,4 +1,4 @@
resolver: lts-18.7 resolver: lts-18.2
packages: packages:
- . - .
@@ -6,21 +6,22 @@ packages:
extra-deps: extra-deps:
- git: https://github.com/bgamari/terminal-size - git: https://github.com/bgamari/terminal-size
commit: 34ea816bd63f75f800eedac12c6908c6f3736036 commit: 34ea816bd63f75f800eedac12c6908c6f3736036
- git: https://github.com/hasufell/libarchive
commit: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530 - git: https://github.com/hasufell/libarchive
commit: 8587aab78dd515928024ecd82c8f215e06db85cd
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582 - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231 - base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964 - brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331 - brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153 - chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496 - chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216 - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
- haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466 - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298 - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159 - haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615 - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712 - hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
@@ -29,11 +30,11 @@ extra-deps:
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179 - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582 - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308 - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568 - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995 - optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432 - optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009 - optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728 - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7 - regex-posix-clib-2.7
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421 - streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
@@ -41,7 +42,6 @@ extra-deps:
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138 - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248 - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918
flags: flags:
http-io-streams: http-io-streams:
@@ -63,3 +63,11 @@ ghc-options:
"$locals": -O2 "$locals": -O2
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
build:
test: true
test-arguments:
no-run-tests: true
bench: true
benchmark-opts:
no-run-benchmarks: true

View File

@@ -66,7 +66,7 @@ instance Arbitrary ByteString where
--------------------- ---------------------
instance Arbitrary Scheme where instance Arbitrary Scheme where
arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ] arbitrary = elements [ Scheme "http", Scheme "https" ]
instance Arbitrary Host where instance Arbitrary Host where
arbitrary = genericArbitrary arbitrary = genericArbitrary

View File

@@ -13,4 +13,5 @@ import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do
roundtripAndGoldenSpecs (Proxy @GHCupInfo) roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName "test/golden" }) (Proxy @GHCupInfo)

View File

@@ -174,7 +174,17 @@ span.code {
line-height: 2rem; line-height: 2rem;
} }
#help {
margin-bottom: 0px !important;
}
#collective {
margin-top: 1em !important;
margin-bottom: 0px !important;
}
#about { #about {
margin-top: 0.5em !important;
font-size: 16px; font-size: 16px;
line-height: 2em; line-height: 2em;
} }

View File

@@ -137,9 +137,14 @@
</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>. 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>
<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"> <p id="about">
<img src="haskell-logo.svg" alt="" /> <img src="haskell-logo.svg" alt="" />