Compare commits

..

7 Commits

189 changed files with 24954 additions and 80526 deletions

View File

@@ -1,28 +0,0 @@
freebsd_instance:
image_family: freebsd-13-2
build_task:
name: build
env:
GHC_VER: 9.2.4
CABAL_VER: 3.8.1.0
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
ARCH: 64
RUNNER_OS: FreeBSD
DISTRO: na
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]
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
script:
- tzsetup Etc/GMT
- adjkerntz -a
- bash .github/scripts/build.sh
- bash .github/scripts/test.sh
binaries_artifacts:
path: "out/*"

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

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,37 +0,0 @@
.
./cabal
./ghc
./ghc-8.10.7
./ghc-pkg
./ghc-pkg-8.10.7
./ghci
./ghci-8.10.7
./haddock
./haddock-8.10.7
./haskell-language-server-8.10.6
./haskell-language-server-8.10.6~1.6.1.0
./haskell-language-server-8.10.7
./haskell-language-server-8.10.7~1.6.1.0
./haskell-language-server-8.6.5
./haskell-language-server-8.6.5~1.6.1.0
./haskell-language-server-8.8.4
./haskell-language-server-8.8.4~1.6.1.0
./haskell-language-server-9.0.1
./haskell-language-server-9.0.1~1.6.1.0
./haskell-language-server-9.0.2
./haskell-language-server-9.0.2~1.6.1.0
./haskell-language-server-9.2.1
./haskell-language-server-9.2.1~1.6.1.0
./haskell-language-server-wrapper
./haskell-language-server-wrapper-1.6.1.0
./hp2ps
./hp2ps-8.10.7
./hpc
./hpc-8.10.7
./hsc2hs
./hsc2hs-8.10.7
./runghc
./runghc-8.10.7
./runhaskell
./runhaskell-8.10.7
./stack

View File

@@ -1,31 +0,0 @@
.
./cabal
./ghc
./ghc-8.10.7
./ghc-pkg
./ghc-pkg-8.10.7
./ghci
./ghci-8.10.7
./haddock
./haddock-8.10.7
./haskell-language-server-8.10.7
./haskell-language-server-8.10.7~1.6.1.0
./haskell-language-server-8.8.4
./haskell-language-server-8.8.4~1.6.1.0
./haskell-language-server-9.0.2
./haskell-language-server-9.0.2~1.6.1.0
./haskell-language-server-9.2.1
./haskell-language-server-9.2.1~1.6.1.0
./haskell-language-server-wrapper
./haskell-language-server-wrapper-1.6.1.0
./hp2ps
./hp2ps-8.10.7
./hpc
./hpc-8.10.7
./hsc2hs
./hsc2hs-8.10.7
./runghc
./runghc-8.10.7
./runhaskell
./runhaskell-8.10.7
./stack

View File

@@ -1,81 +0,0 @@
.
./cabal.exe
./cabal.shim
./ghc-8.10.7.exe
./ghc-8.10.7.shim
./ghc-pkg-8.10.7.exe
./ghc-pkg-8.10.7.shim
./ghc-pkg.exe
./ghc-pkg.shim
./ghc.exe
./ghc.shim
./ghci-8.10.7.exe
./ghci-8.10.7.shim
./ghci.exe
./ghci.shim
./ghcii-8.10.7.sh-8.10.7.exe
./ghcii-8.10.7.sh-8.10.7.shim
./ghcii-8.10.7.sh.exe
./ghcii-8.10.7.sh.shim
./ghcii.sh-8.10.7.exe
./ghcii.sh-8.10.7.shim
./ghcii.sh.exe
./ghcii.sh.shim
./haddock-8.10.7.exe
./haddock-8.10.7.shim
./haddock.exe
./haddock.shim
./haskell-language-server-8.10.6.exe
./haskell-language-server-8.10.6.shim
./haskell-language-server-8.10.6~1.6.1.0.exe
./haskell-language-server-8.10.6~1.6.1.0.shim
./haskell-language-server-8.10.7.exe
./haskell-language-server-8.10.7.shim
./haskell-language-server-8.10.7~1.6.1.0.exe
./haskell-language-server-8.10.7~1.6.1.0.shim
./haskell-language-server-8.6.5.exe
./haskell-language-server-8.6.5.shim
./haskell-language-server-8.6.5~1.6.1.0.exe
./haskell-language-server-8.6.5~1.6.1.0.shim
./haskell-language-server-8.8.4.exe
./haskell-language-server-8.8.4.shim
./haskell-language-server-8.8.4~1.6.1.0.exe
./haskell-language-server-8.8.4~1.6.1.0.shim
./haskell-language-server-9.0.1.exe
./haskell-language-server-9.0.1.shim
./haskell-language-server-9.0.1~1.6.1.0.exe
./haskell-language-server-9.0.1~1.6.1.0.shim
./haskell-language-server-9.0.2.exe
./haskell-language-server-9.0.2.shim
./haskell-language-server-9.0.2~1.6.1.0.exe
./haskell-language-server-9.0.2~1.6.1.0.shim
./haskell-language-server-9.2.1.exe
./haskell-language-server-9.2.1.shim
./haskell-language-server-9.2.1~1.6.1.0.exe
./haskell-language-server-9.2.1~1.6.1.0.shim
./haskell-language-server-wrapper-1.6.1.0.exe
./haskell-language-server-wrapper-1.6.1.0.shim
./haskell-language-server-wrapper.exe
./haskell-language-server-wrapper.shim
./hp2ps-8.10.7.exe
./hp2ps-8.10.7.shim
./hp2ps.exe
./hp2ps.shim
./hpc-8.10.7.exe
./hpc-8.10.7.shim
./hpc.exe
./hpc.shim
./hsc2hs-8.10.7.exe
./hsc2hs-8.10.7.shim
./hsc2hs.exe
./hsc2hs.shim
./runghc-8.10.7.exe
./runghc-8.10.7.shim
./runghc.exe
./runghc.shim
./runhaskell-8.10.7.exe
./runhaskell-8.10.7.shim
./runhaskell.exe
./runhaskell.shim
./stack.exe
./stack.shim

View File

@@ -1,18 +0,0 @@
#!/usr/bin/env bash
set -eux
. .github/scripts/env.sh
mkdir -p "$CI_PROJECT_DIR"/.local/bin
git describe --always
### build
./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

@@ -1,37 +0,0 @@
#!/bin/sh
set -eux
. .github/scripts/common.sh
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
# 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)
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 ./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,174 +0,0 @@
#!/bin/sh
. .github/scripts/env.sh
ecabal() {
cabal "$@"
}
nonfatal() {
"$@" || "$* failed"
}
sync_from() {
if [ "${RUNNER_OS}" != "Windows" ] ; then
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi
cabal-cache.sh sync-from-archive \
--host-name-override=${S3_HOST} \
--host-port-override=443 \
--host-ssl-override=True \
--region us-west-2 \
$([ "${RUNNER_OS}" != "Windows" ] && echo --store-path="$cabal_store_path") \
--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
}
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 \
--host-name-override=${S3_HOST} \
--host-port-override=443 \
--host-ssl-override=True \
--region us-west-2 \
$([ "${RUNNER_OS}" != "Windows" ] && echo --store-path="$cabal_store_path") \
--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
}
raw_eghcup() {
"$GHCUP_BIN/ghcup${ext}" -v -c "$@"
}
eghcup() {
if [ "${OS}" = "Windows" ] ; then
"$GHCUP_BIN/ghcup${ext}" -c -s "file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
else
"$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
fi
}
sha_sum() {
if [ "${OS}" = "FreeBSD" ] ; then
sha256 "$@"
else
sha256sum "$@"
fi
}
git_describe() {
git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*"
git describe --always
}
download_cabal_cache() {
(
set -e
mkdir -p "$HOME/.local/bin"
dest="$HOME/.local/bin/cabal-cache"
url=""
exe=""
cd /tmp
case "${RUNNER_OS}" in
"Linux")
case "${ARCH}" in
"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/i386-linux-cabal-cache
;;
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-linux-cabal-cache
;;
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-linux-cabal-cache
;;
"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/armv7-linux-cabal-cache
;;
esac
;;
"FreeBSD")
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-portbld-freebsd-cabal-cache
;;
"Windows")
exe=".exe"
url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-mingw64-cabal-cache
;;
"macOS")
case "${ARCH}" in
"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-apple-darwin-cabal-cache
;;
"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-apple-darwin-cabal-cache
;;
esac
;;
esac
if [ -n "${url}" ] ; then
case "${url##*.}" in
"gz")
curl -L -o - "${url}" | gunzip > cabal-cache${exe}
;;
*)
curl -o cabal-cache${exe} -L "${url}"
;;
esac
sha_sum cabal-cache${exe}
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
ecabal build "$@"
sync_to
}
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
}
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
}
strip_binary() {
(
set -e
local binary=$1
case "$(uname -s)" in
"Darwin"|"darwin")
;;
MSYS_*|MINGW*)
;;
*)
strip -s "${binary}"
;;
esac
)
}

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

@@ -1,72 +0,0 @@
#!/usr/bin/env bash
set -eux
. .github/scripts/common.sh
mkdir -p "$CI_PROJECT_DIR"/.local/bin
### build
if [ "${OS}" = "Windows" ] ; then
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
rm -rf "${GHCUP_DIR}"
mkdir -p "${GHCUP_BIN}"
ls -lah out
find out
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}"
echo "$PATH"
"$GHCUP_BIN/ghcup${ext}" --version
eghcup --version
sha_sum "$GHCUP_BIN/ghcup${ext}"
sha_sum "$(raw_eghcup --offline whereis ghcup)"
git_describe
eghcup install ghc "${GHC_VERSION}"
eghcup install cabal "${CABAL_VERSION}"
ecabal update
if ! command -v cabal-cache ; then
download_cabal_cache "$HOME/.local/bin/cabal-cache"
fi
if ! cabal-cache version ; then
build_cabal_cache "$HOME/.local/bin"
fi
eghcup debug-info
(
cd /tmp
git clone --depth 1 --branch "${HLS_TARGET_VERSION}" \
https://github.com/haskell/haskell-language-server.git \
"haskell-language-server-${HLS_TARGET_VERSION}"
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
ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" || sync_to
sync_to
)
eghcup -v compile hls -j "$(nproc)" -g "${HLS_TARGET_VERSION}" --ghc "${GHC_VERSION}"
[ "$($(eghcup whereis hls "${HLS_TARGET_VERSION}") --numeric-version)" = "${HLS_TARGET_VERSION}" ] ||
[ "$($(eghcup whereis hls "${HLS_TARGET_VERSION}") --numeric-version | sed 's/.0$//')" = "${HLS_TARGET_VERSION}" ]
# nuke
eghcup nuke
[ ! -e "${GHCUP_DIR}" ]

View File

@@ -1,265 +0,0 @@
#!/usr/bin/env bash
set -eux
. .github/scripts/common.sh
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}"
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
sha_sum "$GHCUP_BIN/ghcup${ext}"
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}"
### manual cli based testing
eghcup --numeric-version
eghcup install ghc "${GHC_VER}"
eghcup unset ghc "${GHC_VER}"
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
eghcup set ghc "${GHC_VER}"
eghcup install cabal "${CABAL_VER}"
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
eghcup set cabal "${CABAL_VER}"
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
if [ "${OS}" != "FreeBSD" ] ; then
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
eghcup run --ghc 8.10.7 --cabal 3.4.1.0 --hls 1.6.1.0 --stack 2.7.3 --install --bindir "$(pwd)/.bin"
if [ "${OS}" = "Windows" ] ; then
cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.windows" | sort > expected.txt
elif [ "${DISTRO}" = "Alpine" ] ; then
cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.alpine" | sort > expected.txt
else
cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files" | sort > expected.txt
fi
(cd ".bin" && find . | sort) > actual.txt
diff --strip-trailing-cr -w -u actual.txt expected.txt
rm actual.txt expected.txt
rm -rf .bin
fi
fi
cabal --version
eghcup debug-info
# also test etags
eghcup list
eghcup list -t ghc
eghcup list -t cabal
ghc_ver=$(ghc --numeric-version)
ghc --version
"ghc-${ghc_ver}" --version
if [ "${OS}" != "Windows" ] ; then
ghci --version
"ghci-${ghc_ver}" --version
fi
if [ "${OS}" = "macOS" ] && [ "${ARCH}" = "ARM64" ] ; then
# missing bindists
echo
elif [ "${OS}" = "FreeBSD" ] ; then
# not enough space
echo
else
# test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "Linux" ] ; then
eghcup --downloader=wget prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
if [ "${ARCH}" = "64" ] ; then
if [ "${DISTRO}" = "Alpine" ] ; then
(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.alpine.files" | sort) > expected.txt
else
(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort) > expected.txt
fi
(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort) > actual.txt
# ignore docs
sed -i '/share\/doc/d' actual.txt
sed -i '/share\/doc/d' expected.txt
diff --strip-trailing-cr -w -u actual.txt expected.txt
rm actual.txt expected.txt
fi
elif [ "${OS}" = "Windows" ] ; then
eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort) > expected.txt
(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort) > actual.txt
diff --strip-trailing-cr -w -u actual.txt expected.txt
rm actual.txt expected.txt
else
eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
fi
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup --offline set 8.10.3
eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set "${GHC_VER}"
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup unset ghc
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
eghcup set "${GHC_VER}"
eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
ls -lah "$GHCUP_BIN"
if [ "${OS}" = "macOS" ] ; then
eghcup install hls
$(eghcup whereis hls) --version
eghcup install stack
$(eghcup whereis stack) --version
elif [ "${OS}" = "Linux" ] ; then
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
eghcup install hls
haskell-language-server-wrapper --version
eghcup unset hls
"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit 1 || echo yes
eghcup install stack
stack --version
eghcup unset stack
"$GHCUP_BIN"/stack --version && exit 1 || echo yes
fi
fi
fi
# check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc "$(ghc --numeric-version)"
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup rm "$(ghc --numeric-version)"
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
if [ "${OS}" = "Linux" ] ; then
if [ "${ARCH}" = "64" ] ; then
eghcup install cabal -u https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.7.0.0-pre20220407/cabal-install-3.7-x86_64-linux-alpine.tar.xz 3.4.0.0-rc4
eghcup rm cabal 3.4.0.0-rc4
fi
fi
eghcup gc -c
# test etags
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
# snapshot yaml and etags file
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
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
# 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")
# compare
[ "${etag}" != "${etag2}" ]
[ "${sha}" != "${sha2}" ]
# 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
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
[ "${etag2}" = "${etag3}" ]
[ "${sha2}" = "${sha3}" ]
# test isolated installs
if [ "${DISTRO}" != "Alpine" ] ; then
eghcup install ghc -i "$(pwd)/isolated" 8.10.5
[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
if [ "${ARCH}" = "64" ] ; then
if [ "${OS}" = "Linux" ] || [ "${OS}" = "Windows" ] ; then
eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
eghcup install stack -i "$(pwd)/isolated" 2.7.3
[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
eghcup install hls -i "$(pwd)/isolated" 1.3.0
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
# test that isolated installs don't clean up target directory
cat <<EOF > "${GHCUP_BIN}/gmake"
#!/bin/bash
exit 1
EOF
chmod +x "${GHCUP_BIN}/gmake"
mkdir isolated_tainted/
touch isolated_tainted/lol
! eghcup install ghc -i "$(pwd)/isolated_tainted" 8.10.5 --force
[ -e "$(pwd)/isolated_tainted/lol" ]
rm "${GHCUP_BIN}/gmake"
fi
fi
fi
eghcup upgrade
eghcup upgrade -f
# restore old ghcup, because we want to test nuke
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}"
# 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,58 +0,0 @@
name: Bootstrap tests
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
jobs:
bootstrap:
name: bootstrap
runs-on: ${{ matrix.os }}
env:
BOOTSTRAP_HASKELL_CABAL_VERSION: 3.6.2.0
BOOTSTRAP_HASKELL_GHC_VERSION: 8.10.7
BOOTSTRAP_HASKELL_NONINTERACTIVE: yes
ARCH: 64
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: ubuntu-latest
DISTRO: Ubuntu
- os: macOS-11
DISTRO: na
- os: windows-latest
DISTRO: na
steps:
- name: Checkout code
uses: actions/checkout@v3
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'
name: Run bootstrap
run: sh ./.github/scripts/bootstrap.sh
env:
DISTRO: ${{ matrix.DISTRO }}
- 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
shell: pwsh

View File

@@ -1,37 +0,0 @@
name: Cache eviction
on:
workflow_dispatch:
inputs:
key:
description: Which cache to evict
required: true
default: '/'
type: choice
options:
- FreeBSD-64-na
- Linux-32-Alpine
- Linux-64-Alpine
- Linux-64-Ubuntu
- Linux-ARM-Ubuntu
- Linux-ARM64-Ubuntu
- Windows-64-na
- macOS-64-na
- macOS-ARM64-na
- /
jobs:
evict:
runs-on: ubuntu-latest
steps:
- name: Remove from S3
uses: vitorsgomes/s3-rm-action@master
with:
args: --recursive
env:
AWS_S3_ENDPOINT: https://${{ secrets.S3_HOST }}
AWS_S3_BUCKET: ghcup-hs
AWS_REGION: us-west-2
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
PATH_TO_DELETE: ${{ github.event.inputs.key }}

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

@@ -1,125 +0,0 @@
name: Docker image builds
on:
workflow_dispatch:
schedule:
- cron: '0 0 * * *'
jobs:
docker-alpine32:
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 }}
- name: Build and push (alpine 32bit)
uses: docker/build-push-action@v3
with:
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 }}
- name: Build and push (alpine 64bit)
uses: docker/build-push-action@v3
with:
context: ./docker/alpine64
push: true
tags: hasufell/alpine-haskell:3.12
platforms: linux/amd64
docker-arm32:
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/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
push: true
tags: hasufell/arm64v8-ubuntu-haskell:focal
platforms: linux/arm64

View File

@@ -1,26 +0,0 @@
name: Hlint
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
jobs:
hlint:
name: hlint
runs-on: ubuntu-latest
env:
JSON_VERSION: "0.0.7"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- name: Run hlint
run: curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/

View File

@@ -1,33 +0,0 @@
name: MkDocs
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
jobs:
mkdocs:
name: mkdocs
runs-on: ubuntu-latest
env:
JSON_VERSION: "0.0.7"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- name: Install mkdocs deps
run: |
sudo apt-get update -y
sudo apt-get install -y python3-pip
sudo pip3 install mkdocs
- name: Run mkdocs
run: |
mkdocs build

View File

@@ -1,518 +1,109 @@
name: Build and release name: Create Release
on: on:
push: push:
branches:
- master
tags: tags:
- 'v*' - 'v*'
pull_request:
branches:
- master
schedule:
- cron: '0 2 * * *'
env:
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
CABAL_CACHE_NONFATAL: yes
jobs: jobs:
build-linux: draft_release:
name: Build linux binary name: Draft Release
runs-on: ubuntu-latest
outputs:
upload_url: ${{ steps.create_release.outputs.upload_url }}
steps:
- name: Create Release
id: create_release
uses: actions/create-release@v1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
tag_name: ${{ github.ref }}
release_name: Release ${{ github.ref }}
body: |
Changes in this Release
- First Change
- Second Change
draft: true
prerelease: false
release-mac:
name: Create Release
needs: draft_release
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.10.1.0 MACOSX_DEPLOYMENT_TARGET: 10.13
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 }}
strategy: strategy:
fail-fast: true
matrix: matrix:
include: os:
- os: ubuntu-latest - macOS-10.15
ARTIFACT: "i386-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 32
- os: ubuntu-latest
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 64
steps: steps:
- name: Checkout code - name: Checkout code
uses: actions/checkout@v3 uses: actions/checkout@v2
- uses: haskell/actions/setup@v1.2
with: with:
submodules: 'true' ghc-version: 8.10.7
cabal-version: 3.6.2.0
- if: matrix.ARCH == '32' - name: create ~/.local/bin
name: Run build (32 bit linux) run: mkdir -p "$HOME/.local/bin"
uses: docker://hasufell/i386-alpine-haskell:3.12
with:
args: sh .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.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: matrix.ARCH == '64'
name: Run build (64 bit linux)
uses: docker://hasufell/alpine-haskell:3.12
with:
args: sh .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.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/*
build-arm:
name: Build ARM binary
runs-on: ${{ matrix.os }}
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 }}
strategy:
fail-fast: true
matrix:
include:
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
ARCH: ARM
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.6
ARCH: ARM64
steps:
- uses: docker://arm64v8/debian:10
name: Cleanup (aarch64 linux)
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
- name: git config
run: |
git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*"
shell: bash shell: bash
- name: Checkout code - name: Add ~/.local/bin to PATH
uses: actions/checkout@v3 run: echo "$HOME/.local/bin" >> $GITHUB_PATH
with: shell: bash
submodules: 'true'
- if: matrix.ARCH == 'ARM' - name: Update cabal cache
uses: docker://hasufell/arm32v7-debian-haskell:10 run: cabal update
name: Run build (armv7 linux) shell: bash
with:
args: sh .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: Ubuntu
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ env.S3_HOST }}
- if: matrix.ARCH == 'ARM64' - name: Install cabal dependencies
uses: docker://hasufell/arm64v8-debian-haskell:10 run: cabal build --only-dependencies --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
name: Run build (aarch64 linux) shell: bash
with:
args: sh .github/scripts/build.sh - name: Build
run: cabal build --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
shell: bash
- name: Install
run: cp "$(cabal list-bin exe:ghcup)" ~/.local/bin/ghcup
shell: bash
- name: Strip
run: strip ~/.local/bin/ghcup
shell: bash
- name: Run tests
run: cabal test --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" all
shell: bash
- name: Install git
run: brew install git
- name: set HOME
run: echo "HOME=$HOME" >> $GITHUB_ENV
shell: bash
- name: Set ASSET_PATH
run: echo "ASSET_PATH=$HOME/.local/bin/ghcup" >> $GITHUB_ENV
shell: bash
- name: Upload Release Asset
id: upload-release-asset
uses: actions/upload-release-asset@v1
env: env:
ARTIFACT: ${{ matrix.ARTIFACT }} GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
ARCH: ${{ matrix.ARCH }} with:
GHC_VER: ${{ matrix.GHC_VER }} upload_url: ${{ needs.draft_release.outputs.upload_url }}
DISTRO: Ubuntu asset_path: ${{ env.ASSET_PATH }}
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }} asset_name: ghcup-${{ matrix.os }}
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }} asset_content_type: application/octet-stream
S3_HOST: ${{ env.S3_HOST }}
- if: always() - if: always()
name: Upload artifact uses: actions/upload-artifact@v2
uses: actions/upload-artifact@v3
with: with:
name: artifacts name: plan.json
path: | path: ./dist-newstyle/cache/plan.json
./out/*
build-macwin:
name: Build binary (Mac/Win)
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
MACOSX_DEPLOYMENT_TARGET: 10.13
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 }}
strategy:
fail-fast: false
matrix:
include:
- os: [self-hosted, macOS, ARM64]
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: ARM64
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: 64
- os: windows-latest
ARTIFACT: "x86_64-mingw64-ghcup"
GHC_VER: 8.10.7
ARCH: 64
steps:
- name: Checkout code
uses: actions/checkout@v3
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
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: always()
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: artifacts
path: |
./out/*
test-linux:
name: Test linux
needs: "build-linux"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: ubuntu-latest
ARTIFACT: "i386-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 32
DISTRO: Alpine
- os: ubuntu-latest
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 64
DISTRO: Alpine
- os: ubuntu-latest
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
ARCH: 64
DISTRO: Ubuntu
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- if: matrix.ARCH == '32' && matrix.DISTRO == 'Alpine'
name: Run test (32 bit linux Alpine)
uses: docker://hasufell/i386-alpine-haskell:3.12
with:
args: sh .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: ${{ matrix.DISTRO }}
- if: matrix.ARCH == '64' && matrix.DISTRO == 'Alpine'
name: Run test (64 bit linux Alpine)
uses: docker://hasufell/alpine-haskell:3.12
with:
args: sh .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: ${{ matrix.DISTRO }}
- 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
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: ${{ matrix.DISTRO }}
- if: failure()
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: testfiles
path: |
./test/ghcup-test/golden/unix/GHCupInfo*json
test-arm:
name: Test ARM
needs: "build-arm"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
ARCH: ARM
DISTRO: Ubuntu
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.6
ARCH: ARM64
DISTRO: Ubuntu
steps:
- uses: docker://arm64v8/debian:10
name: Cleanup (aarch64 linux)
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- if: matrix.ARCH == 'ARM'
uses: docker://hasufell/arm32v7-debian-haskell:10
name: Run test (armv7 linux)
with:
args: sh .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: Ubuntu
- if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-debian-haskell:10
name: Run test (aarch64 linux)
with:
args: sh .github/scripts/test.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
ARCH: ${{ matrix.ARCH }}
GHC_VER: ${{ matrix.GHC_VER }}
DISTRO: Ubuntu
- if: failure()
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: testfiles
path: |
./test/ghcup-test/golden/unix/GHCupInfo*json
test-macwin:
name: Test Mac/Win
needs: "build-macwin"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: [self-hosted, macOS, ARM64]
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: ARM64
DISTRO: na
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: 64
DISTRO: na
- os: windows-latest
ARTIFACT: "x86_64-mingw64-ghcup"
GHC_VER: 8.10.7
ARCH: 64
DISTRO: na
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
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
run: 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: failure() && runner.os == 'Windows'
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: testfiles
path: |
./test/ghcup-test/golden/windows/GHCupInfo*json
- if: failure() && runner.os != 'Windows'
name: Upload artifact
uses: actions/upload-artifact@v3
with:
name: testfiles
path: |
./test/ghcup-test/golden/unix/GHCupInfo*json
hls:
name: hls
needs: build-linux
runs-on: ubuntu-latest
env:
GHC_VERSION: "8.10.7"
HLS_TARGET_VERSION: "1.8.0.0"
CABAL_VERSION: "3.8.1.0"
JSON_VERSION: "0.0.7"
ARTIFACT: "x86_64-linux-ghcup"
DISTRO: Ubuntu
ARCH: 64
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
S3_HOST: ${{ secrets.S3_HOST }}
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- uses: actions/download-artifact@v3
with:
name: artifacts
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
release:
name: release
needs: ["test-linux", "test-arm", "test-macwin", "hls"]
runs-on: ubuntu-latest
if: startsWith(github.ref, 'refs/tags/v')
steps:
- name: Download artifacts
uses: actions/download-artifact@v3
with:
name: artifacts
path: ./out
- name: Release
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
./out/*

View File

@@ -1,28 +0,0 @@
name: Shellcheck
on:
push:
branches:
- master
tags:
- 'v*'
pull_request:
branches:
- master
jobs:
shellcheck:
name: shellcheck
runs-on: ubuntu-latest
env:
JSON_VERSION: "0.0.7"
steps:
- name: Checkout code
uses: actions/checkout@v3
with:
submodules: 'true'
- name: Run shellcheck
uses: docker://koalaman/shellcheck-alpine
with:
args: shellcheck scripts/bootstrap/bootstrap-haskell

View File

@@ -13,7 +13,7 @@ variables:
# Sequential version number of all cached things. # Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache. # Bump to invalidate GitLab CI cache.
CACHE_REV: 1 CACHE_REV: 0
GIT_SUBMODULE_STRATEGY: recursive GIT_SUBMODULE_STRATEGY: recursive
@@ -125,10 +125,6 @@ variables:
- test/golden - test/golden
- dist-newstyle/cache/ - dist-newstyle/cache/
when: on_failure when: on_failure
cache:
key: ghcup-test-$CACHE_REV
paths:
- cabal-cache
# .test_ghcup_scoop: # .test_ghcup_scoop:
# script: # script:
@@ -140,10 +136,6 @@ variables:
- .debian - .debian
before_script: before_script:
- ./.gitlab/before_script/linux/install_deps.sh - ./.gitlab/before_script/linux/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:linux32: .test_ghcup_version:linux32:
extends: extends:
@@ -151,10 +143,6 @@ variables:
- .alpine:32bit - .alpine:32bit
before_script: before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh - ./.gitlab/before_script/linux/alpine/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:armv7: .test_ghcup_version:armv7:
extends: extends:
@@ -162,10 +150,6 @@ variables:
- .linux:armv7 - .linux:armv7
before_script: before_script:
- ./.gitlab/before_script/linux/install_deps.sh - ./.gitlab/before_script/linux/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:aarch64: .test_ghcup_version:aarch64:
extends: extends:
@@ -173,42 +157,45 @@ variables:
- .linux:aarch64 - .linux:aarch64
before_script: before_script:
- ./.gitlab/before_script/linux/install_deps.sh - ./.gitlab/before_script/linux/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:darwin: .test_ghcup_version:darwin:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .darwin - .darwin
- .root_cleanup
before_script: before_script:
- ./.gitlab/before_script/darwin/install_deps.sh - ./.gitlab/before_script/darwin/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:darwin:aarch64: .test_ghcup_version:darwin:aarch64:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .darwin:aarch64 - .darwin:aarch64
- .root_cleanup
cache: cache:
key: darwin-brew-$CACHE_REV key: darwin-brew-$CACHE_REV
paths: paths:
- brew_cache - .brew
key: ghcup-test-$CACHE_REV - .brew_cache
paths:
- cabal-cache
before_script: before_script:
# extract brew cache # Install brew locally in the project dir. Packages will also be installed here.
- ./.gitlab/script/ci.sh extract_brew_cache - '[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew'
- export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# otherwise we seem to get intel binaries # otherwise we seem to get intel binaries
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1 - export HOMEBREW_CHANGE_ARCH_TO_ARM=1
# make sure to not pollute the machine with temp files etc
- 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
# update and install packages # update and install packages
- /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake coreutils - brew update
# extract cabal cache - brew install llvm
- ./.gitlab/script/ci.sh extract_cabal_cache - brew install autoconf automake coreutils
script: | script: |
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH" export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
@@ -218,51 +205,40 @@ variables:
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
./.gitlab/before_script/darwin/install_deps.sh ./.gitlab/before_script/darwin/install_deps.sh
./.gitlab/script/ghcup_version.sh ./.gitlab/script/ghcup_version.sh
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- ./.gitlab/script/ci.sh save_brew_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:freebsd12: .test_ghcup_version:freebsd12:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .freebsd12 - .freebsd12
- .root_cleanup
before_script: before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:freebsd13: .test_ghcup_version:freebsd13:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .freebsd13 - .freebsd13
- .root_cleanup
before_script: before_script:
- sudo pkg update - sudo pkg update
- sudo pkg install --yes compat12x-amd64 - sudo pkg install --yes compat12x-amd64
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2 - sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
- ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
.test_ghcup_version:windows: .test_ghcup_version:windows:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
- .windows - .windows
- .root_cleanup
before_script: before_script:
- set CABAL_DIR="$CI_PROJECT_DIR/cabal"
- bash ./.gitlab/before_script/windows/install_deps.sh - bash ./.gitlab/before_script/windows/install_deps.sh
- bash ./.gitlab/script/ci.sh extract_cabal_cache
after_script:
- bash ./.gitlab/script/ci.sh save_cabal_cache
- bash ./.gitlab/after_script.sh
# .test_ghcup_scoop:windows: # .test_ghcup_scoop:windows:
# extends: # extends:
# - .windows # - .windows
# - .test_ghcup_scoop # - .test_ghcup_scoop
# - .root_cleanup
.release_ghcup: .release_ghcup:
script: script:
@@ -282,12 +258,9 @@ variables:
test:linux:stack: test:linux:stack:
stage: test stage: test
before_script: before_script:
- ./.gitlab/script/ci.sh extract_stack_cache
- ./.gitlab/before_script/linux/install_deps_minimal.sh - ./.gitlab/before_script/linux/install_deps_minimal.sh
script: script:
- ./.gitlab/script/ghcup_stack.sh - ./.gitlab/script/ghcup_stack.sh
after_script:
- ./.gitlab/script/ci.sh save_stack_cache
extends: extends:
- .debian - .debian
needs: [] needs: []
@@ -317,7 +290,6 @@ test:windows:bootstrap_powershell_script:
- "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)" - "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)"
- "[Environment]::SetEnvironmentVariable('CABAL_DIR', $null, [System.EnvironmentVariableTarget]::User)" - "[Environment]::SetEnvironmentVariable('CABAL_DIR', $null, [System.EnvironmentVariableTarget]::User)"
- bash ./.gitlab/after_script.sh - bash ./.gitlab/after_script.sh
- bash ./.gitlab/script/ci.sh save_cabal_cache
variables: variables:
GHC_VERSION: "8.10.7" GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0" CABAL_VERSION: "3.6.2.0"
@@ -564,17 +536,28 @@ release:darwin:aarch64:
cache: cache:
key: darwin-brew-$CACHE_REV key: darwin-brew-$CACHE_REV
paths: paths:
- brew_cache - .brew
key: ghcup-test-$CACHE_REV - .brew_cache
paths:
- cabal-cache
before_script: before_script:
- ./.gitlab/script/ci.sh extract_brew_cache # Install brew locally in the project dir. Packages will also be installed here.
- ./.gitlab/script/ci.sh extract_cabal_cache - '[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew'
- export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# otherwise we seem to get intel binaries # otherwise we seem to get intel binaries
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1 - export HOMEBREW_CHANGE_ARCH_TO_ARM=1
# make sure to not pollute the machine with temp files etc
- 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
# update and install packages # update and install packages
- /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake coreutils - brew update
- brew install llvm
- brew install autoconf automake
script: | script: |
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH" export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
@@ -584,9 +567,6 @@ release:darwin:aarch64:
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
./.gitlab/before_script/darwin/install_deps.sh ./.gitlab/before_script/darwin/install_deps.sh
./.gitlab/script/ghcup_release.sh ./.gitlab/script/ghcup_release.sh
after_script:
- ./.gitlab/script/ci.sh save_cabal_cache
- ./.gitlab/script/ci.sh save_brew_cache
variables: variables:
ARTIFACT: "aarch64-apple-darwin-ghcup" ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VERSION: "8.10.7" GHC_VERSION: "8.10.7"

View File

@@ -1,23 +1,11 @@
if [ "${OS}" = "WINDOWS" ] ; then if [ "${OS}" = "WINDOWS" ] ; then
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR" export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin" export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin"
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH" export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
export TMPDIR="$CI_PROJECT_DIR/tmp" export TMPDIR="$CI_PROJECT_DIR/tmp"
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
export STACK_ROOT="$CI_PROJECT_DIR/stack"
export STACK_CACHE="$CI_PROJECT_DIR/stack-cache"
export BREW_DIR="$CI_PROJECT_DIR/.brew_cache"
export BREW_CACHE="$CI_PROJECT_DIR/brew-cache"
else else
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR" export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin" export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH" export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
export TMPDIR="$CI_PROJECT_DIR/tmp" export TMPDIR="$CI_PROJECT_DIR/tmp"
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
export STACK_ROOT="$CI_PROJECT_DIR/stack"
export STACK_CACHE="$CI_PROJECT_DIR/stack-cache"
export BREW_DIR="$CI_PROJECT_DIR/.brew_cache"
export BREW_CACHE="$CI_PROJECT_DIR/brew-cache"
fi fi

View File

@@ -1,19 +0,0 @@
#!/usr/bin/env bash
set -Eeuxo pipefail
# Install brew locally in the project dir. Packages will also be installed here.
[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew
export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# make sure to not pollute the machine with temp files etc
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
# update and install packages
brew update
brew install ${1+"$@"}

View File

@@ -1,70 +0,0 @@
#!/usr/bin/env bash
set -Eeuo pipefail
TOP="$( cd "$(dirname "$0")" ; pwd -P )"
. "${TOP}/../ghcup_env"
function save_cabal_cache () {
echo "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..."
rm -Rf "$CABAL_CACHE"
mkdir -p "$CABAL_CACHE"
if [ -d "$CABAL_DIR" ]; then
cp -Rf "$CABAL_DIR" "$CABAL_CACHE/"
fi
}
function extract_cabal_cache () {
if [ -d "$CABAL_CACHE" ]; then
echo "Extracting cabal cache from $CABAL_CACHE to $CABAL_DIR..."
mkdir -p "$CABAL_DIR"
cp -Rf "$CABAL_CACHE"/* "$CABAL_DIR"
fi
}
function save_stack_cache () {
echo "Storing stack cache from $STACK_ROOT to $STACK_CACHE..."
rm -Rf "$STACK_CACHE"
mkdir -p "$STACK_CACHE"
if [ -d "$STACK_ROOT" ]; then
cp -Rf "$STACK_DIR" "$STACK_CACHE"
fi
}
function extract_stack_cache () {
if [ -d "$STACK_CACHE" ]; then
echo "Extracting stack cache from $STACK_CACHE to $STACK_ROOT..."
mkdir -p "$STACK_ROOT"
cp -Rf "$STACK_CACHE"/* "$STACK_ROOT"
fi
}
function save_brew_cache () {
echo "Storing brew cache from $BREW_DIR to $BREW_CACHE..."
rm -Rf "$BREW_CACHE"
mkdir -p "$BREW_CACHE"
if [ -d "$BREW_DIR" ]; then
cp -Rf "$BREW_DIR" "$BREW_CACHE"
fi
}
function extract_brew_cache () {
if [ -d "$BREW_CACHE" ]; then
echo "Extracting stack cache from $BREW_CACHE to $BREW_DIR..."
mkdir -p "$BREW_DIR"
cp -Rf "$BREW_CACHE"/* "$BREW_DIR"
fi
}
case $1 in
extract_cabal_cache) extract_cabal_cache ;;
save_cabal_cache) save_cabal_cache ;;
extract_stack_cache) extract_stack_cache ;;
save_stack_cache) save_stack_cache ;;
extract_brew_cache) extract_brew_cache ;;
save_brew_cache) save_brew_cache ;;
*) echo "unknown mode $1" ; exit 11 ;;
esac

View File

@@ -6,10 +6,20 @@ set -eux
mkdir -p "$CI_PROJECT_DIR"/.local/bin mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal "$@"
}
eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always git describe --always
### build ### build
ecabal update
export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION

View File

@@ -1,4 +1,4 @@
#!/usr/bin/env bash #!/bin/sh
set -eux set -eux
@@ -8,7 +8,6 @@ mkdir -p "$CI_PROJECT_DIR"/.local/bin
CI_PROJECT_DIR=$(pwd) CI_PROJECT_DIR=$(pwd)
ecabal() { ecabal() {
cabal "$@" cabal "$@"
} }
@@ -35,8 +34,6 @@ git describe --always
### build ### build
rm -rf "${GHCUP_DIR}"/share
ecabal update ecabal update
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
@@ -97,23 +94,16 @@ rm -rf "${GHCUP_DIR}"
eghcup --numeric-version eghcup --numeric-version
eghcup install ghc ${GHC_VERSION} eghcup install ghc ${GHC_VERSION}
eghcup unset ghc ${GHC_VERSION} [ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})" [ `eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version` = "${GHC_VERSION}" ]
[ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
[ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
[ "`ghcup run --ghc ${GHC_VERSION} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VERSION}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
eghcup set ghc ${GHC_VERSION} eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION} eghcup install cabal ${CABAL_VERSION}
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ] [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
eghcup unset cabal eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes "$GHCUP_BIN"/cabal --version && exit || echo yes
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
eghcup set cabal ${CABAL_VERSION} eghcup set cabal ${CABAL_VERSION}
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ] [ `eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version` = "${CABAL_VERSION}" ]
if [ "${OS}" != "FREEBSD" ] ; then if [ "${OS}" != "FREEBSD" ] ; then
if [ "${ARCH}" = "64" ] ; then if [ "${ARCH}" = "64" ] ; then
@@ -180,14 +170,12 @@ else
eghcup set ${GHC_VERSION} eghcup set ${GHC_VERSION}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup unset ghc eghcup unset ghc
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes "$GHCUP_BIN"/ghc --numeric-version && exit || echo yes
eghcup set ${GHC_VERSION} eghcup set ${GHC_VERSION}
eghcup --offline rm 8.10.3 eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
ls -lah "$GHCUP_BIN"
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls eghcup install hls
$(eghcup whereis hls) --version $(eghcup whereis hls) --version
@@ -199,12 +187,12 @@ else
eghcup install hls eghcup install hls
haskell-language-server-wrapper --version haskell-language-server-wrapper --version
eghcup unset hls eghcup unset hls
"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit 1 || echo yes "$GHCUP_BIN"/haskell-language-server-wrapper --version && exit || echo yes
eghcup install stack eghcup install stack
stack --version stack --version
eghcup unset stack eghcup unset hls
"$GHCUP_BIN"/stack --version && exit 1 || echo yes "$GHCUP_BIN"/stack --version && exit || echo yes
fi fi
fi fi
fi fi
@@ -222,13 +210,11 @@ eghcup rm $(ghc --numeric-version)
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
if [ "${OS}" = "LINUX" ] ; then if [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "64" ] ; then if [ "${ARCH}" = "64" ] ; then
eghcup install cabal -u https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.7.0.0-pre20220407/cabal-install-3.7-x86_64-linux-alpine.tar.xz 3.4.0.0-rc4 eghcup install cabal -u https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz 3.4.0.0-rc4
eghcup rm cabal 3.4.0.0-rc4 eghcup rm cabal 3.4.0.0-rc4
fi fi
fi fi
eghcup gc -c
sha_sum() { sha_sum() {
if [ "${OS}" = "FREEBSD" ] ; then if [ "${OS}" = "FREEBSD" ] ; then
sha256 "$@" sha256 "$@"
@@ -276,39 +262,13 @@ if [ "${ARCH}" = "64" ] ; then
eghcup install hls -i "$(pwd)/isolated" 1.3.0 eghcup install hls -i "$(pwd)/isolated" 1.3.0
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] || [ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ] [ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
# test that isolated installs don't clean up target directory
cat <<EOF > "${GHCUP_BIN}/gmake"
#!/bin/bash
exit 1
EOF
chmod +x "${GHCUP_BIN}/gmake"
mkdir isolated_tainted/
touch isolated_tainted/lol
! eghcup install ghc -i "$(pwd)/isolated_tainted" 8.10.5 --force
[ -e "$(pwd)/isolated_tainted/lol" ]
rm "${GHCUP_BIN}/gmake"
fi fi
fi fi
eghcup upgrade eghcup upgrade
eghcup upgrade -f eghcup upgrade -f
# 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 # nuke
eghcup nuke eghcup nuke
[ ! -e "${GHCUP_DIR}" ] [ ! -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 ]

2
.gitmodules vendored
View File

@@ -1,4 +1,4 @@
[submodule "data/metadata"] [submodule "data/metadata"]
path = data/metadata path = data/metadata
url = https://github.com/haskell/ghcup-metadata.git url = https://github.com/haskell/ghcup-metadata.git
branch = develop branch = master

View File

@@ -20,7 +20,6 @@
- ignore: {name: "Avoid lambda"} - ignore: {name: "Avoid lambda"}
- ignore: {name: "Use uncurry"} - ignore: {name: "Use uncurry"}
- ignore: {name: "Use replicateM"} - ignore: {name: "Use replicateM"}
- ignore: {name: "Use unless"}
- ignore: {name: "Redundant irrefutable pattern"} - ignore: {name: "Redundant irrefutable pattern"}

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,119 +1,6 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.20.0 -- 2023-11-10 ## 0.1.17.6 -- ????-??-??
### New features
* support TUI on windows thanks to the work from vty and brick maintainers (Chris Hackett, Timofey Zakrevskiy, Jonathan Daugherty, ...), wrt [#912](https://github.com/haskell/ghcup-hs/pull/912)
* support JS and wasm cross compilers wrt [#838](https://github.com/haskell/ghcup-hs/issues/838), thanks to Sylvain Henry and IOG
* Support stacks installation strategy and metadata wrt [#892](https://github.com/haskell/ghcup-hs/issues/892)
- you can now enable stacks installation method via `ghcup config set url-source '["GHCupURL", "StackSetupURL"]'`... for more information, check the [documentation](https://www.haskell.org/ghcup/guide/#using-stacks-setup-info-metadata-to-install-ghc)
### Improvements and bug fixes
* fix segfault in TUI when hitting enter early wrt [#887](https://github.com/haskell/ghcup-hs/issues/887)
* Improve key handling in TUI, fixes [#875](https://github.com/haskell/ghcup-hs/issues/875)
* add explicit support for Void Linux and Rocky Linux (this requires a metadata version bump to `ghcup-0.0.8.yaml`)
* optparse cli interface now has a test suite thanks to Lei Zhu, wrt [#862](https://github.com/haskell/ghcup-hs/pull/862)
## 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)
## 0.1.18.0 -- 2022-07-30
* Fix tui set wrt [#266](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/266) by Arjun Kathuria
- Ask the user to install the tool via prompt when setting an non-installed version
* improvements to safe (un-)installations
- bindists that don't support `make DESTDIR=/some/tmp/dir install` are now unsupported
- installed GHC files are now recorded to avoid use of `removePathForcibly`
- internally uses a newtype wrapper for user-input paths and restrict destructive operations to validated paths
* Add `--disable-ld-override` for darwin bindists wrt #391
* Allow passing bindist configure args wrt #377
* use of `TMPDIR` is dropped... now uses an internal tmp dir `~/.ghcup/tmp`
* improvements to error handling and warnings
* Require --isolate to have an absolute directory, fixes #367
* Fix mingw PATH handling wrt #371
* Add --mingw-path switch to `ghcup run`
* Fix `ghcup run` on windows, fixes #375
* Improve `ghcup compile <hls|ghc>`
- short hashes now work
- print the long hash in addition to the detected version
* Improve `ghcup compile hls`
- add `--git-describe-version` switch as an alternative to `--overwrite-version`
- Allow to build HLS from hackage (now is the default)
- Allow to run 'cabal update' automatically before the HLS build
- Fix parser and completer for 'ghcup compile hls --version'
* Improve `ghcup compile ghc`
- Allow to build from arbitrary GHC source dists
## 0.1.17.10 -- 2022-05-12
* windows hotfix (hackage-only release)
## 0.1.17.9 -- 2022-05-12
* broken sdist (hackage-only release)
## 0.1.17.8 -- 2022-05-11
* Fix a serious (but hard to trigger) bug when combining `--isolate <DIR>` with `--force`, please make sure to upgrade or avoid `--force`
* Fix HLS build not cleaning up properly on failed installations, fixes [#361](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/361)
* Fix parsing of symlinks with multiple slashes, wrt [#353](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/353)
* Re-enable upgrade functionality for all configurations wrt [MR #250](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/250) and [VSCode haskell issue #601](https://github.com/haskell/vscode-haskell/issues/601)
* Fix `ghcup run --ghc 8.10` (for short versions) wrt [#360](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/360)
- this also introduces a `--quick` switch for `ghcup run`
## 0.1.17.7 -- 2022-04-21
* Fix `ghcup run` on windows wrt [#345](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/345)
## 0.1.17.6 -- 2022-03-18
* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242) * Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324) * Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
@@ -123,7 +10,6 @@
* Add `--no-set` to install commands, fixes [#330](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/330) * Add `--no-set` to install commands, fixes [#330](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/330)
* Fix serious bug in `ghcup list --raw-format -t <tool> -c installed` * Fix serious bug in `ghcup list --raw-format -t <tool> -c installed`
* Overhaul metadata merging and add `ghcup config add-release-channel URI` wrt [#328](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/328) * Overhaul metadata merging and add `ghcup config add-release-channel URI` wrt [#328](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/328)
* Fix max path issues on windows with `ghcup run`
## 0.1.17.5 -- 2022-02-26 ## 0.1.17.5 -- 2022-02-26

View File

@@ -6,7 +6,7 @@
[![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
<a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a> <a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
GHCup is the main installer for the general purpose language [Haskell](https://www.haskell.org/). GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/).
Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions. Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions.

File diff suppressed because it is too large Load Diff

View File

@@ -8,7 +8,6 @@
module GHCup.OptParse ( module GHCup.OptParse (
module GHCup.OptParse.Common module GHCup.OptParse.Common
, module GHCup.OptParse.Install , module GHCup.OptParse.Install
, module GHCup.OptParse.Test
, module GHCup.OptParse.Set , module GHCup.OptParse.Set
, module GHCup.OptParse.UnSet , module GHCup.OptParse.UnSet
, module GHCup.OptParse.Rm , module GHCup.OptParse.Rm
@@ -32,7 +31,6 @@ module GHCup.OptParse (
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.OptParse.Install import GHCup.OptParse.Install
import GHCup.OptParse.Test
import GHCup.OptParse.Set import GHCup.OptParse.Set
import GHCup.OptParse.UnSet import GHCup.OptParse.UnSet
import GHCup.OptParse.Rm import GHCup.OptParse.Rm
@@ -57,12 +55,16 @@ import GHCup.Types
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Monad.Reader import Control.Monad.Reader
import Data.Bifunctor
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8
@@ -72,22 +74,18 @@ data Options = Options
optVerbose :: Maybe Bool optVerbose :: Maybe Bool
, optCache :: Maybe Bool , optCache :: Maybe Bool
, optMetaCache :: Maybe Integer , optMetaCache :: Maybe Integer
, optMetaMode :: Maybe MetaMode , optUrlSource :: Maybe URI
, optPlatform :: Maybe PlatformRequest
, optUrlSource :: Maybe URLSource
, optNoVerify :: Maybe Bool , optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs , optKeepDirs :: Maybe KeepDirs
, optsDownloader :: Maybe Downloader , optsDownloader :: Maybe Downloader
, optNoNetwork :: Maybe Bool , optNoNetwork :: Maybe Bool
, optGpg :: Maybe GPGSetting , optGpg :: Maybe GPGSetting
, optStackSetup :: Maybe Bool
-- commands -- commands
, optCommand :: Command , optCommand :: Command
} }
data Command data Command
= Install (Either InstallCommand InstallOptions) = Install (Either InstallCommand InstallOptions)
| Test TestCommand
| InstallCabalLegacy InstallOptions | InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions) | Set (Either SetCommand SetOptions)
| UnSet UnsetCommand | UnSet UnsetCommand
@@ -98,7 +96,7 @@ data Command
| Config ConfigCommand | Config ConfigCommand
| Whereis WhereisOptions WhereisCommand | Whereis WhereisOptions WhereisCommand
#ifndef DISABLE_UPGRADE #ifndef DISABLE_UPGRADE
| Upgrade UpgradeOpts Bool Bool | Upgrade UpgradeOpts Bool
#endif #endif
| ToolRequirements ToolReqOpts | ToolRequirements ToolReqOpts
| ChangeLog ChangeLogOptions | ChangeLog ChangeLogOptions
@@ -109,7 +107,6 @@ data Command
| Prefetch PrefetchCommand | Prefetch PrefetchCommand
| GC GCOptions | GC GCOptions
| Run RunOptions | Run RunOptions
| PrintAppErrors
@@ -118,27 +115,16 @@ opts =
Options Options
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)") <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
<*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)") <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
<*> optional (option auto (long "metadata-caching" <> metavar "SEC" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable")) <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
<*> optional (option auto (long "metadata-fetching-mode" <> metavar "<Strict|Lax>" <> help "Whether to fail on metadata download failure (Strict) or fall back to cached version (Lax (default))"))
<*> optional
(option
(eitherReader platformParser)
( short 'p'
<> long "platform"
<> metavar "PLATFORM"
<> help
"Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
)
)
<*> optional <*> optional
(option (option
(eitherReader parseUrlSource) (eitherReader parseUri)
( short 's' ( short 's'
<> long "url-source" <> long "url-source"
<> metavar "URL_SOURCE" <> metavar "URL"
<> help "Alternative ghcup download info" <> help "Alternative ghcup download info url"
<> internal <> internal
<> completer urlSourceCompleter <> completer fileUri
) )
) )
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)")) <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
@@ -176,9 +162,10 @@ opts =
"GPG verification (default: none)" "GPG verification (default: none)"
<> completer (listCompleter ["strict", "lax", "none"]) <> completer (listCompleter ["strict", "lax", "none"])
)) ))
<*> invertableSwitch "stack-setup" (Just 's') False (help "Use stack's setup info for discovering and installing GHC versions")
<*> com <*> com
where
parseUri s' =
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
com :: Parser Command com :: Parser Command
@@ -205,14 +192,6 @@ com =
<> footerDoc (Just $ text installToolFooter) <> footerDoc (Just $ text installToolFooter)
) )
) )
<> command
"test"
(info
(Test <$> testParser <**> helper)
( progDesc "Run tests for a tool (if any) [EXPERIMENTAL!]"
<> footerDoc (Just $ text testFooter)
)
)
<> command <> command
"set" "set"
(info (info
@@ -241,21 +220,20 @@ com =
<> command <> command
"list" "list"
(info (List <$> listOpts <**> helper) (info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools" (progDesc "Show available GHCs and other tools")
<> footerDoc (Just $ text listToolFooter))
) )
#ifndef DISABLE_UPGRADE
<> command <> command
"upgrade" "upgrade"
(info (info
( (Upgrade <$> upgradeOptsP <*> switch ( (Upgrade <$> upgradeOptsP <*> switch
(short 'f' <> long "force" <> help "Force update") (short 'f' <> long "force" <> help "Force update")
<*> switch
(long "fail-if-shadowed" <> help "Fails after upgrading if the upgraded ghcup binary is shadowed by something else in PATH (useful for CI)")
) )
<**> helper <**> helper
) )
(progDesc "Upgrade ghcup") (progDesc "Upgrade ghcup")
) )
#endif
<> command <> command
"compile" "compile"
( Compile ( Compile
@@ -351,10 +329,3 @@ com =
<> commandGroup "Nuclear Commands:" <> commandGroup "Nuclear Commands:"
<> hidden <> hidden
) )
<|> subparser
(command
"print-app-errors"
(info (pure PrintAppErrors <**> helper)
(progDesc ""))
<> internal
)

View File

@@ -12,12 +12,9 @@ module GHCup.OptParse.ChangeLog where
import GHCup.Types import GHCup.Types
import GHCup.Errors import GHCup.Utils.Logger
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Prelude import GHCup.Utils.String.QQ
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import GHCup.Prelude.Process (exec)
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -29,14 +26,16 @@ import Data.Maybe
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import System.Process ( system )
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef') import URI.ByteString (serializeURIRef')
import GHCup.Utils.Prelude
import GHCup.Utils.File (exec)
import Data.Char (toLower) import Data.Char (toLower)
@@ -50,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
{ clOpen :: Bool { clOpen :: Bool
, clTool :: Maybe Tool , clTool :: Maybe Tool
, clToolVer :: Maybe ToolVersion , clToolVer :: Maybe ToolVersion
} deriving (Eq, Show) }
@@ -59,7 +58,7 @@ data ChangeLogOptions = ChangeLogOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
changelogP :: Parser ChangeLogOptions changelogP :: Parser ChangeLogOptions
changelogP = changelogP =
(\x y -> ChangeLogOptions x y) (\x y -> ChangeLogOptions x y)
@@ -72,16 +71,15 @@ changelogP =
"cabal" -> Right Cabal "cabal" -> Right Cabal
"ghcup" -> Right GHCup "ghcup" -> Right GHCup
"stack" -> Right Stack "stack" -> Right Stack
"hls" -> Right HLS
e -> Left e e -> Left e
) )
) )
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup|stack>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
"Open changelog for given tool (default: ghc)" "Open changelog for given tool (default: ghc)"
<> completer toolCompleter <> completer toolCompleter
) )
) )
<*> optional (toolVersionTagArgument [] Nothing) <*> optional (toolVersionArgument Nothing Nothing)
@@ -115,36 +113,39 @@ changelog :: ( Monad m
changelog ChangeLogOptions{..} runAppState runLogger = do changelog ChangeLogOptions{..} runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let tool = fromMaybe GHC clTool let tool = fromMaybe GHC clTool
ver' = fromMaybe ver' = maybe
(ToolTag Latest) (Right Latest)
(\case
ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
ToolTag t -> Right t
)
clToolVer clToolVer
muri = getChangeLog dls tool ver' muri = getChangeLog dls tool ver'
case muri of case muri of
Nothing -> do Nothing -> do
runLogger runLogger
(logWarn $ (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 pure ExitSuccess
Just uri -> do Just uri -> do
pfreq <- runAppState getPlatformReq pfreq <- runAppState getPlatformReq
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
if clOpen if clOpen
then do then do
runAppState $ runAppState $
case _rPlatform pfreq of exec cmd
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing [T.unpack $ decUTF8Safe $ serializeURIRef' uri]
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing Nothing
FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing Nothing
Windows -> do
let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
c <- liftIO $ system $ args
case c of
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
ExitSuccess -> pure $ Right ()
>>= \case >>= \case
Right _ -> pure ExitSuccess Right _ -> pure ExitSuccess
Left e -> logError (T.pack $ prettyHFError e) Left e -> logError (T.pack $ prettyShow e)
>> pure (ExitFailure 13) >> pure (ExitFailure 13)
else liftIO $ putStrLn uri' >> pure ExitSuccess else liftIO $ putStrLn uri' >> pure ExitSuccess

View File

@@ -5,7 +5,6 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Common where module GHCup.OptParse.Common where
@@ -17,16 +16,15 @@ import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Prelude import GHCup.Utils.File
import GHCup.Prelude.Process import GHCup.Utils.Logger
import GHCup.Prelude.Logger import GHCup.Utils.MegaParsec
import GHCup.Prelude.MegaParsec import GHCup.Utils.Prelude
import Control.DeepSeq import Control.DeepSeq
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad.Identity (Identity(..))
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
@@ -46,9 +44,7 @@ import Data.Functor
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix ) import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Calendar ( Day ) import Data.Versions hiding ( str )
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions
import Data.Void import Data.Void
import qualified Data.Vector as V import qualified Data.Vector as V
import GHC.IO.Exception import GHC.IO.Exception
@@ -56,6 +52,7 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import Safe import Safe
import System.Directory
import System.Process ( readProcess ) import System.Process ( readProcess )
import System.FilePath import System.FilePath
import Text.HTML.TagSoup hiding ( Tag ) import Text.HTML.TagSoup hiding ( Tag )
@@ -64,40 +61,32 @@ import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as LE
import qualified Data.Text.Lazy as LT
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified System.FilePath.Posix as FP import qualified System.FilePath.Posix as FP
import GHCup.Version import GHCup.Version
import Control.Exception (evaluate) import Control.Exception (evaluate)
import qualified Cabal.Config as CC
------------- -------------
--[ Types ]-- --[ Types ]--
------------- -------------
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
| ToolTag Tag
-- a superset of ToolVersion -- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion data SetToolVersion = SetToolVersion GHCTargetVersion
| SetToolVersion Version
| SetToolTag Tag | SetToolTag Tag
| SetToolDay Day
| SetRecommended | SetRecommended
| SetNext | SetNext
deriving (Eq, Show)
prettyToolVer :: ToolVersion -> String prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v' prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v' prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolDay day) = show day
toSetToolVer :: Maybe ToolVersion -> SetToolVersion toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v' toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t' toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
toSetToolVer Nothing = SetRecommended toSetToolVer Nothing = SetRecommended
@@ -108,30 +97,32 @@ toSetToolVer Nothing = SetRecommended
-------------- --------------
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion -- | same as toolVersionParser, except as an argument.
toolVersionTagArgument criteria tool = toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
argument (eitherReader (parser tool)) toolVersionArgument criteria tool =
argument (eitherReader toolVersionEither)
(metavar (mv tool) (metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) []) <> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool) <> foldMap (completer . versionCompleter criteria) tool)
where where
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE" mv (Just GHC) = "GHC_VERSION|TAG"
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE" mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG|RELEASE_DATE" mv _ = "VERSION|TAG"
parser (Just GHC) = ghcVersionTagEither
parser Nothing = ghcVersionTagEither
parser _ = toolVersionTagEither
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version versionParser :: Parser GHCTargetVersion
versionParser = option
(eitherReader tVersionEither)
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
)
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack)) (eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither) versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
-- https://github.com/pcapriotti/optparse-applicative/issues/148 -- https://github.com/pcapriotti/optparse-applicative/issues/148
@@ -211,7 +202,19 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
) )
] ]
distroP :: MP.Parsec Void Text LinuxDistro distroP :: MP.Parsec Void Text LinuxDistro
distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros) distroP = choice'
[ MP.chunk "debian" $> Debian
, MP.chunk "deb" $> Debian
, MP.chunk "ubuntu" $> Ubuntu
, MP.chunk "mint" $> Mint
, MP.chunk "fedora" $> Fedora
, MP.chunk "centos" $> CentOS
, MP.chunk "redhat" $> RedHat
, MP.chunk "alpine" $> Alpine
, MP.chunk "gentoo" $> Gentoo
, MP.chunk "exherbo" $> Exherbo
, MP.chunk "unknown" $> UnknownLinux
]
uriParser :: String -> Either String URI uriParser :: String -> Either String URI
@@ -224,40 +227,28 @@ absolutePathParser f = case isValid f && isAbsolute f of
False -> Left "Please enter a valid absolute filepath." False -> Left "Please enter a valid absolute filepath."
isolateParser :: FilePath -> Either String FilePath isolateParser :: FilePath -> Either String FilePath
isolateParser f = case isValid f && isAbsolute f of isolateParser f = case isValid f of
True -> Right $ normalise f True -> Right $ normalise f
False -> Left "Please enter a valid filepath for isolate dir." False -> Left "Please enter a valid filepath for isolate dir."
-- this accepts cross prefix toolVersionEither :: String -> Either String ToolVersion
ghcVersionTagEither :: String -> Either String ToolVersion toolVersionEither s' =
ghcVersionTagEither s' = second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
second ToolDay (dayParser 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')
tagEither :: String -> Either String Tag tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended "recommended" -> Right Recommended
"latest" -> Right Latest "latest" -> Right Latest
"latest-prerelease" -> Right LatestPrerelease
"latest-nightly" -> Right LatestNightly
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x) Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver' Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left $ "Unknown tag " <> other other -> Left $ "Unknown tag " <> other
ghcVersionEither :: String -> Either String GHCTargetVersion tVersionEither :: String -> Either String GHCTargetVersion
ghcVersionEither = tVersionEither =
first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack
toolVersionEither :: String -> Either String Version
toolVersionEither =
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
toolParser :: String -> Either String Tool toolParser :: String -> Either String Tool
toolParser s' | t == T.pack "ghc" = Right GHC toolParser s' | t == T.pack "ghc" = Right GHC
@@ -267,22 +258,12 @@ toolParser s' | t == T.pack "ghc" = Right GHC
| otherwise = Left ("Unknown tool: " <> s') | otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack 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 :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True criteriaParser s' | t == T.pack "installed" = Right ListInstalled
| t == T.pack "set" = Right $ ListSet True | t == T.pack "set" = Right ListSet
| t == T.pack "available" = Right $ ListAvailable True | t == T.pack "available" = Right ListAvailable
| t == T.pack "+installed" = Right $ ListInstalled True | otherwise = Left ("Unknown criteria: " <> s')
| 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')
where t = T.toLower (T.pack s') where t = T.toLower (T.pack s')
@@ -324,15 +305,6 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
gitFileUri :: [String] -> Completer gitFileUri :: [String] -> Completer
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add) gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
urlSourceCompleter :: Completer
urlSourceCompleter = mkCompleter $ urlSourceCompleter' []
urlSourceCompleter' :: [String] -> String -> IO [String]
urlSourceCompleter' add str' = do
let static = ["GHCupURL", "StackSetupURL"]
file <- fileUri' add str'
pure $ static ++ file
fileUri :: Completer fileUri :: Completer
fileUri = mkCompleter $ fileUri' [] fileUri = mkCompleter $ fileUri' []
@@ -366,7 +338,7 @@ fileUri' add = \case
-- We need to do this so bash doesn't expand out any ~ or other -- We need to do this so bash doesn't expand out any ~ or other
-- chars we want to complete on, or emit an end of line error -- chars we want to complete on, or emit an end of line error
-- when seeking the close to the quote. -- when seeking the close to the quote.
-- --
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
requote :: String -> String requote :: String -> String
requote s = requote s =
@@ -461,21 +433,17 @@ tagCompleter tool add = listIOCompleter $ do
defaultKeyBindings defaultKeyBindings
loggerConfig loggerConfig
mpFreq <- flip runReaderT appState . runE $ platformRequest mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
forFold mpFreq $ \pfreq -> do case mGhcUpInfo of
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq VRight ghcupInfo -> do
case mGhcUpInfo of let allTags = filter (/= Old)
VRight ghcupInfo -> do $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
let allTags = filter (/= Old) pure $ nub $ (add ++) $ fmap tagToString allTags
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool) VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter' criteria tool filter' = listIOCompleter $ do versionCompleter criteria tool = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = False { lcPrintDebug = False
@@ -490,8 +458,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
defaultKeyBindings defaultKeyBindings
loggerConfig loggerConfig
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
forFold mpFreq $ \pfreq -> do forFold mpFreq $ \pfreq -> do
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
forFold mGhcUpInfo $ \ghcupInfo -> do forFold mGhcUpInfo $ \ghcupInfo -> do
let appState = AppState let appState = AppState
settings settings
@@ -503,8 +471,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
runEnv = flip runReaderT appState 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 return $ T.unpack . prettyVer . lVer <$> installedVersions
toolDlCompleter :: Tool -> Completer toolDlCompleter :: Tool -> Completer
@@ -671,7 +639,6 @@ fromVersion :: ( HasLog env
-> Tool -> Tool
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo) ] m (GHCTargetVersion, Maybe VersionInfo)
@@ -690,58 +657,34 @@ fromVersion' :: ( HasLog env
-> Tool -> Tool
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo) ] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetRecommended tool = do fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
second Just <$> getRecommended dls tool bimap mkTVer Just <$> getRecommended dls tool
?? TagNotFound Recommended tool ?? TagNotFound Recommended tool
fromVersion' (SetGHCVersion v) tool = do fromVersion' (SetToolVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo 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 case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi) Left _ -> pure (v, vi)
Right pvpIn -> Right pvpIn ->
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do Just (pvp_, vi') -> do
v' <- lift $ pvpToVersion pvp_ "" v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v') 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
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)
Right pvpIn ->
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> 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) Nothing -> pure (v, vi)
fromVersion' (SetToolTag Latest) tool = do fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool bimap mkTVer 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
fromVersion' (SetToolTag Recommended) tool = do fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo 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 fromVersion' (SetToolTag (Base pvp'')) GHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo 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 fromVersion' SetNext tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
next <- case tool of next <- case tool of
@@ -786,7 +729,7 @@ fromVersion' SetNext tool = do
. sort . sort
$ stacks) ?? NoToolVersionSet tool $ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set" GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo next tool dls let vi = getVersionInfo (_tvVersion next) tool dls
pure (next, vi) pure (next, vi)
fromVersion' (SetToolTag t') tool = fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool throwE $ TagNotFound t' tool
@@ -802,15 +745,15 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
=> m [(Tool, GHCTargetVersion)] => m [(Tool, Version)]
checkForUpdates = do checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing) lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled 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 (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 -> otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
forMM (getLatest dls t) $ \(l, _) -> do forMM (getLatest dls t) $ \(l, _) -> do
@@ -821,24 +764,3 @@ checkForUpdates = do
pure $ catMaybes (ghcup:otherTools) pure $ catMaybes (ghcup:otherTools)
where where
forMM a f = fmap join $ forM a f forMM a f = fmap join $ forM a f
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")
(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
parseUrlSource :: String -> Either String URLSource
parseUrlSource "GHCupURL" = pure GHCupURL
parseUrlSource "StackSetupURL" = pure StackSetupURL
parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
parseNewUrlSource :: String -> Either String NewURLSource
parseNewUrlSource "GHCupURL" = pure NewGHCupURL
parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')

View File

@@ -12,15 +12,14 @@ module GHCup.OptParse.Compile where
import GHCup import GHCup
import qualified GHCup.GHC as GHC
import qualified GHCup.HLS as HLS
import GHCup.Errors import GHCup.Errors
import GHCup.Utils.File
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -32,18 +31,18 @@ import Control.Monad.Trans.Resource
import Data.Bifunctor import Data.Bifunctor
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions ( Version, prettyVer, version, pvp ) import Data.Versions ( Version, prettyVer, version )
import qualified Data.Versions as V
import Data.Text ( Text ) import Data.Text ( Text )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString hiding ( uriParser ) import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask, displayException) import Control.Exception.Safe (MonadMask)
import System.FilePath (isPathSeparator) import System.FilePath (isPathSeparator)
import Text.Read (readEither) import Text.Read (readEither)
@@ -57,7 +56,6 @@ import Text.Read (readEither)
data CompileCommand = CompileGHC GHCCompileOptions data CompileCommand = CompileGHC GHCCompileOptions
| CompileHLS HLSCompileOptions | CompileHLS HLSCompileOptions
deriving (Eq, Show)
@@ -67,7 +65,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
data GHCCompileOptions = GHCCompileOptions data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: GHC.GHCVer { targetGhc :: Either Version GitBranch
, bootstrapGhc :: Either Version FilePath , bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe FilePath , buildConfig :: Maybe FilePath
@@ -77,24 +75,22 @@ data GHCCompileOptions = GHCCompileOptions
, setCompile :: Bool , setCompile :: Bool
, ovewrwiteVer :: Maybe Version , ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String , buildFlavour :: Maybe String
, buildSystem :: Maybe BuildSystem , hadrian :: Bool
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
} deriving (Eq, Show) }
data HLSCompileOptions = HLSCompileOptions data HLSCompileOptions = HLSCompileOptions
{ targetHLS :: HLS.HLSVer { targetHLS :: Either Version GitBranch
, jobs :: Maybe Int , jobs :: Maybe Int
, setCompile :: Bool , setCompile :: Bool
, updateCabal :: Bool , ovewrwiteVer :: Maybe Version
, ovewrwiteVer :: Either Bool Version
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
, cabalProject :: Maybe (Either FilePath URI) , cabalProject :: Maybe (Either FilePath URI)
, cabalProjectLocal :: Maybe URI , cabalProjectLocal :: Maybe URI
, patches :: Maybe (Either FilePath [URI]) , patches :: Maybe (Either FilePath [URI])
, targetGHCs :: [ToolVersion] , targetGHCs :: [ToolVersion]
, cabalArgs :: [Text] , cabalArgs :: [Text]
} deriving (Eq, Show) }
@@ -103,7 +99,7 @@ data HLSCompileOptions = HLSCompileOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
compileP :: Parser CompileCommand compileP :: Parser CompileCommand
compileP = subparser compileP = subparser
( command ( command
@@ -150,31 +146,29 @@ Examples:
compileHLSFooter = [s|Discussion: compileHLSFooter = [s|Discussion:
Compiles and installs the specified HLS version. Compiles and installs the specified HLS version.
The --ghc arguments are necessary to specify which GHC version to build for/against. The last argument is a list of GHC versions to compile for.
These need to be available in PATH prior to compilation. These need to be available in PATH prior to compilation.
Examples: Examples:
# compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build # compile 1.4.0 for ghc 8.10.5 and 8.10.7
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
# compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state # compile from master for ghc 8.10.7, linking everything dynamically
ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s') ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
# compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts :: Parser GHCCompileOptions
ghcCompileOpts = ghcCompileOpts =
GHCCompileOptions GHCCompileOptions
<$> ((GHC.SourceDist <$> option <$> ((Left <$> option
(eitherReader (eitherReader
(first (const "Not a valid version") . version . T.pack) (first (const "Not a valid version") . version . T.pack)
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
<> (completer $ versionCompleter [] GHC) <> (completer $ versionCompleter Nothing GHC)
) )
) <|> ) <|>
(GHC.GitDist <$> (GitBranch <$> option (Right <$> (GitBranch <$> option
str str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from" "The git commit/branch/ref to build from"
@@ -183,18 +177,7 @@ ghcCompileOpts =
short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)" short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
<> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"]) <> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
)) ))
)) )))
<|>
(
GHC.RemoteDist <$> (option
(eitherReader uriParser)
(long "remote-source-dist" <> metavar "URI" <> help
"URI (https/http/file) to a GHC source distribution"
<> completer fileUri
)
)
)
)
<*> option <*> option
(eitherReader (eitherReader
(\x -> (\x ->
@@ -206,7 +189,7 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC" <> metavar "BOOTSTRAP_GHC"
<> help <> help
"The GHC version (or full path) to bootstrap with (must be installed)" "The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter [] GHC) <> (completer $ versionCompleter Nothing GHC)
) )
<*> optional <*> optional
(option (option
@@ -250,7 +233,7 @@ ghcCompileOpts =
"Build cross-compiler for this platform" "Build cross-compiler for this platform"
) )
) )
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to compile configure, prefix with '-- ' (longopts)")) <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install")) <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
<*> optional <*> optional
(option (option
@@ -259,7 +242,7 @@ ghcCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (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'" "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 <*> optional
@@ -269,22 +252,16 @@ ghcCompileOpts =
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')" "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
) )
) )
<*> ( <*> switch
(\b -> if b then Just Hadrian else Nothing) <$> switch (long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
(long "hadrian" <> help "Use the hadrian build system instead of make. Tries to detect by default."
) )
<|>
(\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 <*> optional
(option (option
(eitherReader isolateParser) (eitherReader isolateParser)
( short 'i' ( short 'i'
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> 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") <> completer (bashCompleter "directory")
) )
) )
@@ -292,46 +269,24 @@ ghcCompileOpts =
hlsCompileOpts :: Parser HLSCompileOptions hlsCompileOpts :: Parser HLSCompileOptions
hlsCompileOpts = hlsCompileOpts =
HLSCompileOptions HLSCompileOptions
<$> ((HLS.HackageDist <$> option <$> ((Left <$> option
(eitherReader (eitherReader
((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack) (first (const "Not a valid version") . version . T.pack)
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The version to compile (pulled from hackage)" "The tool version to compile"
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer)) <> (completer $ versionCompleter Nothing HLS)
) )
) ) <|>
<|> (Right <$> (GitBranch <$> option
(HLS.GitDist <$> (GitBranch <$> option
str str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)" "The git commit/branch/ref to build from"
) <*> ) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)" optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"]) <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
)) ))
)) )))
<|>
(HLS.SourceDist <$> (option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(long "source-dist" <> metavar "VERSION" <> help
"The version to compile (pulled from packaged git sources)"
<> (completer $ versionCompleter [] HLS)
)
))
<|>
(
HLS.RemoteDist <$> (option
(eitherReader uriParser)
(long "remote-source-dist" <> metavar "URI" <> help
"URI (https/http/file) to a HLS source distribution"
<> completer fileUri
)
)
)
)
<*> optional <*> optional
(option (option
(eitherReader (readEither @Int)) (eitherReader (readEither @Int))
@@ -341,33 +296,23 @@ hlsCompileOpts =
) )
) )
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install")) <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build") <*> optional
<*> (option
(
(Right <$> option
(eitherReader (eitherReader
(first (const "Not a valid version") . version . T.pack) (first (const "Not a valid version") . version . T.pack)
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (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'" "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)
) )
) )
<|>
(Left <$> (switch
(long "git-describe-version"
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
)
)
)
)
<*> optional <*> optional
(option (option
(eitherReader isolateParser) (eitherReader isolateParser)
( short 'i' ( short 'i'
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> 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") <> completer (bashCompleter "directory")
) )
) )
@@ -407,10 +352,10 @@ hlsCompileOpts =
) )
) )
<*> some ( <*> some (
option (eitherReader ghcVersionTagEither) option (eitherReader toolVersionEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)" ( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC []) <> 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)")) <*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@@ -426,7 +371,6 @@ hlsCompileOpts =
type GHCEffects = '[ AlreadyInstalled type GHCEffects = '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, ContentLengthError
, GPGError , GPGError
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
@@ -444,13 +388,10 @@ type GHCEffects = '[ AlreadyInstalled
, ProcessError , ProcessError
, CopyError , CopyError
, BuildFailed , BuildFailed
, UninstallFailed
, MergeFileTreeError
] ]
type HLSEffects = '[ AlreadyInstalled type HLSEffects = '[ AlreadyInstalled
, BuildFailed , BuildFailed
, DigestError , DigestError
, ContentLengthError
, GPGError , GPGError
, DownloadFailed , DownloadFailed
, GHCupSetError , GHCupSetError
@@ -460,14 +401,11 @@ type HLSEffects = '[ AlreadyInstalled
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, NotInstalled , NotInstalled
, DirNotEmpty , DirNotEmpty
, ArchiveResult , ArchiveResult
, UninstallFailed
, MergeFileTreeError
] ]
@@ -516,29 +454,28 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
(CompileHLS HLSCompileOptions { .. }) -> do (CompileHLS HLSCompileOptions { .. }) -> do
runCompileHLS runAppState (do runCompileHLS runAppState (do
case targetHLS of case targetHLS of
HLS.SourceDist targetVer -> do Left targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) HLS dls let vi = getVersionInfo targetVer HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg lift $ logInfo msg
lift $ logInfo lift $ logInfo
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure () Right _ -> pure ()
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC) ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
targetVer <- liftE $ compileHLS targetVer <- liftE $ compileHLS
targetHLS targetHLS
ghcs ghcs
jobs jobs
ovewrwiteVer ovewrwiteVer
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
cabalProject cabalProject
cabalProjectLocal cabalProjectLocal
updateCabal
patches patches
cabalArgs cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) HLS dls let vi = getVersionInfo targetVer HLS dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setHLS targetVer SetHLSOnly Nothing setHLS targetVer SetHLSOnly Nothing
pure (vi, targetVer) pure (vi, targetVer)
@@ -553,30 +490,32 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
pure ExitSuccess pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger $ logError $ T.pack $ prettyHFError err Never -> runLogger $ logError $ T.pack $ prettyShow err
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <> _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " "Check the logs at " <> T.pack logsDir <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <> <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9 pure $ ExitFailure 9
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 9 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 {..}) -> (CompileGHC GHCCompileOptions {..}) ->
runCompileGHC runAppState (do runCompileGHC runAppState (do
case targetGhc of case targetGhc of
GHC.SourceDist targetVer -> do Left targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) GHC dls let vi = getVersionInfo targetVer GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg lift $ logInfo msg
lift $ logInfo lift $ logInfo
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure () Right _ -> pure ()
targetVer <- liftE $ compileGHC targetVer <- liftE $ compileGHC
targetGhc (first (GHCTargetVersion crossTarget) targetGhc)
crossTarget
ovewrwiteVer ovewrwiteVer
bootstrapGhc bootstrapGhc
jobs jobs
@@ -584,10 +523,10 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches patches
addConfArgs addConfArgs
buildFlavour buildFlavour
buildSystem hadrian
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly Nothing setGHC targetVer SetGHCOnly Nothing
pure (vi, targetVer) pure (vi, targetVer)
@@ -602,20 +541,20 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall" "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logError $ runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty." "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger $ logError $ T.pack $ prettyHFError err Never -> runLogger $ logError $ T.pack $ prettyShow err
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <> _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " "Check the logs at " <> T.pack logsDir <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <> <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9 pure $ ExitFailure 9
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 9 pure $ ExitFailure 9

View File

@@ -7,6 +7,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExplicitForAll #-}
module GHCup.OptParse.Config where module GHCup.OptParse.Config where
@@ -14,9 +15,9 @@ module GHCup.OptParse.Config where
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Utils import GHCup.Utils
import GHCup.Prelude import GHCup.Utils.Prelude
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ import GHCup.Utils.String.QQ
import GHCup.OptParse.Common import GHCup.OptParse.Common
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
@@ -32,6 +33,7 @@ import Options.Applicative hiding ( style, ParseError )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
@@ -50,8 +52,7 @@ data ConfigCommand
= ShowConfig = ShowConfig
| SetConfig String (Maybe String) | SetConfig String (Maybe String)
| InitConfig | InitConfig
| AddReleaseChannel Bool NewURLSource | AddReleaseChannel URI
deriving (Eq, Show)
@@ -59,7 +60,7 @@ data ConfigCommand
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
configP :: Parser ConfigCommand configP :: Parser ConfigCommand
configP = subparser configP = subparser
( command "init" initP ( command "init" initP
@@ -67,14 +68,15 @@ configP = subparser
<> command "show" showP <> command "show" showP
<> command "add-release-channel" addP <> command "add-release-channel" addP
) )
<|> argsP -- add show for a single option
<|> pure ShowConfig <|> pure ShowConfig
where where
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml") initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
showP = info (pure ShowConfig) (progDesc "Show current config (default)") 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)) 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")) 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 parseNewUrlSource) (metavar "URL_SOURCE" <> completer urlSourceCompleter)) addP = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
(progDesc "Add a release channel, e.g. from a URI") (progDesc "Add a release channel from a URI")
@@ -119,37 +121,18 @@ formatConfig :: UserSettings -> String
formatConfig = UTF8.toString . Y.encode formatConfig = UTF8.toString . Y.encode
updateSettings :: UserSettings -> UserSettings -> UserSettings updateSettings :: UserSettings -> Settings -> Settings
updateSettings usl usr = updateSettings UserSettings{..} Settings{..} =
let cache' = uCache usl <|> uCache usr let cache' = fromMaybe cache uCache
metaCache' = uMetaCache usl <|> uMetaCache usr metaCache' = fromMaybe metaCache uMetaCache
metaMode' = uMetaMode usl <|> uMetaMode usr noVerify' = fromMaybe noVerify uNoVerify
noVerify' = uNoVerify usl <|> uNoVerify usr keepDirs' = fromMaybe keepDirs uKeepDirs
verbose' = uVerbose usl <|> uVerbose usr downloader' = fromMaybe downloader uDownloader
keepDirs' = uKeepDirs usl <|> uKeepDirs usr verbose' = fromMaybe verbose uVerbose
downloader' = uDownloader usl <|> uDownloader usr urlSource' = fromMaybe urlSource uUrlSource
urlSource' = uUrlSource usl <|> uUrlSource usr noNetwork' = fromMaybe noNetwork uNoNetwork
noNetwork' = uNoNetwork usl <|> uNoNetwork usr gpgSetting' = fromMaybe gpgSetting uGPGSetting
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
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
}
@@ -157,9 +140,6 @@ updateSettings usl usr =
--[ Entrypoint ]-- --[ 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 config :: forall m. ( Monad m
@@ -169,11 +149,10 @@ config :: forall m. ( Monad m
) )
=> ConfigCommand => ConfigCommand
-> Settings -> Settings
-> UserSettings
-> KeyBindings -> KeyBindings
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
config configCommand settings userConf keybindings runLogger = case configCommand of config configCommand settings keybindings runLogger = case configCommand of
InitConfig -> do InitConfig -> do
path <- getConfigFilePath path <- getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings) liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
@@ -191,14 +170,10 @@ config configCommand settings userConf keybindings runLogger = case configComman
throwE $ ParseError "Empty values are not allowed" throwE $ ParseError "Empty values are not allowed"
Nothing -> do Nothing -> do
usersettings <- decodeSettings k usersettings <- decodeSettings k
when (usersettings == defaultUserSettings)
$ throwE $ ParseError ("Failed to parse setting (maybe typo?): " <> k)
lift $ doConfig usersettings lift $ doConfig usersettings
pure () pure ()
Just v -> do Just v -> do
usersettings <- decodeSettings (k <> ": " <> v <> "\n") usersettings <- decodeSettings (k <> ": " <> v <> "\n")
when (usersettings == defaultUserSettings)
$ throwE $ ParseError ("Failed to parse key '" <> k <> "' with value '" <> v <> "' as user setting. Maybe typo?")
lift $ doConfig usersettings lift $ doConfig usersettings
pure () pure ()
case r of case r of
@@ -206,38 +181,23 @@ config configCommand settings userConf keybindings runLogger = case configComman
VLeft (V (JSONDecodeError e)) -> do VLeft (V (JSONDecodeError e)) -> do
runLogger $ logError $ "Error decoding config: " <> T.pack e runLogger $ logError $ "Error decoding config: " <> T.pack e
pure $ ExitFailure 65 pure $ ExitFailure 65
VLeft e -> do VLeft _ -> pure $ ExitFailure 65
runLogger (logError $ T.pack $ prettyHFError e)
pure $ ExitFailure 65
AddReleaseChannel force new -> do AddReleaseChannel uri -> do
r <- runE @'[DuplicateReleaseChannel] $ do case urlSource settings of
let oldSources = fromURLSource (urlSource settings) AddSource xs -> do
let merged = oldSources ++ [new] doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
case checkDuplicate oldSources new of pure ExitSuccess
Duplicate _ -> do
| not force -> throwE (DuplicateReleaseChannel new) doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
DuplicateLast -> pure ()
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ SimpleList merged })
case r of
VRight _ -> do
pure ExitSuccess pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 15
where where
checkDuplicate :: Eq a => [a] -> a -> Duplicate
checkDuplicate xs a
| last xs == a = DuplicateLast
| a `elem` xs = Duplicate
| otherwise = NoDuplicate
doConfig :: MonadIO m => UserSettings -> m () doConfig :: MonadIO m => UserSettings -> m ()
doConfig usersettings = do doConfig usersettings = do
let settings' = updateSettings usersettings userConf let settings' = updateSettings usersettings settings
path <- liftIO getConfigFilePath path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ settings' liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
runLogger $ logDebug $ T.pack $ show settings' runLogger $ logDebug $ T.pack $ show settings'
pure () pure ()

View File

@@ -17,10 +17,9 @@ import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Version import GHCup.Version
import GHCup.Types import GHCup.Types
import GHCup.Utils.Prelude
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Prelude import GHCup.Utils.Logger
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -37,6 +36,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import GHCup.Utils.File
import Language.Haskell.TH import Language.Haskell.TH
@@ -115,5 +115,5 @@ dinfo runAppState runLogger = do
liftIO $ putStrLn $ prettyDebugInfo di liftIO $ putStrLn $ prettyDebugInfo di
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 8 pure $ ExitFailure 8

View File

@@ -14,8 +14,8 @@ module GHCup.OptParse.GC where
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -27,6 +27,7 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -47,7 +48,7 @@ data GCOptions = GCOptions
, gcHLSNoGHC :: Bool , gcHLSNoGHC :: Bool
, gcCache :: Bool , gcCache :: Bool
, gcTmp :: Bool , gcTmp :: Bool
} deriving (Eq, Show) }
@@ -55,26 +56,26 @@ data GCOptions = GCOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
gcP :: Parser GCOptions gcP :: Parser GCOptions
gcP = gcP =
GCOptions GCOptions
<$> <$>
switch switch
(short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'") (short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'")
<*> <*>
switch switch
(short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions") (short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions")
<*> <*>
switch switch
(short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)") (short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)")
<*> <*>
switch switch
(short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version") (short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version")
<*> <*>
switch switch
(short 'c' <> long "cache" <> help "GC the GHCup cache") (short 'c' <> long "cache" <> help "GC the GHCup cache")
<*> <*>
switch switch
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers") (short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
@@ -97,7 +98,7 @@ gcFooter = [s|Discussion:
--------------------------- ---------------------------
type GCEffects = '[ NotInstalled, UninstallFailed ] type GCEffects = '[ NotInstalled ]
runGC :: MonadUnliftIO m runGC :: MonadUnliftIO m
@@ -128,7 +129,7 @@ gc :: ( Monad m
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
gc GCOptions{..} runAppState runLogger = runGC runAppState (do gc GCOptions{..} runAppState runLogger = runGC runAppState (do
when gcOldGHC (liftE rmOldGHC) when gcOldGHC rmOldGHC
lift $ when gcProfilingLibs rmProfilingLibs lift $ when gcProfilingLibs rmProfilingLibs
lift $ when gcShareDir rmShareDir lift $ when gcShareDir rmShareDir
liftE $ when gcHLSNoGHC rmHLSNoGHC liftE $ when gcHLSNoGHC rmHLSNoGHC
@@ -138,5 +139,5 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
VRight _ -> do VRight _ -> do
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 27 pure $ ExitFailure 27

View File

@@ -7,7 +7,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeOperators #-}
module GHCup.OptParse.Install where module GHCup.OptParse.Install where
@@ -19,10 +18,8 @@ import GHCup.OptParse.Common
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Utils.Dirs import GHCup.Utils.Logger
import GHCup.Prelude import GHCup.Utils.String.QQ
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Codec.Archive import Codec.Archive
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
@@ -33,11 +30,13 @@ import Control.Monad.Trans.Resource
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString hiding ( uriParser ) import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
@@ -54,7 +53,6 @@ data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions | InstallCabal InstallOptions
| InstallHLS InstallOptions | InstallHLS InstallOptions
| InstallStack InstallOptions | InstallStack InstallOptions
deriving (Eq, Show)
@@ -63,14 +61,15 @@ data InstallCommand = InstallGHC InstallOptions
--[ Options ]-- --[ Options ]--
--------------- ---------------
data InstallOptions = InstallOptions data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion { instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI , instBindist :: Maybe URI
, instSet :: Bool , instSet :: Bool
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
, forceInstall :: Bool , forceInstall :: Bool
, addConfArgs :: [T.Text] }
} deriving (Eq, Show)
@@ -133,7 +132,7 @@ installParser =
) )
) )
) )
<|> (Right <$> installOpts (Just GHC)) <|> (Right <$> installOpts Nothing)
where where
installHLSFooter :: String installHLSFooter :: String
installHLSFooter = [s|Discussion: installHLSFooter = [s|Discussion:
@@ -169,13 +168,23 @@ Examples:
ghcup install ghc 8.10.2 ghcup install ghc 8.10.2
# install GHC head fedora bindist # install GHC head fedora bindist
ghcup install ghc -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head|] ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
installOpts :: Maybe Tool -> Parser InstallOptions installOpts :: Maybe Tool -> Parser InstallOptions
installOpts tool = installOpts tool =
(\(u, v) b is f -> InstallOptions v u b is f) (\p (u, v) b is f -> InstallOptions v p u b is f)
<$> ( ( (,) <$> optional
(option
(eitherReader platformParser)
( short 'p'
<> long "platform"
<> metavar "PLATFORM"
<> help
"Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
)
)
<*> ( ( (,)
<$> optional <$> optional
(option (option
(eitherReader uriParser) (eitherReader uriParser)
@@ -184,7 +193,7 @@ installOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool)) <> completer (toolDlCompleter (fromMaybe GHC tool))
) )
) )
<*> (Just <$> toolVersionTagArgument [] tool) <*> (Just <$> toolVersionArgument Nothing tool)
) )
<|> pure (Nothing, Nothing) <|> pure (Nothing, Nothing)
) )
@@ -196,19 +205,18 @@ installOpts tool =
( short 'i' ( short 'i'
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> 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") <> completer (bashCompleter "directory")
) )
) )
<*> switch <*> switch
(short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)") (short 'f' <> long "force" <> help "Force install")
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)"))
where where
setDefault = case tool of setDefault = case tool of
Nothing -> False Nothing -> False
Just GHC -> False Just GHC -> False
Just _ -> True Just _ -> True
@@ -241,9 +249,7 @@ type InstallEffects = '[ AlreadyInstalled
, NotInstalled , NotInstalled
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, DayNotFound
, DigestError , DigestError
, ContentLengthError
, GPGError , GPGError
, DownloadFailed , DownloadFailed
, TarDirDoesNotExist , TarDirDoesNotExist
@@ -251,57 +257,116 @@ type InstallEffects = '[ AlreadyInstalled
, NoToolVersionSet , NoToolVersionSet
, FileAlreadyExistsError , FileAlreadyExistsError
, ProcessError , ProcessError
, UninstallFailed
, MergeFileTreeError , (AlreadyInstalled, ())
, InstallSetError , (UnknownArchive, ())
, (ArchiveResult, ())
, (FileDoesNotExistError, ())
, (CopyError, ())
, (NotInstalled, ())
, (DirNotEmpty, ())
, (NoDownload, ())
, (NotInstalled, ())
, (BuildFailed, ())
, (TagNotFound, ())
, (DigestError, ())
, (GPGError, ())
, (DownloadFailed, ())
, (TarDirDoesNotExist, ())
, (NextVerNotFound, ())
, (NoToolVersionSet, ())
, (FileAlreadyExistsError, ())
, (ProcessError, ())
, (AlreadyInstalled, NotInstalled)
, (UnknownArchive, NotInstalled)
, (ArchiveResult, NotInstalled)
, (FileDoesNotExistError, NotInstalled)
, (CopyError, NotInstalled)
, (NotInstalled, NotInstalled)
, (DirNotEmpty, NotInstalled)
, (NoDownload, NotInstalled)
, (NotInstalled, NotInstalled)
, (BuildFailed, NotInstalled)
, (TagNotFound, NotInstalled)
, (DigestError, NotInstalled)
, (GPGError, NotInstalled)
, (DownloadFailed, NotInstalled)
, (TarDirDoesNotExist, NotInstalled)
, (NextVerNotFound, NotInstalled)
, (NoToolVersionSet, NotInstalled)
, (FileAlreadyExistsError, NotInstalled)
, (ProcessError, NotInstalled)
, ((), NotInstalled)
] ]
runInstTool :: AppState runInstTool :: AppState
-> Maybe PlatformRequest
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a) -> IO (VEither InstallEffects a)
runInstTool appstate' = runInstTool appstate' mInstPlatform =
flip runReaderT appstate' flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. runResourceT . runResourceT
. runE . runE
@InstallEffects @InstallEffects
type InstallGHCEffects = '[ AlreadyInstalled type InstallGHCEffects = '[ TagNotFound
, ArchiveResult
, BuildFailed
, CopyError
, DigestError
, ContentLengthError
, DirNotEmpty
, DownloadFailed
, FileAlreadyExistsError
, FileDoesNotExistError
, GPGError
, MergeFileTreeError
, NextVerNotFound , NextVerNotFound
, NoDownload
, NoToolVersionSet , NoToolVersionSet
, NotInstalled , BuildFailed
, ProcessError , DirNotEmpty
, TagNotFound , AlreadyInstalled
, DayNotFound
, TarDirDoesNotExist , (AlreadyInstalled, NotInstalled)
, UninstallFailed , (UnknownArchive, NotInstalled)
, UnknownArchive , (ArchiveResult, NotInstalled)
, InstallSetError , (FileDoesNotExistError, NotInstalled)
, NoCompatiblePlatform , (CopyError, NotInstalled)
, GHCup.Errors.ParseError , (NotInstalled, NotInstalled)
, UnsupportedSetupCombo , (DirNotEmpty, NotInstalled)
, DistroNotFound , (NoDownload, NotInstalled)
, NoCompatibleArch , (BuildFailed, NotInstalled)
, (TagNotFound, NotInstalled)
, (DigestError, NotInstalled)
, (GPGError, NotInstalled)
, (DownloadFailed, NotInstalled)
, (TarDirDoesNotExist, NotInstalled)
, (NextVerNotFound, NotInstalled)
, (NoToolVersionSet, NotInstalled)
, (FileAlreadyExistsError, NotInstalled)
, (ProcessError, NotInstalled)
, (AlreadyInstalled, ())
, (UnknownArchive, ())
, (ArchiveResult, ())
, (FileDoesNotExistError, ())
, (CopyError, ())
, (NotInstalled, ())
, (DirNotEmpty, ())
, (NoDownload, ())
, (BuildFailed, ())
, (TagNotFound, ())
, (DigestError, ())
, (GPGError, ())
, (DownloadFailed, ())
, (TarDirDoesNotExist, ())
, (NextVerNotFound, ())
, (NoToolVersionSet, ())
, (FileAlreadyExistsError, ())
, (ProcessError, ())
, ((), NotInstalled)
] ]
runInstGHC :: AppState runInstGHC :: AppState
-> Maybe PlatformRequest
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a -> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a) -> IO (VEither InstallGHCEffects a)
runInstGHC appstate' = runInstGHC appstate' mInstPlatform =
flip runReaderT appstate' flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. runResourceT . runResourceT
. runE . runE
@InstallGHCEffects @InstallGHCEffects
@@ -314,39 +379,37 @@ runInstGHC appstate' =
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install installCommand settings getAppState' runLogger = case installCommand of install installCommand settings getAppState' runLogger = case installCommand of
(Right iGHCopts) -> do (Right iopts) -> do
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.") runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
installGHC iGHCopts installGHC iopts
(Left (InstallGHC iGHCopts)) -> installGHC iGHCopts (Left (InstallGHC iopts)) -> installGHC iopts
(Left (InstallCabal iopts)) -> installCabal iopts (Left (InstallCabal iopts)) -> installCabal iopts
(Left (InstallHLS iopts)) -> installHLS iopts (Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts (Left (InstallStack iopts)) -> installStack iopts
where where
installGHC :: InstallOptions -> IO ExitCode installGHC :: InstallOptions -> IO ExitCode
installGHC InstallOptions{..} = do installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstGHC s' $ do Nothing -> runInstGHC s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin void $ liftE $ sequenceE (installGHCBin
v (_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
addConfArgs
) )
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
pure vi pure vi
Just uri -> do Just uri -> do
runInstGHC s'{ settings = settings {noVerify = True}} $ do runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist void $ liftE $ sequenceE (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing) (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
v (_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
addConfArgs
) )
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
pure vi pure vi
) )
>>= \case >>= \case
@@ -356,41 +419,43 @@ install installCommand settings getAppState' runLogger = case installCommand of
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logError $ runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty." "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft (V (DirNotEmpty fp)) -> do VLeft (V (DirNotEmpty fp, ())) -> do
runLogger $ logError $ runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty." "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyHFError err) Never -> runLogger (logError $ T.pack $ prettyShow err)
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <> _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <> "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _, ())) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyHFError err) Never -> runLogger (logError $ T.pack $ prettyShow err)
_ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <> _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <> "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyHFError e logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir) logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 3 pure $ ExitFailure 3
@@ -398,23 +463,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
installCabal InstallOptions{..} = do installCabal InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' $ do Nothing -> runInstTool s' instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBin void $ liftE $ sequenceE (installCabalBin
v v
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setCabal v ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
pure vi pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist void $ liftE $ sequenceE (installCabalBindist
(DownloadInfo uri Nothing "" Nothing Nothing) (DownloadInfo uri Nothing "")
v v
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setCabal v ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
pure vi pure vi
) )
>>= \case >>= \case
@@ -423,48 +488,50 @@ install installCommand settings getAppState' runLogger = case installCommand of
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do VLeft (V (FileAlreadyExistsError fp, ())) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyHFError e logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir) logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
installHLS :: InstallOptions -> IO ExitCode installHLS :: InstallOptions -> IO ExitCode
installHLS InstallOptions{..} = do installHLS InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' $ do Nothing -> runInstTool s' instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
liftE $ runBothE' (installHLSBin void $ liftE $ sequenceE (installHLSBin
v v
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setHLS v SetHLSOnly Nothing ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
pure vi pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy -- TODO: support legacy
liftE $ runBothE' (installHLSBindist void $ liftE $ sequenceE (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing) (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
v v
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setHLS v SetHLSOnly Nothing ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
pure vi pure vi
) )
>>= \case >>= \case
@@ -473,47 +540,57 @@ install installCommand settings getAppState' runLogger = case installCommand of
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"HLS ver "
<> prettyVer v
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
<> prettyVer v
<> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"HLS ver "
<> prettyVer v
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
<> prettyVer v
<> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do VLeft (V (FileAlreadyExistsError fp, ())) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyHFError e logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir) logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4
installStack :: InstallOptions -> IO ExitCode installStack :: InstallOptions -> IO ExitCode
installStack InstallOptions{..} = do installStack InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' $ do Nothing -> runInstTool s' instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBin void $ liftE $ sequenceE (installStackBin
v v
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setStack v ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
pure vi pure vi
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist void $ liftE $ sequenceE (installStackBindist
(DownloadInfo uri Nothing "" Nothing Nothing) (DownloadInfo uri Nothing "")
v v
(maybe GHCupInternal IsolateDir isolateDir) isolateDir
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setStack v ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
pure vi pure vi
) )
>>= \case >>= \case
@@ -522,22 +599,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $ T.pack $ prettyHFError e runLogger $ logWarn $
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do VLeft (V (FileAlreadyExistsError fp, ())) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite." "File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyHFError e logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir) logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4 pure $ ExitFailure 4

View File

@@ -2,7 +2,6 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
@@ -12,10 +11,9 @@ module GHCup.OptParse.List where
import GHCup import GHCup
import GHCup.Prelude import GHCup.Utils.Prelude
import GHCup.Types import GHCup.Types
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Prelude.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -26,8 +24,7 @@ import Data.Char
import Data.List ( intercalate, sort ) import Data.List ( intercalate, sort )
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Time.Calendar ( Day ) import Data.Versions hiding ( str )
import Data.Versions
import Data.Void import Data.Void
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
@@ -53,12 +50,8 @@ import qualified Text.Megaparsec.Char as MPC
data ListOptions = ListOptions data ListOptions = ListOptions
{ loTool :: Maybe Tool { loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria , lCriteria :: Maybe ListCriteria
, lFrom :: Maybe Day
, lTo :: Maybe Day
, lHideOld :: Bool
, lShowNightly :: Bool
, lRawFormat :: Bool , lRawFormat :: Bool
} deriving (Eq, Show) }
@@ -67,6 +60,7 @@ data ListOptions = ListOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
listOpts :: Parser ListOptions listOpts :: Parser ListOptions
listOpts = listOpts =
ListOptions ListOptions
@@ -75,7 +69,7 @@ listOpts =
(eitherReader toolParser) (eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all" "Tool to list versions for. Default is all"
<> completer toolCompleter <> completer (toolCompleter)
) )
) )
<*> optional <*> optional
@@ -84,53 +78,15 @@ listOpts =
( short 'c' ( short 'c'
<> long "show-criteria" <> long "show-criteria"
<> metavar "<installed|set|available>" <> metavar "<installed|set|available>"
<> help "Apply filtering criteria, prefix with + or -" <> help "Show only installed/set/available tool versions"
<> completer (listCompleter <> completer (listCompleter ["installed", "set", "available"])
[ "+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 <*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format" (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|]
----------------- -----------------
@@ -149,11 +105,8 @@ printListResult no_color raw lr = do
printTag Recommended = color Green "recommended" printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest" printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease" printTag Prerelease = color Red "prerelease"
printTag Nightly = color Red "nightly"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t printTag (UnknownTag t ) = t
printTag LatestPrerelease = color Red "latest-prerelease"
printTag LatestNightly = color Red "latest-nightly"
printTag Old = "" printTag Old = ""
let let
@@ -180,10 +133,8 @@ printListResult no_color raw lr = do
then [color Green "hls-powered"] then [color Green "hls-powered"]
else mempty else mempty
) )
++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty) ++ (if lStray then [color Yellow "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [color Blue (show d)])
++ (if lNoBindist ++ (if lNoBindist
then [color Red "no-bindist"] then [color Red "no-bindist"]
else mempty else mempty
@@ -308,7 +259,7 @@ list :: ( Monad m
-> m ExitCode -> m ExitCode
list ListOptions{..} no_color runAppState = list ListOptions{..} no_color runAppState =
runAppState (do runAppState (do
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo) l <- listVersions loTool lCriteria
liftIO $ printListResult no_color lRawFormat l liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess pure ExitSuccess
) )

View File

@@ -14,7 +14,7 @@ module GHCup.OptParse.Nuke where
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Prelude.Logger import GHCup.Utils.Logger
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -26,6 +26,7 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -41,7 +42,7 @@ import Control.Concurrent (threadDelay)
--------------------------- ---------------------------
type NukeEffects = '[ NotInstalled, UninstallFailed ] type NukeEffects = '[ NotInstalled ]
runNuke :: AppState runNuke :: AppState
@@ -76,8 +77,8 @@ nuke appState runLogger = do
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀" lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1" lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing) lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
forM_ lInstalled (liftE . rmTool) forM_ lInstalled (liftE . rmTool)
@@ -94,5 +95,5 @@ nuke appState runLogger = do
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15

View File

@@ -14,11 +14,9 @@ module GHCup.OptParse.Prefetch where
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Utils.Logger
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -31,9 +29,11 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import GHCup.Utils.Prelude
import GHCup.Download (getDownloadsF) import GHCup.Download (getDownloadsF)
@@ -74,44 +74,44 @@ data PrefetchGHCOptions = PrefetchGHCOptions {
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
prefetchP :: Parser PrefetchCommand prefetchP :: Parser PrefetchCommand
prefetchP = subparser prefetchP = subparser
( command ( command
"ghc" "ghc"
(info (info
(PrefetchGHC (PrefetchGHC
<$> (PrefetchGHCOptions <$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper ) <$> ( 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 (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> optional (toolVersionTagArgument [] (Just GHC)) ) <*> optional (toolVersionArgument Nothing (Just GHC)) )
( progDesc "Download GHC assets for installation") ( progDesc "Download GHC assets for installation")
) )
<> <>
command command
"cabal" "cabal"
(info (info
(PrefetchCabal (PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> 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 (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation") ( progDesc "Download cabal assets for installation")
) )
<> <>
command command
"hls" "hls"
(info (info
(PrefetchHLS (PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> 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 (toolVersionArgument Nothing (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation") ( progDesc "Download HLS assets for installation")
) )
<> <>
command command
"stack" "stack"
(info (info
(PrefetchStack (PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> 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 (toolVersionArgument Nothing (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation") ( progDesc "Download stack assets for installation")
) )
<> <>
@@ -149,18 +149,14 @@ Examples:
type PrefetchEffects = '[ TagNotFound type PrefetchEffects = '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, NoDownload , NoDownload
, DigestError , DigestError
, ContentLengthError
, GPGError , GPGError
, DownloadFailed , DownloadFailed
, JSONError , JSONError
, FileDoesNotExistError , FileDoesNotExistError ]
, StackPlatformDetectError
]
runPrefetch :: MonadUnliftIO m runPrefetch :: MonadUnliftIO m
@@ -198,27 +194,26 @@ prefetch prefetchCommand runAppState runLogger =
forM_ pfCacheDir (liftIO . createDirRecursive') forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt GHC (v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc if pfGHCSrc
then liftE $ fetchGHCSrc v pfCacheDir then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
else liftE $ fetchToolBindist v GHC pfCacheDir else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive') forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt Cabal (v, _) <- liftE $ fromVersion mt Cabal
liftE $ fetchToolBindist v Cabal pfCacheDir liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive') forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt HLS (v, _) <- liftE $ fromVersion mt HLS
liftE $ fetchToolBindist v HLS pfCacheDir liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive') forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt Stack (v, _) <- liftE $ fromVersion mt Stack
liftE $ fetchToolBindist v Stack pfCacheDir liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
PrefetchMetadata -> do PrefetchMetadata -> do
pfreq <- lift getPlatformReq _ <- liftE getDownloadsF
_ <- liftE $ getDownloadsF pfreq
pure "" pure ""
) >>= \case ) >>= \case
VRight _ -> do VRight _ -> do
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15

View File

@@ -18,9 +18,9 @@ import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -29,11 +29,12 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -50,7 +51,6 @@ data RmCommand = RmGHC RmOptions
| RmCabal Version | RmCabal Version
| RmHLS Version | RmHLS Version
| RmStack Version | RmStack Version
deriving (Eq, Show)
@@ -62,7 +62,7 @@ data RmCommand = RmGHC RmOptions
data RmOptions = RmOptions data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion { ghcVer :: GHCTargetVersion
} deriving (Eq, Show) }
@@ -71,7 +71,7 @@ data RmOptions = RmOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
rmParser :: Parser (Either RmCommand RmOptions) rmParser :: Parser (Either RmCommand RmOptions)
rmParser = rmParser =
(Left <$> subparser (Left <$> subparser
@@ -81,19 +81,19 @@ rmParser =
<> command <> command
"cabal" "cabal"
( RmCabal ( RmCabal
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper) <$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
(progDesc "Remove Cabal version") (progDesc "Remove Cabal version")
) )
<> command <> command
"hls" "hls"
( RmHLS ( RmHLS
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper) <$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version") (progDesc "Remove haskell-language-server version")
) )
<> command <> command
"stack" "stack"
( RmStack ( RmStack
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper) <$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
(progDesc "Remove stack version") (progDesc "Remove stack version")
) )
) )
@@ -103,7 +103,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
@@ -127,7 +127,7 @@ rmFooter = [s|Discussion:
--------------------------- ---------------------------
type RmEffects = '[ NotInstalled, UninstallFailed ] type RmEffects = '[ NotInstalled ]
runRm :: (ReaderT env m (VEither RmEffects a) -> m (VEither RmEffects a)) runRm :: (ReaderT env m (VEither RmEffects a) -> m (VEither RmEffects a))
@@ -171,15 +171,15 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmGHCVer ghcVer rmGHCVer ghcVer
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo ghcVer GHC dls) pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ logGHCPostRm ghcVer forM_ (_viPostRemove =<< vi) $ \msg ->
postRmLog vi runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 7 pure $ ExitFailure 7
rmCabal' tv = rmCabal' tv =
@@ -187,14 +187,15 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmCabalVer tv rmCabalVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (mkTVer tv) Cabal dls) pure (getVersionInfo tv Cabal dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
postRmLog vi forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
rmHLS' tv = rmHLS' tv =
@@ -202,14 +203,15 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmHLSVer tv rmHLSVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (mkTVer tv) HLS dls) pure (getVersionInfo tv HLS dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
postRmLog vi forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
rmStack' tv = rmStack' tv =
@@ -217,16 +219,14 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmStackVer tv rmStackVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (mkTVer tv) Stack dls) pure (getVersionInfo tv Stack dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
postRmLog vi forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15 pure $ ExitFailure 15
postRmLog vi =
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg

View File

@@ -0,0 +1,401 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module GHCup.OptParse.Run where
import GHCup
import GHCup.Utils
import GHCup.Utils.Prelude
import GHCup.Utils.File
import GHCup.OptParse.Common
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics ( getDirs )
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import Control.Exception.Safe ( MonadMask, MonadCatch )
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Codec.Archive
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe (isNothing)
import Data.List ( intercalate )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Directory
import System.FilePath
import System.Environment
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
#ifndef IS_WINDOWS
import qualified System.Posix.Process as SPP
#endif
---------------
--[ Options ]--
---------------
data RunOptions = RunOptions
{ runAppendPATH :: Bool
, runInstTool' :: Bool
, runGHCVer :: Maybe ToolVersion
, runCabalVer :: Maybe ToolVersion
, runHLSVer :: Maybe ToolVersion
, runStackVer :: Maybe ToolVersion
, runBinDir :: Maybe FilePath
, runCOMMAND :: [String]
}
---------------
--[ Parsers ]--
---------------
runOpts :: Parser RunOptions
runOpts =
RunOptions
<$> switch
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
<*> switch
(short 'i' <> long "install" <> help "Install the tool, if missing")
<*> optional
(option
(eitherReader toolVersionEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC [])
<> (completer $ versionCompleter Nothing GHC)
)
)
<*> optional
(option
(eitherReader toolVersionEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter Nothing Cabal)
)
)
<*> optional
(option
(eitherReader toolVersionEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS [])
<> (completer $ versionCompleter Nothing HLS)
)
)
<*> optional
(option
(eitherReader toolVersionEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack [])
<> (completer $ versionCompleter Nothing Stack)
)
)
<*> optional
(option
(eitherReader isolateParser)
( short 'b'
<> long "bindir"
<> metavar "DIR"
<> help "directory where to create the tool symlinks (default: newly created system temp dir)"
<> completer (bashCompleter "directory")
)
)
<*> 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."))
--------------
--[ Footer ]--
--------------
runFooter :: String
runFooter = [s|Discussion:
Adds the given tools to a dedicated bin/ directory and adds them to PATH, exposing
the relevant binaries, then executes a command.
Examples:
# run VSCode with all latest toolchain exposed, installing missing versions if necessary
ghcup run --ghc latest --cabal latest --hls latest --stack latest --install -- code Setup.hs
# create a custom toolchain bin/ dir with GHC and cabal that can be manually added to PATH
ghcup run --ghc 8.10.7 --cabal 3.2.0.0 --bindir $HOME/toolchain/bin
# run a specific ghc version
ghcup run --ghc 8.10.7 -- ghc --version|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type RunEffects = '[ AlreadyInstalled
, UnknownArchive
, ArchiveResult
, FileDoesNotExistError
, CopyError
, NotInstalled
, DirNotEmpty
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, GPGError
, DownloadFailed
, TarDirDoesNotExist
, NextVerNotFound
, NoToolVersionSet
, FileAlreadyExistsError
, ProcessError
]
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
=> LeanAppState
-> Excepts RunEffects (ReaderT LeanAppState m) a
-> m (VEither RunEffects a)
runLeanRUN leanAppstate =
-- Don't use runLeanAppState here, which is disabled on windows.
-- This is the only command on all platforms that doesn't need full appstate.
flip runReaderT leanAppstate
. runE
@RunEffects
runRUN :: MonadUnliftIO m
=> (ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
-> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither RunEffects a)
runRUN runAppState =
runAppState
. runResourceT
. runE
@RunEffects
------------------
--[ Entrypoint ]--
------------------
run :: forall m.
( MonadFail m
, MonadMask m
, MonadCatch m
, MonadIO m
, MonadUnliftIO m
)
=> RunOptions
-> (forall a. ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
-> LeanAppState
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
toolchain <- Excepts resolveToolchain
tmp <- case runBinDir of
Just bindir -> do
liftIO $ createDirRecursive' bindir
liftIO $ canonicalizePath bindir
Nothing -> do
d <- liftIO $ predictableTmpDir toolchain
liftIO $ createDirRecursive' d
liftIO $ canonicalizePath d
Excepts $ installToolChain toolchain tmp
pure tmp
) >>= \case
VRight tmp -> do
case runCOMMAND of
[] -> do
liftIO $ putStr tmp
pure ExitSuccess
(cmd:args) -> do
newEnv <- liftIO $ addToPath tmp
#ifndef IS_WINDOWS
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
pure ExitSuccess
#else
r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
case r' of
VRight _ -> pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 28
#endif
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 27
where
isToolTag :: ToolVersion -> Bool
isToolTag (ToolTag _) = True
isToolTag _ = False
-- TODO: doesn't work for cross
resolveToolchain
| or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
ghcVer <- forM runGHCVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) GHC
pure v
cabalVer <- forM runCabalVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Cabal
pure v
hlsVer <- forM runHLSVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) HLS
pure v
stackVer <- forM runStackVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Stack
pure v
pure Toolchain{..}
| otherwise = runLeanRUN leanAppstate $ do
ghcVer <- case runGHCVer of
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
cabalVer <- case runCabalVer of
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
hlsVer <- case runHLSVer of
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
stackVer <- case runStackVer of
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
pure Toolchain{..}
installToolChain Toolchain{..} tmp
| or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
case mt of
Just (GHC, v) -> do
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
(_tvVersion v)
Nothing
False
setTool GHC v tmp
Just (Cabal, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
(_tvVersion v)
Nothing
False
setTool Cabal v tmp
Just (Stack, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
(_tvVersion v)
Nothing
False
setTool Stack v tmp
Just (HLS, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
(_tvVersion v)
Nothing
False
setTool HLS v tmp
_ -> pure ()
| otherwise = runLeanRUN leanAppstate $ do
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
case mt of
Just (GHC, v) -> setTool GHC v tmp
Just (Cabal, v) -> setTool Cabal v tmp
Just (Stack, v) -> setTool Stack v tmp
Just (HLS, v) -> setTool HLS v tmp
_ -> pure ()
setTool tool v tmp =
case tool of
GHC -> do
void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
void $ liftE $ setGHC v SetGHCOnly (Just tmp)
Cabal -> do
bin <- liftE $ whereIsTool Cabal v
cbin <- liftIO $ canonicalizePath bin
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
Stack -> do
bin <- liftE $ whereIsTool Stack v
cbin <- liftIO $ canonicalizePath bin
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
HLS -> do
Dirs {..} <- getDirs
let v' = _tvVersion v
legacy <- isLegacyHLS v'
if legacy
then do
-- TODO: factor this out
hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
forM_ hlsBins $ \bin ->
lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
else do
liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
GHCup -> pure ()
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
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
predictableTmpDir Toolchain{..} = do
tmp <- getTemporaryDirectory
pure $ tmp
</> ("ghcup-" <> intercalate "_"
( maybe [] ( (:[]) . ("ghc-" <>) . T.unpack . tVerToText) ghcVer
<> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
<> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . tVerToText) hlsVer
<> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
)
)
-------------------------
--[ Other local types ]--
-------------------------
data Toolchain = Toolchain
{ ghcVer :: Maybe GHCTargetVersion
, cabalVer :: Maybe GHCTargetVersion
, hlsVer :: Maybe GHCTargetVersion
, stackVer :: Maybe GHCTargetVersion
}

View File

@@ -17,8 +17,8 @@ import GHCup.OptParse.Common
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -28,13 +28,14 @@ import Control.Monad.Trans.Resource
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions import Data.Versions hiding ( str )
import GHC.Unicode import GHC.Unicode
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Data.Bifunctor (second) import Data.Bifunctor (second)
@@ -53,7 +54,6 @@ data SetCommand = SetGHC SetOptions
| SetCabal SetOptions | SetCabal SetOptions
| SetHLS SetOptions | SetHLS SetOptions
| SetStack SetOptions | SetStack SetOptions
deriving (Eq, Show)
@@ -65,7 +65,7 @@ data SetCommand = SetGHC SetOptions
data SetOptions = SetOptions data SetOptions = SetOptions
{ sToolVer :: SetToolVersion { sToolVer :: SetToolVersion
} deriving (Eq, Show) }
@@ -74,7 +74,7 @@ data SetOptions = SetOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
setParser :: Parser (Either SetCommand SetOptions) setParser :: Parser (Either SetCommand SetOptions)
setParser = setParser =
(Left <$> subparser (Left <$> subparser
@@ -82,7 +82,7 @@ setParser =
"ghc" "ghc"
( SetGHC ( SetGHC
<$> info <$> info
(setOpts GHC <**> helper) (setOpts (Just GHC) <**> helper)
( progDesc "Set GHC version" ( progDesc "Set GHC version"
<> footerDoc (Just $ text setGHCFooter) <> footerDoc (Just $ text setGHCFooter)
) )
@@ -91,7 +91,7 @@ setParser =
"cabal" "cabal"
( SetCabal ( SetCabal
<$> info <$> info
(setOpts Cabal <**> helper) (setOpts (Just Cabal) <**> helper)
( progDesc "Set Cabal version" ( progDesc "Set Cabal version"
<> footerDoc (Just $ text setCabalFooter) <> footerDoc (Just $ text setCabalFooter)
) )
@@ -100,7 +100,7 @@ setParser =
"hls" "hls"
( SetHLS ( SetHLS
<$> info <$> info
(setOpts HLS <**> helper) (setOpts (Just HLS) <**> helper)
( progDesc "Set haskell-language-server version" ( progDesc "Set haskell-language-server version"
<> footerDoc (Just $ text setHLSFooter) <> footerDoc (Just $ text setHLSFooter)
) )
@@ -109,14 +109,14 @@ setParser =
"stack" "stack"
( SetStack ( SetStack
<$> info <$> info
(setOpts Stack <**> helper) (setOpts (Just Stack) <**> helper)
( progDesc "Set stack version" ( progDesc "Set stack version"
<> footerDoc (Just $ text setStackFooter) <> footerDoc (Just $ text setStackFooter)
) )
) )
) )
) )
<|> (Right <$> setOpts GHC) <|> (Right <$> setOpts Nothing)
where where
setGHCFooter :: String setGHCFooter :: String
setGHCFooter = [s|Discussion: setGHCFooter = [s|Discussion:
@@ -137,25 +137,22 @@ setParser =
Sets the the current haskell-language-server version.|] Sets the the current haskell-language-server version.|]
setOpts :: Tool -> Parser SetOptions setOpts :: Maybe Tool -> Parser SetOptions
setOpts tool = SetOptions <$> setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$> (fromMaybe SetRecommended <$>
optional (setVersionArgument [ListInstalled True] tool)) optional (setVersionArgument (Just ListInstalled) tool))
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
setVersionArgument criteria tool = setVersionArgument criteria tool =
argument (eitherReader setEither) argument (eitherReader setEither)
(metavar "VERSION|TAG|next" (metavar "VERSION|TAG|next"
<> completer (tagCompleter tool ["next"]) <> completer (tagCompleter (fromMaybe GHC tool) ["next"])
<> (completer . versionCompleter criteria) tool) <> foldMap (completer . versionCompleter criteria) tool)
where where
setEither s' = setEither s' =
parseSet s' parseSet s'
<|> second SetToolTag (tagEither s') <|> second SetToolTag (tagEither s')
<|> se s' <|> second SetToolVersion (tVersionEither s')
se s' = case tool of
GHC -> second SetGHCVersion (ghcVersionEither s')
_ -> second SetToolVersion (toolVersionEither s')
parseSet s' = case fmap toLower s' of parseSet s' = case fmap toLower s' of
"next" -> Right SetNext "next" -> Right SetNext
other -> Left $ "Unknown tag/version " <> other other -> Left $ "Unknown tag/version " <> other
@@ -185,7 +182,6 @@ setFooter = [s|Discussion:
type SetGHCEffects = '[ FileDoesNotExistError type SetGHCEffects = '[ FileDoesNotExistError
, NotInstalled , NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@@ -200,7 +196,6 @@ runSetGHC runAppState =
type SetCabalEffects = '[ NotInstalled type SetCabalEffects = '[ NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@@ -215,7 +210,6 @@ runSetCabal runAppState =
type SetHLSEffects = '[ NotInstalled type SetHLSEffects = '[ NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@@ -230,7 +224,6 @@ runSetHLS runAppState =
type SetStackEffects = '[ NotInstalled type SetStackEffects = '[ NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@@ -264,19 +257,22 @@ set :: forall m env.
-> m (VEither eff GHCTargetVersion)) -> m (VEither eff GHCTargetVersion))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
set setCommand runAppState _ runLogger = case setCommand of set setCommand runAppState runLeanAppState runLogger = case setCommand of
(Right sopts) -> do (Right sopts) -> do
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.") runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
setGHC' sopts setGHC' sopts
(Left (SetGHC sopts)) -> setGHC' sopts (Left (SetGHC sopts)) -> setGHC' sopts
(Left (SetCabal sopts)) -> setCabal' sopts (Left (SetCabal sopts)) -> setCabal' sopts
(Left (SetHLS sopts)) -> setHLS' sopts (Left (SetHLS sopts)) -> setHLS' sopts
(Left (SetStack sopts)) -> setStack' sopts (Left (SetStack sopts)) -> setStack' sopts
where where
setGHC' :: SetOptions setGHC' :: SetOptions
-> m ExitCode -> m ExitCode
setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do setGHC' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
_ -> runSetGHC runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer GHC v <- liftE $ fst <$> fromVersion' sToolVer GHC
liftE $ setGHC v SetGHCOnly Nothing liftE $ setGHC v SetGHCOnly Nothing
) )
@@ -287,58 +283,67 @@ set setCommand runAppState _ runLogger = case setCommand of
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget "GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 5 pure $ ExitFailure 5
setCabal' :: SetOptions setCabal' :: SetOptions
-> m ExitCode -> m ExitCode
setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do setCabal' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v)
_ -> runSetCabal runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Cabal v <- liftE $ fst <$> fromVersion' sToolVer Cabal
liftE $ setCabal (_tvVersion v) liftE $ setCabal (_tvVersion v)
pure v pure v
) )
>>= \case >>= \case
VRight v -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ logInfo $ $ logInfo $
"Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version" "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
setHLS' :: SetOptions setHLS' :: SetOptions
-> m ExitCode -> m ExitCode
setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do setHLS' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
_ -> runSetHLS runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer HLS v <- liftE $ fst <$> fromVersion' sToolVer HLS
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
pure v pure v
) )
>>= \case >>= \case
VRight v -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ logInfo $ $ logInfo $
"HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version" "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
setStack' :: SetOptions setStack' :: SetOptions
-> m ExitCode -> m ExitCode
setStack' SetOptions{ sToolVer } = runSetStack runAppState (do setStack' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v)
_ -> runSetStack runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Stack v <- liftE $ fst <$> fromVersion' sToolVer Stack
liftE $ setStack (_tvVersion v) liftE $ setStack (_tvVersion v)
pure v pure v
) )
>>= \case >>= \case
VRight v -> do VRight GHCTargetVersion{..} -> do
runLogger runLogger
$ logInfo $ $ logInfo $
"Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version" "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14

View File

@@ -11,8 +11,8 @@ module GHCup.OptParse.ToolRequirements where
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -23,13 +23,14 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Platform import GHCup.Platform
import GHCup.Prelude import GHCup.Utils.Prelude
import GHCup.Requirements import GHCup.Requirements
import System.IO import System.IO
@@ -117,5 +118,5 @@ toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements run
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight _ -> pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 12 pure $ ExitFailure 12

View File

@@ -16,8 +16,8 @@ module GHCup.OptParse.UnSet where
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Prelude.Logger import GHCup.Utils.Logger
import GHCup.Prelude.String.QQ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -31,6 +31,7 @@ import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -48,7 +49,6 @@ data UnsetCommand = UnsetGHC UnsetOptions
| UnsetCabal UnsetOptions | UnsetCabal UnsetOptions
| UnsetHLS UnsetOptions | UnsetHLS UnsetOptions
| UnsetStack UnsetOptions | UnsetStack UnsetOptions
deriving (Eq, Show)
@@ -60,7 +60,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
data UnsetOptions = UnsetOptions data UnsetOptions = UnsetOptions
{ sToolVer :: Maybe T.Text -- target platform triple { sToolVer :: Maybe T.Text -- target platform triple
} deriving (Eq, Show) }
@@ -69,7 +69,7 @@ data UnsetOptions = UnsetOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
unsetParser :: Parser UnsetCommand unsetParser :: Parser UnsetCommand
unsetParser = unsetParser =
subparser subparser
@@ -114,14 +114,7 @@ unsetParser =
unsetGHCFooter :: String unsetGHCFooter :: String
unsetGHCFooter = [s|Discussion: unsetGHCFooter = [s|Discussion:
Unsets the the current GHC version. That means there won't Unsets the the current GHC version. That means there won't
be a ~/.ghcup/bin/ghc anymore. 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|]
unsetCabalFooter :: String unsetCabalFooter :: String
unsetCabalFooter = [s|Discussion: unsetCabalFooter = [s|Discussion:
@@ -196,7 +189,7 @@ unset unsetCommand runLeanAppState runLogger = case unsetCommand of
runLogger $ logInfo "GHC successfully unset" runLogger $ logInfo "GHC successfully unset"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14 pure $ ExitFailure 14
(UnsetCabal (UnsetOptions _)) -> do (UnsetCabal (UnsetOptions _)) -> do
void $ runLeanAppState (VRight <$> unsetCabal) void $ runLeanAppState (VRight <$> unsetCabal)

View File

@@ -14,8 +14,7 @@ module GHCup.OptParse.Upgrade where
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Prelude.File import GHCup.Utils.Logger
import GHCup.Prelude.Logger
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -28,6 +27,7 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -35,7 +35,7 @@ import System.Environment
import GHCup.Utils import GHCup.Utils
import System.FilePath import System.FilePath
import GHCup.Types.Optics import GHCup.Types.Optics
import Data.Versions import Data.Versions hiding (str)
@@ -50,7 +50,7 @@ import Data.Versions
data UpgradeOpts = UpgradeInplace data UpgradeOpts = UpgradeInplace
| UpgradeAt FilePath | UpgradeAt FilePath
| UpgradeGHCupDir | UpgradeGHCupDir
deriving (Eq, Show) deriving Show
@@ -59,16 +59,15 @@ data UpgradeOpts = UpgradeInplace
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
upgradeOptsP :: Parser UpgradeOpts upgradeOptsP :: Parser UpgradeOpts
upgradeOptsP = upgradeOptsP =
flag' flag'
UpgradeInplace UpgradeInplace
(short 'i' <> long "inplace" <> help (short 'i' <> long "inplace" <> help
"Upgrade ghcup in-place" "Upgrade ghcup in-place (wherever it's at)"
) )
<|> <|> ( UpgradeAt
( UpgradeAt
<$> option <$> option
str str
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
@@ -87,14 +86,12 @@ upgradeOptsP =
type UpgradeEffects = '[ DigestError type UpgradeEffects = '[ DigestError
, ContentLengthError
, GPGError , GPGError
, NoDownload , NoDownload
, NoUpdate , NoUpdate
, FileDoesNotExistError , FileDoesNotExistError
, CopyError , CopyError
, DownloadFailed , DownloadFailed
, ToolShadowed
] ]
@@ -123,19 +120,18 @@ upgrade :: ( Monad m
) )
=> UpgradeOpts => UpgradeOpts
-> Bool -> Bool
-> Bool
-> Dirs -> Dirs
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a)) -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do upgrade uOpts force' Dirs{..} runAppState runLogger = do
target <- case uOpts of target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath UpgradeInplace -> Just <$> liftIO getExecutablePath
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt)) UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade runAppState (do runUpgrade runAppState (do
v' <- liftE $ upgradeGHCup target force' fatal v' <- liftE $ upgradeGHCup target force'
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (v', dls) pure (v', dls)
) >>= \case ) >>= \case
@@ -151,5 +147,5 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
runLogger $ logWarn "No GHCup update available" runLogger $ logWarn "No GHCup update available"
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 11 pure $ ExitFailure 11

View File

@@ -17,9 +17,8 @@ import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Types import GHCup.Types
import GHCup.Utils import GHCup.Utils.Logger
import GHCup.Prelude.Logger import GHCup.Utils.String.QQ
import GHCup.Prelude.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -32,8 +31,8 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Environment
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -54,7 +53,6 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
| WhereisCacheDir | WhereisCacheDir
| WhereisLogsDir | WhereisLogsDir
| WhereisConfDir | WhereisConfDir
deriving (Eq, Show)
@@ -67,7 +65,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
data WhereisOptions = WhereisOptions { data WhereisOptions = WhereisOptions {
directory :: Bool directory :: Bool
} deriving (Eq, Show) }
@@ -76,14 +74,14 @@ data WhereisOptions = WhereisOptions {
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
whereisP :: Parser WhereisCommand whereisP :: Parser WhereisCommand
whereisP = subparser whereisP = subparser
(commandGroup "Tools locations:" <> (commandGroup "Tools locations:" <>
command command
"ghc" "ghc"
(WhereisTool GHC <$> info (WhereisTool GHC <$> info
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper ) ( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
( progDesc "Get GHC location" ( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter )) <> footerDoc (Just $ text whereisGHCFooter ))
) )
@@ -91,7 +89,7 @@ whereisP = subparser
command command
"cabal" "cabal"
(WhereisTool Cabal <$> info (WhereisTool Cabal <$> info
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ) ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
( progDesc "Get cabal location" ( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter )) <> footerDoc (Just $ text whereisCabalFooter ))
) )
@@ -99,7 +97,7 @@ whereisP = subparser
command command
"hls" "hls"
(WhereisTool HLS <$> info (WhereisTool HLS <$> info
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ) ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
( progDesc "Get HLS location" ( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter )) <> footerDoc (Just $ text whereisHLSFooter ))
) )
@@ -107,7 +105,7 @@ whereisP = subparser
command command
"stack" "stack"
(WhereisTool Stack <$> info (WhereisTool Stack <$> info
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ) ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
( progDesc "Get stack location" ( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter )) <> footerDoc (Just $ text whereisStackFooter ))
) )
@@ -223,7 +221,6 @@ type WhereisEffects = '[ NotInstalled
, NoToolVersionSet , NoToolVersionSet
, NextVerNotFound , NextVerNotFound
, TagNotFound , TagNotFound
, DayNotFound
] ]
@@ -270,14 +267,7 @@ whereis :: ( Monad m
whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
Dirs{ .. } <- runReaderT getDirs leanAppstate Dirs{ .. } <- runReaderT getDirs leanAppstate
case (whereisCommand, whereisOptions) of case (whereisCommand, whereisOptions) of
(WhereisTool GHCup _, WhereisOptions{..}) -> do (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
loc <- liftIO (getExecutablePath >>= canonicalizePath )
if directory
then liftIO $ putStr $ takeDirectory loc
else liftIO $ putStr loc
pure ExitSuccess
(WhereisTool tool (Just (GHCVersion v)), WhereisOptions{..}) ->
runLeanWhereIs leanAppstate (do runLeanWhereIs leanAppstate (do
loc <- liftE $ whereIsTool tool v loc <- liftE $ whereIsTool tool v
if directory if directory
@@ -289,21 +279,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
liftIO $ putStr r liftIO $ putStr r
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
runLeanWhereIs leanAppstate (do
loc <- liftE $ whereIsTool tool (mkTVer v)
if directory
then pure $ takeDirectory loc
else pure loc
)
>>= \case
VRight r -> do
liftIO $ putStr r
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 30 pure $ ExitFailure 30
(WhereisTool tool whereVer, WhereisOptions{..}) -> do (WhereisTool tool whereVer, WhereisOptions{..}) -> do
@@ -319,11 +295,11 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
liftIO $ putStr r liftIO $ putStr r
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30 pure $ ExitFailure 30
(WhereisBaseDir, _) -> do (WhereisBaseDir, _) -> do
liftIO $ putStr $ fromGHCupPath baseDir liftIO $ putStr baseDir
pure ExitSuccess pure ExitSuccess
(WhereisBinDir, _) -> do (WhereisBinDir, _) -> do
@@ -331,13 +307,13 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
pure ExitSuccess pure ExitSuccess
(WhereisCacheDir, _) -> do (WhereisCacheDir, _) -> do
liftIO $ putStr $ fromGHCupPath cacheDir liftIO $ putStr cacheDir
pure ExitSuccess pure ExitSuccess
(WhereisLogsDir, _) -> do (WhereisLogsDir, _) -> do
liftIO $ putStr $ fromGHCupPath logsDir liftIO $ putStr logsDir
pure ExitSuccess pure ExitSuccess
(WhereisConfDir, _) -> do (WhereisConfDir, _) -> do
liftIO $ putStr $ fromGHCupPath confDir liftIO $ putStr confDir
pure ExitSuccess pure ExitSuccess

View File

@@ -14,8 +14,6 @@ module Main where
import BrickMain ( brickMain ) import BrickMain ( brickMain )
#endif #endif
import qualified GHCup.GHC as GHC
import qualified GHCup.HLS as HLS
import GHCup.OptParse import GHCup.OptParse
import GHCup.Download import GHCup.Download
@@ -24,9 +22,9 @@ import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics hiding ( toolRequirements ) import GHCup.Types.Optics hiding ( toolRequirements )
import GHCup.Utils import GHCup.Utils
import GHCup.Prelude import GHCup.Utils.Logger
import GHCup.Prelude.Logger import GHCup.Utils.Prelude
import GHCup.Prelude.String.QQ import GHCup.Utils.String.QQ
import GHCup.Version import GHCup.Version
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) ) import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
@@ -42,6 +40,7 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions
import GHC.IO.Encoding import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH import Language.Haskell.TH
@@ -62,7 +61,7 @@ import qualified GHCup.Types as Types
toSettings :: Options -> IO (Settings, KeyBindings, UserSettings) toSettings :: Options -> IO (Settings, KeyBindings)
toSettings options = do toSettings options = do
noColor <- isJust <$> lookupEnv "NO_COLOR" noColor <- isJust <$> lookupEnv "NO_COLOR"
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -72,23 +71,20 @@ toSettings options = do
pure defaultUserSettings pure defaultUserSettings
_ -> do _ -> do
die "Unexpected error!" die "Unexpected error!"
pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor pure $ mergeConf options userConf noColor
where where
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings) mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
mergeConf Options{..} UserSettings{..} noColor = mergeConf Options{..} UserSettings{..} noColor =
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
metaMode = fromMaybe (fromMaybe (Types.metaMode defaultSettings) uMetaMode) optMetaMode
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = fromMaybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) optUrlSource urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
in (Settings {..}, keyBindings) in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal defaultDownloader = Internal
@@ -107,6 +103,7 @@ toSettings options = do
, bSet = fromMaybe bSet kSet , bSet = fromMaybe bSet kSet
, bChangelog = fromMaybe bChangelog kChangelog , bChangelog = fromMaybe bChangelog kChangelog
, bShowAllVersions = fromMaybe bShowAllVersions kShowAll , bShowAllVersions = fromMaybe bShowAllVersions kShowAll
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools
} }
@@ -144,7 +141,9 @@ main = do
) )
let listCommands = infoOption let listCommands = infoOption
("install set rm install-cabal list" ("install set rm install-cabal list"
#ifndef DISABLE_UPGRADE
<> " upgrade" <> " upgrade"
#endif
<> " compile debug-info tool-requirements changelog" <> " compile debug-info tool-requirements changelog"
) )
( long "list-commands" ( long "list-commands"
@@ -158,10 +157,11 @@ main = do
versions. It maintains a self-contained ~/.ghcup directory. versions. It maintains a self-contained ~/.ghcup directory.
ENV variables: ENV variables:
* TMPDIR: where ghcup does the work (unpacking, building, ...)
* GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME) * GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME)
* GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories * GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories
Report bugs at <https://github.com/haskell/ghcup-hs/issues>|] Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
customExecParser customExecParser
(prefs showHelpOnError) (prefs showHelpOnError)
@@ -174,7 +174,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-- create ~/.ghcup dir -- create ~/.ghcup dir
ensureDirectories dirs ensureDirectories dirs
(settings, keybindings, userConf) <- toSettings opt (settings, keybindings) <- toSettings opt
-- logger interpreter -- logger interpreter
logfile <- runReaderT initGHCupFileLogging dirs logfile <- runReaderT initGHCupFileLogging dirs
@@ -199,29 +199,30 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
let appState = do let appState = do
pfreq <- case platformOverride settings of pfreq <- (
Just pfreq' -> return pfreq' runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
Nothing -> (runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest) >>= \case ) >>= \case
VRight r -> pure r VRight r -> pure r
VLeft e -> do VLeft e -> do
runLogger runLogger
(logError $ T.pack $ prettyHFError e) (logError $ T.pack $ prettyShow e)
exitWith (ExitFailure 2) exitWith (ExitFailure 2)
ghcupInfo <- ghcupInfo <-
( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do ( flip runReaderT leanAppstate
liftE $ getDownloadsF pfreq . runE @'[DigestError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
) $ liftE getDownloadsF
)
>>= \case >>= \case
VRight r -> pure r VRight r -> pure r
VLeft e -> do VLeft e -> do
runLogger runLogger
(logError $ T.pack $ prettyHFError e) (logError $ T.pack $ prettyShow e)
exitWith (ExitFailure 2) exitWith (ExitFailure 2)
let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
race_ (liftIO $ runReaderT cleanupTrash s') race_ (liftIO $ runReaderT cleanupTrash s')
(threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack (fromGHCupPath recycleDir) <> " manually")) (threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
case optCommand of case optCommand of
Nuke -> pure () Nuke -> pure ()
@@ -237,34 +238,38 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
_ _
| Just False <- optVerbose -> pure () | Just False <- optVerbose -> pure ()
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case | 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 newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283 -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
alreadyInstalling' <- alreadyInstalling optCommand newTool alreadyInstalling' <- alreadyInstalling optCommand newTool
when (not alreadyInstalling') $ when (not alreadyInstalling') $
case t of case t of
#ifdef DISABLE_UPGRADE
GHCup -> pure ()
#else
GHCup -> runLogger $ GHCup -> runLogger $
logWarn ("New GHCup version available: " logWarn ("New GHCup version available: "
<> tVerToText l <> prettyVer l
<> ". To upgrade, run 'ghcup upgrade'") <> ". To upgrade, run 'ghcup upgrade'")
#endif
_ -> runLogger $ _ -> runLogger $
logWarn ("New " logWarn ("New "
<> T.pack (prettyShow t) <> T.pack (prettyShow t)
<> " version available. " <> " version available. "
<> "If you want to install this latest version, run 'ghcup install " <> "To upgrade, run 'ghcup install "
<> T.pack (prettyShow t) <> T.pack (prettyShow t)
<> " " <> " "
<> tVerToText l <> prettyVer l
<> "'") <> "'")
Just _ -> pure () Just _ -> pure ()
-- TODO: always run for windows -- TODO: always run for windows
siletRunLogger (flip runReaderT s' $ runE ensureShimGen) >>= \case siletRunLogger (flip runReaderT s' $ runE ensureGlobalTools) >>= \case
VRight _ -> pure () VRight _ -> pure ()
VLeft e -> do VLeft e -> do
runLogger runLogger
(logError $ T.pack $ prettyHFError e) (logError $ T.pack $ prettyShow e)
exitWith (ExitFailure 30) exitWith (ExitFailure 30)
pure s' pure s'
@@ -279,7 +284,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
runAppState action' = do runAppState action' = do
s' <- liftIO appState s' <- liftIO appState
runReaderT action' s' runReaderT action' s'
----------------- -----------------
-- Run command -- -- Run command --
@@ -291,26 +296,26 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
s' <- appState s' <- appState
liftIO $ brickMain s' >> pure ExitSuccess liftIO $ brickMain s' >> pure ExitSuccess
#endif #endif
Install installCommand -> install installCommand settings appState runLogger Install installCommand -> install installCommand settings appState runLogger
InstallCabalLegacy iopts -> install (Left (InstallCabal iopts)) 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
Set setCommand -> set setCommand runAppState runLeanAppState runLogger UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger
UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger List lo -> list lo no_color runAppState
List lo -> list lo no_color runAppState Rm rmCommand -> rm rmCommand runAppState runLogger
Rm rmCommand -> rm rmCommand runAppState runLogger DInfo -> dinfo runAppState runLogger
DInfo -> dinfo runAppState runLogger Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger Config configCommand -> config configCommand settings keybindings runLogger
Config configCommand -> config configCommand settings userConf keybindings runLogger
Whereis whereisOptions Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger #ifndef DISABLE_UPGRADE
ToolRequirements topts -> toolRequirements topts runAppState runLogger Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger #endif
Nuke -> nuke appState runLogger ToolRequirements topts -> toolRequirements topts runAppState runLogger
Prefetch pfCom -> prefetch pfCom runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
GC gcOpts -> gc gcOpts runAppState runLogger Nuke -> nuke appState runLogger
Run runCommand -> run runCommand appState leanAppstate runLogger Prefetch pfCom -> prefetch pfCom runAppState runLogger
PrintAppErrors -> putStrLn allHFError >> pure ExitSuccess GC gcOpts -> gc gcOpts runAppState runLogger
Run runCommand -> run runCommand runAppState leanAppstate runLogger
case res of case res of
ExitSuccess -> pure () ExitSuccess -> pure ()
@@ -329,29 +334,28 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, MonadCatch m , MonadCatch m
) )
=> Command => Command
-> (Tool, GHCTargetVersion) -> (Tool, Version)
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m Bool ] m Bool
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over })) alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver (GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver })) alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver (GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion over) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver })) #ifndef DISABLE_UPGRADE
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
alreadyInstalling (Upgrade {}) (GHCup, _) = pure True #endif
alreadyInstalling _ _ = pure False alreadyInstalling _ _ = pure False
cmp' :: ( HasLog env cmp' :: ( HasLog env
@@ -365,14 +369,12 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
) )
=> Tool => Tool
-> Maybe ToolVersion -> Maybe ToolVersion
-> GHCTargetVersion -> Version
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m Bool ] m Bool
cmp' tool instVer ver = do cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool (v, _) <- liftE $ fromVersion instVer tool
pure (v == ver) pure (v == mkTVer ver)

View File

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

View File

@@ -1,9 +1,8 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.6.3.0, constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic, Cabal -bundled-binary-generic,
any.Cabal-syntax ==3.8.1.0,
any.HUnit ==1.6.2.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, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1, any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
@@ -11,13 +10,13 @@ constraints: any.Cabal ==3.6.3.0,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
any.abstract-deque ==0.3, any.abstract-deque ==0.3,
abstract-deque -usecas, abstract-deque -usecas,
any.aeson ==2.1.1.0, any.aeson ==2.0.3.0,
aeson -cffi +ordered-keymap, aeson -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9, any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only, aeson-pretty +lib-only,
any.alex ==3.2.7.1, any.alex ==3.2.7.1,
any.ansi-terminal ==0.11.4, any.ansi-terminal ==0.11.1,
ansi-terminal -example +win32-2-13-1, ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9, any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example, ansi-wl-pprint -example,
any.array ==0.5.4.0, any.array ==0.5.4.0,
@@ -29,27 +28,23 @@ constraints: any.Cabal ==3.6.3.0,
any.attoparsec ==0.14.4, any.attoparsec ==0.14.4,
attoparsec -developer, attoparsec -developer,
any.base ==4.14.3.0, any.base ==4.14.3.0,
any.base-compat ==0.12.2, any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.2, any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.7, any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.2.0, any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.2.1.0, any.base64-bytestring ==1.2.1.0,
any.bifunctors ==5.5.14, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.8.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.blaze-builder ==0.4.2.2,
any.brick ==1.5, any.brick ==0.64.2,
brick -demos, brick -demos,
any.bytestring ==0.10.12.0, any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib, bz2 -cross +with-bzlib,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-install-parsers ==0.5, any.cabal-plan ==0.7.2.1,
any.cabal-plan ==0.7.2.3,
cabal-plan -_ -exe -license-report, cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
@@ -57,12 +52,14 @@ constraints: any.Cabal ==3.6.3.0,
any.chs-cabal ==0.1.1.1, any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0, any.chs-deps ==0.1.0.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.3,
clock -llvm,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable, comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2, any.composition-prelude ==3.0.0.2,
composition-prelude -development, composition-prelude -development,
any.config-ini ==0.2.5.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.5.1, any.containers ==0.6.5.1,
any.contravariant ==1.5.5, 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-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1, any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2, any.data-clist ==0.2,
any.data-fix ==0.3.2, any.data-fix ==0.3.2,
any.deepseq ==1.4.4.0, any.deepseq ==1.4.4.0,
@@ -84,91 +80,93 @@ constraints: any.Cabal ==3.6.3.0,
dlist -werror, dlist -werror,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.10, any.free ==5.1.7,
any.fusion-plugin-types ==0.1.0, any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2, any.generic-arbitrary ==0.2.0,
any.generically ==0.1, any.ghc ==8.10.7,
any.ghc-boot ==8.10.7,
any.ghc-boot-th ==8.10.7, any.ghc-boot-th ==8.10.7,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-heap ==8.10.7,
any.ghc-prim ==0.6.1, any.ghc-prim ==0.6.1,
any.ghci ==8.10.7,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.4.2.0, any.hashable ==1.4.0.2,
hashable +integer-gmp -random-initial-seed, hashable +containers +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.2.1, any.haskus-utils-variant ==3.2.1,
any.heaps ==0.4, any.heaps ==0.4,
any.hpc ==0.6.1.0,
any.hsc2hs ==0.68.8, any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.10.8, any.hspec ==2.9.4,
any.hspec-core ==2.10.8, any.hspec-core ==2.9.4,
any.hspec-discover ==2.10.8, any.hspec-discover ==2.9.4,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.1, any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor, http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1, any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.2, 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-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1, any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp, 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, io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.2, any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings, language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.2, any.libarchive ==3.0.3.2,
libarchive -cross -low-memory +no-exe -system-libarchive, libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1, any.libyaml-streamly ==0.2.1,
libyaml-streamly -no-unicode -system-libyaml, libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4, any.lockfree-queue ==0.2.3.1,
any.lukko ==0.1.1.3, any.lzma-static ==5.2.5.4,
lukko +ofd-locking, any.megaparsec ==9.2.0,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.1,
megaparsec -dev, megaparsec -dev,
any.microlens ==0.4.13.1, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.3, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.11, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3.1,
any.mtl ==2.2.2, any.mtl ==2.2.2,
any.network ==3.1.2.7, any.network ==3.1.2.7,
network -devel, network -devel,
any.network-uri ==2.6.4.2, any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0, any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2, any.optics ==0.4,
any.optics-core ==0.4.1, any.optics-core ==0.4,
optics-core -explicit-generic-labels, optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1, any.optics-extra ==0.4,
any.optics-th ==0.4.1, any.optics-th ==0.4,
any.optparse-applicative ==0.17.0.0, any.optparse-applicative ==0.17.0.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2.1, any.os-release ==1.0.2.1,
os-release -devel, os-release -devel,
any.parallel ==3.2.2.0, any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1, any.parsec ==3.1.14.0,
any.parser-combinators ==1.3.0, any.parser-combinators ==1.3.0,
parser-combinators -dev, parser-combinators -dev,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.4.0, any.primitive ==0.7.3.0,
any.process ==1.6.13.2, any.process ==1.6.13.2,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.random ==1.2.1.1, any.random ==1.2.1,
any.recursion-schemes ==5.2.2.3, any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2, any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.6, any.resourcet ==1.2.4.3,
any.retry ==0.8.1.2, any.retry ==0.8.1.2,
retry -lib-werror, retry -lib-werror,
any.rts ==1.0.1, any.rts ==1.0.1,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.3, any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0, any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple, scientific -bytestring-builder -integer-simple,
any.semialign ==1.2.0.1, any.semialign ==1.2.0.1,
@@ -176,36 +174,32 @@ constraints: any.Cabal ==3.6.3.0,
any.semigroupoids ==5.3.7, any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.split ==0.2.3.5, any.split ==0.2.3.4,
any.splitmix ==0.1.0.4, any.splitmix ==0.1.0.4,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.1, 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, 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, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
any.tagged ==0.8.6.1, any.tagged ==0.8.6.1,
tagged +deepseq +transformers, tagged +deepseq +transformers,
any.tagsoup ==0.14.8, any.tagsoup ==0.14.8,
any.tar ==0.5.1.1,
tar -old-bytestring -old-time,
any.template-haskell ==2.16.0.0, any.template-haskell ==2.16.0.0,
any.temporary ==1.3, any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1, any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.3, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.4,
any.text ==2.0.1, any.text ==1.2.4.1,
text -developer +simdutf,
any.text-binary ==0.2.1.1,
any.text-short ==0.1.5, any.text-short ==0.1.5,
text-short -asserts, text-short -asserts,
any.text-zipper ==0.12, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.5.0, any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.4, any.th-compat ==0.1.3,
any.th-lift ==0.8.2, 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, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
@@ -214,16 +208,16 @@ constraints: any.Cabal ==3.6.3.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, 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, 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, unicode-data -ucd2haskell,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.8, any.unix-bytestring ==0.3.7.6,
any.unix-compat ==0.6, any.unix-compat ==0.5.4,
unix-compat -old-time, unix-compat -old-time,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.19.1, any.unordered-containers ==0.2.17.0,
unordered-containers -debug, unordered-containers -debug,
any.uri-bytestring ==0.3.3.1, any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror, uri-bytestring -lib-werror,
@@ -231,16 +225,15 @@ constraints: any.Cabal ==3.6.3.0,
any.uuid-types ==1.0.5, any.uuid-types ==1.0.5,
any.vector ==0.12.3.1, any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall, vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-binary-instances ==0.2.5.2, any.versions ==5.0.3,
any.versions ==5.0.4, any.vty ==5.33,
any.vty ==5.37,
any.witherable ==0.4.2, any.witherable ==0.4.2,
any.word-wrap ==0.5, any.word-wrap ==0.5,
any.word8 ==0.1.3, any.word8 ==0.1.3,
any.xor ==0.0.1.1, any.xor ==0.0.1.1,
any.yaml-streamly ==0.12.1, any.yaml-streamly ==0.12.1,
yaml-streamly +no-examples +no-exe, yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.3.0, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5 any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2023-01-12T04:22:48Z index-state: hackage.haskell.org 2022-03-15T16:43:02Z

34
cabal.ghc902.project Normal file
View File

@@ -0,0 +1,34 @@
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
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.2

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

@@ -0,0 +1,239 @@
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.1,
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.11,
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.7,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.0,
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.4,
any.hspec-core ==2.9.4,
any.hspec-discover ==2.9.4,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0,
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.0.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.0,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3.1,
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,
any.optics-core ==0.4,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4,
any.optics-th ==0.4,
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.3.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,
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.4.3,
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.2,
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.6,
any.unix-compat ==0.5.4,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.17.0,
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.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2022-03-15T16:43:02Z

View File

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

View File

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

View File

@@ -1,46 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
flags: +tui
if os(linux)
if arch(x86_64) || arch(i386)
package *
ghc-options: -split-sections -optl-static
elif os(darwin)
constraints: zlib +bundled-c-zlib,
lzma +static
elif os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.1.0.3
elif os(freebsd)
constraints: zlib +bundled-c-zlib,
zip +disable-zstd
package *
ghc-options: -split-sections -pgmc clang++14
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

@@ -1,7 +0,0 @@
#include "dirutils.h"
unsigned int
__posixdir_d_type(struct dirent* d)
{
return(d -> d_type);
}

View File

@@ -1,16 +0,0 @@
#ifndef POSIXPATHS_CBITS_DIRUTILS_H
#define POSIXPATHS_CBITS_DIRUTILS_H
#include <HsFFI.h>
#include <stdlib.h>
#include <dirent.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
extern unsigned int
__posixdir_d_type(struct dirent* d)
;
#endif

View File

@@ -16,11 +16,6 @@ gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
# TUI key bindings, # TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key # see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values. # for possible values.
# It's also possible to define key+modifier, e.g.:
# quit:
# Key:
# KChar: c
# Mods: [MCtrl]
key-bindings: key-bindings:
up: up:
KUp: [] KUp: []
@@ -45,86 +40,38 @@ key-bindings:
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'. # of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
meta-cache: 300 # in seconds meta-cache: 300 # in seconds
# When trying to download ghcup metadata, this option decides what to do # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# when the download fails: # check the 'URLSource' type in the code.
# 1. Lax: use existing ~/.ghcup/cache/ghcup-<ver>.yaml as fallback (default)
# 2. Strict: fail hard
meta-mode: Lax # Strict | Lax
# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
# union over tool versions, preferring the later entries.
url-source: url-source:
## Use the internal download uri, this is the default ## Use the internal download uri, this is the default
- GHCupURL GHCupURL: []
## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata) ## Example 1: Read download info from this location instead
# - StackSetupURL ## Accepts file/http/https scheme
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
## which case they are merged right-biased (overwriting duplicate versions).
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Add pre-release channel ## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml ## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
## Add nightly channel # AddSource:
# - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml # Left:
## Add cross compiler channel # globalTools: {}
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml # toolRequirements: {}
# ghcupDownloads:
## Use dwarf bindist for 9.4.7 for ghcup metadata # GHC:
# - ghcup-info: # 9.10.2:
# ghcupDownloads: # viTags: []
# GHC: # viArch:
# 9.4.7: # A_64:
# viTags: [] # Linux_UnknownLinux:
# viArch: # unknown_versioning:
# A_64: # dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
# Linux_UnknownLinux: # dlSubdir: ghc-7.10.3
# unknown_versioning: # dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
# dlUri: https://downloads.haskell.org/ghc/9.4.7/ghc-9.4.7-x86_64-deb10-linux-dwarf.tar.xz
# dlSubdir:
# RegexDir: "ghc-.*"
# dlHash: b261b3438ba455e3cf757f9c8dc3a06fdc061ea8ec287a65b7809e25fe18bad4
## for stack metadata and the linux64-tinfo6 bindists, use static alpine for 9.8.1
# - setup-info:
# ghc:
# linux64-tinfo6:
# 9.8.1:
# url: "https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-alpine3_12-linux-static.tar.xz"
# content-length: 229037440
# sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3
# This is a way to override platform detection, e.g. when you're running
# a Ubuntu derivate based on 18.04, you could do:
#
# platform-override:
# arch: A_64
# platform:
# contents: Ubuntu
# 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"
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
## versions).
# AddSource:
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

View File

@@ -1,71 +0,0 @@
FROM --platform=linux/i386 i386/alpine:3.12
ENV LANG C.UTF-8
RUN apk add --no-cache \
curl \
gcc \
g++ \
binutils \
binutils-gold \
coreutils \
bsd-compat-headers \
gmp-dev \
ncurses-dev \
libffi-dev \
make \
xz \
tar \
perl \
bash \
diffutils \
git \
gzip \
gnupg && \
apk add --no-cache \
zlib \
zlib-dev \
zlib-static \
bzip2 \
bzip2-dev \
bzip2-static \
gmp \
gmp-dev \
openssl-dev \
openssl-libs-static \
xz \
xz-dev \
ncurses-static
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/i386-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 i386-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} && \
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:/root/.local/bin:$PATH

View File

@@ -1,72 +0,0 @@
FROM alpine:3.12
ENV LANG C.UTF-8
RUN apk add --no-cache \
curl \
gcc \
g++ \
binutils \
binutils-gold \
coreutils \
bsd-compat-headers \
gmp-dev \
ncurses-dev \
libffi-dev \
make \
xz \
tar \
perl \
bash \
diffutils \
git \
gzip \
gnupg && \
apk add --no-cache \
zlib \
zlib-dev \
zlib-static \
bzip2 \
bzip2-dev \
bzip2-static \
gmp \
gmp-dev \
openssl-dev \
openssl-libs-static \
xz \
xz-dev \
ncurses-static
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/x86_64-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 x86_64-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} && \
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:/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

@@ -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,61 +0,0 @@
FROM arm32v7/ubuntu:focal
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-9 clang-9 && \
rm -rf /var/lib/apt/lists/*
RUN update_opt.sh 9 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

@@ -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,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,61 +0,0 @@
FROM arm64v8/ubuntu:focal
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-9 clang-9 && \
rm -rf /var/lib/apt/lists/*
RUN update_opt.sh 9 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

@@ -42,8 +42,8 @@ All you wanted to know about GHCup.
## How to help ## How to help
* if you want to contribute code or documentation, check out the [issue tracker](https://github.com/haskell/ghcup-hs/issues) and the [Development guide](./dev.md) * if you want to contribute code or documentation, check out the [issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues) and the [Development guide](./dev.md)
* if you want to propose features or write user feedback, feel free to [open a ticket](https://github.com/haskell/ghcup-hs/issues/new) * if you want to propose features or write user feedback, feel free to [open a ticket](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/new?issue)
* if you want to donate to the project, visit our [opencollective](https://opencollective.com/ghcup#category-CONTRIBUTE) page * if you want to donate to the project, visit our [opencollective](https://opencollective.com/ghcup#category-CONTRIBUTE) page
## Design goals ## Design goals
@@ -60,29 +60,6 @@ All you wanted to know about GHCup.
3. handling cabal projects 3. handling cabal projects
4. being a stack alternative 4. being a stack alternative
## Distribution policies
Like most Linux distros and other distribution channels, GHCup also
follows certain policies. These are as follows:
1. The end-user experience is our primary concern
- ghcup in CI systems as a use case is a first class citizen
2. We strive to collaborate with all maintainers of all the tools we support and maintain a good relationship
3. We may fix build system or other distribution bugs in upstream bindists
- these are always communicated upstream
4. We may even patch source code of supported tools in very rare cases if that is required to ensure that the end-user experience does not break
- we'll first try to upstream any such required patch and request a new release to avoid downstream patching
- patches will be communicated to the maintainers either way and we'll strive to get their review
- they will also be communicated to the end-user
- they will be uploaded along with the bindist
- we will avoid maintaining long-running downstream patches (currently zero)
5. We may add bindists for platforms that upstream does not support
- this is currently the case for GHC for e.g. Alpine and possibly FreeBSD in the future
- this is currently also the case for stack on darwin M1
- we don't guarantee for unofficial bindists that the test suite passes at the moment (this may change in the future)
6. We GPG sign all the GHCup metadata as well as the unofficial bindists
- any trust issues relating to missing checksums or GPG signatures is a bug and given high priority
## How ## How
Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`. Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.
@@ -97,16 +74,13 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
## Known users ## Known users
* CI: * Github actions:
- [Github actions/virtual-environments](https://github.com/actions/virtual-environments) - [actions/virtual-environments](https://github.com/actions/virtual-environments)
- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup) - [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
* mirrors: * mirrors:
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup) - [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
* tools: * tools:
- [vscode-haskell](https://github.com/haskell/vscode-haskell) - [vabal](https://github.com/Franciman/vabal)
- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
- [vabal](https://github.com/Franciman/vabal)
## Known problems ## Known problems
@@ -178,11 +152,6 @@ Windows 7 and Powershell 2.0 aren't well supported at the moment, also see:
## FAQ ## FAQ
### Is ghcup really the main installer?
This is based on the Haskell survey results from 2022, which show that more
than half of survey participants use GHCup: https://taylor.fausak.me/2022/11/18/haskell-survey-results/
### Why reimplement stack? ### Why reimplement stack?
GHCup is not a reimplementation of stack. The only common part is automatic installation of GHC, GHCup is not a reimplementation of stack. The only common part is automatic installation of GHC,

View File

@@ -69,9 +69,9 @@ Head over to: [https://github.com/haskell/ghcup-metadata#adding-a-new-ghc-versio
### Adding a new CLI command ### Adding a new CLI command
An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://github.com/haskell/ghcup-hs/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://github.com/haskell/ghcup-hs/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26) An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://github.com/haskell/ghcup-hs/tree/master/app/ghcup/GHCup/OptParse). Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/app/ghcup/GHCup/OptParse).
## Major refactors ## Major refactors

View File

@@ -1,10 +1,10 @@
# User Guide # User Guide
This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend. `ghcup --help` is your friend.
## Basic usage ## Basic usage
For the simple, interactive, text-based user interface (TUI), run: For the simple interactive TUI (not available on windows), run:
```sh ```sh
ghcup tui ghcup tui
@@ -43,11 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
If the argument is omitted, the default is `recommended`. If the argument is omitted, the default is `recommended`.
Other tags include: ## Configuration
- `prerelease`: a prerelease version A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
- `latest-prerelease`: the latest prerelease version explaining all possible configurations can be found in this repo: [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml).
Partial configuration is fine. Command line options always override the config file settings.
## Manpages ## Manpages
@@ -56,70 +57,13 @@ For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man`
## Shell-completion ## Shell-completion
Shell completions are in [scripts/shell-completions](https://github.com/haskell/ghcup-hs/tree/master/scripts/shell-completions) directory of this repository. Shell completions are in [scripts/shell-completions](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/shell-completions) directory of this repository.
For bash: install `shell-completions/bash` For bash: install `shell-completions/bash`
as e.g. `/etc/bash_completion.d/ghcup` (depending on distro) as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros). (`/usr/share/bash-completion/bash_completion` on some distros).
## Portability
`ghcup` is very portable. There are a few exceptions though:
1. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
# Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
explaining all possible configurations can be found in this repo: [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml).
Partial configuration is fine. Command line options always override the config file settings.
## Overriding distro detection
If you're running e.g. an Ubuntu derivate based on 18.04 and ghcup is picking bindists that
don't work well, you could do this in `config.yaml`:
```yml
platform-override:
arch: A_64
platform:
contents: Ubuntu
tag: Linux
version: '18.04'
```
## Env variables
This is the complete list of env variables that change GHCup behavior:
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) below
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
* `GHCUP_GPG_OPTS`: additional options that can be passed to gpg
* `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
* `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup
On windows, there's additionally:
* `GHCUP_MSYS2`: Has to point to the root of an existing MSYS2 installation (when installed by GHCup, that's e.g. `C:\ghcup\msys64`). GHCup bootstrap takes care of this usually.
### XDG support
To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIRS` to anything.
Then you can control the locations via XDG environment variables as such:
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir (default: `~/.local/share`)
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir (default: `~/.cache`)
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
* `XDG_CONFIG_HOME`: the config file is stored in `ghcup` subdir as `config.yaml` (default: `~/.config`)
**Note that `ghcup` makes some assumptions about structure of files in `XDG_BIN_HOME`. So if you have other tools
installing e.g. stack/cabal/ghc into it, this will likely clash. In that case consider disabling XDG support.**
## Caching ## Caching
GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default. GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default.
@@ -139,365 +83,21 @@ have a 5 minutes cache per default depending on the last access time of the file
If you experience problems, consider clearing the cache via `ghcup gc --cache`. If you experience problems, consider clearing the cache via `ghcup gc --cache`.
## Metadata ## Compiling GHC from source
Metadata files are also called release or distribution channels. They describe tool versions, where to download them etc. and
can be viewed here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata).
See the [description](https://github.com/haskell/ghcup-metadata#metadata-variants-distribution-channels)
of metadata files to understand their purpose. These can be combined.
For example, if you want access to both prerelease and cross bindists, you'd do:
```sh
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
```
This results in the following configuration in `~/.ghcup/config.yaml`:
```yaml
url-source:
# the base url that contains all the release bindists
- GHCupURL
# prereleases
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml
# cross bindists
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml
```
You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
here overwrite the default ones, if any.
To remove the channel, delete the entire `url-source` section or set it back to the default:
```yml
url-source:
- GHCupURL
```
Also see [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
for more options.
You can also use an alternative metadata via one-shot cli option:
```sh
ghcup --url-source=https://some-url/ghcup-0.0.8.yaml tui
```
One main caveat of using URLs is that you might need to check whether there are new versions
of the file (e.g. `ghcup-0.0.7.yaml` vs `ghcup-0.0.8.yaml`). Although old metadata files
are supported for some time, they are not so indefinitely.
### Mirrors
Metadata files can also be used to operate 3rd party mirrors, in which case you want to use
a URL instead of the `GHCupURL` alias. E.g. in `~/.ghcup/config.yaml`, you'd do:
```yml
url-source:
- https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml
```
Note that later versions of GHCup allow more sophisticated mirror support, see [here](./#mirrors-proper).
#### 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)
### Git based metadata config
If you don't like the way ghcup updates its metadata with caching and fetching via curl, you can also do as follows:
Clone the metadata git repo:
```sh
mkdir -p /home/user/git/
cd /home/user/git/
git clone -b master https://github.com/haskell/ghcup-metadata.git
```
Then tell ghcup to use file locations in `~/.ghcup/config.yaml`, e.g.:
```yaml
url-source:
- file:///home/user/git/ghcup-metadata/ghcup-0.0.8.yaml
- file:///home/user/git/ghcup-metadata/ghcup-cross-0.0.8.yaml
- file:///home/user/git/ghcup-metadata/ghcup-prereleases-0.0.8.yaml
```
Now, if you invoke `ghcup tui`, it will open instantly without any download, since it just
reads the metadata from local disk.
You'll have to update the metadata manually though, like so:
```sh
cd /home/user/git/
git pull --ff-only origin master
```
## Stack integration
Stack manages GHC versions internally by default. In order to make it use ghcup installed
GHC versions there are two strategies.
### Strategy 1: Stack hooks (new, recommended)
Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
We can use this to simply invoke ghcup whenever stack is trying to install/discover a GHC versions. This
is done via placing a shell script at `~/.stack/hooks/ghc-install.sh` and making it executable.
The ghcup bootstrap script asks you during installation whether you want to install this shell script. You can also
install/update it manually like so:
```sh
mkdir -p ~/.stack/hooks/
curl https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/hooks/stack/ghc-install.sh \
> ~/.stack/hooks/ghc-install.sh
chmod +x ~/.stack/hooks/ghc-install.sh
# hooks are only run when 'system-ghc: false'
stack config set system-ghc false --global
```
By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
this, run `stack config set install-ghc false --global`.
### Strategy 2: System GHC (works on all stack versions)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
stack config set system-ghc true --global
```
### Using stack's setup-info metadata to install GHC
You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
to install GHC. For that, you can invoke ghcup like so as a shorthand:
```sh
# ghcup will only see GHC now
ghcup -s StackSetupURL install ghc 9.4.7
# this combines both ghcup and stack metadata
ghcup -s '["GHCupURL", "StackSetupURL"]' install ghc 9.4.7
```
To make this permanent and combine it with the GHCup metadata, you can add the following to your `~/.ghcup/config.yaml`:
```yaml
url-source:
- GHCupURL
# stack versions take precedence
# you'll still have access to GHCup provided versions and tools in case they don't exist in stack metadata
- StackSetupURL
```
You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:
```yaml
url-source:
- GHCupURL
- StackSetupURL
- setup-info:
ghc:
linux64-tinfo6:
9.4.7:
url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
content-length: 179117892
sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
```
#### Caveats
The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
when you try to install HLS.
Another potential usability issue is that the `latest` and `recommended` shorthands won't work anymore, since
Stack metadata doesn't have a concept of those and we don't try to be smart when combining the metadatas.
### Windows
On windows, you may find the following config options useful too:
`skip-msys`, `extra-path`, `extra-include-dirs`, `extra-lib-dirs`.
Also check out: [https://docs.haskellstack.org/en/stable/yaml_configuration](https://docs.haskellstack.org/en/stable/yaml_configuration)
## Mirrors (proper)
Mirrors are now supported via configuration, instead of specifying alternative metadata files.
As an example, this would be a complete mirror configuration in `~/.ghcup/config.yaml`:
```yaml
mirrors:
# yaml download location, would result in:
# https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.8.yaml
# -> https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml
"raw.githubusercontent.com":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "ghcup/yaml"
# for stack and some older HLS versions, would result in e.g.
# https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
# -> https://mirror.sjtu.edu.cn/ghcup/github/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
"github.com":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "ghcup/github"
# for all haskell.org hosted bindists, would result in e.g.
# https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
# -> https://mirror.sjtu.edu.cn/ghcup/haskell-downloads/~ghc/9.8.1/ghc-9.8.1-x86_64-deb10-linux.tar.xz
"downloads.haskell.org":
authority:
host: "mirror.sjtu.edu.cn"
pathPrefix: "downloads.haskell.org"
```
The configuration depends on the host of the mirror and they have to provide the correct configuration.
# More on installation
## Customisation of the installation scripts
The scripts offered to install GHCup are available here:
* [bootstrap-haskell](https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
for Unix-like operating systems
* [bootstrap-haskell.ps1](https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1)
for Windows (PowerShell). This will, in turn, run the final bootstrap script
(by default, that for the Unix-like operating systems).
The effect of the scripts can be customised by setting one or more
`BOOTSTRAP_HASKELL_*` environment variables (as set out in the first script)
and, in the case of Windows, by specifying parameters (as set out in the
PowerShell script).
For example, you can toggle:
* non-interactive installation
* a more verbose installation
* whether to install only GHCup (and, on Windows, MSYS2)
* not to trigger the upgrade of GHCup
* whether to install the latest version of HLS
* whether to install the latest version of Stack
* whether to respect the XDG Base Directory Specification
* whether to adjust (prepend) the PATH in `bashrc`
* on Windows, whether to adjust MINGW paths in `cabal.config`
You can also specify:
* the GHC version to install
* the Cabal version to install
* which downloader to use (the default is `curl`)
* the base URL for the download of the GHCup binary distribution
On Windows, you can also use the parameters to:
* toggle whether to overwrite a previous installation
* specify the GHCup installation root directory
* specify the Cabal root directory
* specify the directory of an existing installation of MSYS2 (for example,
the one supplied by Stack)
* specify the URL of the final bootstrap script
* toggle whether to run the final bootstrap script via `bash` (instead of in a
new MSYS2 shell)
## Installing custom bindists
There are a couple of good use cases to install custom bindists:
1. manually built bindists (e.g. with patches)
- example: `ghcup install ghc -u 'file:///home/mearwald/tmp/ghc-eff-patches/ghc-8.10.2-x86_64-deb10-linux.tar.xz' 8.10.2-eff`
2. GHC head CI bindists
- example specifying a branch (`master`): `ghcup install ghc -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head`
- example specifying a job id (`1129565`): `ghcup install ghc -u ' https://gitlab.haskell.org/api/v4/projects/1/jobs/1129565/artifacts/ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz' mr7847`
3. DWARF bindists
- example: `ghcup install ghc -u 'https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux-dwarf.tar.xz' 8.10.2-dwarf`
Since the version parser is pretty lax, `8.10.2-eff` and `head` are both valid versions
and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected).
## Compiling from source
### GHC
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help` Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
for a list of all available options. for a list of all available options.
If you need to overwrite the existing `build.mk`, check the default files If you need to overwrite the existing `build.mk`, check the default files
in [data/build_mk](https://github.com/haskell/ghcup-hs/tree/master/data/build_mk), copy them somewhere, adjust them and in [data/build_mk](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/data/build_mk), copy them somewhere, adjust them and
pass `--config path/to/build.mk` to `ghcup compile ghc`. pass `--config path/to/build.mk` to `ghcup compile ghc`.
Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/using#build-configuration). Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/using#build-configuration).
Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation). Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
### HLS ### Cross support
There are 3 main ways to compile HLS from source. ghcup can compile and install a cross GHC for any target. However, this
1. from hackage (should have up to date version bounds)
- `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3`
2. from git (allows to build latest sources and PRs)
- `ghcup compile hls --git-ref master --ghc 9.2.3`
- `ghcup compile hls --git-ref a32db0b --ghc 9.2.3`
- `ghcup compile hls --git-ref 1.7.0.0 --ghc 9.2.3`
3. from source distribution that's packaged during release from the corresponding git sources
- `ghcup compile hls --source-dist 1.7.0.0 --ghc 9.2.3`
All these use `cabal v2-install` under the hood, so all build components are cached.
You can pass arbitrary arguments to cabal, e.g. set the index state like so:
```sh
ghcup compile hls --git-ref master --ghc 9.2.3 -- --index-state=2022-06-12T00:00:00Z --allow-newer
```
You can pass `--ghc <ver>` multiple times to install for many GHCs at once.
When building from git sources, ghcup will auto-detect the HLS version that the git commit corresponds to
from the `haskell-language-server.cabal` file. This version might not have been updated since the last release.
If you want to avoid overwriting the existing installed HLS version, you can instruct ghcup to use `git describe`
to set the HLS version instead:
```sh
ghcup compile hls --git-ref master --ghc 9.2.3 --git-describe-version
```
You can also set the version explicitly:
```sh
ghcup compile hls --git-ref master --ghc 9.2.3 --overwrite-version 1.7.0.0-p1
```
To instruct cabal to run `cabal update` before building, run `ghcup compile hls --version 1.7.0.0 --ghc 9.2.3 --cabal-update`
As always, check `ghcup compile hls --help`.
#### Updating HLS for a new GHC version
First try to build from hackage with some tricks:
```sh
ghcup compile hls --version 1.7.0.0 --ghc 9.2.4 --cabal-update -- --allow-newer --index-state=2022-06-12T00:00:00Z
```
This augments the currently installed 1.7.0.0 official bindists in ghcup with new GHC versions support.
If that fails (since `--allow-newer` is quite brutal), you can install from HLS master branch (which may contain new fixes) like so:
```
ghcup compile hls --git-ref master --git-describe-version --ghc 8.10.7 --ghc 9.2.4 --cabal-update
```
This however will create a new HLS version in ghcup, e.g. `1.7.0.0-105-gdc682ba1`, for both 8.10.7 and 9.2.4. If you want to switch back to the official bindists, run `ghcup set hls 1.7.0.0`.
## Cross support
ghcup can compile a cross GHC for any target. However, this
requires that the build host has a complete cross toolchain and various requires that the build host has a complete cross toolchain and various
libraries installed for the target platform. libraries installed for the target platform.
@@ -506,80 +106,76 @@ For distributions with non-standard locations of cross toolchain and
libraries, this may need some tweaking of `build.mk` or configure args. libraries, this may need some tweaking of `build.mk` or configure args.
See `ghcup compile ghc --help` for further information. See `ghcup compile ghc --help` for further information.
Since ghcup version 0.1.20.0, we provide cross bindists for GHC JS and WASM. These can be installed conveniently. ## XDG support
However, these are intended as a developer preview only. By using these GHC variants, you are implicitly signing up to participate in GHC development!
If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org.
First, add the cross release channel: To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIRS` to anything.
```sh Then you can control the locations via XDG environment variables as such:
ghcup config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-cross-0.0.8.yaml
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir (default: `~/.local/share`)
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir (default: `~/.cache`)
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
* `XDG_CONFIG_HOME`: the config file is stored in `ghcup` subdir as `config.yaml` (default: `~/.config`)
**Note that `ghcup` makes some assumptions about structure of files in `XDG_BIN_HOME`. So if you have other tools
installing e.g. stack/cabal/ghc into it, this will likely clash. In that case consider disabling XDG support.**
## Env variables
This is the complete list of env variables that change GHCup behavior:
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
* `TMPDIR`: where ghcup does the work (unpacking, building, ...)
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
* `GHCUP_GPG_OPTS`: additional options that can be passed to gpg
* `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
* `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup
## Installing custom bindists
There are a couple of good use cases to install custom bindists:
1. manually built bindists (e.g. with patches)
- example: `ghcup install ghc -u 'file:///home/mearwald/tmp/ghc-eff-patches/ghc-8.10.2-x86_64-deb10-linux.tar.xz' 8.10.2-eff`
2. GHC head CI bindists
- example: `ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
3. DWARF bindists
- example: `ghcup install ghc -u 'https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux-dwarf.tar.xz' 8.10.2-dwarf`
Since the version parser is pretty lax, `8.10.2-eff` and `head` are both valid versions
and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected).
## Mirrors
GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
To use a mirror, set the following option in `~/.ghcup/config.yaml`:
```yml
url-source:
# Accepts file/http/https scheme
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
``` ```
The next sections explain how to install each cross bindist. See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
for more options.
### GHC JS cross bindists (experimental) Alternatively you can do it via a cli switch:
You need the required emscripten JS toolchain:
```sh ```sh
git clone https://github.com/emscripten-core/emsdk.git ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
cd emsdk
./emsdk install latest
./emsdk activate latest
source ./emsdk_env.sh
``` ```
Instructions are also here: [Download and install — Emscripten 3.1.43-git (dev) documentation](https://emscripten.org/docs/getting_started/downloads.html). ### Known mirrors
To install we need to invoke ghcup like so: 1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
```sh
emconfigure ghcup install ghc --set javascript-unknown-ghcjs-9.6.2
```
You'll now have the compiler `javascript-unknown-ghcjs-ghc`. To build a hello world, do e.g.:
```sh
echo 'main = putStrLn "hello world"' > hello.hs
javascript-unknown-ghcjs-ghc -fforce-recomp hello.hs
./hello
```
You can follow the instructions [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/javascript-backend/building#compiling-hello-world).
### GHC WASM cross bindists (experimental)
You need the required wasm toolchain:
```sh
git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta.git
cd ghc-wasm-meta/
export SKIP_GHC=yes
./setup.sh
source ~/.ghc-wasm/env
```
To install, we need to invoke ghcup like so also passing the `--host=<host>` flag (adjust as needed):
```sh
ghcup install ghc --set wasm32-wasi-9.6.3.20230927 -- --host=x86_64-linux --with-intree-gmp --with-system-libffi
```
Also check the documentation here: [Glasgow Haskell Compiler / ghc-wasm-meta](https://gitlab.haskell.org/ghc/ghc-wasm-meta).
You'll now have the compiler `wasm32-wasi-ghc`. To build a hello world, do e.g.:
```sh
echo 'main = putStrLn "hello world"' > hello.hs
wasm32-wasi-ghc hello.hs -o hello.wasm
wasmtime ./hello.wasm
```
## Isolated installs ## Isolated installs
**Before using isolated installs, make sure to have at least GHCup version 0.1.17.8!**
Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing. Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.
These installs, as the name suggests, are separate from your main installs and DO NOT conflict with them. These installs, as the name suggests, are separate from your main installs and DO NOT conflict with them.
@@ -592,101 +188,56 @@ You need to use the `--isolate` or `-i` flag followed by the directory path.
Examples: Examples:
1. install an isolated GHC version at location /home/user/isolated_dir/ghc/ 1. install an isolated GHC version at location /home/user/isolated_dir/ghc/
- `ghcup install ghc 8.10.5 --isolate /home/user/isolated_dir/ghc` - `ghcup install ghc 8.10.5 --isolate /home/user/isolated_dir/ghc`
2. isolated install Cabal at a location you desire 2. isolated install Cabal at a location you desire
- `ghcup install cabal --isolate /home/username/my_isolated_dir/` - `ghcup install cabal --isolate /home/username/my_isolated_dir/`
3. do an isolated install with a custom bindist 3. do an isolated install with a custom bindist
- `ghcup install ghc --isolate /home/username/my_isolated_dir/ -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head` - `ghcup install ghc --isolate /home/username/my_isolated_dir/ -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
4. isolated install HLS 4. isolated install HLS
- `ghcup install hls --isolate /home/username/dir/hls/` - `ghcup install hls --isolate /home/username/dir/hls/`
5. you can even compile ghc to an isolated location. 5. you can even compile ghc to an isolated location.
- `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc` - `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc`
## Continuous integration ## Continuous integration
On Windows, GHCup can be installed automatically on a CI runner On windows, ghcup can be installed automatically on a CI runner non-interactively like so:
non-interactively, as below. The paramaters to the PowerShell script are
specified positionally, after `-ArgumentList`:
```ps ```ps
$ErrorActionPreference = 'Stop';Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\" } catch { Write-Error $_ } Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
``` ```
`$ErrorActionPreference = 'Stop'` here acts like `set -e` and stops execution if ghcup installation fails.
On linux/darwin/freebsd, run the following on your runner: On linux/darwin/freebsd, run the following on your runner:
```sh ```sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
``` ```
This will just install `ghcup` and on Windows additionally MSYS2. This will just install `ghcup` and on windows additionally `msys2`.
See the installation scripts referred to above for the full list of environment For the full list of env variables and parameters to tweak the script behavior, see:
variables and, in the case of Windows, parameters to tweak the script behavior.
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
### github workflows ### github workflows
On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations. On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
Here's an example workflow with a GHC matrix: GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
```yaml
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: true
matrix:
os: [ubuntu-22.04, macOS-latest]
ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
steps:
- uses: actions/checkout@v3
- name: Setup toolchain
run: |
ghcup install cabal --set recommended
ghcup install ghc --set ${{ matrix.ghc }}
- name: Build
run: |
cabal update
cabal test all --test-show-details=direct
i386:
runs-on: ubuntu-latest
container:
image: i386/ubuntu:bionic
steps:
- name: Install GHCup in container
run: |
apt-get update -y
apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
# we just go with recommended versions of cabal and GHC
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
- uses: actions/checkout@v1
- name: Test
run: |
# in containers we need to fix PATH
source ~/.ghcup/env
cabal update
cabal test all --test-show-details=direct
```
## GPG verification ## GPG verification
GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so
this is cryptographically secure. this is cryptographically secure.
First, obtain the gpg keys: First, obtain the gpg key:
```sh ```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: Then verify the gpg key in one of these ways:
@@ -705,10 +256,10 @@ gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning. In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
You can also pass the mode via `ghcup --gpg <strict|lax|none>`. You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
## Tips and tricks
# Tips and tricks ### Execute command with certain GHC in PATH
## ghcup run
If you don't want to explicitly switch the active GHC all the time and are using If you don't want to explicitly switch the active GHC all the time and are using
tools that rely on the plain `ghc` binary, GHCup provides an easy way to execute tools that rely on the plain `ghc` binary, GHCup provides an easy way to execute
@@ -719,34 +270,3 @@ ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- c
``` ```
This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version. This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
# Troubleshooting
## Script immediately exits on windows
There are two possible reasons:
1. your company blocks the script (some have a whitelist)... ask your administrator
2. your Antivirus or Windows Defender interfere with the installation. Disable them temporarily.
## C compiler cannot create executables
### Darwin
You need to update your XCode command line tools, e.g. [like this](https://stackoverflow.com/questions/34617452/how-to-update-xcode-from-command-line).
## Certificate authority errors (curl)
If your certificates are outdated or improperly configured, curl may be unable
to download ghcup.
There are two known workarounds:
1. Tell curl to ignore certificate errors (dangerous): `curl -k https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/bootstrap/bootstrap-haskell | GHCUP_CURL_OPTS="-k" sh`
2. Try to use wget instead: `wget -O /dev/stdout https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/bootstrap/bootstrap-haskell | BOOTSTRAP_HASKELL_DOWNLOADER=wget sh`
On windows, you can disable curl like so:
```pwsh
Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true,$false,$false,$false,$false,$false,$false,"","","","",$true } catch { Write-Error $_ }
```

View File

@@ -4,16 +4,19 @@ hide:
- toc - 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"> <section class="index-ghcup-hero">
<img alt="haskell logo" src="./haskell_logo.png" /> <img alt="haskell logo" src="./haskell_logo.png" />
<h1>GHCup</h1> <h1>GHCup</h1>
</section> </section>
<p class="ghcup-intro">GHCup is the main installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p> <p class="ghcup-intro">GHCup is an installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p>
<div class="text-center main-buttons"> <div class="text-center main-buttons">
<a href="install/" class="btn btn-primary" role="button">Installation</a> <a href="install/" class="btn btn-primary" role="button">Getting Started</a>
<a href="steps/" class="btn btn-primary" role="button">First steps</a>
<a href="guide/" class="btn btn-primary" role="button">User Guide</a> <a href="guide/" class="btn btn-primary" role="button">User Guide</a>
</div> </div>
@@ -31,7 +34,7 @@ hide:
<span> <span>
</span> </span>
<div class="footer"> <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://gitlab.haskell.org/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>
</div> </div>
@@ -41,19 +44,19 @@ hide:
<div class="command-button"> <div class="command-button">
<pre> <pre>
<span class="ghcup-command" id="ghcup-command-windows">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072; try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true } catch { Write-Error $_ } <span class="ghcup-command" id="ghcup-command-windows">Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true
</span> </span>
</pre> </pre>
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button> <button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
</div> </div>
<div class="footer"> <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://gitlab.haskell.org/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>
</div> </div>
</section> </section>
<p id="help" class="ghcup-help"> <p id="help" class="ghcup-help">
Need help? Check the <a href="guide/#troubleshooting">Troubleshooting section</a> or ask on Need help? Ask on
<span> <span>
<a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup"> <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup">
<img src="irc.svg" alt="" /> <img src="irc.svg" alt="" />
@@ -73,13 +76,16 @@ hide:
</span> </span>
or or
<span> <span>
<a href="https://github.com/haskell/ghcup-hs/issues"> <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">
report a bug report a bug
<img src="Octicons-bug.svg" alt="" /> <img src="Octicons-bug.svg" alt="" />
</a> </a>
</span> </span>
</p> </p>
<script type="text/javascript" src="javascripts/ghcup.js"></script>
---- ----

View File

@@ -1,10 +1,10 @@
# Installation # Getting started
GHCup makes it easy to install specific versions of GHC on GNU/Linux, 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). It follows the unix 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 ## Installation
The following commands will download the `ghcup` binary into `~/.ghcup/bin` (or `C:\ghcup\bin` on windows) and then The following commands will download the `ghcup` binary into `~/.ghcup/bin` (or `C:\ghcup\bin` on windows) and then
run it to interactively install the [Haskell Toolchain](#supported-tools). These commands should be run as **non-root/non-admin run it to interactively install the [Haskell Toolchain](#supported-tools). These commands should be run as **non-root/non-admin
@@ -19,12 +19,10 @@ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
For Windows, run this in a PowerShell session: For Windows, run this in a PowerShell session:
```psh ```psh
Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072; try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true } catch { Write-Error $_ } Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true
``` ```
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://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) 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-installation) and GPG verify the binaries.
### Which versions get installed? ### Which versions get installed?
@@ -34,217 +32,105 @@ GHCup has two main channels for every tool: **recommended** and **latest**. By d
Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information. Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
## System requirements ## First steps
### Linux Debian 1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/stable/getting-started.html) guide
2. To learn Haskell, try any of those:
#### Generic - A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
- An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` 3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
#### Version >= 11 && <= 12
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 12
The following distro packages are required: `build-essential curl libffi-dev libffi8 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 && < 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
### Linux Fedora
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs 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 (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
1. Follow the [First steps guide](../steps) on how to build a "Hello world" program, use `ghc`, run an interactive REPL and create a Haskell project
2. To understand the difference and overlap of `stack` and `cabal`, read on [here](https://gist.github.com/merijn/8152d561fb8b011f9313c48d876ceb07)
3. To learn Haskell proper check out the links at [How to learn Haskell proper](../steps#how-to-learn-haskell-proper)
4. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
## Uninstallation ## Uninstallation
On linux, just run `ghcup nuke`, then make sure any ghcup added lines in your `~/.bashrc` (or similar) are removed. On linux, just run `ghcup nuke`, then make sure any ghcup added lines in your `~/.bashrc` (or similar) are removed.
On windows, right click on the `Uninstall Haskell.ps1` PowerShell script on your Desktop and select *Run with PowerShell*. On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on your Desktop.
## Supported tools ## Supported tools
GHCup supports the following tools, which are also known as the **Haskell Toolchain**: GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
<details> <summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary> <details>
<summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>
<table> <table>
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead> <thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>9.8.1</td><td><span style="color:blue">latest</span>, base-4.19.0.0</td></tr>
<tr><td>9.6.3</td><td>base-4.18.1.0</td></tr>
<tr><td>9.6.2</td><td>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><span style="color:green">recommended</span>, 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.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>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.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>
<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
<tr><td>8.10.7</td><td>base-4.14.3.0</td></tr>
<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr> <tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
</tbody> </tbody>
</table> </table>
</details> </details>
<details> <summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary> <details>
<table> <summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
<table>
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead> <thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>3.10.2.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.10.1.0</td><td></td></tr>
<tr><td>3.8.1.0</td><td></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>
<tr><td>3.4.0.0</td><td></td></tr>
<tr><td>3.2.0.0</td><td></td></tr>
<tr><td>3.0.0.0</td><td></td></tr>
<tr><td>2.4.1.0</td><td></td></tr> <tr><td>2.4.1.0</td><td></td></tr>
<tr><td>3.0.0.0</td><td></td></tr>
<tr><td>3.2.0.0</td><td></td></tr>
<tr><td>3.4.0.0</td><td></td></tr>
<tr><td>3.4.1.0</td><td></td></tr>
<tr><td>3.6.0.0</td><td></td></tr>
<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
</tbody> </tbody>
</table> </table>
</details> </details>
<details> <summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary> <details>
<summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
<table> <table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead> <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.3.0.0</td><td></td></tr>
<tr><td>2.2.0.0</td><td></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.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>
<tr><td>1.5.1</td><td></td></tr>
<tr><td>1.5.0</td><td></td></tr>
<tr><td>1.4.0</td><td></td></tr>
<tr><td>1.3.0</td><td></td></tr>
<tr><td>1.2.0</td><td></td></tr>
<tr><td>1.1.0</td><td></td></tr> <tr><td>1.1.0</td><td></td></tr>
<tr><td>1.2.0</td><td></td></tr>
<tr><td>1.3.0</td><td></td></tr>
<tr><td>1.4.0</td><td></td></tr>
<tr><td>1.5.0</td><td></td></tr>
<tr><td>1.5.1</td><td></td></tr>
<tr><td>1.6.0.0</td><td></td></tr>
<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
</tbody> </tbody>
</table> </table>
</details> </details>
<details> <summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary> <details>
<summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
<table> <table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead> <thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>2.13.1</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>2.11.1</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>2.9.3</td><td></td></tr>
<tr><td>2.9.1</td><td></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>
<tr><td>2.5.1</td><td></td></tr> <tr><td>2.5.1</td><td></td></tr>
<tr><td>2.7.1</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr>
<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
</tbody> </tbody>
</table> </table>
</details> </details>
@@ -253,9 +139,9 @@ 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. 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 8.1 | amd64 | | ✅ | ✅ | ✅ | ✅ | | Windows 7 | amd64 | | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ | | Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ | | Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ | | Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
@@ -271,11 +157,12 @@ This list may not be exhaustive and specifies support for bindists only.
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ | | Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ | | Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
### Windows <8.1 ### Windows 7
No longer supported for recent GHCs, according to manual testing of GHC 9.8.1 on Windows 7. May or may not work, several issues:
According to [msys2 documentation](https://www.msys2.org/docs/windows_support), the minimum Windows
version is now 8.1. * [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
### WSL1 ### WSL1
@@ -293,29 +180,19 @@ There are various issues with GHC itself.
### FreeBSD ### 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. HLS bindists are experimental.
Only latest FreeBSD is generally supported.
### Linux ARMv7/AARCH64 ### Linux ARMv7/AARCH64
Lower availability of bindists. Stack and HLS binaries are experimental. Lower availability of bindists. Stack and HLS binaries are experimental.
## Manual installation ## Manual install
### Unix
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/) Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere. and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following keys first: If you want to GPG verify the binaries, import the following key first: `7784930957807690A66EBDBE3786C5262ECB4A3F`.
```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
```
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so: Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
@@ -323,96 +200,14 @@ Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) lik
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH" 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 ## Vim integration
See [ghcup.vim](https://github.com/hasufell/ghcup.vim). See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
## VSCode integration
The developers of the Haskell Language Server offer an [extension](https://github.com/haskell/vscode-haskell) tightly integrated with the [Haskell Language Server](https://github.com/haskell/haskell-language-server). To get started:
1. Install GHCup. During installation, opt in to install the Haskell Language Server (HLS).
2. Install the extension (from VSCode: Ctrl + P and then `ext install haskell.haskell`).
3. Make sure your project uses the GHC version installed from GHCup (otherwise HLS is likely to fail on launch):
- instructions for [stack](https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc)
On Linux, some users have reported an issue when VSCode is not launched from a terminal ("cannot find ghc version"). A solution is to [let HLS know about your GHCup on $PATH](https://github.com/haskell/vscode-haskell#stackcabalghc-can-not-be-found).
## Get help ## Get help
* [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup) * [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
* [GHCup issue tracker](https://github.com/haskell/ghcup-hs/issues/new) * [GHCup issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/issues)
* [Matrix](https://app.element.io/#/room/#haskell-tooling:matrix.org) * [Matrix](https://app.element.io/#/room/#haskell-tooling:matrix.org)
* [Discord](https://discord.gg/pKYf3zDQU7) * [Discord](https://discord.gg/pKYf3zDQU7)

File diff suppressed because it is too large Load Diff

Before

Width:  |  Height:  |  Size: 27 KiB

After

Width:  |  Height:  |  Size: 32 KiB

File diff suppressed because it is too large Load Diff

Before

Width:  |  Height:  |  Size: 28 KiB

After

Width:  |  Height:  |  Size: 33 KiB

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

@@ -1,349 +0,0 @@
# First steps
In this guide we'll take a look at a few core tools that are installed
with the Haskell toolchain, namely, `ghc`, `runghc` and `ghci`.
These tools can be used to compile, interpret or explore Haskell programs.
First, let's start by opening your system's command line interface
and running `ghc --version` to make sure we have successfully
installed a Haskell toolchain:
```
➜ ghc --version
The Glorious Glasgow Haskell Compilation System, version 8.10.7
```
If this fails, consult [the Getting started page](../install) for information on
how to install Haskell on your computer.
This guide is partly based on [Gil Mizrahi's blog](https://gilmi.me/blog/post/2021/08/14/hs-core-tools).
## Compiling programs with ghc
Running `ghc` invokes the Glasgow Haskell Compiler (GHC), and can be used to
compile Haskell modules and programs into native executables and libraries.
Create a new Haskell source file named `hello.hs`,
and write the following code in it:
```hs
main = putStrLn "Hello, Haskell!"
```
Now, we can compile the program by invoking `ghc` with the file name:
```sh
➜ ghc hello.hs
[1 of 1] Compiling Main ( hello.hs, hello.o )
Linking hello ...
```
For more in-depth information about the files `ghc` produces,
follow the [GHC user guide](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/using.html#getting-started-compiling-programs) guide.
Now we run our program:
```sh
➜ ./hello
Hello, Haskell!
```
Alternatively, we can skip the compilation phase by using the command `runghc`:
```sh
➜ runghc hello.hs
Hello, Haskell!
```
`runghc` interprets the source file instead of compiling it and does not
create build artifacts. This makes it very useful when developing programs
and can help accelerate the feedback loop. More information about `runghc`
can be found in the
[GHC user guide](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/runghc.html).
### Turning on warnings
The `-Wall` flag will enable GHC to emit warnings about our code.
```sh
➜ ghc -Wall hello.hs -fforce-recomp
[1 of 1] Compiling Main ( hello.hs, hello.o )
hello.hs:1:1: warning: [-Wmissing-signatures]
Top-level binding with no type signature: main :: IO ()
|
1 | main = putStrLn "Hello, Haskell!"
| ^^^^
Linking hello ...
```
While Haskell can infer
the types of most expressions, it is recommended that top-level definitions
are annotated with their types.
Now our `hello.hs` source file should looks like this:
```hs
main :: IO ()
main = putStrLn "Hello, world!"
```
And now GHC will compile `hello.hs` without warnings.
## An interactive environment
GHC provides an interactive environment in a form of a
Read-Evaluate-Print Loop (REPL) called GHCi.
To enter the environment run the program `ghci`.
```sh
➜ ghci
GHCi, version 9.0.2: https://www.haskell.org/ghc/ :? for help
ghci>
```
It provides an interactive prompt where Haskell expressions can be written and
evaluated.
For example:
```sh
ghci> 1 + 1
2
ghci> putStrLn "Hello, world!"
Hello, world!
```
We can define new names:
```sh
ghci> double x = x + x
ghci> double 2
4
```
We can write multi-line code by surrounding it with `:{` and `:}`:
```hs
ghci> :{
| map f list =
| case list of
| [] -> []
| x : xs -> f x : map f xs
| :}
ghci> map (+1) [1, 2, 3]
[2,3,4]
```
We can import Haskell source files using the `:load` command (`:l` for short):
```sh
ghci> :load hello.hs
[1 of 1] Compiling Main ( hello.hs, interpreted )
Ok, one module loaded.
ghci> main
Hello, Haskell!
```
As well as import library modules:
```sh
ghci> import Data.Bits
ghci> shiftL 32 1
64
ghci> clearBit 33 0
32
```
We can even ask what the type of an expression is using the `:type` command
(`:t` for short):
```sh
λ> :type putStrLn
putStrLn :: String -> IO ()
```
To exit `ghci`, use the `:quit` command (or `:q` for short)
```sh
ghci> :quit
Leaving GHCi.
```
A more thorough introduction to GHCi can be found in the
[GHC user guide](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html).
### Using external packages in ghci
By default, GHCi can only load and use packages that are
[included with the GHC installation](https://downloads.haskell.org/ghc/9.4.2/docs/users_guide/9.4.2-notes.html#included-libraries).
However, users of the [cabal-install](https://www.haskell.org/cabal) and
[stack](http://haskellstack.org) build tools can download and load external packages
very easily using the following commands:
cabal-install:
```sh
cabal repl --build-depends async,say
```
Stack:
```sh
stack exec --package async --package say -- ghci
```
And the modules of the relevant packages will be available for import:
```sh
GHCi, version 9.0.1: https://www.haskell.org/ghc/ :? for help
ghci> import Control.Concurrent.Async
ghci> import Say
ghci> concurrently_ (sayString "Hello") (sayString "World")
Hello
World
```
Stack users can also use this feature with `runghc` and `ghc` by replacing
`ghci` in the command above, and cabal-install users can generate an
environment file that will make `async` and `say` visible for GHC tools
in the current directory using this command:
```sh
cabal install --lib async say --package-env .
```
Many more packages are waiting for you on [Hackage](https://hackage.haskell.org).
## Creating a proper package with modules
The previous methods to compile Haskell code are for quick experiments and small
programs. Usually in Haskell, we create cabal projects, where build tools such as
`cabal-install` or `stack` will install necessary dependencies and compile modules
in correct order. For simplicity's sake, this section will only use `cabal-install`.
To get started, run:
```sh
mkdir haskell-project
cd haskell-project
cabal init --interactive
```
If you let it generate a simple project with sensible defaults, then you should have these files:
* `src/MyLib.hs`: the library module of your project
* `app/Main.hs`: the entry point of your project
* `haskell-project.cabal`: the "cabal" file, describing your project, its dependencies and how it's built
To build the project, run:
```sh
cabal build
```
To run the main executable, run:
```sh
➜ cabal run
Hello, Haskell!
someFunc
```
### Adding dependencies
Now let's add a dependency and adjust our library module. Open `haskell-project.cabal`
and find the library section:
```
library
exposed-modules: MyLib
-- Modules included in this library but not exported.
-- other-modules:
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
build-depends: base ^>=4.14.3.0
hs-source-dirs: src
default-language: Haskell2010
```
The interesting parts here are `exposed-modules` and `build-depends`.
To add a dependency, it should look like this:
```
build-depends: base ^>=4.14.3.0
, directory
```
Now open `src/MyLib.hs` and change it to:
```hs
module MyLib (someFunc) where
import System.Directory
someFunc :: IO ()
someFunc = do
contents <- listDirectory "src"
putStrLn (show contents)
```
### Adding modules
To add a module to your package, adjust `exposed-modules`, like so
```
exposed-modules: MyLib
OtherLib
```
then create `src/OtherLib.hs` with the following contents:
```hs
module OtherLib where
otherFunc :: String -> Int
otherFunc str = length str
```
To use this function interactively, we can run:
```sh
➜ cabal repl
ghci> import OtherLib
ghci> otherFunc "Hello Haskell"
13
```
For further information about how to manage Haskell projects
see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-started.html).
# Where to go from here
<div class="text-center main-buttons">
<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>
</div>
## How to learn Haskell proper
To learn Haskell, try any of those:
- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Dmitrii Kovanikov](https://kodimensional.dev/))
- An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
## Projects to contribute to
* [https://github.com/haskell/haskell-language-server](https://github.com/haskell/haskell-language-server)
* [https://github.com/haskell/cabal](https://github.com/haskell/cabal)
* [https://github.com/commercialhaskell/stack](https://github.com/commercialhaskell/stack)
* [https://github.com/haskell/ghcup-hs](https://github.com/haskell/ghcup-hs)
* [https://github.com/jgm/pandoc](https://github.com/jgm/pandoc)
* [https://github.com/simonmichael/hledger](https://github.com/simonmichael/hledger)
* [https://github.com/koalaman/shellcheck](https://github.com/koalaman/shellcheck)

View File

@@ -1,13 +1,13 @@
cabal-version: 2.4 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.20.0 version: 0.1.17.6
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
maintainer: hasufell@posteo.de maintainer: hasufell@posteo.de
author: Julian Ospald author: Julian Ospald
homepage: https://github.com/haskell/ghcup-hs homepage: https://gitlab.haskell.org/haskell/ghcup-hs
bug-reports: https://github.com/haskell/ghcup-hs/issues/ bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
synopsis: ghc toolchain installer synopsis: ghc toolchain installer
description: description:
A rewrite of the shell script ghcup, for providing A rewrite of the shell script ghcup, for providing
@@ -21,22 +21,17 @@ extra-doc-files:
README.md README.md
extra-source-files: extra-source-files:
cbits/dirutils.c
cbits/dirutils.h
data/build_mk/cross data/build_mk/cross
data/build_mk/default data/build_mk/default
test/ghcup-test/data/dir/.keep test/golden/GHCupInfo.json
test/ghcup-test/data/file
test/ghcup-test/golden/unix/GHCupInfo.json
test/ghcup-test/golden/windows/GHCupInfo.json
source-repository head source-repository head
type: git type: git
location: https://github.com/haskell/ghcup-hs.git location: https://gitlab.haskell.org/haskell/ghcup-hs.git
flag tui flag tui
description: description:
Build the brick powered tui (ghcup tui). Build the brick powered tui (ghcup tui). This is disabled on windows.
default: False default: False
manual: True manual: True
@@ -49,79 +44,38 @@ flag internal-downloader
manual: True manual: True
flag no-exe flag no-exe
description: Don't build any executables description: Don't build any executables
default: False default: False
manual: True manual: True
common app-common-depends flag disable-upgrade
build-depends: description:
, aeson >=1.4 Disable upgrade functionality. This is mainly to support brew packagers.
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3 default: False
, base >=4.12 && <5 manual: True
, 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 && <0.14
, versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0
library library
exposed-modules: exposed-modules:
GHCup GHCup
GHCup.Cabal
GHCup.Download GHCup.Download
GHCup.Download.Utils GHCup.Download.Utils
GHCup.Errors GHCup.Errors
GHCup.GHC
GHCup.HLS
GHCup.List
GHCup.Platform GHCup.Platform
GHCup.Prelude
GHCup.Prelude.File
GHCup.Prelude.File.Search
GHCup.Prelude.Internal
GHCup.Prelude.Logger
GHCup.Prelude.Logger.Internal
GHCup.Prelude.MegaParsec
GHCup.Prelude.Process
GHCup.Prelude.String.QQ
GHCup.Prelude.Version.QQ
GHCup.Prompts
GHCup.Requirements GHCup.Requirements
GHCup.Stack
GHCup.Types GHCup.Types
GHCup.Types.JSON GHCup.Types.JSON
GHCup.Types.JSON.Utils GHCup.Types.JSON.Utils
GHCup.Types.JSON.Versions
GHCup.Types.Optics GHCup.Types.Optics
GHCup.Types.Stack
GHCup.Utils GHCup.Utils
GHCup.Utils.Dirs GHCup.Utils.Dirs
GHCup.Utils.File
GHCup.Utils.File.Common
GHCup.Utils.Logger
GHCup.Utils.MegaParsec
GHCup.Utils.Prelude
GHCup.Utils.String.QQ
GHCup.Utils.Version.QQ
GHCup.Version GHCup.Version
hs-source-dirs: lib hs-source-dirs: lib
@@ -153,8 +107,8 @@ library
, base >=4.12 && <5 , base >=4.12 && <5
, base16-bytestring >=0.1.1.6 && <1.1 , base16-bytestring >=0.1.1.6 && <1.1
, binary ^>=0.8.6.0 , binary ^>=0.8.6.0
, bytestring >=0.10 && <0.12 , bytestring ^>=0.10
, Cabal ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 , Cabal ^>=3.6.2.0
, case-insensitive ^>=1.2.1.0 , case-insensitive ^>=1.2.1.0
, casing ^>=0.1.4.1 , casing ^>=0.1.4.1
, containers ^>=0.6 , containers ^>=0.6
@@ -162,7 +116,6 @@ library
, deepseq ^>=1.4.4.0 , deepseq ^>=1.4.4.0
, directory ^>=1.3.6.0 , directory ^>=1.3.6.0
, disk-free-space ^>=0.1.0.1 , disk-free-space ^>=0.1.0.1
, exceptions ^>=0.10
, filepath ^>=1.4.2.1 , filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5 , haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1 , haskus-utils-variant ^>=3.2.1
@@ -176,22 +129,21 @@ library
, pretty-terminal ^>=0.1.0.0 , pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96 , regex-posix ^>=0.96
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, retry >=0.8.1.2 && <0.10 , retry ^>=0.8.1.2
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, split ^>=0.2.3.4 , split ^>=0.2.3.4
, streamly ^>=0.8.2
, strict-base ^>=0.4 , strict-base ^>=0.4
, template-haskell >=2.7 && <2.20 , template-haskell >=2.7 && <2.18
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=2.0 , text ^>=1.2.4.0
, time >=1.9.3 && <1.12 , time ^>=1.9.3
, transformers ^>=0.5 , transformers ^>=0.5
, unliftio-core ^>=0.2.0.1 , unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, vector >=0.12 && <0.14 , vector ^>=0.12
, versions >=6.0.3 && <6.1 , versions >=4.0.1 && <5.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2 , zlib ^>=0.6.2.2
@@ -200,49 +152,42 @@ library
exposed-modules: GHCup.Download.IOStreams exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
build-depends: build-depends:
, HsOpenSSL >=0.11.7.2 , HsOpenSSL >=0.11.4.18
, http-io-streams >=0.1.2.0 , http-io-streams >=0.1.2.0
, io-streams >=1.5.2.1 , io-streams >=1.5.2.1
, terminal-progress-bar >=0.4.1 , terminal-progress-bar >=0.4.1
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
other-modules: other-modules:
GHCup.Prelude.File.Windows GHCup.Utils.File.Windows
GHCup.Prelude.Windows GHCup.Utils.Prelude.Windows
GHCup.Utils.Windows
-- GHCup.OptParse.Run uses this
exposed-modules: GHCup.Prelude.Process.Windows
build-depends: build-depends:
, bzlib , bzlib
, process ^>=1.6.11.0 , process ^>=1.6.11.0
, Win32 >=2.10 , Win32 ^>=2.10
else else
other-modules: other-modules:
GHCup.Prelude.File.Posix GHCup.Utils.File.Posix
GHCup.Prelude.File.Posix.Foreign GHCup.Utils.Posix
GHCup.Prelude.Posix GHCup.Utils.Prelude.Posix
GHCup.Prelude.Process.Posix
exposed-modules: GHCup.Prelude.File.Posix.Traversals
include-dirs: cbits
includes: dirutils.h
install-includes: dirutils.h
c-sources: cbits/dirutils.c
build-depends: build-depends:
, bz2 >=0.5.0.5 && <1.1 , bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.3 , terminal-size ^>=0.3.2.1
, unix ^>=2.7 , unix ^>=2.7
, unix-bytestring ^>=0.3.7.3 , unix-bytestring ^>=0.3.7.3
if flag(tui) if (flag(tui) && !os(windows))
cpp-options: -DBRICK cpp-options: -DBRICK
build-depends: vty ^>=6.0 build-depends: vty >=5.28.2 && <5.34
library ghcup-optparse executable ghcup
import: app-common-depends main-is: Main.hs
exposed-modules: other-modules:
GHCup.OptParse GHCup.OptParse
GHCup.OptParse.ChangeLog GHCup.OptParse.ChangeLog
GHCup.OptParse.Common GHCup.OptParse.Common
@@ -257,46 +202,10 @@ library ghcup-optparse
GHCup.OptParse.Rm GHCup.OptParse.Rm
GHCup.OptParse.Run GHCup.OptParse.Run
GHCup.OptParse.Set GHCup.OptParse.Set
GHCup.OptParse.Test
GHCup.OptParse.ToolRequirements GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis 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)
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 hs-source-dirs: app/ghcup
default-language: Haskell2010 default-language: Haskell2010
default-extensions: default-extensions:
@@ -314,21 +223,50 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded -fwarn-incomplete-record-updates -threaded
build-depends: build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring ^>=0.10
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, ghcup , ghcup
, ghcup-optparse , 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) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
if flag(tui) if (flag(tui) && !os(windows))
cpp-options: -DBRICK cpp-options: -DBRICK
other-modules: BrickMain other-modules: BrickMain
build-depends: build-depends:
, brick ^>=2.1 , brick ^>=0.64
, transformers ^>=0.5 , transformers ^>=0.5
, vty ^>=6.0
, unix ^>=2.7 , unix ^>=2.7
, optics ^>=0.4 , vty >=5.28.2 && <5.34
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
@@ -339,16 +277,20 @@ executable ghcup
if flag(no-exe) if flag(no-exe)
buildable: False buildable: False
if flag(disable-upgrade)
cpp-options: -DDISABLE_UPGRADE
else
other-modules: GHCup.OptParse.Upgrade
test-suite ghcup-test test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs
build-tool-depends: hspec-discover:hspec-discover -any build-tool-depends: hspec-discover:hspec-discover -any
hs-source-dirs: test/ghcup-test hs-source-dirs: test
other-modules: other-modules:
GHCup.ArbitraryTypes GHCup.ArbitraryTypes
GHCup.Prelude.File.Posix.TraversalsSpec
GHCup.Types.JSONSpec GHCup.Types.JSONSpec
GHCup.Utils.FileSpec
Spec Spec
default-language: Haskell2010 default-language: Haskell2010
@@ -366,61 +308,14 @@ test-suite ghcup-test
build-depends: build-depends:
, base >=4.12 && <5 , base >=4.12 && <5
, bytestring >=0.10 && <0.12 , bytestring ^>=0.10
, containers ^>=0.6 , containers ^>=0.6
, directory ^>=1.3.6.0 , generic-arbitrary >=0.1.0 && <0.3
, filepath ^>=1.4.2.1
, generic-arbitrary >=0.1.0 && <0.2.1 || >=0.2.2 && <0.3
, ghcup , ghcup
, hspec >=2.7.10 && <2.11 , hspec >=2.7.10 && <2.10
, hspec-golden-aeson ^>=0.9 , hspec-golden-aeson ^>=0.9
, QuickCheck ^>=2.14.1 , QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0 , quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2 , text ^>=1.2.4.0
, text ^>=2.0
, time >=1.9.3 && <1.12
, uri-bytestring ^>=0.3.2.2 , 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

View File

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

View File

@@ -1,509 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Run where
import GHCup
import GHCup.Utils
import GHCup.OptParse.Common
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Prelude
import GHCup.Prelude.File
#ifdef IS_WINDOWS
import GHCup.Prelude.Process
import GHCup.Prelude.Process.Windows ( execNoMinGW )
#endif
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Control.Exception.Safe ( MonadMask, MonadCatch )
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Codec.Archive
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe (isNothing)
import Data.List ( intercalate )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.FilePath
import System.Environment
import System.Exit
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
#ifndef IS_WINDOWS
import qualified System.Posix.Process as SPP
#endif
import Data.Versions ( prettyVer, Version )
---------------
--[ Options ]--
---------------
data RunOptions = RunOptions
{ runAppendPATH :: Bool
, runInstTool' :: Bool
, runMinGWPath :: Bool
, runGHCVer :: Maybe ToolVersion
, runCabalVer :: Maybe ToolVersion
, runHLSVer :: Maybe ToolVersion
, runStackVer :: Maybe ToolVersion
, runBinDir :: Maybe FilePath
, runQuick :: Bool
, runCOMMAND :: [String]
} deriving (Eq, Show)
---------------
--[ Parsers ]--
---------------
runOpts :: Parser RunOptions
runOpts =
RunOptions
<$> switch
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
<*> switch
(short 'i' <> long "install" <> help "Install the tool, if missing")
<*> switch
(short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
<*> optional
(option
(eitherReader ghcVersionTagEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC [])
<> (completer $ versionCompleter [] GHC)
)
)
<*> optional
(option
(eitherReader toolVersionTagEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter [] Cabal)
)
)
<*> optional
(option
(eitherReader toolVersionTagEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS [])
<> (completer $ versionCompleter [] HLS)
)
)
<*> optional
(option
(eitherReader toolVersionTagEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack [])
<> (completer $ versionCompleter [] Stack)
)
)
<*> optional
(option
(eitherReader isolateParser)
( short 'b'
<> long "bindir"
<> metavar "DIR"
<> help "directory where to create the tool symlinks (default: newly created system temp dir)"
<> completer (bashCompleter "directory")
)
)
<*> 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."))
--------------
--[ Footer ]--
--------------
runFooter :: String
runFooter = [s|Discussion:
Adds the given tools to a dedicated bin/ directory and adds them to PATH, exposing
the relevant binaries, then executes a command.
Examples:
# run VSCode with all latest toolchain exposed, installing missing versions if necessary
ghcup run --ghc latest --cabal latest --hls latest --stack latest --install -- code Setup.hs
# create a custom toolchain bin/ dir with GHC and cabal that can be manually added to PATH
ghcup run --ghc 8.10.7 --cabal 3.2.0.0 --bindir $HOME/toolchain/bin
# run a specific ghc version
ghcup run --ghc 8.10.7 -- ghc --version|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type RunEffects = '[ AlreadyInstalled
, UnknownArchive
, ArchiveResult
, FileDoesNotExistError
, CopyError
, NotInstalled
, DirNotEmpty
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, TarDirDoesNotExist
, NextVerNotFound
, NoToolVersionSet
, FileAlreadyExistsError
, ProcessError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
=> LeanAppState
-> Excepts RunEffects (ReaderT LeanAppState m) a
-> m (VEither RunEffects a)
runLeanRUN leanAppstate =
-- Don't use runLeanAppState here, which is disabled on windows.
-- This is the only command on all platforms that doesn't need full appstate.
flip runReaderT leanAppstate
. runE
@RunEffects
runRUN :: MonadUnliftIO m
=> IO AppState
-> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither RunEffects a)
runRUN appState action' = do
s' <- liftIO appState
flip runReaderT s'
. runResourceT
. runE
@RunEffects
$ action'
------------------
--[ Entrypoint ]--
------------------
run :: forall m .
( MonadFail m
, MonadMask m
, MonadCatch m
, MonadIO m
, MonadUnliftIO m
, Alternative m
)
=> RunOptions
-> IO AppState
-> LeanAppState
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
run RunOptions{..} runAppState leanAppstate runLogger = do
r <- if not runQuick
then runRUN runAppState $ do
toolchain <- liftE resolveToolchainFull
-- oh dear
r <- lift ask
tmp <- lift . lift . lift . flip runReaderT (fromAppState r) $ createTmpDir toolchain
liftE $ installToolChainFull toolchain tmp
pure tmp
else runLeanRUN leanAppstate $ do
toolchain <- resolveToolchain
tmp <- lift $ createTmpDir toolchain
liftE $ installToolChain toolchain tmp
pure tmp
case r of
VRight tmp -> do
case runCOMMAND of
[] -> do
liftIO $ putStr tmp
pure ExitSuccess
(cmd:args) -> do
newEnv <- liftIO $ addToPath [tmp] runAppendPATH
let pathVar = if isWindows then "Path" else "PATH"
forM_ (Map.lookup pathVar . Map.fromList $ newEnv) $ liftIO . setEnv pathVar
#ifndef IS_WINDOWS
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
pure ExitSuccess
#else
r' <- if runMinGWPath
then runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
else runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ execNoMinGW cmd args Nothing (Just newEnv)
case r' of
VRight _ -> pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 28
#endif
VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 27
where
-- TODO: doesn't work for cross
resolveToolchainFull :: ( MonadFail m
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] (ResourceT (ReaderT AppState m)) Toolchain
resolveToolchainFull = do
ghcVer <- forM runGHCVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) GHC
pure v
cabalVer <- forM runCabalVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Cabal
pure (_tvVersion v)
hlsVer <- forM runHLSVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) HLS
pure (_tvVersion v)
stackVer <- forM runStackVer $ \ver -> do
(v, _) <- liftE $ fromVersion (Just ver) Stack
pure (_tvVersion v)
pure Toolchain{..}
resolveToolchain = do
ghcVer <- case runGHCVer of
Just (GHCVersion v) -> pure $ Just v
Just (ToolVersion v) -> pure $ Just (mkTVer v)
Nothing -> pure Nothing
_ -> fail "Internal error"
cabalVer <- case runCabalVer of
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
hlsVer <- case runHLSVer of
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
stackVer <- case runStackVer of
Just (GHCVersion v) -> pure $ Just (_tvVersion v)
Just (ToolVersion v) -> pure $ Just v
Nothing -> pure Nothing
_ -> fail "Internal error"
pure Toolchain{..}
installToolChainFull :: ( MonadFail m
, MonadThrow m
, MonadIO m
, MonadCatch m
, Alternative m
)
=> Toolchain
-> FilePath
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, UnknownArchive
, TarDirDoesNotExist
, ProcessError
, NotInstalled
, NoDownload
, GPGError
, DownloadFailed
, DirNotEmpty
, DigestError
, ContentLengthError
, BuildFailed
, ArchiveResult
, AlreadyInstalled
, FileAlreadyExistsError
, CopyError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
] (ResourceT (ReaderT AppState m)) ()
installToolChainFull Toolchain{..} tmp = do
case ghcVer of
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' GHC v
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
v
GHCupInternal
False
[]
setGHC' v tmp
_ -> pure ()
case cabalVer of
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' Cabal (mkTVer v)
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
v
GHCupInternal
False
setCabal' v tmp
_ -> pure ()
case stackVer of
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' Stack (mkTVer v)
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
v
GHCupInternal
False
setStack' v tmp
_ -> pure ()
case hlsVer of
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' HLS (mkTVer v)
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
v
GHCupInternal
False
setHLS' v tmp
_ -> pure ()
installToolChain :: ( MonadFail m
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Toolchain
-> FilePath
-> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
installToolChain Toolchain{..} tmp = do
case ghcVer of
Just v -> setGHC' v tmp
_ -> pure ()
case cabalVer of
Just v -> setCabal' v tmp
_ -> pure ()
case stackVer of
Just v -> setStack' v tmp
_ -> pure ()
case hlsVer of
Just v -> setHLS' v tmp
_ -> pure ()
setGHC' v tmp = do
void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
void $ liftE $ setGHC v SetGHCOnly (Just tmp)
setCabal' v tmp = do
bin <- liftE $ whereIsTool Cabal (mkTVer v)
cbin <- liftIO $ canonicalizePath bin
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
setStack' v tmp = do
bin <- liftE $ whereIsTool Stack (mkTVer v)
cbin <- liftIO $ canonicalizePath bin
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
setHLS' v tmp = do
Dirs {..} <- getDirs
legacy <- isLegacyHLS v
if legacy
then do
-- TODO: factor this out
hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? (NotInstalled HLS (mkTVer v))
cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
forM_ hlsBins $ \bin ->
lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
liftE $ setHLS v SetHLSOnly (Just tmp)
else do
liftE $ setHLS v SetHLS_XYZ (Just tmp)
liftE $ setHLS v SetHLSOnly (Just tmp)
createTmpDir :: ( MonadUnliftIO m
, MonadCatch m
, MonadThrow m
, MonadMask m
, MonadIO m
)
=> Toolchain
-> ReaderT LeanAppState m FilePath
createTmpDir toolchain =
case runBinDir of
Just bindir -> do
liftIO $ createDirRecursive' bindir
liftIO $ canonicalizePath bindir
Nothing -> do
d <- predictableTmpDir toolchain
liftIO $ createDirRecursive' d
liftIO $ canonicalizePath d
predictableTmpDir :: Monad m
=> Toolchain
-> ReaderT LeanAppState m FilePath
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) = do
Dirs { tmpDir } <- getDirs
pure (fromGHCupPath tmpDir </> "ghcup-none")
predictableTmpDir Toolchain{..} = do
Dirs { tmpDir } <- getDirs
pure $ fromGHCupPath tmpDir
</> ("ghcup-" <> intercalate "_"
( maybe [] ( (:[]) . ("ghc-" <>) . T.unpack . tVerToText) ghcVer
<> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . prettyVer) cabalVer
<> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . prettyVer) hlsVer
<> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . prettyVer) stackVer
)
)
-------------------------
--[ Other local types ]--
-------------------------
data Toolchain = Toolchain
{ ghcVer :: Maybe GHCTargetVersion
, cabalVer :: Maybe Version
, hlsVer :: Maybe Version
, stackVer :: Maybe Version
} deriving Show

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

File diff suppressed because it is too large Load Diff

View File

@@ -1,286 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Cabal
Description : GHCup installation functions for Cabal
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Cabal where
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
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
import Optics
import Prelude hiding ( abs
, writeFile
)
import Safe hiding ( at )
import System.FilePath
import System.IO.Error
import qualified Data.Text as T
-------------------------
--[ Tool installation ]--
-------------------------
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installCabalBindist :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> InstallDir
-> Bool -- ^ Force install
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installCabalBindist dlinfo ver installDir forceInstall = do
lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs
-- check if we already have a regular cabal already installed
regularCabalInstalled <- lift $ cabalInstalled ver
if
| not forceInstall
, regularCabalInstalled
, GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled Cabal ver
| forceInstall
, regularCabalInstalled
, GHCupInternal <- installDir -> do
lift $ logInfo "Removing the currently installed version first!"
liftE $ rmCabalVer ver
| otherwise -> pure ()
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-- the subdir of the archive where we do the work
workdir <- fromGHCupPath <$> maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
case installDir of
IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
liftE $ installCabalUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
GHCupInternal -> do -- regular install
liftE $ installCabalUnpacked workdir (GHCupBinDir binDir) ver forceInstall
-- | Install an unpacked cabal distribution.Symbol
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> InstallDirResolved -- ^ Path to install to
-> Version
-> Bool -- ^ Force Install
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst ver forceInstall = do
lift $ logInfo "Installing cabal"
let cabalFile = "cabal"
liftIO $ createDirRecursive' (fromInstallDir inst)
let destFileName = cabalFile
<> (case inst of
IsolateDirResolved _ -> ""
_ -> ("-" <>) . T.unpack . prettyVer $ ver
)
<> exeExt
let destPath = fromInstallDir inst </> destFileName
copyFileE
(path </> cabalFile <> exeExt)
destPath
(not forceInstall)
lift $ chmod_755 destPath
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
-- the latest installed version.
installCabalBin :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Version
-> InstallDir
-> Bool -- force install
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installCabalBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo ver installDir forceInstall
-----------------
--[ Set cabal ]--
-----------------
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
setCabal :: ( MonadMask m
, MonadReader env m
, HasDirs env
, HasLog env
, MonadFail m
, MonadIO m
, MonadUnliftIO m)
=> Version
-> Excepts '[NotInstalled] m ()
setCabal ver = do
let targetFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
-- symlink destination
Dirs {..} <- lift getDirs
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
$ throwE
$ NotInstalled Cabal (GHCTargetVersion Nothing ver)
let cabalbin = binDir </> "cabal" <> exeExt
-- create link
let destL = targetFile
lift $ createLink destL cabalbin
liftIO (isShadowed cabalbin) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa cabalbin ver)
pure ()
unsetCabal :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadIO m)
=> m ()
unsetCabal = do
Dirs {..} <- getDirs
let cabalbin = binDir </> "cabal" <> exeExt
hideError doesNotExistErrorType $ rmLink cabalbin
----------------
--[ Rm cabal ]--
----------------
-- | Delete a cabal version. Will try to fix the @cabal@ symlink
-- after removal (e.g. setting it to an older version).
rmCabalVer :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadFail m
, MonadCatch m
, MonadUnliftIO m
)
=> Version
-> Excepts '[NotInstalled] m ()
rmCabalVer ver = do
whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (GHCTargetVersion Nothing ver))
cSet <- lift cabalSet
Dirs {..} <- lift getDirs
let cabalFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
lift $ hideError doesNotExistErrorType $ recycleFile (binDir </> cabalFile)
when (Just ver == cSet) $ do
cVers <- lift $ fmap rights getInstalledCabals
case headMay . sortBy (comparing Down) $ cVers of
Just latestver -> setCabal latestver
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-| {-|
Module : GHCup.Download Module : GHCup.Download
Description : Downloading Description : Downloading
@@ -30,15 +31,12 @@ import GHCup.Download.Utils
#endif #endif
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import qualified GHCup.Types.Stack as Stack
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Platform import GHCup.Utils.File
import GHCup.Prelude import GHCup.Utils.Logger
import GHCup.Prelude.File import GHCup.Utils.Prelude
import GHCup.Prelude.Logger.Internal
import GHCup.Prelude.Process
import GHCup.Version import GHCup.Version
import Control.Applicative import Control.Applicative
@@ -56,7 +54,6 @@ import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( mk ) import Data.CaseInsensitive ( mk )
#endif #endif
import Data.Maybe import Data.Maybe
import Data.Either
import Data.List import Data.List
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
@@ -72,11 +69,13 @@ import Prelude hiding ( abs
, writeFile , writeFile
) )
import Safe import Safe
import System.Directory
import System.Environment import System.Environment
import System.Exit import System.Exit
import System.FilePath import System.FilePath
import System.IO.Error import System.IO.Error
import System.IO.Temp import System.IO.Temp
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
@@ -114,97 +113,46 @@ getDownloadsF :: ( FromJSONKey Tool
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
) )
=> PlatformRequest => Excepts
-> Excepts '[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
m m
GHCupInfo GHCupInfo
getDownloadsF pfreq@(PlatformRequest arch plat _) = do getDownloadsF = do
Settings { urlSource } <- lift getSettings Settings { urlSource } <- lift getSettings
let newUrlSources = fromURLSource urlSource case urlSource of
infos <- liftE $ mapM dl' newUrlSources GHCupURL -> liftE $ getBase ghcupURL
keys <- if any isRight infos (OwnSource exts) -> do
then liftE . reThrowAll @_ @_ @'[StackPlatformDetectError] StackPlatformDetectError $ getStackPlatformKey pfreq ext <- liftE $ mapM (either pure getBase) exts
else pure [] mergeGhcupInfo ext
ghcupInfos <- fmap catMaybes $ forM infos $ \case (OwnSpec av) -> pure av
Left gi -> pure (Just gi) (AddSource exts) -> do
Right si -> pure $ fromStackSetupInfo si keys base <- liftE $ getBase ghcupURL
mergeGhcupInfo ghcupInfos ext <- liftE $ mapM (either pure getBase) exts
mergeGhcupInfo (base:ext)
where where
dl' :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
, MonadReader env m
, HasSettings env
, HasDirs env
, MonadIO m
, MonadCatch m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> NewURLSource
-> Excepts
'[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError]
m (Either GHCupInfo Stack.SetupInfo)
dl' NewGHCupURL = fmap Left $ liftE (getBase ghcupURL) >>= liftE . decodeMetadata @GHCupInfo
dl' NewStackSetupURL = fmap Right $ liftE (getBase stackSetupURL) >>= liftE . decodeMetadata @Stack.SetupInfo
dl' (NewGHCupInfo gi) = pure (Left gi)
dl' (NewSetupInfo si) = pure (Right si)
dl' (NewURI uri) = do
base <- liftE $ getBase uri
catchE @JSONError (\(JSONDecodeError _) -> do
logDebug $ "Couldn't decode " <> T.pack base <> " as GHCupInfo, trying as SetupInfo: "
Right <$> decodeMetadata @Stack.SetupInfo base)
$ fmap Left (decodeMetadata @GHCupInfo base >>= \gI -> warnOnMetadataUpdate uri gI >> pure gI)
fromStackSetupInfo :: MonadThrow m
=> Stack.SetupInfo
-> [String]
-> m GHCupInfo
fromStackSetupInfo (Stack.siGHCs -> ghcDli) keys = do
let ghcVersionsPerKey = (`M.lookup` ghcDli) <$> (T.pack <$> keys)
ghcVersions = fromMaybe mempty . listToMaybe . catMaybes $ ghcVersionsPerKey
(ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
let ghcupDownloads' = M.singleton GHC (M.map fromDownloadInfo ghcupInfo')
pure (GHCupInfo mempty ghcupDownloads' Nothing)
where
fromDownloadInfo :: DownloadInfo -> VersionInfo
fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
mergeGhcupInfo :: MonadFail m mergeGhcupInfo :: MonadFail m
=> [GHCupInfo] => [GHCupInfo]
-> m GHCupInfo -> m GHCupInfo
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo" mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
mergeGhcupInfo xs@(GHCupInfo{}: _) = mergeGhcupInfo xs@(GHCupInfo{}: _) =
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs) let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
newGlobalTools = M.unionsWith (\_ a2 -> a2 ) (_globalTools <$> xs)
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs) newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
in pure $ GHCupInfo newToolReqs newDownloads Nothing in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
yamlFromCache uri = do yamlFromCache uri = do
Dirs{..} <- getDirs Dirs{..} <- getDirs
pure (fromGHCupPath cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri)) pure (cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri))
etagsFile :: FilePath -> FilePath etagsFile :: FilePath -> FilePath
etagsFile = (<.> "etags") etagsFile = (<.> "etags")
getBase :: forall m env . ( MonadReader env m getBase :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
, MonadFail m , MonadFail m
@@ -214,28 +162,41 @@ getBase :: forall m env . ( MonadReader env m
, MonadMask m , MonadMask m
) )
=> URI => URI
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError] m FilePath -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
getBase uri = do getBase uri = do
Settings { noNetwork, downloader, metaMode } <- lift getSettings Settings { noNetwork, downloader } <- lift getSettings
-- try to download yaml... usually this writes it into cache dir, -- try to download yaml... usually this writes it into cache dir,
-- but in some cases not (e.g. when using file://), so we honour -- but in some cases not (e.g. when using file://), so we honour
-- the return filepath, if any -- the return filepath, if any
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
then pure Nothing then pure Nothing
else handleIO (\e -> case metaMode of else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
Strict -> throwIO e . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
Lax -> lift (warnCache (displayException e) downloader) >> pure Nothing)
. catchE @_ @_ @'[DownloadFailed] (\e@(DownloadFailed _) -> case metaMode of
Strict -> throwE e
Lax -> lift (warnCache (prettyHFError e) downloader) >> pure Nothing)
. fmap Just . fmap Just
. smartDl . smartDl
$ uri $ uri
-- if we didn't get a filepath from the download, use the cached yaml -- if we didn't get a filepath from the download, use the cached yaml
maybe (lift $ yamlFromCache uri) pure mYaml actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE
. onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
. liftIO
. Y.decodeFileEither
$ actualYaml
where where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed.
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do
let efp = etagsFile fp
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
(hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m () warnCache :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> Downloader -> m ()
warnCache s downloader' = do warnCache s downloader' = do
let tryDownloder = case downloader' of let tryDownloder = case downloader' of
@@ -268,7 +229,6 @@ getBase uri = do
-> Excepts -> Excepts
'[ DownloadFailed '[ DownloadFailed
, DigestError , DigestError
, ContentLengthError
, GPGError , GPGError
] ]
m1 m1
@@ -282,7 +242,7 @@ getBase uri = do
Settings { metaCache } <- lift getSettings Settings { metaCache } <- lift getSettings
-- for local files, let's short-circuit and ignore access time -- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing Nothing Nothing (fromGHCupPath cacheDir) Nothing True if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
| e -> do | e -> do
accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -298,77 +258,11 @@ getBase uri = do
where where
dlWithMod modTime json_file = do dlWithMod modTime json_file = do
let (dir, fn) = splitFileName json_file let (dir, fn) = splitFileName json_file
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing dir (Just fn) True
liftIO $ setModificationTime f modTime
-- make these failures non-fatal, also see: liftIO $ setAccessTime f modTime
-- 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
pure f pure f
warnOnMetadataUpdate ::
( MonadReader env m
, MonadIO m
, HasLog env
, HasDirs env
)
=> URI
-> GHCupInfo
-> m ()
warnOnMetadataUpdate uri (GHCupInfo { _metadataUpdate = Just newUri })
| scheme' uri == "file"
, urlBase' uri /= urlBase' newUri = do
confFile <- getConfigFilePath'
logWarn $ "New metadata version detected"
<> "\n old URI: " <> (decUTF8Safe . serializeURIRef') uri
<> "\n new URI: " <> (decUTF8Safe . serializeURIRef') newUri
<> "\nYou might need to update your " <> T.pack confFile
| scheme' uri /= "file"
, uri /= newUri = do
confFile <- getConfigFilePath'
logWarn $ "New metadata version detected"
<> "\n old URI: " <> (decUTF8Safe . serializeURIRef') uri
<> "\n new URI: " <> (decUTF8Safe . serializeURIRef') newUri
<> "\nYou might need to update your " <> T.pack confFile
where
scheme' = view (uriSchemeL' % schemeBSL')
urlBase' = T.unpack . decUTF8Safe . urlBaseName . view pathL'
warnOnMetadataUpdate _ _ = pure ()
decodeMetadata :: forall j m env .
( MonadReader env m
, HasDirs env
, HasSettings env
, MonadFail m
, MonadIO m
, MonadCatch m
, HasLog env
, MonadMask m
, FromJSON j
)
=> FilePath
-> Excepts '[JSONError, FileDoesNotExistError] m j
decodeMetadata actualYaml = do
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE
. onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
. liftIO
. Y.decodeFileEither
$ actualYaml
where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed.
onError :: (MonadReader env m, HasLog env, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do
let efp = etagsFile fp
handleIO (\e -> logWarn $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
(hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
getDownloadInfo :: ( MonadReader env m getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env , HasPlatformReq env
@@ -381,21 +275,8 @@ getDownloadInfo :: ( MonadReader env m
'[NoDownload] '[NoDownload]
m m
DownloadInfo DownloadInfo
getDownloadInfo t v = getDownloadInfo' t (mkTVer v) getDownloadInfo t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
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
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let distro_preview f g = let distro_preview f g =
@@ -416,7 +297,7 @@ getDownloadInfo' t v = do
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing) without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
maybe maybe
(throwE $ NoDownload v t (Just pfreq)) (throwE NoDownload)
pure pure
(case p of (case p of
-- non-musl won't work on alpine -- non-musl won't work on alpine
@@ -425,7 +306,6 @@ getDownloadInfo' t v = do
) )
-- | Tries to download from the given http or https url -- | Tries to download from the given http or https url
-- and saves the result in continuous memory into a file. -- and saves the result in continuous memory into a file.
-- If the filename is not provided, then we: -- If the filename is not provided, then we:
@@ -444,26 +324,23 @@ download :: ( MonadReader env m
=> URI => URI
-> Maybe URI -- ^ URI for gpg sig -> Maybe URI -- ^ URI for gpg sig
-> Maybe T.Text -- ^ expected hash -> Maybe T.Text -- ^ expected hash
-> Maybe Integer -- ^ expected content length
-> FilePath -- ^ destination dir (ignored for file:// scheme) -> FilePath -- ^ destination dir (ignored for file:// scheme)
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Bool -- ^ whether to read an write etags -> Bool -- ^ whether to read an write etags
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
download rawUri gpgUri eDigest eCSize dest mfn etags download uri gpgUri eDigest dest mfn etags
| scheme == "https" = liftE dl | scheme == "https" = dl
| scheme == "http" = liftE dl | scheme == "http" = dl
| scheme == "file" = do | 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' lift $ logDebug $ "using local file: " <> T.pack destFile'
forM_ eDigest (liftE . flip checkDigest destFile') forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile' pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
where where
scheme = view (uriSchemeL' % schemeBSL') rawUri scheme = view (uriSchemeL' % schemeBSL') uri
dl = do dl = do
Settings{ mirrors } <- lift getSettings
let uri = applyMirrors mirrors rawUri
baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
@@ -474,7 +351,7 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
-- download -- download
flip onException flip onException
(lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)) (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile))
$ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError, ContentLengthError] @'[DigestError, ContentLengthError, DownloadFailed, GPGError] $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError] @'[DigestError, DownloadFailed, GPGError]
(\e' -> do (\e' -> do
lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile) lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)
case e' of case e' of
@@ -509,7 +386,7 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
liftE $ flip onException liftE $ flip onException
(lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile)) (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
$ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError] $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
(\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e)) (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyShow (GPGError e))
) $ do ) $ do
o' <- liftIO getGpgOpts o' <- liftIO getGpgOpts
lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
@@ -524,37 +401,19 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
_ -> pure () _ -> pure ()
forM_ eCSize (liftE . flip checkCSize baseDestFile)
forM_ eDigest (liftE . flip checkDigest baseDestFile) forM_ eDigest (liftE . flip checkDigest baseDestFile)
pure baseDestFile pure baseDestFile
curlDL :: ( MonadCatch m curlDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
, MonadMask m
, MonadIO m
)
=> [String]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do curlDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
liftE $ lEM @_ @'[ProcessError] $ exec "curl" liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ ["-fL", "-o", destFileTemp, T.unpack uri'] (o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
++ maybe [] (\s -> ["--max-filesize", show s]) eCSize
) Nothing Nothing
liftIO $ renameFile destFileTemp destFile liftIO $ renameFile destFileTemp destFile
curlEtagsDL :: ( MonadReader env m curlEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
, HasLog env => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
, MonadCatch m
, MonadMask m
, MonadIO m
)
=> [String]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
curlEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do curlEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile let destFileTemp = tmpFile destFile
dh <- liftIO $ emptySystemTempFile "curl-header" dh <- liftIO $ emptySystemTempFile "curl-header"
@@ -581,14 +440,7 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
lift $ writeEtags destFile (parseEtags headers) lift $ writeEtags destFile (parseEtags headers)
wgetDL :: ( MonadCatch m wgetDL :: (MonadCatch m, MonadMask m, MonadIO m) => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
, MonadMask m
, MonadIO m
)
=> [String]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do wgetDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
@@ -597,16 +449,8 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
liftIO $ renameFile destFileTemp destFile liftIO $ renameFile destFileTemp destFile
wgetEtagsDL :: ( MonadReader env m wgetEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
, HasLog env => [String] -> FilePath -> URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
, MonadCatch m
, MonadMask m
, MonadIO m
)
=> [String]
-> FilePath
-> URI
-> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m ()
wgetEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do wgetEtagsDL o' destFile (decUTF8Safe . serializeURIRef' -> uri') = do
let destFileTemp = tmpFile destFile let destFileTemp = tmpFile destFile
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
@@ -627,10 +471,7 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
| otherwise -> throwE (NonZeroExit i' "wget" opts) | otherwise -> throwE (NonZeroExit i' "wget" opts)
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
internalDL :: ( MonadCatch m internalDL :: (MonadCatch m, MonadMask m, MonadIO m)
, MonadMask m
, MonadIO m
)
=> FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m () => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
internalDL destFile uri' = do internalDL destFile uri' = do
let destFileTemp = tmpFile destFile let destFileTemp = tmpFile destFile
@@ -640,16 +481,11 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
@'[DownloadFailed] @'[DownloadFailed]
(\e@(HTTPNotModified _) -> (\e@(HTTPNotModified _) ->
throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified]))) throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
$ downloadToFile https host fullPath port destFileTemp mempty eCSize $ downloadToFile https host fullPath port destFileTemp mempty
liftIO $ renameFile destFileTemp destFile liftIO $ renameFile destFileTemp destFile
internalEtagsDL :: ( MonadReader env m internalEtagsDL :: (MonadReader env m, HasLog env, MonadCatch m, MonadMask m, MonadIO m)
, HasLog env
, MonadCatch m
, MonadMask m
, MonadIO m
)
=> FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m () => FilePath -> URI -> Excepts '[DownloadFailed, UnsupportedScheme] m ()
internalEtagsDL destFile uri' = do internalEtagsDL destFile uri' = do
let destFileTemp = tmpFile destFile let destFileTemp = tmpFile destFile
@@ -661,7 +497,7 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
liftE liftE
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag)) $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
$ do $ do
r <- downloadToFile https host fullPath port destFileTemp addHeaders eCSize r <- downloadToFile https host fullPath port destFileTemp addHeaders
liftIO $ renameFile destFileTemp destFile liftIO $ renameFile destFileTemp destFile
lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag") lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
#endif #endif
@@ -669,7 +505,7 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
-- Manage to find a file we can write the body into. -- Manage to find a file we can write the body into.
getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath getDestFile :: Monad m => URI -> Maybe FilePath -> Excepts '[NoUrlBase] m FilePath
getDestFile uri' mfn' = getDestFile uri' mfn' =
let path = view pathL' uri' let path = view pathL' uri'
in case mfn' of in case mfn' of
Just fn -> pure (dest </> fn) Just fn -> pure (dest </> fn)
@@ -738,16 +574,14 @@ downloadCached :: ( MonadReader env m
) )
=> DownloadInfo => DownloadInfo
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached dli mfn = do downloadCached dli mfn = do
Settings{ cache } <- lift getSettings Settings{ cache } <- lift getSettings
case cache of case cache of
True -> downloadCached' dli mfn Nothing True -> downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmp mfn False
where
outputFileName = mfn <|> _dlOutput dli
downloadCached' :: ( MonadReader env m downloadCached' :: ( MonadReader env m
@@ -762,21 +596,18 @@ downloadCached' :: ( MonadReader env m
=> DownloadInfo => DownloadInfo
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Maybe FilePath -- ^ optional destination dir (default: cacheDir) -> Maybe FilePath -- ^ optional destination dir (default: cacheDir)
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
downloadCached' dli mfn mDestDir = do downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir let destDir = fromMaybe 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 let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile fileExists <- liftIO $ doesFileExist cachfile
if if
| fileExists -> do | fileExists -> do
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
liftE $ checkDigest (view dlHash dli) cachfile liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile pure cachfile
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) destDir mfn False
where
outputFileName = mfn <|> _dlOutput dli
@@ -807,25 +638,6 @@ checkDigest eDigest file = do
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest) when ((cDigest /= eDigest) && verify) $ throwE (DigestError file cDigest eDigest)
checkCSize :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadThrow m
, HasLog env
)
=> Integer
-> FilePath
-> Excepts '[ContentLengthError] m ()
checkCSize eCSize file = do
Settings{ noVerify } <- lift getSettings
let verify = not noVerify
when verify $ do
let p' = takeFileName file
lift $ logInfo $ "verifying content length of: " <> T.pack p'
cSize <- liftIO $ getFileSize file
when ((eCSize /= cSize) && verify) $ throwE (ContentLengthError (Just file) (Just cSize) eCSize)
-- | Get additional curl args from env. This is an undocumented option. -- | Get additional curl args from env. This is an undocumented option.
getCurlOpts :: IO [String] getCurlOpts :: IO [String]
@@ -873,17 +685,3 @@ getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [
tmpFile :: FilePath -> FilePath tmpFile :: FilePath -> FilePath
tmpFile = (<.> "tmp") 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

@@ -10,19 +10,21 @@ module GHCup.Download.IOStreams where
import GHCup.Download.Utils import GHCup.Download.Utils
import GHCup.Errors import GHCup.Errors
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Prelude import GHCup.Utils.Prelude
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.ByteString.Builder
import Data.CaseInsensitive ( CI, original, mk ) import Data.CaseInsensitive ( CI, original, mk )
import Data.IORef import Data.IORef
import Data.Maybe import Data.Maybe
import Data.Text.Read import Data.Text.Read
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Network.Http.Client hiding ( URL ) import Network.Http.Client hiding ( URL )
import Optics
import Prelude hiding ( abs import Prelude hiding ( abs
, readFile , readFile
, writeFile , writeFile
@@ -31,6 +33,7 @@ import System.ProgressBar
import URI.ByteString import URI.ByteString
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified System.IO.Streams as Streams import qualified System.IO.Streams as Streams
@@ -43,6 +46,27 @@ import qualified System.IO.Streams as Streams
---------------------------- ----------------------------
-- | Load the result of this download into memory at once.
downloadBS' :: MonadIO m
=> Bool -- ^ https?
-> ByteString -- ^ host (e.g. "www.example.com")
-> ByteString -- ^ path (e.g. "/my/file") including query
-> Maybe Int -- ^ optional port (e.g. 3000)
-> Excepts
'[ HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
]
m
L.ByteString
downloadBS' https host path port = do
bref <- liftIO $ newIORef (mempty :: Builder)
let stepper bs = modifyIORef bref (<> byteString bs)
void $ downloadInternal False https host path port stepper (pure ()) mempty
liftIO (readIORef bref <&> toLazyByteString)
downloadToFile :: (MonadMask m, MonadIO m) downloadToFile :: (MonadMask m, MonadIO m)
=> Bool -- ^ https? => Bool -- ^ https?
@@ -51,9 +75,8 @@ downloadToFile :: (MonadMask m, MonadIO m)
-> Maybe Int -- ^ optional port (e.g. 3000) -> Maybe Int -- ^ optional port (e.g. 3000)
-> FilePath -- ^ destination file to create and write to -> FilePath -- ^ destination file to create and write to
-> M.Map (CI ByteString) ByteString -- ^ additional headers -> M.Map (CI ByteString) ByteString -- ^ additional headers
-> Maybe Integer -- ^ expected content length
-> Excepts '[DownloadFailed, HTTPNotModified] m Response -> Excepts '[DownloadFailed, HTTPNotModified] m Response
downloadToFile https host fullPath port destFile addHeaders eCSize = do downloadToFile https host fullPath port destFile addHeaders = do
let stepper = BS.appendFile destFile let stepper = BS.appendFile destFile
setup = BS.writeFile destFile mempty setup = BS.writeFile destFile mempty
catchAllE (\case catchAllE (\case
@@ -61,7 +84,7 @@ downloadToFile https host fullPath port destFile addHeaders eCSize = do
| i == 304 | i == 304
, Just e <- M.lookup (mk "etag") headers -> throwE $ HTTPNotModified (decUTF8Safe e) , Just e <- M.lookup (mk "etag") headers -> throwE $ HTTPNotModified (decUTF8Safe e)
v -> throwE $ DownloadFailed v v -> throwE $ DownloadFailed v
) $ downloadInternal True https host fullPath port stepper setup addHeaders eCSize ) $ downloadInternal True https host fullPath port stepper setup addHeaders
downloadInternal :: MonadIO m downloadInternal :: MonadIO m
@@ -73,21 +96,19 @@ downloadInternal :: MonadIO m
-> (ByteString -> IO a) -- ^ the consuming step function -> (ByteString -> IO a) -- ^ the consuming step function
-> IO a -- ^ setup action -> IO a -- ^ setup action
-> M.Map (CI ByteString) ByteString -- ^ additional headers -> M.Map (CI ByteString) ByteString -- ^ additional headers
-> Maybe Integer
-> Excepts -> Excepts
'[ HTTPStatusError '[ HTTPStatusError
, URIParseError , URIParseError
, UnsupportedScheme , UnsupportedScheme
, NoLocationHeader , NoLocationHeader
, TooManyRedirs , TooManyRedirs
, ContentLengthError
] ]
m m
Response Response
downloadInternal = go (5 :: Int) downloadInternal = go (5 :: Int)
where where
go redirs progressBar https host path port consumer setup addHeaders eCSize = do go redirs progressBar https host path port consumer setup addHeaders = do
r <- liftIO $ withConnection' https host port action r <- liftIO $ withConnection' https host port action
veitherToExcepts r >>= \case veitherToExcepts r >>= \case
Right r' -> Right r' ->
@@ -117,39 +138,25 @@ downloadInternal = go (5 :: Int)
followRedirectURL bs = case parseURI strictURIParserOptions bs of followRedirectURL bs = case parseURI strictURIParserOptions bs of
Right uri' -> do Right uri' -> do
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri' (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders eCSize go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders
Left e -> throwE e Left e -> throwE e
downloadStream r i' = do downloadStream r i' = do
void setup void setup
let size = case getHeader r "Content-Length" of let size = case getHeader r "Content-Length" of
Just x' -> case decimal $ decUTF8Safe x' of Just x' -> case decimal $ decUTF8Safe x' of
Left _ -> Nothing Left _ -> 0
Right (r', _) -> Just r' Right (r', _) -> r'
Nothing -> Nothing Nothing -> 0
forM_ size $ \s -> forM_ eCSize $ \es -> when (es /= s) $ throwIO (ContentLengthError Nothing (Just s) es) (mpb :: Maybe (ProgressBar ())) <- if progressBar
let size' = eCSize <|> size then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
else pure Nothing
(mpb :: Maybe (ProgressBar ())) <- case (progressBar, size') of
(True, Just size'') -> Just <$> newProgressBar defStyle 10 (Progress 0 (fromInteger size'') ())
_ -> pure Nothing
ior <- liftIO $ newIORef 0
outStream <- liftIO $ Streams.makeOutputStream outStream <- liftIO $ Streams.makeOutputStream
(\case (\case
Just bs -> do Just bs -> do
let len = BS.length bs forM_ mpb $ \pb -> incProgress pb (BS.length bs)
forM_ mpb $ \pb -> incProgress pb len
-- check we don't exceed size
forM_ size' $ \s -> do
cs <- readIORef ior
when ((cs + toInteger len) > s) $ throwIO (ContentLengthError Nothing (Just (cs + toInteger len)) s)
modifyIORef ior (+ toInteger len)
void $ consumer bs void $ consumer bs
Nothing -> pure () Nothing -> pure ()
) )

View File

@@ -10,7 +10,7 @@ module GHCup.Download.Utils where
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Prelude import GHCup.Utils.Prelude
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad

View File

@@ -6,7 +6,6 @@
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-| {-|
Module : GHCup.Errors Module : GHCup.Errors
@@ -28,167 +27,15 @@ import Data.CaseInsensitive ( CI )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import Haskus.Utils.Variant import Haskus.Utils.Variant
import System.FilePath
import Text.PrettyPrint hiding ( (<>) ) import Text.PrettyPrint hiding ( (<>) )
import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString import URI.ByteString
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import Data.Data (Proxy(..))
import Data.Time (Day)
allHFError :: String
allHFError = unlines allErrors
where
format p = "GHCup-" <> show (eBase p) <> " " <> eDesc p
format'' e p = "GHCup-" <> show (eNum e) <> " " <> eDesc p
format' e _ = "GHCup-" <> show (eNum e) <> " " <> prettyShow e
format''' e _ str' = "GHCup-" <> show (eNum e) <> " " <> str'
allErrors =
[ "# low level errors (1 to 500)"
, let proxy = Proxy :: Proxy NoCompatiblePlatform in format proxy
, let proxy = Proxy :: Proxy NoDownload in format proxy
, let proxy = Proxy :: Proxy NoUpdate in format proxy
, let proxy = Proxy :: Proxy DistroNotFound in format proxy
, let proxy = Proxy :: Proxy UnknownArchive in format proxy
, let proxy = Proxy :: Proxy UnsupportedScheme in format proxy
, 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
, let proxy = Proxy :: Proxy NotInstalled in format proxy
, let proxy = Proxy :: Proxy UninstallFailed in format proxy
, let proxy = Proxy :: Proxy NotFoundInPATH in format proxy
, let proxy = Proxy :: Proxy JSONError in format proxy
, let proxy = Proxy :: Proxy FileDoesNotExistError in format proxy
, let proxy = Proxy :: Proxy FileAlreadyExistsError in format proxy
, let proxy = Proxy :: Proxy TarDirDoesNotExist in format proxy
, let proxy = Proxy :: Proxy DigestError in format proxy
, let proxy = Proxy :: Proxy GPGError in format proxy
, let proxy = Proxy :: Proxy HTTPStatusError in format proxy
, let proxy = Proxy :: Proxy MalformedHeaders in format proxy
, let proxy = Proxy :: Proxy HTTPNotModified in format proxy
, let proxy = Proxy :: Proxy NoLocationHeader in format proxy
, let proxy = Proxy :: Proxy TooManyRedirs in format proxy
, let proxy = Proxy :: Proxy PatchFailed in format proxy
, let proxy = Proxy :: Proxy NoToolRequirements in format proxy
, let proxy = Proxy :: Proxy InvalidBuildConfig in format proxy
, let proxy = Proxy :: Proxy NoToolVersionSet in format proxy
, let proxy = Proxy :: Proxy NoNetwork in format proxy
, 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
, let proxy = Proxy :: Proxy UnsupportedSetupCombo in format proxy
, ""
, "# high level errors (4000+)"
, 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
, ""
, "# true exceptions (500+)"
, let proxy = Proxy :: Proxy ParseError in format proxy
, let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
, let proxy = Proxy :: Proxy NoUrlBase in format proxy
, let proxy = Proxy :: Proxy DigestMissing in format proxy
, ""
, "# orphans (800+)"
, let proxy = Proxy :: Proxy URIParseError in format proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedScheme MissingColon
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedUserInfo
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedQuery
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedFragment
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedHost
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedPort
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = MalformedPath
in format' e proxy
, let proxy = Proxy :: Proxy URIParseError
e = OtherError ""
in format'' e proxy
, let proxy = Proxy :: Proxy ArchiveResult in format proxy
, let proxy = Proxy :: Proxy ArchiveResult
e = ArchiveFatal
in format' e proxy
, let proxy = Proxy :: Proxy ArchiveResult
e = ArchiveFailed
in format' e proxy
, let proxy = Proxy :: Proxy ArchiveResult
e = ArchiveWarn
in format' e proxy
, let proxy = Proxy :: Proxy ArchiveResult
e = ArchiveRetry
in format' e proxy
, let proxy = Proxy :: Proxy ArchiveResult
e = ArchiveOk
in format' e proxy
, let proxy = Proxy :: Proxy ArchiveResult
e = ArchiveEOF
in format' e proxy
, let proxy = Proxy :: Proxy ProcessError in format proxy
, let proxy = Proxy :: Proxy ProcessError
e = NonZeroExit 0 "" []
in format''' e proxy "A process returned a non-zero exit code."
, let proxy = Proxy :: Proxy ProcessError
e = PTerminated "" []
in format''' e proxy "A process terminated prematurely."
, let proxy = Proxy :: Proxy ProcessError
e = PStopped "" []
in format''' e proxy "A process stopped prematurely."
, let proxy = Proxy :: Proxy ProcessError
e = NoSuchPid "" []
in format''' e proxy "Could not find PID for this process."
]
prettyHFError :: (Pretty e, HFErrorProject e) => e -> String
prettyHFError e =
let errorCode = "GHCup-" <> padIntAndShow (eNum e)
in ("[" <> linkEscapeCode errorCode (hfErrorLink errorCode) <> "] ") <> prettyShow e
where
hfErrorLink errorCode = "https://errors.haskell.org/messages/" <> errorCode
padIntAndShow i
| i < 10 = "0000" <> show i
| i < 100 = "000" <> show i
| i < 1000 = "00" <> show i
| i < 10000 = "0" <> show i
| otherwise = show i
class HFErrorProject a where
eNum :: a -> Int
eNum _ = eBase (Proxy :: Proxy a)
eBase :: Proxy a -> Int
eDesc :: Proxy a -> String
linkEscapeCode :: String -> String -> String
linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
------------------------ ------------------------
--[ Low-level errors ]-- --[ Low-level errors ]--
------------------------ ------------------------
@@ -203,44 +50,20 @@ instance Pretty NoCompatiblePlatform where
pPrint (NoCompatiblePlatform str') = pPrint (NoCompatiblePlatform str') =
text ("Could not find a compatible platform. Got: " ++ str') text ("Could not find a compatible platform. Got: " ++ str')
instance HFErrorProject NoCompatiblePlatform where
eBase _ = 1
eDesc _ = "No compatible platform could be found"
-- | Unable to find a download for the requested version/distro. -- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest) data NoDownload = NoDownload
deriving Show deriving Show
instance Pretty NoDownload where instance Pretty NoDownload where
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq) pPrint NoDownload =
| (Just target) <- mtarget text "Unable to find a download for the requested version/distro."
, 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)
instance HFErrorProject NoDownload where
eBase _ = 10
eDesc _ = "Unable to find a download for the requested version/distro."
-- | No update available or necessary. -- | No update available or necessary.
data NoUpdate = NoUpdate data NoUpdate = NoUpdate
deriving Show deriving Show
instance Pretty NoUpdate where instance Pretty NoUpdate where
pPrint NoUpdate = text (eDesc (Proxy :: Proxy NoUpdate)) pPrint NoUpdate = text "No update available or necessary."
instance HFErrorProject NoUpdate where
eBase _ = 20
eDesc _ = "No update available or necessary."
-- | The Architecture is unknown and unsupported. -- | The Architecture is unknown and unsupported.
data NoCompatibleArch = NoCompatibleArch String data NoCompatibleArch = NoCompatibleArch String
@@ -250,21 +73,13 @@ instance Pretty NoCompatibleArch where
pPrint (NoCompatibleArch arch) = pPrint (NoCompatibleArch arch) =
text ("The Architecture is unknown or unsupported. Got: " ++ arch) text ("The Architecture is unknown or unsupported. Got: " ++ arch)
instance HFErrorProject NoCompatibleArch where
eBase _ = 30
eDesc _ = "The Architecture is unknown and unsupported"
-- | Unable to figure out the distribution of the host. -- | Unable to figure out the distribution of the host.
data DistroNotFound = DistroNotFound data DistroNotFound = DistroNotFound
deriving Show deriving Show
instance Pretty DistroNotFound where instance Pretty DistroNotFound where
pPrint DistroNotFound = pPrint DistroNotFound =
text (eDesc (Proxy :: Proxy DistroNotFound)) text "Unable to figure out the distribution of the host."
instance HFErrorProject DistroNotFound where
eBase _ = 40
eDesc _ = "Unable to figure out the distribution of the host"
-- | The archive format is unknown. We don't know how to extract it. -- | The archive format is unknown. We don't know how to extract it.
data UnknownArchive = UnknownArchive FilePath data UnknownArchive = UnknownArchive FilePath
@@ -274,21 +89,12 @@ instance Pretty UnknownArchive where
pPrint (UnknownArchive file) = pPrint (UnknownArchive file) =
text $ "The archive format is unknown. We don't know how to extract the file " <> file text $ "The archive format is unknown. We don't know how to extract the file " <> file
instance HFErrorProject UnknownArchive where
eBase _ = 50
eDesc _ = "The archive format is unknown. We don't know how to extract it."
-- | The scheme is not supported (such as ftp). -- | The scheme is not supported (such as ftp).
data UnsupportedScheme = UnsupportedScheme data UnsupportedScheme = UnsupportedScheme
deriving Show deriving Show
instance Pretty UnsupportedScheme where instance Pretty UnsupportedScheme where
pPrint UnsupportedScheme = pPrint UnsupportedScheme = text "The scheme is not supported (such as ftp)."
text (eDesc (Proxy :: Proxy UnsupportedScheme))
instance HFErrorProject UnsupportedScheme where
eBase _ = 60
eDesc _ = "The scheme is not supported (such as ftp)."
-- | Unable to copy a file. -- | Unable to copy a file.
data CopyError = CopyError String data CopyError = CopyError String
@@ -298,23 +104,6 @@ instance Pretty CopyError where
pPrint (CopyError reason) = pPrint (CopyError reason) =
text ("Unable to copy a file. Reason was: " ++ reason) text ("Unable to copy a file. Reason was: " ++ reason)
instance HFErrorProject CopyError where
eBase _ = 70
eDesc _ = "Unable to copy a file."
-- | Unable to merge file trees.
data MergeFileTreeError = MergeFileTreeError IOException FilePath FilePath
deriving Show
instance Pretty MergeFileTreeError where
pPrint (MergeFileTreeError e from to) =
text "Failed to merge file tree from" <+> text from <+> text "to" <+> text to <+> text "\nexception was:" <+> text (displayException e)
<+> text "\n...you may need to delete" <+> text to <+> text "manually. Make sure it's gone."
instance HFErrorProject MergeFileTreeError where
eBase _ = 80
eDesc _ = "Unable to merge file trees during installation"
-- | Unable to find a tag of a tool. -- | Unable to find a tag of a tool.
data TagNotFound = TagNotFound Tag Tool data TagNotFound = TagNotFound Tag Tool
deriving Show deriving Show
@@ -323,25 +112,6 @@ instance Pretty TagNotFound where
pPrint (TagNotFound tag tool) = pPrint (TagNotFound tag tool) =
text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
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 -- | Unable to find the next version of a tool (the one after the currently
-- set one). -- set one).
data NextVerNotFound = NextVerNotFound Tool data NextVerNotFound = NextVerNotFound Tool
@@ -351,35 +121,21 @@ instance Pretty NextVerNotFound where
pPrint (NextVerNotFound tool) = pPrint (NextVerNotFound tool) =
text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
instance HFErrorProject NextVerNotFound where
eBase _ = 100
eDesc _ = "Unable to find the next version of a tool (the one after the currently set one)"
-- | The tool (such as GHC) is already installed with that version. -- | The tool (such as GHC) is already installed with that version.
data AlreadyInstalled = AlreadyInstalled Tool Version data AlreadyInstalled = AlreadyInstalled Tool Version
deriving Show deriving Show
instance Pretty AlreadyInstalled where instance Pretty AlreadyInstalled where
pPrint (AlreadyInstalled tool ver') = pPrint (AlreadyInstalled tool ver') =
(pPrint tool <> text "-" <> pPrint ver') <+> text "is already installed;" pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
<+> text "if you really want to reinstall it, you may want to run 'ghcup install" <+> pPrint tool <+> text "--force" <+> (pPrint ver' <> text "'")
instance HFErrorProject AlreadyInstalled where
eBase _ = 110
eDesc _ = "The tool (such as GHC) is already installed with that version"
-- | The Directory is supposed to be empty, but wasn't. -- | The Directory is supposed to be empty, but wasn't.
data DirNotEmpty = DirNotEmpty {path :: FilePath} data DirNotEmpty = DirNotEmpty {path :: FilePath}
deriving Show
instance Pretty DirNotEmpty where instance Pretty DirNotEmpty where
pPrint (DirNotEmpty path) = do pPrint (DirNotEmpty path) = do
text $ "The directory was expected to be empty, but isn't: " <> path text $ "The directory was expected to be empty, but isn't: " <> path
instance HFErrorProject DirNotEmpty where
eBase _ = 120
eDesc _ = "The Directory is supposed to be empty, but wasn't"
-- | The tool is not installed. Some operations rely on a tool -- | The tool is not installed. Some operations rely on a tool
-- to be installed (such as setting the current GHC version). -- to be installed (such as setting the current GHC version).
data NotInstalled = NotInstalled Tool GHCTargetVersion data NotInstalled = NotInstalled Tool GHCTargetVersion
@@ -389,21 +145,6 @@ instance Pretty NotInstalled where
pPrint (NotInstalled tool ver) = pPrint (NotInstalled tool ver) =
text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed." text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
instance HFErrorProject NotInstalled where
eBase _ = 130
eDesc _ = "The required tool is not installed"
data UninstallFailed = UninstallFailed FilePath [FilePath]
deriving Show
instance Pretty UninstallFailed where
pPrint (UninstallFailed dir files) =
text "The following files survived uninstallation: " <+> pPrint files <+> text "...consider removing" <+> pPrint dir <+> text "manually."
instance HFErrorProject UninstallFailed where
eBase _ = 140
eDesc _ = "Uninstallation failed with leftover files"
-- | An executable was expected to be in PATH, but was not found. -- | An executable was expected to be in PATH, but was not found.
data NotFoundInPATH = NotFoundInPATH FilePath data NotFoundInPATH = NotFoundInPATH FilePath
deriving Show deriving Show
@@ -414,10 +155,6 @@ instance Pretty NotFoundInPATH where
pPrint (NotFoundInPATH exe) = pPrint (NotFoundInPATH exe) =
text $ "The exe " <> exe <> " was not found in PATH." text $ "The exe " <> exe <> " was not found in PATH."
instance HFErrorProject NotFoundInPATH where
eBase _ = 150
eDesc _ = "An executable was expected to be in PATH, but was not found"
-- | JSON decoding failed. -- | JSON decoding failed.
data JSONError = JSONDecodeError String data JSONError = JSONDecodeError String
deriving Show deriving Show
@@ -426,10 +163,6 @@ instance Pretty JSONError where
pPrint (JSONDecodeError err) = pPrint (JSONDecodeError err) =
text $ "JSON decoding failed with: " <> err text $ "JSON decoding failed with: " <> err
instance HFErrorProject JSONError where
eBase _ = 160
eDesc _ = "JSON decoding failed"
-- | A file that is supposed to exist does not exist -- | A file that is supposed to exist does not exist
-- (e.g. when we use file scheme to "download" something). -- (e.g. when we use file scheme to "download" something).
data FileDoesNotExistError = FileDoesNotExistError FilePath data FileDoesNotExistError = FileDoesNotExistError FilePath
@@ -439,10 +172,6 @@ instance Pretty FileDoesNotExistError where
pPrint (FileDoesNotExistError file) = pPrint (FileDoesNotExistError file) =
text $ "File " <> file <> " does not exist." text $ "File " <> file <> " does not exist."
instance HFErrorProject FileDoesNotExistError where
eBase _ = 170
eDesc _ = "A file that is supposed to exist does not exist (oops)"
-- | The file already exists -- | The file already exists
-- (e.g. when we use isolated installs with the same path). -- (e.g. when we use isolated installs with the same path).
-- (e.g. This is done to prevent any overwriting) -- (e.g. This is done to prevent any overwriting)
@@ -453,10 +182,6 @@ instance Pretty FileAlreadyExistsError where
pPrint (FileAlreadyExistsError file) = pPrint (FileAlreadyExistsError file) =
text $ "File " <> file <> " Already exists." text $ "File " <> file <> " Already exists."
instance HFErrorProject FileAlreadyExistsError where
eBase _ = 180
eDesc _ = "A file already exists that wasn't expected to exist"
data TarDirDoesNotExist = TarDirDoesNotExist TarDir data TarDirDoesNotExist = TarDirDoesNotExist TarDir
deriving Show deriving Show
@@ -464,10 +189,6 @@ instance Pretty TarDirDoesNotExist where
pPrint (TarDirDoesNotExist dir) = pPrint (TarDirDoesNotExist dir) =
text "Tar directory does not exist:" <+> pPrint dir text "Tar directory does not exist:" <+> pPrint dir
instance HFErrorProject TarDirDoesNotExist where
eBase _ = 190
eDesc _ = "The tar directory (e.g. inside an archive) does not exist"
-- | File digest verification failed. -- | File digest verification failed.
data DigestError = DigestError FilePath Text Text data DigestError = DigestError FilePath Text Text
deriving Show deriving Show
@@ -478,11 +199,7 @@ instance Pretty DigestError where
<+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
"\nConsider removing the file in case it's cached and try again." "\nConsider removing the file in case it's cached and try again."
instance HFErrorProject DigestError where -- | File digest verification failed.
eBase _ = 200
eDesc _ = "File digest verification failed"
-- | File PGP verification failed.
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs) data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
deriving instance Show GPGError deriving instance Show GPGError
@@ -490,10 +207,6 @@ deriving instance Show GPGError
instance Pretty GPGError where instance Pretty GPGError where
pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason
instance HFErrorProject GPGError where
eBase _ = 210
eDesc _ = "File PGP verification failed"
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString) data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
deriving Show deriving Show
@@ -502,10 +215,6 @@ instance Pretty HTTPStatusError where
pPrint (HTTPStatusError status _) = pPrint (HTTPStatusError status _) =
text "Unexpected HTTP status:" <+> pPrint status text "Unexpected HTTP status:" <+> pPrint status
instance HFErrorProject HTTPStatusError where
eBase _ = 220
eDesc _ = "Unexpected HTTP status error (e.g. during downloads)"
-- | Malformed headers. -- | Malformed headers.
data MalformedHeaders = MalformedHeaders Text data MalformedHeaders = MalformedHeaders Text
deriving Show deriving Show
@@ -514,10 +223,6 @@ instance Pretty MalformedHeaders where
pPrint (MalformedHeaders h) = pPrint (MalformedHeaders h) =
text "Headers are malformed: " <+> pPrint h text "Headers are malformed: " <+> pPrint h
instance HFErrorProject MalformedHeaders where
eBase _ = 230
eDesc _ = "Malformed headers during download"
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPNotModified = HTTPNotModified Text data HTTPNotModified = HTTPNotModified Text
deriving Show deriving Show
@@ -526,21 +231,13 @@ instance Pretty HTTPNotModified where
pPrint (HTTPNotModified etag) = pPrint (HTTPNotModified etag) =
text "Remote resource not modifed, etag was:" <+> pPrint etag text "Remote resource not modifed, etag was:" <+> pPrint etag
instance HFErrorProject HTTPNotModified where
eBase _ = 240
eDesc _ = "Not modified HTTP status error (e.g. during downloads)."
-- | The 'Location' header was expected during a 3xx redirect, but not found. -- | The 'Location' header was expected during a 3xx redirect, but not found.
data NoLocationHeader = NoLocationHeader data NoLocationHeader = NoLocationHeader
deriving Show deriving Show
instance Pretty NoLocationHeader where instance Pretty NoLocationHeader where
pPrint NoLocationHeader = pPrint NoLocationHeader =
text (eDesc (Proxy :: Proxy NoLocationHeader)) text "The 'Location' header was expected during a 3xx redirect, but not found."
instance HFErrorProject NoLocationHeader where
eBase _ = 250
eDesc _ = "The 'Location' header was expected during a 3xx redirect, but not found."
-- | Too many redirects. -- | Too many redirects.
data TooManyRedirs = TooManyRedirs data TooManyRedirs = TooManyRedirs
@@ -548,11 +245,7 @@ data TooManyRedirs = TooManyRedirs
instance Pretty TooManyRedirs where instance Pretty TooManyRedirs where
pPrint TooManyRedirs = pPrint TooManyRedirs =
text (eDesc (Proxy :: Proxy TooManyRedirs)) text "Too many redirections."
instance HFErrorProject TooManyRedirs where
eBase _ = 260
eDesc _ = "Too many redirections."
-- | A patch could not be applied. -- | A patch could not be applied.
data PatchFailed = PatchFailed data PatchFailed = PatchFailed
@@ -560,11 +253,7 @@ data PatchFailed = PatchFailed
instance Pretty PatchFailed where instance Pretty PatchFailed where
pPrint PatchFailed = pPrint PatchFailed =
text (eDesc (Proxy :: Proxy PatchFailed)) text "A patch could not be applied."
instance HFErrorProject PatchFailed where
eBase _ = 270
eDesc _ = "A patch could not be applied."
-- | The tool requirements could not be found. -- | The tool requirements could not be found.
data NoToolRequirements = NoToolRequirements data NoToolRequirements = NoToolRequirements
@@ -572,11 +261,7 @@ data NoToolRequirements = NoToolRequirements
instance Pretty NoToolRequirements where instance Pretty NoToolRequirements where
pPrint NoToolRequirements = pPrint NoToolRequirements =
text (eDesc (Proxy :: Proxy NoToolRequirements)) text "The Tool requirements could not be found."
instance HFErrorProject NoToolRequirements where
eBase _ = 280
eDesc _ = "The Tool requirements could not be found."
data InvalidBuildConfig = InvalidBuildConfig Text data InvalidBuildConfig = InvalidBuildConfig Text
deriving Show deriving Show
@@ -585,10 +270,6 @@ instance Pretty InvalidBuildConfig where
pPrint (InvalidBuildConfig reason) = pPrint (InvalidBuildConfig reason) =
text "The build config is invalid. Reason was:" <+> pPrint reason text "The build config is invalid. Reason was:" <+> pPrint reason
instance HFErrorProject InvalidBuildConfig where
eBase _ = 290
eDesc _ = "The build config is invalid."
data NoToolVersionSet = NoToolVersionSet Tool data NoToolVersionSet = NoToolVersionSet Tool
deriving Show deriving Show
@@ -596,114 +277,27 @@ instance Pretty NoToolVersionSet where
pPrint (NoToolVersionSet tool) = pPrint (NoToolVersionSet tool) =
text "No version is set for tool" <+> pPrint tool <+> text "." text "No version is set for tool" <+> pPrint tool <+> text "."
instance HFErrorProject NoToolVersionSet where
eBase _ = 300
eDesc _ = "No version is set for tool (but was expected)."
data NoNetwork = NoNetwork data NoNetwork = NoNetwork
deriving Show deriving Show
instance Pretty NoNetwork where instance Pretty NoNetwork where
pPrint NoNetwork = pPrint NoNetwork =
text (eDesc (Proxy :: Proxy NoNetwork)) text "A download was required or requested, but '--offline' was specified."
instance HFErrorProject NoNetwork where
eBase _ = 310
eDesc _ = "A download was required or requested, but '--offline' was specified."
data HadrianNotFound = HadrianNotFound data HadrianNotFound = HadrianNotFound
deriving Show deriving Show
instance Pretty HadrianNotFound where instance Pretty HadrianNotFound where
pPrint HadrianNotFound = pPrint HadrianNotFound =
text (eDesc (Proxy :: Proxy HadrianNotFound)) text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
instance HFErrorProject HadrianNotFound where
eBase _ = 320
eDesc _ = "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
data ToolShadowed = ToolShadowed
Tool
FilePath -- shadow binary
FilePath -- upgraded binary
Version -- upgraded version
deriving Show
instance Pretty ToolShadowed where
pPrint (ToolShadowed tool sh up _) =
text (prettyShow tool
<> " is shadowed by "
<> sh
<> ".\nThe upgrade will not be in effect, unless you remove "
<> sh
<> "\nor make sure "
<> takeDirectory up
<> " comes before "
<> takeDirectory sh
<> " in PATH."
)
instance HFErrorProject ToolShadowed where
eBase _ = 330
eDesc _ = "A tool is shadowed in PATH."
-- | File content length verification failed.
data ContentLengthError = ContentLengthError (Maybe FilePath) (Maybe Integer) Integer
deriving Show
instance Pretty ContentLengthError where
pPrint (ContentLengthError Nothing Nothing expectedSize) =
text "Content length exceeded expected size:"
<+> text (show expectedSize)
<+> text "\nConsider removing the file in case it's cached and try again."
pPrint (ContentLengthError Nothing (Just currentSize) expectedSize) =
text "Content length error. Expected"
<+> text (show expectedSize) <+> text "but got" <+> pPrint currentSize <+> text
"\nConsider removing the file in case it's cached and try again."
pPrint (ContentLengthError (Just fp) (Just currentSize) expectedSize) =
text "Content length error for" <+> text (fp <> ": expected")
<+> text (show expectedSize) <+> text "but got" <+> pPrint currentSize <+> text
"\nConsider removing the file in case it's cached and try again."
pPrint (ContentLengthError (Just fp) Nothing expectedSize) =
text "Content length error for" <+> text (fp <> ": expected")
<+> text (show expectedSize) <+> text "\nConsider removing the file in case it's cached and try again."
instance Exception ContentLengthError
instance HFErrorProject ContentLengthError where
eBase _ = 340
eDesc _ = "File content length verification failed"
data DuplicateReleaseChannel = DuplicateReleaseChannel NewURLSource
deriving Show
instance HFErrorProject DuplicateReleaseChannel where
eBase _ = 350
eDesc _ = "Duplicate release channel detected when adding new source.\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
instance Pretty DuplicateReleaseChannel where
pPrint (DuplicateReleaseChannel source) =
text $ "Duplicate release channel detected when adding: \n "
<> show source
<> "\nGiving up. You can use '--force' to remove and append the duplicate source (this may change order/semantics)."
data UnsupportedSetupCombo = UnsupportedSetupCombo Architecture Platform
deriving Show
instance Pretty UnsupportedSetupCombo where
pPrint (UnsupportedSetupCombo arch plat) =
text "Could not find a compatible setup combo for:" <+> pPrint arch <+> pPrint plat
instance HFErrorProject UnsupportedSetupCombo where
eBase _ = 360
eDesc _ = "Could not find a compatible setup combo"
------------------------- -------------------------
--[ High-level errors ]-- --[ High-level errors ]--
------------------------- -------------------------
-- | A download failed. The underlying error is encapsulated. -- | A download failed. The underlying error is encapsulated.
data DownloadFailed = forall xs . (HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs) data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
instance Pretty DownloadFailed where instance Pretty DownloadFailed where
pPrint (DownloadFailed reason) = pPrint (DownloadFailed reason) =
@@ -713,47 +307,9 @@ instance Pretty DownloadFailed where
deriving instance Show DownloadFailed deriving instance Show DownloadFailed
instance HFErrorProject DownloadFailed where
eBase _ = 5000
eNum (DownloadFailed xs) = 5000 + eNum xs
eDesc _ = "A download failed."
data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorProject (V xs1), Show (V xs2), Pretty (V xs2), HFErrorProject (V xs2)) => InstallSetError (V xs1) (V xs2)
instance Pretty InstallSetError where
pPrint (InstallSetError reason1 reason2) =
text "Both installation and setting the tool failed.\nInstall error was:"
<+> pPrint reason1
<+> text "\nSet error was:"
<+> pPrint reason2
deriving instance Show InstallSetError
instance HFErrorProject InstallSetError where
eBase _ = 7000
-- will there be collisions?
eNum (InstallSetError xs1 xs2) = 7000 + eNum xs1 + eNum xs2
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. -- | 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) data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
instance Pretty BuildFailed where instance Pretty BuildFailed where
pPrint (BuildFailed path reason) = pPrint (BuildFailed path reason) =
@@ -763,44 +319,18 @@ instance Pretty BuildFailed where
deriving instance Show BuildFailed deriving instance Show BuildFailed
instance HFErrorProject BuildFailed where
eBase _ = 8000
eNum (BuildFailed _ xs2) = 8000 + eNum xs2
eDesc _ = "The build failed."
-- | Setting the current GHC version failed. -- | Setting the current GHC version failed.
data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => GHCupSetError (V es) data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
instance Pretty GHCupSetError where instance Pretty GHCupSetError where
pPrint (GHCupSetError reason) = pPrint (GHCupSetError reason) =
case reason of case reason of
VMaybe (_ :: GHCupSetError) -> pPrint reason VMaybe (_ :: GHCupSetError) -> pPrint reason
_ -> text "Setting the current version failed:" <+> pPrint reason _ -> text "Setting the current GHC version failed:" <+> pPrint reason
deriving instance Show GHCupSetError deriving instance Show GHCupSetError
instance HFErrorProject GHCupSetError where
eBase _ = 9000
eNum (GHCupSetError xs) = 9000 + eNum xs
eDesc _ = "Setting the current version failed."
-- | Executing stacks platform detection failed.
data StackPlatformDetectError = forall es . (ToVariantMaybe StackPlatformDetectError es, PopVariant StackPlatformDetectError es, Show (V es), Pretty (V es), HFErrorProject (V es)) => StackPlatformDetectError (V es)
instance Pretty StackPlatformDetectError where
pPrint (StackPlatformDetectError reason) =
case reason of
VMaybe (_ :: StackPlatformDetectError) -> pPrint reason
_ -> text "Running stack platform detection logic failed:" <+> pPrint reason
deriving instance Show StackPlatformDetectError
instance HFErrorProject StackPlatformDetectError where
eBase _ = 6000
eNum (StackPlatformDetectError xs) = 6000 + eNum xs
eDesc _ = "Running stack platform detection logic failed."
--------------------------------------------- ---------------------------------------------
--[ True Exceptions (e.g. for MonadThrow) ]-- --[ True Exceptions (e.g. for MonadThrow) ]--
@@ -817,10 +347,6 @@ instance Pretty ParseError where
instance Exception ParseError instance Exception ParseError
instance HFErrorProject ParseError where
eBase _ = 500
eDesc _ = "A parse error occured."
data UnexpectedListLength = UnexpectedListLength String data UnexpectedListLength = UnexpectedListLength String
deriving Show deriving Show
@@ -831,10 +357,6 @@ instance Pretty UnexpectedListLength where
instance Exception UnexpectedListLength instance Exception UnexpectedListLength
instance HFErrorProject UnexpectedListLength where
eBase _ = 510
eDesc _ = "A list had an unexpected length."
data NoUrlBase = NoUrlBase Text data NoUrlBase = NoUrlBase Text
deriving Show deriving Show
@@ -844,22 +366,6 @@ instance Pretty NoUrlBase where
instance Exception NoUrlBase instance Exception NoUrlBase
instance HFErrorProject NoUrlBase where
eBase _ = 520
eDesc _ = "URL does not have a base filename."
data DigestMissing = DigestMissing URI
deriving Show
instance Pretty DigestMissing where
pPrint (DigestMissing uri) =
text "Digest missing for:" <+> (text . T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
instance Exception DigestMissing
instance HFErrorProject DigestMissing where
eBase _ = 530
eDesc _ = "An expected digest is missing."
------------------------ ------------------------
@@ -879,23 +385,6 @@ instance
Right x -> pPrint x Right x -> pPrint x
Left xs -> pPrint xs Left xs -> pPrint xs
instance HFErrorProject (V '[]) where
{-# INLINABLE eBase #-}
eBase _ = undefined
{-# INLINABLE eDesc #-}
eDesc _ = undefined
instance
( HFErrorProject x
, HFErrorProject (V xs)
) => HFErrorProject (V (x ': xs))
where
eNum v = case popVariantHead v of
Right x -> eNum x
Left xs -> eNum xs
eDesc _ = undefined
eBase _ = undefined
instance Pretty URIParseError where instance Pretty URIParseError where
pPrint (MalformedScheme reason) = pPrint (MalformedScheme reason) =
text "Failed to parse URI. Malformed scheme:" <+> text (show reason) text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
@@ -914,22 +403,6 @@ instance Pretty URIParseError where
pPrint (OtherError err) = pPrint (OtherError err) =
text "Failed to parse URI:" <+> pPrint err text "Failed to parse URI:" <+> pPrint err
instance HFErrorProject URIParseError where
eBase _ = 800
eNum (MalformedScheme NonAlphaLeading) = 801
eNum (MalformedScheme InvalidChars) = 802
eNum (MalformedScheme MissingColon) = 803
eNum MalformedUserInfo = 804
eNum MalformedQuery = 805
eNum MalformedFragment = 806
eNum MalformedHost = 807
eNum MalformedPort = 808
eNum MalformedPath = 809
eNum (OtherError _) = 810
eDesc _ = "Failed to parse URI."
instance Pretty ArchiveResult where instance Pretty ArchiveResult where
pPrint ArchiveFatal = text "Archive result: fatal" pPrint ArchiveFatal = text "Archive result: fatal"
pPrint ArchiveFailed = text "Archive result: failed" pPrint ArchiveFailed = text "Archive result: failed"
@@ -938,37 +411,5 @@ instance Pretty ArchiveResult where
pPrint ArchiveOk = text "Archive result: Ok" pPrint ArchiveOk = text "Archive result: Ok"
pPrint ArchiveEOF = text "Archive result: EOF" pPrint ArchiveEOF = text "Archive result: EOF"
instance HFErrorProject ArchiveResult where
eBase _ = 820
eNum ArchiveFatal = 821
eNum ArchiveFailed = 822
eNum ArchiveWarn = 823
eNum ArchiveRetry = 824
eNum ArchiveOk = 825
eNum ArchiveEOF = 826
eDesc _ = "Archive extraction result."
instance Pretty T.Text where instance Pretty T.Text where
pPrint = text . T.unpack pPrint = text . T.unpack
instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
instance HFErrorProject ProcessError where
eBase _ = 840
eNum NonZeroExit{} = 841
eNum (PTerminated _ _) = 842
eNum (PStopped _ _) = 843
eNum (NoSuchPid _ _) = 844
eDesc _ = "A process exited prematurely."

File diff suppressed because it is too large Load Diff

View File

@@ -1,729 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : GHCup.HLS
Description : GHCup installation functions for HLS
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.HLS where
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prelude.String.QQ
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Ord
import Data.Maybe
import Data.String ( fromString )
import Data.Text ( Text )
import Data.Versions hiding ( patch )
import Distribution.Types.Version hiding ( Version )
import Distribution.Types.PackageId
import Distribution.Types.PackageDescription
import Distribution.Types.GenericPackageDescription
import Distribution.PackageDescription.Parsec
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts
import Optics
import Prelude hiding ( abs
, writeFile
)
import Safe hiding ( at )
import System.FilePath
import System.IO.Error
import Text.Regex.Posix
import URI.ByteString
import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
data HLSVer = SourceDist Version
| GitDist GitBranch
| HackageDist Version
| RemoteDist URI
deriving (Eq, Show)
--------------------
--[ Installation ]--
--------------------
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installHLSBindist :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> InstallDir -- ^ isolated install path, if user passed any
-> Bool -- ^ Force install
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
, ProcessError
, DirNotEmpty
, UninstallFailed
, MergeFileTreeError
]
m
()
installHLSBindist dlinfo ver installDir forceInstall = do
lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs
regularHLSInstalled <- lift $ hlsInstalled ver
if
| not forceInstall
, regularHLSInstalled
, GHCupInternal <- installDir -> do -- regular install
throwE $ AlreadyInstalled HLS ver
| forceInstall
, regularHLSInstalled
, GHCupInternal <- installDir -> do -- regular forced install
lift $ logInfo "Removing the currently installed version of HLS before force installing!"
liftE $ rmHLSVer ver
| otherwise -> pure ()
-- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
tmpUnpack <- lift withGHCupTmpDir
liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-- the subdir of the archive where we do the work
workdir <- fromGHCupPath <$> maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
legacy <- liftIO $ isLegacyHLSBindist workdir
if
| not forceInstall
, not legacy
, (IsolateDir fp) <- installDir -> liftE $ installDestSanityCheck (IsolateDirResolved fp)
| otherwise -> pure ()
case installDir of
IsolateDir isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
if legacy
then liftE $ installHLSUnpackedLegacy workdir (IsolateDirResolved isoDir) ver forceInstall
else liftE $ runBuildAction tmpUnpack $ installHLSUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
GHCupInternal -> do
if legacy
then liftE $ installHLSUnpackedLegacy workdir (GHCupBinDir binDir) ver forceInstall
else do
inst <- ghcupHLSDir ver
liftE $ runBuildAction tmpUnpack
$ installHLSUnpacked workdir (GHCupDir inst) ver forceInstall
liftE $ setHLS ver SetHLS_XYZ Nothing
isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
-> IO Bool
isLegacyHLSBindist path = do
not <$> doesFileExist (path </> "GNUmakefile")
-- | Install an unpacked hls distribution.
installHLSUnpacked :: ( MonadMask m
, MonadUnliftIO m
, MonadReader env m
, MonadFail m
, HasLog env
, HasDirs env
, HasSettings env
, MonadCatch m
, MonadIO m
, MonadResource m
, HasPlatformReq env
)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> InstallDirResolved -- ^ Path to install to
-> Version
-> Bool
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled, MergeFileTreeError] m ()
installHLSUnpacked path inst ver forceInstall = do
PlatformRequest { .. } <- lift getPlatformReq
lift $ logInfo "Installing HLS"
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "PREFIX=" <> fromInstallDir inst, "install"] (Just path)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
inst
HLS
(mkTVer ver)
(\f t -> liftIO $ do
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
install f t (not forceInstall)
forM_ mtime $ setModificationTime t)
-- | Install an unpacked hls distribution (legacy).
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> InstallDirResolved -- ^ Path to install to
-> Version
-> Bool -- ^ is it a force install
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy path installDir ver forceInstall = do
lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' (fromInstallDir installDir)
-- install haskell-language-server-<ghcver>
bins@(_:_) <- liftIO $ findFiles
path
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
)
forM_ bins $ \f -> do
let toF = dropSuffix exeExt f
<> (case installDir of
IsolateDirResolved _ -> ""
_ -> ("~" <>) . T.unpack . prettyVer $ ver
)
<> exeExt
let srcPath = path </> f
let destPath = fromInstallDir installDir </> toF
-- destination could be an existing symlink
-- for new make-based HLSes
liftIO $ rmFileForce destPath
copyFileE
srcPath
destPath
(not forceInstall)
lift $ chmod_755 destPath
-- install haskell-language-server-wrapper
let wrapper = "haskell-language-server-wrapper"
toF = wrapper
<> (case installDir of
IsolateDirResolved _ -> ""
_ -> ("-" <>) . T.unpack . prettyVer $ ver
)
<> exeExt
srcWrapperPath = path </> wrapper <> exeExt
destWrapperPath = fromInstallDir installDir </> toF
liftIO $ rmFileForce destWrapperPath
copyFileE
srcWrapperPath
destWrapperPath
(not forceInstall)
lift $ chmod_755 destWrapperPath
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Version
-> InstallDir
-> Bool -- force install
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
, ProcessError
, DirNotEmpty
, UninstallFailed
, MergeFileTreeError
]
m
()
installHLSBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo HLS ver
installHLSBindist dlinfo ver installDir forceInstall
compileHLS :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> HLSVer
-> [Version]
-> Maybe Int
-> Either Bool Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
-> Bool
-> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to cabal install
-> Excepts '[ NoDownload
, GPGError
, DownloadFailed
, DigestError
, ContentLengthError
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, BuildFailed
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
when updateCabal $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
lift $ logInfo "Updating cabal DB"
lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
(workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
-- unpack from version tarball
SourceDist tver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
-- download source tarball
dlInfo <-
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
?? NoDownload (mkTVer tver) HLS (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
tmpUnpack <- lift mkGhcupTmpDir
liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
pure (workdir, tmpUnpack, tver, Nothing)
HackageDist tver -> do
lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
-- download source tarball
tmpUnpack <- lift mkGhcupTmpDir
let hls = "haskell-language-server-" <> T.unpack (prettyVer tver)
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
-- unpack
lEM $ exec "cabal" ["unpack", hls] (Just $ fromGHCupPath tmpUnpack) Nothing
let workdir = appendGHCupPath tmpUnpack hls
pure (workdir, tmpUnpack, tver, Nothing)
RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
-- download source tarball
tmpDownload <- lift withGHCupTmpDir
tmpUnpack <- lift mkGhcupTmpDir
tar <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpDownload) Nothing False
(cf, tver) <- liftE $ cleanUpOnError tmpUnpack $ do
unpackToDir (fromGHCupPath tmpUnpack) tar
let regex = [s|^(.*/)*haskell-language-server\.cabal$|] :: B.ByteString
[cabalFile] <- liftIO $ findFilesDeep
tmpUnpack
(makeRegexOpts compExtended
execBlank
regex
)
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> cabalFile)
pure (cabalFile, tver)
let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
pure (workdir, tmpUnpack, tver, Nothing)
-- clone from git
GitDist GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ]
lEM $ git [ "remote"
, "add"
, "origin"
, fromString rep ]
-- figure out if we can do a shallow clone
remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
let shallow_clone
| gitDescribeRequested = False
| isCommitHash ref = True
| fromString ref `elem` remoteBranches = True
| otherwise = False
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-- fetch
let fetch_args
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
lEM $ git fetch_args
-- checkout
lEM $ git [ "checkout", fromString ref ]
-- gather some info
git_describe <- if shallow_clone
then pure Nothing
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
"HLS version (from cabal file): " <> prettyVer tver <>
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
pure (tmpUnpack, tmpUnpack, tver, git_describe)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
installVer <- case ov of
Left True -> case git_describe of
-- git describe
Just h -> either (fail . displayException) pure . version $ h
-- git describe, but not building from git, lol
Nothing -> pure tver
-- default: use detected version
Left False -> pure tver
-- overwrite version with users value
Right v -> pure v
liftE $ runBuildAction
tmpUnpack
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, ContentLengthError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
let tmpInstallDir = fromGHCupPath workdir </> "out"
liftIO $ createDirRecursive' tmpInstallDir
-- apply patches
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
-- set up project files
cp <- case cabalProject of
Just (Left cp)
| isAbsolute cp -> do
copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
pure "cabal.project"
| otherwise -> pure (takeFileName cp)
Just (Right uri) -> do
tmpUnpack' <- lift withGHCupTmpDir
cp <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpUnpack') (Just "cabal.project") False
copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
pure "cabal.project"
Nothing
| HackageDist _ <- targetHLS -> do
liftIO $ B.writeFile (fromGHCupPath workdir </> "cabal.project") "packages: ./"
pure "cabal.project"
| RemoteDist _ <- targetHLS -> do
let cabalFile = fromGHCupPath workdir </> "cabal.project"
liftIO $ whenM (not <$> doesFileExist cabalFile) $ B.writeFile cabalFile "packages: ./"
pure "cabal.project"
| otherwise -> pure "cabal.project"
forM_ cabalProjectLocal $ \uri -> do
tmpUnpack' <- lift withGHCupTmpDir
cpl <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpUnpack') (Just (cp <.> "local")) False
copyFileE cpl (fromGHCupPath workdir </> cp <.> "local") False
artifacts <- forM (sort ghcs) $ \ghc -> do
let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
liftIO $ createDirRecursive' tmpInstallDir
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
liftE $ lEM @_ @'[ProcessError] $
execLogged "cabal" ( [ "v2-install"
, "-w"
, "ghc-" <> T.unpack (prettyVer ghc)
, "--install-method=copy"
] ++
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
[ "--overwrite-policy=always"
, "--disable-profiling"
, "--disable-tests"
, "--installdir=" <> ghcInstallDir
, "--project-file=" <> cp
] ++ fmap T.unpack cabalArgs ++ [
"exe:haskell-language-server"
, "exe:haskell-language-server-wrapper"]
)
(Just $ fromGHCupPath workdir)
"cabal"
Nothing
pure ghcInstallDir
forM_ artifacts $ \artifact -> do
logDebug $ T.pack (show artifact)
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
(tmpInstallDir </> "haskell-language-server-wrapper" <.> exeExt)
case installDir of
IsolateDir isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpackedLegacy tmpInstallDir (IsolateDirResolved isoDir) installVer True
GHCupInternal -> do
liftE $ installHLSUnpackedLegacy tmpInstallDir (GHCupBinDir binDir) installVer True
)
pure installVer
where
gitDescribeRequested = case ov of
Left b -> b
_ -> False
-----------------
--[ Set/Unset ]--
-----------------
-- | Set the haskell-language-server symlinks.
setHLS :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
, MonadFail m
, MonadUnliftIO m
)
=> Version
-> SetHLS
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
-- and don't want mess with other versions
-> Excepts '[NotInstalled] m ()
setHLS ver shls mBinDir = do
whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
-- symlink destination
binDir <- case mBinDir of
Just x -> pure x
Nothing -> do
Dirs {binDir = f} <- lift getDirs
pure f
-- first delete the old symlinks
when (isNothing mBinDir) $
case shls of
-- not for legacy
SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
-- legacy and new
SetHLSOnly -> liftE rmPlainHLS
case shls of
-- not for legacy
SetHLS_XYZ -> do
bins <- lift $ hlsInternalServerScripts ver Nothing
forM_ bins $ \f -> do
let fname = takeFileName f
destL <- binarySymLinkDestination binDir f
let target = if "haskell-language-server-wrapper" `isPrefixOf` fname
then fname <> "-" <> T.unpack (prettyVer ver) <> exeExt
else fname <> "~" <> T.unpack (prettyVer ver) <> exeExt
lift $ createLink destL (binDir </> target)
-- legacy and new
SetHLSOnly -> do
-- set haskell-language-server-<ghcver> symlinks
bins <- lift $ hlsServerBinaries ver Nothing
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
forM_ bins $ \f -> do
let destL = f
let target = (<> exeExt) . head . splitOn "~" $ f
lift $ createLink destL (binDir </> target)
-- set haskell-language-server-wrapper symlink
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
lift $ createLink destL wrapper
when (isNothing mBinDir) $
lift warnAboutHlsCompatibility
liftIO (isShadowed wrapper) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed HLS pa wrapper ver)
unsetHLS :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadIO m)
=> m ()
unsetHLS = do
Dirs {..} <- getDirs
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles'
binDir
(MP.chunk "haskell-language-server-" <* pvp' <* MP.chunk (T.pack exeExt) <* MP.eof)
forM_ bins (hideError doesNotExistErrorType . rmLink . (binDir </>))
hideError doesNotExistErrorType $ rmLink wrapper
---------------
--[ Removal ]--
---------------
-- | Delete a hls version. Will try to fix the hls symlinks
-- after removal (e.g. setting it to an older version).
rmHLSVer :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadFail m
, MonadCatch m
, MonadUnliftIO m
)
=> Version
-> Excepts '[NotInstalled, UninstallFailed] m ()
rmHLSVer ver = do
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
isHlsSet <- lift hlsSet
liftE $ rmMinorHLSSymlinks ver
when (Just ver == isHlsSet) $ do
-- delete all set symlinks
liftE rmPlainHLS
hlsDir' <- ghcupHLSDir ver
let hlsDir = fromGHCupPath hlsDir'
lift (getInstalledFiles HLS (mkTVer ver)) >>= \case
Just files -> do
lift $ logInfo $ "Removing files safely from: " <> T.pack hlsDir
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> hlsDir </> dropDrive f))
removeEmptyDirsRecursive hlsDir
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory hlsDir
f <- recordedInstallationFile HLS (mkTVer ver)
lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
Nothing -> do
isDir <- liftIO $ doesDirectoryExist hlsDir
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
recyclePathForcibly hlsDir'
when (Just ver == isHlsSet) $ do
-- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs
case headMay . sortBy (comparing Down) $ hlsVers of
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
Nothing -> pure ()
getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version
getCabalVersion fp = do
contents <- liftIO $ B.readFile fp
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)
. versionNumbers
. pkgVersion
. package
. packageDescription
$ gpd
pure tver

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