Compare commits

..

1 Commits

Author SHA1 Message Date
14168a41fe Lala 2020-08-27 23:39:47 +02:00
55 changed files with 1269 additions and 29929 deletions

View File

@@ -1,7 +1,3 @@
stages:
- test
- release
variables:
GIT_SSL_NO_VERIFY: "1"
@@ -18,53 +14,37 @@ variables:
- x86_64-linux
variables:
OS: "LINUX"
ARCH: "64"
BIT: "64"
.alpine:64bit:
image: "alpine:3.12"
image: "alpine:edge"
tags:
- x86_64-linux
variables:
OS: "LINUX"
ARCH: "64"
BIT: "64"
.alpine:32bit:
image: "i386/alpine:3.12"
image: "i386/alpine:edge"
tags:
- x86_64-linux
variables:
OS: "LINUX"
ARCH: "32"
.linux:armv7:
image: "arm32v7/fedora"
tags:
- armv7-linux
variables:
OS: "LINUX"
ARCH: "ARM"
.linux:aarch64:
image: "arm64v8/fedora"
tags:
- aarch64-linux
variables:
OS: "LINUX"
ARCH: "ARM64"
BIT: "32"
.darwin:
tags:
- x86_64-darwin
variables:
OS: "DARWIN"
ARCH: "64"
BIT: "64"
.freebsd:
tags:
- x86_64-freebsd
variables:
OS: "FREEBSD"
ARCH: "64"
BIT: "64"
.root_cleanup:
after_script:
@@ -80,12 +60,7 @@ variables:
script:
- ./.gitlab/script/ghcup_version.sh
variables:
JSON_VERSION: "0.0.4"
artifacts:
expire_in: 2 week
paths:
- golden
when: on_failure
JSON_VERSION: "0.0.2"
.test_ghcup_version:linux:
extends:
@@ -101,20 +76,6 @@ variables:
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
.test_ghcup_version:armv7:
extends:
- .test_ghcup_version
- .linux:armv7
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
.test_ghcup_version:aarch64:
extends:
- .test_ghcup_version
- .linux:aarch64
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
.test_ghcup_version:darwin:
extends:
- .test_ghcup_version
@@ -140,114 +101,65 @@ variables:
- out
only:
- tags
variables:
JSON_VERSION: "0.0.4"
######## stack test ########
test:linux:stack:
stage: test
before_script:
- ./.gitlab/before_script/linux/install_deps_minimal.sh
script:
- ./.gitlab/script/ghcup_stack.sh
extends:
- .debian
######## bootstrap test ########
test:linux:bootstrap_script:
stage: test
before_script:
- ./.gitlab/before_script/linux/install_deps_minimal.sh
script:
- ./.gitlab/script/ghcup_bootstrap.sh
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
extends:
- .debian
######## linux test ########
test:linux:recommended:
stage: test
extends: .test_ghcup_version:linux
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.8.4"
CABAL_VERSION: "3.2.0.0"
test:linux:latest:
stage: test
extends: .test_ghcup_version:linux
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.10.2"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
######## linux 32bit test ########
test:linux:recommended:32bit:
stage: test
extends: .test_ghcup_version:linux32
variables:
GHC_VERSION: "8.10.4"
GHC_VERSION: "8.8.4"
CABAL_VERSION: "3.2.0.0"
######## arm tests ########
test:linux:recommended:armv7:
extends: .test_ghcup_version:armv7
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
when: manual
test:linux:recommended:aarch64:
extends: .test_ghcup_version:aarch64
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
when: manual
######## darwin test ########
test:mac:recommended:
stage: test
extends: .test_ghcup_version:darwin
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.8.4"
CABAL_VERSION: "3.2.0.0"
test:mac:latest:
stage: test
extends: .test_ghcup_version:darwin
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.10.2"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
######## freebsd test ########
test:freebsd:recommended:
stage: test
extends: .test_ghcup_version:freebsd
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.8.4"
CABAL_VERSION: "3.2.0.0"
test:freebsd:latest:
stage: test
extends: .test_ghcup_version:freebsd
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.10.2"
CABAL_VERSION: "3.2.0.0"
allow_failure: true
######## linux release ########
release:linux:64bit:
stage: release
needs: ["test:linux:recommended", "test:linux:latest"]
extends:
- .alpine:64bit
- .release_ghcup
@@ -255,13 +167,11 @@ release:linux:64bit:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "x86_64-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.8.4"
CABAL_VERSION: "3.2.0.0"
release:linux:32bit:
stage: release
needs: ["test:linux:recommended:32bit"]
extends:
- .alpine:32bit
- .release_ghcup
@@ -269,40 +179,13 @@ release:linux:32bit:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "i386-linux-ghcup"
GHC_VERSION: "8.10.4"
GHC_VERSION: "8.8.4"
CABAL_VERSION: "3.2.0.0"
release:linux:armv7:
stage: release
needs: ["test:linux:recommended:armv7"]
extends:
- .linux:armv7
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
variables:
ARTIFACT: "armv7-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
release:linux:aarch64:
stage: release
needs: ["test:linux:recommended:aarch64"]
extends:
- .linux:aarch64
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
variables:
ARTIFACT: "aarch64-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
######## darwin release ########
release:darwin:
stage: release
needs: ["test:mac:recommended", "test:mac:latest"]
extends:
- .darwin
- .release_ghcup
@@ -311,16 +194,14 @@ release:darwin:
- ./.gitlab/before_script/darwin/install_deps.sh
variables:
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"
MACOSX_DEPLOYMENT_TARGET: "10.7"
######## freebsd release ########
release:freebsd:
stage: release
needs: ["test:freebsd:recommended", "test:freebsd:latest"]
extends:
- .freebsd
- .release_ghcup
@@ -329,6 +210,6 @@ release:freebsd:
- ./.gitlab/before_script/freebsd/install_deps.sh
variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
GHC_VERSION: "8.8.3"
CABAL_VERSION: "3.2.0.0"

View File

@@ -9,9 +9,8 @@ mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin
chmod +x ghcup-bin
./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
exit 0

View File

@@ -11,9 +11,8 @@ 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 -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
./ghcup-bin set ${GHC_VERSION}
exit 0

View File

@@ -10,9 +10,6 @@ apk add --no-cache \
curl \
gcc \
g++ \
binutils \
binutils-gold \
bsd-compat-headers \
gmp-dev \
ncurses-dev \
libffi-dev \
@@ -21,15 +18,14 @@ apk add --no-cache \
tar \
perl
if [ "${ARCH}" = "32" ] ; then
if [ "${BIT}" = "32" ] ; then
curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin
else
curl -sSfL https://downloads.haskell.org/ghcup/x86_64-linux-ghcup > ./ghcup-bin
fi
chmod +x ghcup-bin
./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
# utils
apk add --no-cache \

View File

@@ -12,8 +12,7 @@ sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev li
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
chmod +x ghcup-bin
./ghcup-bin upgrade -i -f
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}

View File

@@ -1,64 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}"
ednf() {
case "${ARCH}" in
"ARM")
sudo dnf -y --forcearch armv7hl "$@"
;;
"ARM64")
sudo dnf -y --forcearch aarch64 "$@"
;;
*) exit 1 ;;
esac
}
ednf update
ednf install gcc gcc-c++ gmp gmp-devel make ncurses ncurses-devel xz xz-devel perl zlib zlib-devel openssl-devel openssl-libs openssl libffi libffi-devel
if [ "${ARCH}" = "ARM64" ] ; then
ednf install numactl numactl-libs numactl-devel
fi
ednf install bash wget curl git tar
ednf install llvm9.0 llvm9.0-devel llvm9.0-libs llvm9.0-static
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
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
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

View File

@@ -1,10 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}"
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget

View File

@@ -1,30 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal --store-dir="$(pwd)"/.store "$@"
}
eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always
### build
ecabal update
export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
./bootstrap-haskell
[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]

View File

@@ -16,17 +16,15 @@ git describe
ecabal update
if [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "32" ] ; then
if [ "${BIT}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar
elif [ "${ARCH}" = "64" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
else
ecabal build -w ghc-${GHC_VERSION} -ftui
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
fi
elif [ "${OS}" = "FREEBSD" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib +static" -ftui
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib static" -ftui
else
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib +static" --constraint="lzma +static" -ftui
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib static" --constraint="lzma static" -ftui
fi
mkdir out

View File

@@ -1,21 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
git describe --always
### build
curl -L -O https://get.haskellstack.org/stable/linux-x86_64.tar.gz
tar xf linux-x86_64.tar.gz
cp stack-*-linux-*/stack "$CI_PROJECT_DIR"/.local/bin/stack
chmod +x "$CI_PROJECT_DIR"/.local/bin/stack
mkdir -p "$CI_PROJECT_DIR"/.stack_root
export TAR_OPTIONS=--no-same-owner
stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root build
stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root test

View File

@@ -20,28 +20,22 @@ git describe --always
ecabal update
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION} -ftui
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
elif [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "32" ] ; then
if [ "${BIT}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ghcup-test
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
fi
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
fi
ecabal haddock -w ghc-${GHC_VERSION} -ftar
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" .
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" .
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" .
cp ./ghcup "$CI_PROJECT_DIR"/.local/bin/ghcup
cp ./ghcup-gen "$CI_PROJECT_DIR"/.local/bin/ghcup-gen
@@ -80,31 +74,19 @@ ghci-$(ghc --numeric-version) --version
# test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "LINUX" ] ; then
eghcup --downloader=wget install 8.10.3
eghcup --downloader=wget install 8.4.4
else # test wget a bit
eghcup install 8.10.3
eghcup install 8.4.4
fi
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup set 8.10.3
eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set 8.4.4
eghcup set 8.4.4
[ "$(ghc --numeric-version)" = "8.4.4" ]
eghcup set ${GHC_VERSION}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup rm 8.10.3
eghcup rm 8.4.4
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
# install hls
if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls
haskell-language-server-wrapper --version
elif [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "64" ] ; then
eghcup install hls
haskell-language-server-wrapper --version
fi
fi
eghcup rm $(ghc --numeric-version)
eghcup upgrade

View File

@@ -2,21 +2,23 @@
set -ex
## install ghc via old ghcup
mkdir -p ~/.ghcup/bin
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ~/.ghcup/bin/ghcup
curl https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > ~/.ghcup/bin/ghcup
chmod +x ~/.ghcup/bin/ghcup
export PATH="$HOME/.ghcup/bin:$PATH"
ghcup install 8.10.3
ghcup install-cabal 3.4.0.0-rc4
ghcup set 8.10.3
ghcup install 8.8.3
ghcup install-cabal 3.2.0.0
ghcup set 8.8.3
## install ghcup
cabal update
cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui
cabal build --constraint="zlib static" --constraint="lzma static" -ftui
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
strip ./ghcup
cp ghcup "./${ARTIFACT}"

View File

@@ -1,43 +1,5 @@
# Revision history for ghcup
## 0.1.13 -- 2021-02-26
* Support ARMv7/AARCH64
* Add command line completions for installed and available versions wrt [MR #70](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/70)
* Allow to cycle through set tools wrt [#114](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/114)
* Fix item selection with unavailable versions wrt [#107](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/107)
* Allow for dynamic post-install, post-remove and pre-compile msgs wrt [MR #68](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/68)
* Alert user if upgraded ghcup is shadowed by old ghcup wrt [#111](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/111)
* Fix to `ghcup` directory creation and placement for the XDG install mode ([MR #49](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/49))
* Do 755 permissions on executables, wrt #97
* Add [NO_COLOR](https://no-color.org/) support wrt [MR #47](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/47)
## 0.1.12 -- 2020-11-21
* Fix disappearing HLS symlinks wrt #91
* improve TUI:
- separators between tools sections
- reverse list order so latest is on top
- expand the blues selected bar
- show new latest versions in bright white
* allow configuration file and setting TUI hotkeys wrt #41
- see https://gitlab.haskell.org/haskell/ghcup-hs#configuration for a more in-depth explanation
* add a `--set` switch to `ghcup install ghc` to automatically set as default after install
* emit warnings when CC/LD is set wrt #82
* add support for version ranges in distro specifiers wrt #84
- e.g. `"(>= 19 && <= 20) || ==0.2.2"` is a valid version key for distro
## 0.1.11 -- 2020-09-23
* Add support for installing haskell-language-server, wrt #65
* When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51
* Allow to compile over existing version (`ghcup compile ghc -v 8.6.5 -b 8.6.5`) and replace it wrt #59
* simplify installing from custom bindist wrt #60
- `ghcup install ghc -u <url> <version>`
* fix bug when cabal isn't marked executable in bindist
* fix bug when `~/.ghcup` is a valid symlink wrt #49
* Drop support for compiling cabal from source (the old bootstrap script is discontinued)
## 0.1.10 -- 2020-08-14
* Show stray Cabals (useful for pre-releases or compiled ones)

View File

@@ -52,19 +52,8 @@ organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
Anything dealing with ghcup specific directories is in
`GHCup.Utils.Dirs`.
Download information on where to fetch bindists from is in the appropriate
yaml files: `ghcup-<yaml-ver>.yaml`.
## Common Tasks
### Adding a new GHC version
1. open the latest `ghcup-<yaml-ver>.yaml`
2. find the latest ghc version (in yaml tree e.g. `ghcupDownloads -> GHC -> 8.10.3`)
3. copy-paste it
4. adjust the version, tags, changelog, source url
5. adjust the various bindist urls (make sure to also change the yaml anchors)
6. run `cabal run exe:ghcup-gen -- check-tarballs -f ghcup-<yaml-ver>.yaml -u 'ghc-8\.10\.4'`
Download information on where to fetch bindists from is in
`GHCup.Data.GHCupDownloads`.
## Major refactors

View File

@@ -9,16 +9,11 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
## Table of Contents
* [Installation](#installation)
* [Simple bootstrap](#simple-bootstrap)
* [Manual install](#manual-install)
* [Vim integration](#vim-integration)
* [Usage](#usage)
* [Configuration](#configuration)
* [Manpages](#manpages)
* [Shell-completion](#shell-completion)
* [Cross support](#cross-support)
* [XDG support](#xdg-support)
* [Installing custom bindists](#installing-custom-bindists)
* [Design goals](#design-goals)
* [How](#how)
* [Known users](#known-users)
@@ -42,10 +37,6 @@ Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) lik
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
```
### Vim integration
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
## Usage
See `ghcup --help`.
@@ -81,13 +72,6 @@ ghcup upgrade
Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler) of `ghc` is available, which `ghcup` can do.
### 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).
Partial configuration is fine. Command line options always overwrite the config file settings.
### Manpages
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
@@ -119,26 +103,9 @@ To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIR
Then you can control the locations via XDG environment variables as such:
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir (default: `~/.local/share`)
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir (default: `~/.cache`)
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
* `XDG_CONFIG_HOME`: the config file is stored in `ghcup` subdir as `config.yaml` (default: `~/.config`)
### Installing custom bindists
There are a couple of good use cases to install custom bindists:
1. manually built bindists (e.g. with patches)
- example: `ghcup install ghc -u 'file:///home/mearwald/tmp/ghc-eff-patches/ghc-8.10.2-x86_64-deb10-linux.tar.xz' 8.10.2-eff`
2. GHC head CI bindists
- example: `ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
3. DWARF bindists
- example: `ghcup install ghc -u 'https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux-dwarf.tar.xz' 8.10.2-dwarf`
Since the version parser is pretty lax, `8.10.2-eff` and `head` are both valid versions
and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected).
## Design goals
@@ -172,17 +139,6 @@ In addition this script can also install `cabal-install`.
## Known problems
### Custom ghc version names
When installing ghc bindists with custom version names as outlined in
[installing custom bindists](#installing-custom-bindists), then cabal might
be unable to find the correct `ghc-pkg` (also see [#73](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/73))
if you use `cabal build --with-compiler=ghc-foo`. Instead, point it to the full path, such as:
`cabal build --with-compiler=$HOME/.ghcup/ghc/<version-name>/bin/ghc` or set that GHC version
as the current one via: `ghcup set ghc <version-name>`.
This problem doesn't exist for regularly installed GHC versions.
### Limited distributions supported
Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.

View File

@@ -14,7 +14,6 @@ import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import Data.Char ( toLower )
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) )
#endif
@@ -22,7 +21,6 @@ import Options.Applicative hiding ( style )
import System.Console.Pretty
import System.Exit
import System.IO ( stdout )
import Text.Regex.Posix
import Validate
import qualified Data.ByteString as B
@@ -34,7 +32,7 @@ data Options = Options
}
data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts TarballFilter
| ValidateTarballs ValidateYAMLOpts
data Input
@@ -65,22 +63,6 @@ data ValidateYAMLOpts = ValidateYAMLOpts
validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
tarballFilterP :: Parser TarballFilter
tarballFilterP = option readm $
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
<> help "Only check certain tarballs (format: <tool>-<version>)"
where
def = TarballFilter Nothing (makeRegex ("" :: String))
readm = do
s <- str
case span (/= '-') s of
(_, []) -> fail "invalid format, missing '-' after the tool name"
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
TarballFilter <$> pure (Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
_ -> fail "invalid tool"
low = fmap toLower
opts :: Parser Options
opts = Options <$> com
@@ -96,9 +78,11 @@ com = subparser
)
<> (command
"check-tarballs"
(info
((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
( ValidateTarballs
<$> (info
(validateYAMLOpts <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
)
)
)
)
@@ -116,13 +100,13 @@ main = do
B.getContents >>= valAndExit validate
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit validate
ValidateTarballs vopts tarballFilter -> case vopts of
ValidateTarballs vopts -> case vopts of
ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit (validateTarballs tarballFilter)
B.getContents >>= valAndExit validateTarballs
ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit (validateTarballs tarballFilter)
B.getContents >>= valAndExit validateTarballs
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit (validateTarballs tarballFilter)
B.readFile file >>= valAndExit validateTarballs
pure ()
where

View File

@@ -7,8 +7,8 @@ module Validate where
import GHCup
import GHCup.Download
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils.Dirs
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Version.QQ
@@ -22,7 +22,6 @@ import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.Trans.Resource ( runResourceT
, MonadUnliftIO
)
import Data.Containers.ListUtils ( nubOrd )
import Data.IORef
import Data.List
import Data.String.Interpolate
@@ -32,7 +31,6 @@ import Optics
import System.Exit
import System.IO
import Text.ParserCombinators.ReadP
import Text.Regex.Posix
import qualified Data.ByteString as B
import qualified Data.Map.Strict as M
@@ -58,7 +56,7 @@ validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m)
validate dls = do
ref <- liftIO $ newIORef 0
-- verify binary downloads --
-- * verify binary downloads * --
flip runReaderT ref $ do
-- unique tags
forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t
@@ -67,7 +65,7 @@ validate dls = do
forM_ (M.toList dls) $ \(t, versions) ->
forM_ (M.toList versions) $ \(v, vi) ->
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v (_viTags vi) arch (M.keys pspecs)
checkHasRequiredPlatforms t v arch (M.keys pspecs)
checkGHCVerIsValid
forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
@@ -81,18 +79,17 @@ validate dls = do
lift $ $(logInfo) [i|All good|]
pure ExitSuccess
where
checkHasRequiredPlatforms t v tags arch pspecs = do
checkHasRequiredPlatforms t v arch pspecs = do
let v' = prettyVer v
arch' = prettyArch arch
when (not $ any (== Linux UnknownLinux) pspecs) $ do
lift $ $(logError)
[i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|]
[i|Linux UnknownLinux missing for for #{t} #{v'} #{arch}|]
addError
when ((not $ any (== Darwin) pspecs) && arch == A_64) $ do
lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch'}|]
lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch}|]
addError
when ((not $ any (== FreeBSD) pspecs) && arch == A_64) $ lift $ $(logWarn)
[i|FreeBSD missing for #{t} #{v'} #{arch'}|]
[i|FreeBSD missing for #{t} #{v'} #{arch}|]
-- alpine needs to be set explicitly, because
-- we cannot assume that "Linux UnknownLinux" runs on Alpine
@@ -100,11 +97,8 @@ validate dls = do
when (not $ any (== Linux Alpine) pspecs) $
case t of
GHCup -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
Cabal | v > [vver|2.4.1.0|]
, arch `elem` [A_64, A_32] -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError
GHC | Latest `elem` tags || Recommended `elem` tags
, arch `elem` [A_64, A_32] -> lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
Cabal | v > [vver|2.4.1.0|] -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]
checkUniqueTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool
@@ -129,7 +123,6 @@ validate dls = do
where
isUniqueTag Latest = True
isUniqueTag Recommended = True
isUniqueTag Old = False
isUniqueTag Prerelease = False
isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False
@@ -164,11 +157,6 @@ validate dls = do
isBase (Base _) = True
isBase _ = False
data TarballFilter = TarballFilter
{ tfTool :: Maybe Tool
, tfVersion :: Regex
}
validateTarballs :: ( Monad m
, MonadLogger m
, MonadThrow m
@@ -176,20 +164,23 @@ validateTarballs :: ( Monad m
, MonadUnliftIO m
, MonadMask m
)
=> TarballFilter
-> GHCupDownloads
=> GHCupDownloads
-> m ExitCode
validateTarballs (TarballFilter tool versionRegex) dls = do
validateTarballs dls = do
ref <- liftIO $ newIORef 0
flip runReaderT ref $ do
-- download/verify all tarballs
let dlis = nubOrd $ dls ^.. each
%& indices (maybe (const True) (==) tool) %> each
%& indices (matchTest versionRegex . T.unpack . prettyVer)
% (viSourceDL % _Just `summing` viArch % each % each % each)
when (null dlis) $ $(logError) [i|no tarballs selected by filter|] *> addError
forM_ dlis $ downloadAll
-- download/verify all binary tarballs
let
dlbis = nub $ join $ (M.elems dls) <&> \versions ->
join $ (M.elems versions) <&> \vi ->
join $ (M.elems $ _viArch vi) <&> \pspecs ->
join $ (M.elems pspecs) <&> \pverspecs -> (M.elems pverspecs)
forM_ dlbis $ downloadAll
let dlsrc = nub $ join $ (M.elems dls) <&> \versions ->
join $ (M.elems versions) <&> maybe [] (: []) . _viSourceDL
forM_ dlsrc $ downloadAll
-- exit
e <- liftIO $ readIORef ref
@@ -200,13 +191,13 @@ validateTarballs (TarballFilter tool versionRegex) dls = do
pure ExitSuccess
where
runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())
}
downloadAll dli = do
dirs <- liftIO getDirs
let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings
let settings = Settings True False Never Curl False dirs defExecCb
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())
}
r <-
runLogger

View File

@@ -1,11 +1,9 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module BrickMain where
@@ -16,135 +14,106 @@ import GHCup.Types
import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude hiding ((!?))
import GHCup.Utils.Prelude
import Brick
import Brick.BChan
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Brick.Widgets.List ( listSelectedFocusedAttr
, listSelectedAttr
, listAttr
)
import Brick.Widgets.List
#if !defined(TAR)
import Codec.Archive
#endif
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception.Safe
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Bool
import Data.ByteString ( ByteString )
import Data.Functor
import Data.List
import Data.Maybe
import Data.Char
import Data.IORef
import Data.String.Interpolate
import Data.Vector ( Vector
, (!?)
)
import Data.Vector ( Vector )
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.Environment
import HPath
import HPath.IO hiding ( hideError )
import Prelude hiding ( abs, appendFile, writeFile )
import System.Exit
import System.IO.Unsafe
import System.Posix.Types
import URI.ByteString
import qualified GHCup.Types as GT
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
data SubProcess = SubProcess {
procName :: String
, exited :: Maybe (Either ProcessError ())
, procId :: Maybe ProcessID
, logLine :: Maybe ByteString
}
data BrickData = BrickData
{ lr :: [ListResult]
data AppState = AppState {
lr :: LR
, dls :: GHCupDownloads
, pfreq :: PlatformRequest
}
deriving Show
data BrickSettings = BrickSettings
{ showAll :: Bool
}
deriving Show
, mproc :: Maybe SubProcess
}
data BrickInternalState = BrickInternalState
{ clr :: Vector ListResult
, ix :: Int
}
deriving Show
data MyAppEvent = LogLine ByteString
| StartProc String
| GotProcId ProcessID
| EndProc (Either ProcessError ())
data BrickState = BrickState
{ appData :: BrickData
, appSettings :: BrickSettings
, appState :: BrickInternalState
, appKeys :: KeyBindings
}
deriving Show
type LR = GenericList String Vector ListResult
keyHandlers :: KeyBindings
-> [ ( Vty.Key
, BrickSettings -> String
, BrickState -> EventM n (Next BrickState)
)
]
keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAll
, (\BrickSettings {..} ->
if showAll then "Hide old versions" else "Show all versions"
)
, hideShowHandler
)
, (bUp, const "Up", \BrickState {..} -> continue (BrickState { appState = (moveCursor 1 appState Up), .. }))
, (bDown, const "Down", \BrickState {..} -> continue (BrickState { appState = (moveCursor 1 appState Down), .. }))
keyHandlers :: [(Char, String, AppState -> EventM n (Next AppState))]
keyHandlers =
[ ('q', "Quit" , halt)
, ('i', "Install" , withIOAction install')
, ('u', "Uninstall", withIOAction del')
, ('s', "Set" , withIOAction set')
, ('c', "ChangeLog", withIOAction changelog')
]
where
hideShowHandler (BrickState {..}) =
let newAppSettings = appSettings { showAll = not . showAll $ appSettings }
newInternalState = constructList appData newAppSettings (Just appState)
in continue (BrickState appData newAppSettings newInternalState appKeys)
showKey :: Vty.Key -> String
showKey (Vty.KChar c) = [c]
showKey (Vty.KUp) = ""
showKey (Vty.KDown) = ""
showKey key = tail (show key)
ui :: AttrMap -> BrickState -> Widget String
ui dimAttrs BrickState { appSettings = as@(BrickSettings {}), ..}
= ( padBottom Max
$ ( withBorderStyle unicode
$ borderWithLabel (str "GHCup")
$ (center $ (header <=> hBorder <=> renderList' appState))
)
)
<=> footer
ui :: AppState -> Widget String
ui AppState {..} =
case mproc of
Just _ -> logDialog
Nothing ->
( padBottom Max
$ ( withBorderStyle unicode
$ borderWithLabel (str "GHCup")
$ (center $ renderList renderItem True lr)
)
)
<=> ( withAttr "help"
. txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
. (++ ["↑↓:Navigation"])
$ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
)
where
footer =
withAttr "help"
. txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
$ (fmap (\(key, s, _) -> (showKey key <> ":" <> s as)) $ keyHandlers appKeys)
header =
(minHSize 2 $ emptyWidget)
<+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
<+> (minHSize 15 $ str "Version")
<+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
<+> (padLeft (Pad 5) $ str "Notes")
renderList' = withDefAttr listAttr . drawListElements renderItem True
renderItem _ b listResult@(ListResult {..}) =
logDialog = case mproc of
Nothing -> emptyWidget
Just (SubProcess name Nothing _ (Just logLine)) -> centerLayer . txtWrap . decUTF8Safe $ logLine
Just (SubProcess name Nothing _ (Just logLine)) -> centerLayer . txtWrap $ ""
renderItem b ListResult {..} =
let marks = if
| lSet -> (withAttr "set" $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "")
@@ -152,298 +121,154 @@ ui dimAttrs BrickState { appSettings = as@(BrickSettings {}), ..}
ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
dim
| lNoBindist && (not lInstalled)
&& (not b) -- TODO: overloading dim and active ignores active
-- so we hack around it here
= updateAttrMap (const dimAttrs) . withAttr "no-bindist"
| otherwise = id
hooray
| elem Latest lTag && not lInstalled =
withAttr "hooray"
| otherwise = id
active = if b then forceAttr "active" else id
in hooray $ active $ dim
dim = if lNoBindist
then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
else id
in dim
( marks
<+> (( padLeft (Pad 2)
$ minHSize 6
$ (printTool lTool)
)
<+> ( padLeft (Pad 2)
$ minHSize 20
$ ((if b then withAttr "active" else id)
(str $ (fmap toLower . show $ lTool) <> " " <> ver)
)
)
<+> (minHSize 15 $ (str ver))
<+> (let l = catMaybes . fmap printTag $ sort lTag
in padLeft (Pad 1) $ minHSize 25 $ if null l
then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) l
<+> (padLeft (Pad 1) $ if null lTag
then emptyWidget
else
foldr1 (\x y -> x <+> str "," <+> y)
$ (fmap printTag $ sort lTag)
)
<+> ( padLeft (Pad 5)
$ let notes = printNotes listResult
in if null notes
then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) $ notes
)
<+> (vLimit 1 $ fill ' ')
)
printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
printTag Latest = Just $ withAttr "latest" $ str "latest"
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing
printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
printTool GHC = str "GHC"
printTool GHCup = str "GHCup"
printTool HLS = str "HLS"
printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
)
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
-- | Draws the list elements.
--
-- Evaluates the underlying container up to, and a bit beyond, the
-- selected element. The exact amount depends on available height
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
-- available height.
drawListElements :: (Int -> Bool -> ListResult -> Widget String)
-> Bool
-> BrickInternalState
-> Widget String
drawListElements drawElem foc is@(BrickInternalState clr _) =
Widget Greedy Greedy $
let
es = clr
listSelected = fmap fst $ listSelectedElement' is
drawnElements = flip V.imap es $ \i' e ->
let addSeparator w = case es !? (i' - 1) of
Just e' | lTool e' /= lTool e ->
hBorder <=> w
_ -> w
isSelected = Just i' == listSelected
elemWidget = drawElem i' isSelected e
selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr
makeVisible = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible elemWidget
in render
$ viewport "GHCup" Vertical
$ vBox
$ V.toList drawnElements
printTag Recommended = withAttr "recommended" $ str "recommended"
printTag Latest = withAttr "latest" $ str "latest"
printTag Prerelease = withAttr "prerelease" $ str "prerelease"
printTag (Base pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag (UnknownTag t ) = str t
minHSize :: Int -> Widget n -> Widget n
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
app :: AttrMap -> AttrMap -> App BrickState e String
app attrs dimAttrs =
App { appDraw = \st -> [ui dimAttrs st]
, appHandleEvent = eventHandler
, appStartEvent = return
, appAttrMap = const attrs
, appChooseCursor = neverShowCursor
}
app :: App AppState MyAppEvent String
app = App { appDraw = \st -> [ui st]
, appHandleEvent = eventHandler
, appStartEvent = return
, appAttrMap = const defaultAttributes
, appChooseCursor = neverShowCursor
}
defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap
defaultAttributes :: AttrMap
defaultAttributes = attrMap
Vty.defAttr
[ ("active" , Vty.defAttr `withBackColor` Vty.blue)
, ("not-installed", Vty.defAttr `withForeColor` Vty.red)
, ("set" , Vty.defAttr `withForeColor` Vty.green)
, ("installed" , Vty.defAttr `withForeColor` Vty.green)
, ("recommended" , Vty.defAttr `withForeColor` Vty.green)
, ("hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, ("latest" , Vty.defAttr `withForeColor` Vty.yellow)
, ("prerelease" , Vty.defAttr `withForeColor` Vty.red)
, ("compiled" , Vty.defAttr `withForeColor` Vty.blue)
, ("stray" , Vty.defAttr `withForeColor` Vty.blue)
, ("help" , Vty.defAttr `withStyle` Vty.italic)
, ("hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue)
, ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red)
, ("set" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("installed" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("recommended" , Vty.defAttr `Vty.withForeColor` Vty.green)
, ("latest" , Vty.defAttr `Vty.withForeColor` Vty.yellow)
, ("prerelease" , Vty.defAttr `Vty.withForeColor` Vty.red)
, ("help" , Vty.defAttr `Vty.withStyle` Vty.italic)
]
where
withForeColor | no_color = const
| otherwise = Vty.withForeColor
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
withStyle = Vty.withStyle
dimAttributes :: Bool -> AttrMap
dimAttributes no_color = attrMap
dimAttributes :: AttrMap
dimAttributes = attrMap
(Vty.defAttr `Vty.withStyle` Vty.dim)
[ ("active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue)
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
]
where
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState)
eventHandler st@(BrickState {..}) ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef settings'
case ev of
(MouseDown _ Vty.BScrollUp _ _) ->
continue (BrickState { appState = moveCursor 1 appState Up, .. })
(MouseDown _ Vty.BScrollDown _ _) ->
continue (BrickState { appState = moveCursor 1 appState Down, .. })
(VtyEvent (Vty.EvResize _ _)) -> continue st
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
continue (BrickState { appState = (moveCursor 1 appState Up), .. })
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
continue (BrickState { appState = (moveCursor 1 appState Down), .. })
(VtyEvent (Vty.EvKey key _)) ->
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
Nothing -> continue st
Just (_, _, handler) -> handler st
_ -> continue st
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
moveCursor steps ais@(BrickInternalState {..}) direction =
let newIx = if direction == Down then ix + steps else ix - steps
in case clr !? newIx of
Just _ -> BrickInternalState { ix = newIx, .. }
Nothing -> ais
eventHandler :: AppState -> BrickEvent n MyAppEvent -> EventM n (Next AppState)
eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st
eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
continue (AppState (listMoveUp lr) dls pfreq mproc)
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
continue (AppState (listMoveDown lr) dls pfreq mproc)
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
case find (\(c', _, _) -> c' == c) keyHandlers of
Nothing -> continue as
Just (_, _, handler) -> handler as
eventHandler st (AppEvent (StartProc str')) = continue st
{ mproc = Just SubProcess { procName = str'
, exited = Nothing
, procId = Nothing
, logLine = Nothing
}
}
eventHandler st@AppState { mproc = Just sp } (AppEvent (GotProcId pid)) =
continue st { mproc = Just sp { procId = Just pid } }
eventHandler st@AppState { mproc = Just sp } (AppEvent (EndProc exited)) =
continue st { mproc = Just sp { exited = Just exited, procId = Nothing } }
eventHandler st@AppState { mproc = Just sp } (AppEvent (LogLine bs)) =
continue st { mproc = Just sp { logLine = Just bs } }
eventHandler st (AppEvent _) = error "noes" -- TODO
eventHandler st _ = continue st
-- | Suspend the current UI and run an IO action in terminal. If the
-- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (BrickState -> (Int, ListResult) -> IO (Either String a))
-> BrickState
-> EventM n (Next BrickState)
withIOAction action as = case listSelectedElement' (appState as) of
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
-> AppState
-> EventM n (Next AppState)
withIOAction action as = case listSelectedElement (lr as) of
Nothing -> continue as
Just (ix, e) -> suspendAndResume $ do
action as (ix, e) >>= \case
Left err -> putStrLn $ ("Error: " <> err)
Right _ -> putStrLn "Success"
getAppData Nothing (pfreq . appData $ as) >>= \case
Right data' -> do
putStrLn "Press enter to continue"
_ <- getLine
pure (updateList data' as)
Left err -> throwIO $ userError err
Just (ix, e) -> do
liftIO $ forkIO $ void $ action as (ix, e)
continue as
-- apps <- (fmap . fmap)
-- (\AppState {..} -> AppState { lr = listMoveTo ix lr, .. })
-- $ getAppState Nothing (pfreq as)
-- case apps of
-- Right nas -> do
-- putStrLn "Press enter to continue"
-- _ <- getLine
-- pure nas
-- Left err -> throwIO $ userError err
-- | Update app data and list internal state based on new evidence.
-- This synchronises @BrickInternalState@ with @BrickData@
-- and @BrickSettings@.
updateList :: BrickData -> BrickState -> BrickState
updateList appD (BrickState {..}) =
let newInternalState = constructList appD appSettings (Just appState)
in BrickState { appState = newInternalState
, appData = appD
, appSettings = appSettings
, appKeys = appKeys
}
constructList :: BrickData
-> BrickSettings
-> Maybe BrickInternalState
-> BrickInternalState
constructList appD appSettings mapp =
replaceLR (filterVisible (showAll appSettings)) (lr appD) mapp
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
listSelectedElement' (BrickInternalState {..}) = fmap (ix, ) $ clr !? ix
selectLatest :: Vector ListResult -> Int
selectLatest v =
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
Just ix -> ix
Nothing -> 0
-- | Replace the @appState@ or construct it based on a filter function
-- and a new @[ListResult]@ evidence.
-- When passed an existing @appState@, tries to keep the selected element.
replaceLR :: (ListResult -> Bool)
-> [ListResult]
-> Maybe BrickInternalState
-> BrickInternalState
replaceLR filterF lr s =
let oldElem = s >>= listSelectedElement'
newVec = V.fromList . filter filterF $ lr
newSelected =
case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
Just ix -> ix
Nothing -> selectLatest newVec
in BrickInternalState newVec newSelected
where
toolEqual e1 e2 =
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
filterVisible :: Bool -> ListResult -> Bool
filterVisible showAll e | lInstalled e = True
| showAll = True
| otherwise = not (elem Old (lTag e))
install' :: BrickState -> (Int, ListResult) -> IO (Either String ())
install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
install' :: AppState -> (Int, ListResult) -> IO (Either String ())
install' AppState {..} (_, ListResult {..}) = do
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
let run =
runLogger
. flip runReaderT settings
. runResourceT
. runE
@'[ AlreadyInstalled
let
run =
runLogger
. flip runReaderT settings
. runResourceT
. runE
@'[AlreadyInstalled
, UnknownArchive
#if !defined(TAR)
, ArchiveResult
, ArchiveResult
#endif
, UnknownArchive
, FileDoesNotExistError
, CopyError
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, DownloadFailed
, NoUpdate
, TarDirDoesNotExist
, VerNotFound
]
, FileDoesNotExistError
, CopyError
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, DownloadFailed
, NoUpdate
, TarDirDoesNotExist
]
(run $ do
case lTool of
GHC -> do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer GHC dls
?? VerNotFound lVer GHC
liftE $ installGHCBin dls lVer pfreq $> vi
Cabal -> do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer Cabal dls
?? VerNotFound lVer Cabal
liftE $ installCabalBin dls lVer pfreq $> vi
GHCup -> do
let vi = fromJust $ snd <$> getLatest dls GHCup
liftE $ upgradeGHCup dls Nothing False pfreq $> vi
HLS -> do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer HLS dls
?? VerNotFound lVer HLS
liftE $ installHLSBin dls lVer pfreq $> vi
GHC -> liftE $ installGHCBin dls lVer pfreq
Cabal -> liftE $ installCabalBin dls lVer pfreq
GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> ()
)
>>= \case
VRight vi -> do
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure $ Right ()
VRight _ -> pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V (BuildFailed _ e)) ->
pure $ Left [i|Build failed with #{e}|]
@@ -454,7 +279,7 @@ install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
Also check the logs in ~/.ghcup/logs|]
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
set' :: AppState -> (Int, ListResult) -> IO (Either String ())
set' _ (_, ListResult {..}) = do
settings <- readIORef settings'
l <- readIORef logger'
@@ -463,13 +288,12 @@ set' _ (_, ListResult {..}) = do
let run =
runLogger
. flip runReaderT settings
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
. runE @'[FileDoesNotExistError, NotInstalled, TagNotFound]
(run $ do
case lTool of
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
Cabal -> liftE $ setCabal lVer $> ()
HLS -> liftE $ setHLS lVer $> ()
GHCup -> pure ()
)
>>= \case
@@ -477,62 +301,57 @@ set' _ (_, ListResult {..}) = do
VLeft e -> pure $ Left [i|#{e}|]
del' :: BrickState -> (Int, ListResult) -> IO (Either String ())
del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
del' :: AppState -> (Int, ListResult) -> IO (Either String ())
del' _ (_, ListResult {..}) = do
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
let run = runLogger . flip runReaderT settings . runE @'[NotInstalled, VerNotFound]
let run = runLogger . flip runReaderT settings . runE @'[NotInstalled]
(run $ do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer lTool dls
?? VerNotFound lVer lTool
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> Just vi
Cabal -> liftE $ rmCabalVer lVer $> Just vi
HLS -> liftE $ rmHLSVer lVer $> Just vi
GHCup -> pure Nothing
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> ()
Cabal -> liftE $ rmCabalVer lVer $> ()
GHCup -> pure ()
)
>>= \case
VRight (Just vi) -> do
forM_ (_viPostRemove vi) $ \msg ->
runLogger $ $(logInfo) msg
pure $ Right ()
VRight _ -> pure $ Right ()
VLeft e -> pure $ Left [i|#{e}|]
changelog' :: BrickState -> (Int, ListResult) -> IO (Either String ())
changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
changelog' AppState {..} (_, ListResult {..}) = do
case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
Just uri -> do
let cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
Right _ -> pure $ Right ()
Left e -> pure $ Left [i|#{e}|]
settings' :: IORef AppState
uri' :: IORef (Maybe URI)
{-# NOINLINE uri' #-}
uri' = unsafePerformIO (newIORef Nothing)
settings' :: IORef Settings
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
dirs <- getDirs
newIORef $ AppState (Settings { cache = True
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, ..
})
dirs
defaultKeyBindings
newIORef Settings { cache = True
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, execCb = (\_ _ _ _ _ -> liftIO $ writeFile [abs|/home/jule/git/ghcup-hs/cb.log|] Nothing "settings'")
, ..
}
logger' :: IORef LoggerConfig
@@ -545,42 +364,38 @@ logger' = unsafePerformIO
)
brickMain :: AppState
-> LoggerConfig
-> GHCupDownloads
-> PlatformRequest
-> IO ()
brickMain s l av pfreq' = do
writeIORef settings' s
brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO ()
brickMain _ muri _ av pfreq' = do
writeIORef uri' muri
s <- readIORef settings'
-- logger interpreter
writeIORef logger' l
-- writeIORef logger' l
l <- readIORef logger'
let runLogger = myLoggerT l
no_color <- isJust <$> lookupEnv "NO_COLOR"
eAppData <- getAppData (Just av) pfreq'
case eAppData of
Right ad ->
defaultMain
(app (defaultAttributes no_color) (dimAttributes no_color))
(BrickState ad
defaultAppSettings
(constructList ad defaultAppSettings Nothing)
(keyBindings s)
)
$> ()
Left e -> do
eApps <- getAppState (Just av) pfreq'
case eApps of
Right as -> do
eventChan <- newBChan 1000
let builder = Vty.mkVty Vty.defaultConfig
initialVty <- builder
writeIORef settings' s{ execCb = brickExecCb eventChan }
customMain initialVty builder (Just eventChan) app (selectLatest as) $> ()
Left e -> do
runLogger ($(logError) [i|Error building app state: #{show e}|])
exitWith $ ExitFailure 2
where
selectLatest :: AppState -> AppState
selectLatest AppState {..} =
(\ix -> AppState { lr = listMoveTo ix lr, .. })
. fromJust
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
$ (listElements lr)
defaultAppSettings :: BrickSettings
defaultAppSettings = BrickSettings { showAll = False }
getDownloads' :: IO (Either String GHCupDownloads)
getDownloads' = do
getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState)
getAppState mg pfreq' = do
muri <- readIORef uri'
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
@@ -588,30 +403,31 @@ getDownloads' = do
r <-
runLogger
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
$ fmap _ghcupDownloads
$ liftE
$ getDownloadsF (urlSource . GT.settings $ settings)
. runE
@'[JSONError, DownloadFailed, FileDoesNotExistError]
$ do
dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg
lV <- lift $ listVersions dls Nothing Nothing pfreq'
pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls pfreq' Nothing)
case r of
VRight a -> pure $ Right a
VLeft e -> pure $ Left [i|#{e}|]
getAppData :: Maybe GHCupDownloads
-> PlatformRequest
-> IO (Either String BrickData)
getAppData mg pfreq' = do
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
brickExecCb :: BChan MyAppEvent -> ExecCb
brickExecCb chan _ fileFd stdoutRead pState lfile = do
liftIO $ writeFile [abs|/home/jule/git/ghcup-hs/cb.log|] Nothing "brickExecCb"
writeBChan chan (StartProc . T.unpack . decUTF8Safe $ lfile)
readLineTilEOF lineAction stdoutRead
takeMVar pState >>= \case
PExited e@(Left _) -> writeBChan chan (EndProc e)
_ -> error "no"
where
lineAction bs = do
void $ SPIB.fdWrite fileFd (bs <> "\n")
error "blah"
writeBChan chan (LogLine bs)
r <- maybe getDownloads' (pure . Right) mg
runLogger . flip runReaderT settings $ do
case r of
Right dls -> do
lV <- listVersions dls Nothing Nothing pfreq'
pure $ Right $ (BrickData (reverse lV) dls pfreq')
Left e -> pure $ Left [i|#{e}|]

File diff suppressed because it is too large Load Diff

View File

@@ -1,16 +1,5 @@
#!/bin/sh
# Main settings:
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
# * 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
# * BOOTSTRAP_HASKELL_CABAL_VERSION
# License: LGPL-3.0
# safety subshell to avoid executing anything in case this script is not downloaded properly
(
@@ -19,7 +8,7 @@
export GHCUP_USE_XDG_DIRS
if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local}/ghcup
GHCUP_BIN=${XDG_BIN_HOME:=$HOME/.local/bin}
else
GHCUP_DIR=${GHCUP_INSTALL_BASE_PREFIX}/.ghcup
@@ -34,7 +23,8 @@ die() {
exit 2
}
edo() {
edo()
{
"$@" || die "\"$*\" failed!"
}
@@ -69,7 +59,7 @@ _done() {
download_ghcup() {
_plat="$(uname -s)"
_arch=$(uname -m)
_ghver="0.1.12"
_ghver="0.1.10"
_base_url="https://downloads.haskell.org/~ghcup"
case "${_plat}" in
@@ -124,7 +114,6 @@ download_ghcup() {
edo chmod +x "${GHCUP_BIN}"/ghcup
edo mkdir -p "${GHCUP_DIR}"
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
EOF
@@ -199,30 +188,7 @@ printf "\\033[0;35m%s\\033[0m\\n" ""
printf "\\033[0;35m%s\\033[0m\\n" "Installation done!"
printf "\\033[0;35m%s\\033[0m\\n" ""
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
printf "\\033[0;35m%s\\033[0m\\n" "Do you want to install haskell-language-server (HLS) now?"
printf "\\033[0;35m%s\\033[0m\\n" "HLS is a language-server that provides IDE-like functionality"
printf "\\033[0;35m%s\\033[0m\\n" "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
printf "\\033[0;35m%s\\033[0m\\n" "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
printf "\\033[0;35m%s\\033[0m\\n" ""
printf "\\033[0;35m%s\\033[0m\\n" "Answer with YES or NO and press ENTER."
printf "\\033[0;35m%s\\033[0m\\n" ""
while true; do
read -r hls_answer </dev/tty
case $hls_answer in
[Yy]*)
eghcup --cache install hls
break ;;
[Nn]*)
break ;;
*)
echo "Please type YES or NO and press enter.";;
esac
done
echo "In order to run ghc and cabal, you need to adjust your PATH variable."
echo "You may want to source '$GHCUP_DIR/env' in your shell"
echo "configuration to do so (e.g. ~/.bashrc)."
@@ -269,23 +235,10 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
echo "# ghcup-env" >> "${GHCUP_PROFILE_FILE}"
echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME" >> "${GHCUP_PROFILE_FILE}"
echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH" >> "${GHCUP_PROFILE_FILE}"
echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN/bin \$PATH" >> "${GHCUP_PROFILE_FILE}"
fi
break ;;
bash)
if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
fi
case "$(uname -s)" in
"Darwin"|"darwin")
if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
fi
;;
esac
break ;;
zsh)
*)
if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
fi

View File

@@ -1,38 +0,0 @@
with-compiler: ghc-8.10.3
packages: ./ghcup.cabal
optional-packages: ./3rdparty/*/*.cabal
source-repository-package
type: git
location: https://github.com/haskus/packages.git
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdir: haskus-utils-types
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-io
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory
optimization: 2
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell

View File

@@ -1,261 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0,
any.HUnit ==1.6.2.0,
any.IfElse ==0.85,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.1,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==1.5.5.1,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only,
any.alex ==3.2.6,
alex +small_base,
any.ansi-terminal ==0.11,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.ascii-string ==1.0.1.4,
any.assoc ==1.0.2,
any.async ==2.2.2,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.4,
attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.14.1.0,
any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2,
any.base-orphans ==0.8.4,
any.base16-bytestring ==1.0.1.0,
any.base64-bytestring ==1.2.0.1,
any.bifunctors ==5.5.10,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1,
any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.7,
c2hs +base3 -regression,
any.call-stack ==0.3.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.20,
cmdargs +quotation -testprog,
any.colour ==2.3.5,
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,
any.conduit-extra ==1.3.5,
any.containers ==0.6.2.1,
any.contravariant ==1.5.3,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha256 ==0.11.102.0,
cryptohash-sha256 -exe +use-cbits,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.0,
any.deepseq ==1.4.4.0,
any.deferred-folds ==0.9.15,
any.directory ==1.3.6.0,
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.fast-logger ==3.0.2,
any.filepath ==1.4.2.1,
any.focus ==1.0.2,
any.foldl ==1.4.10,
any.free ==5.1.6,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.0,
any.ghc-boot-th ==8.10.3,
any.ghc-prim ==0.6.1,
ghcup -internal-downloader -tar -tui,
any.happy ==1.20.0,
any.hashable ==1.3.0.0,
hashable -examples +integer-gmp +sse2 -sse41,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.5,
any.haskus-utils-data ==1.3,
any.haskus-utils-types ==1.5,
any.haskus-utils-variant ==3.0,
any.heaps ==0.3.6.1,
any.hpath ==0.11.0,
any.hpath-directory ==0.14.1,
any.hpath-filepath ==0.10.4,
any.hpath-io ==0.14.1,
any.hpath-posix ==0.13.2,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.8,
any.hspec-core ==2.7.8,
any.hspec-discover ==2.7.8,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.7.0.0,
any.indexed-profunctors ==0.1,
any.indexed-traversable ==0.1.1,
any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.8.3,
language-c -allwarnings +iecfpextension +separatesyb +usebytestrings,
any.libarchive ==3.0.2.1,
libarchive -cross -low-memory -system-libarchive,
any.libyaml ==0.1.2,
libyaml -no-unicode -system-libyaml,
any.lifted-base ==0.2.3.12,
any.list-t ==1.0.4,
any.lockfree-queue ==0.2.3.1,
lzma -static,
any.math-functions ==0.3.4.1,
math-functions +system-erf +system-expm1,
any.megaparsec ==9.0.1,
megaparsec -dev,
any.microlens ==0.4.11.2,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.9,
any.mmorph ==1.1.4,
any.monad-control ==1.0.2.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.mwc-random ==0.15.0.1,
any.network ==3.1.2.1,
network -devel,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.optics ==0.3,
any.optics-core ==0.3.0.1,
any.optics-extra ==0.3,
any.optics-th ==0.3.0.2,
any.optics-vl ==0.2.1,
any.optparse-applicative ==0.16.1.0,
optparse-applicative +process,
any.os-release ==1.0.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.2.1,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.0.1,
any.primitive-extras ==0.8,
any.primitive-unlifted ==0.1.3.0,
any.process ==1.6.9.0,
any.profunctors ==5.6.1,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.0,
any.recursion-schemes ==5.2.1,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.0,
any.regex-posix ==0.96.0.0,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2,
any.rts ==1.0,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.1,
any.scientific ==0.3.6.2,
scientific -bytestring-builder -integer-simple,
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.streamly ==0.7.2,
streamly -debug -dev -examples -examples-sdl -fusion-plugin -has-llvm -inspection -no-fusion -streamk,
any.streamly-bytestring ==0.1.2,
any.streamly-posix ==0.1.0.1,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.0.2,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tasty ==1.3.1,
tasty +clock,
any.tasty-hunit ==0.10.0.3,
any.tasty-quickcheck ==0.10.1.2,
any.template-haskell ==2.16.0.0,
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-short ==0.1.3,
text-short -asserts,
any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1,
any.th-expand-syns ==0.4.6.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.5,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances,
any.transformers-compat ==0.6.6,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unbounded-delays ==0.1.1.1,
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.13.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.0,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.3,
any.vector ==0.12.2.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.4,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.versions ==4.0.2,
any.vty ==5.32,
any.wcwidth ==0.0.2,
wcwidth -cli +split-base,
any.word8 ==0.1.3,
any.yaml ==0.11.5.0,
yaml +no-examples +no-exe,
zlib -non-blocking-ffi -pkg-config -static
index-state: hackage.haskell.org 2021-02-04T20:08:20Z

View File

@@ -1,47 +0,0 @@
-- Generated by stackage-to-hackage
index-state: 2020-10-24T20:53:55Z
with-compiler: ghc-8.8.4
packages:
./
, 3rdparty/lzma/
, 3rdparty/lzma-clib/
, 3rdparty/zlib/
source-repository-package
type: git
location: https://github.com/haskus/packages.git
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdir: haskus-utils-types
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory
hpath-io
source-repository-package
type: git
location: https://github.com/hasufell/text-conversions.git
tag: 9abf0e5e5664a3178367597c32db19880477a53c
allow-older: *
allow-newer: *
package lzma
ghc-options: -O2
package lzma-clib
ghc-options: -O2
package zlib
ghc-options: -O2
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

File diff suppressed because it is too large Load Diff

View File

@@ -8,23 +8,6 @@ source-repository-package
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdir: haskus-utils-types
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-io
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory
source-repository-package
type: git
location: https://github.com/hasufell/streamly.git
tag: f921e78236c6b44a6673b5e1a1803d2e7102d806
optimization: 2
package streamly
@@ -36,6 +19,6 @@ package ghcup
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
flags: +static
allow-newer: base, ghc-prim, template-haskell

View File

@@ -1,61 +0,0 @@
# Cache downloads in ~/.ghcup/cache
cache: False
# Skip tarball checksum verification
no-verify: False
# enable verbosity
verbose: False
# When to keep build directories
keep-dirs: Errors # Always | Never | Errors
# Which downloader to use
downloader: Curl # Curl | Wget | Internal
# TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values.
key-bindings:
up:
KUp: []
down:
KDown: []
quit:
KChar: 'q'
install:
KChar: 'i'
uninstall:
KChar: 'u'
set:
KChar: 's'
changelog:
KChar: 'c'
show-all:
KChar: 'a'
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
url-source:
## Use the internal download uri, this is the default
GHCupURL: []
## Example 1: Read download info from this location instead
## Accepts file/http/https scheme
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
# AddSource:
# Left:
# toolRequirements: {} # this is ignored
# ghcupDownloads:
# GHC:
# 9.10.2:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
# dlSubdir: ghc-7.10.3
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
# AddSource:
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

View File

@@ -1117,6 +1117,7 @@ ghcupDownloads:
unknown_versioning: *ghc-8101-32-deb9
8.10.2:
viTags:
- Latest
- base-4.14.1.0
viChangeLog: https://downloads.haskell.org/~ghc/8.10.2/docs/html/users_guide/8.10.2-notes.html
viSourceDL:
@@ -1158,7 +1159,7 @@ ghcupDownloads:
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-8.10.2-x86_64-unknown-linux
dlSubdir: ghc-8.10.2
dlHash: 14d09a508f2a3a11875c140be8e6c5f6982ac5cd448f089ca10b7adc955fec76
Linux_AmazonLinux:
unknown_versioning: *ghc-8102-64-centos
@@ -1192,83 +1193,14 @@ ghcupDownloads:
dlUri: https://files.hasufell.de/ghc/ghc-8.10.2-i386-alpine-linux.tar.xz
dlSubdir: ghc-8.10.2
dlHash: 9ee1cf1e85e9536088b3c9e80e975074e525ea378cd4eb156071bbc4b7b38327
8.10.3:
viTags:
- Latest
- base-4.14.1.0
viChangeLog: https://downloads.haskell.org/~ghc/8.10.3/docs/html/users_guide/8.10.3-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-src.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 9c573a4621a78723950617c223559bdc325ea6a3409264aedf68f05510b0880b
viArch:
A_64:
Linux_Debian:
'9': &ghc-8103-64-deb9
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-deb9-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 95e4aadea30701fe5ab84d15f757926d843ded7115e11c4cd827809ca830718d
'10': &ghc-8103-64-deb10
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-deb10-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: c8f3d9f0e61a89eaba1d3ad8fb2eced1af0e81576811261b887993bee12538ac
unknown_versioning: *ghc-8103-64-deb9
Linux_Ubuntu:
unknown_versioning: &ghc-8103-64-fedora
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-fedora27-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: f8739b12008712d6b6a9ffc6c39f9d05af77ef3bcb932c9aff20fa0893c8c159
'16.04': *ghc-8103-64-deb9
'18.04': *ghc-8103-64-deb9
Linux_Mint:
unknown_versioning: *ghc-8103-64-deb10
Linux_Fedora:
'27': *ghc-8103-64-fedora
unknown_versioning: *ghc-8103-64-fedora
Linux_CentOS:
'7': &ghc-8103-64-centos
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-centos7-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: f562ca61979ff1d21e34e69e59028cb742a8eff8d84e46bbd3a750f2ac7d8ed1
unknown_versioning: *ghc-8103-64-centos
Linux_RedHat:
unknown_versioning: *ghc-8103-64-centos
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-8.10.3-x86_64-unknown-linux
dlHash: 8506c478ebbfb5441c3c36c07c36fc8532cacb2b3e13c6733bd44cb17b3ce96c
Linux_AmazonLinux:
unknown_versioning: *ghc-8103-64-centos
Linux_UnknownLinux:
unknown_versioning: *ghc-8103-64-fedora
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-apple-darwin.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 2635f35d76e44e69afdfd37cae89d211975cc20f71f784363b72003e59f22015
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-portbld-freebsd.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 749007e995104db05cf6e3ad5bc36238cab8afac8055145661e5730e8f8af040
A_32:
Linux_Debian:
'9': &ghc-8103-32-deb9
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-i386-deb9-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: f0addd2a16b705f58ff9e8702c3ddf3e2d6bd0d3555707b5b5095e51bafee7b1
unknown_versioning: *ghc-8103-32-deb9
Linux_Ubuntu:
unknown_versioning: *ghc-8103-32-deb9
Linux_Mint:
unknown_versioning: *ghc-8103-32-deb9
Linux_UnknownLinux:
unknown_versioning: *ghc-8103-32-deb9
Cabal:
2.4.1.0:
viTags: []
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog
viSourceDL:
dlUri: https://github.com/haskell/cabal/archive/cabal-install-v2.4.1.0.tar.gz
dlSubdir: cabal-cabal-install-v2.4.1.0/cabal-install
dlHash: 61eb64a5addafca026aff9277291f4643fe07e83886f76d059d42c734fed829c
viArch:
A_64:
Linux_Alpine:
@@ -1300,6 +1232,10 @@ ghcupDownloads:
3.0.0.0:
viTags: []
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog
viSourceDL:
dlUri: https://github.com/haskell/cabal/archive/cabal-install-v3.0.0.0.tar.gz
dlSubdir: cabal-cabal-install-v3.0.0.0/cabal-install
dlHash: c0b26817a7b7c2907e45cb38235ce1157e732211880f62e92eaff4066202e674
viArch:
A_64:
Linux_Alpine:
@@ -1332,6 +1268,10 @@ ghcupDownloads:
- Recommended
- Latest
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog
viSourceDL:
dlUri: https://github.com/haskell/cabal/archive/cabal-install-v3.2.0.0.tar.gz
dlSubdir: cabal-cabal-install-v3.2.0.0/cabal-install
dlHash: 77202358bdf0b481c09326268ce18880df14194c5aaa840f99510bdd1a124b75
viArch:
A_64:
Linux_Alpine:
@@ -1359,32 +1299,31 @@ ghcupDownloads:
unknown_versioning:
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz
dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93
3.4.0.0-rc4:
3.4.0.0-rc1:
viTags:
- Prerelease
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
viArch:
A_64:
Linux_Ubuntu:
unknown_versioning: &cabal-3400rc4-ubuntu
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz
dlHash: a1be168876816a624b206c55596d9bb5f442541c889ee2438d664698122b9ffe
unknown_versioning: &cabal-3400rc1-ubuntu
dlUri: http://oleg.fi/cabal-install-3.4.0.0-rc1/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz
dlHash: 4a693eeacf91993d639b0296a366af7aec6899992352595835f7671e5adef4c6
Linux_Alpine:
unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-alpine-3.11.6-static-noofd.tar.xz
dlHash: 49dab6684483594e4c7c3e561ec477268002605253ad34701b471277efbe91bc
dlUri: http://oleg.fi/cabal-install-3.4.0.0-rc1/cabal-install-3.4.0.0-x86_64-alpine-3.11.6-static-noofd.tar.xz
dlHash: 143160e1768c9c21bad613f720a37aad34051f41fb3473f5f28c030f9ccb7aca
Linux_UnknownLinux:
unknown_versioning: *cabal-3400rc4-ubuntu
unknown_versioning: *cabal-3400rc1-ubuntu
Darwin:
unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-darwin-sierra.tar.xz
dlHash: a3f809a3388e90b9fdf52444e30ea9aad3894e2cbe53c37fc3311ceb106eda9e
dlUri: http://oleg.fi/cabal-install-3.4.0.0-rc1/cabal-install-3.4.0.0-x86_64-darwin-sierra.tar.xz
dlHash: 98e362a57c3b5c1a76f75ede2c2a7c29439902a3e21c3e4f8dcd701e276b164f
FreeBSD:
unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
dlUri: http://oleg.fi/cabal-install-3.4.0.0-rc1/cabal-install-3.4.0.0-amd64-freebsd-12.1-release.tar.xz
dlHash: 0035cc5d35db15d254037a9448697e1daff0a6d21b12c8d43d72522c82cc7319
GHCup:
0.1.11:
0.1.10:
viTags:
- Recommended
- Latest
@@ -1394,22 +1333,22 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-linux-ghcup-0.1.11
dlHash: 99d97c9a1dce76892001e5cffd50cc23bf804f2282998c546d1b965aa2179699
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-linux-ghcup-0.1.10
dlHash: 87661bd127f857b990174ac8d96ad4bd629865306b2058c8cc64d3b36ed317c9
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-apple-darwin-ghcup-0.1.11
dlHash: 4b91dcd9bfdc40534156b8fadea3f317b3c44af1255169895f4911a221f819c6
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-apple-darwin-ghcup-0.1.10
dlHash: e71666fde6a7700f307e1a55720859d3a042fe27c68ff32f3d1181f4436b7391
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-portbld-freebsd-ghcup-0.1.11
dlHash: 6f04ce98d3f3eb9299ce74f8264aa956f0dc38a64a3bd12ee048b7f146e9e1b4
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-portbld-freebsd-ghcup-0.1.10
dlHash: b5ef1b0454f1a9c5a62b378c1e9c48c2b794d64a22086adf482b064dfb34e68d
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/i386-linux-ghcup-0.1.11
dlHash: ec339e4c2b8b4d502f66a03c0d3f112cb68cd922dd3c4a6f66323628cf6a76c2
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/i386-linux-ghcup-0.1.10
dlHash: 50ac43199b64bc0724400b0a3db674bef3ec53cf6d41acc04a2c4ca8557e534f
Linux_Alpine:
unknown_versioning: *ghcup-32

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
version: 0.1.13
version: 0.1.10
synopsis: ghc toolchain installer as an exe/library
description:
A rewrite of the shell script ghcup, for providing
@@ -15,7 +15,7 @@ maintainer: hasufell@posteo.de
copyright: Julian Ospald 2020
category: System
build-type: Simple
extra-doc-files: CHANGELOG.md
extra-source-files: CHANGELOG.md
source-repository head
type: git
@@ -72,9 +72,6 @@ common bz2
common case-insensitive
build-depends: case-insensitive >=1.2.1.0
common casing
build-depends: casing >=0.1.4.1
common concurrent-output
build-depends: concurrent-output >=1.10.11
@@ -84,9 +81,6 @@ common containers
common cryptohash-sha256
build-depends: cryptohash-sha256 >= 0.11.101.0
common generic-arbitrary
build-depends: generic-arbitrary >=0.1.0
common generics-sop
build-depends: generics-sop >=0.5
@@ -100,13 +94,13 @@ common hpath
build-depends: hpath >=0.11
common hpath-directory
build-depends: hpath-directory >=0.14.1
build-depends: hpath-directory >=0.14
common hpath-filepath
build-depends: hpath-filepath >=0.10.3
common hpath-io
build-depends: hpath-io >=0.14.1
build-depends: hpath-io >=0.14
common hpath-posix
build-depends: hpath-posix >=0.13.2
@@ -114,17 +108,11 @@ common hpath-posix
common http-io-streams
build-depends: http-io-streams >=0.1.2.0
common hspec
build-depends: hspec >=2.7.4
common hspec-golden-aeson
build-depends: hspec-golden-aeson >=0.7
common io-streams
build-depends: io-streams >=1.5
common libarchive
build-depends: libarchive >= 3.0.0.0
build-depends: libarchive >= 2.2.5.0
common lzma
build-depends: lzma >=0.0.0.3
@@ -183,6 +171,9 @@ common strict-base
common string-interpolate
build-depends: string-interpolate >=0.2.0.0
common table-layout
build-depends: table-layout >=0.8
common template-haskell
build-depends: template-haskell >=2.7
@@ -204,12 +195,6 @@ common transformers
common os-release
build-depends: os-release >=1.0.0
common QuickCheck
build-depends: QuickCheck >=2.14.1
common quickcheck-arbitrary-adt
build-depends: quickcheck-arbitrary-adt >=0.3.1.0
common unix
build-depends: unix >=2.7
@@ -229,7 +214,7 @@ common vector
build-depends: vector >=0.12
common versions
build-depends: versions >=4.0.1
build-depends: versions >=3.5
common vty
build-depends: vty >=5.28.2
@@ -255,6 +240,8 @@ common config
PackageImports
RecordWildCards
ScopedTypeVariables
Strict
StrictData
TupleSections
library
@@ -269,7 +256,6 @@ library
, bytestring
, bz2
, case-insensitive
, casing
, concurrent-output
, containers
, cryptohash-sha256
@@ -311,7 +297,6 @@ library
, utf8-string
, vector
, versions
, vty
, word8
, yaml
, zlib
@@ -336,13 +321,7 @@ library
GHCup.Utils.Version.QQ
GHCup.Version
other-modules:
Paths_ghcup
default-extensions:
Strict
StrictData
-- other-modules:
-- other-extensions:
hs-source-dirs: lib
@@ -382,8 +361,10 @@ executable ghcup
, safe
, safe-exceptions
, string-interpolate
, table-layout
, template-haskell
, text
, unix-bytestring
, uri-bytestring
, utf8-string
, versions
@@ -397,10 +378,6 @@ executable ghcup
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
Strict
StrictData
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
@@ -433,10 +410,10 @@ executable ghcup-gen
, optics
, optparse-applicative
, pretty-terminal
, regex-posix
, resourcet
, safe-exceptions
, string-interpolate
, table-layout
, text
, transformers
, uri-bytestring
@@ -455,25 +432,8 @@ executable ghcup-gen
default-language: Haskell2010
test-suite ghcup-test
import:
config
, base
, bytestring
, containers
, QuickCheck
, generic-arbitrary
, hpath
, hspec
, hspec-golden-aeson
, quickcheck-arbitrary-adt
, text
, uri-bytestring
, versions
default-language: Haskell2010
type: exitcode-stdio-1.0
build-depends: ghcup
hs-source-dirs: test
main-is: Main.hs
other-modules:
GHCup.ArbitraryTypes
GHCup.Types.JSONSpec
Spec
main-is: MyLibTest.hs
build-depends: base >=4.12.0.0

File diff suppressed because it is too large Load Diff

View File

@@ -1,19 +1,4 @@
cradle:
cabal:
- path: "./lib"
component: "lib:ghcup"
- path: "./app/ghcup/Main.hs"
component: "ghcup:exe:ghcup"
- path: "./app/ghcup/BrickMain.hs"
component: "ghcup:exe:ghcup"
- path: "./app/ghcup-gen/Main.hs"
component: "ghcup:exe:ghcup-gen"
- path: "./app/ghcup-gen/Validate.hs"
component: "ghcup:exe:ghcup-gen"
- path: "./test"
component: "ghcup:test:ghcup-test"
- path: "."
component: "ghcup:lib:ghcup"

File diff suppressed because it is too large Load Diff

View File

@@ -57,7 +57,6 @@ import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI )
#endif
import Data.List ( find )
import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
@@ -84,9 +83,9 @@ import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M
#if defined(INTERNAL_DOWNLOADER)
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as M
import qualified Data.Text as T
#endif
import qualified Data.Text.Encoding as E
@@ -105,8 +104,8 @@ import qualified System.Posix.RawFilePath.Directory
------------------
-- | Downloads the download information! But only if we need to ;P
-- | Like 'getDownloads', but tries to fall back to
-- cached ~/.ghcup/cache/ghcup-<format-ver>.yaml
getDownloadsF :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
@@ -115,7 +114,7 @@ getDownloadsF :: ( FromJSONKey Tool
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
, MonadReader Settings m
)
=> URLSource
-> Excepts
@@ -124,58 +123,54 @@ getDownloadsF :: ( FromJSONKey Tool
GHCupInfo
getDownloadsF urlSource = do
case urlSource of
GHCupURL -> liftE getBase
GHCupURL ->
liftE
$ handleIO (\_ -> readFromCache)
$ catchE @_ @'[JSONError , FileDoesNotExistError]
(\(DownloadFailed _) -> readFromCache)
$ getDownloads urlSource
(OwnSource _) -> liftE $ getDownloads urlSource
(OwnSpec _) -> liftE $ getDownloads urlSource
where
readFromCache = do
Settings {dirs = Dirs {..}} <- lift ask
lift $ $(logWarn)
[i|Could not get download info, trying cached version (this may not be recent!)|]
let path = view pathL' ghcupURL
yaml_file <- (cacheDir </>) <$> urlBaseName path
bs <-
handleIO' NoSuchThing
(\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
$ liftIO
$ readFile yaml_file
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
-- | Downloads the download information! But only if we need to ;P
getDownloads :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
, MonadIO m
, MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader Settings m
)
=> URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
getDownloads urlSource = do
lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
case urlSource of
GHCupURL -> do
bs <- reThrowAll DownloadFailed $ smartDl ghcupURL
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSource url) -> do
bs <- reThrowAll DownloadFailed $ downloadBS url
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSpec av) -> pure av
(AddSource (Left ext)) -> do
base <- liftE getBase
pure (mergeGhcupInfo base ext)
(AddSource (Right uri)) -> do
base <- liftE getBase
bsExt <- reThrowAll DownloadFailed $ downloadBS uri
ext <- lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bsExt)
pure (mergeGhcupInfo base ext)
(OwnSpec av) -> pure $ av
where
mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
-> GHCupInfo -- ^ extension overwriting the base
-> GHCupInfo
mergeGhcupInfo (GHCupInfo tr base) (GHCupInfo _ ext) =
let new = M.mapWithKey (\k a -> case M.lookup k ext of
Just a' -> M.union a' a
Nothing -> a
) base
in GHCupInfo tr new
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
=> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache = do
AppState {dirs = Dirs {..}} <- lift ask
lift $ $(logWarn)
[i|Could not get download info, trying cached version (this may not be recent!)|]
let path = view pathL' ghcupURL
yaml_file <- (cacheDir </>) <$> urlBaseName path
bs <-
handleIO' NoSuchThing
(\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
$ liftIO
$ readFile yaml_file
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
=> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
getBase =
handleIO (\_ -> readFromCache)
$ catchE @_ @'[JSONError, FileDoesNotExistError]
(\(DownloadFailed _) -> readFromCache)
$ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
where
where
-- 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
-- last 5 minutes, just reuse it.
@@ -190,7 +185,7 @@ getBase =
, MonadIO m1
, MonadFail m1
, MonadLogger m1
, MonadReader AppState m1
, MonadReader Settings m1
)
=> URI
-> Excepts
@@ -205,7 +200,7 @@ getBase =
m1
L.ByteString
smartDl uri' = do
AppState {dirs = Dirs {..}} <- lift ask
Settings {dirs = Dirs {..}} <- lift ask
let path = view pathL' uri'
json_file <- (cacheDir </>) <$> urlBaseName path
e <- liftIO $ doesFileExist json_file
@@ -213,8 +208,8 @@ getBase =
then do
accessTime <-
PF.accessTimeHiRes
<$> liftIO (PF.getFileStatus (toFilePath json_file))
currentTime <- liftIO getPOSIXTime
<$> (liftIO $ PF.getFileStatus (toFilePath json_file))
currentTime <- liftIO $ getPOSIXTime
-- access time won't work on most linuxes, but we can try regardless
if (currentTime - accessTime) > 300
@@ -231,7 +226,7 @@ getBase =
else -- access in less than 5 minutes, re-use file
liftIO $ readFile json_file
else do
liftIO $ createDirRecursive' cacheDir
liftIO $ createDirRecursive newDirPerms cacheDir
getModTime >>= \case
Just modTime -> dlWithMod modTime json_file
Nothing -> do
@@ -297,8 +292,7 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
(case p of
-- non-musl won't work on alpine
Linux Alpine -> with_distro <|> without_distro_ver
_ -> with_distro <|> without_distro_ver <|> without_distro
)
_ -> with_distro <|> without_distro_ver <|> without_distro)
where
with_distro = distro_preview id id
@@ -306,18 +300,7 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
distro_preview f g =
let platformVersionSpec =
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
mv' = g mv
in fmap snd
. find
(\(mverRange, _) -> maybe
(mv' == Nothing)
(\range -> maybe False (flip versionRange range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
preview (ix t % ix v % viArch % ix a % ix (f p) % ix (g mv)) dls
-- | Tries to download from the given http or https url
@@ -328,7 +311,7 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
--
-- The file must not exist.
download :: ( MonadMask m
, MonadReader AppState m
, MonadReader Settings m
, MonadThrow m
, MonadLogger m
, MonadIO m
@@ -347,7 +330,7 @@ download dli dest mfn
scheme = view (dlUri % uriSchemeL' % schemeBSL') dli
cp = do
-- destination dir must exist
liftIO $ createDirRecursive' dest
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
destFile <- getDestFile
fromFile <- parseAbs path
liftIO $ copyFile fromFile destFile Strict
@@ -357,7 +340,7 @@ download dli dest mfn
lift $ $(logInfo) [i|downloading: #{uri'}|]
-- destination dir must exist
liftIO $ createDirRecursive' dest
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
destFile <- getDestFile
-- download
@@ -400,7 +383,7 @@ downloadCached :: ( MonadMask m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadReader AppState m
, MonadReader Settings m
)
=> DownloadInfo
-> Maybe (Path Rel) -- ^ optional filename
@@ -409,7 +392,7 @@ downloadCached dli mfn = do
cache <- lift getCache
case cache of
True -> do
AppState {dirs = Dirs {..}} <- lift ask
Settings {dirs = Dirs {..}} <- lift ask
fn <- maybe (urlBaseName $ view (dlUri % pathL') dli) pure mfn
let cachfile = cacheDir </> fn
fileExists <- liftIO $ doesFileExist cachfile
@@ -433,7 +416,7 @@ downloadCached dli mfn = do
-- | This is used for downloading the JSON.
downloadBS :: (MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m)
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
=> URI
-> Excepts
'[ FileDoesNotExistError
@@ -490,12 +473,12 @@ downloadBS uri'
#endif
checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m)
checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader Settings m)
=> DownloadInfo
-> Path Abs
-> Excepts '[DigestError] m ()
checkDigest dli file = do
verify <- lift ask <&> (not . noVerify . settings)
verify <- lift ask <&> (not . noVerify)
when verify $ do
p' <- toFilePath <$> basename file
lift $ $(logInfo) [i|verifying digest of: #{p'}|]

View File

@@ -13,6 +13,7 @@ module GHCup.Download.IOStreams where
import GHCup.Download.Utils
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.File

View File

@@ -67,15 +67,6 @@ data CopyError = CopyError String
data TagNotFound = TagNotFound Tag Tool
deriving Show
-- | Unable to find a version of a tool.
data VerNotFound = VerNotFound Version Tool
deriving Show
-- | Unable to find the next version of a tool (the one after the currently
-- set one).
data NextVerNotFound = NextVerNotFound Tool
deriving Show
-- | The tool (such as GHC) is already installed with that version.
data AlreadyInstalled = AlreadyInstalled Tool Version
deriving Show
@@ -127,9 +118,6 @@ data NoToolRequirements = NoToolRequirements
data InvalidBuildConfig = InvalidBuildConfig Text
deriving Show
data NoToolVersionSet = NoToolVersionSet Tool
deriving Show
-------------------------
@@ -164,10 +152,3 @@ data ParseError = ParseError String
deriving Show
instance Exception ParseError
data UnexpectedListLength = UnexpectedListLength String
deriving Show
instance Exception UnexpectedListLength

View File

@@ -14,10 +14,8 @@ module GHCup.Requirements where
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Version
import Control.Applicative
import Data.List ( find )
import Data.Maybe
import Optics
import Prelude hiding ( abs
@@ -25,7 +23,6 @@ import Prelude hiding ( abs
, writeFile
)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
@@ -36,32 +33,22 @@ getCommonRequirements :: PlatformResult
-> ToolRequirements
-> Maybe Requirements
getCommonRequirements pr tr =
with_distro <|> without_distro_ver <|> without_distro
where
with_distro = distro_preview _platform _distroVersion
without_distro_ver = distro_preview _platform (const Nothing)
without_distro = distro_preview (set _Linux UnknownLinux . _platform) (const Nothing)
distro_preview f g =
let platformVersionSpec =
preview (ix GHC % ix Nothing % ix (f pr)) tr
mv' = g pr
in fmap snd
. find
(\(mverRange, _) -> maybe
(mv' == Nothing)
(\range -> maybe False (flip versionRange range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
preview (ix GHC % ix Nothing % ix (_platform pr) % ix (_distroVersion pr)) tr
<|> preview (ix GHC % ix Nothing % ix (_platform pr) % ix Nothing) tr
<|> preview
( ix GHC
% ix Nothing
% ix (set _Linux UnknownLinux $ _platform pr)
% ix Nothing
)
tr
prettyRequirements :: Requirements -> T.Text
prettyRequirements Requirements {..} =
let d = if not . null $ _distroPKGs
then
"\n Please install the following distro packages: "
"\n Install the following distro packages: "
<> T.intercalate " " _distroPKGs
else ""
n = if not . T.null $ _notes then "\n Note: " <> _notes else ""

View File

@@ -1,6 +1,10 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-|
Module : GHCup.Types
@@ -13,16 +17,16 @@ Portability : POSIX
-}
module GHCup.Types where
import Control.Concurrent.MVar
import Data.ByteString ( ByteString )
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Text ( Text )
import Data.Versions
import HPath
import URI.ByteString
import System.Posix.Types
import qualified Data.Text as T
import qualified GHC.Generics as GHC
import qualified Graphics.Vty as Vty
@@ -47,7 +51,7 @@ data GHCupInfo = GHCupInfo
type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe VersionRange) Requirements
type PlatformReqVersionSpec = Map (Maybe Versioning) Requirements
data Requirements = Requirements
@@ -71,30 +75,25 @@ type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map Version VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
-- | An installable tool.
data Tool = GHC
| Cabal
| GHCup
| HLS
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
deriving (Eq, GHC.Generic, Ord, Show)
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
-- informative messages
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
{ _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
}
deriving (Eq, GHC.Generic, Show)
deriving (Eq, Show)
-- | A tag. These are currently attached to a version of a tool.
@@ -102,17 +101,9 @@ data Tag = Latest
| Recommended
| Prerelease
| Base PVP
| Old -- ^ old version are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
deriving (Ord, Eq, Show) -- FIXME: manual JSON instance
prettyTag :: Tag -> String
prettyTag Recommended = "recommended"
prettyTag Latest = "latest"
prettyTag Prerelease = "prerelease"
prettyTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
prettyTag (UnknownTag t ) = t
prettyTag Old = ""
data Architecture = A_64
| A_32
@@ -124,15 +115,6 @@ data Architecture = A_64
| A_ARM64
deriving (Eq, GHC.Generic, Ord, Show)
prettyArch :: Architecture -> String
prettyArch A_64 = "x86_64"
prettyArch A_32 = "i386"
prettyArch A_PowerPC = "powerpc"
prettyArch A_PowerPC64 = "powerpc64"
prettyArch A_Sparc = "sparc"
prettyArch A_Sparc64 = "sparc64"
prettyArch A_ARM = "arm"
prettyArch A_ARM64 = "aarch64"
data Platform = Linux LinuxDistro
-- ^ must exit
@@ -141,11 +123,6 @@ data Platform = Linux LinuxDistro
| FreeBSD
deriving (Eq, GHC.Generic, Ord, Show)
prettyPlatfrom :: Platform -> String
prettyPlatfrom (Linux distro) = "linux-" ++ prettyDistro distro
prettyPlatfrom Darwin = "darwin"
prettyPlatfrom FreeBSD = "freebsd"
data LinuxDistro = Debian
| Ubuntu
| Mint
@@ -162,19 +139,6 @@ data LinuxDistro = Debian
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show)
prettyDistro :: LinuxDistro -> String
prettyDistro Debian = "debian"
prettyDistro Ubuntu = "ubuntu"
prettyDistro Mint= "mint"
prettyDistro Fedora = "fedora"
prettyDistro CentOS = "centos"
prettyDistro RedHat = "redhat"
prettyDistro Alpine = "alpine"
prettyDistro AmazonLinux = "amazon"
prettyDistro Gentoo = "gentoo"
prettyDistro Exherbo = "exherbo"
prettyDistro UnknownLinux = "unknown"
-- | An encapsulation of a download. This can be used
-- to download, extract and install a tool.
@@ -183,7 +147,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir
, _dlHash :: Text
}
deriving (Eq, Ord, GHC.Generic, Show)
deriving (Eq, Show)
@@ -196,89 +160,56 @@ data DownloadInfo = DownloadInfo
-- | How to descend into a tar archive.
data TarDir = RealDir (Path Rel)
| RegexDir String -- ^ will be compiled to regex, the first match will "win"
deriving (Eq, Ord, GHC.Generic, Show)
deriving (Eq, Show)
-- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL
| OwnSource URI
| OwnSpec GHCupInfo
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
deriving (GHC.Generic, Show)
deriving Show
data UserSettings = UserSettings
{ uCache :: Maybe Bool
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
}
deriving (Show, GHC.Generic)
data ProcessError = NonZeroExit Int ByteString [ByteString]
| PTerminated ByteString [ByteString]
| PStopped ByteString [ByteString]
| NoSuchPid ByteString [ByteString]
deriving (Eq, Show)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data ProcState = PRunning ProcessID
| PExited (Either ProcessError ())
deriving Eq
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Vty.Key
, kDown :: Maybe Vty.Key
, kQuit :: Maybe Vty.Key
, kInstall :: Maybe Vty.Key
, kUninstall :: Maybe Vty.Key
, kSet :: Maybe Vty.Key
, kChangelog :: Maybe Vty.Key
, kShowAll :: Maybe Vty.Key
}
deriving (Show, GHC.Generic)
type ExecCb = Bool -- verbose
-> Fd -- log file fd
-> Fd -- input fd to read from
-> MVar ProcState -- state of the producing process
-> ByteString -- log filename
-> IO ()
data KeyBindings = KeyBindings
{ bUp :: Vty.Key
, bDown :: Vty.Key
, bQuit :: Vty.Key
, bInstall :: Vty.Key
, bUninstall :: Vty.Key
, bSet :: Vty.Key
, bChangelog :: Vty.Key
, bShowAll :: Vty.Key
}
deriving (Show, GHC.Generic)
instance Show ExecCb where
show _ = "**ExecCb**"
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
{ bUp = Vty.KUp
, bDown = Vty.KDown
, bQuit = Vty.KChar 'q'
, bInstall = Vty.KChar 'i'
, bUninstall = Vty.KChar 'u'
, bSet = Vty.KChar 's'
, bChangelog = Vty.KChar 'c'
, bShowAll = Vty.KChar 'a'
}
data AppState = AppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
} deriving (Show)
data Settings = Settings
{ cache :: Bool
{ -- set by user
cache :: Bool
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
-- set on app start
, dirs :: Dirs
, execCb :: ExecCb
}
deriving (Show, GHC.Generic)
deriving Show
data Dirs = Dirs
{ baseDir :: Path Abs
, binDir :: Path Abs
, cacheDir :: Path Abs
, logsDir :: Path Abs
, confDir :: Path Abs
}
deriving Show
@@ -317,12 +248,6 @@ data PlatformResult = PlatformResult
}
deriving (Eq, Show)
prettyPlatform :: PlatformResult -> String
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> T.unpack (prettyV v')
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat
data PlatformRequest = PlatformRequest
{ _rArch :: Architecture
, _rPlatform :: Platform
@@ -330,13 +255,6 @@ data PlatformRequest = PlatformRequest
}
deriving (Eq, Show)
prettyPfReq :: PlatformRequest -> String
prettyPfReq (PlatformRequest arch plat ver) =
prettyArch arch ++ "-" ++ prettyPlatfrom plat ++ pver
where
pver = case ver of
Just v' -> "-" ++ (T.unpack $ prettyV v')
Nothing -> ""
-- | A GHC identified by the target platform triple
-- and the version.
@@ -356,19 +274,3 @@ prettyTVer :: GHCTargetVersion -> Text
prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
prettyTVer (GHCTargetVersion Nothing v') = prettyVer v'
-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
| VR_gteq Versioning
| VR_lt Versioning
| VR_lteq Versioning
| VR_eq Versioning
deriving (Eq, GHC.Generic, Ord, Show)
-- | A version range. Supports && and ||, but not arbitrary
-- combinations. This is a little simplified.
data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
| OrRange (NonEmpty VersionCmp) VersionRange
deriving (Eq, GHC.Generic, Ord, Show)

View File

@@ -22,34 +22,25 @@ Portability : POSIX
module GHCup.Types.JSON where
import GHCup.Types
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import Control.Applicative ( (<|>) )
import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Text.Encoding as E
import Data.Versions
import Data.Void
import Data.Word8
import HPath
import URI.ByteString
import Text.Casing
import qualified Data.ByteString as BS
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
@@ -59,18 +50,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Versio
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key
instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON (UnknownTag x ) = String (T.pack x)
@@ -79,7 +63,6 @@ instance FromJSON Tag where
"Latest" -> pure Latest
"Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
Left e -> fail . show $ e
@@ -117,10 +100,10 @@ instance ToJSONKey (Maybe Versioning) where
instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
if t == T.pack "unknown_versioning" then pure Nothing else pure $ just t
where
just t = case versioning t of
Right x -> pure $ Just x
Right x -> pure x
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
instance ToJSONKey Platform where
@@ -163,10 +146,10 @@ instance ToJSONKey (Maybe Version) where
instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else just t
if t == T.pack "unknown_version" then pure Nothing else pure $ just t
where
just t = case version t of
Right x -> pure $ Just x
Right x -> pure x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where
@@ -226,101 +209,3 @@ instance FromJSON TarDir where
regexDir = withObject "TarDir" $ \o -> do
r <- o .: "RegexDir"
pure $ RegexDir r
instance ToJSON VersionCmp where
toJSON = String . versionCmpToText
instance FromJSON VersionCmp where
parseJSON = withText "VersionCmp" $ \t -> do
case MP.parse versionCmpP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionCmpToText :: VersionCmp -> T.Text
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
versionCmpToText (VR_lt ver') = "< " <> prettyV ver'
versionCmpToText (VR_lteq ver') = "<= " <> prettyV ver'
versionCmpToText (VR_eq ver') = "== " <> prettyV ver'
versionCmpP :: MP.Parsec Void T.Text VersionCmp
versionCmpP =
fmap VR_gt (MP.try $ MPC.space *> MP.chunk ">" *> MPC.space *> versioningEnd)
<|> fmap
VR_gteq
(MP.try $ MPC.space *> MP.chunk ">=" *> MPC.space *> versioningEnd)
<|> fmap
VR_lt
(MP.try $ MPC.space *> MP.chunk "<" *> MPC.space *> versioningEnd)
<|> fmap
VR_lteq
(MP.try $ MPC.space *> MP.chunk "<=" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> MP.chunk "==" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> versioningEnd)
instance ToJSON VersionRange where
toJSON = String . verRangeToText
verRangeToText :: VersionRange -> T.Text
verRangeToText (SimpleRange cmps) =
let inner = foldr1 (\x y -> x <> " && " <> y)
(versionCmpToText <$> NE.toList cmps)
in "( " <> inner <> " )"
verRangeToText (OrRange cmps range) =
let left = verRangeToText $ (SimpleRange cmps)
right = verRangeToText range
in left <> " || " <> right
instance FromJSON VersionRange where
parseJSON = withText "VersionRange" $ \t -> do
case MP.parse versionRangeP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionRangeP :: MP.Parsec Void T.Text VersionRange
versionRangeP = go <* MP.eof
where
go =
MP.try orParse
<|> MP.try (fmap SimpleRange andParse)
<|> (fmap (SimpleRange . pure) versionCmpP)
orParse :: MP.Parsec Void T.Text VersionRange
orParse =
(\a o -> OrRange a o)
<$> (MP.try andParse <|> fmap pure versionCmpP)
<*> (MPC.space *> MP.chunk "||" *> MPC.space *> go)
andParse :: MP.Parsec Void T.Text (NonEmpty VersionCmp)
andParse =
fmap (\h t -> h :| t)
(MPC.space *> MP.chunk "(" *> MPC.space *> versionCmpP)
<*> ( MP.try
$ MP.many (MPC.space *> MP.chunk "&&" *> MPC.space *> versionCmpP)
)
<* MPC.space
<* MP.chunk ")"
<* MPC.space
versioningEnd :: MP.Parsec Void T.Text Versioning
versioningEnd =
MP.try (verP (MP.chunk " " <|> MP.chunk ")" <|> MP.chunk "&&") <* MPC.space)
<|> versioning'
instance ToJSONKey (Maybe VersionRange) where
toJSONKey = toJSONKeyText $ \case
Just x -> verRangeToText x
Nothing -> "unknown_versioning"
instance FromJSONKey (Maybe VersionRange) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case MP.parse versionRangeP "" t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e

View File

@@ -36,7 +36,7 @@ import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
#if !defined(TAR)
import Codec.Archive hiding ( Directory )
import Codec.Archive
#endif
import Control.Applicative
import Control.Exception.Safe
@@ -50,7 +50,6 @@ import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
import Data.List
import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.List.Split
import Data.Maybe
import Data.String.Interpolate
@@ -100,52 +99,45 @@ import qualified Text.Megaparsec as MP
-- | The symlink destination of a ghc tool.
ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
ghcLinkDestination :: (MonadReader Settings m, MonadThrow m, MonadIO m)
=> ByteString -- ^ the tool, such as 'ghc', 'haddock' etc.
-> GHCTargetVersion
-> m ByteString
ghcLinkDestination tool ver = do
AppState { dirs = Dirs {..} } <- ask
Settings {dirs = Dirs {..}} <- ask
t <- parseRel tool
ghcd <- ghcupGHCDir ver
pure (relativeSymlink binDir (ghcd </> [rel|bin|] </> t))
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorSymlinks tv@(GHCTargetVersion {..}) = do
AppState { dirs = Dirs {..} } <- lift ask
rmMinorSymlinks :: (MonadReader Settings m, MonadIO m, MonadLogger m) => GHCTargetVersion -> m ()
rmMinorSymlinks GHCTargetVersion {..} = do
Settings {dirs = Dirs {..}} <- ask
files <- liftIO $ findFiles'
binDir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk $ prettyVer _tvVersion)
*> (MP.chunk $ prettyVer _tvVersion)
*> MP.eof
)
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion)
let fullF = (binDir </> f_xyz)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
let fullF = (binDir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- | Removes the set ghc version for the given target, if any.
rmPlain :: ( MonadReader AppState m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
)
=> Maybe Text -- ^ target
rmPlain :: (MonadReader Settings m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m ()
rmPlain target = do
AppState { dirs = Dirs {..} } <- lift ask
mtv <- lift $ ghcSet target
Settings {dirs = Dirs {..}} <- lift ask
mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let fullF = (binDir </> f)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
@@ -157,25 +149,25 @@ rmPlain target = do
-- | Remove the major GHC symlink, e.g. ghc-8.6.
rmMajorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
rmMajorSymlinks :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks tv@(GHCTargetVersion {..}) = do
AppState { dirs = Dirs {..} } <- lift ask
-> m ()
rmMajorSymlinks GHCTargetVersion {..} = do
Settings {dirs = Dirs {..}} <- ask
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
files <- liftE $ ghcToolFiles tv
files <- liftIO $ findFiles'
binDir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk v')
*> MP.chunk v'
*> MP.eof
)
forM_ files $ \f -> do
f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v')
let fullF = (binDir </> f_xyz)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
let fullF = (binDir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
@@ -187,26 +179,26 @@ rmMajorSymlinks tv@(GHCTargetVersion {..}) = do
-- | Whethe the given GHC versin is installed.
ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled :: (MonadIO m, MonadReader Settings m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesDirectoryExist ghcdir
-- | Whether the given GHC version is installed from source.
ghcSrcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled :: (MonadIO m, MonadReader Settings m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
-- | Whether the given GHC version is set as the current.
ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m)
ghcSet :: (MonadReader Settings m, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
-- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersion)
ghcSet mtarget = do
AppState {dirs = Dirs {..}} <- ask
Settings {dirs = Dirs {..}} <- ask
ghc <- parseRel $ E.encodeUtf8 (maybe "ghc" (<> "-ghc") mtarget)
let ghcBin = binDir </> ghc
@@ -239,7 +231,7 @@ ghcLinkVersion bs = do
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
-- If a dir cannot be parsed, returns left.
getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs :: (MonadReader Settings m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs = do
ghcdir <- ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir
@@ -249,10 +241,10 @@ getInstalledGHCs = do
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
getInstalledCabals :: (MonadReader AppState m, MonadIO m, MonadCatch m)
getInstalledCabals :: (MonadReader Settings m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version]
getInstalledCabals = do
AppState {dirs = Dirs {..}} <- ask
Settings {dirs = Dirs {..}} <- ask
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
@@ -265,16 +257,16 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed.
cabalInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
cabalInstalled :: (MonadIO m, MonadReader Settings m, 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 :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet :: (MonadReader Settings m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet = do
AppState {dirs = Dirs {..}} <- ask
Settings {dirs = Dirs {..}} <- ask
let cabalbin = binDir </> [rel|cabal|]
b <- handleIO (\_ -> pure False) $ fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin
if
@@ -309,150 +301,6 @@ cabalSet = do
-- | Get all installed hls, by matching on
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version]
getInstalledHLSs = do
AppState { dirs = Dirs {..} } <- ask
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
)
vs <- forM bins $ \f ->
case
fmap
version
(fmap decUTF8Safe . B.stripPrefix "haskell-language-server-wrapper-" . toFilePath $ f)
of
Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f
pure $ vs
-- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
hlsInstalled ver = do
vers <- fmap rights $ getInstalledHLSs
pure $ elem ver $ vers
-- Return the currently set hls version, if any.
hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do
AppState {dirs = Dirs {..}} <- ask
let hlsBin = binDir </> [rel|haskell-language-server-wrapper|]
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
broken <- isBrokenSymlink hlsBin
if broken
then pure Nothing
else do
link <- readSymbolicLink $ toFilePath hlsBin
Just <$> linkVersion link
where
linkVersion :: MonadThrow m => ByteString -> m Version
linkVersion bs = do
t <- throwEither $ E.decodeUtf8' bs
throwEither $ MP.parse parser "" t
where
parser =
MP.chunk "haskell-language-server-wrapper-" *> version'
-- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader AppState m
, MonadIO m
, MonadThrow m
, MonadCatch m
)
=> m [Version]
hlsGHCVersions = do
h <- hlsSet
vers <- forM h $ \h' -> do
bins <- hlsServerBinaries h'
pure $ fmap
(\bin ->
version
. decUTF8Safe
. fromJust
. B.stripPrefix "haskell-language-server-"
. head
. B.split _tilde
. toFilePath
$ bin
)
bins
pure . rights . concat . maybeToList $ vers
-- | Get all server binaries for an hls version, if any.
hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
=> Version
-> m [Path Rel]
hlsServerBinaries ver = do
AppState { dirs = Dirs {..} } <- ask
liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
compExtended
execBlank
([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> [s|$|] :: ByteString
)
)
-- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> Version
-> m (Maybe (Path Rel))
hlsWrapperBinary ver = do
AppState { dirs = Dirs {..} } <- ask
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
compExtended
execBlank
([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> [s|$|] :: ByteString
)
)
case wrapper of
[] -> pure $ Nothing
[x] -> pure $ Just x
_ -> throwM $ UnexpectedListLength
"There were multiple hls wrapper binaries for a single version"
-- | Get all binaries for an hls version, if any.
hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [Path Rel]
hlsAllBinaries ver = do
hls <- hlsServerBinaries ver
wrapper <- hlsWrapperBinary ver
pure (maybeToList wrapper ++ hls)
-- | Get the active symlinks for hls.
hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [Path Rel]
hlsSymlinks = do
AppState { dirs = Dirs {..} } <- ask
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-.*$|] :: ByteString)
)
filterM
( fmap (== SymbolicLink)
. liftIO
. getFileType
. (binDir </>)
)
oldSyms
-----------------------------------------
@@ -463,7 +311,7 @@ hlsSymlinks = do
-- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version {..} = case _vChunks of
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
([Digits x] : [Digits y] : _) -> pure (fromIntegral x, fromIntegral y)
_ -> throwM $ ParseError "Could not parse X.Y from version"
@@ -475,7 +323,7 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
-- | Get the latest installed full GHC version that satisfies X.Y.
-- This reads `ghcupGHCBaseDir`.
getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m)
getGHCForMajor :: (MonadReader Settings m, MonadIO m, MonadThrow m)
=> Int -- ^ major version component
-> Int -- ^ minor version component
-> Maybe Text -- ^ the target triple
@@ -497,11 +345,11 @@ getGHCForMajor major' minor' mt = do
getLatestGHCFor :: Int -- ^ major version component
-> Int -- ^ minor version component
-> GHCupDownloads
-> Maybe (Version, VersionInfo)
-> Maybe Version
getLatestGHCFor major' minor' dls = do
join
. fmap (lastMay . filter (\(v, _) -> matchMajor v major' minor'))
. preview (ix GHC % to Map.toDescList)
. fmap (lastMay . filter (\v -> matchMajor v major' minor'))
. preview (ix GHC % to Map.keys)
$ dls
@@ -596,31 +444,31 @@ getTagged tag =
% _head
)
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest) $ av
getLatest :: GHCupDownloads -> Tool -> Maybe Version
getLatest av tool = headOf (ix tool % getTagged Latest % to fst) $ av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) $ av
getRecommended :: GHCupDownloads -> Tool -> Maybe Version
getRecommended av tool = headOf (ix tool % getTagged Recommended % to fst) $ av
-- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe Version
getLatestBaseVersion av pvpVer =
headOf (ix GHC % getTagged (Base pvpVer)) av
headOf (ix GHC % getTagged (Base pvpVer) % to fst) av
-----------------------
--[ AppState Getter ]--
--[ Settings Getter ]--
-----------------------
getCache :: MonadReader AppState m => m Bool
getCache = ask <&> cache . settings
getCache :: MonadReader Settings m => m Bool
getCache = ask <&> cache
getDownloader :: MonadReader AppState m => m Downloader
getDownloader = ask <&> downloader . settings
getDownloader :: MonadReader Settings m => m Downloader
getDownloader = ask <&> downloader
@@ -641,7 +489,7 @@ urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
-- Returns unversioned relative files, e.g.:
--
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
ghcToolFiles :: (MonadReader Settings m, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles ver = do
@@ -694,7 +542,7 @@ ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
-- | Calls gmake if it exists in PATH, otherwise make.
make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
make :: (MonadThrow m, MonadIO m, MonadReader Settings m)
=> [ByteString]
-> Maybe (Path Abs)
-> m (Either ProcessError ())
@@ -702,7 +550,7 @@ make args workdir = do
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
has_gmake <- isJust <$> (liftIO $ searchPath spaths [rel|gmake|])
let mymake = if has_gmake then "gmake" else "make"
execLogged mymake True args [rel|ghc-make|] workdir Nothing
execLogged mymake True args workdir Nothing
-- | Try to apply patches in order. Fails with 'PatchFailed'
@@ -747,13 +595,13 @@ getChangeLog dls tool (Right tag) =
--
-- 1. the build directory, depending on the KeepDirs setting
-- 2. the install destination, depending on whether the build failed
runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
=> Path Abs -- ^ build directory (cleaned up depending on Settings)
-> Maybe (Path Abs) -- ^ dir to *always* clean up on exception
runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m)
=> Path Abs -- ^ build directory
-> Maybe (Path Abs) -- ^ install location (e.g. for GHC)
-> Excepts e m a
-> Excepts '[BuildFailed] m a
runBuildAction bdir instdir action = do
AppState { settings = Settings {..} } <- lift ask
Settings {..} <- lift ask
let exAction = do
forM_ instdir $ \dir ->
liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir
@@ -773,47 +621,3 @@ runBuildAction bdir instdir action = do
when (keepDirs == Never || keepDirs == Errors) $ liftIO $ deleteDirRecursive
bdir
pure v
-- | More permissive version of 'createDirRecursive'. This doesn't
-- error when the destination is a symlink to a directory.
createDirRecursive' :: Path b -> IO ()
createDirRecursive' p =
handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e)
. createDirRecursive newDirPerms
$ p
where
isSymlinkDir e = do
ft <- getFileType p
case ft of
SymbolicLink -> do
rp <- canonicalizePath p
rft <- getFileType rp
case rft of
Directory -> pure ()
_ -> throwIO e
_ -> throwIO e
getVersionInfo :: Version
-> Tool
-> GHCupDownloads
-> Maybe VersionInfo
getVersionInfo v' tool dls =
headOf
( ix tool
% to (Map.filterWithKey (\k _ -> k == v'))
% to Map.elems
% _head
)
dls
-- Gathering monoidal values
traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
-- | Gathering monoidal values
forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
forFold = \t -> \f -> traverseFold f t

View File

@@ -1,4 +1,3 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
@@ -15,18 +14,16 @@ Portability : POSIX
-}
module GHCup.Utils.Dirs
( getDirs
, ghcupConfigFile
, ghcupGHCBaseDir
, ghcupGHCDir
, mkGhcupTmpDir
, parseGHCupGHCDir
, relativeSymlink
, mkGhcupTmpDir
, withGHCupTmpDir
, relativeSymlink
)
where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.MegaParsec
@@ -37,11 +34,8 @@ import Control.Exception.Safe
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Bifunctor
import Data.ByteString ( ByteString )
import Data.Maybe
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts
import HPath
import HPath.IO
import Optics
@@ -55,10 +49,8 @@ import System.Posix.Env.ByteString ( getEnv
import System.Posix.FilePath hiding ( (</>) )
import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y
import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU
import qualified Text.Megaparsec as MP
@@ -92,28 +84,6 @@ ghcupBaseDir = do
pure (bdir </> [rel|.ghcup|])
-- | ~/.ghcup by default
--
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
ghcupConfigDir :: IO (Path Abs)
ghcupConfigDir = do
xdg <- useXDG
if xdg
then do
bdir <- getEnv "XDG_CONFIG_HOME" >>= \case
Just r -> parseAbs r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> [rel|.config|])
pure (bdir </> [rel|ghcup|])
else do
bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> parseAbs r
Nothing -> liftIO getHomeDirectory
pure (bdir </> [rel|.ghcup|])
-- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
-- (which, sadly is not strictly xdg spec).
@@ -172,44 +142,27 @@ getDirs = do
binDir <- ghcupBinDir
cacheDir <- ghcupCacheDir
logsDir <- ghcupLogsDir
confDir <- ghcupConfigDir
pure Dirs { .. }
-------------------
--[ GHCup files ]--
-------------------
ghcupConfigFile :: (MonadIO m)
=> Excepts '[JSONError] m UserSettings
ghcupConfigFile = do
confDir <- liftIO ghcupConfigDir
let file = confDir </> [rel|config.yaml|]
bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> readFile file
case bs of
Nothing -> pure defaultUserSettings
Just bs' -> lE' JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict $ bs'
-------------------------
--[ GHCup directories ]--
-------------------------
-- | ~/.ghcup/ghc by default.
ghcupGHCBaseDir :: (MonadReader AppState m) => m (Path Abs)
ghcupGHCBaseDir :: (MonadReader Settings m) => m (Path Abs)
ghcupGHCBaseDir = do
AppState { dirs = Dirs {..} } <- ask
pure (baseDir </> [rel|ghc|])
Settings {..} <- ask
pure (baseDir dirs </> [rel|ghc|])
-- | Gets '~/.ghcup/ghc/<ghcupGHCDir>'.
-- The dir may be of the form
-- * armv7-unknown-linux-gnueabihf-8.8.3
-- * 8.8.4
ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
ghcupGHCDir :: (MonadReader Settings m, MonadThrow m)
=> GHCTargetVersion
-> m (Path Abs)
ghcupGHCDir ver = do

View File

@@ -72,14 +72,6 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
data ProcessError = NonZeroExit Int ByteString [ByteString]
| PTerminated ByteString [ByteString]
| PStopped ByteString [ByteString]
| NoSuchPid ByteString [ByteString]
deriving Show
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: ByteString
@@ -117,34 +109,35 @@ executeOut path args chdir = captureOutStreams $ do
SPPB.executeFile (toFilePath path) True args Nothing
execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
execLogged :: (MonadReader Settings m, MonadIO m, MonadThrow m)
=> ByteString -- ^ thing to execute
-> Bool -- ^ whether to search PATH for the thing
-> [ByteString] -- ^ args for the thing
-> Path Rel -- ^ log filename
-> Maybe (Path Abs) -- ^ optionally chdir into this
-> Maybe [(ByteString, ByteString)] -- ^ optional environment
-> m (Either ProcessError ())
execLogged exe spath args lfile chdir env = do
AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
logfile <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log")
execLogged exe spath args chdir env = do
Settings {dirs = Dirs {..}, ..} <- ask
logfile <- (logsDir </>) <$> parseRel (lfile <> ".log")
liftIO $ bracket (createFile (toFilePath logfile) newFilePerms)
closeFd
(action verbose)
(action verbose execCb)
where
action verbose fd = do
lfile = fromMaybe exe $ BS.stripPrefix "./" exe
action verbose cb fd = do
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
-- start the thread that logs to stdout
pState <- newEmptyMVar
done <- newEmptyMVar
pState <- newEmptyMVar
done <- newEmptyMVar
liftIO $ HPath.IO.writeFile [HPath.abs|/home/jule/git/ghcup-hs/cb.log|] Nothing "execLogged1"
void
$ forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ flip EX.finally (putMVar done ())
$ (if verbose
then tee fd stdoutRead
else printToRegion fd stdoutRead 6 pState
)
$ (do
liftIO $ HPath.IO.writeFile [HPath.abs|/home/jule/git/ghcup-hs/cb.log|] Nothing "execLogged"
cb verbose fd stdoutRead pState lfile)
-- fork the subprocess
pid <- SPPB.forkProcess $ do
@@ -157,115 +150,57 @@ execLogged exe spath args lfile chdir env = do
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
void $ SPPB.executeFile exe spath args env
putMVar pState (PRunning pid)
closeFd stdoutWrite
-- wait for the subprocess to finish
e <- toProcessError exe args <$!> SPPB.getProcessStatus True True pid
putMVar pState (either (const False) (const True) e)
void $ swapMVar pState (PExited e)
void $ race (takeMVar done) (threadDelay (1000000 * 3))
closeFd stdoutRead
pure e
tee :: Fd -> Fd -> IO ()
tee fileFd fdIn = readTilEOF lineAction fdIn
where
lineAction :: ByteString -> IO ()
lineAction bs' = do
void $ SPIB.fdWrite fileFd (bs' <> "\n")
void $ SPIB.fdWrite stdOutput (bs' <> "\n")
readLineTilEOF :: MonadIO m => (ByteString -> m a) -> Fd -> m ()
readLineTilEOF ~action' fd' = go mempty
where
go bs' = do
(bs, rest, eof) <- readLine fd' bs'
if eof
then liftIO $ ioError (mkIOError eofErrorType "" Nothing Nothing)
else (void $ action' bs) >> go rest
-- Reads fdIn and logs the output in a continous scrolling area
-- of 'size' terminal lines. Also writes to a log file.
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
printToRegion fileFd fdIn size pState = do
void $ displayConsoleRegions $ do
rs <-
liftIO
. fmap Sq.fromList
. sequence
. replicate size
. openConsoleRegion
$ Linear
flip runStateT mempty
$ handle
(\(ex :: SomeException) -> do
ps <- liftIO $ takeMVar pState
when (ps == True) (forM_ rs (liftIO . closeConsoleRegion))
throw ex
)
$ readTilEOF (lineAction rs) fdIn
where
-- action to perform line by line
-- TODO: do this with vty for efficiency
lineAction :: (MonadMask m, MonadIO m)
=> Seq ConsoleRegion
-> ByteString
-> StateT (Seq ByteString) m ()
lineAction rs = \bs' -> do
void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
modify (swapRegs bs')
regs <- get
liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
w <- consoleWidth
return
. T.pack
. color Blue
. T.unpack
. decUTF8Safe
. trim w
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
$ bs
-- Consecutively read from Fd in 512 chunks until we hit
-- newline or EOF.
readLine :: MonadIO m
=> Fd -- ^ input file descriptor
-> ByteString -- ^ rest buffer (read across newline)
-> m (ByteString, ByteString, Bool) -- ^ (full line, rest, eof)
readLine fd = \inBs -> go inBs
where
go inBs = do
-- if buffer is not empty, process it first
mbs <- if BS.length inBs == 0
-- otherwise attempt read
then liftIO
$ handleIO (\e -> if isEOFError e then pure Nothing else ioError e)
$ fmap Just
$ SPIB.fdRead fd 512
else pure $ Just inBs
case mbs of
Nothing -> pure ("", "", True)
Just bs -> do
-- split on newline
let (line, rest) = BS.span (/= _lf) bs
if
| BS.length rest /= 0 -> pure (line, BS.tail rest, False)
-- if rest is empty, then there was no newline, process further
| otherwise -> (\(l, r, b) -> (line <> l, r, b)) <$!> go mempty
swapRegs :: a -> Seq a -> Seq a
swapRegs bs = \regs -> if
| Sq.length regs < size -> regs |> bs
| otherwise -> Sq.drop 1 regs |> bs
-- trim output line to terminal width
trim :: Int -> ByteString -> ByteString
trim w = \bs -> if
| BS.length bs > w && w > 5 -> BS.take (w - 4) bs <> "..."
| otherwise -> bs
-- Consecutively read from Fd in 512 chunks until we hit
-- newline or EOF.
readLine :: MonadIO m
=> Fd -- ^ input file descriptor
-> ByteString -- ^ rest buffer (read across newline)
-> m (ByteString, ByteString, Bool) -- ^ (full line, rest, eof)
readLine fd = \inBs -> go inBs
where
go inBs = do
-- if buffer is not empty, process it first
mbs <- if BS.length inBs == 0
-- otherwise attempt read
then liftIO
$ handleIO (\e -> if isEOFError e then pure Nothing else ioError e)
$ fmap Just
$ SPIB.fdRead fd 512
else pure $ Just inBs
case mbs of
Nothing -> pure ("", "", True)
Just bs -> do
-- split on newline
let (line, rest) = BS.span (/= _lf) bs
if
| BS.length rest /= 0 -> pure (line, BS.tail rest, False)
-- if rest is empty, then there was no newline, process further
| otherwise -> (\(l, r, b) -> (line <> l, r, b)) <$!> go mempty
readTilEOF :: MonadIO m => (ByteString -> m a) -> Fd -> m ()
readTilEOF ~action' fd' = go mempty
where
go bs' = do
(bs, rest, eof) <- readLine fd' bs'
if eof
then liftIO $ ioError (mkIOError eofErrorType "" Nothing Nothing)
else (void $ action' bs) >> go rest
-- | Capture the stdout and stderr of the given action, which
@@ -407,32 +342,6 @@ searchPath paths needle = go paths
else pure False
-- | Check wether a binary is shadowed by another one that comes before
-- it in PATH. Returns the path to said binary, if any.
isShadowed :: Path Abs -> IO (Maybe (Path Abs))
isShadowed p = do
let dir = dirname p
fn <- basename p
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
if dir `elem` spaths
then do
let shadowPaths = takeWhile (/= dir) spaths
searchPath shadowPaths fn
else pure Nothing
-- | Check whether the binary is in PATH. This returns only `True`
-- if the directory containing the binary is part of PATH.
isInPath :: Path Abs -> IO Bool
isInPath p = do
let dir = dirname p
fn <- basename p
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
if dir `elem` spaths
then isJust <$> searchPath [dir] fn
else pure False
findFiles :: Path Abs -> Regex -> IO [Path Rel]
findFiles path regex = do
dirStream <- openDirStream (toFilePath path)
@@ -466,16 +375,86 @@ isBrokenSymlink p =
pure False
chmod_755 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_755 (toFilePath -> fp) = do
chmod_777 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_777 (toFilePath -> fp) = do
let exe_mode =
nullFileMode
newFilePerms
`unionFileModes` ownerExecuteMode
`unionFileModes` ownerReadMode
`unionFileModes` ownerWriteMode
`unionFileModes` groupExecuteMode
`unionFileModes` groupReadMode
`unionFileModes` otherExecuteMode
`unionFileModes` otherReadMode
$(logDebug) [i|chmod 755 #{fp}|]
$(logDebug) [i|chmod 777 #{fp}|]
liftIO $ setFileMode fp exe_mode
-- | The default callback for logging/printing on 'execLogged'.
defExecCb :: ExecCb
defExecCb verbose fd stdoutRead pState lfile = if verbose
then tee fd stdoutRead
else printToRegion fd stdoutRead 6
where
tee :: Fd -> Fd -> IO ()
tee fileFd fdIn = readLineTilEOF lineAction fdIn
where
lineAction :: ByteString -> IO ()
lineAction bs' = do
void $ SPIB.fdWrite fileFd (bs' <> "\n")
void $ SPIB.fdWrite stdOutput (bs' <> "\n")
-- Reads fdIn and logs the output in a continous scrolling area
-- of 'size' terminal lines. Also writes to a log file.
printToRegion :: Fd -> Fd -> Int -> IO ()
printToRegion fileFd fdIn size = do
void $ displayConsoleRegions $ do
rs <-
liftIO
. fmap Sq.fromList
. sequence
. replicate size
. openConsoleRegion
$ Linear
flip runStateT mempty
$ handle
(\(ex :: SomeException) -> do
let closeEventually = readMVar pState >>= \case
PExited (Right _) -> forM_ rs (liftIO . closeConsoleRegion)
_ -> threadDelay 500 >> closeEventually
void $ liftIO $ race closeEventually (threadDelay (1000000 * 3))
throw ex
)
$ readLineTilEOF (lineAction rs) fdIn
where
-- action to perform line by line
-- TODO: do this with vty for efficiency
lineAction :: (MonadMask m, MonadIO m)
=> Seq ConsoleRegion
-> ByteString
-> StateT (Seq ByteString) m ()
lineAction rs = \bs' -> do
void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
modify (swapRegs bs')
regs <- get
liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
w <- consoleWidth
return
. T.pack
. color Blue
. T.unpack
. decUTF8Safe
. trim w
. (\b -> "[ " <> lfile <> " ] " <> b)
$ bs
swapRegs :: a -> Seq a -> Seq a
swapRegs bs = \regs -> if
| Sq.length regs < size -> regs |> bs
| otherwise -> Sq.drop 1 regs |> bs
-- trim output line to terminal width
trim :: Int -> ByteString -> ByteString
trim w = \bs -> if
| BS.length bs > w && w > 5 -> BS.take (w - 4) bs <> "..."
| otherwise -> bs

View File

@@ -15,7 +15,6 @@ Here we define our main logger.
module GHCup.Utils.Logger where
import GHCup.Types
import GHCup.Utils
import Control.Monad
import Control.Monad.IO.Class
@@ -65,12 +64,12 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
rawOutter outr
initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => Path Rel -> m (Path Abs)
initGHCupFileLogging :: (MonadIO m, MonadReader Settings m) => Path Rel -> m (Path Abs)
initGHCupFileLogging context = do
AppState {dirs = Dirs {..}} <- ask
Settings {dirs = Dirs {..}} <- ask
let logfile = logsDir </> context
liftIO $ do
createDirRecursive' logsDir
createDirRecursive newDirPerms logsDir
hideError doesNotExistErrorType $ deleteFile logfile
createRegularFile newFilePerms logfile
pure logfile

View File

@@ -25,7 +25,6 @@ import Data.Text ( Text )
import Data.Versions
import Data.Void
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
@@ -74,13 +73,13 @@ ghcTargetBinP t =
ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion
ghcTargetVerP =
(\x y -> GHCTargetVersion x y)
<$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP')) <* MP.chunk "-")
<$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP)) <* MP.chunk "-")
<|> (flip const Nothing <$> mempty)
)
<*> (version' <* MP.eof)
where
verP' :: MP.Parsec Void Text Text
verP' = do
verP :: MP.Parsec Void Text Text
verP = do
v <- version'
let startsWithDigists =
and
@@ -91,22 +90,7 @@ ghcTargetVerP =
(Digits _) -> True
(Str _) -> False
)
. fmap NE.toList
. NE.toList
$ (_vChunks v)
if startsWithDigists && not (isJust (_vEpoch v))
then pure $ prettyVer v
else fail "Oh"
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP suffix = do
ver <- parseUntil suffix
if T.null ver
then fail "empty version"
else do
rest <- MP.getInput
MP.setInput ver
v <- versioning'
MP.setInput rest
pure v

View File

@@ -31,13 +31,11 @@ import Data.ByteString ( ByteString )
import Data.String
import Data.Text ( Text )
import Data.Versions
import Data.Word8
import Haskus.Utils.Types.List
import Haskus.Utils.Variant.Excepts
import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S
import qualified Data.Text as T
@@ -277,13 +275,3 @@ decUTF8Safe = E.decodeUtf8With E.lenientDecode
decUTF8Safe' :: L.ByteString -> Text
decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode
-- | Escape a version for use in regex
escapeVerRex :: Version -> ByteString
escapeVerRex = B.pack . go . B.unpack . verToBS
where
go [] = []
go (x : xs) | x == _period = [_backslash, _period] ++ go xs
| otherwise = x : go xs

View File

@@ -42,8 +42,6 @@ deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep

View File

@@ -3,7 +3,7 @@
{-|
Module : GHCup.Version
Description : Version information and version handling.
Description : Static version information
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
@@ -12,38 +12,22 @@ Portability : POSIX
-}
module GHCup.Version where
import GHCup.Types
import Paths_ghcup (version)
import GHCup.Utils.Version.QQ
import Data.Version (Version(versionBranch))
import Data.Versions hiding (version)
import Data.Versions
import URI.ByteString
import URI.ByteString.QQ
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
-- | This reflects the API version of the YAML.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.4.yaml|]
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.yaml|]
-- | The current ghcup version.
ghcUpVer :: PVP
ghcUpVer = PVP . NE.fromList . fmap fromIntegral $ versionBranch version
ghcUpVer = [pver|0.1.10|]
-- | ghcup version as numeric string.
numericVer :: String
numericVer = T.unpack . prettyPVP $ ghcUpVer
versionCmp :: Versioning -> VersionCmp -> Bool
versionCmp ver1 (VR_gt ver2) = ver1 > ver2
versionCmp ver1 (VR_gteq ver2) = ver1 >= ver2
versionCmp ver1 (VR_lt ver2) = ver1 < ver2
versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range

View File

@@ -1,72 +0,0 @@
resolver: lts-16.17
packages:
- .
extra-deps:
- 3rdparty/lzma
- 3rdparty/lzma-clib
- 3rdparty/zlib
- git: https://github.com/haskus/packages.git
commit: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdirs:
- haskus-utils-types
- git: https://github.com/hasufell/hpath.git
commit: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdirs:
- hpath-io
- hpath-directory
- git: https://github.com/hasufell/text-conversions.git
commit: 9abf0e5e5664a3178367597c32db19880477a53c
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base64-bytestring-1.1.0.0@sha256:190264fef9e65d9085f00ccda419137096d1dc94777c58272bc96821dc7f37c3,2334
- brick-0.55@sha256:f98736eca0cd694837062e06da4655eed969d53b789dfd919716e9b6f5b4c5ce,15858
- 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.0@sha256:7407835ce8c1e0e2fd6febd25391b12989b216773e685e3cf95bd89072af0ecc,1149
- haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466
- haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
- hpath-0.11.0@sha256:12b8405bee13d0007d644a888ef8407069ce7bbbd76970f8746b801447124ade,1440
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.2@sha256:eec4ff2b00dc86be847aca0f409fc8f6212ffd2170ec36a17dc9a52b46562392,1615
- http-io-streams-0.1.4.0@sha256:9a74a059daeddf7a41d361919190b9f4d4292f05e0e4bdf156e2098a116a8145,3582
- libarchive-3.0.0.0@sha256:e4157b307acf16cca0ec3d398ac5093cc06f092b33a9743be559ef0f6c6ae52f,11204
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
- primitive-unlifted-0.1.3.0@sha256:a98f827740f5dcf097d885b3a47c32f4462204449620abc9d51b8c4f8619f9e6,1427
- random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094
- splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- tar-bytestring-0.6.3.2@sha256:88f29bed56b688c543a4cb3986402d64b360f76b3fd9b88ac618b8344f8da712,5715
- versions-4.0.1@sha256:0f644c1587d38f0eb3c3fe364bf1822424db43cbd4d618d0e21473b062c45239,1936
- vty-5.30@sha256:4af3938d7b9e6096e222bf52d0ea5d39873bc6fe19febd34106906306af13730,20857
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
flags:
http-io-streams:
brotli: false
libarchive:
system-libarchive: false
ghcup:
tui: true
internal-downloader: true
system-ghc: true
compiler: ghc-8.8.4
compiler-check: match-exact
ghc-options:
"$locals": -O2
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

View File

@@ -1,205 +0,0 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module GHCup.ArbitraryTypes where
import GHCup.Types
import Data.ByteString ( ByteString )
import Data.Versions
import Data.List.NonEmpty
import HPath
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
import Test.QuickCheck.Arbitrary.Generic
import URI.ByteString
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Lazy as T
( toStrict )
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B
-----------------
--[ utilities ]--
-----------------
intToText :: Integral a => a -> T.Text
intToText = T.toStrict . B.toLazyText . B.decimal
genVer :: Gen (Int, Int, Int)
genVer =
(\x y z -> (getPositive x, getPositive y, getPositive z))
<$> arbitrary
<*> arbitrary
<*> arbitrary
instance ToADTArbitrary GHCupInfo
----------------------
--[ base arbitrary ]--
----------------------
instance Arbitrary T.Text where
arbitrary = fmap T.pack $ listOf $ elements ['a' .. 'z']
shrink xs = T.pack <$> shrink (T.unpack xs)
instance Arbitrary (NonEmpty Word) where
arbitrary = fmap fromList $ listOf1 $ arbitrary
-- utf8 encoded bytestring
instance Arbitrary ByteString where
arbitrary = fmap (E.encodeUtf8 . T.pack) $ listOf $ elements ['a' .. 'z']
---------------------
--[ uri arbitrary ]--
---------------------
instance Arbitrary Scheme where
arbitrary = oneof [ Scheme <$> pure "http", Scheme <$> pure "https" ]
instance Arbitrary Host where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Port where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (URIRef Absolute) where
arbitrary =
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> (Query <$> pure []) <*> pure Nothing
-------------------------
--[ version arbitrary ]--
-------------------------
instance Arbitrary Mess where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ mess
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary Version where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ version
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary SemVer where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ semver
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary PVP where
arbitrary = do
(x, y, z) <- genVer
pure
$ either (error . show) id
$ pvp
$ (intToText x <> "." <> intToText y <> "." <> intToText z)
instance Arbitrary Versioning where
arbitrary = Ideal <$> arbitrary
-----------------------
--[ ghcup arbitrary ]--
-----------------------
instance Arbitrary Requirements where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary DownloadInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary LinuxDistro where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Platform where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Tag where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Architecture where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionRange where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (NonEmpty VersionCmp) where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionCmp where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (Path Rel) where
arbitrary =
(either (error . show) id . parseRel . E.encodeUtf8 . T.pack)
<$> (listOf1 $ elements ['a' .. 'z'])
instance Arbitrary TarDir where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Tool where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary GHCupInfo where
arbitrary = genericArbitrary
shrink = genericShrink
-- our maps are nested... the default size easily blows up most ppls ram
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Tool v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Version) v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Platform v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary
instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Versioning) v) where
arbitrary = resize 8 $ M.fromList <$> arbitrary

View File

@@ -1,17 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
module GHCup.Types.JSONSpec where
import GHCup.ArbitraryTypes ()
import GHCup.Types
import GHCup.Types.JSON ()
import Test.Aeson.GenericSpecs
import Test.Hspec
spec :: Spec
spec = do
roundtripAndGoldenSpecs (Proxy @GHCupInfo)

View File

@@ -1,12 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
import Test.Hspec.Runner
import Test.Hspec.Formatters
import qualified Spec
main :: IO ()
main =
hspecWith
defaultConfig { configFormatter = Just progress }
$ Spec.spec

4
test/MyLibTest.hs Normal file
View File

@@ -0,0 +1,4 @@
module Main (main) where
main :: IO ()
main = putStrLn "Test suite not yet implemented."

View File

@@ -1,2 +0,0 @@
-- file test/Spec.hs
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

View File

@@ -149,17 +149,7 @@ function fill_in_bug_report_values() {
}
function copyToClipboard() {
const text = document.getElementById("ghcup-command-normal").innerText;
const el = document.createElement('textarea');
el.value = text;
document.body.appendChild(el);
el.select();
document.execCommand('copy');
document.body.removeChild(el);
}
function copyToClipboardSilicon() {
const text = document.getElementById("ghcup-command-silicon").innerText;
const text = document.getElementsByClassName("ghcup-command").item(0).innerText;
const el = document.createElement('textarea');
el.value = text;
document.body.appendChild(el);

View File

@@ -32,10 +32,7 @@
<div id="platform-instructions-mac" class="instructions" style="display: none;">
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
<p>On Intel:</p>
<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-normal">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p>On Apple Silicon:</p>
<div class="command-button"><pre><span class='ghcup-command' id="ghcup-command-silicon">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboardSilicon()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
</div>
@@ -104,11 +101,9 @@
<div id="platform-instructions-default" class="instructions">
<div>
<p>To install Haskell, if you are running Linux, macOS (on Intel), FreeBSD or Windows Subsystem for Linux, run the following
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following
in your terminal (as a user other than root), then follow the onscreen instructions.</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p>For macOS on Apple Silicon, run this instead:</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboardSilicon()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
</div>
@@ -151,11 +146,9 @@
<div id="platform-instructions-default" class="instructions">
<div>
<p>To install Haskell, if you are running Linux, macOS (on Intel), FreeBSD or Windows Subsystem for Linux, run the following
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following
in your terminal (as a user other than root), then follow the onscreen instructions.</p>
<pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre>
<p>For macOS on Apple Silicon, run this instead:</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboardSilicon()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
</div>