Compare commits

..

11 Commits

Author SHA1 Message Date
1a450545f2 Fix 2023-01-05 21:47:35 +08:00
8fe26d7042 loll 2023-01-05 21:41:01 +08:00
7fd27cd635 lol 2023-01-05 21:41:01 +08:00
fff2599c2c More 2023-01-05 21:41:01 +08:00
efb81e4bac More work 2023-01-05 21:41:01 +08:00
6a5043b68f Patch to ansi-terminal-game 2023-01-05 21:41:01 +08:00
44e8bec74c Add ansi-terminal-game 2023-01-05 21:41:00 +08:00
f564b1b533 More work 2023-01-05 21:41:00 +08:00
e6ce466700 lala 2023-01-05 21:41:00 +08:00
0f8c3ba9d9 WIP 2023-01-05 21:41:00 +08:00
d5483facdc Add ansi terminal skeleton 2023-01-05 21:41:00 +08:00
178 changed files with 17782 additions and 18241 deletions

View File

@@ -1,11 +1,10 @@
freebsd_instance:
image_family: freebsd-13-2
image_family: freebsd-13-1
build_task:
name: build
task:
env:
GHC_VER: 9.2.4
CABAL_VER: 3.8.1.0
CABAL_VER: 3.6.2.0
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
ARCH: 64
RUNNER_OS: FreeBSD
@@ -13,12 +12,10 @@ build_task:
GITHUB_WORKSPACE: ${CIRRUS_WORKING_DIR}
JSON_VERSION: "0.0.7"
CIRRUS_CLONE_SUBMODULES: true
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
AWS_ACCESS_KEY_ID: ENCRYPTED[3e99c4ac040871f213abd616ec66952d954dc289cdd97772f88e58a74d08a2250133437780fe98b7aedf7ef1fb32f5eb]
AWS_SECRET_ACCESS_KEY: ENCRYPTED[5910cfd77a922ff7fc06eeb6a6b9f79d4867863e541f06eb2c4cfecae0613650e3e0588373fa8d9249d295d76cf9cb3b]
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
install_script:
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
script:
- tzsetup Etc/GMT
- adjkerntz -a

View File

@@ -1,11 +0,0 @@
root = true
[*]
end_of_line = LF
trim_trailing_whitespace = true
insert_final_newline = true
[*.hs]
indent_style = space
indent_size = 2
max_line_length = 80

View File

@@ -2,7 +2,7 @@
set -eux
. .github/scripts/env.sh
. .github/scripts/prereq.sh
mkdir -p "$CI_PROJECT_DIR"/.local/bin
@@ -13,6 +13,4 @@ git describe --always
./scripts/bootstrap/bootstrap-haskell
[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
# https://github.com/actions/runner-images/issues/7061
[ "$(ghcup config | grep --color=never meta-mode)" = "meta-mode: Lax" ]

View File

@@ -1,27 +0,0 @@
#!/bin/sh
set -eux
. .github/scripts/env.sh
if [ -e "$HOME/.brew" ] ; then
(
cd "$HOME/.brew"
git fetch --depth 1
git reset --hard origin/master
)
else
git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
fi
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
mkdir -p $CI_PROJECT_DIR/.brew_cache
export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
mkdir -p $CI_PROJECT_DIR/.brew_logs
export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
mkdir -p /private/tmp/.brew_tmp
export HOMEBREW_TEMP=/private/tmp/.brew_tmp
brew update
brew install ${1+"$@"}

View File

@@ -2,36 +2,75 @@
set -eux
. .github/scripts/prereq.sh
. .github/scripts/common.sh
# ensure ghcup
if ! command -v ghcup ; then
install_ghcup
fi
# ensure cabal-cache
if ! cabal-cache version ; then
download_cabal_cache "$HOME/.local/bin/cabal-cache"
fi
# ensure ghc
if [ "${RUNNER_OS}" != "FreeBSD" ] ; then
if [ "${DISTRO}" != "Debian" ] ; then # ! armv7 or aarch64 linux
if ! "ghc-${GHC_VER}" --numeric-version ; then
ghcup -v install ghc --set --force "$GHC_VER"
fi
if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
ghcup -v install cabal --force "$CABAL_VER"
fi
ghc --version
cabal --version
GHC="ghc-${GHC_VER}"
else
if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
ghcup -v install cabal --force "$CABAL_VER"
fi
cabal --version
GHC="ghc"
fi
else
ghc --version
cabal --version
GHC="ghc"
fi
git_describe
# ensure ghcup
install_ghcup
# ensure cabal-cache
download_cabal_cache "$HOME/.local/bin/cabal-cache"
# install toolchain (if necessary)
ghcup -v install ghc --set --force "$GHC_VER"
ghcup -v install cabal --force "$CABAL_VER"
ghc --version
cabal --version
GHC="ghc-${GHC_VER}"
# build
ecabal update
build_with_cache --project-file=cabal.project.release -w "${GHC}" --enable-tests
if [ "${RUNNER_OS}" = "Linux" ] ; then
if [ "${ARCH}" = "32" ] ; then
build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
elif [ "${ARCH}" = "64" ] ; then
build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
else
build_with_cache -w "${GHC}" -ftui --enable-tests
fi
elif [ "${RUNNER_OS}" = "FreeBSD" ] ; then
build_with_cache -w "${GHC}" --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui --enable-tests
elif [ "${RUNNER_OS}" = "Windows" ] ; then
build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" --enable-tests
else
build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui --enable-tests
fi
# set up artifacts
mkdir -p out
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
binary_opttest=$(cabal --project-file=cabal.project.release list-bin ghcup-optparse-test)
binary=$(cabal list-bin ghcup)
binary_test=$(cabal list-bin ghcup-test)
ver=$("${binary}" --numeric-version)
strip_binary "${binary}"
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
cp "${binary_opttest}" "out/test-optparse-${ARTIFACT}-${ver}${ext}"
cp "${binary}" "out/${ARTIFACT}-${ver}"
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}"
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"

View File

@@ -1,13 +0,0 @@
#!/usr/bin/env bash
case "$(uname -s)" in
MSYS_*|MINGW*)
ext=".exe"
;;
*)
ext=""
;;
esac
echo "cabal-cache disabled (CABAL_CACHE_DISABLE set)"

View File

@@ -1,13 +1,23 @@
#!/bin/sh
. .github/scripts/env.sh
if [ "${RUNNER_OS}" = "Windows" ] ; then
ext=".exe"
else
ext=''
fi
ecabal() {
cabal "$@"
}
nonfatal() {
"$@" || "$* failed"
sync_from_retry() {
if [ "${RUNNER_OS}" != "Windows" ] ; then
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
else
cabal_store_path="${CABAL_DIR}/store"
fi
sync_from || { sleep 9 ; rm -rf "${cabal_store_path:?}"/* ; sync_from || { sleep 20 ; rm -rf "${cabal_store_path:?}"/* ; sync_from ; } }
}
sync_from() {
@@ -15,7 +25,7 @@ sync_from() {
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi
cabal-cache.sh sync-from-archive \
cabal-cache sync-from-archive \
--host-name-override=${S3_HOST} \
--host-port-override=443 \
--host-ssl-override=True \
@@ -24,12 +34,16 @@ sync_from() {
--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
}
sync_to_retry() {
sync_to || { sleep 9 ; sync_to || { sleep 20 ; sync_to ; } }
}
sync_to() {
if [ "${RUNNER_OS}" != "Windows" ] ; then
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi
cabal-cache.sh sync-to-archive \
cabal-cache sync-to-archive \
--host-name-override=${S3_HOST} \
--host-port-override=443 \
--host-ssl-override=True \
@@ -67,7 +81,6 @@ git_describe() {
download_cabal_cache() {
(
set -e
mkdir -p "$HOME/.local/bin"
dest="$HOME/.local/bin/cabal-cache"
url=""
exe=""
@@ -115,46 +128,31 @@ download_cabal_cache() {
mv "cabal-cache${exe}" "${dest}${exe}"
chmod +x "${dest}${exe}"
fi
# install shell wrapper
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
chmod +x "$HOME"/.local/bin/cabal-cache.sh
)
}
build_with_cache() {
ecabal configure "$@"
ecabal build --dependencies-only "$@" --dry-run
sync_from
ecabal build --dependencies-only "$@" || sync_to
sync_to
sync_from_retry
ecabal build --dependencies-only "$@" || sync_to_retry
sync_to_retry
ecabal build "$@"
sync_to
sync_to_retry
}
install_ghcup() {
case "${RUNNER_OS}" in
"Linux")
case "${ARCH}" in
"ARM"*)
if command -v ghcup ; then
mkdir -p "$GHCUP_BIN"
cp "$(command -v ghcup)" "$GHCUP_BIN/ghcup${ext}"
else
install_ghcup_curl_sh
fi
;;
*) install_ghcup_curl_sh
;;
esac
;;
*) install_ghcup_curl_sh
;;
esac
}
find "$GHCUP_INSTALL_BASE_PREFIX"
mkdir -p "$GHCUP_BIN"
mkdir -p "$GHCUP_BIN"/../cache
install_ghcup_curl_sh() {
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
if [ "${RUNNER_OS}" = "FreeBSD" ] ; then
curl -o ghcup https://downloads.haskell.org/ghcup/tmp/x86_64-portbld-freebsd-ghcup-0.1.18.1
chmod +x ghcup
mv ghcup "$HOME/.local/bin/ghcup"
else
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
fi
}
strip_binary() {

View File

@@ -1,74 +0,0 @@
#!/usr/bin/env bash
set -ex
. .github/scripts/common.sh
run() {
"$@"
}
if [ "${OS}" = "Windows" ] ; then
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
git_describe
rm -rf "${GHCUP_DIR}"
mkdir -p "${GHCUP_BIN}"
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}"
chmod +x "ghcup-test${ext}"
"$GHCUP_BIN/ghcup${ext}" --version
eghcup --version
sha_sum "$GHCUP_BIN/ghcup${ext}"
sha_sum "$(raw_eghcup --offline whereis ghcup)"
### cross build
eghcup --numeric-version
eghcup install ghc "${GHC_VER}"
eghcup set ghc "${GHC_VER}"
eghcup install cabal "${CABAL_VER}"
cabal --version
eghcup debug-info
ecabal update
"${WRAPPER}" "$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" -v \
compile ghc \
$(if [ -n "${HADRIAN_FLAVOUR}" ] ; then printf "%s" "--flavour=${HADRIAN_FLAVOUR}" ; else true ; fi) \
-j "$(nproc)" \
-v "${GHC_TARGET_VERSION}" \
-b "${GHC_VER}" \
-x "${CROSS}" \
-- ${BUILD_CONF_ARGS}
eghcup set ghc "${CROSS}-${GHC_TARGET_VERSION}"
[ "$($(eghcup whereis ghc "${CROSS}-${GHC_TARGET_VERSION}") --numeric-version)" = "${GHC_TARGET_VERSION}" ]
# test that doing fishy symlinks into GHCup dir doesn't cause weird stuff on 'ghcup nuke'
mkdir no_nuke/
mkdir no_nuke/bar
echo 'foo' > no_nuke/file
echo 'bar' > no_nuke/bar/file
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/cache/no_nuke
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/logs/no_nuke
# nuke
eghcup nuke
[ ! -e "${GHCUP_DIR}" ]
# make sure nuke doesn't resolve symlinks
[ -e "$CI_PROJECT_DIR"/no_nuke/file ]
[ -e "$CI_PROJECT_DIR"/no_nuke/bar/file ]

View File

@@ -1,30 +0,0 @@
#!/bin/sh
if [ "${RUNNER_OS}" = "Windows" ] ; then
ext=".exe"
else
ext=''
fi
export DEBIAN_FRONTEND=noninteractive
export TZ=Asia/Singapore
export OS="$RUNNER_OS"
export PATH="$HOME/.local/bin:$PATH"
if [ "${RUNNER_OS}" = "Windows" ] ; then
# on windows use pwd to get unix style path
CI_PROJECT_DIR="$(pwd)"
export CI_PROJECT_DIR
export GHCUP_INSTALL_BASE_PREFIX="/c"
export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
export PATH="$GHCUP_BIN:$PATH"
export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
else
export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
export PATH="$GHCUP_BIN:$PATH"
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
fi

View File

@@ -2,6 +2,7 @@
set -eux
. .github/scripts/prereq.sh
. .github/scripts/common.sh
mkdir -p "$CI_PROJECT_DIR"/.local/bin
@@ -33,7 +34,7 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
git_describe
eghcup install ghc "${GHC_VERSION}"
eghcup install cabal "${CABAL_VERSION}"
eghcup install cabal
ecabal update
@@ -56,9 +57,9 @@ eghcup debug-info
cd "haskell-language-server-${HLS_TARGET_VERSION}/"
ecabal configure -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)"
ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" --dry-run
sync_from
sync_from_retry
ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" || sync_to
sync_to
sync_to_retry
)
eghcup -v compile hls -j "$(nproc)" -g "${HLS_TARGET_VERSION}" --ghc "${GHC_VERSION}"

66
.github/scripts/prereq.sh vendored Normal file
View File

@@ -0,0 +1,66 @@
#!/bin/sh
mkdir -p "$HOME"/.local/bin
export OS="$RUNNER_OS"
export PATH="$HOME/.local/bin:$PATH"
: "${APT_GET:=apt-get}"
if [ "${RUNNER_OS}" = "Windows" ] ; then
# on windows use pwd to get unix style path
CI_PROJECT_DIR="$(pwd)"
export CI_PROJECT_DIR
export GHCUP_INSTALL_BASE_PREFIX="/c"
export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
export PATH="$GHCUP_BIN:$PATH"
export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
else
export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
export PATH="$GHCUP_BIN:$PATH"
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
fi
if [ "${RUNNER_OS}" = "Linux" ] ; then
if [ "${DISTRO}" = "Alpine" ] ; then
:
elif [ "${DISTRO}" = "Ubuntu" ] ; then
export DEBIAN_FRONTEND=noninteractive
export TZ=Asia/Singapore
if [ "${ARCH}" = "ARM64" ] || [ "${ARCH}" = "ARM" ] ; then
:
else
${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
fi
elif [ "${DISTRO}" = "Debian" ] ; then
export DEBIAN_FRONTEND=noninteractive
export TZ=Asia/Singapore
${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip
fi
elif [ "${RUNNER_OS}" = "macOS" ] ; then
if ! command -v brew ; then
[ -e "$HOME/.brew" ] ||
git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
brew update
fi
if ! command -v git ; then
brew install git
fi
if ! command -v realpath ; then
brew install coreutils
fi
if [ "${ARCH}" = "ARM64" ] ; then
brew install llvm@11 autoconf automake
export PATH="$HOME/.brew/opt/llvm@11/bin:$PATH"
export CC="$HOME/.brew/opt/llvm@11/bin/clang"
export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
export LD=ld
export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
fi
fi

View File

@@ -2,6 +2,7 @@
set -eux
. .github/scripts/prereq.sh
. .github/scripts/common.sh
@@ -18,10 +19,8 @@ mkdir -p "${GHCUP_BIN}"
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
cp "out/test-optparse-${ARTIFACT}"-* "ghcup-test-optparse${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}"
chmod +x "ghcup-test${ext}"
chmod +x "ghcup-test-optparse${ext}"
"$GHCUP_BIN/ghcup${ext}" --version
eghcup --version
@@ -31,8 +30,7 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
### Haskell test suite
./ghcup-test${ext}
./ghcup-test-optparse${ext}
rm ghcup-test${ext} ghcup-test-optparse${ext}
rm ghcup-test${ext}
### manual cli based testing
@@ -193,7 +191,7 @@ sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# invalidate access time timer, which is 5minutes, so we re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# redownload same file with some newlines added
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
# snapshot new yaml and etags file
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
@@ -203,7 +201,7 @@ sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# invalidate access time timer, which is 5minutes, but don't expect a re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# this time, we expect the same hash and etag
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
[ "${etag2}" = "${etag3}" ]

View File

@@ -20,12 +20,13 @@ jobs:
BOOTSTRAP_HASKELL_NONINTERACTIVE: yes
ARCH: 64
JSON_VERSION: "0.0.7"
APT_GET: "sudo apt-get"
strategy:
matrix:
include:
- os: ubuntu-latest
DISTRO: Ubuntu
- os: macOS-11
- os: macOS-10.15
DISTRO: na
- os: windows-latest
DISTRO: na
@@ -35,15 +36,7 @@ jobs:
with:
submodules: 'true'
- if: runner.os == 'Linux'
name: Run bootstrap
run: |
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
sh ./.github/scripts/bootstrap.sh
env:
DISTRO: ${{ matrix.DISTRO }}
- if: runner.os == 'macOS'
- if: runner.os != 'Windows'
name: Run bootstrap
run: sh ./.github/scripts/bootstrap.sh
env:
@@ -51,8 +44,5 @@ jobs:
- if: runner.os == 'Windows'
name: Run bootstrap
run: |
$curDir = Get-Location
Write-Host "Current Working Directory: $curDir"
./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash
run: ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ${GITHUB_WORKSPACE}/bootstrap-haskell -InBash
shell: pwsh

View File

@@ -29,7 +29,7 @@ jobs:
with:
args: --recursive
env:
AWS_S3_ENDPOINT: https://${{ secrets.S3_HOST }}
AWS_S3_ENDPOINT: ${{ secrets.S3_HOST }}
AWS_S3_BUCKET: ghcup-hs
AWS_REGION: us-west-2
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}

View File

@@ -1,140 +0,0 @@
name: Test cross bindists
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
schedule:
- cron: '0 2 * * *'
env:
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
CABAL_CACHE_NONFATAL: yes
jobs:
build:
name: Build linux binary
runs-on: ubuntu-latest
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ secrets.S3_HOST }}
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 64
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- name: Run build
uses: docker://hasufell/alpine-haskell:3.12
with:
args: sh .github/scripts/build.sh
env:
ARTIFACT: ${{ env.ARTIFACT }}
ARCH: ${{ env.ARCH }}
GHC_VER: ${{ env.GHC_VER }}
DISTRO: Alpine
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ env.S3_HOST }}
- if: always()
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: artifacts
path: |
./out/*
test-cross-linux:
name: Test linux cross
needs: "build"
runs-on: [self-hosted, Linux, X64]
container:
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
options: --user root
env:
CABAL_VER: 3.6.2.0
BUILD_CONF_ARGS: "--enable-unregisterised"
HADRIAN_FLAVOUR: ""
JSON_VERSION: "0.0.7"
GHC_VER: 8.10.6
GHC_TARGET_VERSION: "8.10.7"
ARCH: 64
DISTRO: Debian
ARTIFACT: "x86_64-linux-ghcup"
CROSS: "arm-linux-gnueabihf"
WRAPPER: "run"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- name: Run test (64 bit linux)
run: |
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
sudo apt-get install -y gcc-arm-linux-gnueabihf
sudo dpkg --add-architecture armhf
sudo apt-get update -y
sudo apt-get install -y libncurses-dev:armhf
sh .github/scripts/cross.sh
test-cross-js:
name: Test GHC JS cross
needs: "build"
runs-on: [self-hosted, Linux, X64]
container:
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
options: --user root
env:
CABAL_VER: 3.6.2.0
BUILD_CONF_ARGS: ""
HADRIAN_FLAVOUR: "default+native_bignum"
JSON_VERSION: "0.0.7"
GHC_VER: 9.6.2
GHC_TARGET_VERSION: "9.6.2"
ARCH: 64
DISTRO: Debian
ARTIFACT: "x86_64-linux-ghcup"
CROSS: "javascript-unknown-ghcjs"
WRAPPER: "emconfigure"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- name: Run test (64 bit linux)
run: |
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
git clone https://github.com/emscripten-core/emsdk.git
cd emsdk
./emsdk install latest
./emsdk activate latest
. ./emsdk_env.sh
cd ..
bash .github/scripts/cross.sh

View File

@@ -6,7 +6,7 @@ on:
- cron: '0 0 * * *'
jobs:
docker-alpine32:
docker-alpine:
runs-on: ubuntu-latest
steps:
- name: Checkout
@@ -26,24 +26,7 @@ jobs:
context: ./docker/alpine32
push: true
tags: hasufell/i386-alpine-haskell:3.12
platforms: |
linux/i386
linux/amd64
docker-alpine:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v3
- name: Set up QEMU
uses: docker/setup-qemu-action@v2
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@v2
- name: Login to Docker Hub
uses: docker/login-action@v2
with:
username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }}
platforms: linux/i386
- name: Build and push (alpine 64bit)
uses: docker/build-push-action@v3
with:
@@ -52,74 +35,34 @@ jobs:
tags: hasufell/alpine-haskell:3.12
platforms: linux/amd64
docker-arm32:
runs-on: [self-hosted, Linux, ARM64]
docker-arm:
runs-on: [self-hosted, Linux, aarch64]
steps:
- uses: docker://arm64v8/ubuntu:focal
name: Cleanup (aarch64 linux)
name: Cleanup
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
- name: Checkout
uses: actions/checkout@v3
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@v2
- name: Login to Docker Hub
uses: docker/login-action@v2
with:
username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }}
- name: Build and push (debian buster)
- name: Build and push (arm64v8)
uses: docker/build-push-action@v3
with:
context: ./docker/arm32v7/buster
push: true
tags: hasufell/arm32v7-debian-haskell:10
platforms: linux/arm
- name: Build and push (ubuntu focal)
uses: docker/build-push-action@v3
with:
context: ./docker/arm32v7/focal
push: true
tags: hasufell/arm32v7-ubuntu-haskell:focal
platforms: linux/arm
docker-aarch:
runs-on: [self-hosted, Linux, ARM64]
steps:
- uses: docker://arm64v8/ubuntu:focal
name: Cleanup (aarch64 linux)
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
- name: Checkout
uses: actions/checkout@v3
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@v2
- name: Login to Docker Hub
uses: docker/login-action@v2
with:
username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }}
- name: Build and push (debian buster)
uses: docker/build-push-action@v3
with:
context: ./docker/arm64v8/buster
push: true
tags: hasufell/arm64v8-debian-haskell:10
platforms: linux/arm64
- name: Build and push (ubuntu focal)
uses: docker/build-push-action@v3
with:
context: ./docker/arm64v8/focal
context: ./docker/arm64v8/
push: true
tags: hasufell/arm64v8-ubuntu-haskell:focal
platforms: linux/arm64
- name: Build and push (arm32v7)
uses: docker/build-push-action@v3
with:
context: ./docker/arm32v7
push: true
tags: hasufell/arm32v7-ubuntu-haskell:focal
platforms: linux/arm

View File

@@ -12,16 +12,12 @@ on:
schedule:
- cron: '0 2 * * *'
env:
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
CABAL_CACHE_NONFATAL: yes
jobs:
build-linux:
name: Build linux binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -85,7 +81,7 @@ jobs:
name: Build ARM binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -94,16 +90,16 @@ jobs:
fail-fast: true
matrix:
include:
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, aarch64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
GHC_VER: 8.10.7
ARCH: ARM
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, aarch64]
ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.6
GHC_VER: 8.10.7
ARCH: ARM64
steps:
- uses: docker://arm64v8/debian:10
- uses: docker://arm64v8/ubuntu:focal
name: Cleanup (aarch64 linux)
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
@@ -119,7 +115,7 @@ jobs:
submodules: 'true'
- if: matrix.ARCH == 'ARM'
uses: docker://hasufell/arm32v7-debian-haskell:10
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
name: Run build (armv7 linux)
with:
args: sh .github/scripts/build.sh
@@ -133,7 +129,7 @@ jobs:
S3_HOST: ${{ env.S3_HOST }}
- if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-debian-haskell:10
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
name: Run build (aarch64 linux)
with:
args: sh .github/scripts/build.sh
@@ -158,7 +154,7 @@ jobs:
name: Build binary (Mac/Win)
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.6.2.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
@@ -168,13 +164,13 @@ jobs:
fail-fast: false
matrix:
include:
- os: [self-hosted, macOS, ARM64]
- os: [self-hosted, macOS, aarch64]
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.2.5
ARCH: ARM64
- os: macOS-11
- os: macOS-10.15
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.2.5
ARCH: 64
- os: windows-latest
ARTIFACT: "x86_64-mingw64-ghcup"
@@ -186,48 +182,8 @@ jobs:
with:
submodules: 'true'
- if: matrix.ARCH == 'ARM64' && runner.os == 'macOS'
name: Run build
run: |
bash .github/scripts/brew.sh git coreutils llvm@11 autoconf automake
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$HOME/.brew/opt/llvm@11/bin:$PATH"
export CC="$HOME/.brew/opt/llvm@11/bin/clang"
export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
export LD=ld
export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
bash .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: na
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ env.S3_HOST }}
HOMEBREW_CHANGE_ARCH_TO_ARM: 1
- if: matrix.ARCH == '64' && runner.os == 'macOS'
name: Run build (windows/mac)
run: |
bash .github/scripts/brew.sh coreutils
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
bash .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: na
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ env.S3_HOST }}
HOMEBREW_CHANGE_ARCH_TO_ARM: 1
- if: runner.os == 'Windows'
name: Run build (windows/mac)
run: |
bash .github/scripts/brew.sh git coreutils autoconf automake
bash .github/scripts/build.sh
- name: Run build (windows/mac)
run: bash .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
@@ -246,12 +202,13 @@ jobs:
path: |
./out/*
test-linux:
name: Test linux
needs: "build-linux"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
@@ -307,14 +264,13 @@ jobs:
- if: matrix.DISTRO != 'Alpine'
name: Run test (64 bit linux)
run: |
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
sh .github/scripts/test.sh
run: sh .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: ${{ matrix.DISTRO }}
APT_GET: "sudo apt-get"
- if: failure()
name: Upload artifact
@@ -329,24 +285,24 @@ jobs:
needs: "build-arm"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, aarch64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
GHC_VER: 8.10.7
ARCH: ARM
DISTRO: Ubuntu
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, aarch64]
ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.6
GHC_VER: 8.10.7
ARCH: ARM64
DISTRO: Ubuntu
steps:
- uses: docker://arm64v8/debian:10
- uses: docker://arm64v8/ubuntu:focal
name: Cleanup (aarch64 linux)
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
@@ -362,7 +318,7 @@ jobs:
path: ./out
- if: matrix.ARCH == 'ARM'
uses: docker://hasufell/arm32v7-debian-haskell:10
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
name: Run test (armv7 linux)
with:
args: sh .github/scripts/test.sh
@@ -373,7 +329,7 @@ jobs:
DISTRO: Ubuntu
- if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-debian-haskell:10
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
name: Run test (aarch64 linux)
with:
args: sh .github/scripts/test.sh
@@ -396,20 +352,20 @@ jobs:
needs: "build-macwin"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.6.2.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: [self-hosted, macOS, ARM64]
- os: [self-hosted, macOS, aarch64]
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.2.5
ARCH: ARM64
DISTRO: na
- os: macOS-11
- os: macOS-10.15
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.2.5
ARCH: 64
DISTRO: na
- os: windows-latest
@@ -429,21 +385,7 @@ jobs:
name: artifacts
path: ./out
- if: runner.os == 'macOS'
name: Run test
run: |
bash .github/scripts/brew.sh coreutils
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
bash .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: ${{ matrix.DISTRO }}
HOMEBREW_CHANGE_ARCH_TO_ARM: 1
- if: runner.os != 'macOS'
name: Run test
- name: Run test (windows/mac)
run: bash .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
@@ -474,7 +416,7 @@ jobs:
env:
GHC_VERSION: "8.10.7"
HLS_TARGET_VERSION: "1.8.0.0"
CABAL_VERSION: "3.8.1.0"
CABAL_VERSION: "3.6.2.0"
JSON_VERSION: "0.0.7"
ARTIFACT: "x86_64-linux-ghcup"
DISTRO: Ubuntu
@@ -494,9 +436,9 @@ jobs:
path: ./out
- name: Run hls build
run: |
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
sh .github/scripts/hls.sh
run: sh .github/scripts/hls.sh
env:
APT_GET: "sudo apt-get"
release:
name: release

25
.travis.yml Normal file
View File

@@ -0,0 +1,25 @@
jobs:
include:
- os: osx
osx_image: xcode10.1
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.13-ghcup
- os: osx
osx_image: xcode11.3
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.14-ghcup
script: ".travis/build.sh"
deploy:
provider: releases
api_key:
secure: "hT2od8Iy04tdFVuonPSWv0NX5hZDmv4al8Q0GbIWmviUetROuM7c6/MCHUcgyiw6H2L3pmH4F24GBYWpKBT3ZMbxrKXhZOZ3KPLXzlnuRlm1qymKqqwsJs3466bMftaiBr16rx1VpAuditN4A32oSmTFcQAJc84Bxn2WZ4t8hk9muS8YPyLhqg3/NxT6ob8dzNp9eS2cA0WODMb/fMzaMruRtepSK8JvuXb/SnTvaDcl9plmPzEa+eW54jwVsDps8ZpQMQlTtGIjYHIwTQ36/iLH4LoAvD7OEnB7qf753LOzmI/bvlB75xYGsLxe1qgpzPMjuG3AK0jb2KGSZCzyAyrbBFSQMIyC1gNKMtab3CohnA9WdQqAT1xrzPzA9zNw516G5Fn/z+t9Ek1f6L2OYO2hJfweNhWh+ChAIsOags2QBpqc0qjkwUS4wqxCWBdyVfgPTUoGelvjCfjQgypgIyLEHFvXt9rlj+kd97FY7nG3vxZrsvWTKKKT551OqUYX5zWTyvGR71jKyNst/p93Pg3DkRy31gHrGnG9zfNgN5tWxJqDd/suR/BAFTp0VtkFb8fR3ct7WMVeJXtE2+bKqxO5Fnocs1VjEm8pKPk7glnp0muu08kaO0h54wiSOCbk1RvO1KZtHue4wKWrHcI18dwW2WtzoBQ4P1lOSkS81UY="
file: $ARTIFACT
on:
repo: hasufell/ghcup-hs
tags: true
skip_cleanup: true
draft: true

View File

@@ -1,54 +1,5 @@
# Revision history for ghcup
## 0.1.19.5 -- ????-?-??
* support JS cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838)
## 0.1.19.4 -- 2023-7-02
* fix missing TUI for aarch64 linux binaries
## 0.1.19.3 -- 2023-6-29
* Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824)
* Fix GC with XDG dirs, fixes [#810](https://github.com/haskell/ghcup-hs/issues/810)
## 0.1.19.2 -- 2023-2-24
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)
- the previous release had a bug that invalidated that broke it
* Implement 'latest-prerelease' tag wrt [#788](https://github.com/haskell/ghcup-hs/issues/788)
* Fix 'Could not parse version of stray directory.DS_Store' warnings on macOs wrt [#797](https://github.com/haskell/ghcup-hs/issues/797)
## 0.1.19.1 -- 2023-2-19
* Fix GHCup on JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#766](https://github.com/haskell/ghcup-hs/issues/766)
* Don't fail on setModificationTime, fixes [#784](https://github.com/haskell/ghcup-hs/issues/784) and many GitHub actions issues
* Make armv7/aarch64 linux binaries more portable (built on Debian buster)
* Improve usability on 'ghcup config add-release-channel', fixes [#751](https://github.com/haskell/ghcup-hs/issues/751)
* Make version shortcuts work with 'ghcup set', fixes [#757](https://github.com/haskell/ghcup-hs/issues/757)
* Don't implicitly smuggle in config options in `ghcup config set` wrt [#775](https://github.com/haskell/ghcup-hs/issues/775)
* Fix build on unix with -ftui
## 0.1.19.0 -- 2023-1-13
* restore proper support for FreeBSD and Linux armv7
* integrate with [errors.haskell.org](https://errors.haskell.org/index.html), wrt [#434](https://github.com/haskell/ghcup-hs/issues/434)
* allow to overwrite distro detection via config wrt [#421](https://github.com/haskell/ghcup-hs/issues/421)
- this is particularly useful for e.g. Ubuntu derivates, where ghcup doesn't pick the optimal bindist, also see the [GHCup documentation on overriding distro detection](https://www.haskell.org/ghcup/guide/#overriding-distro-detection)
* Add proper support for mirrors wrt [#357](https://github.com/haskell/ghcup-hs/issues/357)
* fix a (harmless) bug in `ghcup nuke` on windows
* improvements to `ghcup add-release-channel` wrt [#708](https://github.com/haskell/ghcup-hs/issues/708)
* fix building newer GHC from source wrt [#433](https://github.com/haskell/ghcup-hs/issues/433)
* Fix `ghcup install hls -u` on windows
* Fix failure with `--isolate=dir --force`
* Add `--metadata-fetching-mode` arg, fixes [#440](https://github.com/haskell/ghcup-hs/issues/440)
* Add content-length property to downloads
* [Fix a grave bug on armv7](https://github.com/haskell/ghcup-hs/commit/78ee956df2618862f421178a565c82548ff7e578) during installation wrt [#415](https://github.com/haskell/ghcup-hs/issues/415)
* improve many warning/error messages (contributions by @taylorfausak)
* some minor optimization in `ghcup whereis ghcup`
* improve `--keep=always` to not clean up directories in certain circumstances
## 0.1.18.1 -- 2022-08-06
* fix sdist and unbreak hackage, wrt [#399](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/399)

621
app/ghcup/AnsiMain.hs Normal file
View File

@@ -0,0 +1,621 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiWayIf #-}
module AnsiMain where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Prelude ( decUTF8Safe )
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prompts
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Types.Optics ( getDirs )
import GHCup.Utils
import Data.List (sort, intersperse)
import Data.Versions (prettyPVP, prettyVer)
import Codec.Archive
import Control.Monad.IO.Class
-- import System.Console.ANSI
import System.Console.ANSI
import Terminal.Game
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Control.Exception.Safe
import Control.Monad ( when, forM_ )
import Control.Monad.ST
import Control.Monad.Reader ( ReaderT(runReaderT), MonadReader, ask, lift )
import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource
import Data.Functor
import Data.STRef
import Data.IORef
import Data.Maybe ( fromMaybe, catMaybes )
import qualified Data.Text as Tx
import qualified Data.Tuple as T
import qualified Data.Vector as V
import GHC.IO ( unsafePerformIO )
import Haskus.Utils.Variant.Excepts
import System.Exit
import System.Environment (getExecutablePath)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy as L
import System.FilePath
import URI.ByteString (serializeURIRef')
data Direction = Up
| Down
deriving (Show, Eq)
data BrickData = BrickData
{ lr :: [ListResult]
}
deriving Show
data BrickSettings = BrickSettings
{ showAllVersions :: Bool
, showAllTools :: Bool
}
deriving Show
data BrickInternalState = BrickInternalState
{ clr :: V.Vector ListResult
, ix :: Int
}
deriving Show
data BrickState = BrickState
{ appData :: BrickData
, appSettings :: BrickSettings
, appState :: BrickInternalState
, appKeys :: KeyBindings
, appQuit :: Bool
, appRestart :: Bool
, appMoreInput :: Maybe String
}
deriving Show
startGame :: BrickState -> IO BrickState
startGame g = do
g'@BrickState { appRestart } <- errorPress $ playGameT liftIO (ghcupGame g)
if appRestart
then do
putStrLn "Press enter to continue"
_ <- getLine
startGame $ g' { appRestart = False }
else pure g'
ansiMain :: AppState -> IO ()
ansiMain s = do
writeIORef settings' s
eAppData <- getAppData (Just $ ghcupInfo s)
case eAppData of
Right ad -> do
let g = BrickState ad
defaultAppSettings
(constructList ad defaultAppSettings Nothing)
(keyBindings (s :: AppState))
False
False
Nothing
sizeCheck
void $ startGame g
cleanAndExit
Left e -> do
flip runReaderT s $ logError $ "Error building app state: " <> Tx.pack
(show e)
exitWith $ ExitFailure 2
where
sizeCheck :: IO ()
sizeCheck = let (w, h) = T.swap . snd $ boundaries in assertTermDims w h
ghcupGame :: BrickState -> Game BrickState
ghcupGame bs = Game 13
bs -- ticks per second
(\ge s e -> logicFun ge s e) -- logic function
(\r s -> centerFull r $ drawFun s r) -- draw function
(\s -> appQuit s || appRestart s) -- quit function
drawFun :: BrickState -> GEnv -> Plane
drawFun (BrickState {..}) GEnv{..} =
let focus pl = maybe pl
(\ix -> V.update pl (V.singleton (ix + 1, fmap invert $ pl V.! (ix + 1))))
mix
rows = V.fromList [header, [box (mw - 2) 1 '=']] V.++ renderItems
cols = V.foldr (\xs ys -> zipWith (:) xs ys) (repeat []) $ V.filter ((==5) . length) rows
padded = focus $ V.map (\xs -> zipWith padTo xs lengths) rows
lengths :: [Int]
lengths = fmap (maximum . fmap (fst . planeSize)) cols
in blankPlane mw mh
& (1, 1) % box 1 1 'X' -- '┌'
& (2, 1) % box 1 (mh - 3) '|' -- '│'
& (1, 2) % box (mw - 2) 1 '=' -- '─'
& (2, mw) % box 1 (mh - 3) '|' -- '│'
& (1, mw) % box 1 1 'X' -- '┐'
& (mh-1, 2) % box (mw - 2) 1 '=' -- '─'
& (mh-1, 1) % box 1 1 'X' -- '└'
& (mh-1, mw) % box 1 1 'X' -- '┘'
& (2, 2) % box (mw - 2) (mh - 3) ' ' -- ' '
& (2, 2) % vcat (hcat <$> V.toList padded)
& (mh, 1) % footer
& (1, mw `div` 2 - 2) % stringPlane "GHCup"
where
padTo :: Plane -> Int -> Plane
padTo plane x =
let lstr = fst $ planeSize plane
add' = x - lstr + 1
in if add' < 0 then plane else plane ||| stringPlane (replicate add' ' ')
mh :: Height
mw :: Width
(mh, mw) = T.swap eTermDims
footer = hcat
. intersperse (stringPlane " ")
. fmap stringPlane
$ ["q:Quit", "i:Install", "u:Uninstall", "s:Set", "c:Changelog", "a:all versions", "↑:Up", "↓:Down"]
header = fmap stringPlane [" ", "Tool", "Version", "Tags", "Notes"]
(renderItems, mix) = drawListElements renderItem appState
renderItem _ _ listResult@ListResult{..} =
let marks = if
| lSet -> color Green Vivid $ stringPlane "IS"
| lInstalled -> color Green Vivid $ stringPlane "I "
| otherwise -> color Red Vivid $ stringPlane "X "
ver = case lCross of
Nothing -> stringPlane . Tx.unpack . prettyVer $ lVer
Just c -> stringPlane . Tx.unpack $ (c <> "-" <> prettyVer lVer)
tool = printTool lTool
tag = let l = catMaybes . fmap printTag $ sort lTag
in if null l then blankPlane 1 1 else foldr1 (\x y -> x ||| stringPlane "," ||| y) l
notes = let n = printNotes listResult
in if null n
then blankPlane 1 1
else foldr1 (\x y -> x ||| stringPlane "," ||| y) n
in [marks ||| space, tool, ver, tag, notes]
printTag Recommended = Just $ color Green Dull $ stringPlane "recommended"
printTag Latest = Just $ color Yellow Dull $ stringPlane "latest"
printTag Prerelease = Just $ color Red Dull $ stringPlane "prerelease"
printTag (Base pvp'') = Just $ stringPlane ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing
printTag (UnknownTag t) = Just $ stringPlane t
printTool Cabal = stringPlane "cabal"
printTool GHC = stringPlane "GHC"
printTool GHCup = stringPlane "GHCup"
printTool HLS = stringPlane "HLS"
printTool Stack = stringPlane "Stack"
printNotes ListResult {..} =
(if hlsPowered then [color Green Dull $ stringPlane "hls-powered"] else mempty
)
++ (if fromSrc then [color Blue Dull $ stringPlane "compiled"] else mempty)
++ (if lStray then [color Blue Dull $ stringPlane "stray"] else mempty)
space = stringPlane " "
-- | 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 -> [Plane])
-> BrickInternalState
-> (V.Vector [Plane], Maybe Int)
drawListElements drawElem is@(BrickInternalState clr _) =
let es = clr
listSelected = fmap fst $ listSelectedElement' is
(drawnElements, selIx) = runST $ do
ref <- newSTRef (Nothing :: Maybe Int)
vec <- newSTRef (mempty :: V.Vector [Plane])
elem' <- newSTRef 0
void $ flip V.imapM es $ \i' e -> do
let isSelected = Just i' == listSelected
elemWidget = drawElem i' isSelected e
case es V.!? (i' - 1) of
Just e' | lTool e' /= lTool e -> do
modifySTRef elem' (+2)
i <- readSTRef elem'
when isSelected $ writeSTRef ref (Just i)
modifySTRef vec (`V.snoc` [hBorder])
modifySTRef vec (`V.snoc` elemWidget)
pure ()
_ -> do
modifySTRef elem' (+1)
i <- readSTRef elem'
when isSelected $ writeSTRef ref (Just i)
modifySTRef vec (`V.snoc` elemWidget)
pure ()
i <- readSTRef ref
arr <- readSTRef vec
pure (arr, i)
in (makeVisible drawnElements (mh - 5) selIx, selIx)
where
makeVisible :: V.Vector [Plane] -> Height -> Maybe Int -> V.Vector [Plane]
makeVisible listElements drawableHeight (Just ix) =
let listHeight = V.length listElements
in if | listHeight <= 0 -> listElements
| listHeight > drawableHeight ->
if | ix <= drawableHeight -> makeVisible (V.init listElements) drawableHeight (Just ix)
| otherwise -> makeVisible (V.tail listElements) drawableHeight (Just (ix - 1))
| otherwise -> listElements
makeVisible listElements _ Nothing = listElements
hBorder = box (mw - 2) 1 '='
logicFun :: GEnv -> BrickState -> Event -> IO BrickState
logicFun _ gs (KeyPress 'q') = pure gs { appQuit = True }
logicFun _ gs@BrickState{appMoreInput = Nothing} (KeyPress '\ESC') = pure gs { appMoreInput = Just "\ESC" }
logicFun _ gs@BrickState{appMoreInput = Just "\ESC"} (KeyPress '[') = pure gs { appMoreInput = Just "\ESC[" }
logicFun _ gs@BrickState{appMoreInput = Just "\ESC[", appState = s'} (KeyPress 'A')
= pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Up }
logicFun _ gs@BrickState{appMoreInput = Just "\ESC[", appState = s'} (KeyPress 'B')
= pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Down }
logicFun _ gs@BrickState{appMoreInput = Just _} _ = pure gs { appMoreInput = Nothing }
logicFun _ gs (KeyPress 'i') = do
bs <- withIOAction install' gs
pure bs { appRestart = True }
logicFun _ gs (KeyPress 'u') = do
bs <- withIOAction del' gs
pure bs { appRestart = True }
logicFun _ gs (KeyPress 's') = do
bs <- withIOAction set' gs
pure bs { appRestart = True }
logicFun _ gs (KeyPress 'c') = do
bs <- withIOAction changelog' gs
pure bs { appRestart = True }
logicFun _ gs (KeyPress 'a') = pure $ hideShowHandler (not . showAllVersions) showAllTools gs
where
hideShowHandler :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> BrickState -> BrickState
hideShowHandler f p BrickState{..} =
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
newInternalState = constructList appData newAppSettings (Just appState)
in BrickState appData newAppSettings newInternalState appKeys appQuit appRestart appMoreInput
-- windows powershell
logicFun _ gs@BrickState{ appState = s' } (KeyPress 'P') = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Down }
logicFun _ gs@BrickState{ appState = s' } (KeyPress 'H') = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Up }
logicFun _ gs Tick = pure gs
logicFun _ gs (KeyPress _) = pure gs
withIOAction :: (BrickState
-> (Int, ListResult)
-> ReaderT AppState IO (Either String a))
-> BrickState
-> IO BrickState
withIOAction action as = case listSelectedElement' (appState as) of
Nothing -> pure as
Just (ix, e) -> do
clearScreen
settings <- readIORef settings'
flip runReaderT settings $ action as (ix, e) >>= \case
Left err -> liftIO $ putStrLn ("Error: " <> err)
Right _ -> liftIO $ putStrLn "Success"
getAppData Nothing >>= \case
Right data' -> do
pure (updateList data' as)
Left err -> throwIO $ userError err
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
moveCursor steps ais@BrickInternalState{..} direction =
let newIx = if direction == Down then ix + steps else ix - steps
in case clr V.!? newIx of
Just _ -> BrickInternalState { ix = newIx, .. }
Nothing -> ais
defaultAppSettings :: BrickSettings
defaultAppSettings =
BrickSettings { showAllVersions = False, showAllTools = False }
-- | 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
, appQuit = appQuit
, appRestart = appRestart
, appMoreInput = appMoreInput
}
constructList
:: BrickData
-> BrickSettings
-> Maybe BrickInternalState
-> BrickInternalState
constructList appD appSettings = replaceLR
(filterVisible (showAllVersions appSettings) (showAllTools appSettings))
(lr appD)
-- | 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 -> Bool -> ListResult -> Bool
filterVisible v t e
| lInstalled e = True
| v, not t, lTool e `notElem` hiddenTools = True
| not v, t, Old `notElem` lTag e = True
| v, t = True
| otherwise = (Old `notElem` lTag e) && (lTool e `notElem` hiddenTools)
hiddenTools :: [Tool]
hiddenTools = []
selectLatest :: V.Vector ListResult -> Int
selectLatest = fromMaybe 0
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
listSelectedElement' BrickInternalState {..} = fmap (ix, ) $ clr V.!? ix
boundaries :: (Coords, Coords)
boundaries = ((1, 1), (24, 80))
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
install' _ (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let run =
runResourceT
. runE
@'[ AlreadyInstalled
, ArchiveResult
, UnknownArchive
, FileDoesNotExistError
, CopyError
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, DirNotEmpty
, NoUpdate
, TarDirDoesNotExist
, FileAlreadyExistsError
, ProcessError
, ToolShadowed
, UninstallFailed
, MergeFileTreeError
]
run (do
ce <- liftIO $ fmap (either (const Nothing) Just) $
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
dirs <- lift getDirs
case lTool of
GHC -> do
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
Cabal -> do
let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do
let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
Stack -> do
let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
)
>>= \case
VRight (vi, Dirs{..}, Just ce) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
case lTool of
GHCup -> do
up <- liftIO $ fmap (either (const Nothing) Just)
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
when ((normalise <$> up) == Just (normalise ce)) $
-- TODO: track cli arguments of previous invocation
void $ liftIO $ exec ce ["tui"] Nothing Nothing
logInfo "Please restart 'ghcup' for the changes to take effect"
_ -> pure ()
pure $ Right ()
VRight (vi, _, _) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo "Please restart 'ghcup' for the changes to take effect"
pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right ()
VLeft e -> pure $ Left $ prettyShow e <> "\n"
<> "Also check the logs in ~/.ghcup/logs"
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
set' bs input@(_, ListResult {..}) = do
settings <- liftIO $ readIORef settings'
let run =
flip runReaderT settings
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
run (do
case lTool of
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
Cabal -> liftE $ setCabal lVer $> ()
HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
Stack -> liftE $ setStack lVer $> ()
GHCup -> pure ()
)
>>= \case
VRight _ -> pure $ Right ()
VLeft e -> case e of
(V (NotInstalled tool _)) -> do
promptAnswer <- getUserPromptResponse userPrompt
case promptAnswer of
PromptYes -> do
res <- install' bs input
case res of
(Left err) -> pure $ Left err
(Right _) -> do
logInfo "Setting now..."
set' bs input
PromptNo -> pure $ Left (prettyShow e)
where
userPrompt = L.toStrict . B.toLazyText . B.fromString $
"This Version of "
<> show tool
<> " you are trying to set is not installed.\n"
<> "Would you like to install it first? [Y/N]: "
_ -> pure $ Left (prettyShow e)
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
del' _ (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let run = runE @'[NotInstalled, UninstallFailed]
run (do
let vi = getVersionInfo lVer lTool dls
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi
HLS -> liftE $ rmHLSVer lVer $> vi
Stack -> liftE $ rmStackVer lVer $> vi
GHCup -> pure Nothing
)
>>= \case
VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
VLeft e -> pure $ Left (prettyShow e)
changelog' :: (MonadReader AppState m, MonadIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do
let cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
Right _ -> pure $ Right ()
Left e -> pure $ Left $ prettyShow e
settings' :: IORef AppState
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
dirs <- getAllDirs
let loggerConfig = LoggerConfig { lcPrintDebug = False
, consoleOutter = \_ -> pure ()
, fileOutter = \_ -> pure ()
, fancyColors = True
}
newIORef $ AppState defaultSettings
dirs
defaultKeyBindings
(GHCupInfo mempty mempty mempty)
(PlatformRequest A_64 Darwin Nothing)
loggerConfig
getAppData :: Maybe GHCupInfo -> IO (Either String BrickData)
getAppData mgi = runExceptT $ do
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do
lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV)
getGHCupInfo :: IO (Either String GHCupInfo)
getGHCupInfo = do
settings <- readIORef settings'
r <-
flip runReaderT settings
. runE
@'[ DigestError
, ContentLengthError
, GPGError
, JSONError
, DownloadFailed
, FileDoesNotExistError
]
$ liftE getDownloadsF
case r of
VRight a -> pure $ Right a
VLeft e -> pure $ Left (prettyShow e)

View File

@@ -4,7 +4,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
module BrickMain where
@@ -45,7 +44,7 @@ import Data.IORef
import Data.Vector ( Vector
, (!?)
)
import Data.Versions
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.FilePath
@@ -73,8 +72,8 @@ data BrickData = BrickData
deriving Show
data BrickSettings = BrickSettings
{ showAllVersions :: Bool
, showAllTools :: Bool
{ showAllVersions :: Bool
, showAllTools :: Bool
}
deriving Show
@@ -96,11 +95,11 @@ data BrickState = BrickState
keyHandlers :: KeyBindings
-> [ ( Vty.Key
, BrickSettings -> String
, BrickState -> EventM String BrickState ()
, BrickState -> EventM n (Next BrickState)
)
]
keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , \_ -> halt)
[ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction set')
@@ -115,14 +114,14 @@ keyHandlers KeyBindings {..} =
if showAllTools then "Don't show all tools" else "Show all tools"
, hideShowHandler showAllVersions (not . showAllTools)
)
, (bUp, const "Up", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Up, .. })
, (bDown, const "Down", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Down, .. })
, (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. })
, (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
]
where
hideShowHandler f p BrickState{..} =
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
newInternalState = constructList appData newAppSettings (Just appState)
in put (BrickState appData newAppSettings newInternalState appKeys)
in continue (BrickState appData newAppSettings newInternalState appKeys)
showKey :: Vty.Key -> String
@@ -143,7 +142,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
where
footer =
withAttr (attrName "help")
withAttr "help"
. txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
@@ -155,15 +154,12 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> minHSize 15 (str "Version")
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
<+> padLeft (Pad 5) (str "Notes")
renderList' bis@BrickInternalState{..} =
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
renderList' = withDefAttr listAttr . drawListElements renderItem True
renderItem _ b listResult@ListResult{..} =
let marks = if
| lSet -> (withAttr (attrName "set") $ str "✔✔")
| lInstalled -> (withAttr (attrName "installed") $ str "")
| otherwise -> (withAttr (attrName "not-installed") $ str "")
| lSet -> (withAttr "set" $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "")
| otherwise -> (withAttr "not-installed" $ str "")
ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
@@ -171,22 +167,22 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
| lNoBindist && not lInstalled
&& not b -- TODO: overloading dim and active ignores active
-- so we hack around it here
= updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
= updateAttrMap (const dimAttrs) . withAttr "no-bindist"
| otherwise = id
hooray
| elem Latest lTag' && not lInstalled =
withAttr (attrName "hooray")
| elem Latest lTag && not lInstalled =
withAttr "hooray"
| otherwise = id
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id
in hooray $ active $ dim
( marks
<+> padLeft (Pad 2)
( minHSize 6
(printTool lTool)
)
<+> minHSize minVerSize (str ver)
<+> (let l = catMaybes . fmap printTag $ sort lTag'
in padLeft (Pad 1) $ minHSize minTagSize $ if null l
<+> 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
)
@@ -199,14 +195,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> vLimit 1 (fill ' ')
)
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly"
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 LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly"
printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
@@ -216,12 +209,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTool Stack = str "Stack"
printNotes ListResult {..} =
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
)
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [withAttr (attrName "day") $ str (show d)])
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
-- | Draws the list elements.
--
@@ -251,8 +242,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr
makeVisible' = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible' elemWidget
makeVisible = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible elemWidget
in render
$ viewport "GHCup" Vertical
@@ -267,8 +258,8 @@ minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
app :: AttrMap -> AttrMap -> App BrickState e String
app attrs dimAttrs =
App { appDraw = \st -> [ui dimAttrs st]
, appHandleEvent = \be -> get >>= \s -> eventHandler s be
, appStartEvent = return ()
, appHandleEvent = eventHandler
, appStartEvent = return
, appAttrMap = const attrs
, appChooseCursor = showFirstCursor
}
@@ -276,22 +267,18 @@ app attrs dimAttrs =
defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap
Vty.defAttr
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
[ ("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)
]
where
withForeColor | no_color = const
@@ -305,31 +292,31 @@ defaultAttributes no_color = attrMap
dimAttributes :: Bool -> AttrMap
dimAttributes no_color = attrMap
(Vty.defAttr `Vty.withStyle` Vty.dim)
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
, (attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
[ ("active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
]
where
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
eventHandler :: BrickState -> BrickEvent String e -> EventM String BrickState ()
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 _ _) ->
put (BrickState { appState = moveCursor 1 appState Up, .. })
continue (BrickState { appState = moveCursor 1 appState Up, .. })
(MouseDown _ Vty.BScrollDown _ _) ->
put (BrickState { appState = moveCursor 1 appState Down, .. })
(VtyEvent (Vty.EvResize _ _)) -> put st
continue (BrickState { appState = moveCursor 1 appState Down, .. })
(VtyEvent (Vty.EvResize _ _)) -> continue st
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
put BrickState{ appState = moveCursor 1 appState Up, .. }
continue BrickState{ appState = moveCursor 1 appState Up, .. }
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
put BrickState{ appState = moveCursor 1 appState Down, .. }
continue BrickState{ appState = moveCursor 1 appState Down, .. }
(VtyEvent (Vty.EvKey key _)) ->
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
Nothing -> put st
Nothing -> continue st
Just (_, _, handler) -> handler st
_ -> put st
_ -> continue st
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
@@ -342,14 +329,13 @@ moveCursor steps ais@BrickInternalState{..} direction =
-- | 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 :: Ord n
=> (BrickState
withIOAction :: (BrickState
-> (Int, ListResult)
-> ReaderT AppState IO (Either String a))
-> BrickState
-> EventM n BrickState ()
-> EventM n (Next BrickState)
withIOAction action as = case listSelectedElement' (appState as) of
Nothing -> put as
Nothing -> continue as
Just (ix, e) -> do
suspendAndResume $ do
settings <- readIORef settings'
@@ -418,17 +404,13 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
filterVisible v t e | lInstalled e = True
| v
, not t
, Nightly `notElem` lTag e
, lTool e `notElem` hiddenTools = True
| not v
, t
, Old `notElem` lTag e
, Nightly `notElem` lTag e = True
, Old `notElem` lTag e = True
| v
, Nightly `notElem` lTag e
, t = True
| otherwise = (Old `notElem` lTag e) &&
(Nightly `notElem` lTag e) &&
| otherwise = (Old `notElem` lTag e) &&
(lTool e `notElem` hiddenTools)
@@ -471,19 +453,19 @@ install' _ (_, ListResult {..}) = do
dirs <- lift getDirs
case lTool of
GHC -> do
let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
Cabal -> do
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do
let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
Stack -> do
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
)
>>= \case
@@ -564,7 +546,7 @@ del' _ (_, ListResult {..}) = do
let run = runE @'[NotInstalled, UninstallFailed]
run (do
let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
let vi = getVersionInfo lVer lTool dls
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi
@@ -574,7 +556,7 @@ del' _ (_, ListResult {..}) = do
)
>>= \case
VRight vi -> do
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
logGHCPostRm (mkTVer lVer)
forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
@@ -587,7 +569,7 @@ changelog' :: (MonadReader AppState m, MonadIO m)
-> m (Either String ())
changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (ToolVersion lVer) of
case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do
@@ -667,5 +649,5 @@ getAppData mgi = runExceptT $ do
settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do
lV <- listVersions Nothing [] False True (Nothing, Nothing)
lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV)

View File

@@ -8,7 +8,6 @@
module GHCup.OptParse (
module GHCup.OptParse.Common
, module GHCup.OptParse.Install
, module GHCup.OptParse.Test
, module GHCup.OptParse.Set
, module GHCup.OptParse.UnSet
, module GHCup.OptParse.Rm
@@ -32,7 +31,6 @@ module GHCup.OptParse (
import GHCup.OptParse.Common
import GHCup.OptParse.Install
import GHCup.OptParse.Test
import GHCup.OptParse.Set
import GHCup.OptParse.UnSet
import GHCup.OptParse.Rm
@@ -89,7 +87,6 @@ data Options = Options
data Command
= Install (Either InstallCommand InstallOptions)
| Test TestCommand
| InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions)
| UnSet UnsetCommand
@@ -107,6 +104,9 @@ data Command
| Nuke
#if defined(BRICK)
| Interactive
#endif
#if defined(ANSI)
| InteractiveAnsi
#endif
| Prefetch PrefetchCommand
| GC GCOptions
@@ -187,8 +187,19 @@ opts =
com :: Parser Command
com =
subparser
#if defined(BRICK)
#if defined(ANSI)
( command
"tui-ansi"
( (\_ -> InteractiveAnsi)
<$> info
helper
( progDesc "Start the interactive GHCup UI (ansi)"
)
)
<>
#endif
#if defined(BRICK)
command
"tui"
( (\_ -> Interactive)
<$> info
@@ -198,7 +209,7 @@ com =
)
<> command
#else
( command
command
#endif
"install"
( Install
@@ -208,14 +219,6 @@ com =
<> footerDoc (Just $ text installToolFooter)
)
)
<> command
"test"
(info
(Test <$> testParser <**> helper)
( progDesc "Run tests for a tool (if any) [EXPERIMENTAL!]"
<> footerDoc (Just $ text testFooter)
)
)
<> command
"set"
(info
@@ -244,8 +247,7 @@ com =
<> command
"list"
(info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools"
<> footerDoc (Just $ text listToolFooter))
(progDesc "Show available GHCs and other tools")
)
<> command
"upgrade"

View File

@@ -35,6 +35,7 @@ import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef')
import Data.Char (toLower)
@@ -49,7 +50,7 @@ data ChangeLogOptions = ChangeLogOptions
{ clOpen :: Bool
, clTool :: Maybe Tool
, clToolVer :: Maybe ToolVersion
} deriving (Eq, Show)
}
@@ -75,12 +76,12 @@ changelogP =
e -> Left e
)
)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup|stack>" <> help
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
"Open changelog for given tool (default: ghc)"
<> completer toolCompleter
)
)
<*> optional (toolVersionTagArgument [] Nothing)
<*> optional (toolVersionTagArgument Nothing Nothing)
@@ -114,15 +115,20 @@ changelog :: ( Monad m
changelog ChangeLogOptions{..} runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let tool = fromMaybe GHC clTool
ver' = fromMaybe
(ToolTag Latest)
ver' = maybe
(Right Latest)
(\case
GHCVersion tv -> Left (_tvVersion tv)
ToolVersion tv -> Left tv
ToolTag t -> Right t
)
clToolVer
muri = getChangeLog dls tool ver'
case muri of
Nothing -> do
runLogger
(logWarn $
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
)
pure ExitSuccess
Just uri -> do

View File

@@ -5,7 +5,6 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Common where
@@ -46,9 +45,7 @@ import Data.Functor
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
import Data.Maybe
import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions
import Data.Versions hiding ( str )
import Data.Void
import qualified Data.Vector as V
import GHC.IO.Exception
@@ -75,27 +72,26 @@ import qualified Cabal.Config as CC
--[ Types ]--
-------------
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
-- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolVersion Version
| SetToolTag Tag
| SetToolDay Day
| SetRecommended
| SetNext
deriving (Eq, Show)
prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolDay day) = show day
prettyToolVer (ToolTag t) = show t
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
toSetToolVer Nothing = SetRecommended
@@ -106,28 +102,28 @@ toSetToolVer Nothing = SetRecommended
--------------
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument criteria tool =
argument (eitherReader (parser tool))
(metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool)
where
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
mv _ = "VERSION|TAG|RELEASE_DATE"
mv (Just GHC) = "GHC_VERSION|TAG"
mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG"
parser (Just GHC) = ghcVersionTagEither
parser Nothing = ghcVersionTagEither
parser _ = toolVersionTagEither
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
@@ -241,23 +237,21 @@ isolateParser f = case isValid f && isAbsolute f of
-- this accepts cross prefix
ghcVersionTagEither :: String -> Either String ToolVersion
ghcVersionTagEither s' =
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
-- this ignores cross prefix
toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither s' =
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
"latest-prerelease" -> Right LatestPrerelease
"latest-nightly" -> Right LatestNightly
"recommended" -> Right Recommended
"latest" -> Right Latest
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left $ "Unknown tag " <> other
other -> Left $ "Unknown tag " <> other
ghcVersionEither :: String -> Either String GHCTargetVersion
@@ -266,7 +260,7 @@ ghcVersionEither =
toolVersionEither :: String -> Either String Version
toolVersionEither =
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
first (const "Not a valid version") . MP.parse version' "" . T.pack
toolParser :: String -> Either String Tool
@@ -277,22 +271,12 @@ toolParser s' | t == T.pack "ghc" = Right GHC
| otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack s')
dayParser :: String -> Either String Day
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
criteriaParser :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
| t == T.pack "set" = Right $ ListSet True
| t == T.pack "available" = Right $ ListAvailable True
| t == T.pack "+installed" = Right $ ListInstalled True
| t == T.pack "+set" = Right $ ListSet True
| t == T.pack "+available" = Right $ ListAvailable True
| t == T.pack "-installed" = Right $ ListInstalled False
| t == T.pack "-set" = Right $ ListSet False
| t == T.pack "-available" = Right $ ListAvailable False
| otherwise = Left ("Unknown criteria: " <> s')
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
| t == T.pack "set" = Right ListSet
| t == T.pack "available" = Right ListAvailable
| otherwise = Left ("Unknown criteria: " <> s')
where t = T.toLower (T.pack s')
@@ -468,12 +452,12 @@ tagCompleter tool add = listIOCompleter $ do
let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
versionCompleter' criteria tool filter' = listIOCompleter $ do
dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig
@@ -502,7 +486,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
installedVersions <- runEnv $ listVersions (Just tool) criteria
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
@@ -670,7 +654,6 @@ fromVersion :: ( HasLog env
-> Tool
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
@@ -689,58 +672,46 @@ fromVersion' :: ( HasLog env
-> Tool
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
second Just <$> getRecommended dls tool
bimap mkTVer Just <$> getRecommended dls tool
?? TagNotFound Recommended tool
fromVersion' (SetGHCVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo v tool dls
let vi = getVersionInfo (_tvVersion v) tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
Right pvpIn ->
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mt v', Just vi')
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
Nothing -> pure (v, vi)
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
fromVersion' (SetToolVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo v tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
case pvp $ prettyVer v of -- need to be strict here
Left _ -> pure (mkTVer v, vi)
Right pvpIn ->
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (v, vi)
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mempty v', Just vi')
Nothing -> pure (mkTVer v, vi)
fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
fromVersion' (SetToolTag LatestNightly) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
fromVersion' (SetToolTag (Base pvp'')) GHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion' SetNext tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
next <- case tool of
@@ -785,7 +756,7 @@ fromVersion' SetNext tool = do
. sort
$ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo next tool dls
let vi = getVersionInfo (_tvVersion next) tool dls
pure (next, vi)
fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool
@@ -801,15 +772,15 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m
, MonadFail m
)
=> m [(Tool, GHCTargetVersion)]
=> m [(Tool, Version)]
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
forMM (getLatest dls t) $ \(l, _) -> do
@@ -824,7 +795,7 @@ checkForUpdates = do
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
logGHCPostRm ghcVer = do
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir

View File

@@ -57,7 +57,6 @@ import Text.Read (readEither)
data CompileCommand = CompileGHC GHCCompileOptions
| CompileHLS HLSCompileOptions
deriving (Eq, Show)
@@ -67,7 +66,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: GHC.GHCVer
{ targetGhc :: GHC.GHCVer Version
, bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int
, buildConfig :: Maybe FilePath
@@ -77,9 +76,9 @@ data GHCCompileOptions = GHCCompileOptions
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String
, buildSystem :: Maybe BuildSystem
, hadrian :: Bool
, isolateDir :: Maybe FilePath
} deriving (Eq, Show)
}
data HLSCompileOptions = HLSCompileOptions
@@ -94,7 +93,7 @@ data HLSCompileOptions = HLSCompileOptions
, patches :: Maybe (Either FilePath [URI])
, targetGHCs :: [ToolVersion]
, cabalArgs :: [Text]
} deriving (Eq, Show)
}
@@ -171,7 +170,7 @@ ghcCompileOpts =
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile"
<> (completer $ versionCompleter [] GHC)
<> (completer $ versionCompleter Nothing GHC)
)
) <|>
(GHC.GitDist <$> (GitBranch <$> option
@@ -206,7 +205,7 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC"
<> help
"The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter [] GHC)
<> (completer $ versionCompleter Nothing GHC)
)
<*> optional
(option
@@ -259,7 +258,7 @@ ghcCompileOpts =
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter [] GHC)
<> (completer $ versionCompleter Nothing GHC)
)
)
<*> optional
@@ -269,22 +268,16 @@ ghcCompileOpts =
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
)
)
<*> (
(\b -> if b then Just Hadrian else Nothing) <$> switch
(long "hadrian" <> help "Use the hadrian build system instead of make. Tries to detect by default."
<*> switch
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
)
<|>
(\b -> if b then Just Make else Nothing) <$> switch
(long "make" <> help "Use the make build system instead of hadrian. Tries to detect by default."
)
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
)
)
@@ -298,7 +291,7 @@ hlsCompileOpts =
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The version to compile (pulled from hackage)"
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
)
)
<|>
@@ -318,7 +311,7 @@ hlsCompileOpts =
)
(long "source-dist" <> metavar "VERSION" <> help
"The version to compile (pulled from packaged git sources)"
<> (completer $ versionCompleter [] HLS)
<> (completer $ versionCompleter Nothing HLS)
)
))
<|>
@@ -350,7 +343,7 @@ hlsCompileOpts =
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter [] HLS)
<> (completer $ versionCompleter Nothing HLS)
)
)
<|>
@@ -367,7 +360,7 @@ hlsCompileOpts =
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory")
)
)
@@ -410,7 +403,7 @@ hlsCompileOpts =
option (eitherReader ghcVersionTagEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC [])
<> completer (versionCompleter [] GHC))
<> completer (versionCompleter Nothing GHC))
)
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@@ -460,7 +453,6 @@ type HLSEffects = '[ AlreadyInstalled
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
@@ -518,7 +510,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
case targetHLS of
HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) HLS dls
let vi = getVersionInfo targetVer HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
@@ -538,7 +530,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) HLS dls
let vi = getVersionInfo targetVer HLS dls
when setCompile $ void $ liftE $
setHLS targetVer SetHLSOnly Nothing
pure (vi, targetVer)
@@ -562,12 +554,15 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions {..}) ->
runCompileGHC runAppState (do
case targetGhc of
GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) GHC dls
let vi = getVersionInfo targetVer GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
@@ -575,8 +570,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure ()
targetVer <- liftE $ compileGHC
targetGhc
crossTarget
((\case
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
GHC.GitDist g -> GHC.GitDist g
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
ovewrwiteVer
bootstrapGhc
jobs
@@ -584,10 +581,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
addConfArgs
buildFlavour
buildSystem
hadrian
(maybe GHCupInternal IsolateDir isolateDir)
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly Nothing
pure (vi, targetVer)

View File

@@ -51,8 +51,7 @@ data ConfigCommand
= ShowConfig
| SetConfig String (Maybe String)
| InitConfig
| AddReleaseChannel Bool URI
deriving (Eq, Show)
| AddReleaseChannel URI
@@ -75,7 +74,7 @@ configP = subparser
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
addP = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
(progDesc "Add a release channel from a URI")
@@ -121,38 +120,20 @@ formatConfig :: UserSettings -> String
formatConfig = UTF8.toString . Y.encode
updateSettings :: UserSettings -> UserSettings -> UserSettings
updateSettings usl usr =
let cache' = uCache usl <|> uCache usr
metaCache' = uMetaCache usl <|> uMetaCache usr
metaMode' = uMetaMode usl <|> uMetaMode usr
noVerify' = uNoVerify usl <|> uNoVerify usr
verbose' = uVerbose usl <|> uVerbose usr
keepDirs' = uKeepDirs usl <|> uKeepDirs usr
downloader' = uDownloader usl <|> uDownloader usr
urlSource' = uUrlSource usl <|> uUrlSource usr
noNetwork' = uNoNetwork usl <|> uNoNetwork usr
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
mirrors' = uMirrors usl <|> uMirrors usr
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
where
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
updateKeyBindings Nothing Nothing = Nothing
updateKeyBindings (Just kbl) Nothing = Just kbl
updateKeyBindings Nothing (Just kbr) = Just kbr
updateKeyBindings (Just kbl) (Just kbr) =
Just $ UserKeyBindings {
kUp = kUp kbl <|> kUp kbr
, kDown = kDown kbl <|> kDown kbr
, kQuit = kQuit kbl <|> kQuit kbr
, kInstall = kInstall kbl <|> kInstall kbr
, kUninstall = kUninstall kbl <|> kUninstall kbr
, kSet = kSet kbl <|> kSet kbr
, kChangelog = kChangelog kbl <|> kChangelog kbr
, kShowAll = kShowAll kbl <|> kShowAll kbr
, kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
}
updateSettings :: UserSettings -> Settings -> Settings
updateSettings UserSettings{..} Settings{..} =
let cache' = fromMaybe cache uCache
metaCache' = fromMaybe metaCache uMetaCache
metaMode' = fromMaybe metaMode uMetaMode
noVerify' = fromMaybe noVerify uNoVerify
keepDirs' = fromMaybe keepDirs uKeepDirs
downloader' = fromMaybe downloader uDownloader
verbose' = fromMaybe verbose uVerbose
urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting
platformOverride' = uPlatformOverride <|> platformOverride
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
@@ -160,9 +141,6 @@ updateSettings usl usr =
--[ Entrypoint ]--
------------------
data Duplicate = Duplicate -- ^ there is a duplicate somewhere in the middle
| NoDuplicate -- ^ there is no duplicate
| DuplicateLast -- ^ there's a duplicate, but it's the last element
config :: forall m. ( Monad m
@@ -172,11 +150,10 @@ config :: forall m. ( Monad m
)
=> ConfigCommand
-> Settings
-> UserSettings
-> KeyBindings
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
config configCommand settings userConf keybindings runLogger = case configCommand of
config configCommand settings keybindings runLogger = case configCommand of
InitConfig -> do
path <- getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
@@ -207,55 +184,27 @@ config configCommand settings userConf keybindings runLogger = case configComman
pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65
AddReleaseChannel force uri -> do
r <- runE @'[DuplicateReleaseChannel] $ do
case urlSource settings of
AddSource xs -> do
case checkDuplicate xs (Right uri) of
Duplicate
| not force -> throwE (DuplicateReleaseChannel uri)
DuplicateLast -> pure ()
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (appendUnique xs (Right uri)) })
GHCupURL -> do
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
pure ()
OwnSource xs -> do
case checkDuplicate xs (Right uri) of
Duplicate
| not force -> throwE (DuplicateReleaseChannel uri)
DuplicateLast -> pure ()
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (appendUnique xs (Right uri)) })
OwnSpec spec -> do
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource [Left spec, Right uri] })
pure ()
case r of
VRight _ -> do
AddReleaseChannel uri -> do
case urlSource settings of
AddSource xs -> do
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
pure ExitSuccess
GHCupURL -> do
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
pure ExitSuccess
OwnSource xs -> do
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
pure ExitSuccess
OwnSpec spec -> do
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 15
where
checkDuplicate :: Eq a => [a] -> a -> Duplicate
checkDuplicate xs a
| last xs == a = DuplicateLast
| a `elem` xs = Duplicate
| otherwise = NoDuplicate
-- appends the element to the end of the list, but also removes it from the existing list
appendUnique :: Eq a => [a] -> a -> [a]
appendUnique xs' e = go xs'
where
go [] = [e]
go (x:xs)
| x == e = go xs -- skip
| otherwise = x : go xs
doConfig :: MonadIO m => UserSettings -> m ()
doConfig usersettings = do
let settings' = updateSettings usersettings userConf
let settings' = updateSettings usersettings settings
path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ settings'
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
runLogger $ logDebug $ T.pack $ show settings'
pure ()

View File

@@ -47,7 +47,7 @@ data GCOptions = GCOptions
, gcHLSNoGHC :: Bool
, gcCache :: Bool
, gcTmp :: Bool
} deriving (Eq, Show)
}

View File

@@ -54,7 +54,6 @@ data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
deriving (Eq, Show)
@@ -71,7 +70,7 @@ data InstallOptions = InstallOptions
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
} deriving (Eq, Show)
}
@@ -185,7 +184,7 @@ installOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool))
)
)
<*> (Just <$> toolVersionTagArgument [] tool)
<*> (Just <$> toolVersionTagArgument Nothing tool)
)
<|> pure (Nothing, Nothing)
)
@@ -197,7 +196,7 @@ installOpts tool =
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated absolute directory instead of the default one"
<> help "install in an isolated dir instead of the default one"
<> completer (bashCompleter "directory")
)
)
@@ -242,7 +241,6 @@ type InstallEffects = '[ AlreadyInstalled
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
@@ -286,7 +284,6 @@ type InstallGHCEffects = '[ AlreadyInstalled
, NotInstalled
, ProcessError
, TagNotFound
, DayNotFound
, TarDirDoesNotExist
, UninstallFailed
, UnknownArchive
@@ -325,7 +322,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
v
(_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
@@ -336,8 +333,8 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
v
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
(_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
@@ -406,7 +403,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing Nothing)
(DownloadInfo uri Nothing "" Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -456,7 +453,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy
liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -505,7 +502,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing Nothing)
(DownloadInfo uri Nothing "" Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall

View File

@@ -0,0 +1,183 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.List where
import GHCup
import GHCup.Prelude
import GHCup.Prelude.Ansi
import GHCup.Types
import GHCup.OptParse.Common
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Char
import Data.List ( intercalate, sort )
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Data.Void
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import System.Console.Pretty hiding ( color )
import qualified Data.Text as T
import qualified System.Console.Pretty as Pretty
import Control.Exception.Safe (MonadMask)
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
---------------
--[ Options ]--
---------------
data ListOptions = ListOptions
{ loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
, lRawFormat :: Bool
}
---------------
--[ Parsers ]--
---------------
listOpts :: Parser ListOptions
listOpts =
ListOptions
<$> optional
(option
(eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all"
<> completer (toolCompleter)
)
)
<*> optional
(option
(eitherReader criteriaParser)
( short 'c'
<> long "show-criteria"
<> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions"
<> completer (listCompleter ["installed", "set", "available"])
)
)
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
-----------------
--[ Utilities ]--
-----------------
printListResult :: Bool -> Bool -> [ListResult] -> IO ()
printListResult no_color raw lr = do
let
color | raw || no_color = (\_ x -> x)
| otherwise = Pretty.color
let
printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
printTag Old = ""
let
rows =
(\x -> if raw
then x
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
)
. fmap
(\ListResult {..} ->
let marks = if
| lSet -> (color Green (if isWindows then "IS" else "✔✔"))
| lInstalled -> (color Green (if isWindows then "I " else ""))
| otherwise -> (color Red (if isWindows then "X " else ""))
in
(if raw then [] else [marks])
++ [ fmap toLower . show $ lTool
, case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
, intercalate "," (filter (/= "") . fmap printTag $ sort lTag)
, intercalate ","
$ (if hlsPowered
then [color Green "hls-powered"]
else mempty
)
++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty)
++ (if lNoBindist
then [color Red "no-bindist"]
else mempty
)
]
)
$ lr
let cols =
foldr (\xs ys -> zipWith (:) xs ys) (repeat []) rows
lengths = fmap (maximum . fmap strWidth) cols
padded = fmap (\xs -> zipWith padTo xs lengths) rows
forM_ (if raw then rows else padded) $ \row -> putStrLn $ unwords row
where
padTo str' x =
let lstr = strWidth str'
add' = x - lstr
in if add' < 0 then str' else str' ++ replicate add' ' '
------------------
--[ Entrypoint ]--
------------------
list :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> ListOptions
-> Bool
-> (ReaderT AppState m ExitCode -> m ExitCode)
-> m ExitCode
list ListOptions{..} no_color runAppState =
runAppState (do
l <- listVersions loTool lCriteria
liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess
)

View File

@@ -76,8 +76,8 @@ nuke appState runLogger = do
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
forM_ lInstalled (liftE . rmTool)

View File

@@ -83,7 +83,7 @@ prefetchP = subparser
<$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> optional (toolVersionTagArgument [] (Just GHC)) )
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
( progDesc "Download GHC assets for installation")
)
<>
@@ -92,7 +92,7 @@ prefetchP = subparser
(info
(PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation")
)
<>
@@ -101,7 +101,7 @@ prefetchP = subparser
(info
(PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation")
)
<>
@@ -110,7 +110,7 @@ prefetchP = subparser
(info
(PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation")
)
<>
@@ -148,7 +148,6 @@ Examples:
type PrefetchEffects = '[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NoDownload
@@ -195,7 +194,7 @@ prefetch prefetchCommand runAppState runLogger =
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc
then liftE $ fetchGHCSrc v pfCacheDir
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')

View File

@@ -29,7 +29,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Data.Versions
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
@@ -50,7 +50,6 @@ data RmCommand = RmGHC RmOptions
| RmCabal Version
| RmHLS Version
| RmStack Version
deriving (Eq, Show)
@@ -62,7 +61,7 @@ data RmCommand = RmGHC RmOptions
data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion
} deriving (Eq, Show)
}
@@ -81,19 +80,19 @@ rmParser =
<> command
"cabal"
( RmCabal
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
(progDesc "Remove Cabal version")
)
<> command
"hls"
( RmHLS
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version")
)
<> command
"stack"
( RmStack
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
(progDesc "Remove stack version")
)
)
@@ -103,7 +102,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
@@ -171,7 +170,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmGHCVer ghcVer
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo ghcVer GHC dls)
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
)
>>= \case
VRight vi -> do
@@ -187,7 +186,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmCabalVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (mkTVer tv) Cabal dls)
pure (getVersionInfo tv Cabal dls)
)
>>= \case
VRight vi -> do
@@ -202,7 +201,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmHLSVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (mkTVer tv) HLS dls)
pure (getVersionInfo tv HLS dls)
)
>>= \case
VRight vi -> do
@@ -217,7 +216,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmStackVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (mkTVer tv) Stack dls)
pure (getVersionInfo tv Stack dls)
)
>>= \case
VRight vi -> do

View File

@@ -68,7 +68,7 @@ data RunOptions = RunOptions
, runBinDir :: Maybe FilePath
, runQuick :: Bool
, runCOMMAND :: [String]
} deriving (Eq, Show)
}
@@ -92,7 +92,7 @@ runOpts =
(eitherReader ghcVersionTagEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC [])
<> (completer $ versionCompleter [] GHC)
<> (completer $ versionCompleter Nothing GHC)
)
)
<*> optional
@@ -100,7 +100,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter [] Cabal)
<> (completer $ versionCompleter Nothing Cabal)
)
)
<*> optional
@@ -108,7 +108,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS [])
<> (completer $ versionCompleter [] HLS)
<> (completer $ versionCompleter Nothing HLS)
)
)
<*> optional
@@ -116,7 +116,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack [])
<> (completer $ versionCompleter [] Stack)
<> (completer $ versionCompleter Nothing Stack)
)
)
<*> optional
@@ -132,7 +132,7 @@ runOpts =
<*> switch
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@@ -175,7 +175,6 @@ type RunEffects = '[ AlreadyInstalled
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
@@ -255,7 +254,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
liftIO $ putStr tmp
pure ExitSuccess
(cmd:args) -> do
newEnv <- liftIO $ addToPath tmp runAppendPATH
newEnv <- liftIO $ addToPath tmp
#ifndef IS_WINDOWS
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
pure ExitSuccess
@@ -283,7 +282,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
)
=> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] (ResourceT (ReaderT AppState m)) Toolchain
@@ -334,7 +332,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
-> FilePath
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, UnknownArchive
@@ -360,7 +357,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' GHC v
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
v
(_tvVersion v)
GHCupInternal
False
[]
@@ -444,6 +441,17 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
liftE $ setHLS v SetHLS_XYZ (Just tmp)
liftE $ setHLS v SetHLSOnly (Just tmp)
addToPath path = do
cEnv <- Map.fromList <$> getEnvironment
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] (if runAppendPATH then (curPaths ++ [path]) else (path : curPaths))
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
pathVar = if isWindows then "Path" else "PATH"
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
liftIO $ setEnv pathVar newPath
return envWithNewPath
createTmpDir :: ( MonadUnliftIO m
, MonadCatch m
, MonadThrow m

View File

@@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions
import Data.Versions hiding ( str )
import GHC.Unicode
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
@@ -53,7 +53,6 @@ data SetCommand = SetGHC SetOptions
| SetCabal SetOptions
| SetHLS SetOptions
| SetStack SetOptions
deriving (Eq, Show)
@@ -65,7 +64,7 @@ data SetCommand = SetGHC SetOptions
data SetOptions = SetOptions
{ sToolVer :: SetToolVersion
} deriving (Eq, Show)
}
@@ -140,9 +139,9 @@ setParser =
setOpts :: Tool -> Parser SetOptions
setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$>
optional (setVersionArgument [ListInstalled True] tool))
optional (setVersionArgument (Just ListInstalled) tool))
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
setVersionArgument criteria tool =
argument (eitherReader setEither)
(metavar "VERSION|TAG|next"
@@ -185,7 +184,6 @@ setFooter = [s|Discussion:
type SetGHCEffects = '[ FileDoesNotExistError
, NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -200,7 +198,6 @@ runSetGHC runAppState =
type SetCabalEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -215,7 +212,6 @@ runSetCabal runAppState =
type SetHLSEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -230,7 +226,6 @@ runSetHLS runAppState =
type SetStackEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -264,7 +259,7 @@ set :: forall m env.
-> m (VEither eff GHCTargetVersion))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
set setCommand runAppState _ runLogger = case setCommand of
set setCommand runAppState runLeanAppState runLogger = case setCommand of
(Right sopts) -> do
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
setGHC' sopts
@@ -276,7 +271,10 @@ set setCommand runAppState _ runLogger = case setCommand of
where
setGHC' :: SetOptions
-> m ExitCode
setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do
setGHC' SetOptions{ sToolVer } =
case sToolVer of
(SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
_ -> runSetGHC runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer GHC
liftE $ setGHC v SetGHCOnly Nothing
)
@@ -293,7 +291,10 @@ set setCommand runAppState _ runLogger = case setCommand of
setCabal' :: SetOptions
-> m ExitCode
setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do
setCabal' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
_ -> runSetCabal runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
liftE $ setCabal (_tvVersion v)
pure v
@@ -310,7 +311,10 @@ set setCommand runAppState _ runLogger = case setCommand of
setHLS' :: SetOptions
-> m ExitCode
setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do
setHLS' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
_ -> runSetHLS runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer HLS
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
pure v
@@ -328,7 +332,10 @@ set setCommand runAppState _ runLogger = case setCommand of
setStack' :: SetOptions
-> m ExitCode
setStack' SetOptions{ sToolVer } = runSetStack runAppState (do
setStack' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
_ -> runSetStack runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Stack
liftE $ setStack (_tvVersion v)
pure v

View File

@@ -48,7 +48,6 @@ data UnsetCommand = UnsetGHC UnsetOptions
| UnsetCabal UnsetOptions
| UnsetHLS UnsetOptions
| UnsetStack UnsetOptions
deriving (Eq, Show)
@@ -60,7 +59,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
data UnsetOptions = UnsetOptions
{ sToolVer :: Maybe T.Text -- target platform triple
} deriving (Eq, Show)
}
@@ -69,7 +68,7 @@ data UnsetOptions = UnsetOptions
--[ Parsers ]--
---------------
unsetParser :: Parser UnsetCommand
unsetParser =
subparser
@@ -114,14 +113,7 @@ unsetParser =
unsetGHCFooter :: String
unsetGHCFooter = [s|Discussion:
Unsets the the current GHC version. That means there won't
be a ~/.ghcup/bin/ghc anymore.
Examples:
# unset ghc
ghcup unset ghc
# unset ghc for the target version
ghcup unset ghc armv7-unknown-linux-gnueabihf|]
be a ~/.ghcup/bin/ghc anymore.|]
unsetCabalFooter :: String
unsetCabalFooter = [s|Discussion:

View File

@@ -35,7 +35,7 @@ import System.Environment
import GHCup.Utils
import System.FilePath
import GHCup.Types.Optics
import Data.Versions
import Data.Versions hiding (str)
@@ -50,7 +50,7 @@ import Data.Versions
data UpgradeOpts = UpgradeInplace
| UpgradeAt FilePath
| UpgradeGHCupDir
deriving (Eq, Show)
deriving Show

View File

@@ -54,7 +54,6 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
| WhereisCacheDir
| WhereisLogsDir
| WhereisConfDir
deriving (Eq, Show)
@@ -67,7 +66,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
data WhereisOptions = WhereisOptions {
directory :: Bool
} deriving (Eq, Show)
}
@@ -83,7 +82,7 @@ whereisP = subparser
command
"ghc"
(WhereisTool GHC <$> info
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter ))
)
@@ -91,7 +90,7 @@ whereisP = subparser
command
"cabal"
(WhereisTool Cabal <$> info
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter ))
)
@@ -99,7 +98,7 @@ whereisP = subparser
command
"hls"
(WhereisTool HLS <$> info
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter ))
)
@@ -107,7 +106,7 @@ whereisP = subparser
command
"stack"
(WhereisTool Stack <$> info
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter ))
)
@@ -223,7 +222,6 @@ type WhereisEffects = '[ NotInstalled
, NoToolVersionSet
, NextVerNotFound
, TagNotFound
, DayNotFound
]

View File

@@ -13,6 +13,9 @@ module Main where
#if defined(BRICK)
import BrickMain ( brickMain )
#endif
#if defined(ANSI)
import AnsiMain ( ansiMain )
#endif
import qualified GHCup.GHC as GHC
import qualified GHCup.HLS as HLS
@@ -63,7 +66,7 @@ import qualified GHCup.Types as Types
toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
toSettings :: Options -> IO (Settings, KeyBindings)
toSettings options = do
noColor <- isJust <$> lookupEnv "NO_COLOR"
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -73,7 +76,7 @@ toSettings options = do
pure defaultUserSettings
_ -> do
die "Unexpected error!"
pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
pure $ mergeConf options userConf noColor
where
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
mergeConf Options{..} UserSettings{..} noColor =
@@ -89,7 +92,6 @@ toSettings options = do
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
@@ -176,7 +178,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-- create ~/.ghcup dir
ensureDirectories dirs
(settings, keybindings, userConf) <- toSettings opt
(settings, keybindings) <- toSettings opt
-- logger interpreter
logfile <- runReaderT initGHCupFileLogging dirs
@@ -235,12 +237,15 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
UnSet _ -> pure ()
#if defined(BRICK)
Interactive -> pure ()
#endif
#if defined(ANSI)
InteractiveAnsi -> pure ()
#endif
-- check for new tools
_
| Just False <- optVerbose -> pure ()
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
@@ -249,7 +254,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
case t of
GHCup -> runLogger $
logWarn ("New GHCup version available: "
<> tVerToText l
<> prettyVer l
<> ". To upgrade, run 'ghcup upgrade'")
_ -> runLogger $
logWarn ("New "
@@ -258,7 +263,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
<> "If you want to install this latest version, run 'ghcup install "
<> T.pack (prettyShow t)
<> " "
<> tVerToText l
<> prettyVer l
<> "'")
Just _ -> pure ()
@@ -293,17 +298,21 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
Interactive -> do
s' <- appState
liftIO $ brickMain s' >> pure ExitSuccess
#endif
#if defined(ANSI)
InteractiveAnsi -> do
s' <- appState
liftIO $ ansiMain s' >> pure ExitSuccess
#endif
Install installCommand -> install installCommand settings appState runLogger
InstallCabalLegacy iopts -> install (Left (InstallCabal iopts)) settings appState runLogger
Test testCommand -> test testCommand settings appState runLogger
Set setCommand -> set setCommand runAppState runLeanAppState runLogger
UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger
List lo -> list lo no_color runAppState
Rm rmCommand -> rm rmCommand runAppState runLogger
DInfo -> dinfo runAppState runLogger
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
Config configCommand -> config configCommand settings userConf keybindings runLogger
Config configCommand -> config configCommand settings keybindings runLogger
Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
@@ -332,10 +341,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, MonadCatch m
)
=> Command
-> (Tool, GHCTargetVersion)
-> (Tool, Version)
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
@@ -368,13 +376,12 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
)
=> Tool
-> Maybe ToolVersion
-> GHCTargetVersion
-> Version
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool
pure (v == ver)
pure (v == mkTVer ver)

View File

@@ -5,10 +5,17 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
tests: True
flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0,
package libarchive
flags: -system-libarchive
@@ -25,5 +32,6 @@ package aeson
package streamly
flags: +use-unliftio
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-8.10.7

View File

@@ -1,9 +1,8 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.6.3.0,
constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic,
any.Cabal-syntax ==3.8.1.0,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.4,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2,
@@ -11,13 +10,13 @@ constraints: any.Cabal ==3.6.3.0,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.1.1.0,
any.aeson ==2.0.3.0,
aeson -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only,
any.alex ==3.2.7.1,
any.ansi-terminal ==0.11.4,
ansi-terminal -example +win32-2-13-1,
any.ansi-terminal ==0.11.3,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
@@ -29,27 +28,23 @@ constraints: any.Cabal ==3.6.3.0,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.14.3.0,
any.base-compat ==0.12.2,
any.base-compat-batteries ==0.12.2,
any.base-orphans ==0.8.7,
any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.2.1.0,
any.bifunctors ==5.5.14,
any.bifunctors ==5.5.12,
bifunctors +semigroups +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.8.0,
any.binary-instances ==1.0.3,
any.binary-orphans ==1.0.3,
any.blaze-builder ==0.4.2.2,
any.brick ==1.5,
any.brick ==0.64.2,
brick -demos,
any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.5,
any.cabal-plan ==0.7.2.3,
any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
@@ -57,12 +52,14 @@ constraints: any.Cabal ==3.6.3.0,
any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.clock ==0.8.3,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.5.0,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
@@ -72,7 +69,6 @@ constraints: any.Cabal ==3.6.3.0,
any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2,
any.data-fix ==0.3.2,
any.deepseq ==1.4.4.0,
@@ -84,57 +80,58 @@ constraints: any.Cabal ==3.6.3.0,
dlist -werror,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.10,
any.free ==5.1.8,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1,
any.ghc ==8.10.7,
any.ghc-boot ==8.10.7,
any.ghc-boot-th ==8.10.7,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-heap ==8.10.7,
any.ghc-prim ==0.6.1,
any.ghci ==8.10.7,
any.happy ==1.20.0,
any.hashable ==1.4.2.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.hashable ==1.4.0.2,
hashable +containers +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.2.1,
any.heaps ==0.4,
any.hpc ==0.6.1.0,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.8,
any.hspec-core ==2.10.8,
any.hspec-discover ==2.10.8,
any.hspec ==2.9.7,
any.hspec-core ==2.9.7,
any.hspec-discover ==2.9.7,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.1,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1.1.1,
any.indexed-traversable-instances ==0.1.1,
any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.2,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.2,
any.language-c ==0.9.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.2,
libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.2.1,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.11,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.2,
any.microlens-th ==0.4.3.10,
any.mtl ==2.2.2,
any.network ==3.1.2.7,
network -devel,
any.network-uri ==2.6.4.2,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2,
any.optics-core ==0.4.1,
@@ -146,7 +143,7 @@ constraints: any.Cabal ==3.6.3.0,
any.os-release ==1.0.2.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
@@ -158,12 +155,12 @@ constraints: any.Cabal ==3.6.3.0,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.1,
any.recursion-schemes ==5.2.2.3,
any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.6,
any.resourcet ==1.2.5,
any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0.1,
@@ -176,11 +173,11 @@ constraints: any.Cabal ==3.6.3.0,
any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.5,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.4,
splitmix -optimised-mixer,
any.stm ==2.5.0.1,
any.streamly ==0.8.3,
any.streamly ==0.8.2,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.4.0.1,
strict +assoc,
@@ -188,24 +185,20 @@ constraints: any.Cabal ==3.6.3.0,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.5.1.1,
tar -old-bytestring -old-time,
any.template-haskell ==2.16.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.3,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4,
any.text ==2.0.1,
text -developer +simdutf,
any.text-binary ==0.2.1.1,
any.text ==1.2.4.1,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.12,
any.text-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.5.0,
any.th-compat ==0.1.4,
any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.20,
any.th-lift-instances ==0.1.19,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
@@ -214,12 +207,12 @@ constraints: any.Cabal ==3.6.3.0,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.1,
any.unicode-data ==0.3.0,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.8,
any.unix-bytestring ==0.3.7.7,
any.unix-compat ==0.6,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
@@ -231,9 +224,8 @@ constraints: any.Cabal ==3.6.3.0,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-binary-instances ==0.2.5.2,
any.versions ==5.0.4,
any.vty ==5.37,
any.versions ==5.0.3,
any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
@@ -243,4 +235,4 @@ constraints: any.Cabal ==3.6.3.0,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2023-01-12T04:22:48Z
index-state: hackage.haskell.org 2022-06-04T19:47:01Z

37
cabal.ghc902.project Normal file
View File

@@ -0,0 +1,37 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
tests: True
flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0,
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.2

238
cabal.ghc902.project.freeze Normal file
View File

@@ -0,0 +1,238 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.0.3.0,
aeson -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only,
any.alex ==3.2.7.1,
any.ansi-terminal ==0.11.3,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.4,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.15.1.0,
any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.2.1.0,
any.bifunctors ==5.5.12,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.2,
any.brick ==0.64.2,
brick -demos,
any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.clock ==0.8.3,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.2,
any.data-fix ==0.3.2,
any.deepseq ==1.4.5.0,
any.directory ==1.3.6.2,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.8,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.ghc ==9.0.2,
any.ghc-bignum ==1.1,
any.ghc-boot ==9.0.2,
any.ghc-boot-th ==9.0.2,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-heap ==9.0.2,
any.ghc-prim ==0.7.0,
any.ghci ==9.0.2,
any.happy ==1.20.0,
any.hashable ==1.4.0.2,
hashable +containers +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.2.1,
any.heaps ==0.4,
any.hpc ==0.6.1.0,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.9.7,
any.hspec-core ==2.9.7,
any.hspec-discover ==2.9.7,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.1,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.2,
libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.2.1,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.2,
any.microlens-th ==0.4.3.10,
any.mtl ==2.2.2,
any.network ==3.1.2.7,
network -devel,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2,
any.optics-core ==0.4.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.0.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.4.0,
any.process ==1.6.13.2,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.1,
any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.5,
any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.3,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.2.0.1,
semialign +semigroupoids,
any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.4,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.streamly ==0.8.2,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.template-haskell ==2.17.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.5,
any.text ==1.2.5.0,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.19,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.0,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.7,
any.unix-compat ==0.6,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.19.1,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.3,
any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.1,
any.yaml-streamly ==0.12.1,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2022-06-04T19:47:01Z

37
cabal.ghc923.project Normal file
View File

@@ -0,0 +1,37 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
tests: True
flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0,
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.2.3

233
cabal.ghc923.project.freeze Normal file
View File

@@ -0,0 +1,233 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.0.3.0,
aeson -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only,
any.alex ==3.2.7.1,
any.ansi-terminal ==0.11.3,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.4,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.16.2.0,
any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.2.1.0,
any.bifunctors ==5.5.12,
bifunctors +semigroups +tagged,
any.binary ==0.8.9.0,
any.blaze-builder ==0.4.2.2,
any.brick ==0.64.2,
brick -demos,
any.bytestring ==0.11.3.1,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.clock ==0.8.3,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.2,
any.data-fix ==0.3.2,
any.deepseq ==1.4.6.1,
any.directory ==1.3.7.0,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.2,
any.free ==5.1.8,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.ghc-bignum ==1.2,
any.ghc-boot-th ==9.2.3,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.8.0,
any.happy ==1.20.0,
any.hashable ==1.4.0.2,
hashable +containers +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.2.1,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree,
any.hspec ==2.9.2,
any.hspec-core ==2.9.2,
any.hspec-discover ==2.9.2,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.1,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.2,
libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.2.1,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.2,
any.microlens-th ==0.4.3.10,
any.mtl ==2.2.2,
any.network ==3.1.2.7,
network -devel,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2,
any.optics-core ==0.4.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.0.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.15.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.4.0,
any.process ==1.6.14.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.1,
any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.5,
any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.3,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.2.0.1,
semialign +semigroupoids,
any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.4,
splitmix -optimised-mixer,
any.stm ==2.5.0.2,
any.streamly ==0.8.2,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.template-haskell ==2.18.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.5,
any.text ==1.2.5.0,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.19,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.0,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.7,
any.unix-compat ==0.6,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.19.1,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.3,
any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.1,
any.yaml-streamly ==0.12.1,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2022-06-04T19:47:01Z

View File

@@ -2,16 +2,20 @@ packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
package ghcup
flags: +tui
optimization: 2
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
package ghcup
tests: True
flags: +tui-ansi
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0,
package libarchive
flags: -system-libarchive
@@ -28,5 +32,4 @@ package aeson
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: base, ghc-prim, template-haskell, language-c

View File

@@ -1,2 +1,2 @@
-- windows picks weird version
constraints: any.hsc2hs ==0.68.8
constraints: any.hsc2hs ==0.68.7

View File

@@ -1,55 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
if os(linux)
package ghcup
flags: +tui
if arch(x86_64) || arch(i386)
package *
ghc-options: -split-sections -optl-static
elif os(darwin)
constraints: zlib +bundled-c-zlib,
lzma +static
package ghcup
flags: +tui
elif os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf
package ghcup
flags: -tui
elif os(freebsd)
constraints: zlib +bundled-c-zlib,
zip +disable-zstd
package *
ghc-options: -split-sections -pgmc clang++14
package ghcup
flags: +tui
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio

View File

@@ -92,30 +92,3 @@ url-source:
# tag: Linux
# version: '18.04'
platform-override: null
# Support for mirrors. Currently there are 3 hosts you can mirror:
# - github.com (for stack and some older HLS versions)
# - raw.githubusercontent.com (for the yaml metadata)
# - downloads.haskell.org (for everything else)
#
# E.g. when we have 'https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
# and the following mirror config
#
# "raw.githubusercontent.com":
# authority:
# host: "mirror.sjtu.edu.cn"
# pathPrefix: "ghcup/yaml"
#
# Then the resulting url will be 'https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
mirrors:
"github.com":
authority:
host: "mirror.sjtu.edu.cn"
"raw.githubusercontent.com":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "ghcup/yaml"
"downloads.haskell.org":
authority:
host: "mirror.sjtu.edu.cn"

View File

@@ -1,4 +1,4 @@
FROM --platform=linux/i386 i386/alpine:3.12
FROM i386/alpine:3.12
ENV LANG C.UTF-8
@@ -37,8 +37,8 @@ RUN apk add --no-cache \
xz-dev \
ncurses-static
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -37,9 +37,8 @@ RUN apk add --no-cache \
xz-dev \
ncurses-static
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 9 1
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.17.8
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
@@ -54,7 +54,10 @@ ENV NO_COLOR=1
RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
ghcup gc -s -c -t
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
rm -r "/usr/share/doc/ghc-${GHC}" && \
rm -rf /tmp/ghcup* && \
ghcup gc -p -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH

View File

@@ -1,61 +0,0 @@
FROM arm32v7/debian:10
ENV LANG C.UTF-8
ENV DEBIAN_FRONTEND=noninteractive
ENV TZ=Asia/Singapore
COPY update_opt.sh /usr/bin/update_opt.sh
RUN chmod +x /usr/bin/update_opt.sh
RUN apt-get update && \
apt-get install -y --no-install-recommends \
ca-certificates \
curl \
dirmngr \
g++ \
git \
gnupg \
libsqlite3-dev \
libtinfo-dev \
libgmp-dev \
make \
netbase \
openssh-client \
xz-utils \
zlib1g-dev \
libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
llvm-11 clang-11 && \
rm -rf /var/lib/apt/lists/*
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/armv7-linux-ghcup-$GHCUP_VERSION && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
gpg --verify SHA256SUMS.sig SHA256SUMS && \
sha256sum -c --ignore-missing SHA256SUMS && \
mv armv7-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1
# install haskell toolchain
RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
ghcup gc -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
CMD ["ghci"]

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 9 1
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
@@ -54,7 +54,10 @@ ENV NO_COLOR=1
RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
ghcup gc -s -c -t
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
rm -r "/usr/share/doc/ghc-${GHC}" && \
rm -rf /tmp/ghcup* && \
ghcup gc -p -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH

View File

@@ -1,61 +0,0 @@
FROM arm64v8/debian:10
ENV LANG C.UTF-8
ENV DEBIAN_FRONTEND=noninteractive
ENV TZ=Asia/Singapore
COPY update_opt.sh /usr/bin/update_opt.sh
RUN chmod +x /usr/bin/update_opt.sh
RUN apt-get update && \
apt-get install -y --no-install-recommends \
ca-certificates \
curl \
dirmngr \
g++ \
git \
gnupg \
libsqlite3-dev \
libtinfo-dev \
libgmp-dev \
make \
netbase \
openssh-client \
xz-utils \
zlib1g-dev \
libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
llvm-11 clang-11 && \
rm -rf /var/lib/apt/lists/*
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/aarch64-linux-ghcup-$GHCUP_VERSION && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
gpg --verify SHA256SUMS.sig SHA256SUMS && \
sha256sum -c --ignore-missing SHA256SUMS && \
mv aarch64-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1
# install haskell toolchain
RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
ghcup gc -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
CMD ["ghci"]

View File

@@ -1,36 +0,0 @@
#!/bin/bash
# update_alternatives.sh
update_alternatives() {
local version=${1}
local priority=${2}
local master=${3}
local slaves=${4}
local path=${5}
local cmdln
cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
for slave in ${slaves}; do
cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
done
update-alternatives ${cmdln}
}
if [[ ${#} -ne 2 ]]; then
echo usage: "${0}" clang_version priority
exit 1
fi
version=${1}
priority=${2}
path="/usr/bin/"
master="llvm-config"
slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
master="clang"
slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"

View File

@@ -1,36 +0,0 @@
#!/bin/bash
# update_alternatives.sh
update_alternatives() {
local version=${1}
local priority=${2}
local master=${3}
local slaves=${4}
local path=${5}
local cmdln
cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
for slave in ${slaves}; do
cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
done
update-alternatives ${cmdln}
}
if [[ ${#} -ne 2 ]]; then
echo usage: "${0}" clang_version priority
exit 1
fi
version=${1}
priority=${2}
path="/usr/bin/"
master="llvm-config"
slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
master="clang"
slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"

View File

@@ -43,12 +43,6 @@ All of the following are valid arguments to `ghcup install ghc`:
If the argument is omitted, the default is `recommended`.
Other tags include:
- `prerelease`: a prerelease version
- `latest-prerelease`: the latest prerelease version
## 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.
@@ -169,7 +163,6 @@ ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
#### Known mirrors
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
### (Pre-)Release channels
@@ -467,10 +460,8 @@ this is cryptographically secure.
First, obtain the gpg keys:
```sh
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
Then verify the gpg key in one of these ways:

View File

@@ -4,6 +4,10 @@ hide:
- toc
---
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
<script src="javascripts/extra.js"></script>
<section class="index-ghcup-hero">
<img alt="haskell logo" src="./haskell_logo.png" />
<h1>GHCup</h1>
@@ -31,7 +35,7 @@ hide:
<span>
</span>
<div class="footer">
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
</div>
</div>
@@ -47,7 +51,7 @@ hide:
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
</div>
<div class="footer">
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
</div>
</div>
</section>
@@ -80,6 +84,9 @@ hide:
</span>
</p>
<script type="text/javascript" src="javascripts/ghcup.js"></script>
----

View File

@@ -1,7 +1,7 @@
# Installation
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
## How to install
@@ -24,7 +24,7 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-installation) and GPG verify the binaries.
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
### Which versions get installed?
@@ -38,78 +38,47 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
### Linux Debian
#### Generic
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 11
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Ubuntu
#### Generic
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.04 && < 20.10
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.10
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Fedora
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
### Linux Mageia
The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
### Linux CentOS
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
#### Version >= 7 && < 8
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses xz perl`
### Linux Alpine
#### Generic
The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
### Linux VoidLinux
The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
### Linux (generic)
#### Generic
You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
### Darwin
#### Generic
On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
### FreeBSD
#### Generic
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
### Windows
#### Generic
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
## Next steps
@@ -133,19 +102,10 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
<tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
@@ -183,8 +143,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.8.1.0</td><td></td></tr>
<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>3.6.0.0</td><td></td></tr>
<tr><td>3.4.1.0</td><td></td></tr>
@@ -200,14 +159,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.1.0.0</td><td></td></tr>
<tr><td>2.0.0.1</td><td></td></tr>
<tr><td>2.0.0.0</td><td></td></tr>
<tr><td>1.10.0.0</td><td></td></tr>
<tr><td>1.9.1.0</td><td></td></tr>
<tr><td>1.9.0.0</td><td></td></tr>
<tr><td>1.8.0.0</td><td></td></tr>
<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>1.7.0.0</td><td></td></tr>
<tr><td>1.6.1.0</td><td></td></tr>
<tr><td>1.6.0.0</td><td></td></tr>
@@ -225,9 +177,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>2.9.1</td><td></td></tr>
<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.7.5</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr>
<tr><td>2.7.1</td><td></td></tr>
@@ -240,7 +190,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
This list may not be exhaustive and specifies support for bindists only.
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -281,9 +231,8 @@ There are various issues with GHC itself.
### FreeBSD
Lacks some upstream bindists and may need compat libs (such as `misc/compat12x`).
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
HLS bindists are experimental.
Only latest FreeBSD is generally supported.
### Linux ARMv7/AARCH64
@@ -291,19 +240,10 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
## Manual installation
### Unix
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following keys first:
```sh
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
@@ -311,78 +251,6 @@ Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) lik
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
```
### Windows
1. Install ghcup binary
- choose a base directory for installation, e.g. `C:\` that has sufficient space
- then create the directory, e.g. `C:\ghcup\bin`
- download the binary: https://downloads.haskell.org/~ghcup/x86_64-mingw64-ghcup.exe
- place it as `ghcup.exe` into e.g. `C:\ghcup\bin`
2. Install MSYS2
- download https://repo.msys2.org/distrib/msys2-x86_64-latest.exe and execute it
- remember the installation destination you choose (default is `C:\msys64`)
- finish the installation
* Add environment variables and update `Path`
- open search bar and type in "Edit the system environment variables", then open it
- click on "Environment Variables..." at the near bottom
- in the upper half, select `Path` variable and double click on it
- in the new window, click "New", type in `C:\ghcup\bin` (depending on step 1.) and press enter
- click "OK" at the bottom
- in the upper half, click on "New..."
- enter `GHCUP_MSYS2` under "Variable name" and the installation destination from step 2. under "Variable value"
- click "OK" at the bottom
- in the upper half, click on "New..."
- enter `GHCUP_INSTALL_BASE_PREFIX` under "Variable name" and based on the installation destination from step 1. enter the device directory (default `C:\`)
- click "OK" at the bottom
- in the upper half, click on "New..."
- enter `CABAL_DIR` under "Variable name" and based on the installation destination from step 1. enter the device directory + `cabal` subdir (default `C:\cabal`)
- click "OK" at the bottom
- click "OK" at the bottom
- click "OK" at the bottom
3. Install tools
- open powershell
- run `ghcup install ghc --set recommended`
- run `ghcup install cabal latest`
- run `ghcup install stack latest`
- run `ghcup install hls latest`
- run `cabal update`
4. Update msys2
- run `ghcup run -m -- pacman --noconfirm -Syuu`
- run `ghcup run -m -- pacman --noconfirm -Syuu`
- run `ghcup run -m -- pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf`
- run `ghcup run -m -- pacman --noconfirm -S ca-certificates`
5. Update cabal config
- go to e.g. `C:\cabal` (based on device you picked in 1.)
- open file `config`
- uncomment `extra-include-dirs` (the `-- `) and add the value (depending on installation destination you chose in 2.), e.g. `C:\msys64\mingw64\include`... so the final line should be `extra-include-dirs: C:\msys64\mingw64\include`
- uncomment `extra-lib-dirs` and do the same, adding `C:\msys64\mingw64\lib`
- uncomment `extra-prog-path` and set it to `C:\ghcup\bin, C:\cabal\bin, C:\msys64\mingw64\bin, C:\msys64\usr\bin`, depending on your install destinations from 1. and 2.
6. Set up msys2 shell
- run `ghcup run -m -- sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf` to make the HOME in your msys2 shell match the one from windows
- make a desktop shortcut from `C:\msys64\msys2_shell.cmd`, which will allow you to start a proper msys2 shell
- run `ghcup run -m -- sed -i -e 's/#MSYS2_PATH_TYPE=.*/MSYS2_PATH_TYPE=inherit/' /c/msys64/msys2.ini`
- run `ghcup run -m -- sed -i -e 's/rem set MSYS2_PATH_TYPE=inherit/set MSYS2_PATH_TYPE=inherit/' /c/msys64/msys2_shell.cmd`
All set. You can run `cabal init` now in an empty directory to start a project.
## Esoteric distros
### Void Linux
Since void linux can be installed with glibc and musl, it's hard to support correctly with ghcup.
One way to make ghcup work on **Void Linux musl** is to follow the [Overriding distro detection](../guide/#overriding-distro-detection)
section and tell it to consider Alpine bindists only. E.g.:
```sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_MINIMAL=1 sh
source ~/.ghcup/env
ghcup config set platform-override '{ "arch": "A_64", "platform": { "contents": "Alpine", "tag": "Linux" }, "version": "3.17" }'
ghcup install cabal --set latest
ghcup install ghc --set latest
ghcup install stack --set latest
ghcup install hls --set latest
```
## Vim integration
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).

201
docs/overrides/base.html Normal file
View File

@@ -0,0 +1,201 @@
<!DOCTYPE html>
<html lang="{{ config.theme.locale|default('en') }}">
<head>
{%- block site_meta %}
<meta charset="utf-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
{% if page and page.is_homepage %}<meta name="description" content="{{ config['site_description'] }}">{% endif %}
{% if config.site_author %}<meta name="author" content="{{ config.site_author }}">{% endif %}
{% if page and page.canonical_url %}<link rel="canonical" href="{{ page.canonical_url }}">{% endif %}
{% if config.site_favicon %}<link rel="shortcut icon" href="{{ config.site_favicon|url }}">
{% else %}<link rel="shortcut icon" href="{{ 'img/favicon.ico'|url }}">{% endif %}
{%- endblock %}
{%- block htmltitle %}
<title>{% if page and page.title and not page.is_homepage %}{{ page.title }} - {% endif %}{{ config.site_name }}</title>
{%- endblock %}
{%- block styles %}
<link href="{{ 'css/bootstrap.min.css'|url }}" rel="stylesheet">
<link href="{{ 'css/font-awesome.min.css'|url }}" rel="stylesheet">
<link href="{{ 'css/base.css'|url }}" rel="stylesheet">
{%- if config.theme.highlightjs %}
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/styles/{{ config.theme.hljs_style }}.min.css">
{%- endif %}
{%- for path in extra_css %}
<link href="{{ path }}" rel="stylesheet">
{%- endfor %}
{%- endblock %}
{%- block libs %}
<script src="{{ 'js/jquery-1.10.2.min.js'|url }}" defer></script>
<script src="{{ 'js/bootstrap.min.js'|url }}" defer></script>
{%- if config.theme.highlightjs %}
<script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/highlight.min.js"></script>
{%- for lang in config.theme.hljs_languages %}
<script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/languages/{{lang}}.min.js"></script>
{%- endfor %}
<script>hljs.initHighlightingOnLoad();</script>
{%- endif %}
{%- endblock %}
{%- block analytics %}
{%- if config.theme.analytics.gtag %}
<script async src="https://www.googletagmanager.com/gtag/js?id={{ config.theme.analytics.gtag }}"></script>
<script>
window.dataLayer = window.dataLayer || [];
function gtag(){dataLayer.push(arguments);}
gtag('js', new Date());
gtag('config', '{{ config.theme.analytics.gtag }}');
</script>
{%- elif config.google_analytics %}
<script>
(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
})(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
ga('create', '{{ config.google_analytics[0] }}', '{{ config.google_analytics[1] }}');
ga('send', 'pageview');
</script>
{%- endif %}
{%- endblock %}
{%- block extrahead %} {% endblock %}
</head>
<body{% if page and page.is_homepage %} class="homepage"{% endif %}>
<div class="navbar fixed-top navbar-expand-lg navbar-{% if config.theme.nav_style == "light" %}light{% else %}dark{% endif %} bg-{{ config.theme.nav_style }}">
<div class="container">
{%- block site_name %}
<a class="navbar-brand" href="{{ nav.homepage.url|url }}">{{ config.site_name }}</a>
{%- endblock %}
{%- if nav|length>1 or (page and (page.next_page or page.previous_page)) or config.repo_url %}
<!-- Expander button -->
<button type="button" class="navbar-toggler" data-toggle="collapse" data-target="#navbar-collapse">
<span class="navbar-toggler-icon"></span>
</button>
{%- endif %}
<!-- Expanded navigation -->
<div id="navbar-collapse" class="navbar-collapse collapse">
{%- block site_nav %}
{%- if nav|length>1 %}
<!-- Main navigation -->
<ul class="nav navbar-nav">
{%- for nav_item in nav %}
{%- if nav_item.children %}
<li class="dropdown{% if nav_item.active %} active{% endif %}">
<a href="#" class="nav-link dropdown-toggle" data-toggle="dropdown">{{ nav_item.title }} <b class="caret"></b></a>
<ul class="dropdown-menu">
{%- for nav_item in nav_item.children %}
{% include "nav-sub.html" %}
{%- endfor %}
</ul>
</li>
{%- else %}
<li class="navitem{% if nav_item.active %} active{% endif %}">
<a href="{{ nav_item.url|url }}" class="nav-link">{{ nav_item.title }}</a>
</li>
{%- endif %}
{%- endfor %}
</ul>
{%- endif %}
{%- endblock %}
<ul class="nav navbar-nav ml-auto">
{%- block search_button %}
{%- if 'search' in config['plugins'] %}
<li class="nav-item">
<a href="#" class="nav-link" data-toggle="modal" data-target="#mkdocs_search_modal">
<i class="fa fa-search"></i> {% trans %}Search{% endtrans %}
</a>
</li>
{%- endif %}
{%- endblock %}
{%- block next_prev %}
{%- endblock %}
{%- block repo %}
{%- if page and page.edit_url %}
<li class="nav-item">
<a href="{{ page.edit_url }}" class="nav-link">
{%- if config.repo_name == 'GitHub' -%}
<i class="fa fa-github"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
{%- elif config.repo_name == 'Bitbucket' -%}
<i class="fa fa-bitbucket"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
{%- elif config.repo_name == 'GitLab' -%}
<i class="fa fa-gitlab"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
{%- else -%}
{% trans repo_name=config.repo_name%}Edit on {{ repo_name }}{% endtrans %}
{%- endif -%}
</a>
</li>
{%- elif config.repo_url %}
<li class="nav-item">
<a href="{{ config.repo_url }}" class="nav-link">
{%- if config.repo_name == 'GitHub' -%}
<i class="fa fa-github"></i> {{ config.repo_name }}
{%- elif config.repo_name == 'Bitbucket' -%}
<i class="fa fa-bitbucket"></i> {{ config.repo_name }}
{%- elif config.repo_name == 'GitLab' -%}
<i class="fa fa-gitlab"></i> {{ config.repo_name }}
{%- else -%}
{{ config.repo_name }}
{%- endif -%}
</a>
</li>
{%- endif %}
{%- endblock %}
</ul>
</div>
</div>
</div>
<div class="container">
<div class="row">
{%- block content %}
<div class="col-md-3">{% include "toc.html" %}</div>
<div class="col-md-9" role="main">{% include "content.html" %}</div>
{%- endblock %}
</div>
</div>
<footer class="col-md-12">
{%- block footer %}
<hr>
{%- if config.copyright %}
<p>{{ config.copyright }}</p>
{%- endif %}
<p>{% trans mkdocs_link='<a href="https://www.mkdocs.org/">MkDocs</a>' %}Documentation built with {{ mkdocs_link }}.{% endtrans %}</p>
{%- endblock %}
</footer>
{%- block scripts %}
<script>
var base_url = {{ base_url | tojson }},
shortcuts = {{ config.theme.shortcuts | tojson }};
</script>
<script src="{{ 'js/base.js'|url }}" defer></script>
{%- for path in extra_javascript %}
<script src="{{ path }}" defer></script>
{%- endfor %}
{%- endblock %}
{% if 'search' in config['plugins'] %}{%- include "search-modal.html" %}{% endif %}
{%- include "keyboard-modal.html" %}
</body>
</html>
{% if page and page.is_homepage %}
<!--
MkDocs version : {{ mkdocs_version }}
Build Date UTC : {{ build_date_utc }}
-->
{% endif %}

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.2 KiB

View File

@@ -1,4 +0,0 @@
{% extends "base.html" %}
<!-- Get rid of the next/prev buttons -->
{% block next_prev %}
{% endblock %}

View File

@@ -328,7 +328,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
<a href="https://play.haskell.org/" class="btn btn-primary" role="button">Online playground</a>
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a>
</div>
## How to learn Haskell proper

View File

@@ -1,6 +1,6 @@
cabal-version: 2.4
cabal-version: 3.0
name: ghcup
version: 0.1.19.5
version: 0.1.18.1
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
@@ -25,10 +25,10 @@ extra-source-files:
cbits/dirutils.h
data/build_mk/cross
data/build_mk/default
test/ghcup-test/data/dir/.keep
test/ghcup-test/data/file
test/ghcup-test/golden/unix/GHCupInfo.json
test/ghcup-test/golden/windows/GHCupInfo.json
test/golden/unix/GHCupInfo.json
test/golden/windows/GHCupInfo.json
test/data/file
test/data/dir/.keep
source-repository head
type: git
@@ -41,6 +41,11 @@ flag tui
default: False
manual: True
flag tui-ansi
description: Build the ansi-terminal powered tui (ghcup tui-ansi).
default: False
manual: True
flag internal-downloader
description:
Compile the internal downloader, which links against OpenSSL. This is disabled on windows.
@@ -53,43 +58,6 @@ flag no-exe
default: False
manual: True
common app-common-depends
build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring >=0.10 && <0.12
, cabal-install-parsers >=0.4.5
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time >=1.9.3 && <1.12
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0
library
exposed-modules:
GHCup
@@ -102,6 +70,7 @@ library
GHCup.List
GHCup.Platform
GHCup.Prelude
GHCup.Prelude.Ansi
GHCup.Prelude.File
GHCup.Prelude.File.Search
GHCup.Prelude.Internal
@@ -161,7 +130,7 @@ library
, directory ^>=1.3.6.0
, disk-free-space ^>=0.1.0.1
, exceptions ^>=0.10
, filepath ^>=1.4.2.1
, filepath ==1.4.2.1
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
@@ -174,22 +143,22 @@ library
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, retry >=0.8.1.2 && <0.10
, retry ^>=0.8.1.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, split ^>=0.2.3.4
, streamly ^>=0.8.2
, strict-base ^>=0.4
, template-haskell >=2.7 && <2.20
, template-haskell >=2.7 && <2.18
, temporary ^>=1.3
, text ^>=2.0
, time >=1.9.3 && <1.12
, text ^>=1.2.4.0
, time ^>=1.9.3
, transformers ^>=0.5
, unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2
, vector ^>=0.12
, versions >=6.0.3 && <6.1
, versions >=4.0.1 && <5.1
, word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2
@@ -198,7 +167,7 @@ library
exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER
build-depends:
, HsOpenSSL >=0.11.7.2
, HsOpenSSL >=0.11.4.18
, http-io-streams >=0.1.2.0
, io-streams >=1.5.2.1
, terminal-progress-bar >=0.4.1
@@ -222,25 +191,26 @@ library
GHCup.Prelude.File.Posix.Foreign
GHCup.Prelude.Posix
GHCup.Prelude.Process.Posix
exposed-modules:
GHCup.Prelude.File.Posix.Traversals
exposed-modules: GHCup.Prelude.File.Posix.Traversals
include-dirs: cbits
includes: dirutils.h
install-includes: dirutils.h
c-sources: cbits/dirutils.c
build-depends:
, bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.3
, terminal-size ^>=0.3.2.1
, unix ^>=2.7
, unix-bytestring ^>=0.3.7.3
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
build-depends: vty ^>=5.39
build-depends: vty >=5.28.2 && <5.34
library ghcup-optparse
import: app-common-depends
exposed-modules:
executable ghcup
main-is: Main.hs
other-modules:
GHCup.OptParse
GHCup.OptParse.ChangeLog
GHCup.OptParse.Common
@@ -255,46 +225,11 @@ library ghcup-optparse
GHCup.OptParse.Rm
GHCup.OptParse.Run
GHCup.OptParse.Set
GHCup.OptParse.Test
GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: lib-opt
default-language: Haskell2010
default-extensions:
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
build-depends: ghcup
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
executable ghcup
import: app-common-depends
main-is: Main.hs
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
@@ -312,20 +247,60 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded
build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring >=0.10 && <0.12
, cabal-plan ^>=0.7.2
, cabal-install-parsers >=0.4.5
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ==1.4.2.1
, ghcup
, ghcup-optparse
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.18
, temporary ^>=1.3
, text ^>=1.2.4.0
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if flag(tui-ansi)
cpp-options: -DANSI
other-modules: AnsiMain
build-depends:
, ansi-terminal
, ansi-terminal-game
, transformers ^>=0.5
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick ^>=1.5
, brick ^>=0.64
, transformers ^>=0.5
, unix ^>=2.7
, vty ^>=5.39
, vty >=5.28.2 && <5.34
if os(windows)
cpp-options: -DIS_WINDOWS
@@ -340,12 +315,12 @@ test-suite ghcup-test
type: exitcode-stdio-1.0
main-is: Main.hs
build-tool-depends: hspec-discover:hspec-discover -any
hs-source-dirs: test/ghcup-test
hs-source-dirs: test
other-modules:
GHCup.ArbitraryTypes
GHCup.Prelude.File.Posix.TraversalsSpec
GHCup.Types.JSONSpec
GHCup.Utils.FileSpec
GHCup.Prelude.File.Posix.TraversalsSpec
Spec
default-language: Haskell2010
@@ -366,7 +341,7 @@ test-suite ghcup-test
, bytestring >=0.10 && <0.12
, containers ^>=0.6
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, filepath ==1.4.2.1
, generic-arbitrary >=0.1.0 && <0.2.1 || >=0.2.2 && <0.3
, ghcup
, hspec >=2.7.10 && <2.11
@@ -374,50 +349,12 @@ test-suite ghcup-test
, QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2
, text ^>=2.0
, time >=1.9.3 && <1.12
, text ^>=1.2.4.0
, uri-bytestring ^>=0.3.2.2
, versions >=6.0.3 && <6.1
, versions >=4.0.1 && <5.1
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
test-suite ghcup-optparse-test
type: exitcode-stdio-1.0
hs-source-dirs: test/optparse-test
main-is: Main.hs
other-modules:
ChangeLogTest
CompileTest
ConfigTest
GCTest
InstallTest
ListTest
OtherCommandTest
RmTest
RunTest
SetTest
UnsetTest
UpgradeTest
Utils
WhereisTest
if os(windows)
cpp-options: -DIS_WINDOWS
default-language: Haskell2010
ghc-options: -Wall
build-depends:
, base
, ghcup
, ghcup-optparse
, optparse-applicative
, tasty
, tasty-hunit
, template-haskell
, text
, uri-bytestring
, versions
build-depends:
, unix ^>=2.7

View File

@@ -5,6 +5,4 @@ cradle:
- component: "ghcup:exe:ghcup"
path: ./app/ghcup
- component: "ghcup:test:ghcup-test"
path: ./test/ghcup-test
- component: "ghcup:test:ghcup-optparse-test"
path: ./test/optparse-test
path: ./test

View File

@@ -1,314 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.List where
import GHCup
import GHCup.Prelude
import GHCup.Types
import GHCup.OptParse.Common
import GHCup.Prelude.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Char
import Data.List ( intercalate, sort )
import Data.Functor
import Data.Maybe
import Data.Time.Calendar ( Day )
import Data.Versions
import Data.Void
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import System.Console.Pretty hiding ( color )
import qualified Data.Text as T
import qualified System.Console.Pretty as Pretty
import Control.Exception.Safe (MonadMask)
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
---------------
--[ Options ]--
---------------
data ListOptions = ListOptions
{ loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
, lFrom :: Maybe Day
, lTo :: Maybe Day
, lHideOld :: Bool
, lShowNightly :: Bool
, lRawFormat :: Bool
} deriving (Eq, Show)
---------------
--[ Parsers ]--
---------------
listOpts :: Parser ListOptions
listOpts =
ListOptions
<$> optional
(option
(eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all"
<> completer toolCompleter
)
)
<*> optional
(option
(eitherReader criteriaParser)
( short 'c'
<> long "show-criteria"
<> metavar "<installed|set|available>"
<> help "Apply filtering criteria, prefix with + or -"
<> completer (listCompleter
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
)
)
<*> optional
(option
(eitherReader dayParser)
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date starting at YYYY-MM-DD or later"
<> completer toolCompleter
)
)
<*> optional
(option
(eitherReader dayParser)
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date earlier than YYYY-MM-DD"
<> completer toolCompleter
)
)
<*> switch
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
)
<*> switch
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
)
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
--------------
--[ Footer ]--
--------------
listToolFooter :: String
listToolFooter = [s|Discussion:
Lists tool versions with optional criteria.
Nightlies are by default hidden.
Examples:
# query nightlies in a specific range
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
# show all installed GHC versions
ghcup list -t ghc -c installed|]
-----------------
--[ Utilities ]--
-----------------
printListResult :: Bool -> Bool -> [ListResult] -> IO ()
printListResult no_color raw lr = do
let
color | raw || no_color = (\_ x -> x)
| otherwise = Pretty.color
let
printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease"
printTag Nightly = color Red "nightly"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
printTag LatestPrerelease = color Red "latest-prerelease"
printTag LatestNightly = color Red "latest-nightly"
printTag Old = ""
let
rows =
(\x -> if raw
then x
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
)
. fmap
(\ListResult {..} ->
let marks = if
| lSet -> (color Green (if isWindows then "IS" else "✔✔"))
| lInstalled -> (color Green (if isWindows then "I " else ""))
| otherwise -> (color Red (if isWindows then "X " else ""))
in
(if raw then [] else [marks])
++ [ fmap toLower . show $ lTool
, case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
, intercalate "," (filter (/= "") . fmap printTag $ sort lTag)
, intercalate ","
$ (if hlsPowered
then [color Green "hls-powered"]
else mempty
)
++ (if lStray then [color Yellow "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [color Blue (show d)])
++ (if lNoBindist
then [color Red "no-bindist"]
else mempty
)
]
)
$ lr
let cols =
foldr (\xs ys -> zipWith (:) xs ys) (repeat []) rows
lengths = fmap (maximum . fmap strWidth) cols
padded = fmap (\xs -> zipWith padTo xs lengths) rows
forM_ (if raw then rows else padded) $ \row -> putStrLn $ unwords row
where
padTo str' x =
let lstr = strWidth str'
add' = x - lstr
in if add' < 0 then str' else str' ++ replicate add' ' '
-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth =
maximum
. (0 :)
. map (foldr (\a b -> charWidth a + b) 0)
. lines
. stripAnsi
-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi s' =
case
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
of
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
Just xs -> concat xs
where
-- This parses lots of invalid ANSI escape codes, but that should be fine
ansi =
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
Void
String
Char
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth c = case c of
_ | c < '\x0300' -> 1
| c >= '\x0300' && c <= '\x036F' -> 0
| -- combining
c >= '\x0370' && c <= '\x10FC' -> 1
| c >= '\x1100' && c <= '\x115F' -> 2
| c >= '\x1160' && c <= '\x11A2' -> 1
| c >= '\x11A3' && c <= '\x11A7' -> 2
| c >= '\x11A8' && c <= '\x11F9' -> 1
| c >= '\x11FA' && c <= '\x11FF' -> 2
| c >= '\x1200' && c <= '\x2328' -> 1
| c >= '\x2329' && c <= '\x232A' -> 2
| c >= '\x232B' && c <= '\x2E31' -> 1
| c >= '\x2E80' && c <= '\x303E' -> 2
| c == '\x303F' -> 1
| c >= '\x3041' && c <= '\x3247' -> 2
| c >= '\x3248' && c <= '\x324F' -> 1
| -- ambiguous
c >= '\x3250' && c <= '\x4DBF' -> 2
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
| c >= '\x4E00' && c <= '\xA4C6' -> 2
| c >= '\xA4D0' && c <= '\xA95F' -> 1
| c >= '\xA960' && c <= '\xA97C' -> 2
| c >= '\xA980' && c <= '\xABF9' -> 1
| c >= '\xAC00' && c <= '\xD7FB' -> 2
| c >= '\xD800' && c <= '\xDFFF' -> 1
| c >= '\xE000' && c <= '\xF8FF' -> 1
| -- ambiguous
c >= '\xF900' && c <= '\xFAFF' -> 2
| c >= '\xFB00' && c <= '\xFDFD' -> 1
| c >= '\xFE00' && c <= '\xFE0F' -> 1
| -- ambiguous
c >= '\xFE10' && c <= '\xFE19' -> 2
| c >= '\xFE20' && c <= '\xFE26' -> 1
| c >= '\xFE30' && c <= '\xFE6B' -> 2
| c >= '\xFE70' && c <= '\xFEFF' -> 1
| c >= '\xFF01' && c <= '\xFF60' -> 2
| c >= '\xFF61' && c <= '\x16A38' -> 1
| c >= '\x1B000' && c <= '\x1B001' -> 2
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
| c >= '\x1F200' && c <= '\x1F251' -> 2
| c >= '\x1F300' && c <= '\x1F773' -> 1
| c >= '\x20000' && c <= '\x3FFFD' -> 2
| otherwise -> 1
------------------
--[ Entrypoint ]--
------------------
list :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> ListOptions
-> Bool
-> (ReaderT AppState m ExitCode -> m ExitCode)
-> m ExitCode
list ListOptions{..} no_color runAppState =
runAppState (do
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess
)

View File

@@ -1,189 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeOperators #-}
module GHCup.OptParse.Test where
import GHCup.OptParse.Common
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Dirs
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Codec.Archive
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T
----------------
--[ Commands ]--
----------------
data TestCommand = TestGHC TestOptions
---------------
--[ Options ]--
---------------
data TestOptions = TestOptions
{ testVer :: Maybe ToolVersion
, testBindist :: Maybe URI
, addMakeArgs :: [T.Text]
}
---------------
--[ Footers ]--
---------------
testFooter :: String
testFooter = [s|Discussion:
Runs test suites from the test bindist.|]
---------------
--[ Parsers ]--
---------------
testParser :: Parser TestCommand
testParser =
subparser
( command
"ghc"
( TestGHC
<$> info
(testOpts (Just GHC) <**> helper)
( progDesc "Test GHC"
<> footerDoc (Just $ text testGHCFooter)
)
)
)
where
testGHCFooter :: String
testGHCFooter = [s|Discussion:
Runs the GHC test suite from the test bindist.|]
testOpts :: Maybe Tool -> Parser TestOptions
testOpts tool =
(\(u, v) args -> TestOptions v u args)
<$> ( ( (,)
<$> optional
(option
(eitherReader uriParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist"
<> completer (toolDlCompleter (fromMaybe GHC tool))
)
)
<*> (Just <$> toolVersionTagArgument [] tool)
)
<|> pure (Nothing, Nothing)
)
<*> many (argument str (metavar "MAKE_ARGS" <> help "Additional arguments to 'make', prefix with '-- ' (longopts)"))
---------------------------
--[ Effect interpreters ]--
---------------------------
type TestGHCEffects = [ DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, ArchiveResult
, TarDirDoesNotExist
, UnknownArchive
, TestFailed
, NextVerNotFound
, TagNotFound
, DayNotFound
, NoToolVersionSet
]
runTestGHC :: AppState
-> Excepts TestGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither TestGHCEffects a)
runTestGHC appstate' =
flip runReaderT appstate'
. runResourceT
. runE
@TestGHCEffects
-------------------
--[ Entrypoints ]--
-------------------
test :: TestCommand -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
test testCommand settings getAppState' runLogger = case testCommand of
(TestGHC iopts) -> go iopts
where
go :: TestOptions -> IO ExitCode
go TestOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case testBindist of
Nothing -> runTestGHC s' $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCVer v addMakeArgs
pure vi
Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
pure vi
)
>>= \case
VRight _ -> do
runLogger $ logInfo "GHC test successful"
pure ExitSuccess
VLeft e -> do
runLogger $ do
logError $ T.pack $ prettyHFError e
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
pure $ ExitFailure 3

View File

@@ -134,24 +134,15 @@ rmTool :: ( MonadReader env m
=> ListResult
-> Excepts '[NotInstalled, UninstallFailed] m ()
rmTool ListResult {lVer, lTool, lCross} = do
let printRmTool = logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
case lTool of
GHC -> do
GHC ->
let ghcTargetVersion = GHCTargetVersion lCross lVer
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
rmGHCVer ghcTargetVersion
HLS -> do
printRmTool
rmHLSVer lVer
Cabal -> do
printRmTool
liftE $ rmCabalVer lVer
Stack -> do
printRmTool
liftE $ rmStackVer lVer
GHCup -> do
printRmTool
lift rmGhcup
in rmGHCVer ghcTargetVersion
HLS -> rmHLSVer lVer
Cabal -> liftE $ rmCabalVer lVer
Stack -> liftE $ rmStackVer lVer
GHCup -> lift rmGhcup
rmGhcupDirs :: ( MonadReader env m
@@ -312,7 +303,7 @@ upgradeGHCup mtarget force' fatal = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ logInfo "Upgrading GHCup..."
let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
let latestVer = fst (fromJust (getLatest dls GHCup))
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -501,7 +492,7 @@ rmOldGHC :: ( MonadReader env m
=> Excepts '[NotInstalled, UninstallFailed] m ()
rmOldGHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls
ghcs <- lift $ fmap rights getInstalledGHCs
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc

View File

@@ -38,7 +38,6 @@ import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
@@ -281,6 +280,6 @@ rmCabalVer ver = do
when (Just ver == cSet) $ do
cVers <- lift $ fmap rights getInstalledCabals
case headMay . sortBy (comparing Down) $ cVers of
case headMay . reverse . sort $ cVers of
Just latestver -> setCabal latestver
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)

View File

@@ -263,14 +263,11 @@ getBase uri = do
dlWithMod modTime json_file = do
let (dir, fn) = splitFileName json_file
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
-- make these failures non-fatal, also see:
-- https://github.com/actions/runner-images/issues/7061
handleIO (\e -> logWarn $ "setModificationTime failed with: " <> T.pack (displayException e)) $ liftIO $ setModificationTime f modTime
handleIO (\e -> logWarn $ "setAccessTime failed with: " <> T.pack (displayException e)) $ liftIO $ setAccessTime f modTime
liftIO $ setModificationTime f modTime
liftIO $ setAccessTime f modTime
pure f
getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
@@ -282,21 +279,8 @@ getDownloadInfo :: ( MonadReader env m
'[NoDownload]
m
DownloadInfo
getDownloadInfo t v = getDownloadInfo' t (mkTVer v)
getDownloadInfo' :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
)
=> Tool
-> GHCTargetVersion
-- ^ tool version
-> Excepts
'[NoDownload]
m
DownloadInfo
getDownloadInfo' t v = do
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
getDownloadInfo t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let distro_preview f g =
@@ -317,7 +301,7 @@ getDownloadInfo' t v = do
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
maybe
(throwE $ NoDownload v t (Just pfreq))
(throwE NoDownload)
pure
(case p of
-- non-musl won't work on alpine
@@ -349,21 +333,19 @@ download :: ( MonadReader env m
-> Maybe FilePath -- ^ optional filename
-> Bool -- ^ whether to read an write etags
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
download rawUri gpgUri eDigest eCSize dest mfn etags
download uri gpgUri eDigest eCSize dest mfn etags
| scheme == "https" = liftE dl
| scheme == "http" = liftE dl
| scheme == "file" = do
let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
lift $ logDebug $ "using local file: " <> T.pack destFile'
forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
where
scheme = view (uriSchemeL' % schemeBSL') rawUri
scheme = view (uriSchemeL' % schemeBSL') uri
dl = do
Settings{ mirrors } <- lift getSettings
let uri = applyMirrors mirrors rawUri
baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
@@ -645,9 +627,7 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing
False -> do
tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
where
outputFileName = mfn <|> _dlOutput dli
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
downloadCached' :: ( MonadReader env m
@@ -666,7 +646,7 @@ downloadCached' :: ( MonadReader env m
downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile
if
@@ -674,9 +654,7 @@ downloadCached' dli mfn mDestDir = do
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
where
outputFileName = mfn <|> _dlOutput dli
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
@@ -773,17 +751,3 @@ getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [
tmpFile :: FilePath -> FilePath
tmpFile = (<.> "tmp")
applyMirrors :: DownloadMirrors -> URI -> URI
applyMirrors (DM ms) uri@(URI { uriAuthority = Just (Authority { authorityHost = Host host }) }) =
case M.lookup (decUTF8Safe host) ms of
Nothing -> uri
Just (DownloadMirror auth (Just prefix)) ->
uri { uriAuthority = Just auth
, uriPath = E.encodeUtf8 $ T.pack ("/" <> T.unpack prefix <> (T.unpack . decUTF8Safe . uriPath $ uri))
}
Just (DownloadMirror auth Nothing) ->
uri { uriAuthority = Just auth }
applyMirrors _ uri = uri

View File

@@ -35,10 +35,7 @@ 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.Encoding.Error as E
import Data.Data (Proxy(..))
import Data.Time (Day)
@@ -60,7 +57,6 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy CopyError in format proxy
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
, let proxy = Proxy :: Proxy TagNotFound in format proxy
, let proxy = Proxy :: Proxy DayNotFound in format proxy
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
@@ -86,12 +82,10 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy HadrianNotFound in format proxy
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
, let proxy = Proxy :: Proxy ContentLengthError in format proxy
, let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
, ""
, "# high level errors (4000+)"
, "# high level errors (5000+)"
, let proxy = Proxy :: Proxy DownloadFailed in format proxy
, let proxy = Proxy :: Proxy InstallSetError in format proxy
, let proxy = Proxy :: Proxy TestFailed in format proxy
, let proxy = Proxy :: Proxy BuildFailed in format proxy
, let proxy = Proxy :: Proxy GHCupSetError in format proxy
, ""
@@ -167,6 +161,7 @@ prettyHFError e =
let errorCode = "GHCup-" <> padIntAndShow (eNum e)
in ("[" <> linkEscapeCode errorCode (hfErrorLink errorCode) <> "] ") <> prettyShow e
where
linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
hfErrorLink errorCode = "https://errors.haskell.org/messages/" <> errorCode
padIntAndShow i
| i < 10 = "0000" <> show i
@@ -183,9 +178,6 @@ class HFErrorProject a where
eDesc :: Proxy a -> String
linkEscapeCode :: String -> String -> String
linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
------------------------
--[ Low-level errors ]--
@@ -206,26 +198,12 @@ instance HFErrorProject NoCompatiblePlatform where
eDesc _ = "No compatible platform could be found"
-- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
| NoDownload' GlobalTool
data NoDownload = NoDownload
deriving Show
instance Pretty NoDownload where
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
| (Just target) <- mtarget
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
= text $ "Unable to find a download for "
<> show tool
<> " version '"
<> T.unpack (tVerToText tver)
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
<> "Perhaps you meant: 'ghcup <command> "
<> T.unpack target
<> " "
<> T.unpack (prettyVer vv)
<> "'"
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
pPrint NoDownload =
text (eDesc (Proxy :: Proxy NoDownload))
instance HFErrorProject NoDownload where
eBase _ = 10
@@ -327,21 +305,6 @@ instance HFErrorProject TagNotFound where
eBase _ = 90
eDesc _ = "Unable to find a tag of a tool"
-- | Unable to find a release day of a tool
data DayNotFound = DayNotFound Day Tool (Maybe Day)
deriving Show
instance Pretty DayNotFound where
pPrint (DayNotFound day tool Nothing) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
pPrint (DayNotFound day tool (Just alternateDay)) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
text "but found an alternative date" <+> text (show alternateDay)
instance HFErrorProject DayNotFound where
eBase _ = 95
eDesc _ = "Unable to find a release date of a tool"
-- | Unable to find the next version of a tool (the one after the currently
-- set one).
data NextVerNotFound = NextVerNotFound Tool
@@ -674,19 +637,6 @@ instance HFErrorProject ContentLengthError where
eBase _ = 340
eDesc _ = "File content length verification failed"
data DuplicateReleaseChannel = DuplicateReleaseChannel URI
deriving Show
instance HFErrorProject DuplicateReleaseChannel where
eBase _ = 350
eDesc _ = "Duplicate release channel detected when adding URI.\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
instance Pretty DuplicateReleaseChannel where
pPrint (DuplicateReleaseChannel uri) =
text $ "Duplicate release channel detected when adding: \n "
<> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
<> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
-------------------------
--[ High-level errors ]--
-------------------------
@@ -725,22 +675,6 @@ instance HFErrorProject InstallSetError where
eDesc _ = "Installation or setting the tool failed."
-- | A test failed.
data TestFailed = forall es . (ToVariantMaybe TestFailed es, PopVariant TestFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => TestFailed FilePath (V es)
instance Pretty TestFailed where
pPrint (TestFailed path reason) =
case reason of
VMaybe (_ :: TestFailed) -> pPrint reason
_ -> text ("The test failed. GHC test suite is fragile and non-portable. Please also check out the " <> linkEscapeCode "issue tracker" " https://gitlab.haskell.org/ghc/ghc/-/issues/?sort=updated_desc&state=opened&label_name%5B%5D=testsuite&label_name%5B%5D=packaging&first_page_size=20" <> ".\nBuild dir was:") <+> text path <+> text "\nReason was:" <+> pPrint reason
deriving instance Show TestFailed
instance HFErrorProject TestFailed where
eBase _ = 4000
eNum (TestFailed _ xs2) = 4000 + eNum xs2
eDesc _ = "The test failed."
-- | A build failed.
data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => BuildFailed FilePath (V es)

View File

@@ -80,153 +80,12 @@ import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
data GHCVer = SourceDist Version
| GitDist GitBranch
| RemoteDist URI
deriving (Eq, Show)
data GHCVer v = SourceDist v
| GitDist GitBranch
| RemoteDist URI
--------------------
--[ Tool testing ]--
--------------------
testGHCVer :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
)
=> GHCTargetVersion
-> [T.Text]
-> Excepts
'[ DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, ArchiveResult
, TarDirDoesNotExist
, UnknownArchive
, TestFailed
]
m
()
testGHCVer ver addMakeArgs = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix ver % viTestDL % _Just) dls
?? NoDownload ver GHC Nothing
liftE $ testGHCBindist dlInfo ver addMakeArgs
testGHCBindist :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
)
=> DownloadInfo
-> GHCTargetVersion
-> [T.Text]
-> Excepts
'[ DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, ArchiveResult
, TarDirDoesNotExist
, UnknownArchive
, TestFailed
]
m
()
testGHCBindist dlinfo ver addMakeArgs = do
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
liftE $ testPackedGHC dl (view dlSubdir dlinfo) ver addMakeArgs
testPackedGHC :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasSettings env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadUnliftIO m
, MonadFail m
, MonadResource m
)
=> FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive
-> GHCTargetVersion -- ^ The GHC version
-> [T.Text] -- ^ additional make args
-> Excepts
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
testPackedGHC dl msubdir ver addMakeArgs = do
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
-- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
msubdir
reThrowAll @_ @'[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
(TestFailed (fromGHCupPath workdir)) $ liftE $ runBuildAction tmpUnpack
(testUnpackedGHC workdir ver addMakeArgs)
testUnpackedGHC :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadThrow m
, HasLog env
, MonadIO m
)
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
-> GHCTargetVersion -- ^ The GHC version
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError] m ()
testUnpackedGHC path tver addMakeArgs = do
lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
ghcDir <- lift $ ghcupGHCDir tver
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
env <- liftIO $ addToPath ghcBinDir False
lEM $ make' (fmap T.unpack addMakeArgs)
(Just $ fromGHCupPath path)
"ghc-test"
(Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver)
<> "ghc-"
<> T.unpack (prettyVer $ _tvVersion tver)) : env)
pure ()
---------------------
--[ Tool fetching ]--
---------------------
@@ -246,7 +105,7 @@ fetchGHCSrc :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> GHCTargetVersion
=> Version
-> Maybe FilePath
-> Excepts
'[ DigestError
@@ -261,7 +120,7 @@ fetchGHCSrc v mfp = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix v % viSourceDL % _Just) dls
?? NoDownload v GHC Nothing
?? NoDownload
liftE $ downloadCached' dlInfo Nothing mfp
@@ -286,7 +145,7 @@ installGHCBindist :: ( MonadFail m
, MonadUnliftIO m
)
=> DownloadInfo -- ^ where/how to download
-> GHCTargetVersion -- ^ the version to install
-> Version -- ^ the version to install
-> InstallDir
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
@@ -309,8 +168,10 @@ installGHCBindist :: ( MonadFail m
]
m
()
installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
let tver = mkTVer ver
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
regularGHCInstalled <- lift $ ghcInstalled tver
@@ -318,7 +179,7 @@ installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
| not forceInstall
, regularGHCInstalled
, GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled GHC (_tvVersion tver)
throwE $ AlreadyInstalled GHC ver
| forceInstall
, regularGHCInstalled
@@ -337,12 +198,12 @@ installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
case installDir of
IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
GHCupInternal -> do -- regular install
-- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
-- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver
@@ -376,7 +237,7 @@ installPackedGHC :: ( MonadMask m
=> FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive
-> InstallDirResolved
-> GHCTargetVersion -- ^ The GHC version
-> Version -- ^ The GHC version
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts
@@ -424,22 +285,26 @@ installUnpackedGHC :: ( MonadReader env m
)
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> InstallDirResolved -- ^ Path to install to
-> GHCTargetVersion -- ^ The GHC version
-> Version -- ^ The GHC version
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC path inst tver forceInstall addConfArgs
installUnpackedGHC path inst ver forceInstall addConfArgs
| isWindows = do
lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need
-- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
liftE $ mergeGHCFileTree path inst tver forceInstall
liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> do
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
liftIO $ moveFilePortable source dest
forM_ mtime $ liftIO . setModificationTime dest
| otherwise = do
PlatformRequest {..} <- lift getPlatformReq
let ldOverride
| _tvVersion tver >= [vver|8.2.2|]
| ver >= [vver|8.2.2|]
, _rPlatform `elem` [Linux Alpine, Darwin]
= ["--disable-ld-override"]
| otherwise
@@ -448,7 +313,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst)
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
: (ldOverride <> (T.unpack <$> addConfArgs))
)
(Just $ fromGHCupPath path)
"ghc-configure"
@@ -456,44 +321,17 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall
pure ()
mergeGHCFileTree :: ( MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadUnliftIO m
, MonadMask m
, MonadResource m
, MonadFail m
)
=> GHCupPath -- ^ Path to the root of the tree
-> InstallDirResolved -- ^ Path to install to
-> GHCTargetVersion -- ^ The GHC version
-> Bool -- ^ Force install
-> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree root inst tver forceInstall
| isWindows = do
liftE $ mergeFileTree root inst GHC tver $ \source dest -> do
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
liftIO $ moveFilePortable source dest
forM_ mtime $ liftIO . setModificationTime dest
| otherwise = do
liftE $ mergeFileTree root
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
inst
GHC
tver
(mkTVer ver)
(\f t -> liftIO $ do
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
install f t (not forceInstall)
forM_ mtime $ setModificationTime t)
pure ()
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
-- following symlinks in @~\/.ghcup\/bin@:
@@ -513,7 +351,7 @@ installGHCBin :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> GHCTargetVersion -- ^ the version to install
=> Version -- ^ the version to install
-> InstallDir
-> Bool -- ^ force install
-> [T.Text] -- ^ additional configure args for bindist
@@ -536,9 +374,9 @@ installGHCBin :: ( MonadFail m
]
m
()
installGHCBin tver installDir forceInstall addConfArgs = do
dlinfo <- liftE $ getDownloadInfo' GHC tver
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
installGHCBin ver installDir forceInstall addConfArgs = do
dlinfo <- liftE $ getDownloadInfo GHC ver
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
@@ -732,7 +570,7 @@ rmGHCVer ver = do
Just files -> do
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
removeEmptyDirsRecursive dir
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
f <- recordedInstallationFile GHC ver
lift $ recycleFile f
@@ -779,8 +617,7 @@ compileGHC :: ( MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> GHCVer
-> Maybe Text -- ^ cross target
=> GHCVer GHCTargetVersion
-> Maybe Version -- ^ overwrite version
-> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs
@@ -788,7 +625,7 @@ compileGHC :: ( MonadMask m
-> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour
-> Maybe BuildSystem
-> Bool
-> InstallDir
-> Excepts
'[ AlreadyInstalled
@@ -817,21 +654,20 @@ compileGHC :: ( MonadMask m
]
m
GHCTargetVersion
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
= do
pfreq@PlatformRequest { .. } <- lift getPlatformReq
PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
(workdir, tmpUnpack, tver) <- case targetGhc of
-- unpack from version tarball
SourceDist ver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
SourceDist tver -> do
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
-- download source tarball
let tver = mkTVer ver
dlInfo <-
preview (ix GHC % ix tver % viSourceDL % _Just) dls
?? NoDownload tver GHC (Just pfreq)
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
@@ -844,7 +680,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
(view dlSubdir dlInfo)
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
pure (workdir, tmpUnpack, Just tver)
RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -868,7 +704,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
pure (workdir, tmpUnpack, mkTVer <$> tver)
-- clone from git
GitDist GitBranch{..} -> do
@@ -925,12 +761,12 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
pure tver
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
installVer <- if | Just ov' <- ov -> pure (mkTVer ov')
| Just tver' <- tver -> pure tver'
| otherwise -> fail "No GHC version given and couldn't detect version. Giving up..."
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
alreadyInstalled <- lift $ ghcInstalled installVer
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
@@ -949,31 +785,16 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
mBindist <- liftE $ runBuildAction
(mBindist, bmk) <- liftE $ runBuildAction
tmpUnpack
(do
-- prefer 'tver', because the real version carries out compatibility checks
-- we don't want the user to do funny things with it
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
case buildSystem of
Just Hadrian -> do
lift $ logInfo "Requested to use Hadrian"
liftE doHadrian
Just Make -> do
lift $ logInfo "Requested to use Make"
doMake
Nothing -> do
supportsHadrian <- liftE $ catchE @HadrianNotFound @'[HadrianNotFound] @'[] (\_ -> return False)
$ fmap (const True)
$ findHadrianFile (fromGHCupPath workdir)
if supportsHadrian
then do
lift $ logInfo "Detected Hadrian"
liftE doHadrian
else do
lift $ logInfo "Detected Make"
doMake
b <- if hadrian
-- prefer 'tver', because the real version carries out compatibility checks
-- we don't want the user to do funny things with it
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
pure (b, bmk)
)
case installDir of
@@ -989,10 +810,12 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
liftE $ installPackedGHC bindist
(Just $ RegexDir "ghc-.*")
ghcdir
installVer
(installVer ^. tvVersion)
False -- not a force install, since we already overwrite when compiling.
[]
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
case installDir of
-- set and make symlinks for regular (non-isolated) installs
GHCupInternal -> do
@@ -1015,29 +838,20 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
=> GHCupPath
-> Excepts '[ProcessError, ParseError] m Version
getGHCVer tmpUnpack = do
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
hasVersionFile <- liftIO $ doesFileExist versionFile
if hasVersionFile
then do
lift $ logDebug "Detected VERSION file, trying to extract"
contents <- liftIO $ readFile versionFile
either (throwE . ParseError . show) pure . MP.parse version' "" . T.pack . stripNewlineEnd $ contents
else do
lift $ logDebug "Didn't detect VERSION file, trying to extract via legacy 'make'"
CapturedProcess {..} <- lift $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
case _exitCode of
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
CapturedProcess {..} <- lift $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
case _exitCode of
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
defaultConf =
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
in case crossTarget of
Just _ -> cross_mk
_ -> default_mk
in case targetGhc of
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk
_ -> default_mk
compileHadrianBindist :: ( MonadReader env m
, HasDirs env
@@ -1063,17 +877,18 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
m
(Maybe FilePath) -- ^ output path of bindist, None for cross
compileHadrianBindist tver workdir ghcdir = do
lEM $ execWithGhcEnv "python3" ["./boot"] (Just workdir) "ghc-bootstrap"
liftE $ configureBindist tver workdir ghcdir
lift $ logInfo "Building (this may take a while)..."
hadrian_build <- liftE $ findHadrianFile workdir
lEM $ execLogged hadrian_build
lEM $ execWithGhcEnv hadrian_build
( maybe [] (\j -> ["-j" <> show j] ) jobs
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
++ ["binary-dist"]
)
(Just workdir) "ghc-make"
Nothing
[tar] <- liftIO $ findFiles
(workdir </> "_build" </> "bindist")
(makeRegexOpts compExtended
@@ -1106,9 +921,6 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
, MonadResource m
)
=> GHCTargetVersion
-> FilePath
@@ -1120,7 +932,6 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
, PatchFailed
, ProcessError
, NotFoundInPATH
, MergeFileTreeError
, CopyError]
m
(Maybe FilePath) -- ^ output path of bindist, None for cross
@@ -1142,9 +953,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
if | isCross tver -> do
lift $ logInfo "Installing cross toolchain..."
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just workdir)
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir ghcdir)) ghcdir tver True
lEM $ make ["install"] (Just workdir)
pure Nothing
| otherwise -> do
lift $ logInfo "Creating bindist..."
@@ -1217,8 +1026,8 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
let lines' = fmap T.strip . T.lines $ decUTF8Safe c
-- for cross, we need Stage1Only
case crossTarget of
Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
case targetGhc of
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE
(InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
)
@@ -1262,50 +1071,64 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
()
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
lift $ logInfo [s|configuring build|]
lEM $ configureWithGhcBoot (Just tver)
(maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
"ghc-conf"
if | _tvVersion tver >= [vver|8.8.0|] -> do
lEM $ execWithGhcEnv
"sh"
("./configure" : maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
"ghc-conf"
| otherwise -> do
lEM $ execLogged
"sh"
( [ "./configure", "--with-ghc=" <> either id id bghc
]
++ maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
"ghc-conf"
Nothing
pure ()
configureWithGhcBoot :: ( MonadReader env m
, HasSettings env
, HasDirs env
, HasLog env
, MonadIO m
, MonadThrow m)
=> Maybe GHCTargetVersion
-> [String] -- ^ args for configure
-> Maybe FilePath -- ^ optionally chdir into this
-> FilePath -- ^ log filename (opened in append mode)
-> m (Either ProcessError ())
configureWithGhcBoot mtver args dir logf = do
let execNew = execLogged
"sh"
("./configure" : ("GHC=" <> bghc) : args)
dir
logf
Nothing
execOld = execLogged
"sh"
("./configure" : ("--with-ghc=" <> bghc) : args)
dir
logf
Nothing
if | Just tver <- mtver
, _tvVersion tver >= [vver|8.8.0|] -> execNew
| Nothing <- mtver -> execNew -- need some default for git checkouts where we don't know yet
| otherwise -> execOld
execWithGhcEnv :: ( MonadReader env m
, HasSettings env
, HasDirs env
, HasLog env
, MonadIO m
, MonadThrow m)
=> FilePath -- ^ thing to execute
-> [String] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
-> FilePath -- ^ log filename (opened in append mode)
-> m (Either ProcessError ())
execWithGhcEnv fp args dir logf = do
env <- ghcEnv
execLogged fp args dir logf (Just env)
bghc = case bstrap of
Right g -> g
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt
Right g -> Right g
Left bver -> Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
ghcEnv = do
cEnv <- liftIO getEnvironment
bghcPath <- case bghc of
Right ghc' -> pure ghc'
Left bver -> do
spaths <- liftIO getSearchPath
throwMaybeM (NotFoundInPATH bver) $ liftIO (searchPath spaths bver)
pure (("GHC", bghcPath) : cEnv)

View File

@@ -43,7 +43,6 @@ import Control.Monad.Trans.Resource
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.String ( fromString )
import Data.Text ( Text )
@@ -75,7 +74,6 @@ data HLSVer = SourceDist Version
| GitDist GitBranch
| HackageDist Version
| RemoteDist URI
deriving (Eq, Show)
@@ -355,7 +353,7 @@ compileHLS :: ( MonadMask m
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
pfreq@PlatformRequest { .. } <- lift getPlatformReq
PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
@@ -370,8 +368,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
-- download source tarball
dlInfo <-
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
?? NoDownload (mkTVer tver) HLS (Just pfreq)
preview (ix HLS % ix tver % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
@@ -706,7 +704,7 @@ rmHLSVer ver = do
when (Just ver == isHlsSet) $ do
-- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs
case headMay . sortBy (comparing Down) $ hlsVers of
case headMay . reverse . sort $ hlsVers of
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
Nothing -> pure ()
@@ -717,10 +715,8 @@ getCabalVersion fp = do
gpd <- case parseGenericPackageDescriptionMaybe contents of
Nothing -> fail $ "could not parse cabal file: " <> fp
Just r -> pure r
let tver = (\c -> Version Nothing c Nothing Nothing)
. Chunks
. NE.fromList
. fmap (Numeric . fromIntegral)
let tver = (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package

View File

@@ -36,7 +36,6 @@ import Data.Either
import Data.List
import Data.Maybe
import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
import Optics
@@ -62,10 +61,10 @@ import qualified Data.Text as T
-- | Filter data type for 'listVersions'.
data ListCriteria = ListInstalled Bool
| ListSet Bool
| ListAvailable Bool
deriving (Eq, Show)
data ListCriteria = ListInstalled
| ListSet
| ListAvailable
deriving Show
-- | A list result describes a single tool version
-- and various of its properties.
@@ -76,16 +75,16 @@ data ListResult = ListResult
, lTag :: [Tag]
, lInstalled :: Bool
, lSet :: Bool -- ^ currently active version
, fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
, hlsPowered :: Bool
, lReleaseDay :: Maybe Day
}
deriving (Eq, Ord, Show)
-- | Extract all available tool versions and their tags.
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
availableToolVersions av tool = view
(at tool % non Map.empty)
av
@@ -94,22 +93,19 @@ availableToolVersions av tool = view
-- | List all versions from the download info, as well as stray
-- versions.
listVersions :: ( MonadCatch m
, HasLog env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
listVersions lt' criteria hideOld showNightly days = do
, HasLog env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
-> Maybe ListCriteria
-> m [ListResult]
listVersions lt' criteria = do
-- some annoying work to avoid too much repeated IO
cSet <- cabalSet
cabals <- getInstalledCabals
@@ -133,13 +129,13 @@ listVersions lt' criteria hideOld showNightly days = do
slr <- strayGHCs avTools
pure (sort (slr ++ lr))
Cabal -> do
slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals
slr <- strayCabals avTools cSet cabals
pure (sort (slr ++ lr))
HLS -> do
slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses
slr <- strayHLS avTools hlsSet' hlses
pure (sort (slr ++ lr))
Stack -> do
slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks
slr <- strayStacks avTools sSet stacks
pure (sort (slr ++ lr))
GHCup -> do
let cg = maybeToList $ currentGHCup avTools
@@ -158,28 +154,42 @@ listVersions lt' criteria hideOld showNightly days = do
, HasLog env
, MonadIO m
)
=> Map.Map GHCTargetVersion VersionInfo
=> Map.Map Version VersionInfo
-> m [ListResult]
strayGHCs avTools = do
ghcs <- getInstalledGHCs
fmap catMaybes $ forM ghcs $ \case
Right tver@GHCTargetVersion{ .. } -> do
case Map.lookup tver avTools of
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
case Map.lookup _tvVersion avTools of
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = _tvTarget
, lCross = Nothing
, lTag = []
, lInstalled = True
, lStray = isNothing (Map.lookup tver avTools)
, lStray = isNothing (Map.lookup _tvVersion avTools)
, lNoBindist = False
, lReleaseDay = Nothing
, ..
}
Right tver@GHCTargetVersion{ .. } -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = _tvTarget
, lTag = []
, lInstalled = True
, lStray = True -- NOTE: cross currently cannot be installed via bindist
, lNoBindist = False
, ..
}
Left e -> do
logWarn
$ "Could not parse version of stray directory" <> T.pack e
@@ -211,8 +221,8 @@ listVersions lt' criteria hideOld showNightly days = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -245,8 +255,8 @@ listVersions lt' criteria hideOld showNightly days = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -280,8 +290,8 @@ listVersions lt' criteria hideOld showNightly days = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -289,24 +299,24 @@ listVersions lt' criteria hideOld showNightly days = do
$ "Could not parse version of stray directory" <> T.pack e
pure Nothing
currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
currentGHCup av =
let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer ""
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
listVer = Map.lookup currentVer av
latestVer = fst <$> headOf (getTagged Latest) av
recommendedVer = fst <$> headOf (getTagged Latest) av
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
in if | Map.member currentVer av -> Nothing
| otherwise -> Just $ ListResult { lVer = _tvVersion currentVer
| otherwise -> Just $ ListResult { lVer = currentVer
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
, lCross = Nothing
, lTool = GHCup
, fromSrc = False
, lStray = isNothing listVer
, lSet = True
, lInstalled = True
, lNoBindist = False
, hlsPowered = False
, lReleaseDay = Nothing
}
-- NOTE: this are not cross ones, because no bindists
@@ -325,41 +335,42 @@ listVersions lt' criteria hideOld showNightly days = do
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> (GHCTargetVersion, VersionInfo)
-> (Version, VersionInfo)
-> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do
let v = _tvVersion tver
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
case t of
GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
let tver = mkTVer v
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
lInstalled <- ghcInstalled tver
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem v) hlsGHCVersions
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
Cabal -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
let lSet = cSet == Just v
let lInstalled = elem v $ rights cabals
pure ListResult { lVer = v
, lCross = Nothing
, lTag = _viTags
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
GHCup -> do
let lSet = prettyPVP ghcUpVer == prettyVer v
let lInstalled = lSet
pure ListResult { lVer = v
, lTag = _viTags
, lTag = tags
, lCross = Nothing
, lTool = t
, fromSrc = False
, lStray = False
, lNoBindist = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
HLS -> do
@@ -368,11 +379,11 @@ listVersions lt' criteria hideOld showNightly days = do
let lInstalled = elem v $ rights hlses
pure ListResult { lVer = v
, lCross = Nothing
, lTag = _viTags
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
Stack -> do
@@ -381,42 +392,19 @@ listVersions lt' criteria hideOld showNightly days = do
let lInstalled = elem v $ rights stacks
pure ListResult { lVer = v
, lCross = Nothing
, lTag = _viTags
, lTag = tags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
filter' :: [ListResult] -> [ListResult]
filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
filterDays :: [ListResult] -> [ListResult]
filterDays lrs = case days of
(Nothing, Nothing) -> lrs
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
fromCriteria :: ListCriteria -> ListResult -> Bool
fromCriteria lc ListResult{..} = case lc of
ListInstalled b -> f b lInstalled
ListSet b -> f b lSet
ListAvailable b -> f b $ not lNoBindist
where
f b
| b = id
| otherwise = not
filterOld :: [ListResult] -> [ListResult]
filterOld lr
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
| otherwise = lr
filterNightly :: [ListResult] -> [ListResult]
filterNightly lr
| showNightly = lr
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr
filter' lr = case criteria of
Nothing -> lr
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
Just ListSet -> filter (\ListResult {..} -> lSet) lr
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr

View File

@@ -77,14 +77,8 @@ runBothE' a1 a2 = do
(_ , VLeft e ) -> throwSomeE e
(VRight _, VRight _) -> pure ()
-- "throwSomeE" function has been upstreamed in haskus-utils-variant-3.3
-- So, only conditionally include this shim if
-- haskus-utils-variant version is < 3.3
#if MIN_VERSION_haskus_utils_variant(3,3,0)
#else
-- | Throw some exception
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
{-# INLINABLE throwSomeE #-}
throwSomeE = Excepts . pure . VLeft . liftVariant
#endif

92
lib/GHCup/Prelude/Ansi.hs Normal file
View File

@@ -0,0 +1,92 @@
module GHCup.Prelude.Ansi where
import Control.Applicative
import Data.Char
import Data.Void
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth =
maximum
. (0 :)
. map (foldr (\a b -> charWidth a + b) 0)
. lines
. stripAnsi
-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi s' =
case
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
of
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
Just xs -> concat xs
where
-- This parses lots of invalid ANSI escape codes, but that should be fine
ansi =
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
Void
String
Char
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth c = case c of
_ | c < '\x0300' -> 1
| c >= '\x0300' && c <= '\x036F' -> 0
| -- combining
c >= '\x0370' && c <= '\x10FC' -> 1
| c >= '\x1100' && c <= '\x115F' -> 2
| c >= '\x1160' && c <= '\x11A2' -> 1
| c >= '\x11A3' && c <= '\x11A7' -> 2
| c >= '\x11A8' && c <= '\x11F9' -> 1
| c >= '\x11FA' && c <= '\x11FF' -> 2
| c >= '\x1200' && c <= '\x2328' -> 1
| c >= '\x2329' && c <= '\x232A' -> 2
| c >= '\x232B' && c <= '\x2E31' -> 1
| c >= '\x2E80' && c <= '\x303E' -> 2
| c == '\x303F' -> 1
| c >= '\x3041' && c <= '\x3247' -> 2
| c >= '\x3248' && c <= '\x324F' -> 1
| -- ambiguous
c >= '\x3250' && c <= '\x4DBF' -> 2
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
| c >= '\x4E00' && c <= '\xA4C6' -> 2
| c >= '\xA4D0' && c <= '\xA95F' -> 1
| c >= '\xA960' && c <= '\xA97C' -> 2
| c >= '\xA980' && c <= '\xABF9' -> 1
| c >= '\xAC00' && c <= '\xD7FB' -> 2
| c >= '\xD800' && c <= '\xDFFF' -> 1
| c >= '\xE000' && c <= '\xF8FF' -> 1
| -- ambiguous
c >= '\xF900' && c <= '\xFAFF' -> 2
| c >= '\xFB00' && c <= '\xFDFD' -> 1
| c >= '\xFE00' && c <= '\xFE0F' -> 1
| -- ambiguous
c >= '\xFE10' && c <= '\xFE19' -> 2
| c >= '\xFE20' && c <= '\xFE26' -> 1
| c >= '\xFE30' && c <= '\xFE6B' -> 2
| c >= '\xFE70' && c <= '\xFEFF' -> 1
| c >= '\xFF01' && c <= '\xFF60' -> 2
| c >= '\xFF61' && c <= '\x16A38' -> 1
| c >= '\x1B000' && c <= '\x1B001' -> 2
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
| c >= '\x1F200' && c <= '\x1F251' -> 2
| c >= '\x1F300' && c <= '\x1F773' -> 1
| c >= '\x20000' && c <= '\x3FFFD' -> 2
| otherwise -> 1

View File

@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
-- | Create an 'Unfold' of directory contents.
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
where
{-# INLINE [0] step #-}
step dirstream = do
(typ, e) <- liftIO $ readDirEntPortable dirstream
(typ, e) <- liftIO $ readDirEnt dirstream
return $ if
| null e -> D.Stop
| "." == e -> D.Skip dirstream
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
step (_, Nothing, []) = return D.Stop
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
(dt, f) <- liftIO $ readDirEntPortable dirstream
if | f == "" -> do
(dt, f) <- liftIO $ readDirEnt dirstream
if | FD.dtUnknown == dt -> do
runIOFinalizer finalizer
return $ D.Skip (topdir, Nothing, dirs)
| f == "." || f == ".."
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
acquire dir =
withRunInIO $ \run -> mask_ $ run $ do
dirstream <- liftIO $ openDirStreamPortable dir
ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
dirstream <- liftIO $ openDirStream dir
ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
return (dirstream, ref)
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)

View File

@@ -10,20 +10,9 @@
module GHCup.Prelude.File.Posix.Traversals (
-- lower-level stuff
readDirEnt
, readDirEntPortable
, openDirStreamPortable
, closeDirStreamPortable
, unpackDirStream
, DirStreamPortable
) where
#include <limits.h>
#include <stdlib.h>
#include <dirent.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
@@ -39,7 +28,6 @@ import Foreign.Storable
import System.Posix
import Foreign (alloca)
import System.Posix.Internals (peekFilePath)
import System.FilePath
@@ -102,38 +90,3 @@ readDirEnt (unpackDirStream -> dirp) =
then return (dtUnknown, mempty)
else throwErrno "readDirEnt"
newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
openDirStreamPortable :: FilePath -> IO DirStreamPortable
openDirStreamPortable fp = do
dirs <- openDirStream fp
pure $ DirStreamPortable (fp, dirs)
closeDirStreamPortable :: DirStreamPortable -> IO ()
closeDirStreamPortable (DirStreamPortable (_, dirs)) = closeDirStream dirs
readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
(dt, fp) <- readDirEnt dirs
case (dt, fp) of
(DirType #{const DT_BLK}, _) -> pure (dt, fp)
(DirType #{const DT_CHR}, _) -> pure (dt, fp)
(DirType #{const DT_DIR}, _) -> pure (dt, fp)
(DirType #{const DT_FIFO}, _) -> pure (dt, fp)
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
(DirType #{const DT_REG}, _) -> pure (dt, fp)
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
(_, _)
| fp /= "" -> do
stat <- getSymbolicLinkStatus (basedir </> fp)
pure $ (, fp) $ if | isBlockDevice stat -> DirType #{const DT_BLK}
| isCharacterDevice stat -> DirType #{const DT_CHR}
| isDirectory stat -> DirType #{const DT_DIR}
| isNamedPipe stat -> DirType #{const DT_FIFO}
| isSymbolicLink stat -> DirType #{const DT_LNK}
| isRegularFile stat -> DirType #{const DT_REG}
| isSocket stat -> DirType #{const DT_SOCK}
| otherwise -> DirType #{const DT_UNKNOWN}
| otherwise -> pure (dt, fp)

View File

@@ -91,16 +91,18 @@ ghcTargetVerP =
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigits =
let startsWithDigists =
and
. take 3
. map (\case
Numeric _ -> True
Alphanum _ -> False)
. concatMap
(map
(\case
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList
. (\(Chunks nec) -> nec)
$ _vChunks v
if startsWithDigits && isNothing (_vEpoch v)
if startsWithDigists && isNothing (_vEpoch v)
then pure $ prettyVer v
else fail "Oh"

View File

@@ -26,14 +26,36 @@ import GHC.Base
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( dataToExpQ )
import Language.Haskell.TH.Syntax ( Lift
, dataToExpQ
)
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
deriving instance Data Versioning
deriving instance Lift Versioning
deriving instance Data Version
deriving instance Lift Version
deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@@ -38,7 +38,6 @@ import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
@@ -280,6 +279,6 @@ rmStackVer ver = do
when (Just ver == sSet) $ do
sVers <- lift $ fmap rights getInstalledStacks
case headMay . sortBy (comparing Down) $ sVers of
case headMay . reverse . sort $ sVers of
Just latestver -> setStack latestver
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)

View File

@@ -31,7 +31,6 @@ import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.DeepSeq ( NFData, rnf )
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Time.Calendar ( Day )
import Data.Text ( Text )
import Data.Versions
import GHC.IO.Exception ( ExitCode )
@@ -45,8 +44,7 @@ import Graphics.Vty ( Key(..) )
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified GHC.Generics as GHC
import qualified Data.List.NonEmpty as NE
import Data.Foldable (foldMap)
#if !defined(BRICK)
data Key = KEsc | KChar Char | KBS | KEnter
@@ -68,7 +66,7 @@ data GHCupInfo = GHCupInfo
, _ghcupDownloads :: GHCupDownloads
, _globalTools :: Map GlobalTool DownloadInfo
}
deriving (Show, GHC.Generic, Eq)
deriving (Show, GHC.Generic)
instance NFData GHCupInfo
@@ -89,7 +87,7 @@ data Requirements = Requirements
{ _distroPKGs :: [Text]
, _notes :: Text
}
deriving (Show, GHC.Generic, Eq)
deriving (Show, GHC.Generic)
instance NFData Requirements
@@ -105,7 +103,7 @@ instance NFData Requirements
-- | Description of all binary and source downloads. This is a tree
-- of nested maps.
type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
type ToolVersionSpec = Map Version VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
@@ -133,18 +131,13 @@ data GlobalTool = ShimGen
instance NFData GlobalTool
instance Pretty GlobalTool where
pPrint ShimGen = text "shimgen"
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viReleaseDay :: Maybe Day
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
-- informative messages
, _viPostInstall :: Maybe Text
@@ -157,17 +150,10 @@ instance NFData VersionInfo
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
| Recommended -- ^ the recommended version of a tool (unique per tool)
| Prerelease -- ^ denotes a prerelease version
-- (a version should either be 'Prerelease' or
-- 'LatestPrerelease', but not both)
| LatestPrerelease -- ^ the latest prerelease (unique per tool)
| Nightly -- ^ denotes a nightly version
-- (a version should either be 'Nightly' or
-- 'LatestNightly', but not both)
| LatestNightly -- ^ the latest nightly (unique per tool)
| Base PVP -- ^ the base version shipped with GHC
data Tag = Latest
| Recommended
| Prerelease
| Base PVP
| Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -178,22 +164,16 @@ tagToString :: Tag -> String
tagToString Recommended = "recommended"
tagToString Latest = "latest"
tagToString Prerelease = "prerelease"
tagToString Nightly = "nightly"
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
tagToString (UnknownTag t ) = t
tagToString LatestPrerelease = "latest-prerelease"
tagToString LatestNightly = "latest-nightly"
tagToString Old = ""
instance Pretty Tag where
pPrint Recommended = text "recommended"
pPrint Latest = text "latest"
pPrint Prerelease = text "prerelease"
pPrint Nightly = text "nightly"
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t
pPrint LatestPrerelease = text "latest-prerelease"
pPrint LatestNightly = text "latest-prerelease"
pPrint Old = mempty
data Architecture = A_64
@@ -283,7 +263,6 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir
, _dlHash :: Text
, _dlCSize :: Maybe Integer
, _dlOutput :: Maybe FilePath
}
deriving (Eq, Ord, GHC.Generic, Show)
@@ -295,23 +274,6 @@ instance NFData DownloadInfo
--[ Others ]--
--------------
data DownloadMirror = DownloadMirror {
authority :: Authority
, pathPrefix :: Maybe Text
} deriving (Eq, Ord, GHC.Generic, Show)
instance NFData DownloadMirror
newtype DownloadMirrors = DM (Map Text DownloadMirror)
deriving (Eq, Ord, GHC.Generic, Show)
instance NFData DownloadMirrors
instance NFData UserInfo
instance NFData Host
instance NFData Port
instance NFData Authority
-- | How to descend into a tar archive.
data TarDir = RealDir FilePath
@@ -354,13 +316,12 @@ data UserSettings = UserSettings
, uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool
, uGPGSetting :: Maybe GPGSetting
, uPlatformOverride :: Maybe PlatformRequest
, uMirrors :: Maybe DownloadMirrors
, uPlatformOverride :: Maybe PlatformRequest
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
@@ -377,7 +338,6 @@ fromSettings Settings{..} Nothing =
, uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
@@ -404,7 +364,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
}
data UserKeyBindings = UserKeyBindings
@@ -434,9 +393,7 @@ data KeyBindings = KeyBindings
deriving (Show, GHC.Generic)
instance NFData KeyBindings
#if defined(IS_WINDOWS) || !defined(BRICK)
instance NFData Key
#endif
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
@@ -488,7 +445,6 @@ data Settings = Settings
, gpgSetting :: GPGSetting
, noColor :: Bool -- this also exists in LoggerConfig
, platformOverride :: Maybe PlatformRequest
, mirrors :: DownloadMirrors
}
deriving (Show, GHC.Generic)
@@ -496,7 +452,7 @@ defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
instance NFData Settings
@@ -601,9 +557,7 @@ data GHCTargetVersion = GHCTargetVersion
{ _tvTarget :: Maybe Text
, _tvVersion :: Version
}
deriving (Ord, Eq, Show, GHC.Generic)
instance NFData GHCTargetVersion
deriving (Ord, Eq, Show)
data GitBranch = GitBranch
{ ref :: String
@@ -642,17 +596,6 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
instance NFData VersionRange
instance Pretty VersionCmp where
pPrint (VR_gt v) = text "> " <> pPrint v
pPrint (VR_gteq v) = text ">= " <> pPrint v
pPrint (VR_lt v) = text "< " <> pPrint v
pPrint (VR_lteq v) = text "<= " <> pPrint v
pPrint (VR_eq v) = text "= " <> pPrint v
instance Pretty VersionRange where
pPrint (SimpleRange xs) = foldl1 (\x y -> x <> text " && " <> y) $ NE.map pPrint xs
pPrint (OrRange xs vr) = foldMap pPrint xs <> " || " <> pPrint vr
instance Pretty Versioning where
pPrint = text . T.unpack . prettyV
@@ -724,21 +667,3 @@ type PromptQuestion = Text
data PromptResponse = PromptYes | PromptNo
deriving (Show, Eq)
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
| ToolDay Day
deriving (Eq, Show)
instance Pretty ToolVersion where
pPrint (GHCVersion v) = pPrint v
pPrint (ToolVersion v) = pPrint v
pPrint (ToolTag t) = pPrint t
pPrint (ToolDay d) = text (show d)
data BuildSystem = Hadrian
| Make
deriving (Show, Eq)

View File

@@ -29,7 +29,6 @@ import Control.Applicative ( (<|>) )
import Data.Aeson hiding (Key)
import Data.Aeson.TH
import Data.Aeson.Types hiding (Key)
import Data.ByteString ( ByteString )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Text.Encoding as E
import Data.Versions
@@ -48,11 +47,10 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
@@ -65,11 +63,8 @@ instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease"
toJSON Nightly = String "Nightly"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON LatestPrerelease = String "LatestPrerelease"
toJSON LatestNightly = String "LatestNightly"
toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where
@@ -77,9 +72,6 @@ instance FromJSON Tag where
"Latest" -> pure Latest
"Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease
"Nightly" -> pure Nightly
"LatestPrerelease" -> pure LatestPrerelease
"LatestNightly" -> pure LatestNightly
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
@@ -96,29 +88,13 @@ instance FromJSON URI where
Right x -> pure x
Left e -> fail . show $ e
instance ToJSON GHCTargetVersion where
toJSON = toJSON . tVerToText
instance FromJSON GHCTargetVersion where
parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey GHCTargetVersion where
toJSONKey = toJSONKeyText $ \x -> tVerToText x
instance FromJSONKey GHCTargetVersion where
fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
instance ToJSON Versioning where
toJSON = toJSON . prettyV
instance FromJSON Versioning where
parseJSON = withText "Versioning" $ \t -> case versioning t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
instance ToJSONKey Versioning where
toJSONKey = toJSONKeyText $ \x -> prettyV x
@@ -249,12 +225,6 @@ instance FromJSON VersionCmp where
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
instance ToJSON ByteString where
toJSON = toJSON . E.decodeUtf8With E.lenientDecode
instance FromJSON ByteString where
parseJSON = withText "ByteString" $ \t -> pure $ E.encodeUtf8 t
versionCmpToText :: VersionCmp -> T.Text
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
@@ -350,12 +320,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
@@ -392,3 +356,4 @@ instance FromJSON URLSource where
pure (AddSource r)
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings

View File

@@ -62,6 +62,7 @@ import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Char ( isHexDigit )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
@@ -92,8 +93,6 @@ import qualified Data.List.NonEmpty as NE
import qualified Streamly.Prelude as S
import Control.DeepSeq (force)
import GHC.IO (evaluate)
import System.Environment (getEnvironment, setEnv)
import Data.Time (Day(..), diffDays, addDays)
-- $setup
@@ -119,11 +118,11 @@ import Data.Time (Day(..), diffDays, addDays)
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
@@ -288,6 +287,13 @@ ghcInstalled ver = do
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
-- | Whether the given GHC version is installed from source.
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesFileExist (fromGHCupPath ghcdir </> ghcUpSrcBuiltFile)
-- | Whether the given GHC version is set as the current.
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
@@ -328,7 +334,7 @@ ghcSet mtarget = do
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
getInstalledGHCs = do
ghcdir <- ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir)
forM fs $ \f -> case parseGHCupGHCDir f of
Right r -> pure $ Right r
Left _ -> pure $ Left f
@@ -431,7 +437,7 @@ getInstalledHLSs = do
Nothing -> pure $ Left f
hlsdir <- ghcupHLSBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir)
new <- forM fs $ \f -> case parseGHCupHLSDir f of
Right r -> pure $ Right r
Left _ -> pure $ Left f
@@ -619,7 +625,7 @@ hlsInternalServerScripts ver mghcVer = do
dir <- ghcupHLSDir ver
let bdir = fromGHCupPath dir </> "bin"
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
<$> liftIO (listDirectoryFiles bdir)
<$> liftIO (listDirectory bdir)
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
-- Returns the full path.
@@ -632,7 +638,7 @@ hlsInternalServerBinaries ver mghcVer = do
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
<$> liftIO (listDirectoryFiles bdir)
<$> liftIO (listDirectory bdir)
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
-- directory, if any.
@@ -645,7 +651,7 @@ hlsInternalServerLibs ver ghcVer = do
dir <- fromGHCupPath <$> ghcupHLSDir ver
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
fmap (bdir </>) <$> liftIO (listDirectoryFiles bdir)
fmap (bdir </>) <$> liftIO (listDirectory bdir)
-- | Get the wrapper binary for an hls version, if any.
@@ -687,8 +693,10 @@ hlsAllBinaries ver = do
-- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
getMajorMinorV Version {..} = case _vChunks of
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
_ -> throwM $ ParseError "Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of
@@ -730,7 +738,7 @@ getGHCForPVP pvpIn mt = do
-- | Like 'getGHCForPVP', except with explicit input parameter.
--
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "debug" :| [])), _vMeta = Just "lol"}})
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
@@ -756,24 +764,21 @@ getGHCForPVP' pvpIn ghcs' mt = do
-- | Get the latest available ghc for the given PVP version, which
-- may only contain parts.
--
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
-- Just (PVP {_pComponents = 8 :| [10,7]})
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
-- Just (PVP {_pComponents = 8 :| [8,4]})
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
-- Just (PVP {_pComponents = 8 :| [8,4]})
getLatestToolFor :: MonadThrow m
=> Tool
-> Maybe Text
-> PVP
-> GHCupDownloads
-> m (Maybe (PVP, VersionInfo, Maybe Text))
getLatestToolFor tool target pvpIn dls = do
let ls :: [(GHCTargetVersion, VersionInfo)]
ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
let ps :: [((PVP, Text), VersionInfo, Maybe Text)]
ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls
pure . fmap (\((pv', _), vi, mt) -> (pv', vi, mt)) . headMay . filter (\((v, _), _, t) -> matchPVPrefix pvpIn v && t == target) $ ps
-> m (Maybe (PVP, VersionInfo))
getLatestToolFor tool pvpIn dls = do
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
@@ -878,41 +883,20 @@ intoSubdir bdir tardir = case tardir of
-- | Get the tool version that has this tag. If multiple have it,
-- picks the greatest version.
getTagged :: Tag
-> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
getTagged tag =
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
% folding id
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
maybe m (\d -> let diff = diffDays d day
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
Map.empty mvv
in case headMay (Map.toAscList mdv) of
Nothing -> Left Nothing
Just (absDiff, (diff, (k, vi)))
| absDiff == 0 -> Right (k, vi)
| otherwise -> Left (Just (addDays diff day))
getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest) av
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
-- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
getLatestBaseVersion av pvpVer =
headOf (ix GHC % getTagged (Base pvpVer)) av
@@ -948,7 +932,7 @@ ghcToolFiles ver = do
whenM (fmap not $ ghcInstalled ver)
(throwE (NotInstalled GHC ver))
files <- liftIO (listDirectoryFiles bindir >>= filterM (doesFileExist . (bindir </>)))
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
where
@@ -966,6 +950,11 @@ ghcToolFiles ver = do
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
-- this GHC was built from source. It contains the build config.
ghcUpSrcBuiltFile :: FilePath
ghcUpSrcBuiltFile = ".ghcup_src_built"
-- | Calls gmake if it exists in PATH, otherwise make.
make :: ( MonadThrow m
@@ -978,28 +967,11 @@ make :: ( MonadThrow m
=> [String]
-> Maybe FilePath
-> m (Either ProcessError ())
make args workdir = make' args workdir "ghc-make" Nothing
-- | Calls gmake if it exists in PATH, otherwise make.
make' :: ( MonadThrow m
, MonadIO m
, MonadReader env m
, HasDirs env
, HasLog env
, HasSettings env
)
=> [String]
-> Maybe FilePath
-> FilePath -- ^ log filename (opened in append mode)
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
make' args workdir logfile menv = do
make args workdir = do
spaths <- liftIO getSearchPath
has_gmake <- isJust <$> liftIO (searchPath spaths "gmake")
let mymake = if has_gmake then "gmake" else "make"
execLogged mymake args workdir logfile menv
execLogged mymake args workdir "ghc-make" Nothing
makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
=> [String]
@@ -1031,7 +1003,7 @@ applyPatches pdir ddir = do
patches <- liftIO $ quilt `catchIO` (\e ->
if isDoesNotExistError e || isPermissionError e then
lexicographical
lexicographical
else throwIO e)
forM_ patches $ \patch' -> applyPatch patch' ddir
@@ -1088,15 +1060,11 @@ darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
getChangeLog dls tool (GHCVersion v') =
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog dls tool (Left v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolVersion (mkTVer -> v')) =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolTag tag) =
getChangeLog dls tool (Right tag) =
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
getChangeLog dls tool (ToolDay day) =
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
-- | Execute a build action while potentially cleaning up:
@@ -1180,7 +1148,7 @@ rmBDir dir = withRunInIO (\run -> run $
$ rmPathForcibly dir)
getVersionInfo :: GHCTargetVersion
getVersionInfo :: Version
-> Tool
-> GHCupDownloads
-> Maybe VersionInfo
@@ -1210,7 +1178,7 @@ ensureGlobalTools
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
@@ -1314,22 +1282,6 @@ warnAboutHlsCompatibility = do
addToPath :: FilePath
-> Bool -- ^ if False will prepend
-> IO [(String, String)]
addToPath path append = do
cEnv <- Map.fromList <$> getEnvironment
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
{- HLINT ignore "Redundant bracket" -}
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
pathVar = if isWindows then "Path" else "PATH"
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
liftIO $ setEnv pathVar newPath
return envWithNewPath
-----------
--[ Git ]--
-----------

View File

@@ -42,9 +42,6 @@ module GHCup.Utils.Dirs
, removeDirectoryRecursive
, removePathForcibly
, listDirectoryFiles
, listDirectoryDirs
-- System.Directory re-exports
, createDirectory
, createDirectoryIfMissing
@@ -133,7 +130,7 @@ import Data.Maybe
import Data.Versions
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts
import Optics hiding ( uncons )
import Optics
import Safe
import System.Directory hiding ( removeDirectory
, removeDirectoryRecursive
@@ -279,7 +276,7 @@ ghcupCacheDir
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup" </> "cache"))
pure (GHCupPath (bdir </> "ghcup"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
@@ -308,7 +305,19 @@ ghcupLogsDir
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
ghcupDbDir :: IO GHCupPath
ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
ghcupDbDir
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup" </> "db"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
-- | '~/.ghcup/trash'.
@@ -520,29 +529,6 @@ cleanupTrash = do
) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
-- | List *actual files* in a directory, ignoring empty files and a couple
-- of blacklisted files, such as '.DS_Store' on mac.
listDirectoryFiles :: FilePath -> IO [FilePath]
listDirectoryFiles fp = do
listDirectory fp >>= filterM (doesFileExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
-- | List *actual directories* in a directory, ignoring empty directories and a couple
-- of blacklisted files, such as '.DS_Store' on mac.
listDirectoryDirs :: FilePath -> IO [FilePath]
listDirectoryDirs fp = do
listDirectory fp >>= filterM (doesDirectoryExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
isHidden :: FilePath -> Bool
isHidden fp'
| isWindows = False
| Just ('.', _) <- uncons fp' = True
| otherwise = False
isBlacklisted :: FilePath -> Bool
{- HLINT ignore "Use ==" -}
isBlacklisted fp' = fp' `elem` [".DS_Store"]
-- System.Directory re-exports with GHCupPath

View File

@@ -24,10 +24,10 @@ import qualified Data.Text as T
import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow)
import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (intersperse)
import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)
-- | This reflects the API version of the YAML.
--
@@ -52,7 +52,7 @@ versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: V.Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range
@@ -65,15 +65,44 @@ pvpToVersion pvp_ rest =
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
Right r -> pure r
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v
where
pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
pvp'' = do
p <- V.pvp'
s <- getParserState
pure (p, stateInput s)
alternative :: MonadThrow m => V.Version -> m V.PVP
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
rest :: V.Version -> Text
rest (V.Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t V.VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: V.VUnit -> Text
f (V.Digits i) = T.pack $ show i
f (V.Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: V.VChunk -> Bool
isDigit (V.Digits _ :| []) = True
isDigit _ = False
unsafeDigit :: V.VChunk -> Int
unsafeDigit (V.Digits x :| []) = fromIntegral x
unsafeDigit _ = error "unsafeDigit: wrong input"
pvpFromList :: [Int] -> V.PVP
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral

View File

@@ -2,6 +2,7 @@ site_name: GHCup
site_url: https://www.haskell.org/ghcup
site_description: GHCup is the main installer for the general purpose language Haskell.
site_author: GHCup Team
site_favicon: haskell_logo.png
repo_url: https://github.com/haskell/ghcup-hs

View File

@@ -28,7 +28,7 @@
plat="$(uname -s)"
arch=$(uname -m)
ghver="0.1.19.4"
ghver="0.1.18.0"
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -119,26 +119,20 @@ edo() {
"$@" || die "\"$*\" failed!"
}
eghcup_raw() {
"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
}
eghcup() {
_eghcup "$@"
edo _eghcup "$@"
}
_eghcup() {
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
args="-s ${BOOTSTRAP_HASKELL_YAML} --metadata-fetching-mode=Strict"
else
args="--metadata-fetching-mode=Strict"
args="-s ${BOOTSTRAP_HASKELL_YAML}"
fi
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
# shellcheck disable=SC2086
"${GHCUP_BIN}/ghcup" ${args} "$@" || die "\"ghcup ${args} $*\" failed!"
"${GHCUP_BIN}/ghcup" ${args} "$@"
else
# shellcheck disable=SC2086
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@" || die "\"ghcup ${args} --verbose $*\" failed!"
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@"
fi
}
@@ -153,7 +147,7 @@ _ecabal() {
}
ecabal() {
_ecabal "$@" || die "\"cabal $*\" failed!"
edo _ecabal "$@"
}
_done() {
@@ -288,6 +282,14 @@ download_ghcup() {
esac
;;
"FreeBSD"|"freebsd")
if freebsd-version | grep -E '^12.*' ; then
freebsd_ver=12
elif freebsd-version | grep -E '^13.*' ; then
freebsd_ver=13
else
die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
fi
case "${arch}" in
x86_64|amd64)
;;
@@ -297,7 +299,7 @@ download_ghcup() {
*) die "Unknown architecture: ${arch}"
;;
esac
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-portbld-freebsd-ghcup-${ghver}
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
;;
"Darwin"|"darwin")
case "${arch}" in
@@ -385,10 +387,10 @@ download_ghcup() {
edo . "${GHCUP_DIR}"/env
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
"curl")
eghcup_raw config set downloader Curl
eghcup config set downloader Curl
;;
"wget")
eghcup_raw config set downloader Wget
eghcup config set downloader Wget
;;
*)
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
@@ -793,7 +795,7 @@ edo mkdir -p "${GHCUP_BIN}"
if command -V "ghcup" >/dev/null 2>&1 ; then
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
( _eghcup upgrade ) || download_ghcup
_eghcup upgrade || download_ghcup
fi
else
download_ghcup
@@ -840,19 +842,19 @@ fi
case $ask_hls_answer in
1)
(_eghcup --cache install hls) || warn "HLS installation failed, continuing anyway"
_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
;;
*) ;;
esac
case $ask_stack_answer in
1)
(_eghcup --cache install stack) || die "Stack installation failed"
_eghcup --cache install stack || die "Stack installation failed"
;;
2)
(_eghcup --cache install stack) || die "Stack installation failed"
edo mkdir -p "${STACK_ROOT:-$HOME/.stack}"/hooks
hook_exe="${STACK_ROOT:-$HOME/.stack}"/hooks/ghc-install.sh
_eghcup --cache install stack || die "Stack installation failed"
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
if [ -e "${hook_exe}" ] ; then

View File

@@ -40,13 +40,10 @@ param (
# Whether to disable use of curl.exe
[switch]$DisableCurl,
# The Msys2 version to download (e.g. 20221216)
[string]$Msys2Version,
# The Msys2 sha256sum hash
[string]$Msys2Hash
[string]$Msys2Version
)
$DefaultMsys2Version = "20221216"
$DefaultMsys2Hash = "18370d32b0264915c97e3d7c618f7b32d48ad80858923883fde5145acd32ca0f"
$Silent = !$Interactive
@@ -433,24 +430,15 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
if (!($Msys2Version)) {
$Msys2Version = $DefaultMsys2Version
}
if (!($Msys2Hash)) {
$Msys2Hash = $DefaultMsys2Hash
}
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
$msysUrl = ('https://downloads.haskell.org/ghcup/msys2/{0}' -f "$archive")
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
Exec "curl.exe" '-o' "$archivePath" "$msysUrl"
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
} else {
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
}
$Msys2HashChecked = Get-FileHash -Algorithm SHA256 "${archivePath}"
if (!($Msys2HashChecked.Hash -eq $Msys2Hash)) {
Print-Msg -color Red -msg ("Hashes don't match, got {0}, but expected {1}" -f $Msys2HashChecked, $Msys2Hash)
Exit 1
}
Print-Msg -msg 'Extracting Msys2 archive...'
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
@@ -459,7 +447,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
Exec "$Bash" '-lc' 'exit'
Exec "$env:windir\system32\taskkill.exe" /F /FI "MODULES eq msys-2.0.dll"
Exec "$env:windir\system32\taskkill.exe" /F /FI `"MODULES eq msys-2.0.dll`"
Print-Msg -msg 'Upgrading full system...'
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'

View File

@@ -1,67 +0,0 @@
#!/bin/bash
set -eu
set -o pipefail
RELEASE=$1
get_sha() {
sha256sum "$1" | awk '{ print $1 }'
}
cd "gh-release-artifacts/v${RELEASE}"
cat <<EOF > /dev/stdout
GHCup:
${RELEASE}:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/ghcup-hs/blob/master/CHANGELOG.md
viSourceDL:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/ghcup-${RELEASE}-src.tar.gz
dlSubdir: ghcup-${RELEASE}
dlHash: $(get_sha "ghcup-${RELEASE}-src.tar.gz")
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-linux-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-linux-ghcup-${RELEASE}")
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-apple-darwin-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-apple-darwin-ghcup-${RELEASE}")
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-portbld-freebsd-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-portbld-freebsd-ghcup-${RELEASE}")
Windows:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-mingw64-ghcup-${RELEASE}.exe
dlHash: $(get_sha "x86_64-mingw64-ghcup-${RELEASE}.exe")
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/i386-linux-ghcup-${RELEASE}
dlHash: $(get_sha "i386-linux-ghcup-${RELEASE}")
Linux_Alpine:
unknown_versioning: *ghcup-32
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-linux-ghcup-${RELEASE}
dlHash: $(get_sha "aarch64-linux-ghcup-${RELEASE}")
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-apple-darwin-ghcup-${RELEASE}
dlHash: $(get_sha "aarch64-apple-darwin-ghcup-${RELEASE}")
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/armv7-linux-ghcup-${RELEASE}
dlHash: $(get_sha "armv7-linux-ghcup-${RELEASE}")
EOF

View File

@@ -1,37 +1,49 @@
#!/bin/bash
set -eu
set -o pipefail
shopt -s extglob
tag=v$1
ver=$1
RELEASE=$1
SIGNER=$2
TAG=${RELEASE/v/}
dest=$2
gpg_user=$3
echo "RELEASE: $RELEASE"
echo "SIGNER: $SIGNER"
mkdir -p "${dest}"
for com in gh gpg curl sha256sum ; do
command -V ${com} >/dev/null 2>&1
done
cd "${dest}"
[ ! -e "gh-release-artifacts/${RELEASE}" ]
base_url="https://gitlab.haskell.org/api/v4/projects/618/jobs/artifacts/${tag}/raw"
mkdir -p "gh-release-artifacts/${RELEASE}"
curl -f -o "x86_64-apple-darwin-ghcup-${ver}" \
"${base_url}/out/x86_64-apple-darwin-ghcup-${ver}?job=release:darwin"
git archive --format=tar.gz -o "gh-release-artifacts/${RELEASE}/ghcup-${TAG}-src.tar.gz" --prefix="ghcup-${TAG}/" HEAD
curl -f -o "aarch64-apple-darwin-ghcup-${ver}" \
"${base_url}/out/aarch64-apple-darwin-ghcup-${ver}?job=release:darwin:aarch64"
cd "gh-release-artifacts/${RELEASE}"
curl -f -o "x86_64-freebsd12-ghcup-${ver}" \
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd12"
# github
gh release download "$RELEASE"
curl -f -o "x86_64-freebsd13-ghcup-${ver}" \
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd13"
curl -f -o "i386-linux-ghcup-${ver}" \
"${base_url}/out/i386-linux-ghcup-${ver}?job=release:linux:32bit"
curl -f -o "x86_64-linux-ghcup-${ver}" \
"${base_url}/out/x86_64-linux-ghcup-${ver}?job=release:linux:64bit"
curl -f -o "aarch64-linux-ghcup-${ver}" \
"${base_url}/out/aarch64-linux-ghcup-${ver}?job=release:linux:aarch64"
curl -f -o "armv7-linux-ghcup-${ver}" \
"${base_url}/out/armv7-linux-ghcup-${ver}?job=release:linux:armv7"
curl -f -o "x86_64-mingw64-ghcup-${ver}.exe" \
"${base_url}/out/x86_64-mingw64-ghcup-${ver}.exe?job=release:windows"
rm -f *.sig
sha256sum *-ghcup-* > SHA256SUMS
gpg --detach-sign -u ${gpg_user} SHA256SUMS
for f in *-ghcup-* ; do gpg --detach-sign -u ${gpg_user} $f ; done
# cirrus
curl -L -o "x86_64-portbld-freebsd-ghcup-${TAG}" \
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${TAG}?branch=${RELEASE}"
sha256sum ./*-ghcup-* > SHA256SUMS
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
gh release upload "$RELEASE" "ghcup-${TAG}-src.tar.gz" "x86_64-portbld-freebsd-ghcup-${TAG}" SHA256SUMS SHA256SUMS.sig

View File

@@ -21,14 +21,16 @@ rm i386-linux-ghcup
rm x86_64-apple-darwin-ghcup
rm x86_64-linux-ghcup
rm x86_64-mingw64-ghcup.exe
rm x86_64-portbld-freebsd-ghcup
rm x86_64-freebsd12-ghcup
rm x86_64-freebsd13-ghcup
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
symlink ${ver}/x86_64-portbld-freebsd-ghcup-${ver} x86_64-portbld-freebsd-ghcup
symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
EOF

View File

@@ -25,28 +25,22 @@ put SHA256SUMS
put SHA256SUMS.sig
put aarch64-apple-darwin-ghcup-${ver}
put aarch64-apple-darwin-ghcup-${ver}.sig
put aarch64-apple-darwin-ghcup.plan.json
put aarch64-linux-ghcup-${ver}
put aarch64-linux-ghcup-${ver}.sig
put aarch64-linux-ghcup.plan.json
put armv7-linux-ghcup-${ver}
put armv7-linux-ghcup-${ver}.sig
put armv7-linux-ghcup.plan.json
put i386-linux-ghcup-${ver}
put i386-linux-ghcup-${ver}.sig
put i386-linux-ghcup.plan.json
put x86_64-apple-darwin-ghcup-${ver}
put x86_64-apple-darwin-ghcup-${ver}.sig
put x86_64-apple-darwin-ghcup.plan.json
put x86_64-portbld-freebsd-ghcup-${ver}
put x86_64-portbld-freebsd-ghcup-${ver}.sig
put x86_64-portbld-freebsd-ghcup.plan.json
put x86_64-freebsd12-ghcup-${ver}
put x86_64-freebsd12-ghcup-${ver}.sig
put x86_64-freebsd13-ghcup-${ver}
put x86_64-freebsd13-ghcup-${ver}.sig
put x86_64-linux-ghcup-${ver}
put x86_64-linux-ghcup-${ver}.sig
put x86_64-linux-ghcup.plan.json
put x86_64-mingw64-ghcup-${ver}.exe
put x86_64-mingw64-ghcup-${ver}.exe.sig
put x86_64-mingw64-ghcup.plan.json
EOF
curl -X PURGE https://downloads.haskell.org/~ghcup/${ver}/

View File

@@ -1,38 +1,56 @@
resolver: lts-20.26
resolver: lts-18.28
packages:
- .
extra-deps:
- Cabal-3.6.3.0
- Cabal-syntax-3.10.1.0
- aeson-2.1.2.1
- cabal-install-parsers-0.6.1
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- ansi-terminal-game-1.8.0.0@sha256:001cf786098d9f1056ac6055ff3f598054b5c231b7343e76abb686d4f485855d,6977
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- chs-cabal-0.1.1.1
- chs-deps-0.1.0.0
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
- generically-0.1.1
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.2.1
- libarchive-3.0.3.2
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.3.0
- libyaml-streamly-0.2.1
- lzma-static-5.2.5.5
- os-release-1.0.2.1
- parsec-3.1.15.0
- linebreak-1.1.0.1@sha256:b253873c3f98189eb22a5a9f0405677cde125c09666b63c3117f497c01c95893,1397
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
- strict-base-0.4.0.0
- text-2.0.2
- yaml-streamly-0.12.2
- github: fosskers/versions
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- timers-tick-0.5.0.1@sha256:91d4b03266715c6969b82cb24e57a6b47191a4d2f95e9a92e0ad3f7301cc7c8b,1552
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
- unidecode-0.1.0.4@sha256:99581ee1ea334a4596a09ae3642e007808457c66893b587e965b31f15cbf8c4d,1144
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- yaml-streamly-0.12.1
flags:
http-io-streams:
brotli: false
libarchive:
system-libarchive: true
system-libarchive: false
regex-posix:
_regex-posix-clib: true
@@ -46,6 +64,9 @@ flags:
streamly:
use-unliftio: true
ghcup:
tui-ansi: true
ghc-options:
"$locals": -O2
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

View File

@@ -11,7 +11,6 @@ import GHCup.Types
import Data.ByteString ( ByteString )
import Data.Versions
import Data.List.NonEmpty
import Data.Time.Calendar ( Day(..) )
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
import Test.QuickCheck.Arbitrary.Generic
@@ -77,9 +76,6 @@ instance Arbitrary Port where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Day where
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
instance Arbitrary (URIRef Absolute) where
arbitrary =
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
@@ -183,10 +179,6 @@ instance Arbitrary GHCupInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary GHCTargetVersion where
arbitrary = GHCTargetVersion Nothing <$> arbitrary
shrink = genericShrink
-- our maps are nested... the default size easily blows up most ppls ram

Some files were not shown because too many files have changed in this diff Show More