Compare commits
74 Commits
cabal-plan
...
hls-1.4.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
0f14dee72a
|
|||
|
ae2031174e
|
|||
|
c163278c64
|
|||
|
d10133f06f
|
|||
|
4377fc663e
|
|||
|
487e236882
|
|||
|
|
737f72f90f | ||
|
|
c3aab65521 | ||
|
|
972474f79a | ||
| bc64d2ade0 | |||
|
|
eddda55fe6 | ||
|
|
13aca91231 | ||
|
bbd11bfa26
|
|||
|
75548fa02d
|
|||
|
fb6956009f
|
|||
|
e029117c3e
|
|||
|
bc7c01de90
|
|||
|
cfcd8a4c20
|
|||
|
5e17eb7ca7
|
|||
|
|
756727ffe2 | ||
|
6bc602dead
|
|||
|
056c79e813
|
|||
|
68bbf31a86
|
|||
|
b58f380e75
|
|||
|
48c54bf374
|
|||
|
51da1578f4
|
|||
|
|
488f25aed6 | ||
|
d355c46250
|
|||
|
787c927de6
|
|||
|
d15ff7bc67
|
|||
|
7c5c35f1b0
|
|||
|
001b090bc6
|
|||
|
db8207f8b9
|
|||
|
e5918de7af
|
|||
|
d2346a543a
|
|||
|
c057b4ae5c
|
|||
|
b962bf4af9
|
|||
|
c54dc05d92
|
|||
|
8c72bf697e
|
|||
|
cc8cf3d12a
|
|||
|
9bdf6bde17
|
|||
|
8363495843
|
|||
|
bc80b1048f
|
|||
|
d61981bc1b
|
|||
|
4ccdc5dd6c
|
|||
|
3240118226
|
|||
|
254989d63d
|
|||
|
283f2a6e46
|
|||
|
94637dfbab
|
|||
|
3e26d7057c
|
|||
|
3f710112f3
|
|||
|
34df41b44a
|
|||
|
3897434ef0
|
|||
|
375dba9dd1
|
|||
|
2edd1fb583
|
|||
|
11326060fb
|
|||
|
d343c01737
|
|||
|
3925f78721
|
|||
|
d98e54a743
|
|||
|
13143b8e4d
|
|||
|
3a7895e5ea
|
|||
|
2893b2e2d2
|
|||
|
987436fed2
|
|||
|
96ac66e909
|
|||
|
e5947f3490
|
|||
|
b35fe15703
|
|||
|
a269b60282
|
|||
|
fc6f7ffd73
|
|||
|
430dc2d20b
|
|||
|
77c464870f
|
|||
|
dda38ec52b
|
|||
|
|
f6b6b36eb7 | ||
|
|
3986677b06 | ||
|
1fb048777c
|
@@ -14,7 +14,7 @@ variables:
|
||||
############################################################
|
||||
|
||||
.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:
|
||||
- x86_64-linux
|
||||
variables:
|
||||
@@ -77,7 +77,7 @@ variables:
|
||||
|
||||
.freebsd:
|
||||
tags:
|
||||
- x86_64-freebsd
|
||||
- x86_64-freebsd13
|
||||
variables:
|
||||
OS: "FREEBSD"
|
||||
ARCH: "64"
|
||||
@@ -103,7 +103,7 @@ variables:
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
- golden
|
||||
- test/golden
|
||||
- dist-newstyle/cache/
|
||||
when: on_failure
|
||||
|
||||
@@ -240,7 +240,7 @@ test:linux:bootstrap_script:
|
||||
test:windows:bootstrap_powershell_script:
|
||||
stage: test
|
||||
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:
|
||||
- "[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)"
|
||||
- "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)"
|
||||
@@ -527,15 +527,9 @@ release:windows:
|
||||
hlint:
|
||||
stage: hlint
|
||||
extends:
|
||||
- .alpine:64bit
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
||||
- .debian
|
||||
script:
|
||||
- ./.gitlab/script/hlint.sh
|
||||
variables:
|
||||
GHC_VERSION: "8.10.6"
|
||||
CABAL_VERSION: "3.4.0.0"
|
||||
JSON_VERSION: "0.0.4"
|
||||
- curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
|
||||
allow_failure: true
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
|
||||
@@ -11,9 +11,9 @@ mkdir -p "${TMPDIR}"
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
./ghcup-bin -v upgrade -i -f
|
||||
./ghcup-bin -v install ${GHC_VERSION}
|
||||
./ghcup-bin -v set ${GHC_VERSION}
|
||||
./ghcup-bin -v install-cabal ${CABAL_VERSION}
|
||||
|
||||
exit 0
|
||||
|
||||
@@ -7,67 +7,21 @@ set -eux
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential
|
||||
|
||||
if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
|
||||
sudo apt-get install -y autoconf build-essential gcc-arm-linux-gnueabihf
|
||||
sudo apt-get install -y gcc-arm-linux-gnueabihf
|
||||
sudo dpkg --add-architecture armhf
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libncurses-dev:armhf
|
||||
fi
|
||||
|
||||
case "${ARCH}" in
|
||||
ARM*)
|
||||
case "${ARCH}" in
|
||||
"ARM")
|
||||
ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-armv7-deb10-linux.tar.xz
|
||||
cabal_url=home.smart-cactus.org/~ben/cabal-install-${CABAL_VERSION}-armv7-linux-bootstrapped.tar.xz
|
||||
;;
|
||||
"ARM64")
|
||||
ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-aarch64-deb10-linux.tar.xz
|
||||
cabal_url=https://downloads.haskell.org/~cabal/cabal-install-${CABAL_VERSION}/cabal-install-${CABAL_VERSION}-aarch64-ubuntu-18.04.tar.xz
|
||||
;;
|
||||
*)
|
||||
exit 1 ;;
|
||||
esac
|
||||
export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
|
||||
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
|
||||
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
|
||||
export BOOTSTRAP_HASKELL_VERBOSE=1
|
||||
|
||||
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
||||
|
||||
curl -O "${ghc_url}"
|
||||
tar -xf ghc-*.tar.*
|
||||
cd ghc-${GHC_VERSION}
|
||||
./configure --prefix="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}
|
||||
make install
|
||||
for i in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}/bin/*-${GHC_VERSION} ; do
|
||||
ln -s "${i}" "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/${i##*/}
|
||||
done
|
||||
for x in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/*-${GHC_VERSION} ; do
|
||||
ln -s ${x##*/} ${x%-${GHC_VERSION}}
|
||||
done
|
||||
cd ..
|
||||
rm -rf ghc-${GHC_VERSION} ghc-*.tar.*
|
||||
unset x i
|
||||
|
||||
mkdir cabal-install
|
||||
cd cabal-install
|
||||
curl -O "${cabal_url}"
|
||||
tar -xf cabal-install-*
|
||||
mv cabal "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/cabal
|
||||
cd ..
|
||||
rm -rf cabal-install
|
||||
|
||||
;;
|
||||
*)
|
||||
url=https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup
|
||||
|
||||
curl -sSfL "${url}" > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin install ghc ${GHC_VERSION}
|
||||
./ghcup-bin set ghc ${GHC_VERSION}
|
||||
./ghcup-bin install cabal ${CABAL_VERSION}
|
||||
|
||||
;;
|
||||
esac
|
||||
rm "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -24,7 +24,7 @@ export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
|
||||
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
|
||||
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
|
||||
|
||||
./bootstrap-haskell
|
||||
./scripts/bootstrap/bootstrap-haskell
|
||||
|
||||
[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]
|
||||
|
||||
|
||||
@@ -13,7 +13,7 @@ ecabal() {
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
@@ -13,7 +13,7 @@ ecabal() {
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
@@ -18,9 +18,9 @@ raw_eghcup() {
|
||||
|
||||
eghcup() {
|
||||
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
|
||||
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
|
||||
}
|
||||
|
||||
@@ -92,7 +92,7 @@ rm -rf "${GHCUP_DIR}"
|
||||
### 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
|
||||
|
||||
@@ -172,10 +172,10 @@ else
|
||||
fi
|
||||
|
||||
# check that lazy loading works for 'whereis'
|
||||
cp "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml"
|
||||
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
eghcup whereis ghc $(ghc --numeric-version)
|
||||
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)
|
||||
|
||||
|
||||
108
README.md
108
README.md
@@ -10,6 +10,7 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
|
||||
[](https://app.element.io/#/room/#haskell-tooling:matrix.org)
|
||||
[](https://discord.gg/pKYf3zDQU7)
|
||||
[](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
|
||||
<a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
|
||||
|
||||
* [Installation](#installation)
|
||||
* [Simple bootstrap](#simple-bootstrap)
|
||||
@@ -19,11 +20,12 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
|
||||
* [Configuration](#configuration)
|
||||
* [Manpages](#manpages)
|
||||
* [Shell-completion](#shell-completion)
|
||||
* [Cross support](#cross-support)
|
||||
* [Compiling GHC from source](#compiling-ghc-from-source)
|
||||
* [XDG support](#xdg-support)
|
||||
* [Env variables](#env-variables)
|
||||
* [Installing custom bindists](#installing-custom-bindists)
|
||||
* [Isolated Installs](#isolated-installs)
|
||||
* [CI](#ci)
|
||||
* [Tips and tricks](#tips-and-tricks)
|
||||
* [Design goals](#design-goals)
|
||||
* [How](#how)
|
||||
@@ -90,7 +92,7 @@ handles your haskell packages and can demand that [a specific version](https://c
|
||||
### Configuration
|
||||
|
||||
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.
|
||||
|
||||
@@ -101,14 +103,26 @@ For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man`
|
||||
|
||||
### 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`
|
||||
as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
|
||||
and make sure your bashrc sources the startup script
|
||||
(`/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
|
||||
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.
|
||||
- `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
|
||||
|
||||
@@ -266,8 +357,13 @@ In addition this script can also install `cabal-install`.
|
||||
|
||||
## Known users
|
||||
|
||||
* Github action [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
|
||||
* [vabal](https://github.com/Franciman/vabal)
|
||||
* Github actions:
|
||||
- [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
|
||||
|
||||
|
||||
19
RELEASING.md
19
RELEASING.md
@@ -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`
|
||||
@@ -11,22 +11,31 @@
|
||||
module Main where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
import Control.Monad.Trans.Reader ( runReaderT )
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Char ( toLower )
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Data.Semigroup ( (<>) )
|
||||
#endif
|
||||
import Options.Applicative hiding ( style )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import System.Console.Pretty
|
||||
import System.Exit
|
||||
import System.IO ( stdout )
|
||||
import System.IO ( stderr )
|
||||
import Text.Regex.Posix
|
||||
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.Yaml as Y
|
||||
import qualified Data.YAML.Aeson as Y
|
||||
|
||||
|
||||
data Options = Options
|
||||
@@ -105,10 +114,27 @@ com = subparser
|
||||
|
||||
main :: IO ()
|
||||
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)
|
||||
>>= \Options {..} -> case optCommand of
|
||||
ValidateYAML vopts -> withValidateYamlOpts vopts validate
|
||||
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (validateTarballs tarballFilter)
|
||||
ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
|
||||
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
|
||||
pure ()
|
||||
|
||||
where
|
||||
@@ -120,8 +146,8 @@ main = do
|
||||
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
||||
B.readFile file >>= valAndExit f
|
||||
valAndExit f contents = do
|
||||
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of
|
||||
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
|
||||
Right r -> pure r
|
||||
Left e -> die (color Red $ show e)
|
||||
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av gt)
|
||||
Left (_, e) -> die (color Red $ show e)
|
||||
f av gt
|
||||
>>= exitWith
|
||||
|
||||
@@ -12,11 +12,9 @@ module Validate where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Types hiding ( LeanAppState (..) )
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Version.QQ
|
||||
|
||||
import Codec.Archive
|
||||
@@ -24,7 +22,6 @@ import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader.Class
|
||||
import Control.Monad.Trans.Class ( lift )
|
||||
import Control.Monad.Trans.Reader ( runReaderT )
|
||||
@@ -39,12 +36,10 @@ import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
import System.FilePath
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Version as V
|
||||
@@ -62,7 +57,7 @@ addError = do
|
||||
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
|
||||
-> M.Map GlobalTool DownloadInfo
|
||||
-> m ExitCode
|
||||
@@ -89,23 +84,23 @@ validate dls _ = do
|
||||
if e > 0
|
||||
then pure $ ExitFailure e
|
||||
else do
|
||||
lift $ $(logInfo) "All good"
|
||||
lift $ logInfo "All good"
|
||||
pure ExitSuccess
|
||||
where
|
||||
checkHasRequiredPlatforms t v tags arch pspecs = do
|
||||
let v' = prettyVer v
|
||||
arch' = prettyShow arch
|
||||
when (notElem (Linux UnknownLinux) pspecs) $ do
|
||||
lift $ $(logError) $
|
||||
lift $ logError $
|
||||
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
addError
|
||||
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
|
||||
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'
|
||||
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
|
||||
|
||||
-- alpine needs to be set explicitly, because
|
||||
@@ -113,12 +108,12 @@ validate dls _ = do
|
||||
-- (although it could be static)
|
||||
when (notElem (Linux Alpine) pspecs) $
|
||||
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|]
|
||||
, 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
|
||||
, 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)
|
||||
, 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)
|
||||
|
||||
checkUniqueTags tool = do
|
||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||
@@ -138,7 +133,7 @@ validate dls _ = do
|
||||
case join nonUnique of
|
||||
[] -> pure ()
|
||||
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
|
||||
where
|
||||
isUniqueTag Latest = True
|
||||
@@ -154,7 +149,7 @@ validate dls _ = do
|
||||
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
|
||||
[_] -> pure ()
|
||||
_ -> do
|
||||
lift $ $(logError) $ "GHC version " <> prettyVer v <> " is not valid"
|
||||
lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
|
||||
addError
|
||||
|
||||
-- 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
|
||||
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
|
||||
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
|
||||
True -> pure ()
|
||||
|
||||
@@ -171,7 +166,7 @@ validate dls _ = do
|
||||
let allTags = M.toList $ availableToolVersions dls GHC
|
||||
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
|
||||
False -> do
|
||||
lift $ $(logError) $ "Base tag missing from GHC ver " <> prettyVer ver
|
||||
lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
|
||||
addError
|
||||
True -> pure ()
|
||||
|
||||
@@ -184,7 +179,10 @@ data TarballFilter = TarballFilter
|
||||
}
|
||||
|
||||
validateTarballs :: ( Monad m
|
||||
, MonadLogger m
|
||||
, MonadReader env m
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -199,45 +197,37 @@ validateTarballs :: ( Monad m
|
||||
validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
ref <- liftIO $ newIORef 0
|
||||
|
||||
flip runReaderT ref $ do
|
||||
-- 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 gdlis = nubOrd $ gt ^.. each
|
||||
let allDls = either (const gdlis) (const dlis) etool
|
||||
when (null allDls) $ $(logError) "no tarballs selected by filter" *> addError
|
||||
forM_ allDls downloadAll
|
||||
-- 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 gdlis = nubOrd $ gt ^.. each
|
||||
let allDls = either (const gdlis) (const dlis) etool
|
||||
when (null allDls) $ logError "no tarballs selected by filter" *> (flip runReaderT ref addError)
|
||||
forM_ allDls (downloadAll ref)
|
||||
|
||||
-- exit
|
||||
e <- liftIO $ readIORef ref
|
||||
if e > 0
|
||||
then pure $ ExitFailure e
|
||||
else do
|
||||
lift $ $(logInfo) "All good"
|
||||
pure ExitSuccess
|
||||
-- exit
|
||||
e <- liftIO $ readIORef ref
|
||||
if e > 0
|
||||
then pure $ ExitFailure e
|
||||
else do
|
||||
logInfo "All good"
|
||||
pure ExitSuccess
|
||||
|
||||
where
|
||||
runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
||||
, colorOutter = B.hPut stderr
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
downloadAll dli = do
|
||||
dirs <- liftIO getAllDirs
|
||||
|
||||
pfreq <- (
|
||||
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
|
||||
) >>= \case
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
lift $ runLogger
|
||||
($(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
|
||||
|
||||
r <-
|
||||
runLogger
|
||||
. flip runReaderT appstate
|
||||
. runResourceT
|
||||
downloadAll :: ( MonadUnliftIO m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadCatch m
|
||||
, MonadMask m
|
||||
, MonadThrow m
|
||||
)
|
||||
=> IORef Int
|
||||
-> DownloadInfo
|
||||
-> m ()
|
||||
downloadAll ref dli = do
|
||||
r <- runResourceT
|
||||
. runE @'[DigestError
|
||||
, DownloadFailed
|
||||
, UnknownArchive
|
||||
@@ -263,26 +253,26 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
|
||||
VRight (Just basePath) -> do
|
||||
case _dlSubdir dli of
|
||||
Just (RealDir prel) -> do
|
||||
lift $ $(logInfo)
|
||||
logInfo
|
||||
$ " verifying subdir: " <> T.pack prel
|
||||
when (basePath /= prel) $ do
|
||||
lift $ $(logError) $
|
||||
logError $
|
||||
"Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
|
||||
addError
|
||||
(flip runReaderT ref addError)
|
||||
Just (RegexDir regexString) -> do
|
||||
lift $ $(logInfo) $
|
||||
logInfo $
|
||||
"verifying subdir (regex): " <> T.pack regexString
|
||||
let regex = makeRegexOpts
|
||||
compIgnoreCase
|
||||
execBlank
|
||||
regexString
|
||||
when (not (match regex basePath)) $ do
|
||||
lift $ $(logError) $
|
||||
logError $
|
||||
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
|
||||
addError
|
||||
(flip runReaderT ref addError)
|
||||
Nothing -> pure ()
|
||||
VRight Nothing -> pure ()
|
||||
VLeft e -> do
|
||||
lift $ $(logError) $
|
||||
logError $
|
||||
"Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
|
||||
addError
|
||||
(flip runReaderT ref addError)
|
||||
|
||||
@@ -13,11 +13,11 @@ module BrickMain where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics hiding ( getGHCupInfo )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Prelude ( decUTF8Safe )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Border
|
||||
@@ -29,7 +29,6 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||
)
|
||||
import Codec.Archive
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Resource
|
||||
@@ -417,12 +416,8 @@ install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, Monad
|
||||
install' _ (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
l <- liftIO $ readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let run =
|
||||
runLogger
|
||||
. runResourceT
|
||||
runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, ArchiveResult
|
||||
@@ -462,7 +457,7 @@ install' _ (_, ListResult {..}) = do
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
myLoggerT l $ $(logInfo) msg
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
VLeft (V NoUpdate) -> pure $ Right ()
|
||||
@@ -473,12 +468,9 @@ install' _ (_, ListResult {..}) = do
|
||||
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
|
||||
set' _ (_, ListResult {..}) = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
let run =
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
flip runReaderT settings
|
||||
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
||||
|
||||
run (do
|
||||
@@ -501,9 +493,7 @@ del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnlif
|
||||
del' _ (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
l <- liftIO $ readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
let run = myLoggerT l . runE @'[NotInstalled]
|
||||
let run = runE @'[NotInstalled]
|
||||
|
||||
run (do
|
||||
let vi = getVersionInfo lVer lTool dls
|
||||
@@ -517,7 +507,7 @@ del' _ (_, ListResult {..}) = do
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
|
||||
@@ -546,6 +536,10 @@ settings' :: IORef AppState
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO $ do
|
||||
dirs <- getAllDirs
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
newIORef $ AppState (Settings { cache = True
|
||||
, noVerify = False
|
||||
, keepDirs = Never
|
||||
@@ -559,27 +553,14 @@ settings' = unsafePerformIO $ do
|
||||
defaultKeyBindings
|
||||
(GHCupInfo mempty mempty mempty)
|
||||
(PlatformRequest A_64 Darwin Nothing)
|
||||
loggerConfig
|
||||
|
||||
|
||||
|
||||
logger' :: IORef LoggerConfig
|
||||
{-# NOINLINE logger' #-}
|
||||
logger' = unsafePerformIO
|
||||
(newIORef $ LoggerConfig { lcPrintDebug = False
|
||||
, colorOutter = \_ -> pure ()
|
||||
, rawOutter = \_ -> pure ()
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
brickMain :: AppState
|
||||
-> LoggerConfig
|
||||
-> IO ()
|
||||
brickMain s l = do
|
||||
brickMain s = do
|
||||
writeIORef settings' s
|
||||
-- logger interpreter
|
||||
writeIORef logger' l
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||
|
||||
@@ -596,7 +577,7 @@ brickMain s l = 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
|
||||
|
||||
|
||||
@@ -607,12 +588,9 @@ defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = Fal
|
||||
getGHCupInfo :: IO (Either String GHCupInfo)
|
||||
getGHCupInfo = do
|
||||
settings <- readIORef settings'
|
||||
l <- readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
r <-
|
||||
runLogger
|
||||
. flip runReaderT settings
|
||||
flip runReaderT settings
|
||||
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
@@ -625,14 +603,11 @@ getGHCupInfo = do
|
||||
getAppData :: Maybe GHCupInfo
|
||||
-> IO (Either String BrickData)
|
||||
getAppData mgi = runExceptT $ do
|
||||
l <- liftIO $ readIORef logger'
|
||||
let runLogger = myLoggerT l
|
||||
|
||||
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
|
||||
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
runLogger . flip runReaderT settings $ do
|
||||
flip runReaderT settings $ do
|
||||
lV <- listVersions Nothing Nothing
|
||||
pure $ BrickData (reverse lV)
|
||||
|
||||
|
||||
@@ -40,7 +40,6 @@ import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Aeson ( decodeStrict', Value )
|
||||
@@ -58,6 +57,7 @@ import Data.Void
|
||||
import GHC.IO.Encoding
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax ( Quasi(qAddDependentFile) )
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
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.IO as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Yaml as Y
|
||||
import qualified Data.Yaml.Pretty as YP
|
||||
import qualified Data.YAML.Aeson as Y
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MPC
|
||||
|
||||
@@ -207,6 +206,11 @@ data ChangeLogOptions = ChangeLogOptions
|
||||
|
||||
|
||||
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
||||
| WhereisBaseDir
|
||||
| WhereisBinDir
|
||||
| WhereisCacheDir
|
||||
| WhereisLogsDir
|
||||
| WhereisConfDir
|
||||
|
||||
data WhereisOptions = WhereisOptions {
|
||||
directory :: Bool
|
||||
@@ -332,7 +336,7 @@ com =
|
||||
( Install
|
||||
<$> info
|
||||
(installParser <**> helper)
|
||||
( progDesc "Install or update GHC/cabal/HLS"
|
||||
( progDesc "Install or update GHC/cabal/HLS/stack"
|
||||
<> footerDoc (Just $ text installToolFooter)
|
||||
)
|
||||
)
|
||||
@@ -348,7 +352,7 @@ com =
|
||||
"rm"
|
||||
(info
|
||||
(Rm <$> rmParser <**> helper)
|
||||
( progDesc "Remove a GHC/cabal/HLS version"
|
||||
( progDesc "Remove a GHC/cabal/HLS/stack version"
|
||||
<> footerDoc (Just $ text rmFooter)
|
||||
)
|
||||
)
|
||||
@@ -448,20 +452,20 @@ com =
|
||||
installToolFooter = [s|Discussion:
|
||||
Installs GHC or cabal. When no command is given, installs GHC
|
||||
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 = [s|Discussion:
|
||||
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
|
||||
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 = [s|Discussion:
|
||||
Remove the given GHC or cabal version. When no command is given,
|
||||
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 = [s|Discussion:
|
||||
@@ -542,7 +546,7 @@ installParser =
|
||||
( InstallHLS
|
||||
<$> info
|
||||
(installOpts (Just HLS) <**> helper)
|
||||
( progDesc "Install haskell-languge-server"
|
||||
( progDesc "Install haskell-language-server"
|
||||
<> footerDoc (Just $ text installHLSFooter)
|
||||
)
|
||||
)
|
||||
@@ -835,7 +839,8 @@ configP = subparser
|
||||
|
||||
whereisP :: Parser WhereisCommand
|
||||
whereisP = subparser
|
||||
( command
|
||||
(commandGroup "Tools locations:" <>
|
||||
command
|
||||
"ghc"
|
||||
(WhereisTool GHC <$> info
|
||||
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
|
||||
@@ -870,6 +875,37 @@ whereisP = subparser
|
||||
command
|
||||
"ghcup"
|
||||
(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
|
||||
whereisGHCFooter = [s|Discussion:
|
||||
@@ -1010,7 +1046,7 @@ ghcCompileOpts =
|
||||
(option
|
||||
str
|
||||
(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
|
||||
@@ -1099,19 +1135,18 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
|
||||
tagCompleter :: Tool -> [String] -> Completer
|
||||
tagCompleter tool add = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let appState = LeanAppState
|
||||
(Settings True False Never Curl False GHCupURL True)
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, colorOutter = 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
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (\t -> t /= Old)
|
||||
@@ -1131,14 +1166,14 @@ versionCompleter criteria tool = listIOCompleter $ do
|
||||
, colorOutter = mempty
|
||||
, rawOutter = mempty
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
settings = Settings True False Never Curl False GHCupURL True
|
||||
let settings = Settings True False Never Curl False GHCupURL True
|
||||
let leanAppState = LeanAppState
|
||||
settings
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
mpFreq <- runLogger . flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- runLogger . flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
loggerConfig
|
||||
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||
let appState = AppState
|
||||
@@ -1147,8 +1182,9 @@ versionCompleter criteria tool = listIOCompleter $ do
|
||||
defaultKeyBindings
|
||||
ghcupInfo
|
||||
pfreq
|
||||
loggerConfig
|
||||
|
||||
runEnv = runLogger . flip runReaderT appState
|
||||
runEnv = flip runReaderT appState
|
||||
|
||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
||||
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
||||
@@ -1319,7 +1355,7 @@ toSettings options = do
|
||||
|
||||
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
|
||||
updateSettings config settings = do
|
||||
settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
|
||||
settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config
|
||||
pure $ mergeConf settings' settings
|
||||
where
|
||||
mergeConf :: UserSettings -> Settings -> Settings
|
||||
@@ -1367,20 +1403,18 @@ describe_result = $( LitE . StringL <$>
|
||||
)
|
||||
|
||||
plan_json :: String
|
||||
plan_json = $( LitE . StringL <$>
|
||||
runIO (handleIO (\_ -> pure "") $ do
|
||||
plan_json = $( do
|
||||
(fp, c) <- runIO (handleIO (\_ -> pure ("", "")) $ do
|
||||
fp <- findPlanJson (ProjectRelativeToDir ".")
|
||||
c <- B.readFile fp
|
||||
(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 settings
|
||||
= UTF8.toString . YP.encodePretty yamlConfig $ settings
|
||||
where
|
||||
yamlConfig = YP.setConfCompare compare YP.defConfig
|
||||
= UTF8.toString . Y.encode1Strict $ settings
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@@ -1435,18 +1469,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
(settings, keybindings) <- toSettings opt
|
||||
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- flip runReaderT dirs $ initGHCupFileLogging
|
||||
logfile <- flip runReaderT dirs initGHCupFileLogging
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = verbose settings
|
||||
, colorOutter = B.hPut stderr
|
||||
, colorOutter = T.hPutStr stderr
|
||||
, rawOutter =
|
||||
case optCommand of
|
||||
Nuke -> \_ -> pure ()
|
||||
_ -> B.appendFile logfile
|
||||
_ -> T.appendFile logfile
|
||||
}
|
||||
let runLogger = myLoggerT loggerConfig
|
||||
let siletRunLogger = myLoggerT loggerConfig { colorOutter = \_ -> pure () }
|
||||
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
|
||||
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
|
||||
pfreq <- (
|
||||
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
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 2)
|
||||
|
||||
ghcupInfo <-
|
||||
( runLogger
|
||||
. flip runReaderT leanAppstate
|
||||
( flip runReaderT leanAppstate
|
||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
@@ -1476,12 +1510,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight r -> pure r
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
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)
|
||||
(threadDelay 5000000 >> runLogger ($(logWarn) $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
|
||||
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"))
|
||||
|
||||
case optCommand of
|
||||
Nuke -> pure ()
|
||||
@@ -1493,7 +1527,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
|
||||
Nothing -> flip runReaderT s' checkForUpdates
|
||||
Just _ -> pure ()
|
||||
|
||||
-- TODO: always run for windows
|
||||
@@ -1501,7 +1535,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
($(logError) $ T.pack $ prettyShow e)
|
||||
(logError $ T.pack $ prettyShow e)
|
||||
exitWith (ExitFailure 30)
|
||||
pure s'
|
||||
|
||||
@@ -1526,8 +1560,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
|
||||
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
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
@@ -1555,8 +1588,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runLeanSetGHC =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
@@ -1566,8 +1598,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runSetGHC =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
@@ -1578,8 +1609,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runLeanSetCabal =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1588,8 +1618,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runSetCabal =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1599,8 +1628,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runSetHLS =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1609,8 +1637,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runLeanSetHLS =
|
||||
runLogger
|
||||
. runLeanAppState
|
||||
runLeanAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, TagNotFound
|
||||
@@ -1618,23 +1645,21 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
, NoToolVersionSet
|
||||
]
|
||||
|
||||
let runListGHC = runLogger . runAppState
|
||||
let runListGHC = runAppState
|
||||
|
||||
let runRm =
|
||||
runLogger . runAppState . runE @'[NotInstalled]
|
||||
runAppState . runE @'[NotInstalled]
|
||||
|
||||
let runNuke s' =
|
||||
runLogger . flip runReaderT s' . runE @'[NotInstalled]
|
||||
flip runReaderT s' . runE @'[NotInstalled]
|
||||
|
||||
let runDebugInfo =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
|
||||
|
||||
let runCompileGHC =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
@@ -1654,10 +1679,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
let
|
||||
runLeanWhereIs =
|
||||
runLogger
|
||||
-- Don't use runLeanAppState here, which is disabled on windows.
|
||||
-- This is the only command on all platforms that doesn't need full appstate.
|
||||
. flip runReaderT leanAppstate
|
||||
flip runReaderT leanAppstate
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
@@ -1666,8 +1690,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
runWhereIs =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runE
|
||||
@'[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
@@ -1676,8 +1699,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
let runUpgrade =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ DigestError
|
||||
@@ -1689,8 +1711,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
]
|
||||
|
||||
let runPrefetch =
|
||||
runLogger
|
||||
. runAppState
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ TagNotFound
|
||||
@@ -1728,25 +1749,25 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "GHC installation successful"
|
||||
runLogger $ logInfo "GHC installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
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"
|
||||
pure ExitSuccess
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err)
|
||||
_ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger $ (logError $ T.pack $ prettyShow err)
|
||||
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 3
|
||||
|
||||
|
||||
@@ -1768,18 +1789,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "Cabal installation successful"
|
||||
runLogger $ logInfo "Cabal installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
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"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
let installHLS InstallOptions{..} =
|
||||
@@ -1800,12 +1821,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "HLS installation successful"
|
||||
runLogger $ logInfo "HLS installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ $(logWarn) $
|
||||
runLogger $ logWarn $
|
||||
"HLS ver "
|
||||
<> prettyVer v
|
||||
<> " 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
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
let installStack InstallOptions{..} =
|
||||
@@ -1836,18 +1857,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ $(logInfo) "Stack installation successful"
|
||||
runLogger $ logInfo "Stack installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
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"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
$(logError) $ T.pack $ prettyShow e
|
||||
$(logError) $ "Also check the logs in " <> T.pack logsDir
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
|
||||
@@ -1861,11 +1882,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 5
|
||||
|
||||
let setCabal' SetOptions{ sToolVer } =
|
||||
@@ -1879,11 +1900,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let setHLS' SetOptions{ sToolVer } =
|
||||
@@ -1897,11 +1918,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"HLS " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let setStack' SetOptions{ sToolVer } =
|
||||
@@ -1915,11 +1936,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ $(logInfo) $
|
||||
$ logInfo $
|
||||
"Stack " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
let rmGHC' RmOptions{..} =
|
||||
@@ -1932,10 +1953,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 7
|
||||
|
||||
let rmCabal' tv =
|
||||
@@ -1948,10 +1969,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
let rmHLS' tv =
|
||||
@@ -1964,10 +1985,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
let rmStack' tv =
|
||||
@@ -1980,31 +2001,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
res <- case optCommand of
|
||||
#if defined(BRICK)
|
||||
Interactive -> do
|
||||
s' <- appState
|
||||
liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
|
||||
liftIO $ brickMain s' >> pure ExitSuccess
|
||||
#endif
|
||||
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
|
||||
Install (Left (InstallGHC iopts)) -> installGHC iopts
|
||||
Install (Left (InstallCabal iopts)) -> installCabal iopts
|
||||
Install (Left (InstallHLS iopts)) -> installHLS iopts
|
||||
Install (Left (InstallStack iopts)) -> installStack iopts
|
||||
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
|
||||
|
||||
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
|
||||
Set (Left (SetGHC sopts)) -> setGHC' 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
|
||||
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
|
||||
Rm (Left (RmGHC rmopts)) -> rmGHC' 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
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 8
|
||||
|
||||
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
|
||||
Compile (CompileGHC GHCCompileOptions {..}) ->
|
||||
runCompileGHC (do
|
||||
@@ -2046,8 +2067,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ $(logInfo) msg
|
||||
lift $ $(logInfo)
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
@@ -2070,32 +2091,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, tv) -> do
|
||||
runLogger $ $(logInfo)
|
||||
runLogger $ logInfo
|
||||
"GHC successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
putStr (T.unpack $ tVerToText tv)
|
||||
pure ExitSuccess
|
||||
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"
|
||||
pure ExitSuccess
|
||||
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
||||
case keepDirs settings of
|
||||
Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err
|
||||
_ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
|
||||
Never -> runLogger $ logError $ T.pack $ prettyShow err
|
||||
_ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
|
||||
"Check the logs at " <> T.pack logsDir <> " and the build directory "
|
||||
<> T.pack tmpdir <> " for more clues." <> "\n" <>
|
||||
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
||||
pure $ ExitFailure 9
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 9
|
||||
|
||||
Config InitConfig -> do
|
||||
path <- getConfigFilePath
|
||||
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
|
||||
|
||||
Config ShowConfig -> do
|
||||
@@ -2105,20 +2126,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Config (SetConfig k v) -> do
|
||||
case v of
|
||||
"" -> do
|
||||
runLogger $ $(logError) "Empty values are not allowed"
|
||||
runLogger $ logError "Empty values are not allowed"
|
||||
pure $ ExitFailure 55
|
||||
_ -> do
|
||||
r <- runE @'[JSONError] $ do
|
||||
settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
|
||||
path <- liftIO getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||
runLogger $ $(logDebug) $ T.pack $ show settings'
|
||||
runLogger $ logDebug $ T.pack $ show settings'
|
||||
pure ()
|
||||
|
||||
case r of
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft (V (JSONDecodeError e)) -> do
|
||||
runLogger $ $(logError) $ "Error decoding config: " <> T.pack e
|
||||
runLogger $ logError $ "Error decoding config: " <> T.pack e
|
||||
pure $ ExitFailure 65
|
||||
VLeft _ -> pure $ ExitFailure 65
|
||||
|
||||
@@ -2134,7 +2155,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
Whereis WhereisOptions{..} (WhereisTool tool whereVer) ->
|
||||
@@ -2150,9 +2171,29 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
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
|
||||
target <- case uOpts of
|
||||
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
||||
@@ -2167,23 +2208,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight (v', dls) -> do
|
||||
let pretty_v = prettyVer v'
|
||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ $(logInfo) $
|
||||
runLogger $ logInfo $
|
||||
"Successfully upgraded GHCup to version " <> pretty_v
|
||||
forM_ (_viPostInstall vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V NoUpdate) -> do
|
||||
runLogger $ $(logWarn) "No GHCup update available"
|
||||
runLogger $ logWarn "No GHCup update available"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 11
|
||||
|
||||
ToolRequirements -> do
|
||||
s' <- appState
|
||||
flip runReaderT s'
|
||||
$ runLogger
|
||||
(runE
|
||||
$ (runE
|
||||
@'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements]
|
||||
$ do
|
||||
GHCupInfo { .. } <- lift getGHCupInfo
|
||||
@@ -2194,7 +2234,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 12
|
||||
|
||||
ChangeLog ChangeLogOptions{..} -> do
|
||||
@@ -2211,7 +2251,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
case muri of
|
||||
Nothing -> do
|
||||
runLogger
|
||||
($(logWarn) $
|
||||
(logWarn $
|
||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
||||
)
|
||||
pure ExitSuccess
|
||||
@@ -2234,7 +2274,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Nothing
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> runLogger ($(logError) (T.pack $ prettyShow e))
|
||||
Left e -> logError (T.pack $ prettyShow e)
|
||||
>> pure (ExitFailure 13)
|
||||
else putStrLn uri' >> pure ExitSuccess
|
||||
|
||||
@@ -2242,12 +2282,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
s' <- liftIO appState
|
||||
void $ liftIO $ evaluate $ force s'
|
||||
runNuke s' (do
|
||||
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 "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."
|
||||
liftIO $ threadDelay 10000000 -- wait 10s
|
||||
|
||||
lift $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||
lift $ $logInfo "Nuking in 3...2...1"
|
||||
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||
lift $ logInfo "Nuking in 3...2...1"
|
||||
|
||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
||||
|
||||
@@ -2258,15 +2298,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
) >>= \case
|
||||
VRight leftOverFiles
|
||||
| null leftOverFiles -> do
|
||||
runLogger $ $logInfo "Nuclear Annihilation complete!"
|
||||
runLogger $ logInfo "Nuclear Annihilation complete!"
|
||||
pure ExitSuccess
|
||||
| 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
|
||||
pure ExitSuccess
|
||||
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
Prefetch pfCom ->
|
||||
runPrefetch (do
|
||||
@@ -2297,7 +2337,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
|
||||
@@ -2308,7 +2348,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
|
||||
pure ()
|
||||
|
||||
fromVersion :: ( MonadLogger m
|
||||
fromVersion :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
@@ -2326,7 +2366,7 @@ fromVersion :: ( MonadLogger m
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion tv = fromVersion' (toSetToolVer tv)
|
||||
|
||||
fromVersion' :: ( MonadLogger m
|
||||
fromVersion' :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
@@ -2572,11 +2612,10 @@ checkForUpdates :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> m ()
|
||||
checkForUpdates = do
|
||||
@@ -2587,35 +2626,35 @@ checkForUpdates = do
|
||||
forM_ (getLatest dls GHCup) $ \(l, _) -> do
|
||||
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
when (l > ghc_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
|
||||
|
||||
forM_ (getLatest dls GHC) $ \(l, _) -> do
|
||||
let mghc_ver = latestInstalled GHC
|
||||
forM mghc_ver $ \ghc_ver ->
|
||||
when (l > ghc_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls Cabal) $ \(l, _) -> do
|
||||
let mcabal_ver = latestInstalled Cabal
|
||||
forM mcabal_ver $ \cabal_ver ->
|
||||
when (l > cabal_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls HLS) $ \(l, _) -> do
|
||||
let mhls_ver = latestInstalled HLS
|
||||
forM mhls_ver $ \hls_ver ->
|
||||
when (l > hls_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
|
||||
|
||||
forM_ (getLatest dls Stack) $ \(l, _) -> do
|
||||
let mstack_ver = latestInstalled Stack
|
||||
forM mstack_ver $ \stack_ver ->
|
||||
when (l > stack_ver)
|
||||
$ $(logWarn) $
|
||||
$ logWarn $
|
||||
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
|
||||
|
||||
|
||||
|
||||
@@ -8,26 +8,27 @@ package ghcup
|
||||
tests: True
|
||||
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
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
constraints: http-io-streams -brotli
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-8.10.5
|
||||
with-compiler: ghc-8.10.7
|
||||
@@ -1,15 +1,18 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.2.1.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,
|
||||
any.HsYAML ==0.2.1.0,
|
||||
HsYAML -exe,
|
||||
any.HsYAML-aeson ==0.2.0.0,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==1.5.6.0,
|
||||
aeson -bytestring-builder -cffi -developer -fast,
|
||||
any.aeson-pretty ==0.8.8,
|
||||
aeson-pretty -lib-only,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
@@ -22,8 +25,7 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
async -bench,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.auto-update ==0.1.6,
|
||||
any.base ==4.14.2.0,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.11.2,
|
||||
any.base-compat-batteries ==0.11.2,
|
||||
any.base-orphans ==0.8.4,
|
||||
@@ -32,41 +34,34 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.bindings-DSL ==1.0.25,
|
||||
any.blaze-builder ==0.4.2.1,
|
||||
any.brick ==0.63,
|
||||
any.brick ==0.64,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.0,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.casing ==0.1.4.1,
|
||||
any.cereal ==0.5.8.1,
|
||||
cereal -bytestring-builder,
|
||||
any.chs-cabal ==0.1.1.0,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.2,
|
||||
clock -llvm,
|
||||
any.cmdargs ==0.10.21,
|
||||
cmdargs +quotation -testprog,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
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,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.4.1,
|
||||
any.contravariant ==1.5.4,
|
||||
any.containers ==0.6.5.1,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
@@ -74,44 +69,32 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.cryptohash-sha256 ==0.11.102.0,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.1,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.4.0,
|
||||
any.digest ==0.0.1.3,
|
||||
digest -bytestring-in-base,
|
||||
any.directory ==1.3.6.0,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.easy-file ==0.2.2,
|
||||
any.errors ==2.3.0,
|
||||
any.exceptions ==0.10.4,
|
||||
any.extra ==1.7.9,
|
||||
any.fast-logger ==3.0.5,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.7,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.generics-sop ==0.5.1.1,
|
||||
any.ghc-boot-th ==8.10.5,
|
||||
any.ghc-boot-th ==8.10.7,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.2.0,
|
||||
any.hashable ==1.3.3.0,
|
||||
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-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.hpath-filepath ==0.10.4,
|
||||
any.hpath-posix ==0.13.3,
|
||||
any.hsc2hs ==0.68.7,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==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-golden-aeson ==0.9.0.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,
|
||||
any.libarchive ==3.0.2.2,
|
||||
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.megaparsec ==9.0.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.1,
|
||||
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.network ==3.1.2.2,
|
||||
network -devel,
|
||||
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.optics ==0.4,
|
||||
any.optics-core ==0.4,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4,
|
||||
any.optics-th ==0.4,
|
||||
any.optics-vl ==0.2.1,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2,
|
||||
@@ -167,8 +138,8 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.1.0,
|
||||
any.process ==1.6.9.0,
|
||||
any.primitive ==0.7.2.0,
|
||||
any.process ==1.6.13.2,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.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-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.4.2,
|
||||
any.resourcet ==1.2.4.3,
|
||||
any.rts ==1.0.1,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.semigroupoids ==5.3.5,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.sop-core ==0.5.0.1,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
splitmix -optimised-mixer,
|
||||
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,
|
||||
strict +assoc,
|
||||
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,
|
||||
tagged +deepseq +transformers,
|
||||
any.tar ==0.6.0.0,
|
||||
any.template-haskell ==2.16.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-conversions ==0.3.1,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.2.0,
|
||||
any.th-compat ==0.1.2,
|
||||
any.th-expand-syns ==0.4.8.0,
|
||||
any.th-lift ==0.8.2,
|
||||
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,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.5.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7,
|
||||
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-bytestring ==0.3.7.3,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unix-time ==0.4.7,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
unordered-containers -debug,
|
||||
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.2.1.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.0,
|
||||
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.vty ==5.33,
|
||||
any.word-wrap ==0.4.1,
|
||||
any.word8 ==0.1.3,
|
||||
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,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.2.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2021-07-27T07:59:57Z
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-08-29T16:24:29Z
|
||||
@@ -8,26 +8,27 @@ package ghcup
|
||||
tests: True
|
||||
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
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
constraints: http-io-streams -brotli
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-9.0.1
|
||||
|
||||
@@ -1,15 +1,18 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.4.0.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,
|
||||
any.HsYAML ==0.2.1.0,
|
||||
HsYAML -exe,
|
||||
any.HsYAML-aeson ==0.2.0.0,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==1.5.6.0,
|
||||
aeson -bytestring-builder -cffi -developer -fast,
|
||||
any.aeson-pretty ==0.8.8,
|
||||
aeson-pretty -lib-only,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
@@ -22,7 +25,6 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
async -bench,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.auto-update ==0.1.6,
|
||||
any.base ==4.15.0.0,
|
||||
any.base-compat ==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,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.bindings-DSL ==1.0.25,
|
||||
any.blaze-builder ==0.4.2.1,
|
||||
any.brick ==0.63,
|
||||
any.brick ==0.64,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.1,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.casing ==0.1.4.1,
|
||||
any.cereal ==0.5.8.1,
|
||||
cereal -bytestring-builder,
|
||||
any.chs-cabal ==0.1.1.0,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.2,
|
||||
clock -llvm,
|
||||
any.cmdargs ==0.10.21,
|
||||
cmdargs +quotation -testprog,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
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,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.4.1,
|
||||
any.contravariant ==1.5.4,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
@@ -74,45 +69,33 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.cryptohash-sha256 ==0.11.102.0,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.1,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.5.0,
|
||||
any.digest ==0.0.1.3,
|
||||
digest -bytestring-in-base,
|
||||
any.directory ==1.3.6.1,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.easy-file ==0.2.2,
|
||||
any.errors ==2.3.0,
|
||||
any.exceptions ==0.10.4,
|
||||
any.extra ==1.7.9,
|
||||
any.fast-logger ==3.0.5,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.7,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.generics-sop ==0.5.1.1,
|
||||
any.ghc-bignum ==1.0,
|
||||
any.ghc-boot-th ==9.0.1,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.7.0,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.2.0,
|
||||
any.hashable ==1.3.3.0,
|
||||
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-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.hpath-filepath ==0.10.4,
|
||||
any.hpath-posix ==0.13.3,
|
||||
any.hsc2hs ==0.68.7,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==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-golden-aeson ==0.9.0.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,
|
||||
any.libarchive ==3.0.2.2,
|
||||
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.megaparsec ==9.0.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.1,
|
||||
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.network ==3.1.2.2,
|
||||
network -devel,
|
||||
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.optics ==0.4,
|
||||
any.optics-core ==0.4,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4,
|
||||
any.optics-th ==0.4,
|
||||
any.optics-vl ==0.2.1,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2,
|
||||
@@ -167,7 +138,7 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
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.profunctors ==5.6.2,
|
||||
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-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.4.2,
|
||||
any.resourcet ==1.2.4.3,
|
||||
any.rts ==1.0,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
@@ -187,55 +158,41 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.semigroupoids ==5.3.5,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.sop-core ==0.5.0.1,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
splitmix -optimised-mixer,
|
||||
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,
|
||||
strict +assoc,
|
||||
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,
|
||||
tagged +deepseq +transformers,
|
||||
any.tar ==0.6.0.0,
|
||||
any.template-haskell ==2.17.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-conversions ==0.3.1,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.2.0,
|
||||
any.th-compat ==0.1.2,
|
||||
any.th-expand-syns ==0.4.8.0,
|
||||
any.th-lift ==0.8.2,
|
||||
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,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.5.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7,
|
||||
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-bytestring ==0.3.7.3,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unix-time ==0.4.7,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
unordered-containers -debug,
|
||||
@@ -245,20 +202,12 @@ constraints: any.Cabal ==3.4.0.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.0,
|
||||
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.vty ==5.33,
|
||||
any.word-wrap ==0.4.1,
|
||||
any.word8 ==0.1.3,
|
||||
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,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.2.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2021-07-27T07:59:57Z
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-08-29T16:24:29Z
|
||||
|
||||
@@ -16,7 +16,7 @@ source-repository-package
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/hasufell/libarchive
|
||||
tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
|
||||
tag: 8587aab78dd515928024ecd82c8f215e06db85cd
|
||||
|
||||
constraints: http-io-streams -brotli
|
||||
|
||||
|
||||
9
data/build_mk/cross
Normal file
9
data/build_mk/cross
Normal 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
8
data/build_mk/default
Normal 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
|
||||
@@ -72,7 +72,6 @@ toolRequirements:
|
||||
'( >= 7 && < 8 )':
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -83,7 +82,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -96,7 +94,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -111,14 +108,15 @@ toolRequirements:
|
||||
- binutils-gold
|
||||
- curl
|
||||
- gcc
|
||||
- g++
|
||||
- gmp-dev
|
||||
- ncurses-dev
|
||||
- libc-dev
|
||||
- libffi-dev
|
||||
- make
|
||||
- xz
|
||||
- tar
|
||||
- musl-dev
|
||||
- ncurses-dev
|
||||
- perl
|
||||
- tar
|
||||
- xz
|
||||
notes: ''
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
@@ -2172,7 +2170,6 @@ ghcupDownloads:
|
||||
3.4.0.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
@@ -2221,6 +2218,50 @@ ghcupDownloads:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
|
||||
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
|
||||
3.6.0.0:
|
||||
viTags:
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux.tar.xz
|
||||
dlHash: bfcb7350966dafe95051b5fc9fcb989c5708ab9e78191e71fc04647061668a11
|
||||
Linux_Alpine:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux-alpine.tar.xz
|
||||
dlHash: 3203d71b7ee87fc9dce74b452ae07f420afe8817b5e6f84e54798442f4ccdda8
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-darwin.tar.xz
|
||||
dlHash: 8e1367a4a1fc86ff0fd82ee057320a7b974595ba7999457b42035467ba06190c
|
||||
FreeBSD:
|
||||
'( >= 12 && < 13 )':
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd.tar.xz
|
||||
dlHash: 56b5b37396c16a29f164a6963f24bd88f09e1d37448542ed61a683325f0a868b
|
||||
'( >= 13 )':
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd13.tar.xz
|
||||
dlHash: a283aa498702a3e286aa08e004c2a389538cbb47ec7096a25682fb7d57f6bb7f
|
||||
Windows:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-windows.zip
|
||||
dlSubdir:
|
||||
dlHash: 8222b49b6eac3d06aaa390bc688f467e8f949a38943567f46246f8320fd72ded
|
||||
A_ARM64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-aarch64-linux-deb10.tar.xz
|
||||
dlHash: 534f71cd4e1d9758dc73066cc5733c5838874710aeb3aa88541de6c6d042d9ec
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-aarch64-darwin-big-sur.tar.xz
|
||||
dlHash: 7acf740946d996ede835edf68887e6b2f1e16d1b95e94054d266463f38d136d9
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
|
||||
dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
|
||||
GHCup:
|
||||
0.1.16.2:
|
||||
viTags:
|
||||
@@ -2314,9 +2355,7 @@ ghcupDownloads:
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-120-64
|
||||
1.3.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viTags: []
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
|
||||
viPostInstall: *hls-post-install
|
||||
viArch:
|
||||
@@ -2335,6 +2374,28 @@ ghcupDownloads:
|
||||
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-130-64
|
||||
1.4.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
|
||||
viPostInstall: *hls-post-install
|
||||
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:
|
||||
2.5.1:
|
||||
viTags:
|
||||
@@ -72,7 +72,6 @@ toolRequirements:
|
||||
'( >= 7 && < 8 )':
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -83,7 +82,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -96,7 +94,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- gcc-c++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -109,7 +106,6 @@ toolRequirements:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- gcc
|
||||
- g++
|
||||
- gmp
|
||||
- gmp-devel
|
||||
- make
|
||||
@@ -125,14 +121,15 @@ toolRequirements:
|
||||
- binutils-gold
|
||||
- curl
|
||||
- gcc
|
||||
- g++
|
||||
- gmp-dev
|
||||
- ncurses-dev
|
||||
- libc-dev
|
||||
- libffi-dev
|
||||
- make
|
||||
- xz
|
||||
- tar
|
||||
- musl-dev
|
||||
- ncurses-dev
|
||||
- perl
|
||||
- tar
|
||||
- xz
|
||||
notes: ''
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
@@ -2234,7 +2231,6 @@ ghcupDownloads:
|
||||
3.4.0.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
@@ -2283,6 +2279,50 @@ ghcupDownloads:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
|
||||
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
|
||||
3.6.0.0:
|
||||
viTags:
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux.tar.xz
|
||||
dlHash: bfcb7350966dafe95051b5fc9fcb989c5708ab9e78191e71fc04647061668a11
|
||||
Linux_Alpine:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-linux-alpine.tar.xz
|
||||
dlHash: 3203d71b7ee87fc9dce74b452ae07f420afe8817b5e6f84e54798442f4ccdda8
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-darwin.tar.xz
|
||||
dlHash: 8e1367a4a1fc86ff0fd82ee057320a7b974595ba7999457b42035467ba06190c
|
||||
FreeBSD:
|
||||
'( >= 12 && < 13 )':
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd.tar.xz
|
||||
dlHash: 56b5b37396c16a29f164a6963f24bd88f09e1d37448542ed61a683325f0a868b
|
||||
'( >= 13 )':
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-x86_64-freebsd13.tar.xz
|
||||
dlHash: a283aa498702a3e286aa08e004c2a389538cbb47ec7096a25682fb7d57f6bb7f
|
||||
Windows:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-x86_64-windows.zip
|
||||
dlSubdir:
|
||||
dlHash: 8222b49b6eac3d06aaa390bc688f467e8f949a38943567f46246f8320fd72ded
|
||||
A_ARM64:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.6.0.0/cabal-install-3.6.0.0-aarch64-linux-deb10.tar.xz
|
||||
dlHash: 534f71cd4e1d9758dc73066cc5733c5838874710aeb3aa88541de6c6d042d9ec
|
||||
Darwin:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-aarch64-darwin-big-sur.tar.xz
|
||||
dlHash: 7acf740946d996ede835edf68887e6b2f1e16d1b95e94054d266463f38d136d9
|
||||
A_ARM:
|
||||
Linux_UnknownLinux:
|
||||
unknown_versioning:
|
||||
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
|
||||
dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
|
||||
GHCup:
|
||||
0.1.16.2:
|
||||
viTags:
|
||||
@@ -2376,9 +2416,7 @@ ghcupDownloads:
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-120-64
|
||||
1.3.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viTags: []
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
|
||||
viPostInstall: *hls-post-install
|
||||
viArch:
|
||||
@@ -2397,6 +2435,28 @@ ghcupDownloads:
|
||||
dlHash: 46aac7be888e29a9907cf56698c1ce1475c148b5e6cc099513e9ef74a0520dcf
|
||||
Linux_Alpine:
|
||||
unknown_versioning: *hls-130-64
|
||||
1.4.0:
|
||||
viTags:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#140
|
||||
viPostInstall: *hls-post-install
|
||||
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:
|
||||
2.5.1:
|
||||
viTags:
|
||||
21
docs/RELEASING.md
Normal file
21
docs/RELEASING.md
Normal 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`
|
||||
31
ghcup.cabal
31
ghcup.cabal
@@ -16,15 +16,19 @@ description:
|
||||
category: System
|
||||
build-type: Simple
|
||||
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
|
||||
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
|
||||
type: git
|
||||
@@ -104,14 +108,12 @@ library
|
||||
, deepseq ^>=1.4.4.0
|
||||
, directory ^>=1.3.6.0
|
||||
, disk-free-space ^>=0.1.0.1
|
||||
, extra ^>=1.7.9
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.0.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, os-release ^>=1.0.0
|
||||
@@ -134,8 +136,7 @@ library
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml ^>=0.11.4.0
|
||||
, zip ^>=1.7.1
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, zlib ^>=0.6.2.2
|
||||
|
||||
if (flag(internal-downloader) && !os(windows))
|
||||
@@ -199,7 +200,6 @@ executable ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.0.0
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
, pretty ^>=1.1.3.1
|
||||
@@ -212,7 +212,7 @@ executable ghcup
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml ^>=0.11.4.0
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
@@ -261,7 +261,6 @@ executable ghcup-gen
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, libarchive ^>=3.0.0.0
|
||||
, monad-logger ^>=0.3.31
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
@@ -273,7 +272,7 @@ executable ghcup-gen
|
||||
, text ^>=1.2.4.0
|
||||
, transformers ^>=0.5
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml ^>=0.11.4.0
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
272
lib/GHCup.hs
272
lib/GHCup.hs
@@ -48,7 +48,6 @@ import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
@@ -58,7 +57,6 @@ import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.List.Extra
|
||||
import Data.Maybe
|
||||
import Data.String ( fromString )
|
||||
import Data.Text ( Text )
|
||||
@@ -67,9 +65,10 @@ import Data.Time.Format.ISO8601
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax ( Quasi(qAddDependentFile) )
|
||||
import Optics
|
||||
import Prelude hiding ( abs
|
||||
, readFile
|
||||
, writeFile
|
||||
)
|
||||
import Safe hiding ( at )
|
||||
@@ -112,7 +111,7 @@ fetchToolBindist :: ( MonadFail m
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -140,7 +139,7 @@ fetchGHCSrc :: ( MonadFail m
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -177,7 +176,7 @@ installGHCBindist :: ( MonadFail m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -202,7 +201,7 @@ installGHCBindist :: ( MonadFail m
|
||||
installGHCBindist dlinfo ver isoFilepath = do
|
||||
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
|
||||
-- we only care for already installed errors in regular (non-isolated) installs
|
||||
@@ -219,7 +218,7 @@ installGHCBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
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
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
|
||||
@@ -233,9 +232,9 @@ installGHCBindist dlinfo ver isoFilepath = do
|
||||
case catMaybes r of
|
||||
[] -> pure ()
|
||||
_ -> do
|
||||
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"
|
||||
lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall."
|
||||
lift $ logWarn $ "CC/LD environment variable is set. This will change the compiler/linker"
|
||||
<> "\n" <> "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
|
||||
<> "\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
|
||||
@@ -247,7 +246,7 @@ installPackedGHC :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -305,7 +304,7 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, MonadMask m
|
||||
@@ -316,7 +315,7 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
-> Excepts '[ProcessError] m ()
|
||||
installUnpackedGHC path inst ver = do
|
||||
#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
|
||||
-- to run configure.
|
||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||
@@ -333,7 +332,7 @@ installUnpackedGHC path inst ver = do
|
||||
| otherwise
|
||||
= []
|
||||
|
||||
lift $ $(logInfo) "Installing GHC (this may take a while)"
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
lEM $ execLogged "sh"
|
||||
("./configure" : ("--prefix=" <> inst)
|
||||
: alpineArgs
|
||||
@@ -359,7 +358,7 @@ installGHCBin :: ( MonadFail m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -393,7 +392,7 @@ installCabalBindist :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -417,7 +416,7 @@ installCabalBindist :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
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
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -448,7 +447,7 @@ installCabalBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
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
|
||||
|
||||
Nothing -> do -- regular install
|
||||
@@ -460,13 +459,13 @@ installCabalBindist dlinfo ver isoFilepath = do
|
||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||
|
||||
-- | 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 install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installCabalUnpacked path inst mver' = do
|
||||
lift $ $(logInfo) "Installing cabal"
|
||||
lift $ logInfo "Installing cabal"
|
||||
let cabalFile = "cabal"
|
||||
liftIO $ createDirRecursive' inst
|
||||
let destFileName = cabalFile
|
||||
@@ -491,7 +490,7 @@ installCabalBin :: ( MonadMask m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -526,7 +525,7 @@ installHLSBindist :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -550,7 +549,7 @@ installHLSBindist :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
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
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -576,7 +575,7 @@ installHLSBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
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
|
||||
|
||||
Nothing -> do
|
||||
@@ -589,13 +588,13 @@ installHLSBindist dlinfo ver isoFilepath = do
|
||||
|
||||
|
||||
-- | 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 install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installHLSUnpacked path inst mver' = do
|
||||
lift $ $(logInfo) "Installing HLS"
|
||||
lift $ logInfo "Installing HLS"
|
||||
liftIO $ createDirRecursive' inst
|
||||
|
||||
-- install haskell-language-server-<ghcver>
|
||||
@@ -645,7 +644,7 @@ installHLSBin :: ( MonadMask m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -682,7 +681,7 @@ installStackBin :: ( MonadMask m
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -717,7 +716,7 @@ installStackBindist :: ( MonadMask m
|
||||
, HasPlatformReq env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
@@ -741,7 +740,7 @@ installStackBindist :: ( MonadMask m
|
||||
m
|
||||
()
|
||||
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
|
||||
Dirs {..} <- lift getDirs
|
||||
@@ -766,7 +765,7 @@ installStackBindist dlinfo ver isoFilepath = do
|
||||
|
||||
case isoFilepath of
|
||||
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
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installStackUnpacked workdir binDir (Just ver)
|
||||
@@ -778,13 +777,13 @@ installStackBindist dlinfo ver isoFilepath = do
|
||||
|
||||
|
||||
-- | 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 install to
|
||||
-> Maybe Version -- ^ Nothing for isolated installs
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installStackUnpacked path inst mver' = do
|
||||
lift $ $(logInfo) "Installing stack"
|
||||
lift $ logInfo "Installing stack"
|
||||
let stackFile = "stack"
|
||||
liftIO $ createDirRecursive' inst
|
||||
let destFileName = stackFile
|
||||
@@ -817,7 +816,7 @@ installStackUnpacked path inst mver' = do
|
||||
-- for 'SetGHCOnly' constructor.
|
||||
setGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -851,7 +850,7 @@ setGHC ver sghc = do
|
||||
SetGHCOnly -> pure $ Just file
|
||||
SetGHC_XY -> do
|
||||
handle
|
||||
(\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
|
||||
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ do
|
||||
(mj, mi) <- getMajorMinorV (_tvVersion ver)
|
||||
let major' = intToText mj <> "." <> intToText mi
|
||||
@@ -869,6 +868,8 @@ setGHC ver sghc = do
|
||||
-- create symlink for share dir
|
||||
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
|
||||
|
||||
when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
|
||||
|
||||
pure ver
|
||||
|
||||
where
|
||||
@@ -876,7 +877,7 @@ setGHC ver sghc = do
|
||||
symlinkShareDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadMask m
|
||||
)
|
||||
@@ -893,9 +894,9 @@ setGHC ver sghc = do
|
||||
whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
|
||||
let fullF = destdir </> sharedir
|
||||
let targetF = "." </> "ghc" </> ver' </> sharedir
|
||||
$(logDebug) $ "rm -f " <> T.pack fullF
|
||||
logDebug $ "rm -f " <> T.pack fullF
|
||||
hideError doesNotExistErrorType $ rmDirectoryLink fullF
|
||||
$(logDebug) $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
|
||||
logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
|
||||
liftIO
|
||||
#if defined(IS_WINDOWS)
|
||||
-- On windows we need to be more permissive
|
||||
@@ -913,7 +914,7 @@ setGHC ver sghc = do
|
||||
setCabal :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -945,7 +946,7 @@ setCabal ver = do
|
||||
setHLS :: ( MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -961,7 +962,7 @@ setHLS ver = do
|
||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
lift $ $(logDebug) $ "rm " <> T.pack (binDir </> f)
|
||||
lift $ logDebug $ "rm " <> T.pack (binDir </> f)
|
||||
lift $ rmLink (binDir </> f)
|
||||
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
@@ -979,6 +980,8 @@ setHLS ver = do
|
||||
|
||||
lift $ createLink destL wrapper
|
||||
|
||||
lift warnAboutHlsCompatibility
|
||||
|
||||
pure ()
|
||||
|
||||
|
||||
@@ -986,7 +989,7 @@ setHLS ver = do
|
||||
setStack :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -1011,6 +1014,31 @@ setStack ver = do
|
||||
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 ]--
|
||||
@@ -1049,9 +1077,9 @@ availableToolVersions av tool = view
|
||||
-- | List all versions from the download info, as well as stray
|
||||
-- versions.
|
||||
listVersions :: ( MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1107,7 +1135,7 @@ listVersions lt' criteria = do
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
@@ -1147,7 +1175,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1155,7 +1183,7 @@ listVersions lt' criteria = do
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
@@ -1182,7 +1210,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1190,7 +1218,7 @@ listVersions lt' criteria = do
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m)
|
||||
=> Map.Map Version VersionInfo
|
||||
-> Maybe Version
|
||||
@@ -1216,7 +1244,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1224,7 +1252,7 @@ listVersions lt' criteria = do
|
||||
, HasDirs env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version VersionInfo
|
||||
@@ -1251,7 +1279,7 @@ listVersions lt' criteria = do
|
||||
, ..
|
||||
}
|
||||
Left e -> do
|
||||
$(logWarn)
|
||||
logWarn
|
||||
$ "Could not parse version of stray directory" <> T.pack e
|
||||
pure Nothing
|
||||
|
||||
@@ -1276,7 +1304,7 @@ listVersions lt' criteria = do
|
||||
}
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: ( MonadLogger m
|
||||
toListResult :: ( HasLog env
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasGHCupInfo env
|
||||
@@ -1378,7 +1406,7 @@ listVersions lt' criteria = do
|
||||
rmGHCVer :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1395,23 +1423,23 @@ rmGHCVer ver = do
|
||||
|
||||
-- this isn't atomic, order matters
|
||||
when isSetGHC $ do
|
||||
lift $ $(logInfo) "Removing ghc symlinks"
|
||||
lift $ logInfo "Removing ghc symlinks"
|
||||
liftE $ rmPlain (_tvTarget ver)
|
||||
|
||||
lift $ $(logInfo) "Removing ghc-x.y.z symlinks"
|
||||
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
||||
liftE $ rmMinorSymlinks ver
|
||||
|
||||
lift $ $(logInfo) "Removing/rewiring ghc-x.y symlinks"
|
||||
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
||||
-- first remove
|
||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
||||
-- 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
|
||||
|
||||
v' <-
|
||||
handle
|
||||
(\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
|
||||
(\(e :: ParseError) -> lift $ logWarn (T.pack $ displayException e) >> pure Nothing)
|
||||
$ fmap Just
|
||||
$ getMajorMinorV (_tvVersion ver)
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
|
||||
@@ -1428,7 +1456,7 @@ rmCabalVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1459,7 +1487,7 @@ rmHLSVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1482,7 +1510,7 @@ rmHLSVer ver = do
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
let fullF = binDir </> f
|
||||
lift $ $(logDebug) $ "rm " <> T.pack fullF
|
||||
lift $ logDebug $ "rm " <> T.pack fullF
|
||||
lift $ rmLink fullF
|
||||
-- set latest hls
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
@@ -1497,7 +1525,7 @@ rmStackVer :: ( MonadMask m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
@@ -1527,7 +1555,7 @@ rmGhcup :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -1552,7 +1580,7 @@ rmGhcup = do
|
||||
|
||||
let areEqualPaths = equalFilePath p1 p2
|
||||
|
||||
unless areEqualPaths $ $logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
||||
unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
-- since it doesn't seem possible to delete a running exe on windows
|
||||
@@ -1568,7 +1596,7 @@ rmGhcup = do
|
||||
|
||||
where
|
||||
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
|
||||
|
||||
nonStandardInstallLocationMsg path = T.pack $
|
||||
@@ -1578,7 +1606,7 @@ rmGhcup = do
|
||||
|
||||
rmTool :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m)
|
||||
@@ -1598,7 +1626,7 @@ rmTool ListResult {lVer, lTool, lCross} = do
|
||||
rmGhcupDirs :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadMask m )
|
||||
=> m [FilePath]
|
||||
@@ -1625,7 +1653,7 @@ rmGhcupDirs = do
|
||||
handleRm $ rmBinDir binDir
|
||||
handleRm $ rmDir recycleDir
|
||||
#if defined(IS_WINDOWS)
|
||||
$logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||
handleRm $ rmPathForcibly (baseDir </> "msys64")
|
||||
#endif
|
||||
|
||||
@@ -1636,27 +1664,27 @@ rmGhcupDirs = do
|
||||
hideErrorDef [doesNotExistErrorType] [] $ reportRemainingFiles baseDir
|
||||
|
||||
where
|
||||
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m ()
|
||||
handleRm = handleIO (\e -> $logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
|
||||
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"
|
||||
<> "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
|
||||
$logInfo "Removing Ghcup Environment File"
|
||||
logInfo "Removing Ghcup Environment File"
|
||||
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
|
||||
$logInfo "removing Ghcup Config File"
|
||||
logInfo "removing Ghcup Config File"
|
||||
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 =
|
||||
-- 'getDirectoryContentsRecursive' is lazy IO. In case
|
||||
-- an error leaks through, we catch it here as well,
|
||||
-- althought 'deleteFile' should already handle it.
|
||||
hideErrorDef [doesNotExistErrorType] () $ do
|
||||
$logInfo $ "removing " <> T.pack dir
|
||||
logInfo $ "removing " <> T.pack dir
|
||||
contents <- liftIO $ getDirectoryContentsRecursive dir
|
||||
forM_ contents (deleteFile . (dir </>))
|
||||
|
||||
@@ -1729,7 +1757,7 @@ getDebugInfo :: ( Alternative m
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
)
|
||||
@@ -1765,7 +1793,7 @@ compileGHC :: ( MonadMask m
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, MonadResource m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
@@ -1805,7 +1833,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
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
|
||||
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
|
||||
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
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 [ "remote"
|
||||
, "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))
|
||||
|
||||
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)
|
||||
-- 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
|
||||
case isolateDir of
|
||||
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 ->
|
||||
lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
|
||||
lift $ $(logWarn)
|
||||
lift $ logWarn $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
|
||||
lift $ logWarn
|
||||
"...waiting for 10 seconds before continuing, you can still abort..."
|
||||
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 ->
|
||||
-- only remove old ghc in regular installs
|
||||
when alreadyInstalled $ do
|
||||
lift $ $(logInfo) "Deleting existing installation"
|
||||
lift $ logInfo "Deleting existing installation"
|
||||
liftE $ rmGHCVer tver
|
||||
|
||||
_ -> pure ()
|
||||
@@ -1924,26 +1952,12 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
pure tver
|
||||
|
||||
where
|
||||
defaultConf = case targetGhc of
|
||||
Left (GHCTargetVersion (Just _) _) -> [s|
|
||||
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|]
|
||||
_ -> [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|]
|
||||
defaultConf =
|
||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
||||
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
|
||||
in case targetGhc of
|
||||
Left (GHCTargetVersion (Just _) _) -> cross_mk
|
||||
_ -> default_mk
|
||||
|
||||
compileHadrianBindist :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1951,7 +1965,7 @@ endif|]
|
||||
, HasPlatformReq env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -1974,7 +1988,7 @@ endif|]
|
||||
|
||||
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
|
||||
lEM $ execLogged hadrian_build
|
||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||
@@ -2013,7 +2027,7 @@ endif|]
|
||||
, HasPlatformReq env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -2044,15 +2058,15 @@ endif|]
|
||||
|
||||
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)
|
||||
|
||||
if | isCross tver -> do
|
||||
lift $ $(logInfo) "Installing cross toolchain..."
|
||||
lift $ logInfo "Installing cross toolchain..."
|
||||
lEM $ make ["install"] (Just workdir)
|
||||
pure Nothing
|
||||
| otherwise -> do
|
||||
lift $ $(logInfo) "Creating bindist..."
|
||||
lift $ logInfo "Creating bindist..."
|
||||
lEM $ make ["binary-dist"] (Just workdir)
|
||||
[tar] <- liftIO $ findFiles
|
||||
workdir
|
||||
@@ -2071,7 +2085,7 @@ endif|]
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> FilePath -- ^ tar file
|
||||
@@ -2106,10 +2120,10 @@ endif|]
|
||||
let tarPath = cacheDir </> tarName
|
||||
handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
|
||||
tarPath
|
||||
lift $ $(logInfo) $ "Copied bindist to " <> T.pack tarPath
|
||||
lift $ logInfo $ "Copied bindist to " <> T.pack tarPath
|
||||
pure tarPath
|
||||
|
||||
checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
|
||||
checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
|
||||
=> FilePath
|
||||
-> Excepts
|
||||
'[FileDoesNotExistError, InvalidBuildConfig]
|
||||
@@ -2132,7 +2146,7 @@ endif|]
|
||||
|
||||
forM_ buildFlavour $ \bf ->
|
||||
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
|
||||
|
||||
addBuildFlavourToConf bc = case buildFlavour of
|
||||
@@ -2149,7 +2163,7 @@ endif|]
|
||||
, HasPlatformReq env
|
||||
, MonadThrow m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
@@ -2168,7 +2182,7 @@ endif|]
|
||||
m
|
||||
()
|
||||
configureBindist bghc tver workdir ghcdir = do
|
||||
lift $ $(logInfo) [s|configuring build|]
|
||||
lift $ logInfo [s|configuring build|]
|
||||
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||
|
||||
@@ -2232,7 +2246,7 @@ upgradeGHCup :: ( MonadMask m
|
||||
, HasGHCupInfo env
|
||||
, HasSettings env
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
@@ -2254,7 +2268,7 @@ upgradeGHCup mtarget force' = do
|
||||
Dirs {..} <- lift getDirs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
lift $ $(logInfo) "Upgrading GHCup..."
|
||||
lift $ logInfo "Upgrading GHCup..."
|
||||
let latestVer = fromJust $ fst <$> getLatest dls GHCup
|
||||
when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
|
||||
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
|
||||
let destDir = takeDirectory destFile
|
||||
destFile = fromMaybe (binDir </> fn) mtarget
|
||||
lift $ $(logDebug) $ "mkdir -p " <> T.pack destDir
|
||||
lift $ logDebug $ "mkdir -p " <> T.pack destDir
|
||||
liftIO $ createDirRecursive' destDir
|
||||
lift $ $(logDebug) $ "rm -f " <> T.pack destFile
|
||||
lift $ logDebug $ "rm -f " <> T.pack 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
|
||||
destFile
|
||||
lift $ chmod_755 destFile
|
||||
|
||||
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
|
||||
Nothing -> pure ()
|
||||
Just pa -> lift $ $(logWarn) $ "ghcup is shadowed by "
|
||||
Just pa -> lift $ logWarn $ "ghcup is shadowed by "
|
||||
<> T.pack pa
|
||||
<> ". The upgrade will not be in effect, unless you remove "
|
||||
<> T.pack pa
|
||||
@@ -2300,7 +2314,7 @@ upgradeGHCup mtarget force' = do
|
||||
-- both installing from source and bindist.
|
||||
postGHCInstall :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -2316,7 +2330,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
-- Create ghc-x.y symlinks. This may not be the current
|
||||
-- version, create it regardless.
|
||||
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
|
||||
$ getMajorMinorV _tvVersion
|
||||
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
|
||||
whereIsTool :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
|
||||
@@ -1,10 +1,7 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
@@ -34,8 +31,8 @@ import GHCup.Download.Utils
|
||||
#endif
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Prelude
|
||||
@@ -47,7 +44,6 @@ import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
@@ -57,8 +53,8 @@ import Data.ByteString ( ByteString )
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import Data.CaseInsensitive ( mk )
|
||||
#endif
|
||||
import Data.List.Extra
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Versions
|
||||
@@ -72,6 +68,7 @@ import Prelude hiding ( abs
|
||||
, readFile
|
||||
, writeFile
|
||||
)
|
||||
import Safe
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
@@ -89,7 +86,7 @@ import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
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
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
@@ -164,21 +161,21 @@ getBase :: ( MonadReader env m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadMask m
|
||||
)
|
||||
=> URI
|
||||
-> Excepts '[JSONError] m GHCupInfo
|
||||
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
getBase uri = do
|
||||
Settings { noNetwork } <- lift getSettings
|
||||
Settings { noNetwork, downloader } <- lift getSettings
|
||||
|
||||
-- try to download yaml... usually this writes it into cache dir,
|
||||
-- but in some cases not (e.g. when using file://), so we honour
|
||||
-- the return filepath, if any
|
||||
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
|
||||
then pure Nothing
|
||||
else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
|
||||
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
|
||||
else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
|
||||
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
|
||||
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
|
||||
. fmap Just
|
||||
. smartDl
|
||||
@@ -186,28 +183,37 @@ getBase uri = do
|
||||
|
||||
-- if we didn't get a filepath from the download, use the cached yaml
|
||||
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
|
||||
. onE_ (onError actualYaml)
|
||||
. lEM' @_ @_ @'[JSONError] JSONDecodeError
|
||||
. fmap (first (\e -> unlines [displayException e
|
||||
,"Consider removing " <> actualYaml <> " manually."]))
|
||||
. liftIO
|
||||
. Y.decodeFileEither
|
||||
$ actualYaml
|
||||
. lE' @_ @_ @'[JSONError] JSONDecodeError
|
||||
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||
. Y.decode1
|
||||
$ yamlContents
|
||||
where
|
||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||
-- may re-download and succeed.
|
||||
onError :: (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
|
||||
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)
|
||||
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!)"
|
||||
lift $ $(logDebug) $ "Error was: " <> T.pack s
|
||||
|
||||
warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
|
||||
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
|
||||
-- and check it's access time. If it has been accessed within the
|
||||
@@ -221,7 +227,7 @@ getBase uri = do
|
||||
, MonadCatch m1
|
||||
, MonadIO m1
|
||||
, MonadFail m1
|
||||
, MonadLogger m1
|
||||
, HasLog env1
|
||||
, MonadMask m1
|
||||
)
|
||||
=> URI
|
||||
@@ -312,7 +318,7 @@ download :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> URI
|
||||
@@ -326,7 +332,7 @@ download uri eDigest dest mfn etags
|
||||
| scheme == "http" = dl
|
||||
| scheme == "file" = do
|
||||
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')
|
||||
pure destFile'
|
||||
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
||||
@@ -335,7 +341,7 @@ download uri eDigest dest mfn etags
|
||||
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||
dl = do
|
||||
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
|
||||
liftIO $ createDirRecursive' dest
|
||||
@@ -358,7 +364,7 @@ download uri eDigest dest mfn etags
|
||||
dh <- liftIO $ emptySystemTempFile "curl-header"
|
||||
flip finally (try @_ @SomeException $ rmFile dh) $
|
||||
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
|
||||
metag <- readETag destFile
|
||||
metag <- lift $ readETag destFile
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ (if etags then ["--dump-header", dh] else [])
|
||||
++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
|
||||
@@ -370,14 +376,14 @@ download uri eDigest dest mfn etags
|
||||
case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
|
||||
Just (http':sc:_)
|
||||
| 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
|
||||
$logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||
lift $ logDebug $ "Status code was " <> sc <> ", overwriting"
|
||||
liftIO $ copyFile (destFile <.> "tmp") destFile
|
||||
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
|
||||
:: V '[MalformedHeaders]))
|
||||
|
||||
writeEtags destFile (parseEtags headers)
|
||||
lift $ writeEtags destFile (parseEtags headers)
|
||||
else
|
||||
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
|
||||
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
|
||||
@@ -387,20 +393,20 @@ download uri eDigest dest mfn etags
|
||||
o' <- liftIO getWgetOpts
|
||||
if etags
|
||||
then do
|
||||
metag <- readETag destFile
|
||||
metag <- lift $ readETag destFile
|
||||
let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
|
||||
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
|
||||
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> do
|
||||
liftIO $ copyFile destFileTemp destFile
|
||||
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
ExitFailure i'
|
||||
| i' == 8
|
||||
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
|
||||
-> do
|
||||
$logDebug "Not modified, skipping download"
|
||||
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
lift $ logDebug "Not modified, skipping download"
|
||||
lift $ writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
|
||||
| otherwise -> throwE (NonZeroExit i' "wget" opts)
|
||||
else do
|
||||
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
|
||||
@@ -411,14 +417,14 @@ download uri eDigest dest mfn etags
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri
|
||||
if etags
|
||||
then do
|
||||
metag <- readETag destFile
|
||||
metag <- lift $ readETag destFile
|
||||
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
|
||||
, E.encodeUtf8 etag)]) metag
|
||||
liftE
|
||||
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
|
||||
$ do
|
||||
r <- downloadToFile https host fullPath port destFile addHeaders
|
||||
writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
||||
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
|
||||
else void $ liftE $ catchE @HTTPNotModified
|
||||
@'[DownloadFailed]
|
||||
(\e@(HTTPNotModified _) ->
|
||||
@@ -444,33 +450,33 @@ download uri eDigest dest mfn etags
|
||||
path = view pathL' 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
|
||||
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
|
||||
case T.words <$> mEtag of
|
||||
(Just []) -> do
|
||||
$logDebug "Couldn't parse etags, no input: "
|
||||
logDebug "Couldn't parse etags, no input: "
|
||||
pure Nothing
|
||||
(Just [_, etag']) -> do
|
||||
$logDebug $ "Parsed etag: " <> etag'
|
||||
logDebug $ "Parsed etag: " <> etag'
|
||||
pure (Just etag')
|
||||
(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
|
||||
Nothing -> do
|
||||
$logDebug "No etags header found"
|
||||
logDebug "No etags header found"
|
||||
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
|
||||
getTags >>= \case
|
||||
Just t -> do
|
||||
$logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
|
||||
logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
|
||||
liftIO $ T.writeFile (etagsFile destFile) t
|
||||
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
|
||||
e <- liftIO $ doesFileExist fp
|
||||
if e
|
||||
@@ -478,13 +484,13 @@ download uri eDigest dest mfn etags
|
||||
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
|
||||
case rE of
|
||||
(Right et) -> do
|
||||
$logDebug $ "Read etag: " <> et
|
||||
logDebug $ "Read etag: " <> et
|
||||
pure (Just et)
|
||||
(Left _) -> do
|
||||
$logDebug "Etag file doesn't exist (yet)"
|
||||
logDebug "Etag file doesn't exist (yet)"
|
||||
pure Nothing
|
||||
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)
|
||||
pure Nothing
|
||||
|
||||
@@ -497,7 +503,7 @@ downloadCached :: ( MonadReader env m
|
||||
, MonadMask m
|
||||
, MonadResource m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -518,7 +524,7 @@ downloadCached' :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
@@ -552,7 +558,7 @@ checkDigest :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
)
|
||||
=> T.Text -- ^ the hash
|
||||
-> FilePath
|
||||
@@ -562,7 +568,7 @@ checkDigest eDigest file = do
|
||||
let verify = not noVerify
|
||||
when verify $ do
|
||||
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
|
||||
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
|
||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
||||
|
||||
@@ -50,7 +50,7 @@ instance Pretty NoCompatiblePlatform where
|
||||
pPrint (NoCompatiblePlatform 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
|
||||
deriving Show
|
||||
|
||||
@@ -285,31 +285,37 @@ instance Pretty HadrianNotFound where
|
||||
-------------------------
|
||||
|
||||
-- | 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
|
||||
pPrint (DownloadFailed reason) =
|
||||
text "Download failed:" <+> pPrint reason
|
||||
case reason of
|
||||
VMaybe (_ :: DownloadFailed) -> pPrint reason
|
||||
_ -> text "Download failed:" <+> pPrint reason
|
||||
|
||||
deriving instance Show DownloadFailed
|
||||
|
||||
|
||||
-- | 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
|
||||
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
|
||||
|
||||
|
||||
-- | 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
|
||||
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
|
||||
|
||||
|
||||
@@ -20,6 +20,7 @@ module GHCup.Platform where
|
||||
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Prelude
|
||||
@@ -28,7 +29,6 @@ import GHCup.Utils.String.QQ
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Foldable
|
||||
@@ -57,7 +57,7 @@ import qualified Data.Text.IO as T
|
||||
|
||||
|
||||
-- | 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
|
||||
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
|
||||
m
|
||||
@@ -82,7 +82,7 @@ getArchitecture = case arch of
|
||||
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
|
||||
'[NoCompatiblePlatform, DistroNotFound]
|
||||
m
|
||||
@@ -107,7 +107,7 @@ getPlatform = do
|
||||
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
|
||||
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
|
||||
what -> throwE $ NoCompatiblePlatform what
|
||||
lift $ $(logDebug) $ "Identified Platform as: " <> T.pack (prettyShow pfr)
|
||||
lift $ logDebug $ "Identified Platform as: " <> T.pack (prettyShow pfr)
|
||||
pure pfr
|
||||
where
|
||||
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
|
||||
@@ -142,9 +142,7 @@ getLinuxDistro = do
|
||||
| otherwise -> UnknownLinux
|
||||
pure (distro, parsedVer)
|
||||
where
|
||||
hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y)
|
||||
False
|
||||
matches
|
||||
hasWord t = any (\x -> match (regex x) (T.unpack t))
|
||||
where
|
||||
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
|
||||
|
||||
|
||||
@@ -25,21 +25,17 @@ module GHCup.Types
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.DeepSeq ( NFData, rnf )
|
||||
import Control.Monad.Logger
|
||||
import Data.Map.Strict ( Map )
|
||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||
import URI.ByteString
|
||||
#if defined(BRICK)
|
||||
import Graphics.Vty ( Key(..) )
|
||||
#endif
|
||||
|
||||
import qualified Control.Monad.Trans.Class as Trans
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
@@ -152,7 +148,7 @@ data Tag = Latest
|
||||
| Recommended
|
||||
| Prerelease
|
||||
| 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
|
||||
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
|
||||
|
||||
@@ -241,7 +237,7 @@ instance NFData LinuxDistro
|
||||
distroToString :: LinuxDistro -> String
|
||||
distroToString Debian = "debian"
|
||||
distroToString Ubuntu = "ubuntu"
|
||||
distroToString Mint= "mint"
|
||||
distroToString Mint = "mint"
|
||||
distroToString Fedora = "fedora"
|
||||
distroToString CentOS = "centos"
|
||||
distroToString RedHat = "redhat"
|
||||
@@ -396,6 +392,7 @@ data AppState = AppState
|
||||
, keyBindings :: KeyBindings
|
||||
, ghcupInfo :: GHCupInfo
|
||||
, pfreq :: PlatformRequest
|
||||
, loggerConfig :: LoggerConfig
|
||||
} deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData AppState
|
||||
@@ -404,6 +401,7 @@ data LeanAppState = LeanAppState
|
||||
{ settings :: Settings
|
||||
, dirs :: Dirs
|
||||
, keyBindings :: KeyBindings
|
||||
, loggerConfig :: LoggerConfig
|
||||
} deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData LeanAppState
|
||||
@@ -555,14 +553,25 @@ instance Pretty Versioning where
|
||||
instance Pretty Version where
|
||||
pPrint = text . T.unpack . prettyVer
|
||||
|
||||
instance Show (a -> b) where
|
||||
show _ = "<function>"
|
||||
|
||||
instance (Monad m, Alternative m) => Alternative (LoggingT m) where
|
||||
empty = Trans.lift empty
|
||||
{-# INLINE empty #-}
|
||||
m <|> n = LoggingT $ \ r -> runLoggingT m r <|> runLoggingT n r
|
||||
{-# INLINE (<|>) #-}
|
||||
instance Show (IO ()) where
|
||||
show _ = "<io>"
|
||||
|
||||
|
||||
instance MonadLogger m => MonadLogger (Excepts e m) where
|
||||
monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d
|
||||
data LogLevel = Warn
|
||||
| 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
|
||||
|
||||
@@ -42,7 +42,7 @@ import qualified Text.Megaparsec as MP
|
||||
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 } ''VSep
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
|
||||
|
||||
@@ -6,6 +6,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Types.Optics
|
||||
@@ -21,9 +22,13 @@ module GHCup.Types.Optics where
|
||||
import GHCup.Types
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Text ( Text )
|
||||
import Optics
|
||||
import URI.ByteString
|
||||
import System.Console.Pretty
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
makePrisms ''Tool
|
||||
makePrisms ''Architecture
|
||||
@@ -87,13 +92,15 @@ getLeanAppState :: ( MonadReader env m
|
||||
, LabelOptic' "settings" A_Lens env Settings
|
||||
, LabelOptic' "dirs" A_Lens env Dirs
|
||||
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
)
|
||||
=> m LeanAppState
|
||||
getLeanAppState = do
|
||||
s <- gets @"settings"
|
||||
d <- gets @"dirs"
|
||||
k <- gets @"keyBindings"
|
||||
pure (LeanAppState s d k)
|
||||
l <- gets @"loggerConfig"
|
||||
pure (LeanAppState s d k l)
|
||||
|
||||
|
||||
getSettings :: ( MonadReader env m
|
||||
@@ -110,6 +117,87 @@ getDirs :: ( MonadReader env m
|
||||
getDirs = gets @"dirs"
|
||||
|
||||
|
||||
logInfo :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logInfo = logInternal Info
|
||||
|
||||
logWarn :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logWarn = logInternal Warn
|
||||
|
||||
logDebug :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logDebug = logInternal Debug
|
||||
|
||||
logError :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
)
|
||||
=> Text
|
||||
-> m ()
|
||||
logError = logInternal Error
|
||||
|
||||
|
||||
logInternal :: ( MonadReader env m
|
||||
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
|
||||
, MonadIO m
|
||||
) => LogLevel
|
||||
-> Text
|
||||
-> m ()
|
||||
logInternal logLevel msg = do
|
||||
LoggerConfig {..} <- gets @"loggerConfig"
|
||||
let style' = case logLevel of
|
||||
Debug -> style Bold . color Blue
|
||||
Info -> style Bold . color Green
|
||||
Warn -> style Bold . color Yellow
|
||||
Error -> style Bold . color Red
|
||||
let l = case logLevel of
|
||||
Debug -> style' "[ Debug ]"
|
||||
Info -> style' "[ Info ]"
|
||||
Warn -> style' "[ Warn ]"
|
||||
Error -> style' "[ Error ]"
|
||||
let strs = T.split (== '\n') msg
|
||||
let out = case strs of
|
||||
[] -> T.empty
|
||||
(x:xs) ->
|
||||
foldr (\a b -> a <> "\n" <> b) mempty
|
||||
. ((l <> " " <> x) :)
|
||||
. fmap (\line' -> style' "[ ... ] " <> line' )
|
||||
$ xs
|
||||
|
||||
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
|
||||
$ liftIO $ colorOutter out
|
||||
|
||||
-- raw output
|
||||
let lr = case logLevel of
|
||||
Debug -> "Debug:"
|
||||
Info -> "Info:"
|
||||
Warn -> "Warn:"
|
||||
Error -> "Error:"
|
||||
let outr = lr <> " " <> msg <> "\n"
|
||||
liftIO $ rawOutter outr
|
||||
|
||||
|
||||
|
||||
getLogCleanup :: ( MonadReader env m
|
||||
, LabelOptic' "logCleanup" A_Lens env (IO ())
|
||||
)
|
||||
=> m (IO ())
|
||||
getLogCleanup = gets @"logCleanup"
|
||||
|
||||
|
||||
getKeyBindings :: ( MonadReader env m
|
||||
, 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 HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
|
||||
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
|
||||
|
||||
@@ -40,14 +40,12 @@ import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Codec.Archive hiding ( Directory )
|
||||
import Codec.Archive.Zip
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
@@ -59,7 +57,6 @@ import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.Foldable
|
||||
import Data.List
|
||||
import Data.List.Extra
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
@@ -115,7 +112,7 @@ ghcLinkDestination tool ver = do
|
||||
rmMinorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
@@ -129,14 +126,14 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
forM_ files $ \f -> do
|
||||
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
|
||||
let fullF = binDir </> f_xyz
|
||||
lift $ $(logDebug) ("rm -f " <> T.pack fullF)
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
-- | Removes the set ghc version for the given target, if any.
|
||||
rmPlain :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
@@ -151,11 +148,11 @@ rmPlain target = do
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
forM_ files $ \f -> do
|
||||
let fullF = binDir </> f <> exeExt
|
||||
lift $ $(logDebug) ("rm -f " <> T.pack fullF)
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
-- old ghcup
|
||||
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
|
||||
|
||||
|
||||
@@ -163,7 +160,7 @@ rmPlain target = do
|
||||
rmMajorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
@@ -179,7 +176,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
forM_ files $ \f -> do
|
||||
let f_xy = f <> "-" <> T.unpack v' <> exeExt
|
||||
let fullF = binDir </> f_xy
|
||||
lift $ $(logDebug) "rm -f #{fullF}"
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
@@ -251,9 +248,9 @@ getInstalledGHCs = do
|
||||
|
||||
|
||||
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
|
||||
getInstalledCabals :: ( MonadLogger m
|
||||
, MonadReader env m
|
||||
getInstalledCabals :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
@@ -271,14 +268,14 @@ getInstalledCabals = do
|
||||
|
||||
|
||||
-- | 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
|
||||
vers <- fmap rights getInstalledCabals
|
||||
pure $ elem ver vers
|
||||
|
||||
|
||||
-- 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
|
||||
Dirs {..} <- getDirs
|
||||
let cabalbin = binDir </> "cabal" <> exeExt
|
||||
@@ -295,7 +292,7 @@ cabalSet = do
|
||||
case linkVersion =<< link of
|
||||
Right v -> pure $ Just v
|
||||
Left err -> do
|
||||
$(logWarn) $ "Failed to parse cabal symlink target with: "
|
||||
logWarn $ "Failed to parse cabal symlink target with: "
|
||||
<> T.pack (displayException err)
|
||||
<> ". The symlink "
|
||||
<> T.pack cabalbin
|
||||
@@ -366,7 +363,7 @@ getInstalledStacks = do
|
||||
|
||||
-- Return the currently set stack version, if any.
|
||||
-- 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
|
||||
Dirs {..} <- getDirs
|
||||
let stackBin = binDir </> "stack" <> exeExt
|
||||
@@ -383,7 +380,7 @@ stackSet = do
|
||||
case linkVersion =<< link of
|
||||
Right v -> pure $ Just v
|
||||
Left err -> do
|
||||
$(logWarn) $ "Failed to parse stack symlink target with: "
|
||||
logWarn $ "Failed to parse stack symlink target with: "
|
||||
<> T.pack (displayException err)
|
||||
<> ". The symlink "
|
||||
<> T.pack stackBin
|
||||
@@ -478,7 +475,7 @@ hlsGHCVersions = do
|
||||
. splitOn "~"
|
||||
)
|
||||
bins
|
||||
pure . rights . concat . maybeToList $ vers
|
||||
pure . sortBy (flip compare) . rights . concat . maybeToList $ vers
|
||||
|
||||
|
||||
-- | 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.
|
||||
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ destination dir
|
||||
-> FilePath -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
@@ -609,7 +606,7 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
] m ()
|
||||
unpackToDir dfp av = do
|
||||
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 ()
|
||||
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
|
||||
@@ -628,12 +625,11 @@ unpackToDir dfp av = do
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (untar . BZip.decompress =<< rf av)
|
||||
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||
| ".zip" `isSuffixOf` fn ->
|
||||
withArchive av (unpackInto dfp)
|
||||
| ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
|
||||
| otherwise -> throwE $ UnknownArchive fn
|
||||
|
||||
|
||||
getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
|
||||
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
|
||||
=> FilePath -- ^ archive path
|
||||
-> Excepts '[UnknownArchive
|
||||
, ArchiveResult
|
||||
@@ -658,14 +654,11 @@ getArchiveFiles av = do
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (entries . BZip.decompress =<< rf av)
|
||||
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||
| ".zip" `isSuffixOf` fn ->
|
||||
withArchive av $ do
|
||||
entries' <- getEntries
|
||||
pure $ fmap unEntrySelector $ Map.keys entries'
|
||||
| ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
|
||||
| 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
|
||||
-> TarDir -- ^ how to descend
|
||||
-> Excepts '[TarDirDoesNotExist] m FilePath
|
||||
@@ -793,14 +786,19 @@ makeOut args workdir = do
|
||||
|
||||
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
||||
-- 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 to apply patches in
|
||||
-> Excepts '[PatchFailed] m ()
|
||||
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
|
||||
lift $ $(logInfo) $ "Applying patch " <> T.pack patch'
|
||||
lift $ logInfo $ "Applying patch " <> T.pack patch'
|
||||
fmap (either (const Nothing) Just)
|
||||
(exec
|
||||
"patch"
|
||||
@@ -836,12 +834,14 @@ getChangeLog dls tool (Right tag) =
|
||||
-- 2. the install destination, depending on whether the build failed
|
||||
runBuildAction :: ( Pretty (V e)
|
||||
, Show (V e)
|
||||
, PopVariant BuildFailed e
|
||||
, ToVariantMaybe BuildFailed e
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> 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
|
||||
-- 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 $
|
||||
liftIO $ handleIO (\e -> run $ $(logWarn) $
|
||||
liftIO $ handleIO (\e -> run $ logWarn $
|
||||
"Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
|
||||
$ hideError doesNotExistErrorType
|
||||
$ rmPathForcibly dir)
|
||||
@@ -984,7 +984,7 @@ rmLink = hideError doesNotExistErrorType . recycleFile
|
||||
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
|
||||
createLink :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1006,24 +1006,24 @@ createLink link exe = do
|
||||
fullLink = takeDirectory exe </> link
|
||||
shimContents = "path = " <> fullLink
|
||||
|
||||
$(logDebug) $ "rm -f " <> T.pack exe
|
||||
logDebug $ "rm -f " <> T.pack 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 $ writeFile shim shimContents
|
||||
#else
|
||||
$(logDebug) $ "rm -f " <> T.pack exe
|
||||
logDebug $ "rm -f " <> T.pack 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
|
||||
#endif
|
||||
|
||||
|
||||
ensureGlobalTools :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -1041,8 +1041,8 @@ ensureGlobalTools = do
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\(DigestError _ _) -> do
|
||||
lift $ $(logWarn) "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ $(logDebug) "rm -f #{shimDownload}"
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
|
||||
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
||||
liftE @'[DigestError , DownloadFailed] $ dl
|
||||
) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
|
||||
|
||||
@@ -2,9 +2,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Dirs
|
||||
@@ -45,7 +43,6 @@ import GHCup.Utils.Prelude
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource hiding (throwM)
|
||||
import Data.Bifunctor
|
||||
@@ -61,7 +58,7 @@ import System.IO.Temp
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
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 Control.Concurrent (threadDelay)
|
||||
|
||||
@@ -224,7 +221,7 @@ ghcupConfigFile = do
|
||||
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
||||
case contents of
|
||||
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
|
||||
, HasDirs env
|
||||
, MonadUnliftIO m
|
||||
, MonadLogger m
|
||||
, HasLog env
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
, MonadMask m
|
||||
@@ -273,14 +270,14 @@ mkGhcupTmpDir = do
|
||||
let minSpace = 5000 -- a rough guess, aight?
|
||||
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
|
||||
when (maybe False (toBytes minSpace >) space) $ do
|
||||
$(logWarn) ("Possibly insufficient disk space on "
|
||||
logWarn ("Possibly insufficient disk space on "
|
||||
<> T.pack tmpdir
|
||||
<> ". At least "
|
||||
<> T.pack (show minSpace)
|
||||
<> " MB are recommended, but only "
|
||||
<> toMB (fromJust space)
|
||||
<> " 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..."
|
||||
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
|
||||
|
||||
@@ -295,8 +292,9 @@ mkGhcupTmpDir = do
|
||||
|
||||
withGHCupTmpDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
, MonadUnliftIO m
|
||||
, MonadLogger m
|
||||
, MonadCatch m
|
||||
, MonadResource m
|
||||
, MonadThrow m
|
||||
@@ -309,7 +307,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
|
||||
(run mkGhcupTmpDir)
|
||||
(\fp ->
|
||||
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
|
||||
$ fp))
|
||||
|
||||
@@ -341,9 +339,10 @@ relativeSymlink p1 p2 =
|
||||
|
||||
cleanupTrash :: ( MonadIO m
|
||||
, MonadMask m
|
||||
, MonadLogger m
|
||||
, MonadReader env m
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
)
|
||||
=> m ()
|
||||
cleanupTrash = do
|
||||
@@ -352,8 +351,8 @@ cleanupTrash = do
|
||||
if null contents
|
||||
then pure ()
|
||||
else do
|
||||
$(logWarn) ("Removing leftover files in " <> T.pack recycleDir)
|
||||
logWarn ("Removing leftover files in " <> T.pack recycleDir)
|
||||
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))
|
||||
|
||||
|
||||
@@ -7,7 +7,6 @@ module GHCup.Utils.File.Common where
|
||||
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
import Control.Monad.Extra
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
import GHC.IO.Exception
|
||||
@@ -29,11 +28,11 @@ data ProcessError = NonZeroExit Int FilePath [String]
|
||||
|
||||
instance Pretty ProcessError where
|
||||
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) =
|
||||
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) =
|
||||
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) =
|
||||
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
|
||||
|
||||
|
||||
@@ -1,8 +1,5 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.File.Posix
|
||||
@@ -28,7 +25,6 @@ import Control.Concurrent.Async
|
||||
import Control.Exception ( evaluate )
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.State.Strict
|
||||
import Data.ByteString ( ByteString )
|
||||
@@ -131,7 +127,7 @@ execLogged exe args chdir lfile env = do
|
||||
pure e
|
||||
|
||||
tee :: Fd -> Fd -> IO ()
|
||||
tee fileFd fdIn = readTilEOF lineAction fdIn
|
||||
tee fileFd = readTilEOF lineAction
|
||||
|
||||
where
|
||||
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
|
||||
let exe_mode =
|
||||
nullFileMode
|
||||
@@ -361,7 +357,7 @@ chmod_755 fp = do
|
||||
`unionFileModes` groupReadMode
|
||||
`unionFileModes` otherExecuteMode
|
||||
`unionFileModes` otherReadMode
|
||||
$(logDebug) ("chmod 755 " <> T.pack fp)
|
||||
logDebug ("chmod 755 " <> T.pack fp)
|
||||
liftIO $ setFileMode fp exe_mode
|
||||
|
||||
|
||||
|
||||
@@ -22,11 +22,8 @@ import GHCup.Utils.String.QQ
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
import Data.Char ( ord )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Console.Pretty
|
||||
import System.FilePath
|
||||
import System.IO.Error
|
||||
import Text.Regex.Posix
|
||||
@@ -35,53 +32,6 @@ import qualified Data.ByteString as B
|
||||
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
|
||||
, HasDirs env
|
||||
|
||||
@@ -5,7 +5,6 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.Prelude
|
||||
@@ -30,10 +29,10 @@ import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Logger
|
||||
import Data.Bifunctor
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List ( nub, intercalate )
|
||||
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf )
|
||||
import Data.Maybe
|
||||
import Data.Foldable
|
||||
import Data.String
|
||||
import Data.Text ( Text )
|
||||
@@ -75,8 +74,9 @@ import qualified System.Win32.File as Win32
|
||||
-- >>> import Data.ByteString.Internal (c2w, w2c)
|
||||
-- >>> import Test.QuickCheck
|
||||
-- >>> import Data.Word8
|
||||
-- >>> import Data.Word8
|
||||
-- >>> import qualified Data.Text as T
|
||||
-- >>> import qualified Data.Char as C
|
||||
-- >>> import Data.List
|
||||
-- >>> 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
|
||||
|
||||
-- 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 = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v))
|
||||
catchWarn :: forall es m env . ( Pretty (V es)
|
||||
, 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 (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)
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from 'ByteString's
|
||||
-- | Strip @\\r@ and @\\n@ from 'String's
|
||||
--
|
||||
-- >>> stripNewline "foo\n\n\n"
|
||||
-- "foo"
|
||||
@@ -532,13 +536,10 @@ forFold = \t -> (`traverseFold` t)
|
||||
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t
|
||||
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
|
||||
stripNewline :: String -> String
|
||||
stripNewline s
|
||||
| null s = []
|
||||
| head s `elem` "\n\r" = stripNewline (tail s)
|
||||
| otherwise = head s : stripNewline (tail s)
|
||||
stripNewline = filter (`notElem` "\n\r")
|
||||
|
||||
|
||||
-- | Strip @\\r@ and @\\n@ from 'ByteString's
|
||||
-- | Strip @\\r@ and @\\n@ from 'Text's
|
||||
--
|
||||
-- >>> stripNewline' "foo\n\n\n"
|
||||
-- "foo"
|
||||
@@ -550,10 +551,7 @@ stripNewline s
|
||||
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
|
||||
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
|
||||
stripNewline' :: T.Text -> T.Text
|
||||
stripNewline' s
|
||||
| T.null s = mempty
|
||||
| T.head s `elem` "\n\r" = stripNewline' (T.tail s)
|
||||
| otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s)
|
||||
stripNewline' = T.filter (`notElem` "\n\r")
|
||||
|
||||
|
||||
-- | Is the word8 a newline?
|
||||
@@ -587,3 +585,117 @@ splitOnPVP c s = case Split.splitOn c s of
|
||||
| otherwise -> def
|
||||
where
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -44,15 +44,14 @@ import Language.Haskell.TH.Quote
|
||||
-- The pattern portion is undefined.
|
||||
s :: QuasiQuoter
|
||||
s = QuasiQuoter
|
||||
(\s' -> case and $ fmap isAscii s' of
|
||||
(\s' -> case all isAscii s' of
|
||||
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
|
||||
False -> fail "Not ascii"
|
||||
)
|
||||
(error "Cannot use q as a pattern")
|
||||
(error "Cannot use q as a type")
|
||||
(error "Cannot use q as a dec")
|
||||
(error "Cannot use s as a pattern")
|
||||
(error "Cannot use s as a type")
|
||||
(error "Cannot use s as a dec")
|
||||
where
|
||||
removeCRs = filter (/= '\r')
|
||||
trimLeadingNewline ('\n' : xs) = xs
|
||||
trimLeadingNewline xs = xs
|
||||
|
||||
|
||||
@@ -24,6 +24,9 @@ import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- | This reflects the API version of the YAML.
|
||||
--
|
||||
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
|
||||
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
||||
ghcupURL :: URI
|
||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
# Main settings:
|
||||
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
|
||||
# * 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
|
||||
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
|
||||
# * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
|
||||
@@ -175,7 +176,15 @@ download_ghcup() {
|
||||
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
|
||||
;;
|
||||
aarch64|arm64|armv8l)
|
||||
_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver}
|
||||
# we could be in a 32bit docker container, in which
|
||||
# case uname doesn't give us what we want
|
||||
if [ "$(getconf LONG_BIT)" = "32" ] ; then
|
||||
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
|
||||
elif [ "$(getconf LONG_BIT)" = "64" ] ; then
|
||||
_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver}
|
||||
else
|
||||
die "Unknown long bit size: $(getconf LONG_BIT)"
|
||||
fi
|
||||
;;
|
||||
*) die "Unknown architecture: ${arch}"
|
||||
;;
|
||||
@@ -292,16 +301,7 @@ ask_bashrc() {
|
||||
|
||||
read -r bashrc_answer </dev/tty
|
||||
else
|
||||
# On windows .bashrc isn't an important user config, so we adjust it
|
||||
# always. On other platforms, let's be a bit more conservative.
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
return 1
|
||||
;;
|
||||
*)
|
||||
return 0
|
||||
;;
|
||||
esac
|
||||
return 0
|
||||
fi
|
||||
case $bashrc_answer in
|
||||
[Pp]* | "")
|
||||
@@ -371,6 +371,13 @@ adjust_bashrc() {
|
||||
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
||||
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
|
||||
break ;;
|
||||
|
||||
@@ -591,10 +598,12 @@ ask_bashrc
|
||||
ask_bashrc_answer=$?
|
||||
ask_cabal_config_init
|
||||
ask_cabal_config_init_answer=$?
|
||||
ask_hls
|
||||
ask_hls_answer=$?
|
||||
ask_stack
|
||||
ask_stack_answer=$?
|
||||
if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||
ask_hls
|
||||
ask_hls_answer=$?
|
||||
ask_stack
|
||||
ask_stack_answer=$?
|
||||
fi
|
||||
|
||||
edo mkdir -p "${GHCUP_BIN}"
|
||||
|
||||
@@ -620,14 +629,30 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
|
||||
read -r answer </dev/tty
|
||||
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 --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
|
||||
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_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
|
||||
1)
|
||||
@@ -15,24 +15,26 @@
|
||||
param (
|
||||
# Run an interactive installation
|
||||
[switch]$Interactive,
|
||||
# Specify the install root (default: 'C:\')
|
||||
[string]$InstallDir,
|
||||
# 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,
|
||||
# Do minimal installation of ghcup and msys2 only
|
||||
[switch]$Minimal,
|
||||
# Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
|
||||
[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
|
||||
[switch]$InstallStack,
|
||||
# Whether to install hls as well
|
||||
[switch]$InstallHLS,
|
||||
# Skip adjusting cabal.config with mingw paths
|
||||
[switch]$NoAdjustCabalConfig
|
||||
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
|
||||
[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
|
||||
@@ -180,7 +182,7 @@ elevated command prompt:
|
||||
|
||||
if ($GhcupBasePrefixEnv) {
|
||||
$defaultGhcupBasePrefix = $GhcupBasePrefixEnv
|
||||
} else {
|
||||
} elseif (!($InstallDir)) {
|
||||
$partitions = Get-CimInstance win32_logicaldisk
|
||||
$defaultGhcupBasePrefix = $null
|
||||
foreach ($p in $partitions){
|
||||
@@ -209,10 +211,10 @@ if ($Silent -and !($InstallDir)) {
|
||||
$GhcupBasePrefix = $defaultGhcupBasePrefix
|
||||
} elseif ($InstallDir) {
|
||||
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
|
||||
} 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
|
||||
} else {
|
||||
$GhcupBasePrefix = $InstallDir
|
||||
@@ -243,7 +245,20 @@ $null = [Environment]::SetEnvironmentVariable("GHCUP_INSTALL_BASE_PREFIX", $Ghcu
|
||||
|
||||
|
||||
$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)
|
||||
if (!($BootstrapUrl)) {
|
||||
$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...'
|
||||
Exec "$Bash" '-lc' "sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf"
|
||||
|
||||
} elseif ($msys2Decision -eq 1) {
|
||||
Print-Msg -color Yellow -msg 'Skipping MSys2 installation.'
|
||||
while ($true) {
|
||||
@@ -529,10 +545,14 @@ if (!($NoAdjustCabalConfig)) {
|
||||
$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) {
|
||||
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 {
|
||||
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)
|
||||
}
|
||||
|
||||
|
||||
24
stack.yaml
24
stack.yaml
@@ -1,4 +1,4 @@
|
||||
resolver: lts-18.7
|
||||
resolver: lts-18.2
|
||||
|
||||
packages:
|
||||
- .
|
||||
@@ -6,21 +6,22 @@ packages:
|
||||
extra-deps:
|
||||
- git: https://github.com/bgamari/terminal-size
|
||||
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
|
||||
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
||||
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
||||
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
||||
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
|
||||
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
|
||||
- chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
|
||||
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
|
||||
- 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-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
|
||||
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
|
||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
||||
@@ -29,11 +30,11 @@ extra-deps:
|
||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
||||
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
|
||||
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
|
||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
||||
- regex-posix-clib-2.7
|
||||
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
|
||||
@@ -41,7 +42,6 @@ extra-deps:
|
||||
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- zip-1.7.1@sha256:0ce03d0fbffba47c1ab6fbb9166f8ba5373d828d78587df21b7e9d7bb150f929,3918
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
@@ -63,3 +63,11 @@ ghc-options:
|
||||
"$locals": -O2
|
||||
streamly: -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
|
||||
|
||||
@@ -66,7 +66,7 @@ instance Arbitrary ByteString where
|
||||
---------------------
|
||||
|
||||
instance Arbitrary Scheme where
|
||||
arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ]
|
||||
arbitrary = elements [ Scheme "http", Scheme "https" ]
|
||||
|
||||
instance Arbitrary Host where
|
||||
arbitrary = genericArbitrary
|
||||
|
||||
@@ -13,4 +13,5 @@ import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
roundtripAndGoldenSpecs (Proxy @GHCupInfo)
|
||||
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName "test/golden" }) (Proxy @GHCupInfo)
|
||||
|
||||
|
||||
@@ -174,7 +174,17 @@ span.code {
|
||||
line-height: 2rem;
|
||||
}
|
||||
|
||||
#help {
|
||||
margin-bottom: 0px !important;
|
||||
}
|
||||
|
||||
#collective {
|
||||
margin-top: 1em !important;
|
||||
margin-bottom: 0px !important;
|
||||
}
|
||||
|
||||
#about {
|
||||
margin-top: 0.5em !important;
|
||||
font-size: 16px;
|
||||
line-height: 2em;
|
||||
}
|
||||
|
||||
@@ -137,9 +137,14 @@
|
||||
|
||||
</div>
|
||||
|
||||
<p>
|
||||
<p id="help">
|
||||
Need help? Ask on <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup"><img src="irc.svg" height="18px" alt="" />IRC</a>, <a href="https://discord.gg/pKYf3zDQU7"><img src="Discord-Logo-Black.svg" height="18px" alt="" />Discord</a>, <a href="https://app.element.io/#/room/#haskell-tooling:matrix.org"><img src="Matrix_logo.svg" height="25px" alt="" style="top:5px;position:relative;" /></a> or <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">report a bug <img src="Octicons-bug.svg" height="18px" alt="" /></a>.
|
||||
</p>
|
||||
<p id="collective">
|
||||
<a id="collective" href="https://opencollective.com/ghcup#category-CONTRIBUTE" target="_blank">
|
||||
<img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" width=200 />
|
||||
</a>
|
||||
</p>
|
||||
|
||||
<p id="about">
|
||||
<img src="haskell-logo.svg" alt="" />
|
||||
|
||||
Reference in New Issue
Block a user