Compare commits
55 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
e03c5ee4a1
|
|||
|
e57a8abd3d
|
|||
|
72f8e53344
|
|||
|
9c464ec9fc
|
|||
|
1c9b296a5e
|
|||
|
|
275522584e | ||
|
|
804520c4bb | ||
|
|
9d25581f3c | ||
|
|
e798037d80 | ||
|
|
2afe5858cb | ||
|
f575dcdad6
|
|||
|
6d3e8d65e1
|
|||
|
895e4b3f18
|
|||
|
20f0505120
|
|||
|
31e83cac5e
|
|||
|
d3a1115b99
|
|||
|
6d46849fec
|
|||
|
53e324bfee
|
|||
|
2e39b7b603
|
|||
|
048932bf50
|
|||
|
69d325bf90
|
|||
|
3d1b8859cd
|
|||
|
db89ca9942
|
|||
|
bba009d98c
|
|||
|
9d954ea174
|
|||
|
da9c9049d2
|
|||
|
a4c00d2c56
|
|||
|
|
b30f565871 | ||
|
|
fa378a1d34 | ||
|
|
119efb1ff4 | ||
|
1fb4101b49
|
|||
|
ec8333b223
|
|||
|
54b979aa0b
|
|||
|
ba274307c0
|
|||
|
|
a623d0809d | ||
|
e00899d176
|
|||
|
a38ca1954b
|
|||
|
3f5a19c63e
|
|||
|
525e9672e8
|
|||
|
070c6e1cf1
|
|||
|
195fd00e0a
|
|||
|
733d014c19
|
|||
|
16039769d5
|
|||
|
5eeb8ca9fc
|
|||
|
317a06bbc3
|
|||
|
f693adcd7c
|
|||
|
ac88d2bd50
|
|||
|
a427146de5
|
|||
|
a16bcddeaa
|
|||
|
74edf1fc07
|
|||
|
1e32639873
|
|||
|
0704d2640a
|
|||
|
26a6368d79
|
|||
|
fffaa65b7f
|
|||
|
703be0a706
|
11
.cirrus.yml
11
.cirrus.yml
@@ -1,10 +1,11 @@
|
||||
freebsd_instance:
|
||||
image_family: freebsd-13-1
|
||||
|
||||
task:
|
||||
build_task:
|
||||
name: build
|
||||
env:
|
||||
GHC_VER: 9.2.4
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.1.0
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
ARCH: 64
|
||||
RUNNER_OS: FreeBSD
|
||||
@@ -12,10 +13,10 @@ task:
|
||||
GITHUB_WORKSPACE: ${CIRRUS_WORKING_DIR}
|
||||
JSON_VERSION: "0.0.7"
|
||||
CIRRUS_CLONE_SUBMODULES: true
|
||||
AWS_ACCESS_KEY_ID: ENCRYPTED[3e99c4ac040871f213abd616ec66952d954dc289cdd97772f88e58a74d08a2250133437780fe98b7aedf7ef1fb32f5eb]
|
||||
AWS_SECRET_ACCESS_KEY: ENCRYPTED[5910cfd77a922ff7fc06eeb6a6b9f79d4867863e541f06eb2c4cfecae0613650e3e0588373fa8d9249d295d76cf9cb3b]
|
||||
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
||||
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
||||
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
||||
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
|
||||
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
||||
script:
|
||||
- tzsetup Etc/GMT
|
||||
- adjkerntz -a
|
||||
|
||||
4
.github/scripts/bootstrap.sh
vendored
4
.github/scripts/bootstrap.sh
vendored
@@ -2,7 +2,7 @@
|
||||
|
||||
set -eux
|
||||
|
||||
. .github/scripts/prereq.sh
|
||||
. .github/scripts/env.sh
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
@@ -13,4 +13,6 @@ git describe --always
|
||||
./scripts/bootstrap/bootstrap-haskell
|
||||
|
||||
[ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
|
||||
# https://github.com/actions/runner-images/issues/7061
|
||||
[ "$(ghcup config | grep --color=never meta-mode)" = "meta-mode: Lax" ]
|
||||
|
||||
|
||||
27
.github/scripts/brew.sh
vendored
Normal file
27
.github/scripts/brew.sh
vendored
Normal file
@@ -0,0 +1,27 @@
|
||||
#!/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+"$@"}
|
||||
|
||||
75
.github/scripts/build.sh
vendored
75
.github/scripts/build.sh
vendored
@@ -2,75 +2,34 @@
|
||||
|
||||
set -eux
|
||||
|
||||
. .github/scripts/prereq.sh
|
||||
. .github/scripts/common.sh
|
||||
|
||||
|
||||
# ensure ghcup
|
||||
if ! command -v ghcup ; then
|
||||
install_ghcup
|
||||
fi
|
||||
|
||||
# ensure cabal-cache
|
||||
if ! cabal-cache version ; then
|
||||
download_cabal_cache "$HOME/.local/bin/cabal-cache"
|
||||
fi
|
||||
|
||||
# ensure ghc
|
||||
if [ "${RUNNER_OS}" != "FreeBSD" ] ; then
|
||||
if [ "${DISTRO}" != "Debian" ] ; then # ! armv7 or aarch64 linux
|
||||
if ! "ghc-${GHC_VER}" --numeric-version ; then
|
||||
ghcup -v install ghc --set --force "$GHC_VER"
|
||||
fi
|
||||
if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
|
||||
ghcup -v install cabal --force "$CABAL_VER"
|
||||
fi
|
||||
ghc --version
|
||||
cabal --version
|
||||
GHC="ghc-${GHC_VER}"
|
||||
else
|
||||
if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
|
||||
ghcup -v install cabal --force "$CABAL_VER"
|
||||
fi
|
||||
cabal --version
|
||||
GHC="ghc"
|
||||
fi
|
||||
else
|
||||
ghc --version
|
||||
cabal --version
|
||||
GHC="ghc"
|
||||
fi
|
||||
|
||||
git_describe
|
||||
|
||||
# ensure ghcup
|
||||
install_ghcup
|
||||
|
||||
# ensure cabal-cache
|
||||
download_cabal_cache "$HOME/.local/bin/cabal-cache"
|
||||
|
||||
# install toolchain (if necessary)
|
||||
ghcup -v install ghc --set --force "$GHC_VER"
|
||||
ghcup -v install cabal --force "$CABAL_VER"
|
||||
ghc --version
|
||||
cabal --version
|
||||
GHC="ghc-${GHC_VER}"
|
||||
|
||||
# build
|
||||
ecabal update
|
||||
|
||||
if [ "${RUNNER_OS}" = "Linux" ] ; then
|
||||
if [ "${ARCH}" = "32" ] ; then
|
||||
build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
|
||||
elif [ "${ARCH}" = "64" ] ; then
|
||||
build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
|
||||
else
|
||||
build_with_cache -w "${GHC}" -ftui --enable-tests
|
||||
fi
|
||||
elif [ "${RUNNER_OS}" = "FreeBSD" ] ; then
|
||||
build_with_cache -w "${GHC}" --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui --enable-tests
|
||||
elif [ "${RUNNER_OS}" = "Windows" ] ; then
|
||||
build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" --enable-tests
|
||||
else
|
||||
build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui --enable-tests
|
||||
fi
|
||||
|
||||
build_with_cache --project-file=cabal.project.release -w "${GHC}" --enable-tests
|
||||
|
||||
# set up artifacts
|
||||
mkdir -p out
|
||||
binary=$(cabal list-bin ghcup)
|
||||
binary_test=$(cabal list-bin ghcup-test)
|
||||
binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
|
||||
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
|
||||
ver=$("${binary}" --numeric-version)
|
||||
strip_binary "${binary}"
|
||||
cp "${binary}" "out/${ARTIFACT}-${ver}"
|
||||
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}"
|
||||
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
|
||||
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
|
||||
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
|
||||
|
||||
|
||||
41
.github/scripts/common.sh
vendored
41
.github/scripts/common.sh
vendored
@@ -1,23 +1,13 @@
|
||||
#!/bin/sh
|
||||
|
||||
if [ "${RUNNER_OS}" = "Windows" ] ; then
|
||||
ext=".exe"
|
||||
else
|
||||
ext=''
|
||||
fi
|
||||
. .github/scripts/env.sh
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
sync_from_retry() {
|
||||
if [ "${RUNNER_OS}" != "Windows" ] ; then
|
||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||
else
|
||||
cabal_store_path="${CABAL_DIR}/store"
|
||||
fi
|
||||
|
||||
sync_from || { sleep 9 ; rm -rf "${cabal_store_path:?}"/* ; sync_from || { sleep 20 ; rm -rf "${cabal_store_path:?}"/* ; sync_from ; } }
|
||||
nonfatal() {
|
||||
"$@" || "$* failed"
|
||||
}
|
||||
|
||||
sync_from() {
|
||||
@@ -34,10 +24,6 @@ sync_from() {
|
||||
--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
|
||||
}
|
||||
|
||||
sync_to_retry() {
|
||||
sync_to || { sleep 9 ; sync_to || { sleep 20 ; sync_to ; } }
|
||||
}
|
||||
|
||||
sync_to() {
|
||||
if [ "${RUNNER_OS}" != "Windows" ] ; then
|
||||
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
|
||||
@@ -81,6 +67,7 @@ git_describe() {
|
||||
download_cabal_cache() {
|
||||
(
|
||||
set -e
|
||||
mkdir -p "$HOME/.local/bin"
|
||||
dest="$HOME/.local/bin/cabal-cache"
|
||||
url=""
|
||||
exe=""
|
||||
@@ -134,25 +121,15 @@ download_cabal_cache() {
|
||||
build_with_cache() {
|
||||
ecabal configure "$@"
|
||||
ecabal build --dependencies-only "$@" --dry-run
|
||||
sync_from_retry
|
||||
ecabal build --dependencies-only "$@" || sync_to_retry
|
||||
sync_to_retry
|
||||
sync_from
|
||||
ecabal build --dependencies-only "$@" || sync_to
|
||||
sync_to
|
||||
ecabal build "$@"
|
||||
sync_to_retry
|
||||
sync_to
|
||||
}
|
||||
|
||||
install_ghcup() {
|
||||
find "$GHCUP_INSTALL_BASE_PREFIX"
|
||||
mkdir -p "$GHCUP_BIN"
|
||||
mkdir -p "$GHCUP_BIN"/../cache
|
||||
|
||||
if [ "${RUNNER_OS}" = "FreeBSD" ] ; then
|
||||
curl -o ghcup https://downloads.haskell.org/ghcup/tmp/x86_64-portbld-freebsd-ghcup-0.1.18.1
|
||||
chmod +x ghcup
|
||||
mv ghcup "$HOME/.local/bin/ghcup"
|
||||
else
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
|
||||
fi
|
||||
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() {
|
||||
|
||||
30
.github/scripts/env.sh
vendored
Normal file
30
.github/scripts/env.sh
vendored
Normal file
@@ -0,0 +1,30 @@
|
||||
#!/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
|
||||
7
.github/scripts/hls.sh
vendored
7
.github/scripts/hls.sh
vendored
@@ -2,7 +2,6 @@
|
||||
|
||||
set -eux
|
||||
|
||||
. .github/scripts/prereq.sh
|
||||
. .github/scripts/common.sh
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
@@ -34,7 +33,7 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
|
||||
git_describe
|
||||
|
||||
eghcup install ghc "${GHC_VERSION}"
|
||||
eghcup install cabal
|
||||
eghcup install cabal "${CABAL_VERSION}"
|
||||
|
||||
ecabal update
|
||||
|
||||
@@ -57,9 +56,9 @@ eghcup debug-info
|
||||
cd "haskell-language-server-${HLS_TARGET_VERSION}/"
|
||||
ecabal configure -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)"
|
||||
ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" --dry-run
|
||||
sync_from_retry
|
||||
sync_from
|
||||
ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" || sync_to
|
||||
sync_to_retry
|
||||
sync_to
|
||||
)
|
||||
|
||||
eghcup -v compile hls -j "$(nproc)" -g "${HLS_TARGET_VERSION}" --ghc "${GHC_VERSION}"
|
||||
|
||||
66
.github/scripts/prereq.sh
vendored
66
.github/scripts/prereq.sh
vendored
@@ -1,66 +0,0 @@
|
||||
#!/bin/sh
|
||||
|
||||
mkdir -p "$HOME"/.local/bin
|
||||
|
||||
export OS="$RUNNER_OS"
|
||||
export PATH="$HOME/.local/bin:$PATH"
|
||||
: "${APT_GET:=apt-get}"
|
||||
|
||||
if [ "${RUNNER_OS}" = "Windows" ] ; then
|
||||
# on windows use pwd to get unix style path
|
||||
CI_PROJECT_DIR="$(pwd)"
|
||||
export CI_PROJECT_DIR
|
||||
export GHCUP_INSTALL_BASE_PREFIX="/c"
|
||||
export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$PATH"
|
||||
export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
|
||||
else
|
||||
export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
|
||||
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
|
||||
export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$PATH"
|
||||
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
|
||||
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
|
||||
fi
|
||||
|
||||
if [ "${RUNNER_OS}" = "Linux" ] ; then
|
||||
if [ "${DISTRO}" = "Alpine" ] ; then
|
||||
:
|
||||
elif [ "${DISTRO}" = "Ubuntu" ] ; then
|
||||
export DEBIAN_FRONTEND=noninteractive
|
||||
export TZ=Asia/Singapore
|
||||
if [ "${ARCH}" = "ARM64" ] || [ "${ARCH}" = "ARM" ] ; then
|
||||
:
|
||||
else
|
||||
${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
|
||||
fi
|
||||
elif [ "${DISTRO}" = "Debian" ] ; then
|
||||
export DEBIAN_FRONTEND=noninteractive
|
||||
export TZ=Asia/Singapore
|
||||
${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip
|
||||
fi
|
||||
elif [ "${RUNNER_OS}" = "macOS" ] ; then
|
||||
if ! command -v brew ; then
|
||||
[ -e "$HOME/.brew" ] ||
|
||||
git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
|
||||
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
|
||||
brew update
|
||||
fi
|
||||
if ! command -v git ; then
|
||||
brew install git
|
||||
fi
|
||||
if ! command -v realpath ; then
|
||||
brew install coreutils
|
||||
fi
|
||||
|
||||
if [ "${ARCH}" = "ARM64" ] ; then
|
||||
brew install llvm@11 autoconf automake
|
||||
export PATH="$HOME/.brew/opt/llvm@11/bin:$PATH"
|
||||
export CC="$HOME/.brew/opt/llvm@11/bin/clang"
|
||||
export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
|
||||
export LD=ld
|
||||
export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
|
||||
export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
|
||||
fi
|
||||
fi
|
||||
|
||||
5
.github/scripts/test.sh
vendored
5
.github/scripts/test.sh
vendored
@@ -2,7 +2,6 @@
|
||||
|
||||
set -eux
|
||||
|
||||
. .github/scripts/prereq.sh
|
||||
. .github/scripts/common.sh
|
||||
|
||||
|
||||
@@ -191,7 +190,7 @@ sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
# invalidate access time timer, which is 5minutes, so we re-download
|
||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
# redownload same file with some newlines added
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
|
||||
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")
|
||||
@@ -201,7 +200,7 @@ sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
# invalidate access time timer, which is 5minutes, but don't expect a re-download
|
||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
# this time, we expect the same hash and etag
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
|
||||
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}" ]
|
||||
|
||||
11
.github/workflows/bootstrap.yaml
vendored
11
.github/workflows/bootstrap.yaml
vendored
@@ -20,7 +20,6 @@ jobs:
|
||||
BOOTSTRAP_HASKELL_NONINTERACTIVE: yes
|
||||
ARCH: 64
|
||||
JSON_VERSION: "0.0.7"
|
||||
APT_GET: "sudo apt-get"
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
@@ -36,7 +35,15 @@ jobs:
|
||||
with:
|
||||
submodules: 'true'
|
||||
|
||||
- if: runner.os != 'Windows'
|
||||
- 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:
|
||||
|
||||
2
.github/workflows/cache.yaml
vendored
2
.github/workflows/cache.yaml
vendored
@@ -29,7 +29,7 @@ jobs:
|
||||
with:
|
||||
args: --recursive
|
||||
env:
|
||||
AWS_S3_ENDPOINT: ${{ secrets.S3_HOST }}
|
||||
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 }}
|
||||
|
||||
69
.github/workflows/docker.yaml
vendored
69
.github/workflows/docker.yaml
vendored
@@ -6,7 +6,7 @@ on:
|
||||
- cron: '0 0 * * *'
|
||||
|
||||
jobs:
|
||||
docker-alpine:
|
||||
docker-alpine32:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout
|
||||
@@ -26,7 +26,24 @@ jobs:
|
||||
context: ./docker/alpine32
|
||||
push: true
|
||||
tags: hasufell/i386-alpine-haskell:3.12
|
||||
platforms: linux/i386
|
||||
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:
|
||||
@@ -35,34 +52,58 @@ jobs:
|
||||
tags: hasufell/alpine-haskell:3.12
|
||||
platforms: linux/amd64
|
||||
|
||||
docker-arm:
|
||||
runs-on: [self-hosted, Linux, aarch64]
|
||||
docker-arm32:
|
||||
runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
name: Cleanup
|
||||
name: Cleanup (aarch64 linux)
|
||||
with:
|
||||
args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
|
||||
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 (arm64v8)
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm64v8/
|
||||
push: true
|
||||
tags: hasufell/arm64v8-ubuntu-haskell:focal
|
||||
platforms: linux/arm64
|
||||
- name: Build and push (arm32v7)
|
||||
|
||||
- name: Build and push
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm32v7
|
||||
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
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
context: ./docker/arm64v8/
|
||||
push: true
|
||||
tags: hasufell/arm64v8-ubuntu-haskell:focal
|
||||
platforms: linux/arm64
|
||||
|
||||
106
.github/workflows/release.yaml
vendored
106
.github/workflows/release.yaml
vendored
@@ -17,7 +17,7 @@ jobs:
|
||||
name: Build linux binary
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.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 }}
|
||||
@@ -81,7 +81,7 @@ jobs:
|
||||
name: Build ARM binary
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.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 }}
|
||||
@@ -90,13 +90,13 @@ jobs:
|
||||
fail-fast: true
|
||||
matrix:
|
||||
include:
|
||||
- os: [self-hosted, Linux, aarch64]
|
||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
||||
ARTIFACT: "armv7-linux-ghcup"
|
||||
GHC_VER: 8.10.7
|
||||
GHC_VER: 9.2.2
|
||||
ARCH: ARM
|
||||
- os: [self-hosted, Linux, aarch64]
|
||||
- os: [self-hosted, Linux, ARM64]
|
||||
ARTIFACT: "aarch64-linux-ghcup"
|
||||
GHC_VER: 8.10.7
|
||||
GHC_VER: 9.2.5
|
||||
ARCH: ARM64
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
@@ -154,7 +154,7 @@ jobs:
|
||||
name: Build binary (Mac/Win)
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.1.0
|
||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||
JSON_VERSION: "0.0.7"
|
||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||
@@ -164,7 +164,7 @@ jobs:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
include:
|
||||
- os: [self-hosted, macOS, aarch64]
|
||||
- os: [self-hosted, macOS, ARM64]
|
||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
ARCH: ARM64
|
||||
@@ -182,8 +182,48 @@ jobs:
|
||||
with:
|
||||
submodules: 'true'
|
||||
|
||||
- name: Run build (windows/mac)
|
||||
run: bash .github/scripts/build.sh
|
||||
- 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 }}
|
||||
@@ -202,13 +242,12 @@ jobs:
|
||||
path: |
|
||||
./out/*
|
||||
|
||||
|
||||
test-linux:
|
||||
name: Test linux
|
||||
needs: "build-linux"
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
strategy:
|
||||
matrix:
|
||||
@@ -264,13 +303,14 @@ jobs:
|
||||
|
||||
- if: matrix.DISTRO != 'Alpine'
|
||||
name: Run test (64 bit linux)
|
||||
run: sh .github/scripts/test.sh
|
||||
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 }}
|
||||
APT_GET: "sudo apt-get"
|
||||
|
||||
- if: failure()
|
||||
name: Upload artifact
|
||||
@@ -285,19 +325,19 @@ jobs:
|
||||
needs: "build-arm"
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
- os: [self-hosted, Linux, aarch64]
|
||||
- os: [self-hosted, Linux, ARM64, aarch32-linux]
|
||||
ARTIFACT: "armv7-linux-ghcup"
|
||||
GHC_VER: 8.10.7
|
||||
GHC_VER: 9.2.2
|
||||
ARCH: ARM
|
||||
DISTRO: Ubuntu
|
||||
- os: [self-hosted, Linux, aarch64]
|
||||
- os: [self-hosted, Linux, ARM64]
|
||||
ARTIFACT: "aarch64-linux-ghcup"
|
||||
GHC_VER: 8.10.7
|
||||
GHC_VER: 9.2.5
|
||||
ARCH: ARM64
|
||||
DISTRO: Ubuntu
|
||||
|
||||
@@ -352,13 +392,13 @@ jobs:
|
||||
needs: "build-macwin"
|
||||
runs-on: ${{ matrix.os }}
|
||||
env:
|
||||
CABAL_VER: 3.6.2.0
|
||||
CABAL_VER: 3.8.1.0
|
||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||
JSON_VERSION: "0.0.7"
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
- os: [self-hosted, macOS, aarch64]
|
||||
- os: [self-hosted, macOS, ARM64]
|
||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||
GHC_VER: 9.2.5
|
||||
ARCH: ARM64
|
||||
@@ -385,7 +425,21 @@ jobs:
|
||||
name: artifacts
|
||||
path: ./out
|
||||
|
||||
- name: Run test (windows/mac)
|
||||
- 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 }}
|
||||
@@ -416,7 +470,7 @@ jobs:
|
||||
env:
|
||||
GHC_VERSION: "8.10.7"
|
||||
HLS_TARGET_VERSION: "1.8.0.0"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CABAL_VERSION: "3.8.1.0"
|
||||
JSON_VERSION: "0.0.7"
|
||||
ARTIFACT: "x86_64-linux-ghcup"
|
||||
DISTRO: Ubuntu
|
||||
@@ -436,9 +490,9 @@ jobs:
|
||||
path: ./out
|
||||
|
||||
- name: Run hls build
|
||||
run: sh .github/scripts/hls.sh
|
||||
env:
|
||||
APT_GET: "sudo apt-get"
|
||||
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
|
||||
|
||||
25
.travis.yml
25
.travis.yml
@@ -1,25 +0,0 @@
|
||||
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
|
||||
19
CHANGELOG.md
19
CHANGELOG.md
@@ -1,5 +1,24 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 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)
|
||||
|
||||
@@ -1,621 +0,0 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
|
||||
module AnsiMain where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Prelude ( decUTF8Safe )
|
||||
import GHCup.Prelude.File
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Utils
|
||||
|
||||
import Data.List (sort, intersperse)
|
||||
import Data.Versions (prettyPVP, prettyVer)
|
||||
import Codec.Archive
|
||||
import Control.Monad.IO.Class
|
||||
-- import System.Console.ANSI
|
||||
import System.Console.ANSI
|
||||
import Terminal.Game
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad ( when, forM_ )
|
||||
import Control.Monad.ST
|
||||
import Control.Monad.Reader ( ReaderT(runReaderT), MonadReader, ask, lift )
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.STRef
|
||||
import Data.IORef
|
||||
import Data.Maybe ( fromMaybe, catMaybes )
|
||||
import qualified Data.Text as Tx
|
||||
import qualified Data.Tuple as T
|
||||
import qualified Data.Vector as V
|
||||
import GHC.IO ( unsafePerformIO )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import System.Exit
|
||||
import System.Environment (getExecutablePath)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as B
|
||||
import qualified Data.Text.Lazy as L
|
||||
import System.FilePath
|
||||
import URI.ByteString (serializeURIRef')
|
||||
|
||||
|
||||
|
||||
data Direction = Up
|
||||
| Down
|
||||
deriving (Show, Eq)
|
||||
|
||||
data BrickData = BrickData
|
||||
{ lr :: [ListResult]
|
||||
}
|
||||
deriving Show
|
||||
|
||||
data BrickSettings = BrickSettings
|
||||
{ showAllVersions :: Bool
|
||||
, showAllTools :: Bool
|
||||
}
|
||||
deriving Show
|
||||
|
||||
data BrickInternalState = BrickInternalState
|
||||
{ clr :: V.Vector ListResult
|
||||
, ix :: Int
|
||||
}
|
||||
deriving Show
|
||||
|
||||
data BrickState = BrickState
|
||||
{ appData :: BrickData
|
||||
, appSettings :: BrickSettings
|
||||
, appState :: BrickInternalState
|
||||
, appKeys :: KeyBindings
|
||||
, appQuit :: Bool
|
||||
, appRestart :: Bool
|
||||
, appMoreInput :: Maybe String
|
||||
}
|
||||
deriving Show
|
||||
|
||||
|
||||
startGame :: BrickState -> IO BrickState
|
||||
startGame g = do
|
||||
g'@BrickState { appRestart } <- errorPress $ playGameT liftIO (ghcupGame g)
|
||||
if appRestart
|
||||
then do
|
||||
putStrLn "Press enter to continue"
|
||||
_ <- getLine
|
||||
startGame $ g' { appRestart = False }
|
||||
else pure g'
|
||||
|
||||
ansiMain :: AppState -> IO ()
|
||||
ansiMain s = do
|
||||
writeIORef settings' s
|
||||
|
||||
eAppData <- getAppData (Just $ ghcupInfo s)
|
||||
case eAppData of
|
||||
Right ad -> do
|
||||
let g = BrickState ad
|
||||
defaultAppSettings
|
||||
(constructList ad defaultAppSettings Nothing)
|
||||
(keyBindings (s :: AppState))
|
||||
False
|
||||
False
|
||||
Nothing
|
||||
|
||||
|
||||
sizeCheck
|
||||
void $ startGame g
|
||||
cleanAndExit
|
||||
Left e -> do
|
||||
flip runReaderT s $ logError $ "Error building app state: " <> Tx.pack
|
||||
(show e)
|
||||
exitWith $ ExitFailure 2
|
||||
|
||||
|
||||
where
|
||||
sizeCheck :: IO ()
|
||||
sizeCheck = let (w, h) = T.swap . snd $ boundaries in assertTermDims w h
|
||||
|
||||
|
||||
ghcupGame :: BrickState -> Game BrickState
|
||||
ghcupGame bs = Game 13
|
||||
bs -- ticks per second
|
||||
(\ge s e -> logicFun ge s e) -- logic function
|
||||
(\r s -> centerFull r $ drawFun s r) -- draw function
|
||||
(\s -> appQuit s || appRestart s) -- quit function
|
||||
|
||||
|
||||
drawFun :: BrickState -> GEnv -> Plane
|
||||
drawFun (BrickState {..}) GEnv{..} =
|
||||
let focus pl = maybe pl
|
||||
(\ix -> V.update pl (V.singleton (ix + 1, fmap invert $ pl V.! (ix + 1))))
|
||||
mix
|
||||
rows = V.fromList [header, [box (mw - 2) 1 '=']] V.++ renderItems
|
||||
cols = V.foldr (\xs ys -> zipWith (:) xs ys) (repeat []) $ V.filter ((==5) . length) rows
|
||||
padded = focus $ V.map (\xs -> zipWith padTo xs lengths) rows
|
||||
lengths :: [Int]
|
||||
lengths = fmap (maximum . fmap (fst . planeSize)) cols
|
||||
in blankPlane mw mh
|
||||
& (1, 1) % box 1 1 'X' -- '┌'
|
||||
& (2, 1) % box 1 (mh - 3) '|' -- '│'
|
||||
& (1, 2) % box (mw - 2) 1 '=' -- '─'
|
||||
& (2, mw) % box 1 (mh - 3) '|' -- '│'
|
||||
& (1, mw) % box 1 1 'X' -- '┐'
|
||||
& (mh-1, 2) % box (mw - 2) 1 '=' -- '─'
|
||||
& (mh-1, 1) % box 1 1 'X' -- '└'
|
||||
& (mh-1, mw) % box 1 1 'X' -- '┘'
|
||||
& (2, 2) % box (mw - 2) (mh - 3) ' ' -- ' '
|
||||
& (2, 2) % vcat (hcat <$> V.toList padded)
|
||||
& (mh, 1) % footer
|
||||
& (1, mw `div` 2 - 2) % stringPlane "GHCup"
|
||||
where
|
||||
|
||||
padTo :: Plane -> Int -> Plane
|
||||
padTo plane x =
|
||||
let lstr = fst $ planeSize plane
|
||||
add' = x - lstr + 1
|
||||
in if add' < 0 then plane else plane ||| stringPlane (replicate add' ' ')
|
||||
mh :: Height
|
||||
mw :: Width
|
||||
(mh, mw) = T.swap eTermDims
|
||||
footer = hcat
|
||||
. intersperse (stringPlane " ")
|
||||
. fmap stringPlane
|
||||
$ ["q:Quit", "i:Install", "u:Uninstall", "s:Set", "c:Changelog", "a:all versions", "↑:Up", "↓:Down"]
|
||||
header = fmap stringPlane [" ", "Tool", "Version", "Tags", "Notes"]
|
||||
(renderItems, mix) = drawListElements renderItem appState
|
||||
renderItem _ _ listResult@ListResult{..} =
|
||||
let marks = if
|
||||
| lSet -> color Green Vivid $ stringPlane "IS"
|
||||
| lInstalled -> color Green Vivid $ stringPlane "I "
|
||||
| otherwise -> color Red Vivid $ stringPlane "X "
|
||||
ver = case lCross of
|
||||
Nothing -> stringPlane . Tx.unpack . prettyVer $ lVer
|
||||
Just c -> stringPlane . Tx.unpack $ (c <> "-" <> prettyVer lVer)
|
||||
tool = printTool lTool
|
||||
tag = let l = catMaybes . fmap printTag $ sort lTag
|
||||
in if null l then blankPlane 1 1 else foldr1 (\x y -> x ||| stringPlane "," ||| y) l
|
||||
notes = let n = printNotes listResult
|
||||
in if null n
|
||||
then blankPlane 1 1
|
||||
else foldr1 (\x y -> x ||| stringPlane "," ||| y) n
|
||||
|
||||
in [marks ||| space, tool, ver, tag, notes]
|
||||
|
||||
printTag Recommended = Just $ color Green Dull $ stringPlane "recommended"
|
||||
printTag Latest = Just $ color Yellow Dull $ stringPlane "latest"
|
||||
printTag Prerelease = Just $ color Red Dull $ stringPlane "prerelease"
|
||||
printTag (Base pvp'') = Just $ stringPlane ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
printTag Old = Nothing
|
||||
printTag (UnknownTag t) = Just $ stringPlane t
|
||||
|
||||
printTool Cabal = stringPlane "cabal"
|
||||
printTool GHC = stringPlane "GHC"
|
||||
printTool GHCup = stringPlane "GHCup"
|
||||
printTool HLS = stringPlane "HLS"
|
||||
printTool Stack = stringPlane "Stack"
|
||||
|
||||
printNotes ListResult {..} =
|
||||
(if hlsPowered then [color Green Dull $ stringPlane "hls-powered"] else mempty
|
||||
)
|
||||
++ (if fromSrc then [color Blue Dull $ stringPlane "compiled"] else mempty)
|
||||
++ (if lStray then [color Blue Dull $ stringPlane "stray"] else mempty)
|
||||
|
||||
space = stringPlane " "
|
||||
|
||||
-- | Draws the list elements.
|
||||
--
|
||||
-- Evaluates the underlying container up to, and a bit beyond, the
|
||||
-- selected element. The exact amount depends on available height
|
||||
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
|
||||
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
|
||||
-- available height.
|
||||
drawListElements :: (Int -> Bool -> ListResult -> [Plane])
|
||||
-> BrickInternalState
|
||||
-> (V.Vector [Plane], Maybe Int)
|
||||
drawListElements drawElem is@(BrickInternalState clr _) =
|
||||
let es = clr
|
||||
listSelected = fmap fst $ listSelectedElement' is
|
||||
|
||||
(drawnElements, selIx) = runST $ do
|
||||
ref <- newSTRef (Nothing :: Maybe Int)
|
||||
vec <- newSTRef (mempty :: V.Vector [Plane])
|
||||
elem' <- newSTRef 0
|
||||
void $ flip V.imapM es $ \i' e -> do
|
||||
let isSelected = Just i' == listSelected
|
||||
elemWidget = drawElem i' isSelected e
|
||||
case es V.!? (i' - 1) of
|
||||
Just e' | lTool e' /= lTool e -> do
|
||||
modifySTRef elem' (+2)
|
||||
i <- readSTRef elem'
|
||||
when isSelected $ writeSTRef ref (Just i)
|
||||
modifySTRef vec (`V.snoc` [hBorder])
|
||||
modifySTRef vec (`V.snoc` elemWidget)
|
||||
pure ()
|
||||
_ -> do
|
||||
modifySTRef elem' (+1)
|
||||
i <- readSTRef elem'
|
||||
when isSelected $ writeSTRef ref (Just i)
|
||||
modifySTRef vec (`V.snoc` elemWidget)
|
||||
pure ()
|
||||
i <- readSTRef ref
|
||||
arr <- readSTRef vec
|
||||
pure (arr, i)
|
||||
in (makeVisible drawnElements (mh - 5) selIx, selIx)
|
||||
where
|
||||
makeVisible :: V.Vector [Plane] -> Height -> Maybe Int -> V.Vector [Plane]
|
||||
makeVisible listElements drawableHeight (Just ix) =
|
||||
let listHeight = V.length listElements
|
||||
in if | listHeight <= 0 -> listElements
|
||||
| listHeight > drawableHeight ->
|
||||
if | ix <= drawableHeight -> makeVisible (V.init listElements) drawableHeight (Just ix)
|
||||
| otherwise -> makeVisible (V.tail listElements) drawableHeight (Just (ix - 1))
|
||||
| otherwise -> listElements
|
||||
makeVisible listElements _ Nothing = listElements
|
||||
|
||||
hBorder = box (mw - 2) 1 '='
|
||||
|
||||
|
||||
logicFun :: GEnv -> BrickState -> Event -> IO BrickState
|
||||
logicFun _ gs (KeyPress 'q') = pure gs { appQuit = True }
|
||||
logicFun _ gs@BrickState{appMoreInput = Nothing} (KeyPress '\ESC') = pure gs { appMoreInput = Just "\ESC" }
|
||||
logicFun _ gs@BrickState{appMoreInput = Just "\ESC"} (KeyPress '[') = pure gs { appMoreInput = Just "\ESC[" }
|
||||
logicFun _ gs@BrickState{appMoreInput = Just "\ESC[", appState = s'} (KeyPress 'A')
|
||||
= pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Up }
|
||||
logicFun _ gs@BrickState{appMoreInput = Just "\ESC[", appState = s'} (KeyPress 'B')
|
||||
= pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Down }
|
||||
logicFun _ gs@BrickState{appMoreInput = Just _} _ = pure gs { appMoreInput = Nothing }
|
||||
logicFun _ gs (KeyPress 'i') = do
|
||||
bs <- withIOAction install' gs
|
||||
pure bs { appRestart = True }
|
||||
logicFun _ gs (KeyPress 'u') = do
|
||||
bs <- withIOAction del' gs
|
||||
pure bs { appRestart = True }
|
||||
logicFun _ gs (KeyPress 's') = do
|
||||
bs <- withIOAction set' gs
|
||||
pure bs { appRestart = True }
|
||||
logicFun _ gs (KeyPress 'c') = do
|
||||
bs <- withIOAction changelog' gs
|
||||
pure bs { appRestart = True }
|
||||
logicFun _ gs (KeyPress 'a') = pure $ hideShowHandler (not . showAllVersions) showAllTools gs
|
||||
where
|
||||
hideShowHandler :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> BrickState -> BrickState
|
||||
hideShowHandler f p BrickState{..} =
|
||||
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
|
||||
newInternalState = constructList appData newAppSettings (Just appState)
|
||||
in BrickState appData newAppSettings newInternalState appKeys appQuit appRestart appMoreInput
|
||||
|
||||
-- windows powershell
|
||||
logicFun _ gs@BrickState{ appState = s' } (KeyPress 'P') = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Down }
|
||||
logicFun _ gs@BrickState{ appState = s' } (KeyPress 'H') = pure gs { appMoreInput = Nothing, appState = moveCursor 1 s' Up }
|
||||
|
||||
logicFun _ gs Tick = pure gs
|
||||
logicFun _ gs (KeyPress _) = pure gs
|
||||
|
||||
withIOAction :: (BrickState
|
||||
-> (Int, ListResult)
|
||||
-> ReaderT AppState IO (Either String a))
|
||||
-> BrickState
|
||||
-> IO BrickState
|
||||
withIOAction action as = case listSelectedElement' (appState as) of
|
||||
Nothing -> pure as
|
||||
Just (ix, e) -> do
|
||||
clearScreen
|
||||
|
||||
settings <- readIORef settings'
|
||||
flip runReaderT settings $ action as (ix, e) >>= \case
|
||||
Left err -> liftIO $ putStrLn ("Error: " <> err)
|
||||
Right _ -> liftIO $ putStrLn "Success"
|
||||
getAppData Nothing >>= \case
|
||||
Right data' -> do
|
||||
pure (updateList data' as)
|
||||
Left err -> throwIO $ userError err
|
||||
|
||||
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
|
||||
moveCursor steps ais@BrickInternalState{..} direction =
|
||||
let newIx = if direction == Down then ix + steps else ix - steps
|
||||
in case clr V.!? newIx of
|
||||
Just _ -> BrickInternalState { ix = newIx, .. }
|
||||
Nothing -> ais
|
||||
|
||||
defaultAppSettings :: BrickSettings
|
||||
defaultAppSettings =
|
||||
BrickSettings { showAllVersions = False, showAllTools = False }
|
||||
|
||||
-- | Update app data and list internal state based on new evidence.
|
||||
-- This synchronises @BrickInternalState@ with @BrickData@
|
||||
-- and @BrickSettings@.
|
||||
updateList :: BrickData -> BrickState -> BrickState
|
||||
updateList appD BrickState{..} =
|
||||
let newInternalState = constructList appD appSettings (Just appState)
|
||||
in BrickState { appState = newInternalState
|
||||
, appData = appD
|
||||
, appSettings = appSettings
|
||||
, appKeys = appKeys
|
||||
, appQuit = appQuit
|
||||
, appRestart = appRestart
|
||||
, appMoreInput = appMoreInput
|
||||
}
|
||||
|
||||
constructList
|
||||
:: BrickData
|
||||
-> BrickSettings
|
||||
-> Maybe BrickInternalState
|
||||
-> BrickInternalState
|
||||
constructList appD appSettings = replaceLR
|
||||
(filterVisible (showAllVersions appSettings) (showAllTools appSettings))
|
||||
(lr appD)
|
||||
|
||||
|
||||
-- | Replace the @appState@ or construct it based on a filter function
|
||||
-- and a new @[ListResult]@ evidence.
|
||||
-- When passed an existing @appState@, tries to keep the selected element.
|
||||
replaceLR
|
||||
:: (ListResult -> Bool)
|
||||
-> [ListResult]
|
||||
-> Maybe BrickInternalState
|
||||
-> BrickInternalState
|
||||
replaceLR filterF lr s =
|
||||
let oldElem = s >>= listSelectedElement'
|
||||
newVec = V.fromList . filter filterF $ lr
|
||||
newSelected =
|
||||
case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
|
||||
Just ix -> ix
|
||||
Nothing -> selectLatest newVec
|
||||
in BrickInternalState newVec newSelected
|
||||
where
|
||||
toolEqual e1 e2 =
|
||||
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
|
||||
|
||||
|
||||
filterVisible :: Bool -> Bool -> ListResult -> Bool
|
||||
filterVisible v t e
|
||||
| lInstalled e = True
|
||||
| v, not t, lTool e `notElem` hiddenTools = True
|
||||
| not v, t, Old `notElem` lTag e = True
|
||||
| v, t = True
|
||||
| otherwise = (Old `notElem` lTag e) && (lTool e `notElem` hiddenTools)
|
||||
|
||||
|
||||
hiddenTools :: [Tool]
|
||||
hiddenTools = []
|
||||
|
||||
|
||||
selectLatest :: V.Vector ListResult -> Int
|
||||
selectLatest = fromMaybe 0
|
||||
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
|
||||
|
||||
|
||||
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
|
||||
listSelectedElement' BrickInternalState {..} = fmap (ix, ) $ clr V.!? ix
|
||||
|
||||
|
||||
boundaries :: (Coords, Coords)
|
||||
boundaries = ((1, 1), (24, 80))
|
||||
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
install' _ (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
let run =
|
||||
runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, ArchiveResult
|
||||
, UnknownArchive
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, DirNotEmpty
|
||||
, NoUpdate
|
||||
, TarDirDoesNotExist
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, ToolShadowed
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
]
|
||||
|
||||
run (do
|
||||
ce <- liftIO $ fmap (either (const Nothing) Just) $
|
||||
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
|
||||
dirs <- lift getDirs
|
||||
case lTool of
|
||||
GHC -> do
|
||||
let vi = getVersionInfo lVer GHC dls
|
||||
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
|
||||
Cabal -> do
|
||||
let vi = getVersionInfo lVer Cabal dls
|
||||
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
Stack -> do
|
||||
let vi = getVersionInfo lVer Stack dls
|
||||
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, Dirs{..}, Just ce) -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
|
||||
when ((normalise <$> up) == Just (normalise ce)) $
|
||||
-- TODO: track cli arguments of previous invocation
|
||||
void $ liftIO $ exec ce ["tui"] Nothing Nothing
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
_ -> pure ()
|
||||
pure $ Right ()
|
||||
VRight (vi, _, _) -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
pure $ Right ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
VLeft (V NoUpdate) -> pure $ Right ()
|
||||
VLeft e -> pure $ Left $ prettyShow e <> "\n"
|
||||
<> "Also check the logs in ~/.ghcup/logs"
|
||||
|
||||
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
set' bs input@(_, ListResult {..}) = do
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
let run =
|
||||
flip runReaderT settings
|
||||
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
||||
|
||||
run (do
|
||||
case lTool of
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
|
||||
Cabal -> liftE $ setCabal lVer $> ()
|
||||
HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
|
||||
Stack -> liftE $ setStack lVer $> ()
|
||||
GHCup -> pure ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
VLeft e -> case e of
|
||||
(V (NotInstalled tool _)) -> do
|
||||
promptAnswer <- getUserPromptResponse userPrompt
|
||||
case promptAnswer of
|
||||
PromptYes -> do
|
||||
res <- install' bs input
|
||||
case res of
|
||||
(Left err) -> pure $ Left err
|
||||
(Right _) -> do
|
||||
logInfo "Setting now..."
|
||||
set' bs input
|
||||
|
||||
PromptNo -> pure $ Left (prettyShow e)
|
||||
where
|
||||
userPrompt = L.toStrict . B.toLazyText . B.fromString $
|
||||
"This Version of "
|
||||
<> show tool
|
||||
<> " you are trying to set is not installed.\n"
|
||||
<> "Would you like to install it first? [Y/N]: "
|
||||
|
||||
_ -> pure $ Left (prettyShow e)
|
||||
|
||||
|
||||
|
||||
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
del' _ (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
let run = runE @'[NotInstalled, UninstallFailed]
|
||||
|
||||
run (do
|
||||
let vi = getVersionInfo lVer lTool dls
|
||||
case lTool of
|
||||
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
|
||||
Cabal -> liftE $ rmCabalVer lVer $> vi
|
||||
HLS -> liftE $ rmHLSVer lVer $> vi
|
||||
Stack -> liftE $ rmStackVer lVer $> vi
|
||||
GHCup -> pure Nothing
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
|
||||
|
||||
changelog' :: (MonadReader AppState m, MonadIO m)
|
||||
=> BrickState
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
changelog' _ (_, ListResult {..}) = do
|
||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
case getChangeLog dls lTool (Left lVer) of
|
||||
Nothing -> pure $ Left $
|
||||
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
|
||||
Just uri -> do
|
||||
let cmd = case _rPlatform pfreq of
|
||||
Darwin -> "open"
|
||||
Linux _ -> "xdg-open"
|
||||
FreeBSD -> "xdg-open"
|
||||
Windows -> "start"
|
||||
exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
|
||||
Right _ -> pure $ Right ()
|
||||
Left e -> pure $ Left $ prettyShow e
|
||||
|
||||
|
||||
settings' :: IORef AppState
|
||||
{-# NOINLINE settings' #-}
|
||||
settings' = unsafePerformIO $ do
|
||||
dirs <- getAllDirs
|
||||
let loggerConfig = LoggerConfig { lcPrintDebug = False
|
||||
, consoleOutter = \_ -> pure ()
|
||||
, fileOutter = \_ -> pure ()
|
||||
, fancyColors = True
|
||||
}
|
||||
newIORef $ AppState defaultSettings
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
(GHCupInfo mempty mempty mempty)
|
||||
(PlatformRequest A_64 Darwin Nothing)
|
||||
loggerConfig
|
||||
|
||||
|
||||
getAppData :: Maybe GHCupInfo -> IO (Either String BrickData)
|
||||
getAppData mgi = runExceptT $ do
|
||||
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
|
||||
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
flip runReaderT settings $ do
|
||||
lV <- listVersions Nothing Nothing
|
||||
pure $ BrickData (reverse lV)
|
||||
|
||||
|
||||
getGHCupInfo :: IO (Either String GHCupInfo)
|
||||
getGHCupInfo = do
|
||||
settings <- readIORef settings'
|
||||
|
||||
r <-
|
||||
flip runReaderT settings
|
||||
. runE
|
||||
@'[ DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
, JSONError
|
||||
, DownloadFailed
|
||||
, FileDoesNotExistError
|
||||
]
|
||||
$ liftE getDownloadsF
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
|
||||
|
||||
@@ -95,11 +95,11 @@ data BrickState = BrickState
|
||||
keyHandlers :: KeyBindings
|
||||
-> [ ( Vty.Key
|
||||
, BrickSettings -> String
|
||||
, BrickState -> EventM n (Next BrickState)
|
||||
, BrickState -> EventM String BrickState ()
|
||||
)
|
||||
]
|
||||
keyHandlers KeyBindings {..} =
|
||||
[ (bQuit, const "Quit" , halt)
|
||||
[ (bQuit, const "Quit" , \_ -> halt)
|
||||
, (bInstall, const "Install" , withIOAction install')
|
||||
, (bUninstall, const "Uninstall", withIOAction del')
|
||||
, (bSet, const "Set" , withIOAction set')
|
||||
@@ -114,14 +114,14 @@ keyHandlers KeyBindings {..} =
|
||||
if showAllTools then "Don't show all tools" else "Show all tools"
|
||||
, hideShowHandler showAllVersions (not . showAllTools)
|
||||
)
|
||||
, (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. })
|
||||
, (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
|
||||
, (bUp, const "Up", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Up, .. })
|
||||
, (bDown, const "Down", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Down, .. })
|
||||
]
|
||||
where
|
||||
hideShowHandler f p BrickState{..} =
|
||||
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
|
||||
newInternalState = constructList appData newAppSettings (Just appState)
|
||||
in continue (BrickState appData newAppSettings newInternalState appKeys)
|
||||
in put (BrickState appData newAppSettings newInternalState appKeys)
|
||||
|
||||
|
||||
showKey :: Vty.Key -> String
|
||||
@@ -142,7 +142,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
|
||||
where
|
||||
footer =
|
||||
withAttr "help"
|
||||
withAttr (attrName "help")
|
||||
. txtWrap
|
||||
. T.pack
|
||||
. foldr1 (\x y -> x <> " " <> y)
|
||||
@@ -157,9 +157,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
renderList' = withDefAttr listAttr . drawListElements renderItem True
|
||||
renderItem _ b listResult@ListResult{..} =
|
||||
let marks = if
|
||||
| lSet -> (withAttr "set" $ str "✔✔")
|
||||
| lInstalled -> (withAttr "installed" $ str "✓ ")
|
||||
| otherwise -> (withAttr "not-installed" $ str "✗ ")
|
||||
| lSet -> (withAttr (attrName "set") $ str "✔✔")
|
||||
| lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
|
||||
| otherwise -> (withAttr (attrName "not-installed") $ str "✗ ")
|
||||
ver = case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
@@ -167,13 +167,13 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
| lNoBindist && not lInstalled
|
||||
&& not b -- TODO: overloading dim and active ignores active
|
||||
-- so we hack around it here
|
||||
= updateAttrMap (const dimAttrs) . withAttr "no-bindist"
|
||||
= updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
|
||||
| otherwise = id
|
||||
hooray
|
||||
| elem Latest lTag && not lInstalled =
|
||||
withAttr "hooray"
|
||||
withAttr (attrName "hooray")
|
||||
| otherwise = id
|
||||
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id
|
||||
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
|
||||
in hooray $ active $ dim
|
||||
( marks
|
||||
<+> padLeft (Pad 2)
|
||||
@@ -195,9 +195,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
<+> vLimit 1 (fill ' ')
|
||||
)
|
||||
|
||||
printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
|
||||
printTag Latest = Just $ withAttr "latest" $ str "latest"
|
||||
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
|
||||
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
|
||||
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
|
||||
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
|
||||
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
printTag Old = Nothing
|
||||
printTag (UnknownTag t) = Just $ str t
|
||||
@@ -209,10 +209,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
printTool Stack = str "Stack"
|
||||
|
||||
printNotes ListResult {..} =
|
||||
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
|
||||
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
|
||||
)
|
||||
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
|
||||
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
|
||||
++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
|
||||
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
|
||||
|
||||
-- | Draws the list elements.
|
||||
--
|
||||
@@ -242,8 +242,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
||||
selItemAttr = if foc
|
||||
then withDefAttr listSelectedFocusedAttr
|
||||
else withDefAttr listSelectedAttr
|
||||
makeVisible = if isSelected then visible . selItemAttr else id
|
||||
in addSeparator $ makeVisible elemWidget
|
||||
makeVisible' = if isSelected then visible . selItemAttr else id
|
||||
in addSeparator $ makeVisible' elemWidget
|
||||
|
||||
in render
|
||||
$ viewport "GHCup" Vertical
|
||||
@@ -258,8 +258,8 @@ minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
||||
app :: AttrMap -> AttrMap -> App BrickState e String
|
||||
app attrs dimAttrs =
|
||||
App { appDraw = \st -> [ui dimAttrs st]
|
||||
, appHandleEvent = eventHandler
|
||||
, appStartEvent = return
|
||||
, appHandleEvent = \be -> get >>= \s -> eventHandler s be
|
||||
, appStartEvent = return ()
|
||||
, appAttrMap = const attrs
|
||||
, appChooseCursor = showFirstCursor
|
||||
}
|
||||
@@ -267,18 +267,18 @@ app attrs dimAttrs =
|
||||
defaultAttributes :: Bool -> AttrMap
|
||||
defaultAttributes no_color = attrMap
|
||||
Vty.defAttr
|
||||
[ ("active" , Vty.defAttr `withBackColor` Vty.blue)
|
||||
, ("not-installed", Vty.defAttr `withForeColor` Vty.red)
|
||||
, ("set" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("installed" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("recommended" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, ("latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
||||
, ("prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, ("compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, ("stray" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, ("help" , Vty.defAttr `withStyle` Vty.italic)
|
||||
, ("hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
|
||||
, (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
|
||||
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
|
||||
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||
]
|
||||
where
|
||||
withForeColor | no_color = const
|
||||
@@ -292,31 +292,31 @@ defaultAttributes no_color = attrMap
|
||||
dimAttributes :: Bool -> AttrMap
|
||||
dimAttributes no_color = attrMap
|
||||
(Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
[ ("active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
|
||||
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
|
||||
, (attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
]
|
||||
where
|
||||
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
|
||||
| otherwise = Vty.withBackColor
|
||||
|
||||
eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState)
|
||||
eventHandler :: BrickState -> BrickEvent String e -> EventM String BrickState ()
|
||||
eventHandler st@BrickState{..} ev = do
|
||||
AppState { keyBindings = kb } <- liftIO $ readIORef settings'
|
||||
case ev of
|
||||
(MouseDown _ Vty.BScrollUp _ _) ->
|
||||
continue (BrickState { appState = moveCursor 1 appState Up, .. })
|
||||
put (BrickState { appState = moveCursor 1 appState Up, .. })
|
||||
(MouseDown _ Vty.BScrollDown _ _) ->
|
||||
continue (BrickState { appState = moveCursor 1 appState Down, .. })
|
||||
(VtyEvent (Vty.EvResize _ _)) -> continue st
|
||||
put (BrickState { appState = moveCursor 1 appState Down, .. })
|
||||
(VtyEvent (Vty.EvResize _ _)) -> put st
|
||||
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
|
||||
continue BrickState{ appState = moveCursor 1 appState Up, .. }
|
||||
put BrickState{ appState = moveCursor 1 appState Up, .. }
|
||||
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
|
||||
continue BrickState{ appState = moveCursor 1 appState Down, .. }
|
||||
put BrickState{ appState = moveCursor 1 appState Down, .. }
|
||||
(VtyEvent (Vty.EvKey key _)) ->
|
||||
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
|
||||
Nothing -> continue st
|
||||
Nothing -> put st
|
||||
Just (_, _, handler) -> handler st
|
||||
_ -> continue st
|
||||
_ -> put st
|
||||
|
||||
|
||||
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
|
||||
@@ -329,13 +329,14 @@ moveCursor steps ais@BrickInternalState{..} direction =
|
||||
|
||||
-- | Suspend the current UI and run an IO action in terminal. If the
|
||||
-- IO action returns a Left value, then it's thrown as userError.
|
||||
withIOAction :: (BrickState
|
||||
withIOAction :: Ord n
|
||||
=> (BrickState
|
||||
-> (Int, ListResult)
|
||||
-> ReaderT AppState IO (Either String a))
|
||||
-> BrickState
|
||||
-> EventM n (Next BrickState)
|
||||
-> EventM n BrickState ()
|
||||
withIOAction action as = case listSelectedElement' (appState as) of
|
||||
Nothing -> continue as
|
||||
Nothing -> put as
|
||||
Just (ix, e) -> do
|
||||
suspendAndResume $ do
|
||||
settings <- readIORef settings'
|
||||
|
||||
@@ -8,6 +8,7 @@
|
||||
module GHCup.OptParse (
|
||||
module GHCup.OptParse.Common
|
||||
, module GHCup.OptParse.Install
|
||||
, module GHCup.OptParse.Test
|
||||
, module GHCup.OptParse.Set
|
||||
, module GHCup.OptParse.UnSet
|
||||
, module GHCup.OptParse.Rm
|
||||
@@ -31,6 +32,7 @@ module GHCup.OptParse (
|
||||
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.OptParse.Install
|
||||
import GHCup.OptParse.Test
|
||||
import GHCup.OptParse.Set
|
||||
import GHCup.OptParse.UnSet
|
||||
import GHCup.OptParse.Rm
|
||||
@@ -87,6 +89,7 @@ data Options = Options
|
||||
|
||||
data Command
|
||||
= Install (Either InstallCommand InstallOptions)
|
||||
| Test TestCommand
|
||||
| InstallCabalLegacy InstallOptions
|
||||
| Set (Either SetCommand SetOptions)
|
||||
| UnSet UnsetCommand
|
||||
@@ -104,9 +107,6 @@ data Command
|
||||
| Nuke
|
||||
#if defined(BRICK)
|
||||
| Interactive
|
||||
#endif
|
||||
#if defined(ANSI)
|
||||
| InteractiveAnsi
|
||||
#endif
|
||||
| Prefetch PrefetchCommand
|
||||
| GC GCOptions
|
||||
@@ -187,19 +187,8 @@ opts =
|
||||
com :: Parser Command
|
||||
com =
|
||||
subparser
|
||||
#if defined(ANSI)
|
||||
( command
|
||||
"tui-ansi"
|
||||
( (\_ -> InteractiveAnsi)
|
||||
<$> info
|
||||
helper
|
||||
( progDesc "Start the interactive GHCup UI (ansi)"
|
||||
)
|
||||
)
|
||||
<>
|
||||
#endif
|
||||
#if defined(BRICK)
|
||||
command
|
||||
( command
|
||||
"tui"
|
||||
( (\_ -> Interactive)
|
||||
<$> info
|
||||
@@ -209,7 +198,7 @@ com =
|
||||
)
|
||||
<> command
|
||||
#else
|
||||
command
|
||||
( command
|
||||
#endif
|
||||
"install"
|
||||
( Install
|
||||
@@ -219,6 +208,14 @@ com =
|
||||
<> footerDoc (Just $ text installToolFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"test"
|
||||
(info
|
||||
(Test <$> testParser <**> helper)
|
||||
( progDesc "Run tests for a tool (if any) [EXPERIMENTAL!]"
|
||||
<> footerDoc (Just $ text testFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"set"
|
||||
(info
|
||||
|
||||
@@ -51,7 +51,7 @@ data ConfigCommand
|
||||
= ShowConfig
|
||||
| SetConfig String (Maybe String)
|
||||
| InitConfig
|
||||
| AddReleaseChannel URI
|
||||
| AddReleaseChannel Bool URI
|
||||
|
||||
|
||||
|
||||
@@ -74,7 +74,7 @@ configP = subparser
|
||||
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
|
||||
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
|
||||
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
|
||||
addP = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
|
||||
addP = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
|
||||
(progDesc "Add a release channel from a URI")
|
||||
|
||||
|
||||
@@ -120,20 +120,38 @@ formatConfig :: UserSettings -> String
|
||||
formatConfig = UTF8.toString . Y.encode
|
||||
|
||||
|
||||
updateSettings :: UserSettings -> Settings -> Settings
|
||||
updateSettings UserSettings{..} Settings{..} =
|
||||
let cache' = fromMaybe cache uCache
|
||||
metaCache' = fromMaybe metaCache uMetaCache
|
||||
metaMode' = fromMaybe metaMode uMetaMode
|
||||
noVerify' = fromMaybe noVerify uNoVerify
|
||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
||||
downloader' = fromMaybe downloader uDownloader
|
||||
verbose' = fromMaybe verbose uVerbose
|
||||
urlSource' = fromMaybe urlSource uUrlSource
|
||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||
platformOverride' = uPlatformOverride <|> platformOverride
|
||||
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
|
||||
updateSettings :: UserSettings -> UserSettings -> UserSettings
|
||||
updateSettings usl usr =
|
||||
let cache' = uCache usl <|> uCache usr
|
||||
metaCache' = uMetaCache usl <|> uMetaCache usr
|
||||
metaMode' = uMetaMode usl <|> uMetaMode usr
|
||||
noVerify' = uNoVerify usl <|> uNoVerify usr
|
||||
verbose' = uVerbose usl <|> uVerbose usr
|
||||
keepDirs' = uKeepDirs usl <|> uKeepDirs usr
|
||||
downloader' = uDownloader usl <|> uDownloader usr
|
||||
urlSource' = uUrlSource usl <|> uUrlSource usr
|
||||
noNetwork' = uNoNetwork usl <|> uNoNetwork usr
|
||||
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
|
||||
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
|
||||
mirrors' = uMirrors usl <|> uMirrors usr
|
||||
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
|
||||
where
|
||||
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
|
||||
updateKeyBindings Nothing Nothing = Nothing
|
||||
updateKeyBindings (Just kbl) Nothing = Just kbl
|
||||
updateKeyBindings Nothing (Just kbr) = Just kbr
|
||||
updateKeyBindings (Just kbl) (Just kbr) =
|
||||
Just $ UserKeyBindings {
|
||||
kUp = kUp kbl <|> kUp kbr
|
||||
, kDown = kDown kbl <|> kDown kbr
|
||||
, kQuit = kQuit kbl <|> kQuit kbr
|
||||
, kInstall = kInstall kbl <|> kInstall kbr
|
||||
, kUninstall = kUninstall kbl <|> kUninstall kbr
|
||||
, kSet = kSet kbl <|> kSet kbr
|
||||
, kChangelog = kChangelog kbl <|> kChangelog kbr
|
||||
, kShowAll = kShowAll kbl <|> kShowAll kbr
|
||||
, kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -141,6 +159,9 @@ updateSettings UserSettings{..} Settings{..} =
|
||||
--[ 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
|
||||
@@ -150,10 +171,11 @@ config :: forall m. ( Monad m
|
||||
)
|
||||
=> ConfigCommand
|
||||
-> Settings
|
||||
-> UserSettings
|
||||
-> KeyBindings
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
config configCommand settings keybindings runLogger = case configCommand of
|
||||
config configCommand settings userConf keybindings runLogger = case configCommand of
|
||||
InitConfig -> do
|
||||
path <- getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||
@@ -184,27 +206,55 @@ config configCommand settings keybindings runLogger = case configCommand of
|
||||
pure $ ExitFailure 65
|
||||
VLeft _ -> pure $ ExitFailure 65
|
||||
|
||||
AddReleaseChannel uri -> do
|
||||
case urlSource settings of
|
||||
AddSource xs -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
||||
pure ExitSuccess
|
||||
GHCupURL -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||
pure ExitSuccess
|
||||
OwnSource xs -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
|
||||
pure ExitSuccess
|
||||
OwnSpec spec -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
|
||||
AddReleaseChannel force uri -> do
|
||||
r <- runE @'[DuplicateReleaseChannel] $ do
|
||||
case urlSource settings of
|
||||
AddSource xs -> do
|
||||
case checkDuplicate xs (Right uri) of
|
||||
Duplicate
|
||||
| not force -> throwE (DuplicateReleaseChannel uri)
|
||||
DuplicateLast -> pure ()
|
||||
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (appendUnique xs (Right uri)) })
|
||||
GHCupURL -> do
|
||||
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||
pure ()
|
||||
OwnSource xs -> do
|
||||
case checkDuplicate xs (Right uri) of
|
||||
Duplicate
|
||||
| not force -> throwE (DuplicateReleaseChannel uri)
|
||||
DuplicateLast -> pure ()
|
||||
_ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (appendUnique xs (Right uri)) })
|
||||
OwnSpec spec -> do
|
||||
lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource [Left spec, Right uri] })
|
||||
pure ()
|
||||
case r of
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyHFError e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
where
|
||||
checkDuplicate :: Eq a => [a] -> a -> Duplicate
|
||||
checkDuplicate xs a
|
||||
| last xs == a = DuplicateLast
|
||||
| a `elem` xs = Duplicate
|
||||
| otherwise = NoDuplicate
|
||||
|
||||
-- appends the element to the end of the list, but also removes it from the existing list
|
||||
appendUnique :: Eq a => [a] -> a -> [a]
|
||||
appendUnique xs' e = go xs'
|
||||
where
|
||||
go [] = [e]
|
||||
go (x:xs)
|
||||
| x == e = go xs -- skip
|
||||
| otherwise = x : go xs
|
||||
|
||||
doConfig :: MonadIO m => UserSettings -> m ()
|
||||
doConfig usersettings = do
|
||||
let settings' = updateSettings usersettings settings
|
||||
let settings' = updateSettings usersettings userConf
|
||||
path <- liftIO getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||
liftIO $ writeFile path $ formatConfig $ settings'
|
||||
runLogger $ logDebug $ T.pack $ show settings'
|
||||
pure ()
|
||||
|
||||
|
||||
@@ -12,7 +12,6 @@ module GHCup.OptParse.List where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.Ansi
|
||||
import GHCup.Types
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
@@ -156,6 +155,89 @@ printListResult no_color raw lr = do
|
||||
add' = x - lstr
|
||||
in if add' < 0 then str' else str' ++ replicate add' ' '
|
||||
|
||||
-- | Calculate the render width of a string, considering
|
||||
-- wide characters (counted as double width), ANSI escape codes
|
||||
-- (not counted), and line breaks (in a multi-line string, the longest
|
||||
-- line determines the width).
|
||||
strWidth :: String -> Int
|
||||
strWidth =
|
||||
maximum
|
||||
. (0 :)
|
||||
. map (foldr (\a b -> charWidth a + b) 0)
|
||||
. lines
|
||||
. stripAnsi
|
||||
|
||||
-- | Strip ANSI escape sequences from a string.
|
||||
--
|
||||
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
|
||||
-- "-1"
|
||||
stripAnsi :: String -> String
|
||||
stripAnsi s' =
|
||||
case
|
||||
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
|
||||
of
|
||||
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
|
||||
Just xs -> concat xs
|
||||
where
|
||||
-- This parses lots of invalid ANSI escape codes, but that should be fine
|
||||
ansi =
|
||||
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
|
||||
Void
|
||||
String
|
||||
Char
|
||||
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
|
||||
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
|
||||
|
||||
-- | Get the designated render width of a character: 0 for a combining
|
||||
-- character, 1 for a regular character, 2 for a wide character.
|
||||
-- (Wide characters are rendered as exactly double width in apps and
|
||||
-- fonts that support it.) (From Pandoc.)
|
||||
charWidth :: Char -> Int
|
||||
charWidth c = case c of
|
||||
_ | c < '\x0300' -> 1
|
||||
| c >= '\x0300' && c <= '\x036F' -> 0
|
||||
| -- combining
|
||||
c >= '\x0370' && c <= '\x10FC' -> 1
|
||||
| c >= '\x1100' && c <= '\x115F' -> 2
|
||||
| c >= '\x1160' && c <= '\x11A2' -> 1
|
||||
| c >= '\x11A3' && c <= '\x11A7' -> 2
|
||||
| c >= '\x11A8' && c <= '\x11F9' -> 1
|
||||
| c >= '\x11FA' && c <= '\x11FF' -> 2
|
||||
| c >= '\x1200' && c <= '\x2328' -> 1
|
||||
| c >= '\x2329' && c <= '\x232A' -> 2
|
||||
| c >= '\x232B' && c <= '\x2E31' -> 1
|
||||
| c >= '\x2E80' && c <= '\x303E' -> 2
|
||||
| c == '\x303F' -> 1
|
||||
| c >= '\x3041' && c <= '\x3247' -> 2
|
||||
| c >= '\x3248' && c <= '\x324F' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\x3250' && c <= '\x4DBF' -> 2
|
||||
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
|
||||
| c >= '\x4E00' && c <= '\xA4C6' -> 2
|
||||
| c >= '\xA4D0' && c <= '\xA95F' -> 1
|
||||
| c >= '\xA960' && c <= '\xA97C' -> 2
|
||||
| c >= '\xA980' && c <= '\xABF9' -> 1
|
||||
| c >= '\xAC00' && c <= '\xD7FB' -> 2
|
||||
| c >= '\xD800' && c <= '\xDFFF' -> 1
|
||||
| c >= '\xE000' && c <= '\xF8FF' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\xF900' && c <= '\xFAFF' -> 2
|
||||
| c >= '\xFB00' && c <= '\xFDFD' -> 1
|
||||
| c >= '\xFE00' && c <= '\xFE0F' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\xFE10' && c <= '\xFE19' -> 2
|
||||
| c >= '\xFE20' && c <= '\xFE26' -> 1
|
||||
| c >= '\xFE30' && c <= '\xFE6B' -> 2
|
||||
| c >= '\xFE70' && c <= '\xFEFF' -> 1
|
||||
| c >= '\xFF01' && c <= '\xFF60' -> 2
|
||||
| c >= '\xFF61' && c <= '\x16A38' -> 1
|
||||
| c >= '\x1B000' && c <= '\x1B001' -> 2
|
||||
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
|
||||
| c >= '\x1F200' && c <= '\x1F251' -> 2
|
||||
| c >= '\x1F300' && c <= '\x1F773' -> 1
|
||||
| c >= '\x20000' && c <= '\x3FFFD' -> 2
|
||||
| otherwise -> 1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -254,7 +254,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
liftIO $ putStr tmp
|
||||
pure ExitSuccess
|
||||
(cmd:args) -> do
|
||||
newEnv <- liftIO $ addToPath tmp
|
||||
newEnv <- liftIO $ addToPath tmp runAppendPATH
|
||||
#ifndef IS_WINDOWS
|
||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||
pure ExitSuccess
|
||||
@@ -441,17 +441,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
liftE $ setHLS v SetHLS_XYZ (Just tmp)
|
||||
liftE $ setHLS v SetHLSOnly (Just tmp)
|
||||
|
||||
addToPath path = do
|
||||
cEnv <- Map.fromList <$> getEnvironment
|
||||
let paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
newPath = intercalate [searchPathSeparator] (if runAppendPATH then (curPaths ++ [path]) else (path : curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
liftIO $ setEnv pathVar newPath
|
||||
return envWithNewPath
|
||||
|
||||
createTmpDir :: ( MonadUnliftIO m
|
||||
, MonadCatch m
|
||||
, MonadThrow m
|
||||
|
||||
@@ -259,7 +259,7 @@ set :: forall m env.
|
||||
-> m (VEither eff GHCTargetVersion))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
set setCommand runAppState _ runLogger = case setCommand of
|
||||
(Right sopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
||||
setGHC' sopts
|
||||
@@ -271,10 +271,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
where
|
||||
setGHC' :: SetOptions
|
||||
-> m ExitCode
|
||||
setGHC' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
|
||||
_ -> runSetGHC runAppState (do
|
||||
setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly Nothing
|
||||
)
|
||||
@@ -291,10 +288,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
|
||||
setCabal' :: SetOptions
|
||||
-> m ExitCode
|
||||
setCabal' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
|
||||
_ -> runSetCabal runAppState (do
|
||||
setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||
liftE $ setCabal (_tvVersion v)
|
||||
pure v
|
||||
@@ -311,10 +305,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
|
||||
setHLS' :: SetOptions
|
||||
-> m ExitCode
|
||||
setHLS' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
|
||||
_ -> runSetHLS runAppState (do
|
||||
setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
||||
pure v
|
||||
@@ -332,10 +323,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
|
||||
setStack' :: SetOptions
|
||||
-> m ExitCode
|
||||
setStack' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
|
||||
_ -> runSetStack runAppState (do
|
||||
setStack' SetOptions{ sToolVer } = runSetStack runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||
liftE $ setStack (_tvVersion v)
|
||||
pure v
|
||||
|
||||
188
app/ghcup/GHCup/OptParse/Test.hs
Normal file
188
app/ghcup/GHCup/OptParse/Test.hs
Normal file
@@ -0,0 +1,188 @@
|
||||
{-# 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 Nothing 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
|
||||
, 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 (_tvVersion 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) (_tvVersion 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
|
||||
|
||||
@@ -13,9 +13,6 @@ module Main where
|
||||
#if defined(BRICK)
|
||||
import BrickMain ( brickMain )
|
||||
#endif
|
||||
#if defined(ANSI)
|
||||
import AnsiMain ( ansiMain )
|
||||
#endif
|
||||
|
||||
import qualified GHCup.GHC as GHC
|
||||
import qualified GHCup.HLS as HLS
|
||||
@@ -66,7 +63,7 @@ import qualified GHCup.Types as Types
|
||||
|
||||
|
||||
|
||||
toSettings :: Options -> IO (Settings, KeyBindings)
|
||||
toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
|
||||
toSettings options = do
|
||||
noColor <- isJust <$> lookupEnv "NO_COLOR"
|
||||
userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
|
||||
@@ -76,7 +73,7 @@ toSettings options = do
|
||||
pure defaultUserSettings
|
||||
_ -> do
|
||||
die "Unexpected error!"
|
||||
pure $ mergeConf options userConf noColor
|
||||
pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
|
||||
where
|
||||
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
|
||||
mergeConf Options{..} UserSettings{..} noColor =
|
||||
@@ -92,6 +89,7 @@ toSettings options = do
|
||||
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
||||
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
||||
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
|
||||
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
|
||||
in (Settings {..}, keyBindings)
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
defaultDownloader = Internal
|
||||
@@ -178,7 +176,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
-- create ~/.ghcup dir
|
||||
ensureDirectories dirs
|
||||
|
||||
(settings, keybindings) <- toSettings opt
|
||||
(settings, keybindings, userConf) <- toSettings opt
|
||||
|
||||
-- logger interpreter
|
||||
logfile <- runReaderT initGHCupFileLogging dirs
|
||||
@@ -237,9 +235,6 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
UnSet _ -> pure ()
|
||||
#if defined(BRICK)
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
#if defined(ANSI)
|
||||
InteractiveAnsi -> pure ()
|
||||
#endif
|
||||
-- check for new tools
|
||||
_
|
||||
@@ -298,21 +293,17 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
Interactive -> do
|
||||
s' <- appState
|
||||
liftIO $ brickMain s' >> pure ExitSuccess
|
||||
#endif
|
||||
#if defined(ANSI)
|
||||
InteractiveAnsi -> do
|
||||
s' <- appState
|
||||
liftIO $ ansiMain s' >> pure ExitSuccess
|
||||
#endif
|
||||
Install installCommand -> install installCommand settings appState runLogger
|
||||
InstallCabalLegacy iopts -> install (Left (InstallCabal iopts)) settings appState runLogger
|
||||
Test testCommand -> test testCommand settings appState runLogger
|
||||
Set setCommand -> set setCommand runAppState runLeanAppState runLogger
|
||||
UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger
|
||||
List lo -> list lo no_color runAppState
|
||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||
DInfo -> dinfo runAppState runLogger
|
||||
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
||||
Config configCommand -> config configCommand settings keybindings runLogger
|
||||
Config configCommand -> config configCommand settings userConf keybindings runLogger
|
||||
Whereis whereisOptions
|
||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
||||
|
||||
@@ -5,17 +5,10 @@ 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,
|
||||
any.aeson >= 2.0.1.0
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
@@ -32,6 +25,5 @@ package aeson
|
||||
package streamly
|
||||
flags: +use-unliftio
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-8.10.7
|
||||
|
||||
@@ -1,8 +1,9 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.6.2.0,
|
||||
constraints: any.Cabal ==3.6.3.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.Cabal-syntax ==3.8.1.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
any.HsOpenSSL ==0.11.7.4,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
@@ -10,13 +11,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.3.0,
|
||||
any.aeson ==2.1.1.0,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.9,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.7.1,
|
||||
any.ansi-terminal ==0.11.3,
|
||||
ansi-terminal -example,
|
||||
any.ansi-terminal ==0.11.4,
|
||||
ansi-terminal -example +win32-2-13-1,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
any.array ==0.5.4.0,
|
||||
@@ -28,23 +29,27 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base-compat ==0.12.2,
|
||||
any.base-compat-batteries ==0.12.2,
|
||||
any.base-orphans ==0.8.7,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.5.12,
|
||||
any.bifunctors ==5.5.14,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.bimap ==0.5.0,
|
||||
any.binary ==0.8.8.0,
|
||||
any.binary-instances ==1.0.3,
|
||||
any.binary-orphans ==1.0.3,
|
||||
any.blaze-builder ==0.4.2.2,
|
||||
any.brick ==0.64.2,
|
||||
any.brick ==1.5,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.0,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.1,
|
||||
any.cabal-install-parsers ==0.5,
|
||||
any.cabal-plan ==0.7.2.3,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
@@ -52,14 +57,12 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.3,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
any.config-ini ==0.2.4.0,
|
||||
any.config-ini ==0.2.5.0,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.5.1,
|
||||
any.contravariant ==1.5.5,
|
||||
@@ -69,6 +72,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha256 ==0.11.102.1,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-array-byte ==0.1.0.1,
|
||||
any.data-clist ==0.2,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.4.0,
|
||||
@@ -80,58 +84,57 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.4,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.8,
|
||||
any.free ==5.1.10,
|
||||
any.fusion-plugin-types ==0.1.0,
|
||||
any.generic-arbitrary ==0.2.2,
|
||||
any.ghc ==8.10.7,
|
||||
any.ghc-boot ==8.10.7,
|
||||
any.generically ==0.1,
|
||||
any.ghc-boot-th ==8.10.7,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-heap ==8.10.7,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.ghci ==8.10.7,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.hashable ==1.4.2.0,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.haskell-lexer ==1.1.1,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.heaps ==0.4,
|
||||
any.hpc ==0.6.1.0,
|
||||
any.hsc2hs ==0.68.8,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.9.7,
|
||||
any.hspec-core ==2.9.7,
|
||||
any.hspec-discover ==2.9.7,
|
||||
any.hspec ==2.10.8,
|
||||
any.hspec-core ==2.10.8,
|
||||
any.hspec-discover ==2.10.8,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.6.1,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.indexed-traversable-instances ==0.1.1.1,
|
||||
any.integer-gmp ==1.0.3.0,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.1,
|
||||
any.io-streams ==1.5.2.2,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.1,
|
||||
any.language-c ==0.9.2,
|
||||
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.lockfree-queue ==0.2.4,
|
||||
any.lukko ==0.1.1.3,
|
||||
lukko +ofd-locking,
|
||||
any.lzma-static ==5.2.5.5,
|
||||
any.megaparsec ==9.2.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.2,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.microlens ==0.4.13.1,
|
||||
any.microlens-mtl ==0.2.0.3,
|
||||
any.microlens-th ==0.4.3.11,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.network-uri ==2.6.4.2,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
any.optics ==0.4.2,
|
||||
any.optics-core ==0.4.1,
|
||||
@@ -143,7 +146,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.os-release ==1.0.2.1,
|
||||
os-release -devel,
|
||||
any.parallel ==3.2.2.0,
|
||||
any.parsec ==3.1.14.0,
|
||||
any.parsec ==3.1.16.1,
|
||||
any.parser-combinators ==1.3.0,
|
||||
parser-combinators -dev,
|
||||
any.polyparse ==1.13,
|
||||
@@ -155,12 +158,12 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
any.recursion-schemes ==5.2.2.3,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.5,
|
||||
any.resourcet ==1.2.6,
|
||||
any.retry ==0.8.1.2,
|
||||
retry -lib-werror,
|
||||
any.rts ==1.0.1,
|
||||
@@ -173,11 +176,11 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.semigroupoids ==5.3.7,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.split ==0.2.3.5,
|
||||
any.splitmix ==0.1.0.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.1,
|
||||
any.streamly ==0.8.2,
|
||||
any.streamly ==0.8.3,
|
||||
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,
|
||||
@@ -185,20 +188,24 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.tagged ==0.8.6.1,
|
||||
tagged +deepseq +transformers,
|
||||
any.tagsoup ==0.14.8,
|
||||
any.tar ==0.5.1.1,
|
||||
tar -old-bytestring -old-time,
|
||||
any.template-haskell ==2.16.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminal-size ==0.3.3,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text ==2.0.1,
|
||||
text -developer +simdutf,
|
||||
any.text-binary ==0.2.1.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.11,
|
||||
any.text-zipper ==0.12,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-abstraction ==0.4.5.0,
|
||||
any.th-compat ==0.1.4,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.th-lift-instances ==0.1.20,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
@@ -207,12 +214,12 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
any.transformers-compat ==0.7.2,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unicode-data ==0.3.0,
|
||||
any.unicode-data ==0.3.1,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.7,
|
||||
any.unix-bytestring ==0.3.7.8,
|
||||
any.unix-compat ==0.6,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
@@ -224,8 +231,9 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
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.vector-binary-instances ==0.2.5.2,
|
||||
any.versions ==5.0.4,
|
||||
any.vty ==5.37,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
@@ -235,4 +243,4 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.zlib ==0.6.3.0,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2022-06-04T19:47:01Z
|
||||
index-state: hackage.haskell.org 2023-01-12T04:22:48Z
|
||||
|
||||
@@ -1,37 +0,0 @@
|
||||
packages: ./ghcup.cabal
|
||||
|
||||
optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size.git
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.Cabal ==3.6.2.0,
|
||||
any.aeson >= 2.0.1.0,
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
package aeson
|
||||
flags: +ordered-keymap
|
||||
|
||||
package streamly
|
||||
flags: +use-unliftio
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-9.0.2
|
||||
@@ -1,238 +0,0 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.6.2.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.3.0,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.9,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.7.1,
|
||||
any.ansi-terminal ==0.11.3,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
any.array ==0.5.4.0,
|
||||
any.assoc ==1.0.2,
|
||||
any.async ==2.2.4,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.15.1.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.5.12,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.blaze-builder ==0.4.2.2,
|
||||
any.brick ==0.64.2,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.1,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.1,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.casing ==0.1.4.1,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.3,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
any.config-ini ==0.2.4.0,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.4.1,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha256 ==0.11.102.1,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.2,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.5.0,
|
||||
any.directory ==1.3.6.2,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.4,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.8,
|
||||
any.fusion-plugin-types ==0.1.0,
|
||||
any.generic-arbitrary ==0.2.2,
|
||||
any.ghc ==9.0.2,
|
||||
any.ghc-bignum ==1.1,
|
||||
any.ghc-boot ==9.0.2,
|
||||
any.ghc-boot-th ==9.0.2,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-heap ==9.0.2,
|
||||
any.ghc-prim ==0.7.0,
|
||||
any.ghci ==9.0.2,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.heaps ==0.4,
|
||||
any.hpc ==0.6.1.0,
|
||||
any.hsc2hs ==0.68.8,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.9.7,
|
||||
any.hspec-core ==2.9.7,
|
||||
any.hspec-discover ==2.9.7,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.6.1,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.1,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.1,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.3.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
any.libyaml-streamly ==0.2.1,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
any.lockfree-queue ==0.2.3.1,
|
||||
any.lzma-static ==5.2.5.4,
|
||||
any.megaparsec ==9.2.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.2,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
any.optics ==0.4.2,
|
||||
any.optics-core ==0.4.1,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4.2.1,
|
||||
any.optics-th ==0.4.1,
|
||||
any.optparse-applicative ==0.17.0.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2.1,
|
||||
os-release -devel,
|
||||
any.parallel ==3.2.2.0,
|
||||
any.parsec ==3.1.14.0,
|
||||
any.parser-combinators ==1.3.0,
|
||||
parser-combinators -dev,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.4.0,
|
||||
any.process ==1.6.13.2,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.5,
|
||||
any.retry ==0.8.1.2,
|
||||
retry -lib-werror,
|
||||
any.rts ==1.0.2,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.3,
|
||||
any.scientific ==0.3.7.0,
|
||||
scientific -bytestring-builder -integer-simple,
|
||||
any.semialign ==1.2.0.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.7,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.0,
|
||||
any.streamly ==0.8.2,
|
||||
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
|
||||
any.strict ==0.4.0.1,
|
||||
strict +assoc,
|
||||
any.strict-base ==0.4.0.0,
|
||||
any.tagged ==0.8.6.1,
|
||||
tagged +deepseq +transformers,
|
||||
any.tagsoup ==0.14.8,
|
||||
any.template-haskell ==2.17.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.5,
|
||||
any.text ==1.2.5.0,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6.1,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unicode-data ==0.3.0,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.7,
|
||||
any.unix-compat ==0.6,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.19.1,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
any.utf8-string ==1.0.2,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.versions ==5.0.3,
|
||||
any.vty ==5.33,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
any.xor ==0.0.1.1,
|
||||
any.yaml-streamly ==0.12.1,
|
||||
yaml-streamly +no-examples +no-exe,
|
||||
any.zlib ==0.6.3.0,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2022-06-04T19:47:01Z
|
||||
@@ -1,37 +0,0 @@
|
||||
packages: ./ghcup.cabal
|
||||
|
||||
optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size.git
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.Cabal ==3.6.2.0,
|
||||
any.aeson >= 2.0.1.0,
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
package aeson
|
||||
flags: +ordered-keymap
|
||||
|
||||
package streamly
|
||||
flags: +use-unliftio
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-9.2.3
|
||||
@@ -1,233 +0,0 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.6.2.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.3.0,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.9,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.7.1,
|
||||
any.ansi-terminal ==0.11.3,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
any.array ==0.5.4.0,
|
||||
any.assoc ==1.0.2,
|
||||
any.async ==2.2.4,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.16.2.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.5.12,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.9.0,
|
||||
any.blaze-builder ==0.4.2.2,
|
||||
any.brick ==0.64.2,
|
||||
brick -demos,
|
||||
any.bytestring ==0.11.3.1,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.1,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
any.casing ==0.1.4.1,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.3,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.composition-prelude ==3.0.0.2,
|
||||
composition-prelude -development,
|
||||
any.config-ini ==0.2.4.0,
|
||||
config-ini -enable-doctests,
|
||||
any.containers ==0.6.5.1,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha256 ==0.11.102.1,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.2,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.6.1,
|
||||
any.directory ==1.3.7.0,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
any.dlist ==1.0,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.4,
|
||||
any.filepath ==1.4.2.2,
|
||||
any.free ==5.1.8,
|
||||
any.fusion-plugin-types ==0.1.0,
|
||||
any.generic-arbitrary ==0.2.2,
|
||||
any.ghc-bignum ==1.2,
|
||||
any.ghc-boot-th ==9.2.3,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.8.0,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.heaps ==0.4,
|
||||
any.hsc2hs ==0.68.8,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.9.2,
|
||||
any.hspec-core ==2.9.2,
|
||||
any.hspec-discover ==2.9.2,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.6.1,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.1,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.1,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.3.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
any.libyaml-streamly ==0.2.1,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
any.lockfree-queue ==0.2.3.1,
|
||||
any.lzma-static ==5.2.5.4,
|
||||
any.megaparsec ==9.2.1,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.2,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
any.optics ==0.4.2,
|
||||
any.optics-core ==0.4.1,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4.2.1,
|
||||
any.optics-th ==0.4.1,
|
||||
any.optparse-applicative ==0.17.0.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2.1,
|
||||
os-release -devel,
|
||||
any.parallel ==3.2.2.0,
|
||||
any.parsec ==3.1.15.0,
|
||||
any.parser-combinators ==1.3.0,
|
||||
parser-combinators -dev,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.4.0,
|
||||
any.process ==1.6.14.0,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.5,
|
||||
any.retry ==0.8.1.2,
|
||||
retry -lib-werror,
|
||||
any.rts ==1.0.2,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.3,
|
||||
any.scientific ==0.3.7.0,
|
||||
scientific -bytestring-builder -integer-simple,
|
||||
any.semialign ==1.2.0.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.7,
|
||||
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.2,
|
||||
any.streamly ==0.8.2,
|
||||
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
|
||||
any.strict ==0.4.0.1,
|
||||
strict +assoc,
|
||||
any.strict-base ==0.4.0.0,
|
||||
any.tagged ==0.8.6.1,
|
||||
tagged +deepseq +transformers,
|
||||
any.tagsoup ==0.14.8,
|
||||
any.template-haskell ==2.18.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.5,
|
||||
any.text ==1.2.5.0,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
any.time-compat ==1.9.6.1,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unicode-data ==0.3.0,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.7,
|
||||
any.unix-compat ==0.6,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.19.1,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
any.utf8-string ==1.0.2,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.versions ==5.0.3,
|
||||
any.vty ==5.33,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
any.xor ==0.0.1.1,
|
||||
any.yaml-streamly ==0.12.1,
|
||||
yaml-streamly +no-examples +no-exe,
|
||||
any.zlib ==0.6.3.0,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2022-06-04T19:47:01Z
|
||||
@@ -2,20 +2,11 @@ packages: ./ghcup.cabal
|
||||
|
||||
optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
package ghcup
|
||||
tests: True
|
||||
flags: +tui-ansi
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size.git
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
flags: +tui
|
||||
|
||||
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
|
||||
flags: -system-libarchive
|
||||
@@ -32,4 +23,3 @@ package aeson
|
||||
package streamly
|
||||
flags: +use-unliftio
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
-- windows picks weird version
|
||||
constraints: any.hsc2hs ==0.68.7
|
||||
constraints: any.hsc2hs ==0.68.8
|
||||
|
||||
50
cabal.project.release
Normal file
50
cabal.project.release
Normal file
@@ -0,0 +1,50 @@
|
||||
packages: ./ghcup.cabal
|
||||
|
||||
optional-packages: ./vendored/*/*.cabal
|
||||
|
||||
optimization: 2
|
||||
|
||||
if os(linux)
|
||||
package ghcup
|
||||
flags: +tui
|
||||
if arch(x86_64) || arch(i386)
|
||||
package *
|
||||
ghc-options: -split-sections -optl-static
|
||||
elif os(darwin)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static
|
||||
package ghcup
|
||||
flags: +tui
|
||||
elif os(mingw32)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
lzma +static,
|
||||
text -simdutf
|
||||
package ghcup
|
||||
flags: -tui
|
||||
elif os(freebsd)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
zip +disable-zstd
|
||||
package *
|
||||
ghc-options: -split-sections -pgmc clang++14
|
||||
package ghcup
|
||||
flags: +tui
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.aeson >= 2.0.1.0,
|
||||
any.hsc2hs ==0.68.8
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
package aeson-pretty
|
||||
flags: +lib-only
|
||||
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
package aeson
|
||||
flags: +ordered-keymap
|
||||
|
||||
package streamly
|
||||
flags: +use-unliftio
|
||||
|
||||
@@ -92,3 +92,30 @@ url-source:
|
||||
# tag: Linux
|
||||
# version: '18.04'
|
||||
platform-override: null
|
||||
|
||||
# Support for mirrors. Currently there are 3 hosts you can mirror:
|
||||
# - github.com (for stack and some older HLS versions)
|
||||
# - raw.githubusercontent.com (for the yaml metadata)
|
||||
# - downloads.haskell.org (for everything else)
|
||||
#
|
||||
# E.g. when we have 'https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
|
||||
# and the following mirror config
|
||||
#
|
||||
# "raw.githubusercontent.com":
|
||||
# authority:
|
||||
# host: "mirror.sjtu.edu.cn"
|
||||
# pathPrefix: "ghcup/yaml"
|
||||
#
|
||||
# Then the resulting url will be 'https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
|
||||
mirrors:
|
||||
"github.com":
|
||||
authority:
|
||||
host: "mirror.sjtu.edu.cn"
|
||||
"raw.githubusercontent.com":
|
||||
authority:
|
||||
host: "mirror.sjtu.edu.cn"
|
||||
pathPrefix: "ghcup/yaml"
|
||||
"downloads.haskell.org":
|
||||
authority:
|
||||
host: "mirror.sjtu.edu.cn"
|
||||
|
||||
|
||||
Submodule data/metadata updated: 8f0e82ef06...9e14e6c736
@@ -1,4 +1,4 @@
|
||||
FROM i386/alpine:3.12
|
||||
FROM --platform=linux/i386 i386/alpine:3.12
|
||||
|
||||
ENV LANG C.UTF-8
|
||||
|
||||
|
||||
@@ -4,10 +4,6 @@ hide:
|
||||
- toc
|
||||
---
|
||||
|
||||
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
|
||||
<script src="javascripts/extra.js"></script>
|
||||
|
||||
|
||||
<section class="index-ghcup-hero">
|
||||
<img alt="haskell logo" src="./haskell_logo.png" />
|
||||
<h1>GHCup</h1>
|
||||
@@ -35,7 +31,7 @@ hide:
|
||||
<span>
|
||||
</span>
|
||||
<div class="footer">
|
||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
@@ -51,7 +47,7 @@ hide:
|
||||
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
|
||||
</div>
|
||||
<div class="footer">
|
||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||
<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b> · </b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b> · </b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
|
||||
</div>
|
||||
</div>
|
||||
</section>
|
||||
@@ -84,9 +80,6 @@ hide:
|
||||
</span>
|
||||
</p>
|
||||
|
||||
<script type="text/javascript" src="javascripts/ghcup.js"></script>
|
||||
|
||||
|
||||
----
|
||||
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# Installation
|
||||
|
||||
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
|
||||
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
|
||||
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
|
||||
It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
|
||||
|
||||
## How to install
|
||||
@@ -24,7 +24,7 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
|
||||
|
||||
There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
|
||||
|
||||
If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-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?
|
||||
|
||||
@@ -240,6 +240,8 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
|
||||
|
||||
## Manual installation
|
||||
|
||||
### Unix
|
||||
|
||||
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
|
||||
and place it into your `PATH` anywhere.
|
||||
|
||||
@@ -251,6 +253,60 @@ Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) lik
|
||||
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
|
||||
```
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install ghcup binary
|
||||
- choose a base directory for installation, e.g. `C:\` that has sufficient space
|
||||
- then create the directory, e.g. `C:\ghcup\bin`
|
||||
- download the binary: https://downloads.haskell.org/~ghcup/x86_64-mingw64-ghcup.exe
|
||||
- place it as `ghcup.exe` into e.g. `C:\ghcup\bin`
|
||||
2. Install MSYS2
|
||||
- download https://repo.msys2.org/distrib/msys2-x86_64-latest.exe and execute it
|
||||
- remember the installation destination you choose (default is `C:\msys64`)
|
||||
- finish the installation
|
||||
* Add environment variables and update `Path`
|
||||
- open search bar and type in "Edit the system environment variables", then open it
|
||||
- click on "Environment Variables..." at the near bottom
|
||||
- in the upper half, select `Path` variable and double click on it
|
||||
- in the new window, click "New", type in `C:\ghcup\bin` (depending on step 1.) and press enter
|
||||
- click "OK" at the bottom
|
||||
- in the upper half, click on "New..."
|
||||
- enter `GHCUP_MSYS2` under "Variable name" and the installation destination from step 2. under "Variable value"
|
||||
- click "OK" at the bottom
|
||||
- in the upper half, click on "New..."
|
||||
- enter `GHCUP_INSTALL_BASE_PREFIX` under "Variable name" and based on the installation destination from step 1. enter the device directory (default `C:\`)
|
||||
- click "OK" at the bottom
|
||||
- in the upper half, click on "New..."
|
||||
- enter `CABAL_DIR` under "Variable name" and based on the installation destination from step 1. enter the device directory + `cabal` subdir (default `C:\cabal`)
|
||||
- click "OK" at the bottom
|
||||
- click "OK" at the bottom
|
||||
- click "OK" at the bottom
|
||||
3. Install tools
|
||||
- open powershell
|
||||
- run `ghcup install ghc --set recommended`
|
||||
- run `ghcup install cabal latest`
|
||||
- run `ghcup install stack latest`
|
||||
- run `ghcup install hls latest`
|
||||
- run `cabal update`
|
||||
4. Update msys2
|
||||
- run `ghcup run -m -- pacman --noconfirm -Syuu`
|
||||
- run `ghcup run -m -- pacman --noconfirm -Syuu`
|
||||
- run `ghcup run -m -- pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf`
|
||||
- run `ghcup run -m -- pacman --noconfirm -S ca-certificates`
|
||||
5. Update cabal config
|
||||
- go to e.g. `C:\cabal` (based on device you picked in 1.)
|
||||
- open file `config`
|
||||
- uncomment `extra-include-dirs` (the `-- `) and add the value (depending on installation destination you chose in 2.), e.g. `C:\msys64\mingw64\include`... so the final line should be `extra-include-dirs: C:\msys64\mingw64\include`
|
||||
- uncomment `extra-lib-dirs` and do the same, adding `C:\msys64\mingw64\lib`
|
||||
- uncomment `extra-prog-path` and set it to `C:\ghcup\bin, C:\cabal\bin, C:\msys64\mingw64\bin, C:\msys64\usr\bin`, depending on your install destinations from 1. and 2.
|
||||
6. Set up msys2 shell
|
||||
- run `ghcup run -m -- sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf` to make the HOME in your msys2 shell match the one from windows
|
||||
- make a desktop shortcut from `C:\msys64\msys2_shell.cmd`, which will allow you to start a proper msys2 shell
|
||||
- run `ghcup run -m -- sed -i -e 's/#MSYS2_PATH_TYPE=.*/MSYS2_PATH_TYPE=inherit/' /c/msys64/msys2.ini`
|
||||
- run `ghcup run -m -- sed -i -e 's/rem set MSYS2_PATH_TYPE=inherit/set MSYS2_PATH_TYPE=inherit/' /c/msys64/msys2_shell.cmd`
|
||||
|
||||
All set. You can run `cabal init` now in an empty directory to start a project.
|
||||
|
||||
## Vim integration
|
||||
|
||||
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
|
||||
|
||||
@@ -1,201 +0,0 @@
|
||||
<!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 %}
|
||||
BIN
docs/overrides/img/favicon.ico
Normal file
BIN
docs/overrides/img/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.2 KiB |
4
docs/overrides/main.html
Normal file
4
docs/overrides/main.html
Normal file
@@ -0,0 +1,4 @@
|
||||
{% extends "base.html" %}
|
||||
<!-- Get rid of the next/prev buttons -->
|
||||
{% block next_prev %}
|
||||
{% endblock %}
|
||||
118
ghcup.cabal
118
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
cabal-version: 2.4
|
||||
name: ghcup
|
||||
version: 0.1.18.1
|
||||
version: 0.1.19.0
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@@ -25,10 +25,10 @@ extra-source-files:
|
||||
cbits/dirutils.h
|
||||
data/build_mk/cross
|
||||
data/build_mk/default
|
||||
test/data/dir/.keep
|
||||
test/data/file
|
||||
test/golden/unix/GHCupInfo.json
|
||||
test/golden/windows/GHCupInfo.json
|
||||
test/data/file
|
||||
test/data/dir/.keep
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@@ -41,11 +41,6 @@ flag tui
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag tui-ansi
|
||||
description: Build the ansi-terminal powered tui (ghcup tui-ansi).
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag internal-downloader
|
||||
description:
|
||||
Compile the internal downloader, which links against OpenSSL. This is disabled on windows.
|
||||
@@ -70,7 +65,6 @@ library
|
||||
GHCup.List
|
||||
GHCup.Platform
|
||||
GHCup.Prelude
|
||||
GHCup.Prelude.Ansi
|
||||
GHCup.Prelude.File
|
||||
GHCup.Prelude.File.Search
|
||||
GHCup.Prelude.Internal
|
||||
@@ -130,7 +124,7 @@ library
|
||||
, directory ^>=1.3.6.0
|
||||
, disk-free-space ^>=0.1.0.1
|
||||
, exceptions ^>=0.10
|
||||
, filepath ==1.4.2.1
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
@@ -149,9 +143,9 @@ library
|
||||
, split ^>=0.2.3.4
|
||||
, streamly ^>=0.8.2
|
||||
, strict-base ^>=0.4
|
||||
, template-haskell >=2.7 && <2.18
|
||||
, template-haskell >=2.7 && <2.20
|
||||
, temporary ^>=1.3
|
||||
, text ^>=1.2.4.0
|
||||
, text ^>=2.0
|
||||
, time ^>=1.9.3
|
||||
, transformers ^>=0.5
|
||||
, unliftio-core ^>=0.2.0.1
|
||||
@@ -167,7 +161,7 @@ library
|
||||
exposed-modules: GHCup.Download.IOStreams
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
build-depends:
|
||||
, HsOpenSSL >=0.11.4.18
|
||||
, HsOpenSSL >=0.11.7.2
|
||||
, http-io-streams >=0.1.2.0
|
||||
, io-streams >=1.5.2.1
|
||||
, terminal-progress-bar >=0.4.1
|
||||
@@ -191,22 +185,21 @@ library
|
||||
GHCup.Prelude.File.Posix.Foreign
|
||||
GHCup.Prelude.Posix
|
||||
GHCup.Prelude.Process.Posix
|
||||
exposed-modules:
|
||||
GHCup.Prelude.File.Posix.Traversals
|
||||
|
||||
exposed-modules: GHCup.Prelude.File.Posix.Traversals
|
||||
include-dirs: cbits
|
||||
includes: dirutils.h
|
||||
install-includes: dirutils.h
|
||||
c-sources: cbits/dirutils.c
|
||||
build-depends:
|
||||
, bz2 >=0.5.0.5 && <1.1
|
||||
, terminal-size ^>=0.3.2.1
|
||||
, terminal-size ^>=0.3.3
|
||||
, unix ^>=2.7
|
||||
, unix-bytestring ^>=0.3.7.3
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
cpp-options: -DBRICK
|
||||
build-depends: vty >=5.28.2 && <5.34
|
||||
build-depends: vty ^>=5.37
|
||||
|
||||
executable ghcup
|
||||
main-is: Main.hs
|
||||
@@ -225,6 +218,7 @@ executable ghcup
|
||||
GHCup.OptParse.Rm
|
||||
GHCup.OptParse.Run
|
||||
GHCup.OptParse.Set
|
||||
GHCup.OptParse.Test
|
||||
GHCup.OptParse.ToolRequirements
|
||||
GHCup.OptParse.UnSet
|
||||
GHCup.OptParse.Upgrade
|
||||
@@ -247,60 +241,52 @@ executable ghcup
|
||||
-fwarn-incomplete-record-updates -threaded
|
||||
|
||||
build-depends:
|
||||
, aeson >=1.4
|
||||
, aeson-pretty ^>=0.8.8
|
||||
, async ^>=2.2.3
|
||||
, base >=4.12 && <5
|
||||
, bytestring >=0.10 && <0.12
|
||||
, cabal-plan ^>=0.7.2
|
||||
, cabal-install-parsers >=0.4.5
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ==1.4.2.1
|
||||
, aeson >=1.4
|
||||
, aeson-pretty ^>=0.8.8
|
||||
, async ^>=2.2.3
|
||||
, base >=4.12 && <5
|
||||
, bytestring >=0.10 && <0.12
|
||||
, cabal-install-parsers >=0.4.5
|
||||
, cabal-plan ^>=0.7.2
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.18
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, process ^>=1.6.11.0
|
||||
, resourcet ^>=1.2.2
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, tagsoup ^>=0.14
|
||||
, template-haskell >=2.7 && <2.18
|
||||
, temporary ^>=1.3
|
||||
, text ^>=1.2.4.0
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
, 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
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if flag(tui-ansi)
|
||||
cpp-options: -DANSI
|
||||
other-modules: AnsiMain
|
||||
build-depends:
|
||||
, ansi-terminal
|
||||
, ansi-terminal-game
|
||||
, transformers ^>=0.5
|
||||
|
||||
if (flag(tui) && !os(windows))
|
||||
cpp-options: -DBRICK
|
||||
other-modules: BrickMain
|
||||
build-depends:
|
||||
, brick ^>=0.64
|
||||
, brick ^>=1.5
|
||||
, transformers ^>=0.5
|
||||
, unix ^>=2.7
|
||||
, vty >=5.28.2 && <5.34
|
||||
, vty ^>=5.37
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
@@ -318,9 +304,9 @@ test-suite ghcup-test
|
||||
hs-source-dirs: test
|
||||
other-modules:
|
||||
GHCup.ArbitraryTypes
|
||||
GHCup.Prelude.File.Posix.TraversalsSpec
|
||||
GHCup.Types.JSONSpec
|
||||
GHCup.Utils.FileSpec
|
||||
GHCup.Prelude.File.Posix.TraversalsSpec
|
||||
Spec
|
||||
|
||||
default-language: Haskell2010
|
||||
@@ -341,7 +327,7 @@ test-suite ghcup-test
|
||||
, bytestring >=0.10 && <0.12
|
||||
, containers ^>=0.6
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ==1.4.2.1
|
||||
, filepath ^>=1.4.2.1
|
||||
, generic-arbitrary >=0.1.0 && <0.2.1 || >=0.2.2 && <0.3
|
||||
, ghcup
|
||||
, hspec >=2.7.10 && <2.11
|
||||
@@ -349,12 +335,12 @@ test-suite ghcup-test
|
||||
, QuickCheck ^>=2.14.1
|
||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||
, streamly ^>=0.8.2
|
||||
, text ^>=1.2.4.0
|
||||
, text ^>=2.0
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, versions >=4.0.1 && <5.1
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
else
|
||||
build-depends:
|
||||
, unix ^>=2.7
|
||||
build-depends: unix ^>=2.7
|
||||
|
||||
@@ -263,8 +263,12 @@ getBase uri = do
|
||||
dlWithMod modTime json_file = do
|
||||
let (dir, fn) = splitFileName json_file
|
||||
f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
|
||||
liftIO $ setModificationTime f modTime
|
||||
liftIO $ setAccessTime f modTime
|
||||
|
||||
-- make these failures non-fatal, also see:
|
||||
-- https://github.com/actions/runner-images/issues/7061
|
||||
handleIO (\e -> logWarn $ "setModificationTime failed with: " <> T.pack (displayException e)) $ liftIO $ setModificationTime f modTime
|
||||
handleIO (\e -> logWarn $ "setAccessTime failed with: " <> T.pack (displayException e)) $ liftIO $ setAccessTime f modTime
|
||||
|
||||
pure f
|
||||
|
||||
|
||||
@@ -333,19 +337,21 @@ download :: ( MonadReader env m
|
||||
-> Maybe FilePath -- ^ optional filename
|
||||
-> Bool -- ^ whether to read an write etags
|
||||
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
|
||||
download uri gpgUri eDigest eCSize dest mfn etags
|
||||
download rawUri gpgUri eDigest eCSize dest mfn etags
|
||||
| scheme == "https" = liftE dl
|
||||
| scheme == "http" = liftE dl
|
||||
| scheme == "file" = do
|
||||
let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
|
||||
let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
|
||||
lift $ logDebug $ "using local file: " <> T.pack destFile'
|
||||
forM_ eDigest (liftE . flip checkDigest destFile')
|
||||
pure destFile'
|
||||
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
|
||||
|
||||
where
|
||||
scheme = view (uriSchemeL' % schemeBSL') uri
|
||||
scheme = view (uriSchemeL' % schemeBSL') rawUri
|
||||
dl = do
|
||||
Settings{ mirrors } <- lift getSettings
|
||||
let uri = applyMirrors mirrors rawUri
|
||||
baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
|
||||
lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
|
||||
|
||||
@@ -751,3 +757,17 @@ getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [
|
||||
|
||||
tmpFile :: FilePath -> FilePath
|
||||
tmpFile = (<.> "tmp")
|
||||
|
||||
|
||||
applyMirrors :: DownloadMirrors -> URI -> URI
|
||||
applyMirrors (DM ms) uri@(URI { uriAuthority = Just (Authority { authorityHost = Host host }) }) =
|
||||
case M.lookup (decUTF8Safe host) ms of
|
||||
Nothing -> uri
|
||||
Just (DownloadMirror auth (Just prefix)) ->
|
||||
uri { uriAuthority = Just auth
|
||||
, uriPath = E.encodeUtf8 $ T.pack ("/" <> T.unpack prefix <> (T.unpack . decUTF8Safe . uriPath $ uri))
|
||||
}
|
||||
Just (DownloadMirror auth Nothing) ->
|
||||
uri { uriAuthority = Just auth }
|
||||
applyMirrors _ uri = uri
|
||||
|
||||
|
||||
@@ -35,6 +35,8 @@ import URI.ByteString
|
||||
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
import Data.Data (Proxy(..))
|
||||
|
||||
|
||||
@@ -82,10 +84,12 @@ allHFError = unlines allErrors
|
||||
, let proxy = Proxy :: Proxy HadrianNotFound in format proxy
|
||||
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
|
||||
, let proxy = Proxy :: Proxy ContentLengthError in format proxy
|
||||
, let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
|
||||
, ""
|
||||
, "# high level errors (5000+)"
|
||||
, "# 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
|
||||
, ""
|
||||
@@ -161,7 +165,6 @@ prettyHFError e =
|
||||
let errorCode = "GHCup-" <> padIntAndShow (eNum e)
|
||||
in ("[" <> linkEscapeCode errorCode (hfErrorLink errorCode) <> "] ") <> prettyShow e
|
||||
where
|
||||
linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
|
||||
hfErrorLink errorCode = "https://errors.haskell.org/messages/" <> errorCode
|
||||
padIntAndShow i
|
||||
| i < 10 = "0000" <> show i
|
||||
@@ -178,6 +181,9 @@ class HFErrorProject a where
|
||||
|
||||
eDesc :: Proxy a -> String
|
||||
|
||||
linkEscapeCode :: String -> String -> String
|
||||
linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
|
||||
|
||||
|
||||
------------------------
|
||||
--[ Low-level errors ]--
|
||||
@@ -637,6 +643,19 @@ instance HFErrorProject ContentLengthError where
|
||||
eBase _ = 340
|
||||
eDesc _ = "File content length verification failed"
|
||||
|
||||
data DuplicateReleaseChannel = DuplicateReleaseChannel URI
|
||||
deriving Show
|
||||
|
||||
instance HFErrorProject DuplicateReleaseChannel where
|
||||
eBase _ = 350
|
||||
eDesc _ = "Duplicate release channel detected when adding URI.\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
|
||||
|
||||
instance Pretty DuplicateReleaseChannel where
|
||||
pPrint (DuplicateReleaseChannel uri) =
|
||||
text $ "Duplicate release channel detected when adding: \n "
|
||||
<> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
|
||||
<> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
|
||||
|
||||
-------------------------
|
||||
--[ High-level errors ]--
|
||||
-------------------------
|
||||
@@ -675,6 +694,22 @@ instance HFErrorProject InstallSetError where
|
||||
eDesc _ = "Installation or setting the tool failed."
|
||||
|
||||
|
||||
-- | A test failed.
|
||||
data TestFailed = forall es . (ToVariantMaybe TestFailed es, PopVariant TestFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => TestFailed FilePath (V es)
|
||||
|
||||
instance Pretty TestFailed where
|
||||
pPrint (TestFailed path reason) =
|
||||
case reason of
|
||||
VMaybe (_ :: TestFailed) -> pPrint reason
|
||||
_ -> text ("The test failed. GHC test suite is fragile and non-portable. Please also check out the " <> linkEscapeCode "issue tracker" " https://gitlab.haskell.org/ghc/ghc/-/issues/?sort=updated_desc&state=opened&label_name%5B%5D=testsuite&label_name%5B%5D=packaging&first_page_size=20" <> ".\nBuild dir was:") <+> text path <+> text "\nReason was:" <+> pPrint reason
|
||||
|
||||
deriving instance Show TestFailed
|
||||
|
||||
instance HFErrorProject TestFailed where
|
||||
eBase _ = 4000
|
||||
eNum (TestFailed _ xs2) = 4000 + eNum xs2
|
||||
eDesc _ = "The test failed."
|
||||
|
||||
-- | A build failed.
|
||||
data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => BuildFailed FilePath (V es)
|
||||
|
||||
|
||||
138
lib/GHCup/GHC.hs
138
lib/GHCup/GHC.hs
@@ -86,6 +86,144 @@ data GHCVer v = SourceDist v
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
--[ Tool testing ]--
|
||||
--------------------
|
||||
|
||||
|
||||
|
||||
testGHCVer :: ( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
-> [T.Text]
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, NoDownload
|
||||
, ArchiveResult
|
||||
, TarDirDoesNotExist
|
||||
, UnknownArchive
|
||||
, TestFailed
|
||||
]
|
||||
m
|
||||
()
|
||||
testGHCVer ver addMakeArgs = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
dlInfo <-
|
||||
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||
?? NoDownload
|
||||
|
||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||
|
||||
|
||||
|
||||
testGHCBindist :: ( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasPlatformReq env
|
||||
, HasGHCupInfo env
|
||||
, HasLog env
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Version
|
||||
-> [T.Text]
|
||||
-> Excepts
|
||||
'[ DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, NoDownload
|
||||
, ArchiveResult
|
||||
, TarDirDoesNotExist
|
||||
, UnknownArchive
|
||||
, TestFailed
|
||||
]
|
||||
m
|
||||
()
|
||||
testGHCBindist dlinfo ver addMakeArgs = do
|
||||
-- download (or use cached version)
|
||||
dl <- liftE $ downloadCached dlinfo Nothing
|
||||
|
||||
liftE $ testPackedGHC dl (view dlSubdir dlinfo) ver addMakeArgs
|
||||
|
||||
|
||||
testPackedGHC :: ( MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, MonadResource m
|
||||
)
|
||||
=> FilePath -- ^ Path to the packed GHC bindist
|
||||
-> Maybe TarDir -- ^ Subdir of the archive
|
||||
-> Version -- ^ The GHC version
|
||||
-> [T.Text] -- ^ additional make args
|
||||
-> Excepts
|
||||
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
|
||||
testPackedGHC dl msubdir ver addMakeArgs = do
|
||||
-- unpack
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
|
||||
|
||||
-- the subdir of the archive where we do the work
|
||||
workdir <- maybe (pure tmpUnpack)
|
||||
(liftE . intoSubdir tmpUnpack)
|
||||
msubdir
|
||||
|
||||
reThrowAll @_ @'[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
|
||||
(TestFailed (fromGHCupPath workdir)) $ liftE $ runBuildAction tmpUnpack
|
||||
(testUnpackedGHC workdir ver addMakeArgs)
|
||||
|
||||
testUnpackedGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
)
|
||||
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
|
||||
-> Version -- ^ The GHC version
|
||||
-> [T.Text] -- ^ additional configure args for bindist
|
||||
-> Excepts '[ProcessError] m ()
|
||||
testUnpackedGHC path ver addMakeArgs = do
|
||||
lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!"
|
||||
ghcDir <- lift $ ghcupGHCDir (mkTVer ver)
|
||||
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
|
||||
env <- liftIO $ addToPath ghcBinDir False
|
||||
|
||||
lEM $ make' (fmap T.unpack addMakeArgs)
|
||||
(Just $ fromGHCupPath path)
|
||||
"ghc-test"
|
||||
(Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env)
|
||||
pure ()
|
||||
|
||||
|
||||
---------------------
|
||||
--[ Tool fetching ]--
|
||||
---------------------
|
||||
|
||||
@@ -1,92 +0,0 @@
|
||||
module GHCup.Prelude.Ansi where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Char
|
||||
import Data.Void
|
||||
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MPC
|
||||
|
||||
|
||||
-- | Calculate the render width of a string, considering
|
||||
-- wide characters (counted as double width), ANSI escape codes
|
||||
-- (not counted), and line breaks (in a multi-line string, the longest
|
||||
-- line determines the width).
|
||||
strWidth :: String -> Int
|
||||
strWidth =
|
||||
maximum
|
||||
. (0 :)
|
||||
. map (foldr (\a b -> charWidth a + b) 0)
|
||||
. lines
|
||||
. stripAnsi
|
||||
|
||||
-- | Strip ANSI escape sequences from a string.
|
||||
--
|
||||
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
|
||||
-- "-1"
|
||||
stripAnsi :: String -> String
|
||||
stripAnsi s' =
|
||||
case
|
||||
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
|
||||
of
|
||||
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
|
||||
Just xs -> concat xs
|
||||
where
|
||||
-- This parses lots of invalid ANSI escape codes, but that should be fine
|
||||
ansi =
|
||||
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
|
||||
Void
|
||||
String
|
||||
Char
|
||||
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
|
||||
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
|
||||
|
||||
-- | Get the designated render width of a character: 0 for a combining
|
||||
-- character, 1 for a regular character, 2 for a wide character.
|
||||
-- (Wide characters are rendered as exactly double width in apps and
|
||||
-- fonts that support it.) (From Pandoc.)
|
||||
charWidth :: Char -> Int
|
||||
charWidth c = case c of
|
||||
_ | c < '\x0300' -> 1
|
||||
| c >= '\x0300' && c <= '\x036F' -> 0
|
||||
| -- combining
|
||||
c >= '\x0370' && c <= '\x10FC' -> 1
|
||||
| c >= '\x1100' && c <= '\x115F' -> 2
|
||||
| c >= '\x1160' && c <= '\x11A2' -> 1
|
||||
| c >= '\x11A3' && c <= '\x11A7' -> 2
|
||||
| c >= '\x11A8' && c <= '\x11F9' -> 1
|
||||
| c >= '\x11FA' && c <= '\x11FF' -> 2
|
||||
| c >= '\x1200' && c <= '\x2328' -> 1
|
||||
| c >= '\x2329' && c <= '\x232A' -> 2
|
||||
| c >= '\x232B' && c <= '\x2E31' -> 1
|
||||
| c >= '\x2E80' && c <= '\x303E' -> 2
|
||||
| c == '\x303F' -> 1
|
||||
| c >= '\x3041' && c <= '\x3247' -> 2
|
||||
| c >= '\x3248' && c <= '\x324F' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\x3250' && c <= '\x4DBF' -> 2
|
||||
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
|
||||
| c >= '\x4E00' && c <= '\xA4C6' -> 2
|
||||
| c >= '\xA4D0' && c <= '\xA95F' -> 1
|
||||
| c >= '\xA960' && c <= '\xA97C' -> 2
|
||||
| c >= '\xA980' && c <= '\xABF9' -> 1
|
||||
| c >= '\xAC00' && c <= '\xD7FB' -> 2
|
||||
| c >= '\xD800' && c <= '\xDFFF' -> 1
|
||||
| c >= '\xE000' && c <= '\xF8FF' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\xF900' && c <= '\xFAFF' -> 2
|
||||
| c >= '\xFB00' && c <= '\xFDFD' -> 1
|
||||
| c >= '\xFE00' && c <= '\xFE0F' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\xFE10' && c <= '\xFE19' -> 2
|
||||
| c >= '\xFE20' && c <= '\xFE26' -> 1
|
||||
| c >= '\xFE30' && c <= '\xFE6B' -> 2
|
||||
| c >= '\xFE70' && c <= '\xFEFF' -> 1
|
||||
| c >= '\xFF01' && c <= '\xFF60' -> 2
|
||||
| c >= '\xFF61' && c <= '\x16A38' -> 1
|
||||
| c >= '\x1B000' && c <= '\x1B001' -> 2
|
||||
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
|
||||
| c >= '\x1F200' && c <= '\x1F251' -> 2
|
||||
| c >= '\x1F300' && c <= '\x1F773' -> 1
|
||||
| c >= '\x20000' && c <= '\x3FFFD' -> 2
|
||||
| otherwise -> 1
|
||||
@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
|
||||
|
||||
-- | Create an 'Unfold' of directory contents.
|
||||
unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
|
||||
unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
|
||||
unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
|
||||
where
|
||||
{-# INLINE [0] step #-}
|
||||
step dirstream = do
|
||||
(typ, e) <- liftIO $ readDirEnt dirstream
|
||||
(typ, e) <- liftIO $ readDirEntPortable dirstream
|
||||
return $ if
|
||||
| null e -> D.Stop
|
||||
| "." == e -> D.Skip dirstream
|
||||
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
||||
step (_, Nothing, []) = return D.Stop
|
||||
|
||||
step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
|
||||
(dt, f) <- liftIO $ readDirEnt dirstream
|
||||
if | FD.dtUnknown == dt -> do
|
||||
(dt, f) <- liftIO $ readDirEntPortable dirstream
|
||||
if | f == "" -> do
|
||||
runIOFinalizer finalizer
|
||||
return $ D.Skip (topdir, Nothing, dirs)
|
||||
| f == "." || f == ".."
|
||||
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
|
||||
|
||||
acquire dir =
|
||||
withRunInIO $ \run -> mask_ $ run $ do
|
||||
dirstream <- liftIO $ openDirStream dir
|
||||
ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
|
||||
dirstream <- liftIO $ openDirStreamPortable dir
|
||||
ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
|
||||
return (dirstream, ref)
|
||||
|
||||
getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
|
||||
|
||||
@@ -10,9 +10,20 @@
|
||||
module GHCup.Prelude.File.Posix.Traversals (
|
||||
-- lower-level stuff
|
||||
readDirEnt
|
||||
, readDirEntPortable
|
||||
, openDirStreamPortable
|
||||
, closeDirStreamPortable
|
||||
, unpackDirStream
|
||||
, DirStreamPortable
|
||||
) where
|
||||
|
||||
#include <limits.h>
|
||||
#include <stdlib.h>
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>))
|
||||
@@ -28,6 +39,7 @@ import Foreign.Storable
|
||||
import System.Posix
|
||||
import Foreign (alloca)
|
||||
import System.Posix.Internals (peekFilePath)
|
||||
import System.FilePath
|
||||
|
||||
|
||||
|
||||
@@ -90,3 +102,38 @@ readDirEnt (unpackDirStream -> dirp) =
|
||||
then return (dtUnknown, mempty)
|
||||
else throwErrno "readDirEnt"
|
||||
|
||||
|
||||
newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
|
||||
|
||||
openDirStreamPortable :: FilePath -> IO DirStreamPortable
|
||||
openDirStreamPortable fp = do
|
||||
dirs <- openDirStream fp
|
||||
pure $ DirStreamPortable (fp, dirs)
|
||||
|
||||
closeDirStreamPortable :: DirStreamPortable -> IO ()
|
||||
closeDirStreamPortable (DirStreamPortable (_, dirs)) = closeDirStream dirs
|
||||
|
||||
readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
|
||||
readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
|
||||
(dt, fp) <- readDirEnt dirs
|
||||
case (dt, fp) of
|
||||
(DirType #{const DT_BLK}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_CHR}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_DIR}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_FIFO}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_REG}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
|
||||
(DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
|
||||
(_, _)
|
||||
| fp /= "" -> do
|
||||
stat <- getSymbolicLinkStatus (basedir </> fp)
|
||||
pure $ (, fp) $ if | isBlockDevice stat -> DirType #{const DT_BLK}
|
||||
| isCharacterDevice stat -> DirType #{const DT_CHR}
|
||||
| isDirectory stat -> DirType #{const DT_DIR}
|
||||
| isNamedPipe stat -> DirType #{const DT_FIFO}
|
||||
| isSymbolicLink stat -> DirType #{const DT_LNK}
|
||||
| isRegularFile stat -> DirType #{const DT_REG}
|
||||
| isSocket stat -> DirType #{const DT_SOCK}
|
||||
| otherwise -> DirType #{const DT_UNKNOWN}
|
||||
|
||||
@@ -66,7 +66,7 @@ data GHCupInfo = GHCupInfo
|
||||
, _ghcupDownloads :: GHCupDownloads
|
||||
, _globalTools :: Map GlobalTool DownloadInfo
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
instance NFData GHCupInfo
|
||||
|
||||
@@ -87,7 +87,7 @@ data Requirements = Requirements
|
||||
{ _distroPKGs :: [Text]
|
||||
, _notes :: Text
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
instance NFData Requirements
|
||||
|
||||
@@ -138,6 +138,7 @@ data VersionInfo = VersionInfo
|
||||
{ _viTags :: [Tag] -- ^ version specific tag
|
||||
, _viChangeLog :: Maybe URI
|
||||
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
|
||||
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
|
||||
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
|
||||
-- informative messages
|
||||
, _viPostInstall :: Maybe Text
|
||||
@@ -274,6 +275,23 @@ instance NFData DownloadInfo
|
||||
--[ Others ]--
|
||||
--------------
|
||||
|
||||
data DownloadMirror = DownloadMirror {
|
||||
authority :: Authority
|
||||
, pathPrefix :: Maybe Text
|
||||
} deriving (Eq, Ord, GHC.Generic, Show)
|
||||
|
||||
instance NFData DownloadMirror
|
||||
|
||||
newtype DownloadMirrors = DM (Map Text DownloadMirror)
|
||||
deriving (Eq, Ord, GHC.Generic, Show)
|
||||
|
||||
instance NFData DownloadMirrors
|
||||
|
||||
instance NFData UserInfo
|
||||
instance NFData Host
|
||||
instance NFData Port
|
||||
instance NFData Authority
|
||||
|
||||
|
||||
-- | How to descend into a tar archive.
|
||||
data TarDir = RealDir FilePath
|
||||
@@ -316,12 +334,13 @@ data UserSettings = UserSettings
|
||||
, uUrlSource :: Maybe URLSource
|
||||
, uNoNetwork :: Maybe Bool
|
||||
, uGPGSetting :: Maybe GPGSetting
|
||||
, uPlatformOverride :: Maybe PlatformRequest
|
||||
, uPlatformOverride :: Maybe PlatformRequest
|
||||
, uMirrors :: Maybe DownloadMirrors
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
defaultUserSettings :: UserSettings
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
||||
fromSettings Settings{..} Nothing =
|
||||
@@ -338,6 +357,7 @@ fromSettings Settings{..} Nothing =
|
||||
, uUrlSource = Just urlSource
|
||||
, uGPGSetting = Just gpgSetting
|
||||
, uPlatformOverride = platformOverride
|
||||
, uMirrors = Just mirrors
|
||||
}
|
||||
fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
let ukb = UserKeyBindings
|
||||
@@ -364,6 +384,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
, uUrlSource = Just urlSource
|
||||
, uGPGSetting = Just gpgSetting
|
||||
, uPlatformOverride = platformOverride
|
||||
, uMirrors = Just mirrors
|
||||
}
|
||||
|
||||
data UserKeyBindings = UserKeyBindings
|
||||
@@ -393,7 +414,9 @@ data KeyBindings = KeyBindings
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData KeyBindings
|
||||
#if defined(IS_WINDOWS) || !defined(BRICK)
|
||||
instance NFData Key
|
||||
#endif
|
||||
|
||||
defaultKeyBindings :: KeyBindings
|
||||
defaultKeyBindings = KeyBindings
|
||||
@@ -445,6 +468,7 @@ data Settings = Settings
|
||||
, gpgSetting :: GPGSetting
|
||||
, noColor :: Bool -- this also exists in LoggerConfig
|
||||
, platformOverride :: Maybe PlatformRequest
|
||||
, mirrors :: DownloadMirrors
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
@@ -452,7 +476,7 @@ defaultMetaCache :: Integer
|
||||
defaultMetaCache = 300 -- 5 minutes
|
||||
|
||||
defaultSettings :: Settings
|
||||
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
|
||||
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
|
||||
|
||||
instance NFData Settings
|
||||
|
||||
|
||||
@@ -29,6 +29,7 @@ import Control.Applicative ( (<|>) )
|
||||
import Data.Aeson hiding (Key)
|
||||
import Data.Aeson.TH
|
||||
import Data.Aeson.Types hiding (Key)
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List.NonEmpty ( NonEmpty(..) )
|
||||
import Data.Text.Encoding as E
|
||||
import Data.Versions
|
||||
@@ -225,6 +226,12 @@ instance FromJSON VersionCmp where
|
||||
Right r -> pure r
|
||||
Left e -> fail (MP.errorBundlePretty e)
|
||||
|
||||
instance ToJSON ByteString where
|
||||
toJSON = toJSON . E.decodeUtf8With E.lenientDecode
|
||||
|
||||
instance FromJSON ByteString where
|
||||
parseJSON = withText "ByteString" $ \t -> pure $ E.encodeUtf8 t
|
||||
|
||||
versionCmpToText :: VersionCmp -> T.Text
|
||||
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
|
||||
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
|
||||
@@ -320,6 +327,12 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
|
||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
|
||||
|
||||
@@ -356,4 +369,3 @@ instance FromJSON URLSource where
|
||||
pure (AddSource r)
|
||||
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||
|
||||
|
||||
@@ -93,6 +93,7 @@ import qualified Data.List.NonEmpty as NE
|
||||
import qualified Streamly.Prelude as S
|
||||
import Control.DeepSeq (force)
|
||||
import GHC.IO (evaluate)
|
||||
import System.Environment (getEnvironment, setEnv)
|
||||
|
||||
|
||||
-- $setup
|
||||
@@ -967,11 +968,28 @@ make :: ( MonadThrow m
|
||||
=> [String]
|
||||
-> Maybe FilePath
|
||||
-> m (Either ProcessError ())
|
||||
make args workdir = do
|
||||
make args workdir = make' args workdir "ghc-make" Nothing
|
||||
|
||||
|
||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||
make' :: ( MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
)
|
||||
=> [String]
|
||||
-> Maybe FilePath
|
||||
-> FilePath -- ^ log filename (opened in append mode)
|
||||
-> Maybe [(String, String)] -- ^ optional environment
|
||||
-> m (Either ProcessError ())
|
||||
make' args workdir logfile menv = do
|
||||
spaths <- liftIO getSearchPath
|
||||
has_gmake <- isJust <$> liftIO (searchPath spaths "gmake")
|
||||
let mymake = if has_gmake then "gmake" else "make"
|
||||
execLogged mymake args workdir "ghc-make" Nothing
|
||||
execLogged mymake args workdir logfile menv
|
||||
|
||||
|
||||
makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
=> [String]
|
||||
@@ -1282,6 +1300,22 @@ warnAboutHlsCompatibility = do
|
||||
|
||||
|
||||
|
||||
addToPath :: FilePath
|
||||
-> Bool -- ^ if False will prepend
|
||||
-> IO [(String, String)]
|
||||
addToPath path append = do
|
||||
cEnv <- Map.fromList <$> getEnvironment
|
||||
let paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
{- HLINT ignore "Redundant bracket" -}
|
||||
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
liftIO $ setEnv pathVar newPath
|
||||
return envWithNewPath
|
||||
|
||||
|
||||
-----------
|
||||
--[ Git ]--
|
||||
-----------
|
||||
|
||||
@@ -2,7 +2,6 @@ site_name: GHCup
|
||||
site_url: https://www.haskell.org/ghcup
|
||||
site_description: GHCup is the main installer for the general purpose language Haskell.
|
||||
site_author: GHCup Team
|
||||
site_favicon: haskell_logo.png
|
||||
|
||||
repo_url: https://github.com/haskell/ghcup-hs
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.18.0"
|
||||
ghver="0.1.19.0"
|
||||
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -119,20 +119,26 @@ edo() {
|
||||
"$@" || die "\"$*\" failed!"
|
||||
}
|
||||
|
||||
eghcup_raw() {
|
||||
"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
edo _eghcup "$@"
|
||||
_eghcup "$@"
|
||||
}
|
||||
|
||||
_eghcup() {
|
||||
if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
|
||||
args="-s ${BOOTSTRAP_HASKELL_YAML}"
|
||||
args="-s ${BOOTSTRAP_HASKELL_YAML} --metadata-fetching-mode=Strict"
|
||||
else
|
||||
args="--metadata-fetching-mode=Strict"
|
||||
fi
|
||||
if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
|
||||
# shellcheck disable=SC2086
|
||||
"${GHCUP_BIN}/ghcup" ${args} "$@"
|
||||
"${GHCUP_BIN}/ghcup" ${args} "$@" || die "\"ghcup ${args} $*\" failed!"
|
||||
else
|
||||
# shellcheck disable=SC2086
|
||||
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@"
|
||||
"${GHCUP_BIN}/ghcup" ${args} --verbose "$@" || die "\"ghcup ${args} --verbose $*\" failed!"
|
||||
fi
|
||||
}
|
||||
|
||||
@@ -147,7 +153,7 @@ _ecabal() {
|
||||
}
|
||||
|
||||
ecabal() {
|
||||
edo _ecabal "$@"
|
||||
_ecabal "$@" || die "\"cabal $*\" failed!"
|
||||
}
|
||||
|
||||
_done() {
|
||||
@@ -282,14 +288,6 @@ download_ghcup() {
|
||||
esac
|
||||
;;
|
||||
"FreeBSD"|"freebsd")
|
||||
if freebsd-version | grep -E '^12.*' ; then
|
||||
freebsd_ver=12
|
||||
elif freebsd-version | grep -E '^13.*' ; then
|
||||
freebsd_ver=13
|
||||
else
|
||||
die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
|
||||
fi
|
||||
|
||||
case "${arch}" in
|
||||
x86_64|amd64)
|
||||
;;
|
||||
@@ -299,7 +297,7 @@ download_ghcup() {
|
||||
*) die "Unknown architecture: ${arch}"
|
||||
;;
|
||||
esac
|
||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
|
||||
_url=${GHCUP_BASE_URL}/${ghver}/x86_64-portbld-freebsd-ghcup-${ghver}
|
||||
;;
|
||||
"Darwin"|"darwin")
|
||||
case "${arch}" in
|
||||
@@ -387,10 +385,10 @@ download_ghcup() {
|
||||
edo . "${GHCUP_DIR}"/env
|
||||
case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
|
||||
"curl")
|
||||
eghcup config set downloader Curl
|
||||
eghcup_raw config set downloader Curl
|
||||
;;
|
||||
"wget")
|
||||
eghcup config set downloader Wget
|
||||
eghcup_raw config set downloader Wget
|
||||
;;
|
||||
*)
|
||||
die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
|
||||
@@ -795,7 +793,7 @@ edo mkdir -p "${GHCUP_BIN}"
|
||||
|
||||
if command -V "ghcup" >/dev/null 2>&1 ; then
|
||||
if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
|
||||
_eghcup upgrade || download_ghcup
|
||||
( _eghcup upgrade ) || download_ghcup
|
||||
fi
|
||||
else
|
||||
download_ghcup
|
||||
@@ -842,17 +840,17 @@ fi
|
||||
|
||||
case $ask_hls_answer in
|
||||
1)
|
||||
_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
|
||||
(_eghcup --cache install hls) || warn "HLS installation failed, continuing anyway"
|
||||
;;
|
||||
*) ;;
|
||||
esac
|
||||
|
||||
case $ask_stack_answer in
|
||||
1)
|
||||
_eghcup --cache install stack || die "Stack installation failed"
|
||||
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||
;;
|
||||
2)
|
||||
_eghcup --cache install stack || die "Stack installation failed"
|
||||
(_eghcup --cache install stack) || die "Stack installation failed"
|
||||
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
|
||||
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
|
||||
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
|
||||
|
||||
@@ -432,12 +432,13 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
}
|
||||
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
||||
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
||||
$msysUrl = ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||
|
||||
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
||||
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
||||
Exec "curl.exe" '-o' "$archivePath" "$msysUrl"
|
||||
} else {
|
||||
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||
Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||
}
|
||||
|
||||
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||
|
||||
@@ -1,49 +1,34 @@
|
||||
#!/bin/bash
|
||||
|
||||
set -eu
|
||||
set -o pipefail
|
||||
|
||||
tag=v$1
|
||||
ver=$1
|
||||
shopt -s extglob
|
||||
|
||||
dest=$2
|
||||
gpg_user=$3
|
||||
RELEASE=$1
|
||||
SIGNER=$2
|
||||
|
||||
mkdir -p "${dest}"
|
||||
echo "RELEASE: $RELEASE"
|
||||
echo "SIGNER: $SIGNER"
|
||||
|
||||
cd "${dest}"
|
||||
for com in gh gpg curl sha256sum ; do
|
||||
command -V ${com} >/dev/null 2>&1
|
||||
done
|
||||
|
||||
base_url="https://gitlab.haskell.org/api/v4/projects/618/jobs/artifacts/${tag}/raw"
|
||||
[ ! -e "gh-release-artifacts/${RELEASE}" ]
|
||||
|
||||
curl -f -o "x86_64-apple-darwin-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-apple-darwin-ghcup-${ver}?job=release:darwin"
|
||||
mkdir -p "gh-release-artifacts/${RELEASE}"
|
||||
cd "gh-release-artifacts/${RELEASE}"
|
||||
|
||||
curl -f -o "aarch64-apple-darwin-ghcup-${ver}" \
|
||||
"${base_url}/out/aarch64-apple-darwin-ghcup-${ver}?job=release:darwin:aarch64"
|
||||
# github
|
||||
gh release download $RELEASE
|
||||
|
||||
curl -f -o "x86_64-freebsd12-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd12"
|
||||
|
||||
curl -f -o "x86_64-freebsd13-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd13"
|
||||
|
||||
curl -f -o "i386-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/i386-linux-ghcup-${ver}?job=release:linux:32bit"
|
||||
|
||||
curl -f -o "x86_64-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-linux-ghcup-${ver}?job=release:linux:64bit"
|
||||
|
||||
curl -f -o "aarch64-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/aarch64-linux-ghcup-${ver}?job=release:linux:aarch64"
|
||||
|
||||
curl -f -o "armv7-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/armv7-linux-ghcup-${ver}?job=release:linux:armv7"
|
||||
|
||||
curl -f -o "x86_64-mingw64-ghcup-${ver}.exe" \
|
||||
"${base_url}/out/x86_64-mingw64-ghcup-${ver}.exe?job=release:windows"
|
||||
|
||||
rm -f *.sig
|
||||
sha256sum *-ghcup-* > SHA256SUMS
|
||||
gpg --detach-sign -u ${gpg_user} SHA256SUMS
|
||||
for f in *-ghcup-* ; do gpg --detach-sign -u ${gpg_user} $f ; done
|
||||
rm test-*
|
||||
|
||||
# cirrus
|
||||
curl -L -o x86_64-portbld-freebsd-ghcup-${RELEASE} \
|
||||
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}"
|
||||
|
||||
sha256sum *ghcup* > SHA256SUMS
|
||||
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
||||
|
||||
|
||||
@@ -29,8 +29,7 @@ symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
|
||||
symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
|
||||
symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
|
||||
symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
|
||||
symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
|
||||
symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
|
||||
symlink ${ver}/x86_64-portbld-freebsd-ghcup-${ver} x86_64-portbld-freebsd-ghcup
|
||||
symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
|
||||
symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
|
||||
EOF
|
||||
|
||||
@@ -25,22 +25,28 @@ put SHA256SUMS
|
||||
put SHA256SUMS.sig
|
||||
put aarch64-apple-darwin-ghcup-${ver}
|
||||
put aarch64-apple-darwin-ghcup-${ver}.sig
|
||||
put aarch64-apple-darwin-ghcup.plan.json
|
||||
put aarch64-linux-ghcup-${ver}
|
||||
put aarch64-linux-ghcup-${ver}.sig
|
||||
put aarch64-linux-ghcup.plan.json
|
||||
put armv7-linux-ghcup-${ver}
|
||||
put armv7-linux-ghcup-${ver}.sig
|
||||
put armv7-linux-ghcup.plan.json
|
||||
put i386-linux-ghcup-${ver}
|
||||
put i386-linux-ghcup-${ver}.sig
|
||||
put i386-linux-ghcup.plan.json
|
||||
put x86_64-apple-darwin-ghcup-${ver}
|
||||
put x86_64-apple-darwin-ghcup-${ver}.sig
|
||||
put x86_64-freebsd12-ghcup-${ver}
|
||||
put x86_64-freebsd12-ghcup-${ver}.sig
|
||||
put x86_64-freebsd13-ghcup-${ver}
|
||||
put x86_64-freebsd13-ghcup-${ver}.sig
|
||||
put x86_64-apple-darwin-ghcup.plan.json
|
||||
put x86_64-portbld-freebsd-ghcup-${ver}
|
||||
put x86_64-portbld-freebsd-ghcup-${ver}.sig
|
||||
put x86_64-portbld-freebsd-ghcup.plan.json
|
||||
put x86_64-linux-ghcup-${ver}
|
||||
put x86_64-linux-ghcup-${ver}.sig
|
||||
put x86_64-linux-ghcup.plan.json
|
||||
put x86_64-mingw64-ghcup-${ver}.exe
|
||||
put x86_64-mingw64-ghcup-${ver}.exe.sig
|
||||
put x86_64-mingw64-ghcup.plan.json
|
||||
EOF
|
||||
|
||||
curl -X PURGE https://downloads.haskell.org/~ghcup/${ver}/
|
||||
|
||||
@@ -6,7 +6,6 @@ packages:
|
||||
extra-deps:
|
||||
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
|
||||
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
|
||||
- ansi-terminal-game-1.8.0.0@sha256:001cf786098d9f1056ac6055ff3f598054b5c231b7343e76abb686d4f485855d,6977
|
||||
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
|
||||
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
|
||||
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
|
||||
@@ -28,7 +27,6 @@ extra-deps:
|
||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
||||
- libarchive-3.0.3.0
|
||||
- libyaml-streamly-0.2.1
|
||||
- linebreak-1.1.0.1@sha256:b253873c3f98189eb22a5a9f0405677cde125c09666b63c3117f497c01c95893,1397
|
||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
||||
@@ -38,10 +36,8 @@ extra-deps:
|
||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
||||
- regex-posix-clib-2.7
|
||||
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- timers-tick-0.5.0.1@sha256:91d4b03266715c6969b82cb24e57a6b47191a4d2f95e9a92e0ad3f7301cc7c8b,1552
|
||||
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
|
||||
- unidecode-0.1.0.4@sha256:99581ee1ea334a4596a09ae3642e007808457c66893b587e965b31f15cbf8c4d,1144
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- yaml-streamly-0.12.1
|
||||
|
||||
@@ -64,9 +60,6 @@ flags:
|
||||
streamly:
|
||||
use-unliftio: true
|
||||
|
||||
ghcup:
|
||||
tui-ansi: true
|
||||
|
||||
ghc-options:
|
||||
"$locals": -O2
|
||||
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
||||
|
||||
@@ -24,11 +24,11 @@ spec = do
|
||||
-- https://github.com/haskell/ghcup-hs/issues/415
|
||||
describe "GHCup.Prelude.File.Posix.Traversals" $ do
|
||||
it "readDirEnt" $ do
|
||||
dirstream <- liftIO $ openDirStream "test/data"
|
||||
(dt1, fp1) <- readDirEnt dirstream
|
||||
(dt2, fp2) <- readDirEnt dirstream
|
||||
(dt3, fp3) <- readDirEnt dirstream
|
||||
(dt4, fp4) <- readDirEnt dirstream
|
||||
dirstream <- liftIO $ openDirStreamPortable "test/data"
|
||||
(dt1, fp1) <- readDirEntPortable dirstream
|
||||
(dt2, fp2) <- readDirEntPortable dirstream
|
||||
(dt3, fp3) <- readDirEntPortable dirstream
|
||||
(dt4, fp4) <- readDirEntPortable dirstream
|
||||
let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
|
||||
, (dt3, fp3), (dt4, fp4)
|
||||
]
|
||||
|
||||
@@ -285,7 +285,8 @@
|
||||
"base-8.7.6",
|
||||
"Latest",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"7.5.5": {
|
||||
"viArch": {
|
||||
@@ -387,7 +388,8 @@
|
||||
"base-4.7.6",
|
||||
"\u0001+n𫛚\r",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"7.7.6": {
|
||||
"viArch": {
|
||||
@@ -509,7 +511,8 @@
|
||||
"old",
|
||||
"base-3.1.4",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.8.6": {
|
||||
"viArch": {
|
||||
@@ -824,7 +827,8 @@
|
||||
"base-5.2.3",
|
||||
"Prerelease",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"HLS": {
|
||||
@@ -1084,7 +1088,8 @@
|
||||
"Latest",
|
||||
"Latest",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"2.1.4": {
|
||||
"viArch": {
|
||||
@@ -1240,7 +1245,8 @@
|
||||
"viTags": [
|
||||
"Prerelease",
|
||||
"base-4.7.4"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.3.7": {
|
||||
"viArch": {
|
||||
@@ -1670,7 +1676,8 @@
|
||||
},
|
||||
"dlUri": "https:mkzzunx"
|
||||
},
|
||||
"viTags": []
|
||||
"viTags": [],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.5.3": {
|
||||
"viArch": {
|
||||
@@ -1972,7 +1979,8 @@
|
||||
"old",
|
||||
"Recommended",
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"5.2.3": {
|
||||
"viArch": {
|
||||
@@ -2309,7 +2317,8 @@
|
||||
"Latest",
|
||||
"Recommended",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.5.2": {
|
||||
"viArch": {
|
||||
@@ -2431,7 +2440,8 @@
|
||||
"Latest",
|
||||
"Latest",
|
||||
"base-8.7.3"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
}
|
||||
},
|
||||
@@ -2880,7 +2890,8 @@
|
||||
},
|
||||
"dlUri": "https:zxekodom"
|
||||
},
|
||||
"viTags": []
|
||||
"viTags": [],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.2.1": {
|
||||
"viArch": {
|
||||
@@ -3100,7 +3111,8 @@
|
||||
"base-7.7.6",
|
||||
"𩺈𥲬\u0015A~",
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.5.3": {
|
||||
"viArch": {
|
||||
@@ -3330,7 +3342,8 @@
|
||||
"base-1.5.2",
|
||||
"Latest",
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"7.3.9": {
|
||||
"viArch": {
|
||||
@@ -3688,7 +3701,8 @@
|
||||
"base-1.6.1",
|
||||
"Prerelease",
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"GHCup": {
|
||||
@@ -3747,7 +3761,8 @@
|
||||
"Latest",
|
||||
"\u0005s톕$\"g",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.5.3": {
|
||||
"viArch": {
|
||||
@@ -3880,7 +3895,8 @@
|
||||
"Latest",
|
||||
"xZ\u000b",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.8.5": {
|
||||
"viArch": {
|
||||
@@ -3993,7 +4009,8 @@
|
||||
"viSourceDL": null,
|
||||
"viTags": [
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.1.6": {
|
||||
"viArch": {
|
||||
@@ -4179,7 +4196,8 @@
|
||||
"viTags": [
|
||||
"Latest",
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"7.5.4": {
|
||||
"viArch": {
|
||||
@@ -4456,7 +4474,8 @@
|
||||
"viSourceDL": null,
|
||||
"viTags": [
|
||||
"鲤"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"HLS": {
|
||||
@@ -4827,7 +4846,8 @@
|
||||
"",
|
||||
"Ctj",
|
||||
"|Wd`"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.5.1": {
|
||||
"viArch": {
|
||||
@@ -4937,7 +4957,8 @@
|
||||
"old",
|
||||
"Latest",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.2.2": {
|
||||
"viArch": {
|
||||
@@ -5030,7 +5051,8 @@
|
||||
"Recommended",
|
||||
"Recommended",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.4.1": {
|
||||
"viArch": {
|
||||
@@ -5122,7 +5144,8 @@
|
||||
"Latest",
|
||||
"Latest",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"5.7.2": {
|
||||
"viArch": {
|
||||
@@ -5473,7 +5496,8 @@
|
||||
"Prerelease",
|
||||
"Prerelease",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"7.1.4": {
|
||||
"viArch": {
|
||||
@@ -5559,7 +5583,8 @@
|
||||
"Latest",
|
||||
"\u0013ADq\u001bX<",
|
||||
"base-8.2.4"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.2.3": {
|
||||
"viArch": {
|
||||
@@ -5667,7 +5692,8 @@
|
||||
"𠖛",
|
||||
"恦AD假n#",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.3.5": {
|
||||
"viArch": {
|
||||
@@ -6070,7 +6096,8 @@
|
||||
"Prerelease",
|
||||
"%R灡𑈃pS",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
}
|
||||
},
|
||||
@@ -7355,7 +7382,8 @@
|
||||
"old",
|
||||
"Latest",
|
||||
"base-8.5.8"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"2.1.4": {
|
||||
"viArch": {
|
||||
@@ -8043,7 +8071,8 @@
|
||||
"",
|
||||
"\u0018\u0017GF\u0018",
|
||||
"base-8.7.8"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.6.8": {
|
||||
"viArch": {
|
||||
@@ -8329,7 +8358,8 @@
|
||||
"base-8.1.6",
|
||||
"old",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"5.1.8": {
|
||||
"viArch": {
|
||||
@@ -8529,7 +8559,8 @@
|
||||
"Prerelease",
|
||||
"~X6*𦥹",
|
||||
"base-2.1.6"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"5.4.7": {
|
||||
"viArch": {},
|
||||
@@ -8549,7 +8580,8 @@
|
||||
"9pR𥎷H",
|
||||
"base-7.5.6",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"Stack": {
|
||||
@@ -8891,7 +8923,8 @@
|
||||
},
|
||||
"dlUri": "http:gji"
|
||||
},
|
||||
"viTags": []
|
||||
"viTags": [],
|
||||
"viTestDL": null
|
||||
},
|
||||
"7.2.3": {
|
||||
"viArch": {
|
||||
@@ -9036,7 +9069,8 @@
|
||||
"old",
|
||||
"Recommended",
|
||||
"base-2.5.2"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
}
|
||||
},
|
||||
@@ -10413,7 +10447,8 @@
|
||||
"Recommended",
|
||||
"S鴖xz",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.4.4": {
|
||||
"viArch": {
|
||||
@@ -10725,7 +10760,8 @@
|
||||
"Prerelease",
|
||||
"old",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"5.5.4": {
|
||||
"viArch": {
|
||||
@@ -11105,7 +11141,8 @@
|
||||
"Latest",
|
||||
"base-1.8.1",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"5.6.4": {
|
||||
"viArch": {
|
||||
@@ -11348,7 +11385,8 @@
|
||||
"Prerelease",
|
||||
">/~l\u0019\u0001F\u0003",
|
||||
"base-4.4.6"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"6.7.3": {
|
||||
"viArch": {},
|
||||
@@ -11367,7 +11405,8 @@
|
||||
"viTags": [
|
||||
"old",
|
||||
"old"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.5.5": {
|
||||
"viArch": {},
|
||||
@@ -11388,7 +11427,8 @@
|
||||
"Latest",
|
||||
"base-3.6.3",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.6.5": {
|
||||
"viArch": {
|
||||
@@ -11770,7 +11810,8 @@
|
||||
"v斾)k",
|
||||
"Prerelease",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"GHC": {},
|
||||
@@ -13541,7 +13582,8 @@
|
||||
},
|
||||
"viTags": [
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"2.6.7": {
|
||||
"viArch": {
|
||||
@@ -13585,7 +13627,8 @@
|
||||
"viSourceDL": null,
|
||||
"viTags": [
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.3.5": {
|
||||
"viArch": {
|
||||
@@ -13608,7 +13651,8 @@
|
||||
"&Z3𭹡X",
|
||||
"Prerelease",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"3.4.4": {
|
||||
"viArch": {
|
||||
@@ -14065,7 +14109,8 @@
|
||||
"f8\u0017xNft(",
|
||||
"Recommended",
|
||||
"Prerelease"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"6.5.7": {
|
||||
"viArch": {
|
||||
@@ -14242,7 +14287,8 @@
|
||||
"dlSubdir": "qG+0t",
|
||||
"dlUri": "http:vvn"
|
||||
},
|
||||
"viTags": []
|
||||
"viTags": [],
|
||||
"viTestDL": null
|
||||
},
|
||||
"6.6.3": {
|
||||
"viArch": {
|
||||
@@ -14310,7 +14356,8 @@
|
||||
"",
|
||||
"\u0014𣉈C\u0018V",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.5.4": {
|
||||
"viArch": {
|
||||
@@ -14463,7 +14510,8 @@
|
||||
"Latest",
|
||||
"\u0005I{5\u0013",
|
||||
"base-3.8.8"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"GHCup": {
|
||||
@@ -14635,7 +14683,8 @@
|
||||
"Latest",
|
||||
"old",
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"4.3.4": {
|
||||
"viArch": {
|
||||
@@ -14831,7 +14880,8 @@
|
||||
"\u0017M",
|
||||
"old",
|
||||
"Recommended"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
},
|
||||
"8.6.2": {
|
||||
"viArch": {
|
||||
@@ -15167,7 +15217,8 @@
|
||||
"Prerelease",
|
||||
"Prerelease",
|
||||
"base-5.1.6"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
},
|
||||
"Stack": {
|
||||
@@ -15524,7 +15575,8 @@
|
||||
},
|
||||
"viTags": [
|
||||
"Latest"
|
||||
]
|
||||
],
|
||||
"viTestDL": null
|
||||
}
|
||||
}
|
||||
},
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,674 +0,0 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The GNU General Public License is a free, copyleft license for
|
||||
software and other kinds of works.
|
||||
|
||||
The licenses for most software and other practical works are designed
|
||||
to take away your freedom to share and change the works. By contrast,
|
||||
the GNU General Public License is intended to guarantee your freedom to
|
||||
share and change all versions of a program--to make sure it remains free
|
||||
software for all its users. We, the Free Software Foundation, use the
|
||||
GNU General Public License for most of our software; it applies also to
|
||||
any other work released this way by its authors. You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
them if you wish), that you receive source code or can get it if you
|
||||
want it, that you can change the software or use pieces of it in new
|
||||
free programs, and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to prevent others from denying you
|
||||
these rights or asking you to surrender the rights. Therefore, you have
|
||||
certain responsibilities if you distribute copies of the software, or if
|
||||
you modify it: responsibilities to respect the freedom of others.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must pass on to the recipients the same
|
||||
freedoms that you received. You must make sure that they, too, receive
|
||||
or can get the source code. And you must show them these terms so they
|
||||
know their rights.
|
||||
|
||||
Developers that use the GNU GPL protect your rights with two steps:
|
||||
(1) assert copyright on the software, and (2) offer you this License
|
||||
giving you legal permission to copy, distribute and/or modify it.
|
||||
|
||||
For the developers' and authors' protection, the GPL clearly explains
|
||||
that there is no warranty for this free software. For both users' and
|
||||
authors' sake, the GPL requires that modified versions be marked as
|
||||
changed, so that their problems will not be attributed erroneously to
|
||||
authors of previous versions.
|
||||
|
||||
Some devices are designed to deny users access to install or run
|
||||
modified versions of the software inside them, although the manufacturer
|
||||
can do so. This is fundamentally incompatible with the aim of
|
||||
protecting users' freedom to change the software. The systematic
|
||||
pattern of such abuse occurs in the area of products for individuals to
|
||||
use, which is precisely where it is most unacceptable. Therefore, we
|
||||
have designed this version of the GPL to prohibit the practice for those
|
||||
products. If such problems arise substantially in other domains, we
|
||||
stand ready to extend this provision to those domains in future versions
|
||||
of the GPL, as needed to protect the freedom of users.
|
||||
|
||||
Finally, every program is threatened constantly by software patents.
|
||||
States should not allow patents to restrict development and use of
|
||||
software on general-purpose computers, but in those that do, we wish to
|
||||
avoid the special danger that patents applied to a free program could
|
||||
make it effectively proprietary. To prevent this, the GPL assures that
|
||||
patents cannot be used to render the program non-free.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
TERMS AND CONDITIONS
|
||||
|
||||
0. Definitions.
|
||||
|
||||
"This License" refers to version 3 of the GNU General Public License.
|
||||
|
||||
"Copyright" also means copyright-like laws that apply to other kinds of
|
||||
works, such as semiconductor masks.
|
||||
|
||||
"The Program" refers to any copyrightable work licensed under this
|
||||
License. Each licensee is addressed as "you". "Licensees" and
|
||||
"recipients" may be individuals or organizations.
|
||||
|
||||
To "modify" a work means to copy from or adapt all or part of the work
|
||||
in a fashion requiring copyright permission, other than the making of an
|
||||
exact copy. The resulting work is called a "modified version" of the
|
||||
earlier work or a work "based on" the earlier work.
|
||||
|
||||
A "covered work" means either the unmodified Program or a work based
|
||||
on the Program.
|
||||
|
||||
To "propagate" a work means to do anything with it that, without
|
||||
permission, would make you directly or secondarily liable for
|
||||
infringement under applicable copyright law, except executing it on a
|
||||
computer or modifying a private copy. Propagation includes copying,
|
||||
distribution (with or without modification), making available to the
|
||||
public, and in some countries other activities as well.
|
||||
|
||||
To "convey" a work means any kind of propagation that enables other
|
||||
parties to make or receive copies. Mere interaction with a user through
|
||||
a computer network, with no transfer of a copy, is not conveying.
|
||||
|
||||
An interactive user interface displays "Appropriate Legal Notices"
|
||||
to the extent that it includes a convenient and prominently visible
|
||||
feature that (1) displays an appropriate copyright notice, and (2)
|
||||
tells the user that there is no warranty for the work (except to the
|
||||
extent that warranties are provided), that licensees may convey the
|
||||
work under this License, and how to view a copy of this License. If
|
||||
the interface presents a list of user commands or options, such as a
|
||||
menu, a prominent item in the list meets this criterion.
|
||||
|
||||
1. Source Code.
|
||||
|
||||
The "source code" for a work means the preferred form of the work
|
||||
for making modifications to it. "Object code" means any non-source
|
||||
form of a work.
|
||||
|
||||
A "Standard Interface" means an interface that either is an official
|
||||
standard defined by a recognized standards body, or, in the case of
|
||||
interfaces specified for a particular programming language, one that
|
||||
is widely used among developers working in that language.
|
||||
|
||||
The "System Libraries" of an executable work include anything, other
|
||||
than the work as a whole, that (a) is included in the normal form of
|
||||
packaging a Major Component, but which is not part of that Major
|
||||
Component, and (b) serves only to enable use of the work with that
|
||||
Major Component, or to implement a Standard Interface for which an
|
||||
implementation is available to the public in source code form. A
|
||||
"Major Component", in this context, means a major essential component
|
||||
(kernel, window system, and so on) of the specific operating system
|
||||
(if any) on which the executable work runs, or a compiler used to
|
||||
produce the work, or an object code interpreter used to run it.
|
||||
|
||||
The "Corresponding Source" for a work in object code form means all
|
||||
the source code needed to generate, install, and (for an executable
|
||||
work) run the object code and to modify the work, including scripts to
|
||||
control those activities. However, it does not include the work's
|
||||
System Libraries, or general-purpose tools or generally available free
|
||||
programs which are used unmodified in performing those activities but
|
||||
which are not part of the work. For example, Corresponding Source
|
||||
includes interface definition files associated with source files for
|
||||
the work, and the source code for shared libraries and dynamically
|
||||
linked subprograms that the work is specifically designed to require,
|
||||
such as by intimate data communication or control flow between those
|
||||
subprograms and other parts of the work.
|
||||
|
||||
The Corresponding Source need not include anything that users
|
||||
can regenerate automatically from other parts of the Corresponding
|
||||
Source.
|
||||
|
||||
The Corresponding Source for a work in source code form is that
|
||||
same work.
|
||||
|
||||
2. Basic Permissions.
|
||||
|
||||
All rights granted under this License are granted for the term of
|
||||
copyright on the Program, and are irrevocable provided the stated
|
||||
conditions are met. This License explicitly affirms your unlimited
|
||||
permission to run the unmodified Program. The output from running a
|
||||
covered work is covered by this License only if the output, given its
|
||||
content, constitutes a covered work. This License acknowledges your
|
||||
rights of fair use or other equivalent, as provided by copyright law.
|
||||
|
||||
You may make, run and propagate covered works that you do not
|
||||
convey, without conditions so long as your license otherwise remains
|
||||
in force. You may convey covered works to others for the sole purpose
|
||||
of having them make modifications exclusively for you, or provide you
|
||||
with facilities for running those works, provided that you comply with
|
||||
the terms of this License in conveying all material for which you do
|
||||
not control copyright. Those thus making or running the covered works
|
||||
for you must do so exclusively on your behalf, under your direction
|
||||
and control, on terms that prohibit them from making any copies of
|
||||
your copyrighted material outside their relationship with you.
|
||||
|
||||
Conveying under any other circumstances is permitted solely under
|
||||
the conditions stated below. Sublicensing is not allowed; section 10
|
||||
makes it unnecessary.
|
||||
|
||||
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
|
||||
|
||||
No covered work shall be deemed part of an effective technological
|
||||
measure under any applicable law fulfilling obligations under article
|
||||
11 of the WIPO copyright treaty adopted on 20 December 1996, or
|
||||
similar laws prohibiting or restricting circumvention of such
|
||||
measures.
|
||||
|
||||
When you convey a covered work, you waive any legal power to forbid
|
||||
circumvention of technological measures to the extent such circumvention
|
||||
is effected by exercising rights under this License with respect to
|
||||
the covered work, and you disclaim any intention to limit operation or
|
||||
modification of the work as a means of enforcing, against the work's
|
||||
users, your or third parties' legal rights to forbid circumvention of
|
||||
technological measures.
|
||||
|
||||
4. Conveying Verbatim Copies.
|
||||
|
||||
You may convey verbatim copies of the Program's source code as you
|
||||
receive it, in any medium, provided that you conspicuously and
|
||||
appropriately publish on each copy an appropriate copyright notice;
|
||||
keep intact all notices stating that this License and any
|
||||
non-permissive terms added in accord with section 7 apply to the code;
|
||||
keep intact all notices of the absence of any warranty; and give all
|
||||
recipients a copy of this License along with the Program.
|
||||
|
||||
You may charge any price or no price for each copy that you convey,
|
||||
and you may offer support or warranty protection for a fee.
|
||||
|
||||
5. Conveying Modified Source Versions.
|
||||
|
||||
You may convey a work based on the Program, or the modifications to
|
||||
produce it from the Program, in the form of source code under the
|
||||
terms of section 4, provided that you also meet all of these conditions:
|
||||
|
||||
a) The work must carry prominent notices stating that you modified
|
||||
it, and giving a relevant date.
|
||||
|
||||
b) The work must carry prominent notices stating that it is
|
||||
released under this License and any conditions added under section
|
||||
7. This requirement modifies the requirement in section 4 to
|
||||
"keep intact all notices".
|
||||
|
||||
c) You must license the entire work, as a whole, under this
|
||||
License to anyone who comes into possession of a copy. This
|
||||
License will therefore apply, along with any applicable section 7
|
||||
additional terms, to the whole of the work, and all its parts,
|
||||
regardless of how they are packaged. This License gives no
|
||||
permission to license the work in any other way, but it does not
|
||||
invalidate such permission if you have separately received it.
|
||||
|
||||
d) If the work has interactive user interfaces, each must display
|
||||
Appropriate Legal Notices; however, if the Program has interactive
|
||||
interfaces that do not display Appropriate Legal Notices, your
|
||||
work need not make them do so.
|
||||
|
||||
A compilation of a covered work with other separate and independent
|
||||
works, which are not by their nature extensions of the covered work,
|
||||
and which are not combined with it such as to form a larger program,
|
||||
in or on a volume of a storage or distribution medium, is called an
|
||||
"aggregate" if the compilation and its resulting copyright are not
|
||||
used to limit the access or legal rights of the compilation's users
|
||||
beyond what the individual works permit. Inclusion of a covered work
|
||||
in an aggregate does not cause this License to apply to the other
|
||||
parts of the aggregate.
|
||||
|
||||
6. Conveying Non-Source Forms.
|
||||
|
||||
You may convey a covered work in object code form under the terms
|
||||
of sections 4 and 5, provided that you also convey the
|
||||
machine-readable Corresponding Source under the terms of this License,
|
||||
in one of these ways:
|
||||
|
||||
a) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by the
|
||||
Corresponding Source fixed on a durable physical medium
|
||||
customarily used for software interchange.
|
||||
|
||||
b) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by a
|
||||
written offer, valid for at least three years and valid for as
|
||||
long as you offer spare parts or customer support for that product
|
||||
model, to give anyone who possesses the object code either (1) a
|
||||
copy of the Corresponding Source for all the software in the
|
||||
product that is covered by this License, on a durable physical
|
||||
medium customarily used for software interchange, for a price no
|
||||
more than your reasonable cost of physically performing this
|
||||
conveying of source, or (2) access to copy the
|
||||
Corresponding Source from a network server at no charge.
|
||||
|
||||
c) Convey individual copies of the object code with a copy of the
|
||||
written offer to provide the Corresponding Source. This
|
||||
alternative is allowed only occasionally and noncommercially, and
|
||||
only if you received the object code with such an offer, in accord
|
||||
with subsection 6b.
|
||||
|
||||
d) Convey the object code by offering access from a designated
|
||||
place (gratis or for a charge), and offer equivalent access to the
|
||||
Corresponding Source in the same way through the same place at no
|
||||
further charge. You need not require recipients to copy the
|
||||
Corresponding Source along with the object code. If the place to
|
||||
copy the object code is a network server, the Corresponding Source
|
||||
may be on a different server (operated by you or a third party)
|
||||
that supports equivalent copying facilities, provided you maintain
|
||||
clear directions next to the object code saying where to find the
|
||||
Corresponding Source. Regardless of what server hosts the
|
||||
Corresponding Source, you remain obligated to ensure that it is
|
||||
available for as long as needed to satisfy these requirements.
|
||||
|
||||
e) Convey the object code using peer-to-peer transmission, provided
|
||||
you inform other peers where the object code and Corresponding
|
||||
Source of the work are being offered to the general public at no
|
||||
charge under subsection 6d.
|
||||
|
||||
A separable portion of the object code, whose source code is excluded
|
||||
from the Corresponding Source as a System Library, need not be
|
||||
included in conveying the object code work.
|
||||
|
||||
A "User Product" is either (1) a "consumer product", which means any
|
||||
tangible personal property which is normally used for personal, family,
|
||||
or household purposes, or (2) anything designed or sold for incorporation
|
||||
into a dwelling. In determining whether a product is a consumer product,
|
||||
doubtful cases shall be resolved in favor of coverage. For a particular
|
||||
product received by a particular user, "normally used" refers to a
|
||||
typical or common use of that class of product, regardless of the status
|
||||
of the particular user or of the way in which the particular user
|
||||
actually uses, or expects or is expected to use, the product. A product
|
||||
is a consumer product regardless of whether the product has substantial
|
||||
commercial, industrial or non-consumer uses, unless such uses represent
|
||||
the only significant mode of use of the product.
|
||||
|
||||
"Installation Information" for a User Product means any methods,
|
||||
procedures, authorization keys, or other information required to install
|
||||
and execute modified versions of a covered work in that User Product from
|
||||
a modified version of its Corresponding Source. The information must
|
||||
suffice to ensure that the continued functioning of the modified object
|
||||
code is in no case prevented or interfered with solely because
|
||||
modification has been made.
|
||||
|
||||
If you convey an object code work under this section in, or with, or
|
||||
specifically for use in, a User Product, and the conveying occurs as
|
||||
part of a transaction in which the right of possession and use of the
|
||||
User Product is transferred to the recipient in perpetuity or for a
|
||||
fixed term (regardless of how the transaction is characterized), the
|
||||
Corresponding Source conveyed under this section must be accompanied
|
||||
by the Installation Information. But this requirement does not apply
|
||||
if neither you nor any third party retains the ability to install
|
||||
modified object code on the User Product (for example, the work has
|
||||
been installed in ROM).
|
||||
|
||||
The requirement to provide Installation Information does not include a
|
||||
requirement to continue to provide support service, warranty, or updates
|
||||
for a work that has been modified or installed by the recipient, or for
|
||||
the User Product in which it has been modified or installed. Access to a
|
||||
network may be denied when the modification itself materially and
|
||||
adversely affects the operation of the network or violates the rules and
|
||||
protocols for communication across the network.
|
||||
|
||||
Corresponding Source conveyed, and Installation Information provided,
|
||||
in accord with this section must be in a format that is publicly
|
||||
documented (and with an implementation available to the public in
|
||||
source code form), and must require no special password or key for
|
||||
unpacking, reading or copying.
|
||||
|
||||
7. Additional Terms.
|
||||
|
||||
"Additional permissions" are terms that supplement the terms of this
|
||||
License by making exceptions from one or more of its conditions.
|
||||
Additional permissions that are applicable to the entire Program shall
|
||||
be treated as though they were included in this License, to the extent
|
||||
that they are valid under applicable law. If additional permissions
|
||||
apply only to part of the Program, that part may be used separately
|
||||
under those permissions, but the entire Program remains governed by
|
||||
this License without regard to the additional permissions.
|
||||
|
||||
When you convey a copy of a covered work, you may at your option
|
||||
remove any additional permissions from that copy, or from any part of
|
||||
it. (Additional permissions may be written to require their own
|
||||
removal in certain cases when you modify the work.) You may place
|
||||
additional permissions on material, added by you to a covered work,
|
||||
for which you have or can give appropriate copyright permission.
|
||||
|
||||
Notwithstanding any other provision of this License, for material you
|
||||
add to a covered work, you may (if authorized by the copyright holders of
|
||||
that material) supplement the terms of this License with terms:
|
||||
|
||||
a) Disclaiming warranty or limiting liability differently from the
|
||||
terms of sections 15 and 16 of this License; or
|
||||
|
||||
b) Requiring preservation of specified reasonable legal notices or
|
||||
author attributions in that material or in the Appropriate Legal
|
||||
Notices displayed by works containing it; or
|
||||
|
||||
c) Prohibiting misrepresentation of the origin of that material, or
|
||||
requiring that modified versions of such material be marked in
|
||||
reasonable ways as different from the original version; or
|
||||
|
||||
d) Limiting the use for publicity purposes of names of licensors or
|
||||
authors of the material; or
|
||||
|
||||
e) Declining to grant rights under trademark law for use of some
|
||||
trade names, trademarks, or service marks; or
|
||||
|
||||
f) Requiring indemnification of licensors and authors of that
|
||||
material by anyone who conveys the material (or modified versions of
|
||||
it) with contractual assumptions of liability to the recipient, for
|
||||
any liability that these contractual assumptions directly impose on
|
||||
those licensors and authors.
|
||||
|
||||
All other non-permissive additional terms are considered "further
|
||||
restrictions" within the meaning of section 10. If the Program as you
|
||||
received it, or any part of it, contains a notice stating that it is
|
||||
governed by this License along with a term that is a further
|
||||
restriction, you may remove that term. If a license document contains
|
||||
a further restriction but permits relicensing or conveying under this
|
||||
License, you may add to a covered work material governed by the terms
|
||||
of that license document, provided that the further restriction does
|
||||
not survive such relicensing or conveying.
|
||||
|
||||
If you add terms to a covered work in accord with this section, you
|
||||
must place, in the relevant source files, a statement of the
|
||||
additional terms that apply to those files, or a notice indicating
|
||||
where to find the applicable terms.
|
||||
|
||||
Additional terms, permissive or non-permissive, may be stated in the
|
||||
form of a separately written license, or stated as exceptions;
|
||||
the above requirements apply either way.
|
||||
|
||||
8. Termination.
|
||||
|
||||
You may not propagate or modify a covered work except as expressly
|
||||
provided under this License. Any attempt otherwise to propagate or
|
||||
modify it is void, and will automatically terminate your rights under
|
||||
this License (including any patent licenses granted under the third
|
||||
paragraph of section 11).
|
||||
|
||||
However, if you cease all violation of this License, then your
|
||||
license from a particular copyright holder is reinstated (a)
|
||||
provisionally, unless and until the copyright holder explicitly and
|
||||
finally terminates your license, and (b) permanently, if the copyright
|
||||
holder fails to notify you of the violation by some reasonable means
|
||||
prior to 60 days after the cessation.
|
||||
|
||||
Moreover, your license from a particular copyright holder is
|
||||
reinstated permanently if the copyright holder notifies you of the
|
||||
violation by some reasonable means, this is the first time you have
|
||||
received notice of violation of this License (for any work) from that
|
||||
copyright holder, and you cure the violation prior to 30 days after
|
||||
your receipt of the notice.
|
||||
|
||||
Termination of your rights under this section does not terminate the
|
||||
licenses of parties who have received copies or rights from you under
|
||||
this License. If your rights have been terminated and not permanently
|
||||
reinstated, you do not qualify to receive new licenses for the same
|
||||
material under section 10.
|
||||
|
||||
9. Acceptance Not Required for Having Copies.
|
||||
|
||||
You are not required to accept this License in order to receive or
|
||||
run a copy of the Program. Ancillary propagation of a covered work
|
||||
occurring solely as a consequence of using peer-to-peer transmission
|
||||
to receive a copy likewise does not require acceptance. However,
|
||||
nothing other than this License grants you permission to propagate or
|
||||
modify any covered work. These actions infringe copyright if you do
|
||||
not accept this License. Therefore, by modifying or propagating a
|
||||
covered work, you indicate your acceptance of this License to do so.
|
||||
|
||||
10. Automatic Licensing of Downstream Recipients.
|
||||
|
||||
Each time you convey a covered work, the recipient automatically
|
||||
receives a license from the original licensors, to run, modify and
|
||||
propagate that work, subject to this License. You are not responsible
|
||||
for enforcing compliance by third parties with this License.
|
||||
|
||||
An "entity transaction" is a transaction transferring control of an
|
||||
organization, or substantially all assets of one, or subdividing an
|
||||
organization, or merging organizations. If propagation of a covered
|
||||
work results from an entity transaction, each party to that
|
||||
transaction who receives a copy of the work also receives whatever
|
||||
licenses to the work the party's predecessor in interest had or could
|
||||
give under the previous paragraph, plus a right to possession of the
|
||||
Corresponding Source of the work from the predecessor in interest, if
|
||||
the predecessor has it or can get it with reasonable efforts.
|
||||
|
||||
You may not impose any further restrictions on the exercise of the
|
||||
rights granted or affirmed under this License. For example, you may
|
||||
not impose a license fee, royalty, or other charge for exercise of
|
||||
rights granted under this License, and you may not initiate litigation
|
||||
(including a cross-claim or counterclaim in a lawsuit) alleging that
|
||||
any patent claim is infringed by making, using, selling, offering for
|
||||
sale, or importing the Program or any portion of it.
|
||||
|
||||
11. Patents.
|
||||
|
||||
A "contributor" is a copyright holder who authorizes use under this
|
||||
License of the Program or a work on which the Program is based. The
|
||||
work thus licensed is called the contributor's "contributor version".
|
||||
|
||||
A contributor's "essential patent claims" are all patent claims
|
||||
owned or controlled by the contributor, whether already acquired or
|
||||
hereafter acquired, that would be infringed by some manner, permitted
|
||||
by this License, of making, using, or selling its contributor version,
|
||||
but do not include claims that would be infringed only as a
|
||||
consequence of further modification of the contributor version. For
|
||||
purposes of this definition, "control" includes the right to grant
|
||||
patent sublicenses in a manner consistent with the requirements of
|
||||
this License.
|
||||
|
||||
Each contributor grants you a non-exclusive, worldwide, royalty-free
|
||||
patent license under the contributor's essential patent claims, to
|
||||
make, use, sell, offer for sale, import and otherwise run, modify and
|
||||
propagate the contents of its contributor version.
|
||||
|
||||
In the following three paragraphs, a "patent license" is any express
|
||||
agreement or commitment, however denominated, not to enforce a patent
|
||||
(such as an express permission to practice a patent or covenant not to
|
||||
sue for patent infringement). To "grant" such a patent license to a
|
||||
party means to make such an agreement or commitment not to enforce a
|
||||
patent against the party.
|
||||
|
||||
If you convey a covered work, knowingly relying on a patent license,
|
||||
and the Corresponding Source of the work is not available for anyone
|
||||
to copy, free of charge and under the terms of this License, through a
|
||||
publicly available network server or other readily accessible means,
|
||||
then you must either (1) cause the Corresponding Source to be so
|
||||
available, or (2) arrange to deprive yourself of the benefit of the
|
||||
patent license for this particular work, or (3) arrange, in a manner
|
||||
consistent with the requirements of this License, to extend the patent
|
||||
license to downstream recipients. "Knowingly relying" means you have
|
||||
actual knowledge that, but for the patent license, your conveying the
|
||||
covered work in a country, or your recipient's use of the covered work
|
||||
in a country, would infringe one or more identifiable patents in that
|
||||
country that you have reason to believe are valid.
|
||||
|
||||
If, pursuant to or in connection with a single transaction or
|
||||
arrangement, you convey, or propagate by procuring conveyance of, a
|
||||
covered work, and grant a patent license to some of the parties
|
||||
receiving the covered work authorizing them to use, propagate, modify
|
||||
or convey a specific copy of the covered work, then the patent license
|
||||
you grant is automatically extended to all recipients of the covered
|
||||
work and works based on it.
|
||||
|
||||
A patent license is "discriminatory" if it does not include within
|
||||
the scope of its coverage, prohibits the exercise of, or is
|
||||
conditioned on the non-exercise of one or more of the rights that are
|
||||
specifically granted under this License. You may not convey a covered
|
||||
work if you are a party to an arrangement with a third party that is
|
||||
in the business of distributing software, under which you make payment
|
||||
to the third party based on the extent of your activity of conveying
|
||||
the work, and under which the third party grants, to any of the
|
||||
parties who would receive the covered work from you, a discriminatory
|
||||
patent license (a) in connection with copies of the covered work
|
||||
conveyed by you (or copies made from those copies), or (b) primarily
|
||||
for and in connection with specific products or compilations that
|
||||
contain the covered work, unless you entered into that arrangement,
|
||||
or that patent license was granted, prior to 28 March 2007.
|
||||
|
||||
Nothing in this License shall be construed as excluding or limiting
|
||||
any implied license or other defenses to infringement that may
|
||||
otherwise be available to you under applicable patent law.
|
||||
|
||||
12. No Surrender of Others' Freedom.
|
||||
|
||||
If conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot convey a
|
||||
covered work so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you may
|
||||
not convey it at all. For example, if you agree to terms that obligate you
|
||||
to collect a royalty for further conveying from those to whom you convey
|
||||
the Program, the only way you could satisfy both those terms and this
|
||||
License would be to refrain entirely from conveying the Program.
|
||||
|
||||
13. Use with the GNU Affero General Public License.
|
||||
|
||||
Notwithstanding any other provision of this License, you have
|
||||
permission to link or combine any covered work with a work licensed
|
||||
under version 3 of the GNU Affero General Public License into a single
|
||||
combined work, and to convey the resulting work. The terms of this
|
||||
License will continue to apply to the part which is the covered work,
|
||||
but the special requirements of the GNU Affero General Public License,
|
||||
section 13, concerning interaction through a network will apply to the
|
||||
combination as such.
|
||||
|
||||
14. Revised Versions of this License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions of
|
||||
the GNU General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Program specifies that a certain numbered version of the GNU General
|
||||
Public License "or any later version" applies to it, you have the
|
||||
option of following the terms and conditions either of that numbered
|
||||
version or of any later version published by the Free Software
|
||||
Foundation. If the Program does not specify a version number of the
|
||||
GNU General Public License, you may choose any version ever published
|
||||
by the Free Software Foundation.
|
||||
|
||||
If the Program specifies that a proxy can decide which future
|
||||
versions of the GNU General Public License can be used, that proxy's
|
||||
public statement of acceptance of a version permanently authorizes you
|
||||
to choose that version for the Program.
|
||||
|
||||
Later license versions may give you additional or different
|
||||
permissions. However, no additional obligations are imposed on any
|
||||
author or copyright holder as a result of your choosing to follow a
|
||||
later version.
|
||||
|
||||
15. Disclaimer of Warranty.
|
||||
|
||||
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
|
||||
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
|
||||
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
|
||||
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
|
||||
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
|
||||
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
|
||||
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
|
||||
|
||||
16. Limitation of Liability.
|
||||
|
||||
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
|
||||
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
|
||||
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
|
||||
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
|
||||
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
|
||||
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
|
||||
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
|
||||
SUCH DAMAGES.
|
||||
|
||||
17. Interpretation of Sections 15 and 16.
|
||||
|
||||
If the disclaimer of warranty and limitation of liability provided
|
||||
above cannot be given local legal effect according to their terms,
|
||||
reviewing courts shall apply local law that most closely approximates
|
||||
an absolute waiver of all civil liability in connection with the
|
||||
Program, unless a warranty or assumption of liability accompanies a
|
||||
copy of the Program in return for a fee.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
state the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program does terminal interaction, make it output a short
|
||||
notice like this when it starts in an interactive mode:
|
||||
|
||||
<program> Copyright (C) <year> <name of author>
|
||||
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, your program's commands
|
||||
might be different; for a GUI interface, you would use an "about box".
|
||||
|
||||
You should also get your employer (if you work as a programmer) or school,
|
||||
if any, to sign a "copyright disclaimer" for the program, if necessary.
|
||||
For more information on this, and how to apply and follow the GNU GPL, see
|
||||
<http://www.gnu.org/licenses/>.
|
||||
|
||||
The GNU General Public License does not permit incorporating your program
|
||||
into proprietary programs. If your program is a subroutine library, you
|
||||
may consider it more useful to permit linking proprietary applications with
|
||||
the library. If this is what you want to do, use the GNU Lesser General
|
||||
Public License instead of this License. But first, please read
|
||||
<http://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
@@ -1,275 +0,0 @@
|
||||
1.8.0.0
|
||||
-------
|
||||
|
||||
- Fixed testing facilities `recordGame`, `testGame`, `narrateGame` and
|
||||
similar functions. `testGame` in particular is able to precisely
|
||||
emulate recorded environment (so if your game has a bug only at a
|
||||
specific size, `testGame` will now catch it).
|
||||
Check `cabal run -f alone-playback examples ` to see a replay in action
|
||||
and `test/Terminal/Game/Layer/ImperativeSpec.hs` for pure test ideas.
|
||||
- Added information on how to have an hot-reload mode, albeit only for
|
||||
non-interactive game replays. Check `example/MainHotReload.hs` if
|
||||
interested.
|
||||
- Added a new exception, `DisplayTooSmall`, which expands gracefully to
|
||||
a “please resize your terminal” message to the player if uncaught.
|
||||
Nothing changes if you do not already use `asserTermDims`.
|
||||
- `assertTermDims` is now curries (`Width -> Height -> IO ()` instead
|
||||
of `Dimensions -> IO ()`) to better fit the rest of the API.
|
||||
- Modified behaviour of functions `vcat`, `hcat`, `stringPlane`,
|
||||
`stringPlaneTrans`. They will not error on empty list, rather return
|
||||
a transparent, 1×1 plane.
|
||||
- Changed licence and changes files to COPYING and NEWS.
|
||||
|
||||
1.7.0.0
|
||||
-------
|
||||
|
||||
- After some feedback from library users, I decided to eliminate
|
||||
`simpleGame` from the API.
|
||||
To reiterate hte migration guide, if your type was:
|
||||
|
||||
Game 80 24 13 initState logicFun drawFun quitFun
|
||||
-- or
|
||||
-- simpleGame (80, 24) 13 initState logicFun drawFun quitFun
|
||||
|
||||
You just need to modify it like this:
|
||||
|
||||
Game 13 initState
|
||||
(const logicFun)
|
||||
(\e s -> centerFull e $ drawFun s)
|
||||
quitFun
|
||||
-- notice how we lost `80 24`. You can still have a screen size
|
||||
-- check with `assertTermDims`, as described below.
|
||||
- Added `blankPlaneFull` and `centerFull` convenience functions (to work
|
||||
with GEnv terminal dimensions).
|
||||
- Added assertTermDims, a quick way to check your user terminal is big
|
||||
enough at the start of the game.
|
||||
- minimal blitting optimisation (you should be able to see a 1–2
|
||||
FPS improvement).
|
||||
- improved documentation on various functions.
|
||||
|
||||
1.6.0.2
|
||||
-------
|
||||
|
||||
- lun 15 nov 2021, 02:21:08
|
||||
- more doc tweaking
|
||||
|
||||
1.6.0.1
|
||||
-------
|
||||
|
||||
- released lun 15 nov 2021, 00:35:41
|
||||
- minor documentation / spelling fixes
|
||||
|
||||
1.6.0.0
|
||||
-------
|
||||
|
||||
Summary and tl;dr migration guide:
|
||||
- This version introduces a breaking changes in the main way to make
|
||||
a `Game`. I will detail the changes below, but first a three-lines
|
||||
migration guide:
|
||||
the only thing you should have to do is to replace your `Game`
|
||||
data constructor with `simpleGame` smart constructor, and substitute
|
||||
the first to `c` `r` arguments (col/row) with a `(c, r)` tuple.
|
||||
And of course, if you are interested in displaying FPS and adapt to
|
||||
screen size modifications at game-time (“liquid” layout), read along!
|
||||
|
||||
Changes:
|
||||
- This version introduces GEnv, a structure that exposes current frame
|
||||
rate (in FPS) and current terminal size (in Width, Height).
|
||||
- `GEnv` is added as a parameter to logic and draw functions, which
|
||||
now have these signatures:
|
||||
gLogicFunction :: GEnv -> s -> Event -> slightly
|
||||
gDrawFunction :: GEnv -> s -> plane
|
||||
- If you do not want to dabble with GEnv, you can still use `simpleGame`
|
||||
smart constructor, which mimicks the old `Game`. `simpleGame` has some
|
||||
nice defaults:
|
||||
- if the terminal is too small it will ask the player to resize it
|
||||
(even in the middle of the game), blocking any input;
|
||||
- if the terminal is bigger, it will paste `Plane` in the middle
|
||||
of the screen.
|
||||
- For this reason, `DisplayTooSmall` exception exists no more.
|
||||
- the new `Game` does not have those defaults, but allows you to get
|
||||
creative with screen resizes, e.g. accomodating as much gameworld
|
||||
as possible etc. Check `cabal run -f examples balls` and resize the
|
||||
screen to see it in action.
|
||||
- Minor change: I have introduced a `Dimensions` alias for
|
||||
`(Width, Height)`.
|
||||
|
||||
Future work:
|
||||
- these changes lay the path for an even more general `Game` type,
|
||||
adding effects like reading form a game configuration, writing to it
|
||||
etc.
|
||||
I would like to have these wrapped in a pure interface (maybe à la
|
||||
Response/Request? Maybe callbacks?) and for sure want them to be
|
||||
composable with current test scaffolding (testGame,
|
||||
narrateGame, etc.). It will not be easy to design; if are reading
|
||||
this and have any suggestion, please write to me.
|
||||
|
||||
Released dom 14 nov 2021, 20:25:19
|
||||
|
||||
1.5.0.0
|
||||
-------
|
||||
|
||||
- `timers-tick` has released a new version: all timers function (creaTimer,
|
||||
creaBoolTimer, creaTimerLoop, creaBoolTimerLoop, creaAnimation,
|
||||
creaLoopAnimation, ticks) are slightly more robust now (will `error`
|
||||
on nonsenical arguments, e.g. frame duration <1).
|
||||
This should not impact any of your current projects, it just makes
|
||||
catching bugs easier.
|
||||
- Removed `getFrames` from Animation interface.
|
||||
- Updated `Random` interface to fit the new `random`. This is a breaking
|
||||
change but it should be easy to fix by updating your `Random` constraints
|
||||
to `UniformRange`.
|
||||
Be mindful that `recordGame` could play slightly differently, as the
|
||||
update function for the StdGen in `random` has changed.
|
||||
- Removed `getRandomList` from Random interface.
|
||||
- Added `pickRandom` to Random interface.
|
||||
- Removed unuseful `creaStaticAnimation` from Animation interface.
|
||||
- Released mar 9 nov 2021, 15:56:14.
|
||||
|
||||
1.4.0.0
|
||||
-------
|
||||
|
||||
- Fixed an annoying bug that made a game run slower than expected on
|
||||
low TPS. Now if you select 5 ticks per second, you can rest assured
|
||||
that after 50 ticks, 5 seconds have elapsed.
|
||||
- Renamed `FPS` to `TPS` (ticks per second); highlight logic speed is
|
||||
constant timewise on all machines, while FPS might be different on
|
||||
differently efficient terminals.
|
||||
This will allow in future releases to provide a function to easily
|
||||
calculate actual FPS of the game.
|
||||
- Added alternative origin combinators `%^>`, `%.<`, `%.>`; they are
|
||||
useful when you want to — e.g. — «paste a plane one row from
|
||||
bottom-right corner».
|
||||
|
||||
1.3.0.0
|
||||
-------
|
||||
|
||||
- `displaySize` and `playGame`/`playGameS` now throw an exception
|
||||
(of type `ATGException`) instead of `error`ing. These exeptions are
|
||||
`CannotGetDisplaySize` and `DisplayTooSmall`; they are synchronous,
|
||||
for easier catching. (requested by sm)
|
||||
- Released sab 16 ott 2021, 21:09:22
|
||||
|
||||
1.2.1.0
|
||||
-------
|
||||
|
||||
- Fixed textBox, textBoxHyphen bug (boxes were not transparent, contrary
|
||||
to what stated in docs) (reported by sm).
|
||||
- Released lun 11 ott 2021, 22:29:40
|
||||
|
||||
1.2.0.0
|
||||
-------
|
||||
|
||||
- Added textBoxHyphen and textBoxHyphenLiquid and a handful of `Hypenator`s.
|
||||
This will allow you to have autohyphenation in textboxes. Compare:
|
||||
(normal textbox) (hyphenated textbox)
|
||||
Rimasi un po’ a meditare nel buio Rimasi un po’ a meditare nel buio
|
||||
velato appena dal barlume azzurrino velato appena dal barlume azzurrino
|
||||
del fornello a gas, su cui del fornello a gas, su cui sobbol-
|
||||
sobbollliva quieta la pentola. liva quieta la pentola.
|
||||
- Switched `Width`, `Height`, `Row`, `Col` from `Integer` to `Int`.
|
||||
This is unfortunate, but will make playing with `base` simpler. I will
|
||||
switch it back once `Prelude` handles both integers appropriately
|
||||
or exports the relevant function. (request by sm)
|
||||
- Changed signature for `box`, `textBox` and `textBoxLiquid`. Now
|
||||
width/height parameters come *before* the character/string. E.g.:
|
||||
textBoxLiquid :: String -> Width -> Plane -- this was before
|
||||
textBoxLiquid :: Width -> String -> Plane -- this is now
|
||||
This felt more ergonomic while writing games.
|
||||
- `paperPlane` is now `planePaper` (to respect SVO order)
|
||||
|
||||
1.1.1.0
|
||||
-------
|
||||
|
||||
- Added (***) (centre blit) (request by sm)
|
||||
- Released gio 30 set 2021, 12:29:22
|
||||
|
||||
1.1.0.0
|
||||
-------
|
||||
|
||||
- Added Plane justapoxition functions (===, |||, vcat, hcat).
|
||||
- Added `word` and and `textBoxLiquid` drawing functions.
|
||||
- Added `subPlane`, `displaySize` Plane functions.
|
||||
- Removed unused `trimPlane`.
|
||||
- Sanitized non-ASCII chars on Win32 console.
|
||||
- Wed 03 Feb 2021 18:41:20 CET
|
||||
|
||||
1.0.0.0
|
||||
-------
|
||||
|
||||
- Milestone release.
|
||||
- Beefed up documentation.
|
||||
- Released Sun 08 Dec 2019 04:19:33 CET
|
||||
|
||||
0.7.2.0
|
||||
-------
|
||||
|
||||
- Fixed 0.7.1.0 unbumped dependency.
|
||||
- Released Fri 22 Nov 2019 16:51:25 CET
|
||||
|
||||
0.7.1.0
|
||||
-------
|
||||
|
||||
- Fixed 0.7.0.0 (deprecated) interface.
|
||||
- Released Fri 22 Nov 2019 14:51:40 CET
|
||||
|
||||
0.7.0.0
|
||||
-------
|
||||
|
||||
- Simplified Animation interface (breaking changes).
|
||||
- Added `creaLoopAnimation` and `creaStaticAnimation`.
|
||||
- Released Fri 22 Nov 2019 14:40:44 CET
|
||||
|
||||
0.6.1.0
|
||||
-------
|
||||
|
||||
- Reworked Timers/Animations interface and documentation.
|
||||
- Added `lapse` (for Timers/Animations).
|
||||
- Released Fri 22 Nov 2019 01:03:37 CET
|
||||
|
||||
0.6.0.1
|
||||
-------
|
||||
|
||||
- Add public repo (requested by sm).
|
||||
- Released Tue 19 Nov 2019 22:38:34 CET
|
||||
|
||||
0.6.0.0
|
||||
-------
|
||||
|
||||
- Add random generation functions.
|
||||
- Released Sun 10 Nov 2019 13:44:32 CET
|
||||
|
||||
0.5.0.0
|
||||
-------
|
||||
|
||||
- Add `setupGame` to setup games before playtesting (skip menus, etc.).
|
||||
- Fixed screen corruption on Windows.
|
||||
- Released Fri 08 Nov 2019 13:52:39 CET
|
||||
|
||||
0.4.0.0
|
||||
-------
|
||||
|
||||
- Exposed new functions in API.
|
||||
- Greatly improved haddock documentation.
|
||||
- Released Tue 25 Jun 2019 16:08:53 CEST
|
||||
|
||||
0.2.1.0
|
||||
-------
|
||||
|
||||
- Improved haddock documentation a bit.
|
||||
- Cleanup runs regardless of exception.
|
||||
- Released on Sun 18 Mar 2018 03:04:07 CET.
|
||||
|
||||
0.2.0.0
|
||||
-------
|
||||
|
||||
- Added dependencies constraints.
|
||||
- Removed internal module.
|
||||
- Fixed changelog.
|
||||
- Released on Fri 16 Mar 2018 00:42:41 CET.
|
||||
|
||||
0.1.0.0
|
||||
-------
|
||||
|
||||
- Initial release.
|
||||
- Released on Fri 16 Mar 2018 00:33:18 CET.
|
||||
@@ -1,46 +0,0 @@
|
||||
==================
|
||||
ansi-terminal-game
|
||||
==================
|
||||
|
||||
`ansi-terminal-game` is a library for creating games in a terminal setting.
|
||||
|
||||
Goals
|
||||
-----
|
||||
|
||||
- be cross platform (linux/win/mac). If you plan to have your executable
|
||||
unix only, I invite you to check brick [1] or other, more expressive
|
||||
libraries.
|
||||
- be simple: no curses/ncurses/pdcurses/etc. dependencies, all
|
||||
functionality built on a standard input / ANSI terminal base.
|
||||
|
||||
[1] http://hackage.haskell.org/package/brick
|
||||
|
||||
Learn
|
||||
-----
|
||||
|
||||
- run the basic example with `cabal new-run -f examples alone`;
|
||||
- check the source in `examples/Alone.hs`;
|
||||
- open the 'Terminal.Game' haddock documentation (start reading from
|
||||
`Data.Game`).
|
||||
|
||||
A full game can be found at:
|
||||
|
||||
http://www.ariis.it/static/articles/venzone/page.html
|
||||
|
||||
Other games made with a-t-g
|
||||
---------------------------
|
||||
|
||||
- caverunner:
|
||||
https://github.com/simonmichael/games/blob/main/caverunner/caverunner.hs
|
||||
- pigafetta: http://www.ariis.it/link/repos/pigafetta/
|
||||
- avoidance: https://sabadev.xyz/avoidance_game
|
||||
|
||||
If you want yours to be added to this list, write to me.
|
||||
|
||||
Contact
|
||||
-------
|
||||
|
||||
For any feedback or report, contact me at:
|
||||
|
||||
http://ariis.it/static/articles/mail/page.html
|
||||
|
||||
@@ -1,2 +0,0 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
@@ -1,188 +0,0 @@
|
||||
name: ansi-terminal-game
|
||||
version: 1.8.0.0
|
||||
synopsis: sdl-like functions for terminal applications, based on
|
||||
ansi-terminal
|
||||
description: Library which aims to replicate standard 2d game
|
||||
functions (blit, ticks, timers, etc.) in a terminal
|
||||
setting; features double buffering to optimise
|
||||
performance.
|
||||
Aims to be cross compatible (based on "ansi-terminal",
|
||||
no unix-only dependencies), practical.
|
||||
See @examples@ folder for some minimal programs. A
|
||||
full game: <http://www.ariis.it/static/articles/venzone/page.html venzone>.
|
||||
homepage: http://www.ariis.it/static/articles/ansi-terminal-game/page.html
|
||||
license: GPL-3
|
||||
license-file: COPYING
|
||||
author: Francesco Ariis
|
||||
maintainer: fa-ml@ariis.it
|
||||
copyright: © 2017-2021 Francesco Ariis
|
||||
category: Game
|
||||
build-type: Simple
|
||||
extra-source-files: README,
|
||||
NEWS,
|
||||
test/records/alone-record-test.gr
|
||||
test/records/balls-dims.gr
|
||||
test/records/balls-slow.gr
|
||||
cabal-version: >=1.10
|
||||
|
||||
flag examples
|
||||
description: builds examples
|
||||
default: False
|
||||
|
||||
source-repository head
|
||||
type: darcs
|
||||
location: http://www.ariis.it/link/repos/ansi-terminal-game/
|
||||
|
||||
library
|
||||
exposed-modules: Terminal.Game
|
||||
other-modules: Terminal.Game.Animation,
|
||||
Terminal.Game.Character,
|
||||
Terminal.Game.Draw,
|
||||
Terminal.Game.Layer.Imperative,
|
||||
Terminal.Game.Layer.Object,
|
||||
Terminal.Game.Layer.Object.GameIO,
|
||||
Terminal.Game.Layer.Object.Interface,
|
||||
Terminal.Game.Layer.Object.IO,
|
||||
Terminal.Game.Layer.Object.Narrate,
|
||||
Terminal.Game.Layer.Object.Primitive,
|
||||
Terminal.Game.Layer.Object.Record,
|
||||
Terminal.Game.Layer.Object.Test,
|
||||
Terminal.Game.Utils,
|
||||
Terminal.Game.Plane,
|
||||
Terminal.Game.Random,
|
||||
Terminal.Game.Timer
|
||||
build-depends: base == 4.*,
|
||||
ansi-terminal == 0.11.*,
|
||||
array == 0.5.*,
|
||||
bytestring >= 0.10 && < 0.12,
|
||||
cereal == 0.5.*,
|
||||
clock >= 0.7 && < 0.9,
|
||||
containers == 0.6.*,
|
||||
exceptions == 0.10.*,
|
||||
linebreak == 1.1.*,
|
||||
mintty == 0.1.*,
|
||||
mtl == 2.2.*,
|
||||
QuickCheck >= 2.13 && < 2.15,
|
||||
random >= 1.2 && < 1.3,
|
||||
split == 0.2.*,
|
||||
terminal-size == 0.3.*,
|
||||
unidecode >= 0.1.0 && < 0.2,
|
||||
timers-tick > 0.5 && < 0.6
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
||||
if os(windows)
|
||||
hs-source-dirs: platform-dep/windows
|
||||
if !os(windows)
|
||||
hs-source-dirs: platform-dep/non-win
|
||||
|
||||
test-suite test
|
||||
default-language: Haskell2010
|
||||
hs-Source-Dirs: test, src, example
|
||||
main-is: Test.hs
|
||||
other-modules: Alone,
|
||||
Balls,
|
||||
Terminal.Game,
|
||||
Terminal.Game.Animation,
|
||||
Terminal.Game.Character,
|
||||
Terminal.Game.Draw,
|
||||
Terminal.Game.DrawSpec,
|
||||
Terminal.Game.Layer.Imperative,
|
||||
Terminal.Game.Layer.ImperativeSpec,
|
||||
Terminal.Game.Layer.Object,
|
||||
Terminal.Game.Layer.Object.GameIO,
|
||||
Terminal.Game.Layer.Object.Interface,
|
||||
Terminal.Game.Layer.Object.IO,
|
||||
Terminal.Game.Layer.Object.Narrate,
|
||||
Terminal.Game.Layer.Object.Primitive,
|
||||
Terminal.Game.Layer.Object.Record,
|
||||
Terminal.Game.Layer.Object.Test,
|
||||
Terminal.Game.Utils,
|
||||
Terminal.Game.Plane,
|
||||
Terminal.Game.PlaneSpec
|
||||
Terminal.Game.Random,
|
||||
Terminal.Game.RandomSpec
|
||||
build-depends: base == 4.*,
|
||||
ansi-terminal == 0.11.*,
|
||||
array == 0.5.*,
|
||||
bytestring >= 0.10 && < 0.12,
|
||||
cereal == 0.5.*,
|
||||
clock >= 0.7 && < 0.9,
|
||||
containers == 0.6.*,
|
||||
exceptions == 0.10.*,
|
||||
linebreak == 1.1.*,
|
||||
mintty == 0.1.*,
|
||||
mtl == 2.2.*,
|
||||
QuickCheck >= 2.13 && < 2.15,
|
||||
random >= 1.2 && < 1.3,
|
||||
split == 0.2.*,
|
||||
terminal-size == 0.3.*,
|
||||
unidecode >= 0.1.0 && < 0.2,
|
||||
timers-tick > 0.5 && < 0.6
|
||||
-- the above plus hspec
|
||||
, hspec
|
||||
type: exitcode-stdio-1.0
|
||||
ghc-options: -Wall
|
||||
|
||||
if os(windows)
|
||||
hs-source-dirs: platform-dep/windows
|
||||
if !os(windows)
|
||||
hs-source-dirs: platform-dep/non-win
|
||||
|
||||
executable alone
|
||||
if flag(examples)
|
||||
build-depends: base == 4.*,
|
||||
ansi-terminal-game
|
||||
else
|
||||
buildable: False
|
||||
|
||||
hs-source-dirs: example
|
||||
main-is: MainAlone.hs
|
||||
other-modules: Alone
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
-Wall
|
||||
|
||||
executable alone-playback
|
||||
if flag(examples)
|
||||
build-depends: base == 4.*,
|
||||
ansi-terminal-game,
|
||||
temporary == 1.3.*
|
||||
else
|
||||
buildable: False
|
||||
|
||||
hs-source-dirs: example
|
||||
main-is: MainPlayback.hs
|
||||
other-modules: Alone
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
-Wall
|
||||
|
||||
executable balls
|
||||
if flag(examples)
|
||||
build-depends: base == 4.*,
|
||||
ansi-terminal-game
|
||||
else
|
||||
buildable: False
|
||||
|
||||
hs-source-dirs: example
|
||||
main-is: MainBalls.hs
|
||||
other-modules: Balls
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
-Wall
|
||||
|
||||
executable hot-reload
|
||||
if flag(examples)
|
||||
build-depends: base == 4.*,
|
||||
ansi-terminal-game
|
||||
else
|
||||
buildable: False
|
||||
|
||||
hs-source-dirs: example
|
||||
main-is: MainHotReload.hs
|
||||
other-modules: Alone
|
||||
default-language: Haskell2010
|
||||
ghc-options: -threaded
|
||||
-Wall
|
||||
@@ -1,90 +0,0 @@
|
||||
module Alone where
|
||||
|
||||
-- Alone in a room, game definition (logic & draw)
|
||||
-- run with: cabal new-run -f examples alone
|
||||
|
||||
import Terminal.Game
|
||||
|
||||
import qualified Data.Tuple as T
|
||||
|
||||
-- game specification
|
||||
aloneInARoom :: Game MyState
|
||||
aloneInARoom = Game 13 -- ticks per second
|
||||
(MyState (10, 10)
|
||||
Stop False) -- init state
|
||||
(\_ s e -> logicFun s e) -- logic function
|
||||
(\r s -> centerFull r $
|
||||
drawFun s) -- draw function
|
||||
gsQuit -- quit function
|
||||
|
||||
sizeCheck :: IO ()
|
||||
sizeCheck = let (w, h) = T.swap . snd $ boundaries
|
||||
in assertTermDims w h
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Types
|
||||
|
||||
data MyState = MyState { gsCoord :: Coords,
|
||||
gsMove :: Move,
|
||||
gsQuit :: Bool }
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Move = N | S | E | W | Stop
|
||||
deriving (Show, Eq)
|
||||
|
||||
boundaries :: (Coords, Coords)
|
||||
boundaries = ((1, 1), (24, 80))
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Logic
|
||||
|
||||
logicFun :: MyState -> Event -> MyState
|
||||
logicFun gs (KeyPress 'q') = gs { gsQuit = True }
|
||||
logicFun gs Tick = gs { gsCoord = pos (gsMove gs) (gsCoord gs) }
|
||||
logicFun gs (KeyPress c) = gs { gsMove = move (gsMove gs) c }
|
||||
|
||||
-- SCI movement
|
||||
move :: Move -> Char -> Move
|
||||
move N 'w' = Stop
|
||||
move S 's' = Stop
|
||||
move W 'a' = Stop
|
||||
move E 'd' = Stop
|
||||
move _ 'w' = N
|
||||
move _ 's' = S
|
||||
move _ 'a' = W
|
||||
move _ 'd' = E
|
||||
move m _ = m
|
||||
|
||||
pos :: Move -> (Width, Height) -> (Width, Height)
|
||||
pos m oldcs | oob newcs = oldcs
|
||||
| otherwise = newcs
|
||||
where
|
||||
newcs = new m oldcs
|
||||
|
||||
new Stop cs = cs
|
||||
new N (r, c) = (r-1, c )
|
||||
new S (r, c) = (r+1, c )
|
||||
new E (r, c) = (r , c+1)
|
||||
new W (r, c) = (r , c-1)
|
||||
|
||||
((lr, lc), (hr, hc)) = boundaries
|
||||
oob (r, c) = r <= lr || c <= lc ||
|
||||
r >= hr || c >= hc
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Draw
|
||||
|
||||
drawFun :: MyState -> Plane
|
||||
drawFun (MyState (r, c) _ _) =
|
||||
blankPlane mw mh &
|
||||
(1, 1) % box mw mh '-' &
|
||||
(2, 2) % box (mw-2) (mh-2) ' ' &
|
||||
(15, 20) % textBox 10 4
|
||||
"Tap WASD to move, tap again to stop." &
|
||||
(20, 60) % textBox 8 10
|
||||
"Press Q to quit." # color Blue Vivid &
|
||||
(r, c) % cell '@' # invert
|
||||
where
|
||||
mh :: Height
|
||||
mw :: Width
|
||||
(mh, mw) = snd boundaries
|
||||
@@ -1,189 +0,0 @@
|
||||
module Balls where
|
||||
|
||||
-- library module for `balls`
|
||||
|
||||
import Terminal.Game
|
||||
|
||||
import qualified Data.Bool as B
|
||||
import qualified Data.Ix as I
|
||||
import qualified Data.Maybe as M
|
||||
import qualified Data.Tuple as T
|
||||
|
||||
{-
|
||||
There are three things I will showcase in this example:
|
||||
|
||||
1. ** How you can display current FPS. **
|
||||
This is done using `Game` to create your game rather than
|
||||
`simpleGame`. `Game` is a bit more complex but you gain
|
||||
additional infos to manipulate/blit, like FPS.
|
||||
|
||||
2. ** How your game can gracefully handle screen resize. **
|
||||
Notice how if you resize the terminal, balls will still
|
||||
fill the entire screen. This is again possible using `Game`
|
||||
and the information passed via GameEnv (in this case, terminal
|
||||
dimensions).
|
||||
|
||||
3. ** That — while FPS can change — game speed does not. **
|
||||
Check the timer: even when screen is crowded and frames are
|
||||
dropped, it is not slowed down.
|
||||
|
||||
|
||||
This game runs at 60 FPS, you will almost surely never need such
|
||||
a high TPS! 15–20 is more than enough in most cases.
|
||||
-}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Ball
|
||||
|
||||
data Ball = Ball { pChar :: Plane,
|
||||
pSpeed :: Timed Bool,
|
||||
pDir :: Coords,
|
||||
pPos :: Coords }
|
||||
|
||||
-- change direction is necessary, then and move
|
||||
modPar :: Dimensions -> Ball -> Maybe Ball
|
||||
modPar ds b@(Ball _ _ d _) =
|
||||
-- tick the ball and check it is time to move
|
||||
let b' = tickBall b in
|
||||
if not (fetchFrame . pSpeed $ b')
|
||||
then Just b' -- no time to move for you
|
||||
else
|
||||
|
||||
-- check all popssible directions
|
||||
let pd = [d, togR d, togC d, togB d]
|
||||
bs = map (\ld -> b' { pDir = ld }) pd
|
||||
bs' = filter (isIn ds) $ map modPos bs in
|
||||
|
||||
-- returns a moved ball nor nothing to mark it “to eliminate”
|
||||
case bs' of
|
||||
[] -> Nothing
|
||||
(cp:_) -> Just cp
|
||||
where
|
||||
togR (wr, wc) = (-wr, wc)
|
||||
togC (wr, wc) = ( wr, -wc)
|
||||
togB (wr, wc) = (-wr, -wc)
|
||||
|
||||
tickBall :: Ball -> Ball
|
||||
tickBall b = b { pSpeed = tick (pSpeed b) }
|
||||
|
||||
modPos :: Ball -> Ball
|
||||
modPos (Ball p t d@(dr, dc) (r, c)) = Ball p t d (r+dr, c+dc)
|
||||
|
||||
isIn :: Dimensions -> Ball -> Bool
|
||||
isIn (w, h) (Ball p _ _ (pr, pc)) =
|
||||
let (pw, ph) = planeSize p
|
||||
in pr >= 1 &&
|
||||
pr+ph-1 <= h &&
|
||||
pc >= 1 &&
|
||||
pc+pw-1 <= w
|
||||
|
||||
dpart :: Ball -> (Coords, Plane)
|
||||
dpart (Ball p _ _ cs) = (cs, p)
|
||||
|
||||
genBall :: StdGen -> Dimensions -> (Ball, StdGen)
|
||||
genBall g ds =
|
||||
let (c, g1) = pickRandom [minBound..] g
|
||||
(s, g2) = getRandom (1, 3) g1
|
||||
(v, g3) = pickRandom dirs g2
|
||||
(p, g4) = ranIx ((1,1), T.swap ds) g3
|
||||
b = Ball (cell 'o' # color c Vivid)
|
||||
(creaBoolTimerLoop s) v p
|
||||
in (b, g4)
|
||||
where
|
||||
dirs = [(1, 1), (1, -1), (-1, 1), (-1, -1)]
|
||||
|
||||
-- tuples instances are yet to be added to `random`
|
||||
-- as nov 21; this will do meanwhile.
|
||||
ranIx :: I.Ix a => (a, a) -> StdGen -> (a, StdGen)
|
||||
ranIx r wg = pickRandom (I.range r) wg
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Timer
|
||||
|
||||
type Timer = (Timed Bool, Integer)
|
||||
|
||||
ctimer :: TPS -> Timer
|
||||
ctimer tps = (creaBoolTimerLoop tps, 0)
|
||||
|
||||
ltimer :: Timer -> Timer
|
||||
ltimer (t, i) = let t' = tick t
|
||||
k = B.bool 0 1 (fetchFrame t')
|
||||
in (t', i+k)
|
||||
|
||||
dtimer :: Timer -> Plane
|
||||
dtimer (_, i) = word . show $ i
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Game
|
||||
|
||||
data GState = GState { gen :: StdGen,
|
||||
quit :: Bool,
|
||||
timer :: Timer,
|
||||
balls :: [Ball],
|
||||
bslow :: Bool }
|
||||
-- pSlow is not used in game, it is there just
|
||||
-- for the test suite
|
||||
|
||||
fireworks :: StdGen -> Game GState
|
||||
fireworks g = Game tps istate lfun dfun qfun
|
||||
where
|
||||
tps = 60
|
||||
|
||||
istate :: GState
|
||||
istate = GState g False (ctimer tps) [] False
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Logic
|
||||
|
||||
lfun :: GEnv -> GState -> Event -> GState
|
||||
lfun e s (KeyPress 's') =
|
||||
let g = gen s
|
||||
ds = eTermDims e
|
||||
(b, g1) = genBall g ds
|
||||
in s { gen = g1,
|
||||
balls = b : balls s }
|
||||
lfun _ s (KeyPress 'q') = s { quit = True }
|
||||
lfun _ s (KeyPress _) = s
|
||||
lfun r s Tick =
|
||||
let ds = eTermDims r
|
||||
|
||||
ps = balls s
|
||||
ps' = M.mapMaybe (modPar ds) ps
|
||||
|
||||
bs = eFPS r < 30
|
||||
in s { timer = ltimer (timer s),
|
||||
balls = filter (isIn ds) ps',
|
||||
bslow = bs }
|
||||
|
||||
qfun :: GState -> Bool
|
||||
qfun s = quit s
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Draw
|
||||
|
||||
dfun :: GEnv -> GState -> Plane
|
||||
dfun r s = mergePlanes
|
||||
(uncurry blankPlane ds)
|
||||
(map dpart $ balls s) &
|
||||
(1, 2) %^> tui # trans &
|
||||
(1, 2) %.< inst # trans # bold
|
||||
where
|
||||
ds = eTermDims r
|
||||
tm = timer s
|
||||
|
||||
tui :: Plane
|
||||
tui = let fps = eFPS r
|
||||
np = length $ balls s
|
||||
|
||||
l1 = word "FPS: " ||| word (show fps)
|
||||
l2 = word "Timer: " ||| dtimer tm
|
||||
l3 = word ("Balls: " ++ show np)
|
||||
l4 = word ("Term. dims.: " ++ show ds)
|
||||
in vcat [l1, l2, l3, l4]
|
||||
|
||||
inst :: Plane
|
||||
inst = word "Press (s) to spawn" ===
|
||||
word "Press (q) to quit"
|
||||
|
||||
trans :: Draw
|
||||
trans = makeTransparent ' '
|
||||
@@ -1,12 +0,0 @@
|
||||
module Main where
|
||||
|
||||
|
||||
import Alone ( aloneInARoom, sizeCheck )
|
||||
|
||||
import Terminal.Game
|
||||
|
||||
-- run with: cabal new-run -f examples alone
|
||||
|
||||
main :: IO ()
|
||||
main = do sizeCheck
|
||||
errorPress $ playGame aloneInARoom
|
||||
@@ -1,12 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import Balls
|
||||
|
||||
import Terminal.Game
|
||||
|
||||
-- Balls Main module. The meat of the game is in `examples/Balls.hs`
|
||||
|
||||
main :: IO ()
|
||||
main = getStdGen >>= \g ->
|
||||
playGame (fireworks g)
|
||||
|
||||
@@ -1,31 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import Alone ( aloneInARoom, sizeCheck )
|
||||
|
||||
import Terminal.Game
|
||||
|
||||
-- Hot reloading is a handy feature while writing a game. Here I will
|
||||
-- show you how to do that with ansi-terminal-game.
|
||||
--
|
||||
-- 1. install `entr` from your repositories;
|
||||
-- 2. run `find example/*.hs | entr -cr cabal run -f examples hot-reload`;
|
||||
-- 3. now modify example/Alone.hs and see your changes live!
|
||||
--
|
||||
-- Caveat: entr and similar applications do *not* work with interactive
|
||||
-- programs, so you need — as shown below — to load a record and play
|
||||
-- it as a demo.
|
||||
-- This is still useful to iteratively build NPCs’ behaviour, GUIs, etc.
|
||||
--
|
||||
-- Remember that you can use `recordGame` to record a session. If you
|
||||
-- need something fancier for your game (e.g. hot-reload with input),
|
||||
-- `venzone` [1] (module Watcher) has a builtin /watch mode/ you can
|
||||
-- take inspiration from.
|
||||
--
|
||||
-- [1] https://hackage.haskell.org/package/venzone
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
sizeCheck
|
||||
gr <- readRecord "test/records/alone-record-test.gr"
|
||||
-- check `readRecord
|
||||
() <$ narrateGame aloneInARoom gr
|
||||
@@ -1,30 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import Alone ( aloneInARoom, sizeCheck )
|
||||
|
||||
import Terminal.Game
|
||||
|
||||
import System.IO.Temp ( emptySystemTempFile )
|
||||
|
||||
-- plays the game and, once you quit, shows a replay of the session
|
||||
-- run with: cabal new-run -f examples alone-playback
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
sizeCheck
|
||||
tf <- emptySystemTempFile "alone-record.gr"
|
||||
playback tf
|
||||
|
||||
playback :: FilePath -> IO ()
|
||||
playback f = do
|
||||
prompt "Press <Enter> to play the game."
|
||||
recordGame aloneInARoom f
|
||||
prompt "Press <Enter> to watch playback."
|
||||
es <- readRecord f
|
||||
_ <- narrateGame aloneInARoom es
|
||||
prompt "Playback over! Press <Enter> to quit."
|
||||
where
|
||||
prompt :: String -> IO ()
|
||||
prompt s = putStrLn s >> () <$ getLine
|
||||
|
||||
|
||||
@@ -1,14 +0,0 @@
|
||||
--------------------------------------------------------------------------------
|
||||
-- Nonbuffering getChar
|
||||
-- 2017 Francesco Ariis GPLv3 80cols
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
module Terminal.Game.Utils ( inputCharTerminal,
|
||||
isWin32Console )
|
||||
where
|
||||
|
||||
inputCharTerminal :: IO Char
|
||||
inputCharTerminal = getChar
|
||||
|
||||
isWin32Console :: IO Bool
|
||||
isWin32Console = return False
|
||||
@@ -1,29 +0,0 @@
|
||||
--------------------------------------------------------------------------------
|
||||
-- Nonbuffering getChar et al
|
||||
-- 2017 Francesco Ariis GPLv3 80cols
|
||||
--------------------------------------------------------------------------------
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
-- horrible horrible horrible hack to make unbuffered input
|
||||
-- work on Windows (and win32console check)
|
||||
|
||||
module Terminal.Game.Utils (inputCharTerminal,
|
||||
isWin32Console )
|
||||
where
|
||||
|
||||
import qualified Data.Char as C
|
||||
import qualified Foreign.C.Types as FT
|
||||
import qualified System.Console.MinTTY as M
|
||||
|
||||
inputCharTerminal :: IO Char
|
||||
inputCharTerminal = getCharWindows
|
||||
|
||||
-- no idea why, but unsafe breaks it
|
||||
getCharWindows :: IO Char
|
||||
getCharWindows = fmap (C.chr . fromEnum) c_getch
|
||||
foreign import ccall safe "conio.h getch"
|
||||
c_getch :: IO FT.CInt
|
||||
|
||||
-- not perfect, but it is what it is (on win, non minTTY)
|
||||
isWin32Console :: IO Bool
|
||||
isWin32Console = not <$> M.isMinTTY
|
||||
@@ -1,206 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Terminal.Game
|
||||
-- Copyright : © 2017-2021 Francesco Ariis
|
||||
-- License : GPLv3 (see COPYING file)
|
||||
--
|
||||
-- Maintainer : Francesco Ariis <fa-ml@ariis.it>
|
||||
-- Stability : provisional
|
||||
-- Portability : portable
|
||||
--
|
||||
-- Machinery and utilities for 2D terminal games.
|
||||
--
|
||||
-- New? Start from 'Game'.
|
||||
--
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- Basic col-on-black ASCII terminal, operations.
|
||||
-- Only module to be imported.
|
||||
|
||||
module Terminal.Game ( -- * Running
|
||||
TPS,
|
||||
FPS,
|
||||
Event(..),
|
||||
GEnv(..),
|
||||
Game,
|
||||
GameT(..),
|
||||
playGame,
|
||||
playGameT,
|
||||
ATGException(..),
|
||||
|
||||
-- ** Helpers
|
||||
playGameS,
|
||||
Terminal.Game.displaySize,
|
||||
assertTermDims,
|
||||
errorPress,
|
||||
blankPlaneFull,
|
||||
centerFull,
|
||||
cleanAndExit,
|
||||
|
||||
-- * Game logic
|
||||
-- | Some convenient function dealing with
|
||||
-- Timers ('Timed') and 'Animation's.
|
||||
--
|
||||
-- Usage of these is not mandatory: 'Game' is
|
||||
-- parametrised over any state @s@, you are free
|
||||
-- to implement game logic as you prefer.
|
||||
|
||||
-- ** Timers/Animation
|
||||
|
||||
-- *** Timers
|
||||
Timed,
|
||||
creaTimer, creaBoolTimer,
|
||||
creaTimerLoop, creaBoolTimerLoop,
|
||||
|
||||
-- *** Animations
|
||||
Animation,
|
||||
creaAnimation,
|
||||
creaLoopAnimation,
|
||||
|
||||
-- *** T/A interface
|
||||
tick, ticks, reset, lapse,
|
||||
fetchFrame, isExpired,
|
||||
|
||||
-- ** Random numbers
|
||||
StdGen,
|
||||
getStdGen, mkStdGen,
|
||||
getRandom, pickRandom,
|
||||
UniformRange,
|
||||
|
||||
-- * Drawing
|
||||
-- | To get to the gist of drawing, check the
|
||||
-- documentation for '%'.
|
||||
--
|
||||
-- Blitting on screen is double-buffered and diff'd
|
||||
-- (at each frame, only cells with changed character
|
||||
-- will be redrawn).
|
||||
|
||||
-- ** Plane
|
||||
Plane,
|
||||
Dimensions,
|
||||
Coords,
|
||||
Row, Column,
|
||||
Width, Height,
|
||||
blankPlane,
|
||||
stringPlane,
|
||||
stringPlaneTrans,
|
||||
makeTransparent,
|
||||
makeOpaque,
|
||||
planePaper,
|
||||
planeSize,
|
||||
|
||||
-- ** Draw
|
||||
Draw,
|
||||
(%), (&), (#),
|
||||
subPlane,
|
||||
mergePlanes,
|
||||
cell, word, box,
|
||||
Color(..), ColorIntensity(..),
|
||||
color, bold, invert,
|
||||
|
||||
-- *** Alternative origins
|
||||
-- $origins
|
||||
(%^>), (%.<), (%.>),
|
||||
|
||||
-- *** Text boxes
|
||||
textBox, textBoxLiquid,
|
||||
textBoxHyphen, textBoxHyphenLiquid,
|
||||
Hyphenator,
|
||||
-- | Eurocentric convenience reexports. Check
|
||||
-- "Text.Hyphenation.Language" for more languages.
|
||||
english_GB, english_US, esperanto,
|
||||
french, german_1996, italian, spanish,
|
||||
|
||||
-- *** Declarative drawing
|
||||
(|||), (===), (***), hcat, vcat,
|
||||
|
||||
-- * Testing
|
||||
GRec,
|
||||
recordGame,
|
||||
readRecord,
|
||||
testGame,
|
||||
setupGame,
|
||||
narrateGame,
|
||||
|
||||
-- * Transformers
|
||||
GameIO(..),
|
||||
Test(..),
|
||||
Narrate(..)
|
||||
|
||||
-- | A quick and dirty way to have /hot reload/
|
||||
-- (autorestarting your game when source files change)
|
||||
-- is illustrated in @example/MainHotReload.hs@.
|
||||
|
||||
-- * Cross platform
|
||||
-- $xcompat
|
||||
)
|
||||
where
|
||||
|
||||
import System.Console.ANSI
|
||||
import Terminal.Game.Animation
|
||||
import Terminal.Game.Draw
|
||||
import Terminal.Game.Layer.Imperative
|
||||
import Terminal.Game.Layer.Object as O
|
||||
import Terminal.Game.Layer.Object.IO ( cleanAndExit )
|
||||
import Terminal.Game.Plane
|
||||
import Terminal.Game.Random
|
||||
import Text.LineBreak
|
||||
|
||||
import qualified Control.Monad as CM
|
||||
|
||||
-- $origins
|
||||
-- Placing a plane is sometimes more convenient if the coordinates origin
|
||||
-- is a corner other than top-left (e.g. “Paste this plane one row from
|
||||
-- bottom-left corner”). These combinators — meant to be used instead of '%'
|
||||
-- — allow you to do so. Example:
|
||||
--
|
||||
-- @
|
||||
-- prova :: Plane
|
||||
-- prova = let rect = box 6 3 \'.\'
|
||||
-- letters = word "ab"
|
||||
-- in rect &
|
||||
-- (1, 1) %.> letters -- start from bottom-right
|
||||
--
|
||||
-- -- λ> putStr (planePaper prova)
|
||||
-- -- ......
|
||||
-- -- ......
|
||||
-- -- ....ab
|
||||
-- @
|
||||
|
||||
-- $xcompat
|
||||
-- Good practices for cross-compatibility:
|
||||
--
|
||||
-- * choose game dimensions of no more than __24 rows__ and __80 columns__.
|
||||
-- This ensures compatibility with the trickiest terminals (i.e. Win32
|
||||
-- console);
|
||||
--
|
||||
-- * use __ASCII characters__ only. Again this is for Win32 console
|
||||
-- compatibility, until
|
||||
-- [this GHC bug](https://gitlab.haskell.org/ghc/ghc/issues/7593) gets
|
||||
-- fixed;
|
||||
--
|
||||
-- * employ colour sparingly: as some users will play your game in a
|
||||
-- light-background terminal and some in a dark one, choose only colours
|
||||
-- that go well with either (blue, red, etc.);
|
||||
--
|
||||
-- * some terminals/multiplexers (i.e. tmux) do not make a distinction
|
||||
-- between vivid/dull; do not base your game mechanics on that
|
||||
-- difference.
|
||||
|
||||
-- | /Usable/ terminal display size (on Win32 console the last line is
|
||||
-- set aside for input). Throws 'CannotGetDisplaySize' on error.
|
||||
displaySize :: IO Dimensions
|
||||
displaySize = O.displaySizeErr
|
||||
|
||||
-- | Check if terminal can accomodate 'Dimensions', otherwise throws
|
||||
-- 'DisplayTooSmall' with a helpful message for the player.
|
||||
assertTermDims :: Width -> Height -> IO ()
|
||||
assertTermDims dw dh =
|
||||
clearScreen >>
|
||||
setCursorPosition 0 0 >>
|
||||
displaySizeErr >>= \ads ->
|
||||
CM.when (isSmaller ads)
|
||||
(throwExc $ DisplayTooSmall (dw, dh) ads)
|
||||
where
|
||||
isSmaller :: Dimensions -> Bool
|
||||
isSmaller (ww, wh) = ww < dw || wh < dh
|
||||
@@ -1,33 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Animation
|
||||
-- 2018 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- {-# LANGUAGE DeriveGeneric #-}
|
||||
-- {-# LANGUAGE DefaultSignatures #-}
|
||||
-- {-# LANGUAGE StandaloneDeriving #-}
|
||||
-- {-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
module Terminal.Game.Animation (module Terminal.Game.Animation,
|
||||
module T
|
||||
) where
|
||||
|
||||
import Terminal.Game.Plane
|
||||
|
||||
import Control.Timer.Tick as T
|
||||
|
||||
-- import Data.Serialize
|
||||
|
||||
-- import qualified Data.ByteString as BS
|
||||
-- import qualified Data.Bifunctor as BF
|
||||
|
||||
-- | An @Animation@ is a series of timed time-separated 'Plane's.
|
||||
type Animation = T.Timed Plane
|
||||
|
||||
-- | Creates an 'Animation'.
|
||||
creaAnimation :: [(Integer, Plane)] -> Animation
|
||||
creaAnimation ips = creaTimedRes (Times 1 Elapse) ips
|
||||
|
||||
-- | Creates a looped 'Animation'.
|
||||
creaLoopAnimation :: [(Integer, Plane)] -> Animation
|
||||
creaLoopAnimation ips = creaTimedRes AlwaysLoop ips
|
||||
@@ -1,43 +0,0 @@
|
||||
module Terminal.Game.Character where
|
||||
|
||||
import Data.Char as C
|
||||
import Text.Unidecode as D
|
||||
import System.IO.Unsafe as U
|
||||
|
||||
|
||||
import Terminal.Game.Utils
|
||||
|
||||
-- Non ASCII character still cause crashes on Win32 console (see this
|
||||
-- report: https://gitlab.haskell.org/ghc/ghc/issues/7593 ).
|
||||
-- We provide a function to substitute them when playing on Win32
|
||||
-- console, with another appropriate chatacter.
|
||||
|
||||
win32SafeChar :: Char -> Char
|
||||
win32SafeChar c | areWeWin32 = toASCII c
|
||||
| otherwise = c
|
||||
where
|
||||
areWeWin32 :: Bool
|
||||
areWeWin32 = unsafePerformIO isWin32Console
|
||||
|
||||
-- ANCILLARIES --
|
||||
|
||||
toASCII :: Char -> Char
|
||||
toASCII c | C.isAscii c = c
|
||||
| Just cm <- lu = cm -- hand-made substitution
|
||||
| [cu] <- unidecode c = cu -- unidecode
|
||||
| otherwise = '?' -- all else failing
|
||||
where
|
||||
lu = lookup c subDictionary
|
||||
|
||||
subDictionary :: [(Char, Char)]
|
||||
subDictionary = [ -- various open/close quotes
|
||||
('«', '<'),
|
||||
('»', '>'),
|
||||
('“', '\''),
|
||||
('”', '\''),
|
||||
('‘', '\''),
|
||||
('’', '\''),
|
||||
|
||||
-- typographical marks
|
||||
('—', '-') ]
|
||||
|
||||
@@ -1,255 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Print convenience functions
|
||||
-- 2017 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- Drawing primitives. If not stated otherwise (textbox, etc.), ' ' are
|
||||
-- assumed to be opaque
|
||||
|
||||
module Terminal.Game.Draw (module Terminal.Game.Draw,
|
||||
(F.&)
|
||||
) where
|
||||
|
||||
import Terminal.Game.Plane
|
||||
|
||||
import Text.LineBreak
|
||||
|
||||
import qualified Data.Function as F ( (&) )
|
||||
import qualified Data.List as L
|
||||
import qualified System.Console.ANSI as CA
|
||||
|
||||
|
||||
-----------
|
||||
-- TYPES --
|
||||
-----------
|
||||
|
||||
-- | A drawing function, usually executed with the help of '%'.
|
||||
type Draw = Plane -> Plane
|
||||
|
||||
|
||||
-----------------
|
||||
-- COMBINATORS --
|
||||
-----------------
|
||||
|
||||
-- | Pastes one 'Plane' onto another. To be used along with 'F.&'
|
||||
-- like this:
|
||||
--
|
||||
-- @
|
||||
-- d :: Plane
|
||||
-- d = blankPlane 100 100 &
|
||||
-- (3, 4) % box '_' 3 5 &
|
||||
-- (a, b) % cell \'A\' '#' bold
|
||||
-- @
|
||||
(%) :: Coords -> Plane -> Draw
|
||||
cds % p1 = \p2 -> pastePlane p1 p2 cds
|
||||
infixl 4 %
|
||||
|
||||
-- | Apply style to plane, e.g.
|
||||
--
|
||||
-- > cell 'w' # bold
|
||||
(#) :: Plane -> Draw -> Plane
|
||||
p # sf = sf p
|
||||
infixl 8 #
|
||||
|
||||
-- | Shorthand for sequencing 'Plane's, e.g.
|
||||
--
|
||||
-- @
|
||||
-- firstPlane &
|
||||
-- (3, 4) '%' secondPlane &
|
||||
-- (1, 9) '%' thirdPlane
|
||||
-- @
|
||||
--
|
||||
-- is equal to
|
||||
--
|
||||
-- @
|
||||
-- mergePlanes firstPlane [((3,4), secondPlane),
|
||||
-- ((1,9), thirdPlane)]
|
||||
-- @
|
||||
mergePlanes :: Plane -> [(Coords, Plane)] -> Plane
|
||||
mergePlanes p cps = L.foldl' addPlane p cps
|
||||
where
|
||||
addPlane :: Plane -> (Coords, Plane) -> Plane
|
||||
addPlane bp (cs, tp) = bp F.& cs % tp
|
||||
|
||||
-- | Place two 'Plane's side-by-side, horizontally.
|
||||
(|||) :: Plane -> Plane -> Plane
|
||||
(|||) a b = let (wa, ha) = planeSize a
|
||||
(wb, hb) = planeSize b
|
||||
in mergePlanes (blankPlane (wa + wb) (max ha hb))
|
||||
[((1,1), a),
|
||||
((1,wa+1), b)]
|
||||
|
||||
-- | Place two 'Plane's side-by-side, vertically.
|
||||
(===) :: Plane -> Plane -> Plane
|
||||
(===) a b = let (wa, ha) = planeSize a
|
||||
(wb, hb) = planeSize b
|
||||
in mergePlanes (blankPlane (max wa wb) (ha + hb))
|
||||
[((1,1), a),
|
||||
((ha+1,1), b)]
|
||||
|
||||
-- | @a *** b@ blits @b@ in the centre of @a@.
|
||||
(***) :: Plane -> Plane -> Plane
|
||||
(***) a b = let (aw, ah) = planeSize a
|
||||
(bw, bh) = planeSize b
|
||||
r = quot (ah - bh) 2 + 1
|
||||
c = quot (aw - bw) 2 + 1
|
||||
in a F.&
|
||||
(r, c) % b
|
||||
|
||||
|
||||
-- | Place a list of 'Plane's side-by-side, horizontally. @error@s on
|
||||
-- empty list.
|
||||
hcat :: [Plane] -> Plane
|
||||
hcat [] = blankPlane 1 1 # makeTransparent ' '
|
||||
hcat ps = L.foldl1' (|||) ps
|
||||
|
||||
-- | Place a list of 'Plane's side-by-side, vertically. @error@s on
|
||||
-- empty list.
|
||||
vcat :: [Plane] -> Plane
|
||||
vcat [] = blankPlane 1 1 # makeTransparent ' '
|
||||
vcat ps = L.foldl1' (===) ps
|
||||
|
||||
infixl 6 |||, ===, ***
|
||||
|
||||
|
||||
------------
|
||||
-- STYLES --
|
||||
------------
|
||||
|
||||
-- | Set foreground color.
|
||||
color :: CA.Color -> CA.ColorIntensity -> Plane -> Plane
|
||||
color c i p = mapPlane (colorCell c i) p
|
||||
|
||||
-- | Apply bold style to 'Plane'.
|
||||
bold :: Plane -> Plane
|
||||
bold p = mapPlane boldCell p
|
||||
|
||||
-- | Swap foreground and background colours of 'Plane'.
|
||||
invert :: Plane -> Plane
|
||||
invert p = mapPlane reverseCell p
|
||||
|
||||
|
||||
|
||||
-------------
|
||||
-- DRAWING --
|
||||
-------------
|
||||
|
||||
-- | A box of dimensions @w h@.
|
||||
box :: Width -> Height -> Char -> Plane
|
||||
box w h chr = seqCellsDim w h cells
|
||||
where
|
||||
cells = [((r, c), chr) | r <- [1..h], c <- [1..w]]
|
||||
|
||||
-- | A 1×1 @Plane@.
|
||||
cell :: Char -> Plane
|
||||
cell ch = box 1 1 ch
|
||||
|
||||
-- | @1xn@ 'Plane' with a word in it. If you need to import multiline
|
||||
-- ASCII art, check 'stringPlane' and 'stringPlaneTrans'.
|
||||
word :: String -> Plane
|
||||
word w = seqCellsDim (L.genericLength w) 1 cells
|
||||
where
|
||||
cells = zip (zip (repeat 1) [1..]) w
|
||||
|
||||
-- opaque :: Plane -> Plane
|
||||
-- opaque p = pastePlane p (box ' ' White w h) (1, 1)
|
||||
-- where
|
||||
-- (w, h) = pSize p
|
||||
|
||||
-- | A text-box. Assumes @' '@s are transparent.
|
||||
textBox :: Width -> Height -> String -> Plane
|
||||
textBox w h cs = frameTrans w h (textBoxLiquid w cs)
|
||||
|
||||
-- | Like 'textBox', but tall enough to fit @String@.
|
||||
textBoxLiquid :: Width -> String -> Plane
|
||||
textBoxLiquid w cs = textBoxGeneralLiquid Nothing w cs
|
||||
|
||||
-- | As 'textBox', but hypenated. Example:
|
||||
--
|
||||
-- @
|
||||
-- (normal textbox) (hyphenated textbox)
|
||||
-- Rimasi un po’ a meditare nel buio Rimasi un po’ a meditare nel buio
|
||||
-- velato appena dal barlume azzurrino velato appena dal barlume azzurrino
|
||||
-- del fornello a gas, su cui del fornello a gas, su cui sobbol-
|
||||
-- sobbolliva quieta la pentola. liva quieta la pentola.
|
||||
-- @
|
||||
--
|
||||
-- Notice how in the right box /sobbolliva/ is broken in two. This
|
||||
-- can be useful and aesthetically pleasing when textboxes are narrow.
|
||||
textBoxHyphen :: Hyphenator -> Width -> Height -> String -> Plane
|
||||
textBoxHyphen hp w h cs = frameTrans w h (textBoxHyphenLiquid hp w cs)
|
||||
|
||||
-- | As 'textBoxLiquid', but hypenated.
|
||||
textBoxHyphenLiquid :: Hyphenator -> Width -> String -> Plane
|
||||
textBoxHyphenLiquid h w cs = textBoxGeneralLiquid (Just h) w cs
|
||||
|
||||
textBoxGeneralLiquid :: Maybe Hyphenator -> Width -> String -> Plane
|
||||
textBoxGeneralLiquid mh w cs = transparent
|
||||
where
|
||||
-- hypenathion
|
||||
bf = BreakFormat (fromIntegral w) 4 '-' mh
|
||||
hcs = breakStringLn bf cs
|
||||
h = L.genericLength hcs
|
||||
|
||||
f :: [String] -> [(Coords, Char)]
|
||||
f css = concatMap (uncurry rf) (zip [1..] css)
|
||||
where rf :: Int -> String -> [(Coords, Char)]
|
||||
rf cr ln = zip (zip (repeat cr) [1..]) ln
|
||||
|
||||
out = seqCellsDim w h (f hcs)
|
||||
transparent = makeTransparent ' ' out
|
||||
|
||||
|
||||
----------------------------
|
||||
-- ADDITIONAL COMBINATORS --
|
||||
----------------------------
|
||||
|
||||
-- Coords as if origin were @ bottom-right
|
||||
recipCoords :: Coords -> Plane -> Plane -> Coords
|
||||
recipCoords (r, c) p p1 =
|
||||
let (pw, ph) = planeSize p
|
||||
(p1w, p1h) = planeSize p1
|
||||
r' = ph-p1h-r+2
|
||||
c' = pw-p1w-c+2
|
||||
in (r', c')
|
||||
|
||||
-- | Pastes a plane onto another (origin: top-right).
|
||||
(%^>) :: Coords -> Plane -> Draw
|
||||
(r, c) %^> p1 = \p ->
|
||||
let (_, c') = recipCoords (r, c) p p1
|
||||
in p F.& (r, c') % p1
|
||||
|
||||
-- | Pastes a plane onto another (origin: bottom-left).
|
||||
(%.<) :: Coords -> Plane -> Draw
|
||||
(r, c) %.< p1 = \p ->
|
||||
let (r', _) = recipCoords (r, c) p p1
|
||||
in p F.& (r', c) % p1
|
||||
|
||||
-- | Pastes a plane onto another (origin: bottom-right).
|
||||
(%.>) :: Coords -> Plane -> Draw
|
||||
cs %.> p1 = \p ->
|
||||
let (r', c') = recipCoords cs p p1
|
||||
in p F.& (r', c') % p1
|
||||
|
||||
infixl 4 %^>
|
||||
infixl 4 %.<
|
||||
infixl 4 %.>
|
||||
|
||||
|
||||
-----------------
|
||||
-- ANCILLARIES --
|
||||
-----------------
|
||||
|
||||
seqCellsDim :: Width -> Height -> [(Coords, Char)] -> Plane
|
||||
seqCellsDim w h cells = seqCells (blankPlane w h) cells
|
||||
|
||||
seqCells :: Plane -> [(Coords, Char)] -> Plane
|
||||
seqCells p cells = updatePlane p (map f cells)
|
||||
where
|
||||
f (cds, chr) = (cds, creaCell chr)
|
||||
|
||||
-- paste plane on a blank one, and make ' ' transparent
|
||||
frameTrans :: Width -> Height -> Plane -> Plane
|
||||
frameTrans w h p = let bt = makeTransparent ' ' (blankPlane w h)
|
||||
in bt F.& (1, 1) % p
|
||||
|
||||
@@ -1,269 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Layer 1 (imperative), as per
|
||||
-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
|
||||
-- 2019 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# Language ScopedTypeVariables #-}
|
||||
{-# Language RankNTypes #-}
|
||||
|
||||
module Terminal.Game.Layer.Imperative where
|
||||
|
||||
import Terminal.Game.Draw
|
||||
import Terminal.Game.Layer.Object
|
||||
|
||||
import qualified Control.Concurrent as CC
|
||||
import qualified Control.Exception as E
|
||||
import qualified Control.Monad as CM
|
||||
import qualified Control.Monad.Trans as T
|
||||
import qualified Data.Bool as B
|
||||
import qualified Data.List as D
|
||||
import qualified System.IO as SI
|
||||
|
||||
import Terminal.Game.Plane
|
||||
|
||||
type Game s = GameT IO s
|
||||
|
||||
-- | Game definition datatype, parametrised on your gamestate. The two most
|
||||
-- important elements are the function dealing with logic and the drawing
|
||||
-- one. Check @alone@ demo (@cabal run -f examples alone@) to see a simple
|
||||
-- game in action.
|
||||
data GameT m s =
|
||||
Game { gTPS :: TPS,
|
||||
-- ^ Game speed in ticks per second. You do not
|
||||
-- need high values, since the 2D canvas is coarse
|
||||
-- (e.g. 13 TPS is enough for action games).
|
||||
gInitState :: s, -- ^ Initial state of the game.
|
||||
gLogicFunction :: GEnv -> s -> Event -> m s,
|
||||
-- ^ Logic function.
|
||||
gDrawFunction :: GEnv -> s -> Plane,
|
||||
-- ^ Draw function. Just want to blit your game
|
||||
-- in the middle? Check 'centerFull'.
|
||||
gQuitFunction :: s -> Bool
|
||||
-- ^ /Should I quit?/ function.
|
||||
}
|
||||
|
||||
-- | A blank plane as big as the terminal.
|
||||
blankPlaneFull :: GEnv -> Plane
|
||||
blankPlaneFull e = uncurry blankPlane (eTermDims e)
|
||||
|
||||
-- | Blits plane in the middle of terminal.
|
||||
--
|
||||
-- @
|
||||
-- draw :: GEnv -> MyState -> Plane
|
||||
-- draw ev s =
|
||||
-- centerFull ev $
|
||||
-- ⁝
|
||||
-- @
|
||||
centerFull :: GEnv -> Plane -> Plane
|
||||
centerFull e p = blankPlaneFull e *** p
|
||||
|
||||
-- | Entry point for the game execution, should be called in @main@.
|
||||
--
|
||||
-- You __must__ compile your programs with @-threaded@; if you do not do
|
||||
-- this the game will crash at start-up. Just add:
|
||||
--
|
||||
-- @
|
||||
-- ghc-options: -threaded
|
||||
-- @
|
||||
--
|
||||
-- in your @.cabal@ file and you will be fine!
|
||||
--
|
||||
-- Need to inspect state on exit? Check 'playGameS'.
|
||||
playGame :: Game s -> IO ()
|
||||
playGame g = () <$ playGameT T.liftIO g
|
||||
|
||||
playGameT :: Monad m => (forall m1 a. T.MonadIO m1 => m a -> m1 a) -> GameT m s -> IO s
|
||||
playGameT trans g = runGameGeneral trans g
|
||||
|
||||
-- | As 'playGame', but do not discard state.
|
||||
playGameS :: Game s -> IO s
|
||||
playGameS g = playGameT T.liftIO g
|
||||
|
||||
-- | Tests a game in a /pure/ environment. Aims to accurately emulate 'GEnv'
|
||||
-- changes (screen size, FPS) too.
|
||||
testGame :: GameT Test s -> GRec -> s
|
||||
testGame g ts = fst $ runTest (runGameGeneral id g) ts
|
||||
|
||||
-- | As 'testGame', but returns 'Game' instead of a bare state.
|
||||
-- Useful to fast-forward (e.g.: skip menus) before invoking 'playGame'.
|
||||
setupGame :: GameT Test s -> GRec -> GameT Test s
|
||||
setupGame g ts = let s' = testGame g ts
|
||||
in g { gInitState = s' }
|
||||
-- xx qua messi solo [Event]?
|
||||
|
||||
-- | Similar to 'testGame', runs the game given a 'GRec'. Unlike
|
||||
-- 'testGame', the playthrough will be displayed on screen. Useful when a
|
||||
-- test fails and you want to see how.
|
||||
--
|
||||
-- See this in action with @cabal run -f examples alone-playback@.
|
||||
--
|
||||
-- Notice that 'GEnv' will be provided at /run-time/, and not
|
||||
-- record-time; this can make emulation slightly inaccurate if — e.g. —
|
||||
-- you replay the game on a smaller terminal than the one you recorded
|
||||
-- the session on.
|
||||
narrateGame :: GameT Narrate s -> GRec -> IO s
|
||||
narrateGame g e = runReplay (runGameGeneral id g) e
|
||||
|
||||
-- | Play as in 'playGame' and write the session to @file@. Useful to
|
||||
-- produce input for 'testGame' and 'narrateGame'. Session will be
|
||||
-- recorded even if an exception happens while playing.
|
||||
recordGame :: GameT Record s -> FilePath -> IO ()
|
||||
recordGame g fp =
|
||||
E.bracket
|
||||
(CC.newMVar igrec)
|
||||
(\ve -> writeRec fp ve)
|
||||
(\ve -> () <$ runRecord (runGameGeneral id g) ve)
|
||||
|
||||
data Config = Config { cMEvents :: CC.MVar [Event],
|
||||
cTPS :: TPS }
|
||||
|
||||
runGameGeneral :: forall s m1 m. (Monad m1, MonadGameIO m)
|
||||
=> (forall a. m1 a -> m a)
|
||||
-> GameT m1 s
|
||||
-> m s
|
||||
runGameGeneral trans (Game tps s lf df qf) =
|
||||
-- init
|
||||
setupDisplay >>
|
||||
startEvents tps >>= \(InputHandle ve ts) ->
|
||||
displaySizeErr >>= \ds -> do
|
||||
|
||||
-- do it!
|
||||
let c = Config ve tps
|
||||
s' <- (game c ds) `onException` (stopEvents ts >> shutdownDisplay)
|
||||
stopEvents ts
|
||||
return s'
|
||||
where
|
||||
game :: MonadGameIO m => Config -> Dimensions -> m s
|
||||
game c wds = gameLoop trans c s lf df qf
|
||||
Nothing wds
|
||||
(creaFPSCalc tps)
|
||||
|
||||
-- | Wraps an @IO@ computation so that any 'ATGException' or 'error' gets
|
||||
-- displayed along with a @\<press any key to quit\>@ prompt.
|
||||
-- Some terminals shut-down immediately upon program end; adding
|
||||
-- @errorPress@ to 'playGame' makes it easier to beta-test games on those
|
||||
-- terminals.
|
||||
errorPress :: IO a -> IO a
|
||||
errorPress m = E.catches m [E.Handler errorDisplay,
|
||||
E.Handler atgDisplay]
|
||||
where
|
||||
errorDisplay :: E.ErrorCall -> IO a
|
||||
errorDisplay (E.ErrorCallWithLocation cs l) = report $
|
||||
putStrLn (cs ++ "\n\n") >>
|
||||
putStrLn "Stack trace info:\n" >>
|
||||
putStrLn l
|
||||
|
||||
atgDisplay :: ATGException -> IO a
|
||||
atgDisplay e = report $ print e
|
||||
|
||||
report :: IO () -> IO a
|
||||
report wm =
|
||||
putStrLn "ERROR REPORT\n" >>
|
||||
wm >>
|
||||
putStrLn "\n\n <Press any key to quit>" >>
|
||||
SI.hSetBuffering SI.stdin SI.NoBuffering >>
|
||||
getChar >>
|
||||
errorWithoutStackTrace "errorPress"
|
||||
|
||||
|
||||
-----------
|
||||
-- LOGIC --
|
||||
-----------
|
||||
|
||||
-- from http://www.loomsoft.net/resources/alltut/alltut_lesson6.htm
|
||||
gameLoop :: (Monad m1, MonadGameIO m) =>
|
||||
(forall a. m1 a -> m a) ->
|
||||
Config -> -- event source
|
||||
s -> -- state
|
||||
(GEnv ->
|
||||
s -> Event -> m1 s) -> -- logic function
|
||||
(GEnv ->
|
||||
s -> Plane) -> -- draw function
|
||||
(s -> Bool) -> -- quit? function
|
||||
Maybe Plane -> -- last blitted screen
|
||||
Dimensions -> -- Term dimensions
|
||||
FPSCalc -> -- calculate fps
|
||||
m s
|
||||
gameLoop trans c s lf df qf opln td fps =
|
||||
|
||||
-- quit?
|
||||
checkQuit qf s >>= \qb ->
|
||||
if qb
|
||||
then return s
|
||||
else
|
||||
|
||||
-- fetch events (if any)
|
||||
pollEvents (cMEvents c) >>= \es ->
|
||||
|
||||
-- no events? skip everything
|
||||
if null es
|
||||
then sleepABit (cTPS c) >>
|
||||
gameLoop trans c s lf df qf opln td fps
|
||||
else
|
||||
|
||||
displaySizeErr >>= \td' ->
|
||||
|
||||
-- logic
|
||||
let ge = GEnv td' (calcFPS fps) in
|
||||
trans (stepsLogic s (lf ge) es) >>= \(i, s') ->
|
||||
|
||||
-- no `Tick` events? You do not need to blit, just update state
|
||||
if i == 0
|
||||
then gameLoop trans c s' lf df qf opln td fps
|
||||
else
|
||||
|
||||
-- FPS calc
|
||||
let fps' = addFPS i fps in
|
||||
|
||||
-- clear screen if resolution changed
|
||||
let resc = td /= td' in
|
||||
CM.when resc clearDisplay >>
|
||||
|
||||
-- draw
|
||||
let opln' | resc = Nothing -- res changed? restart double buffering
|
||||
| otherwise = opln
|
||||
npln = df ge s' in
|
||||
|
||||
blitPlane opln' npln >>
|
||||
|
||||
gameLoop trans c s' lf df qf (Just npln) td' fps'
|
||||
|
||||
-- Int = number of `Tick` events
|
||||
stepsLogic :: Monad m => s -> (s -> Event -> m s) -> [Event] -> m (Integer, s)
|
||||
stepsLogic s lf es = do
|
||||
let ies = D.genericLength . filter isTick $ es
|
||||
res <- CM.foldM lf s es
|
||||
return (ies, res)
|
||||
where
|
||||
isTick Tick = True
|
||||
isTick _ = False
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Frame per Seconds
|
||||
|
||||
data FPSCalc = FPSCalc [Integer] TPS
|
||||
-- list with number of `Ticks` processed at each blit and expected
|
||||
-- FPS (i.e. TPS)
|
||||
|
||||
-- the size of moving average will be TPS (that simplifies calculations)
|
||||
creaFPSCalc :: TPS -> FPSCalc
|
||||
creaFPSCalc tps = FPSCalc (D.genericReplicate tps {- (tps*2) -} 1) tps
|
||||
-- tps*1: size of thw window in **blit actions** (not tick actions!)
|
||||
-- so keeping it small should be responsive and non flickery
|
||||
-- at the same time!
|
||||
|
||||
-- add ticks
|
||||
addFPS :: Integer -> FPSCalc -> FPSCalc
|
||||
addFPS nt (FPSCalc (_:fps) tps) = FPSCalc (fps ++ [nt]) tps
|
||||
addFPS _ (FPSCalc [] _) = error "addFPS: empty list."
|
||||
|
||||
calcFPS :: FPSCalc -> Integer
|
||||
calcFPS (FPSCalc fps tps) =
|
||||
let ts = sum fps
|
||||
ds = D.genericLength fps
|
||||
in roundQuot (tps * ds) ts
|
||||
where
|
||||
roundQuot :: Integer -> Integer -> Integer
|
||||
roundQuot a b = let (q, r) = quotRem a b
|
||||
in q + B.bool 0 1 (r > div b 2)
|
||||
@@ -1,30 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Layer 2 (mockable IO), as per
|
||||
-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
|
||||
-- 2019 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
module Terminal.Game.Layer.Object ( module Export ) where
|
||||
|
||||
import Terminal.Game.Layer.Object.Interface as Export
|
||||
import Terminal.Game.Layer.Object.GameIO as Export
|
||||
import Terminal.Game.Layer.Object.Narrate as Export
|
||||
import Terminal.Game.Layer.Object.Primitive as Export
|
||||
import Terminal.Game.Layer.Object.Record as Export
|
||||
import Terminal.Game.Layer.Object.Test as Export
|
||||
|
||||
-- DESIGN NOTES --
|
||||
|
||||
-- The classes are described in 'Interface'.
|
||||
|
||||
-- The implemented monads are four:
|
||||
-- - GameIO (via MonadIO): playing the game
|
||||
-- - Test: testing the game in a pure manner
|
||||
-- - Record: playing the game and record the Events in a file
|
||||
-- - Replay: replay a game using a set of Events.
|
||||
--
|
||||
-- The last two monads (Record/Replay) take advantage of "overlapping
|
||||
-- instances". Instead of reimplementing most of what happens in MonadIO,
|
||||
-- they'll just touch the classes from interface which behaviour they
|
||||
-- will modify; being more specific, they will be chosen instead of plain
|
||||
-- IO.
|
||||
@@ -1,21 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Layer 2 (mockable IO), as per
|
||||
-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
|
||||
-- 2019 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
|
||||
module Terminal.Game.Layer.Object.GameIO where
|
||||
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import qualified Control.Monad.Trans as T
|
||||
|
||||
|
||||
newtype GameIO a = GameIO { runGIO :: IO a }
|
||||
deriving (Functor, Applicative, Monad,
|
||||
T.MonadIO,
|
||||
MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
|
||||
|
||||
|
||||
@@ -1,291 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Layer 2 (mockable IO), as per
|
||||
-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
|
||||
-- 2019 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
|
||||
module Terminal.Game.Layer.Object.IO where
|
||||
|
||||
import Terminal.Game.Utils
|
||||
|
||||
import Terminal.Game.Layer.Object.Interface
|
||||
import Terminal.Game.Layer.Object.Primitive
|
||||
import Terminal.Game.Plane
|
||||
|
||||
import qualified Control.Concurrent as CC
|
||||
import qualified Control.Monad as CM
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import qualified Control.Monad.Trans as T
|
||||
import qualified Data.List.Split as LS
|
||||
import qualified System.Clock as SC
|
||||
import qualified System.Console.ANSI as CA
|
||||
import qualified System.Console.Terminal.Size as TS
|
||||
import qualified System.IO as SI
|
||||
|
||||
-- Most General MonadIO operations.
|
||||
|
||||
----------------
|
||||
-- Game input --
|
||||
----------------
|
||||
|
||||
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadInput m where
|
||||
startEvents tps = T.liftIO $ startIOInput tps
|
||||
pollEvents ve = T.liftIO $ CC.swapMVar ve []
|
||||
stopEvents ts = T.liftIO $ stopEventsIO ts
|
||||
|
||||
-- filepath = logging
|
||||
startIOInput :: TPS -> IO InputHandle
|
||||
startIOInput tps =
|
||||
SI.hSetBuffering SI.stdin SI.NoBuffering >>
|
||||
SI.hSetBuffering SI.stdout SI.NoBuffering >>
|
||||
SI.hSetEcho SI.stdin False >>
|
||||
-- all the buffering settings has to happen
|
||||
-- at the top of startIOInput. If i move
|
||||
-- them to display, you need to press enter
|
||||
-- before playing the game on some machines.
|
||||
|
||||
-- event and log variables
|
||||
CC.newMVar [] >>= \ve ->
|
||||
|
||||
getTimeTick tps >>= \it ->
|
||||
CC.forkIO (addTick ve tps it) >>= \te ->
|
||||
CC.forkIO (addKeypress ve) >>= \tk ->
|
||||
return (InputHandle ve [te, tk])
|
||||
|
||||
-- a precise timer, not based on `threadDelay`
|
||||
type Elapsed = Integer -- in `Ticks`
|
||||
|
||||
-- elapsed from Epoch in ticks
|
||||
getTimeTick :: TPS -> IO Elapsed
|
||||
getTimeTick tps =
|
||||
getTime >>= \tm ->
|
||||
let ns = 10 ^ (9 :: Integer)
|
||||
t1 = quot ns tps in
|
||||
return (quot tm t1)
|
||||
|
||||
-- mr: maybe recording
|
||||
addTick :: CC.MVar [Event] -> TPS -> Elapsed -> IO ()
|
||||
addTick ve tps el =
|
||||
-- precise timing. With `treadDelay`, on finer TPS,
|
||||
-- ticks take too much (check threadDelay doc).
|
||||
getTimeTick tps >>= \t ->
|
||||
CM.replicateM_ (fromIntegral $ t-el)
|
||||
(addEvent ve Tick) >>
|
||||
|
||||
-- sleep some
|
||||
sleepABit tps >>
|
||||
addTick ve tps t
|
||||
|
||||
-- get action char
|
||||
-- mr: maybe recording
|
||||
addKeypress :: CC.MVar [Event] -> IO ()
|
||||
addKeypress ve = -- vedi platform-dep/
|
||||
inputCharTerminal >>= \c ->
|
||||
addEvent ve (KeyPress c) >>
|
||||
addKeypress ve
|
||||
|
||||
-- mr: maybe recording
|
||||
addEvent :: CC.MVar [Event] -> Event -> IO ()
|
||||
addEvent ve e = vf ve
|
||||
where
|
||||
vf d = CC.modifyMVar_ d (return . (++[e]))
|
||||
|
||||
stopEventsIO :: [CC.ThreadId] -> IO ()
|
||||
stopEventsIO ts = mapM_ CC.killThread ts
|
||||
|
||||
-----------------
|
||||
-- Game timing --
|
||||
-----------------
|
||||
|
||||
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadTimer m where
|
||||
getTime = T.liftIO $ SC.toNanoSecs <$> SC.getTime SC.Monotonic
|
||||
sleepABit tps = T.liftIO $
|
||||
CC.threadDelay (fromIntegral $ quot oneTickSec (tps*10))
|
||||
|
||||
--------------------
|
||||
-- Error handling --
|
||||
--------------------
|
||||
|
||||
instance {-# OVERLAPS #-}
|
||||
(Monad m, T.MonadIO m, MC.MonadMask m, MC.MonadThrow m) =>
|
||||
MonadException m where
|
||||
cleanUpErr m c = MC.finally m c
|
||||
onException m c = MC.onException m c
|
||||
throwExc t = MC.throwM t
|
||||
|
||||
-----------
|
||||
-- Logic --
|
||||
-----------
|
||||
|
||||
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) =>
|
||||
MonadLogic m where
|
||||
checkQuit fb s = return (fb s)
|
||||
|
||||
-------------
|
||||
-- Display --
|
||||
-------------
|
||||
|
||||
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadDisplay m where
|
||||
setupDisplay = T.liftIO initPart
|
||||
clearDisplay = T.liftIO clearScreen
|
||||
displaySize = T.liftIO displaySizeIO
|
||||
blitPlane mp p = T.liftIO (blitPlaneIO mp p)
|
||||
shutdownDisplay = T.liftIO cleanAndExit
|
||||
|
||||
displaySizeIO :: IO (Maybe Dimensions)
|
||||
displaySizeIO =
|
||||
TS.size >>= \ts ->
|
||||
-- cannot use ansi-terminal, on Windows you get
|
||||
-- "ConsoleException 87" (too much scrolling)
|
||||
-- and it does not work for mintty and it is
|
||||
-- inefficient as it gets (attempts to scroll past
|
||||
-- bottom right)
|
||||
isWin32Console >>= \bw ->
|
||||
|
||||
return (fmap (f bw) ts)
|
||||
where
|
||||
f :: Bool -> TS.Window Int -> Dimensions
|
||||
f wbw (TS.Window h w) =
|
||||
let h' | wbw = h - 1
|
||||
| otherwise = h
|
||||
in (w, h')
|
||||
|
||||
-- pn: new plane, po: old plane
|
||||
-- wo, ho: dimensions of the terminal. If they change, reinit double buffering
|
||||
blitPlaneIO :: Maybe Plane -> Plane -> IO ()
|
||||
blitPlaneIO mpo pn =
|
||||
|
||||
-- remember that Nothing will be passed:
|
||||
-- - at the beginning of the game (first blit)
|
||||
-- - when resolution changes (see gameLoop)
|
||||
-- so do not duplicate hasResChanged checks here!
|
||||
|
||||
-- old plane
|
||||
let
|
||||
(pw, ph) = planeSize pn
|
||||
bp = blankPlane pw ph
|
||||
po = pastePlane (maybe bp id mpo) bp (1, 1)
|
||||
in
|
||||
|
||||
-- new plane
|
||||
let pn' = pastePlane pn bp (1, 1)
|
||||
in
|
||||
|
||||
-- trimming is foundamental, as blitMap could otherwise print
|
||||
-- outside terminal boundaries and scroll to its death
|
||||
-- (error 87 on Win32 console).
|
||||
|
||||
CA.setSGR [CA.Reset] >>
|
||||
blitMap po pn'
|
||||
|
||||
|
||||
-----------------
|
||||
-- ANCILLARIES --
|
||||
-----------------
|
||||
|
||||
initPart :: IO ()
|
||||
initPart = -- check thread support
|
||||
CM.unless CC.rtsSupportsBoundThreads
|
||||
(error errMes) >>
|
||||
|
||||
-- initial setup/checks
|
||||
CA.hideCursor >>
|
||||
|
||||
-- text encoding
|
||||
SI.mkTextEncoding "UTF-8//TRANSLIT" >>= \te ->
|
||||
SI.hSetEncoding SI.stdout te >>
|
||||
|
||||
clearScreen
|
||||
where
|
||||
errMes = unlines
|
||||
["\nError: you *must* compile this program with -threaded!",
|
||||
"Just add",
|
||||
"",
|
||||
" ghc-options: -threaded",
|
||||
"",
|
||||
"in your .cabal file (executable section) and you will be fine!"]
|
||||
|
||||
-- clears screen
|
||||
clearScreen :: IO ()
|
||||
clearScreen = CA.setCursorPosition 0 0 >>
|
||||
CA.setSGR [CA.Reset] >>
|
||||
displaySizeErr >>= \(w, h) ->
|
||||
CM.replicateM_ (fromIntegral $ w*h) (putChar ' ')
|
||||
|
||||
cleanAndExit :: IO ()
|
||||
cleanAndExit = CA.setSGR [CA.Reset] >>
|
||||
CA.clearScreen >>
|
||||
CA.setCursorPosition 0 0 >>
|
||||
CA.showCursor
|
||||
|
||||
-- plane
|
||||
blitMap :: Plane -> Plane -> IO ()
|
||||
blitMap po pn =
|
||||
CM.when (planeSize po /= planeSize pn)
|
||||
(error "blitMap: different plane sizes") >>
|
||||
CA.setCursorPosition 0 0 >>
|
||||
-- setCursorPosition is *zero* based!
|
||||
blitToTerminal (0, 0) (orderedCells po) (orderedCells pn)
|
||||
|
||||
orderedCells :: Plane -> [[Cell]]
|
||||
orderedCells p = LS.chunksOf (fromIntegral w) cells
|
||||
where
|
||||
cells = map snd $ assocsPlane p
|
||||
(w, _) = planeSize p
|
||||
|
||||
|
||||
-- ordered sequence of cells, both old and new, like they were a String to
|
||||
-- print to screen.
|
||||
-- Coords: initial blitting position
|
||||
-- Remember that this Column is *zero* based
|
||||
blitToTerminal :: Coords -> [[Cell]] -> [[Cell]] -> IO ()
|
||||
blitToTerminal (rr, rc) ocs ncs = CM.foldM_ blitLine rr oldNew
|
||||
where
|
||||
oldNew :: [[(Cell, Cell)]]
|
||||
oldNew = zipWith zip ocs ncs
|
||||
|
||||
-- row = previous row
|
||||
blitLine :: Row -> [(Cell, Cell)] -> IO Row
|
||||
blitLine pr ccs =
|
||||
CM.foldM_ blitCell 0 ccs >>
|
||||
-- have to use setCursorPosition (instead of nextrow) b/c
|
||||
-- on win there is an auto "go-to-next-line" when reaching
|
||||
-- column end and on win it does not do so
|
||||
let wr = pr + 1 in
|
||||
CA.setCursorPosition (fromIntegral wr)
|
||||
(fromIntegral rc) >>
|
||||
return wr
|
||||
|
||||
-- k is "spaces to skip"
|
||||
blitCell :: Int -> (Cell, Cell) -> IO Int
|
||||
blitCell k (clo, cln)
|
||||
| cln == clo = return (k+1)
|
||||
| otherwise = moveIf k >>= \k' ->
|
||||
putCellStyle cln >>
|
||||
return k'
|
||||
|
||||
moveIf :: Int -> IO Int
|
||||
moveIf k | k == 0 = return k
|
||||
| otherwise = CA.cursorForward k >>
|
||||
return 0
|
||||
|
||||
putCellStyle :: Cell -> IO ()
|
||||
putCellStyle c = CA.setSGR ([CA.Reset] ++ sgrb ++ sgrr ++ sgrc) >>
|
||||
putChar (cellChar c)
|
||||
where
|
||||
sgrb | isBold c = [CA.SetConsoleIntensity CA.BoldIntensity]
|
||||
| otherwise = []
|
||||
|
||||
sgrr | isReversed c = [CA.SetSwapForegroundBackground True]
|
||||
| otherwise = []
|
||||
|
||||
sgrc | Just (k, i) <- cellColor c = [CA.SetColor CA.Foreground i k]
|
||||
| otherwise = []
|
||||
|
||||
oneTickSec :: Integer
|
||||
oneTickSec = 10 ^ (6 :: Integer)
|
||||
@@ -1,90 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Layer 2 (mockable IO), as per
|
||||
-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
|
||||
-- 2019 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Terminal.Game.Layer.Object.Interface where
|
||||
|
||||
import Terminal.Game.Plane
|
||||
import Terminal.Game.Layer.Object.Primitive
|
||||
|
||||
import qualified Control.Concurrent as CC
|
||||
import qualified Control.Monad.Catch as MC
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- mtl interface for game
|
||||
|
||||
type MonadGameIO m = (MonadInput m, MonadTimer m,
|
||||
MonadException m, MonadLogic m,
|
||||
MonadDisplay m)
|
||||
|
||||
data InputHandle = InputHandle
|
||||
{ ihKeyMVar :: CC.MVar [Event],
|
||||
ihOpenThreads :: [CC.ThreadId] }
|
||||
|
||||
class Monad m => MonadInput m where
|
||||
startEvents :: TPS -> m InputHandle
|
||||
pollEvents :: CC.MVar [Event] -> m [Event]
|
||||
stopEvents :: [CC.ThreadId] -> m ()
|
||||
|
||||
class Monad m => MonadTimer m where
|
||||
getTime :: m Integer -- to nanoseconds
|
||||
sleepABit :: TPS -> m () -- Given TPS, sleep a fracion of a single
|
||||
-- Tick.
|
||||
|
||||
-- if a fails, do b (useful for cleaning up)
|
||||
class Monad m => MonadException m where
|
||||
cleanUpErr :: m a -> m b -> m a
|
||||
onException :: m a -> m b -> m a
|
||||
throwExc :: ATGException -> m a
|
||||
|
||||
class Monad m => MonadLogic m where
|
||||
-- decide whether it's time to quit
|
||||
checkQuit :: (s -> Bool) -> s -> m Bool
|
||||
|
||||
class Monad m => MonadDisplay m where
|
||||
setupDisplay :: m ()
|
||||
clearDisplay :: m ()
|
||||
displaySize :: m (Maybe Dimensions)
|
||||
blitPlane :: Maybe Plane -> Plane -> m ()
|
||||
shutdownDisplay :: m ()
|
||||
|
||||
displaySizeErr :: (MonadDisplay m, MonadException m) => m Dimensions
|
||||
displaySizeErr = displaySize >>= \case
|
||||
Nothing -> throwExc CannotGetDisplaySize
|
||||
Just d -> return d
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Error handling
|
||||
|
||||
-- | @ATGException@s are thrown synchronously for easier catching.
|
||||
data ATGException = CannotGetDisplaySize
|
||||
| DisplayTooSmall Dimensions Dimensions
|
||||
-- ^ Required and actual dimensions.
|
||||
|
||||
instance Show ATGException where
|
||||
show CannotGetDisplaySize = "CannotGetDisplaySize"
|
||||
show (DisplayTooSmall (sw, sh) tds) =
|
||||
let colS ww = ww < sw
|
||||
rowS wh = wh < sh
|
||||
|
||||
smallMsg :: Dimensions -> String
|
||||
smallMsg (ww, wh) =
|
||||
let cm = show ww ++ " columns"
|
||||
rm = show wh ++ " rows"
|
||||
em | colS ww && rowS wh = cm ++ " and " ++ rm
|
||||
| colS ww = cm
|
||||
| rowS wh = rm
|
||||
| otherwise = "smallMsg: passed correct term size!"
|
||||
in
|
||||
"This games requires a display of " ++ show sw ++
|
||||
" columns and " ++ show sh ++ " rows.\n" ++
|
||||
"Yours only has " ++ em ++ "!\n\n" ++
|
||||
"Please resize your terminal and restart the game.\n"
|
||||
in "DisplayTooSmall.\n" ++ smallMsg tds
|
||||
|
||||
instance MC.Exception ATGException where
|
||||
@@ -1,30 +0,0 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Terminal.Game.Layer.Object.Narrate where
|
||||
|
||||
-- Narrate Monad, replay on screen from a GRec
|
||||
|
||||
import Terminal.Game.Layer.Object.Interface
|
||||
import Terminal.Game.Layer.Object.Primitive
|
||||
import Terminal.Game.Layer.Object.IO () -- MonadIo
|
||||
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import qualified Control.Monad.State as S
|
||||
import qualified Control.Monad.Trans as T
|
||||
|
||||
|
||||
newtype Narrate a = Narrate (S.StateT GRec IO a)
|
||||
deriving (Functor, Applicative, Monad,
|
||||
T.MonadIO, S.MonadState GRec,
|
||||
MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
|
||||
|
||||
instance MonadInput Narrate where
|
||||
startEvents fps = T.liftIO $ startEvents fps
|
||||
pollEvents _ = S.state getPolled
|
||||
stopEvents ts = T.liftIO $ stopEvents ts
|
||||
|
||||
instance MonadLogic Narrate where
|
||||
checkQuit _ _ = S.gets isOver
|
||||
|
||||
runReplay :: Narrate a -> GRec -> IO a
|
||||
runReplay (Narrate s) k = S.evalStateT s k
|
||||
@@ -1,93 +0,0 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Terminal.Game.Layer.Object.Primitive where
|
||||
|
||||
import Terminal.Game.Plane
|
||||
|
||||
import qualified GHC.Generics as G
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Serialize as Z
|
||||
import qualified Data.Sequence as S
|
||||
import qualified Test.QuickCheck as Q
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Assorted API types
|
||||
|
||||
-- | The number of 'Tick's fed each second to the logic function;
|
||||
-- constant on every machine. /Frames/ per second might be lower
|
||||
-- (depending on drawing function onerousness, terminal refresh rate,
|
||||
-- etc.).
|
||||
type TPS = Integer
|
||||
|
||||
-- | The number of frames blit to terminal per second. Frames might be
|
||||
-- dropped, but game speed will remain constant. Check @balls@
|
||||
-- (@cabal run -f examples balls@) to see how to display FPS.
|
||||
-- For obvious reasons (blits would be wasted) @max FPS = TPS@.
|
||||
type FPS = Integer
|
||||
|
||||
-- | An @Event@ is a 'Tick' (time passes) or a 'KeyPress'.
|
||||
data Event = Tick
|
||||
| KeyPress Char
|
||||
deriving (Show, Eq, G.Generic)
|
||||
instance Z.Serialize Event where
|
||||
|
||||
instance Q.Arbitrary Event where
|
||||
arbitrary = Q.oneof [ pure Tick,
|
||||
KeyPress <$> Q.arbitrary ]
|
||||
|
||||
-- | Game environment with current terminal dimensions and current display
|
||||
-- rate.
|
||||
data GEnv = GEnv { eTermDims :: Dimensions,
|
||||
-- ^ Current terminal dimensions.
|
||||
eFPS :: FPS
|
||||
-- ^ Current blitting rate.
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- GRec record/replay game typs
|
||||
|
||||
-- | Opaque data type with recorded game input, for testing purposes.
|
||||
data GRec = GRec { aPolled :: S.Seq [Event],
|
||||
-- Seq. of polled events
|
||||
aTermSize :: S.Seq (Maybe Dimensions) }
|
||||
-- Seq. of polled termdims
|
||||
deriving (Show, Eq, G.Generic)
|
||||
instance Z.Serialize GRec where
|
||||
|
||||
igrec :: GRec
|
||||
igrec = GRec S.Empty S.Empty
|
||||
|
||||
addDims :: Maybe Dimensions -> GRec -> GRec
|
||||
addDims mds (GRec p s) = GRec p (mds S.<| s)
|
||||
|
||||
getDims :: GRec -> (Maybe Dimensions, GRec)
|
||||
getDims (GRec p (ds S.:|> d)) = (d, GRec p ds)
|
||||
getDims _ = error "getDims: empty Seq"
|
||||
-- Have to use _ or “non exhaustive patterns” warning
|
||||
|
||||
addPolled :: [Event] -> GRec -> GRec
|
||||
addPolled es (GRec p s) = GRec (es S.<| p) s
|
||||
|
||||
getPolled :: GRec -> ([Event], GRec)
|
||||
getPolled (GRec (ps S.:|> p) d) = (p, GRec ps d)
|
||||
getPolled _ = error "getEvents: empty Seq"
|
||||
|
||||
isOver :: GRec -> Bool
|
||||
isOver (GRec S.Empty _) = True
|
||||
isOver _ = False
|
||||
|
||||
-- | Reads a file containing a recorded session.
|
||||
readRecord :: FilePath -> IO GRec
|
||||
readRecord fp = Z.decode <$> BS.readFile fp >>= \case
|
||||
Left e -> error $ "readRecord could not decode: " ++
|
||||
show e
|
||||
Right r -> return r
|
||||
|
||||
-- | Convenience function to create a 'GRec' from screen size (constant) plus a list of events. Useful with 'setupGame'.
|
||||
createGRec :: Dimensions -> [Event] -> GRec
|
||||
createGRec ds es = let l = length es * 2 in
|
||||
GRec (S.fromList [es])
|
||||
(S.fromList . replicate l $ Just ds)
|
||||
|
||||
@@ -1,53 +0,0 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Terminal.Game.Layer.Object.Record where
|
||||
|
||||
-- Record Monad, for when I need to play the game and record Events
|
||||
-- (keypresses, ticks, screen size, FPS) to a file.
|
||||
|
||||
import Terminal.Game.Layer.Object.Interface
|
||||
import Terminal.Game.Layer.Object.Primitive
|
||||
import Terminal.Game.Layer.Object.IO ()
|
||||
|
||||
import qualified Control.Concurrent as CC
|
||||
import qualified Control.Monad.Catch as MC
|
||||
import qualified Control.Monad.Reader as R
|
||||
import qualified Control.Monad.Trans as T -- MonadIO
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Serialize as S
|
||||
|
||||
-- record the key pressed in a game session
|
||||
|
||||
newtype Record a = Record (R.ReaderT (CC.MVar GRec) IO a)
|
||||
deriving (Functor, Applicative, Monad,
|
||||
T.MonadIO, R.MonadReader (CC.MVar GRec),
|
||||
MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
|
||||
|
||||
-- Lifts IO interface, records where necessary
|
||||
instance MonadInput Record where
|
||||
startEvents tps = T.liftIO (startEvents tps)
|
||||
pollEvents ve = T.liftIO (pollEvents ve) >>= \es ->
|
||||
modMRec addPolled es
|
||||
stopEvents ts = T.liftIO (stopEvents ts)
|
||||
|
||||
instance MonadDisplay Record where
|
||||
setupDisplay = T.liftIO setupDisplay
|
||||
clearDisplay = T.liftIO clearDisplay
|
||||
displaySize = T.liftIO displaySize >>= \ds ->
|
||||
modMRec addDims ds
|
||||
blitPlane mp p = T.liftIO (blitPlane mp p)
|
||||
shutdownDisplay = T.liftIO shutdownDisplay
|
||||
|
||||
-- logs and passes the value on
|
||||
modMRec :: (a -> GRec -> GRec) -> a -> Record a
|
||||
modMRec f a = R.ask >>= \mv ->
|
||||
let fmv = CC.modifyMVar_ mv (return . f a) in
|
||||
T.liftIO fmv >>
|
||||
return a
|
||||
|
||||
runRecord :: Record a -> CC.MVar GRec -> IO a
|
||||
runRecord (Record r) me = R.runReaderT r me
|
||||
|
||||
writeRec :: FilePath -> CC.MVar GRec -> IO ()
|
||||
writeRec fp vr = CC.readMVar vr >>= \k ->
|
||||
BS.writeFile fp (S.encode k)
|
||||
@@ -1,78 +0,0 @@
|
||||
-------------------------------------------------------------------------------
|
||||
-- Layer 2 (mockable IO), as per
|
||||
-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
|
||||
-- 2019 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Terminal.Game.Layer.Object.Test where
|
||||
|
||||
-- Test (pure) MonadGame* typeclass implementation for testing purposes.
|
||||
|
||||
import Terminal.Game.Layer.Object.Interface
|
||||
import Terminal.Game.Layer.Object.Primitive
|
||||
|
||||
import qualified Control.Monad.RWS as S
|
||||
|
||||
|
||||
-----------
|
||||
-- TYPES --
|
||||
-----------
|
||||
|
||||
data TestEvent = TCleanUpError
|
||||
| TQuitGame
|
||||
| TSetupDisplay
|
||||
| TShutdownDisplay
|
||||
| TStartGame
|
||||
| TStartEvents
|
||||
| TStopEvents
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- r: ()
|
||||
-- w: [TestEvents]
|
||||
-- s: [GTest]
|
||||
newtype Test a = Test (S.RWS () [TestEvent] GRec a)
|
||||
deriving (Functor, Applicative, Monad,
|
||||
S.MonadState GRec,
|
||||
S.MonadWriter [TestEvent])
|
||||
|
||||
runTest :: Test a -> GRec -> (a, [TestEvent])
|
||||
runTest (Test m) es = S.evalRWS m () es
|
||||
|
||||
|
||||
-----------
|
||||
-- CLASS --
|
||||
-----------
|
||||
|
||||
tconst :: a -> Test a
|
||||
tconst a = Test $ return a
|
||||
|
||||
mockHandle :: InputHandle
|
||||
mockHandle = InputHandle (error "mock handle keyMvar")
|
||||
(error "mock handle threads")
|
||||
|
||||
instance MonadInput Test where
|
||||
startEvents _ = S.tell [TStartEvents] >>
|
||||
return mockHandle
|
||||
pollEvents _ = S.state getPolled
|
||||
stopEvents _ = S.tell [TStopEvents]
|
||||
|
||||
instance MonadTimer Test where
|
||||
getTime = return 1
|
||||
sleepABit _ = return ()
|
||||
|
||||
instance MonadException Test where
|
||||
cleanUpErr a _ = S.tell [TCleanUpError] >> a
|
||||
onException a _ = S.tell [TCleanUpError] >> a
|
||||
throwExc e = error . show $ e
|
||||
|
||||
instance MonadLogic Test where
|
||||
checkQuit _ _ = S.gets isOver
|
||||
|
||||
instance MonadDisplay Test where
|
||||
setupDisplay = () <$ S.tell [TSetupDisplay]
|
||||
clearDisplay = return ()
|
||||
displaySize = Test $ S.state getDims
|
||||
blitPlane _ _ = return ()
|
||||
shutdownDisplay = () <$ S.tell [TShutdownDisplay]
|
||||
@@ -1,237 +0,0 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Screen datatypes and functions
|
||||
-- 2017 Francesco Ariis GPLv3
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- a canvas where to draw our stuff
|
||||
|
||||
module Terminal.Game.Plane where
|
||||
|
||||
import Terminal.Game.Character
|
||||
|
||||
import qualified Data.Array as A
|
||||
import qualified Data.Bifunctor as B
|
||||
import qualified Data.List.Split as LS
|
||||
import qualified Data.Tuple as T
|
||||
import qualified GHC.Generics as G
|
||||
import qualified System.Console.ANSI as CA
|
||||
|
||||
|
||||
----------------
|
||||
-- DATA TYPES --
|
||||
----------------
|
||||
|
||||
-- | 'Row's and 'Column's are 1-based (top-left position is @1 1@).
|
||||
type Coords = (Row, Column)
|
||||
type Row = Int
|
||||
type Column = Int
|
||||
|
||||
-- | Size of a surface in 'Row's and 'Column's.
|
||||
type Dimensions = (Width, Height)
|
||||
|
||||
-- | Expressed in 'Column's.
|
||||
type Width = Int
|
||||
-- | Expressed in 'Row's.
|
||||
type Height = Int
|
||||
|
||||
type Bold = Bool
|
||||
type Reversed = Bool
|
||||
|
||||
-- can be an ASCIIChar or a special, transparent character
|
||||
data Cell = CellChar Char Bold
|
||||
Reversed (Maybe (CA.Color, CA.ColorIntensity))
|
||||
| Transparent
|
||||
deriving (Show, Eq, Ord, G.Generic)
|
||||
-- I found no meaningful speed improvements by making this
|
||||
-- only w/ 1 constructor.
|
||||
|
||||
-- | A two-dimensional surface (Row, Column) where to blit stuff.
|
||||
newtype Plane = Plane { fromPlane :: A.Array Coords Cell }
|
||||
deriving (Show, Eq, G.Generic)
|
||||
-- Could this be made into an UArray? Nope, since UArray is
|
||||
-- only instanced on Words, Int, Chars, etc.
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Plane interface (abstracting Array)
|
||||
|
||||
listPlane :: Coords -> [Cell] -> Plane
|
||||
listPlane (r, c) cs = Plane $ A.listArray ((1,1), (r, c)) cs
|
||||
|
||||
-- | Dimensions or a plane.
|
||||
planeSize :: Plane -> Dimensions
|
||||
planeSize p = T.swap . snd $ A.bounds (fromPlane p)
|
||||
|
||||
assocsPlane :: Plane -> [(Coords, Cell)]
|
||||
assocsPlane p = A.assocs (fromPlane p)
|
||||
|
||||
elemsPlane :: Plane -> [Cell]
|
||||
elemsPlane p = A.elems (fromPlane p)
|
||||
|
||||
-- Array.//
|
||||
updatePlane :: Plane -> [(Coords, Cell)] -> Plane
|
||||
updatePlane (Plane a) kcs = Plane $ a A.// kcs
|
||||
|
||||
-- faux map
|
||||
mapPlane :: (Cell -> Cell) -> Plane -> Plane
|
||||
mapPlane f (Plane a) = Plane $ fmap f a
|
||||
|
||||
|
||||
----------
|
||||
-- CREA --
|
||||
----------
|
||||
|
||||
creaCell :: Char -> Cell
|
||||
creaCell ch = CellChar chm False False Nothing
|
||||
where
|
||||
chm = win32SafeChar ch
|
||||
|
||||
colorCell :: CA.Color -> CA.ColorIntensity -> Cell -> Cell
|
||||
colorCell k i (CellChar c b r _) = CellChar c b r (Just (k, i))
|
||||
colorCell _ _ Transparent = Transparent
|
||||
|
||||
boldCell :: Cell -> Cell
|
||||
boldCell (CellChar c _ r k) = CellChar c True r k
|
||||
boldCell Transparent = Transparent
|
||||
|
||||
reverseCell :: Cell -> Cell
|
||||
reverseCell (CellChar c b _ k) = CellChar c b True k
|
||||
reverseCell Transparent = Transparent
|
||||
|
||||
-- | Creates 'Plane' from 'String', good way to import ASCII
|
||||
-- art/diagrams. @error@s on empty string.
|
||||
stringPlane :: String -> Plane
|
||||
stringPlane t = stringPlaneGeneric Nothing t
|
||||
|
||||
-- | Same as 'stringPlane', but with transparent 'Char'.
|
||||
-- @error@s on empty string.
|
||||
stringPlaneTrans :: Char -> String -> Plane
|
||||
stringPlaneTrans c t = stringPlaneGeneric (Just c) t
|
||||
|
||||
-- | Creates an empty, opaque 'Plane'.
|
||||
blankPlane :: Width -> Height -> Plane
|
||||
blankPlane w h = listPlane (h, w) (repeat $ creaCell ' ')
|
||||
|
||||
-- | Adds transparency to a plane, matching a given character
|
||||
makeTransparent :: Char -> Plane -> Plane
|
||||
makeTransparent tc p = mapPlane f p
|
||||
where
|
||||
f cl | cellChar cl == tc = Transparent
|
||||
| otherwise = cl
|
||||
|
||||
-- | Changes every transparent cell in the 'Plane' to an opaque @' '@
|
||||
-- character.
|
||||
makeOpaque :: Plane -> Plane
|
||||
makeOpaque p = let (w, h) = planeSize p
|
||||
in pastePlane p (blankPlane w h) (1, 1)
|
||||
|
||||
|
||||
|
||||
-----------
|
||||
-- SLICE --
|
||||
-----------
|
||||
|
||||
-- | Paste one plane over the other at a certain position (p1 gets over p2).
|
||||
pastePlane :: Plane -> Plane -> Coords -> Plane
|
||||
pastePlane p1 p2 (r, c)
|
||||
| r > h2 || c > w2 = p2
|
||||
| otherwise =
|
||||
let ks = assocsPlane p1
|
||||
fs = filter (\x -> solid x && inside x) ks
|
||||
ts = fmap (B.first trasl) fs
|
||||
in updatePlane p2 ts
|
||||
where
|
||||
trasl :: Coords -> Coords
|
||||
trasl (wr, wc) = (wr + r - 1, wc + c - 1)
|
||||
|
||||
-- inside new position, cheaper than first mapping and then
|
||||
-- filtering.
|
||||
inside (wcs, _) =
|
||||
let (r1', c1') = trasl wcs
|
||||
in r1' >= 1 && r1' <= h2 &&
|
||||
c1' >= 1 && c1' <= w2
|
||||
|
||||
solid (_, Transparent) = False
|
||||
solid _ = True
|
||||
|
||||
(w2, h2) = planeSize p2
|
||||
|
||||
-- | Cut out a plane by top-left and bottom-right coordinates.
|
||||
subPlane :: Plane -> Coords -> Coords -> Plane
|
||||
subPlane p (r1, c1) (r2, c2)
|
||||
| r1 > r2 || c1 > c2 = err (r1, c1) (r2, c2)
|
||||
| otherwise =
|
||||
let cs = assocsPlane p
|
||||
fs = filter f cs
|
||||
(pw, ph) = planeSize p
|
||||
(w, h) = (min pw (c2-c1+1), min ph (r2-r1+1))
|
||||
in listPlane (h, w) (map snd fs)
|
||||
where
|
||||
f ((rw, cw), _) = rw >= r1 && rw <= r2 &&
|
||||
cw >= c1 && cw <= c2
|
||||
|
||||
err p1 p2 = error ("subPlane: top-left point " ++ show p1 ++
|
||||
" > bottom-right point " ++ show p2 ++ ".")
|
||||
|
||||
-------------
|
||||
-- INQUIRE --
|
||||
-------------
|
||||
|
||||
cellChar :: Cell -> Char
|
||||
cellChar (CellChar c _ _ _) = c
|
||||
cellChar Transparent = ' '
|
||||
|
||||
cellColor :: Cell -> Maybe (CA.Color, CA.ColorIntensity)
|
||||
cellColor (CellChar _ _ _ k) = k
|
||||
cellColor Transparent = Nothing
|
||||
|
||||
isBold :: Cell -> Bool
|
||||
isBold (CellChar _ b _ _) = b
|
||||
isBold _ = False
|
||||
|
||||
isReversed :: Cell -> Bool
|
||||
isReversed (CellChar _ _ r _) = r
|
||||
isReversed _ = False
|
||||
|
||||
-- | A String (@\n@ divided and ended) representing the 'Plane'. Useful
|
||||
-- for debugging/testing purposes.
|
||||
planePaper :: Plane -> String
|
||||
planePaper p = unlines . LS.chunksOf w . map cellChar $ elemsPlane p
|
||||
where
|
||||
w :: Int
|
||||
w = fromIntegral . fst . planeSize $ p
|
||||
|
||||
-----------------
|
||||
-- ANCILLARIES --
|
||||
-----------------
|
||||
|
||||
stringPlaneGeneric :: Maybe Char -> String -> Plane
|
||||
stringPlaneGeneric _ "" = makeTransparent ' ' (blankPlane 1 1)
|
||||
stringPlaneGeneric mc t = vitrous
|
||||
where
|
||||
lined = lines t
|
||||
|
||||
h :: Int
|
||||
h = length lined
|
||||
|
||||
w :: Int
|
||||
w = maximum (map length lined)
|
||||
|
||||
pad :: Int -> String -> String
|
||||
pad mw tl = take mw (tl ++ repeat ' ')
|
||||
|
||||
padded :: [String]
|
||||
padded = map (pad w) lined
|
||||
|
||||
celled :: [Cell]
|
||||
celled = map creaCell . concat $ padded
|
||||
|
||||
plane :: Plane
|
||||
plane = listPlane (h, w) celled
|
||||
|
||||
vitrous :: Plane
|
||||
vitrous = case mc of
|
||||
Just c -> makeTransparent c plane
|
||||
Nothing -> plane
|
||||
|
||||
@@ -1,20 +0,0 @@
|
||||
module Terminal.Game.Random ( R.StdGen,
|
||||
R.UniformRange,
|
||||
R.getStdGen,
|
||||
R.mkStdGen,
|
||||
getRandom,
|
||||
pickRandom )
|
||||
where
|
||||
|
||||
import System.Random as R
|
||||
|
||||
|
||||
-- | Simple, pure pseudo-random generator.
|
||||
getRandom :: UniformRange a => (a, a) -> StdGen -> (a, StdGen)
|
||||
getRandom bs sg = uniformR bs sg
|
||||
|
||||
-- | Picks at random from list.
|
||||
pickRandom :: [a] -> StdGen -> (a, StdGen)
|
||||
pickRandom as sg = let l = length as
|
||||
(a, sg') = getRandom (0, l-1) sg
|
||||
in (as !! a, sg')
|
||||
@@ -1,3 +0,0 @@
|
||||
module Terminal.Game.Timer (module T) where
|
||||
|
||||
import Control.Timer.Tick as T
|
||||
@@ -1,68 +0,0 @@
|
||||
module Terminal.Game.DrawSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Terminal.Game.Plane
|
||||
import Terminal.Game.Draw
|
||||
import Terminal.Game -- language hyphenators
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
||||
describe "mergePlanes" $ do
|
||||
it "piles multiple planes together" $
|
||||
mergePlanes (stringPlane "aa")
|
||||
[((1,2), cell 'b')] `shouldBe` stringPlane "ab"
|
||||
it "works in the middle too" $
|
||||
mergePlanes (stringPlane "aaa\naaa\naaa")
|
||||
[((2,2), cell 'b')] `shouldBe`
|
||||
stringPlane "aaa\naba\naaa"
|
||||
|
||||
describe "textBox/textBoxLiquid" $ do
|
||||
let s = "las rana in Spa"
|
||||
w = 6
|
||||
ps = textBox w 2 s
|
||||
pl = textBoxLiquid w s
|
||||
it "textBox follows specific size" $
|
||||
planeSize ps `shouldBe` (6, 2)
|
||||
it "textBoxLiquid fits the whole string" $
|
||||
planeSize pl `shouldBe` (6, 3)
|
||||
it "textBox should make a transparent plane" $
|
||||
let p1 = textBox 6 1 "a c e "
|
||||
p2 = textBox 6 1 " b d f"
|
||||
pc = p1 & (1, 1) % p2
|
||||
in planePaper pc `shouldBe` "abcdef\n"
|
||||
|
||||
describe "textBoxHypen" $ do
|
||||
let tbh = textBoxHyphen spanish 8 2 "Con pianito"
|
||||
it "hyphens long words" $
|
||||
planePaper tbh `shouldSatisfy` elem '-'
|
||||
|
||||
describe "***" $ do
|
||||
let a = stringPlane ".\n.\n.\n"
|
||||
b = stringPlane "*"
|
||||
c = stringPlane ".\n*\n.\n"
|
||||
it "blits b in the centre of a" $
|
||||
a *** b `shouldBe` c
|
||||
|
||||
-- combinators
|
||||
|
||||
let sp = stringPlane "ab"
|
||||
bp = blankPlane 4 3
|
||||
|
||||
describe "%^>" $ do
|
||||
it "blits in the top right corner" $
|
||||
planePaper (bp & (1,1) %^> sp) `shouldBe` " ab\n \n \n"
|
||||
|
||||
describe "%_<" $ do
|
||||
it "blits in the bottom left corner" $
|
||||
planePaper (bp & (2,1) %.< sp) `shouldBe` " \nab \n \n"
|
||||
|
||||
describe "%_<" $ do
|
||||
it "blits in the bottom left corner" $
|
||||
planePaper (bp & (2,3) %.> sp) `shouldBe` " \nab \n \n"
|
||||
|
||||
describe "%" $ do
|
||||
it "mixes with alternative combinators" $
|
||||
planePaper (bp & (1,2) % sp & (2,3) %.> sp) `shouldBe`
|
||||
" ab \nab \n \n"
|
||||
@@ -1,54 +0,0 @@
|
||||
module Terminal.Game.Layer.ImperativeSpec where
|
||||
|
||||
import Terminal.Game.Layer.Imperative
|
||||
import Terminal.Game.Layer.Object
|
||||
import Terminal.Game.Random
|
||||
import Alone
|
||||
import Balls
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck
|
||||
|
||||
import qualified Test.QuickCheck as Q
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
||||
describe "runGame" $ do
|
||||
let nd = error "<not-defined>"
|
||||
s :: (Integer, Bool, Integer)
|
||||
s = (0, False, 0)
|
||||
lf (t, True, i) Tick = (t+1, True, i+1)
|
||||
lf (t, b, i) Tick = (t+1, b, i )
|
||||
lf (t, _, i) (KeyPress _) = (t, True, i )
|
||||
qf (3, _, _) = True
|
||||
qf _ = False
|
||||
es = [Tick, KeyPress 'c', KeyPress 'c', Tick, Tick]
|
||||
g = Game nd s (const lf) nd qf
|
||||
it "does not confuse input and logic" $
|
||||
testGame g (createGRec (80, 24) es) `shouldBe` (3, True, 2)
|
||||
|
||||
describe "testGame" $ do
|
||||
it "tests a game" $ do
|
||||
r <- readRecord "test/records/alone-record-test.gr"
|
||||
testGame aloneInARoom r `shouldBe` MyState (20, 66) Stop True
|
||||
it "picks up screen resize events" $ do
|
||||
r <- readRecord "test/records/balls-dims.gr"
|
||||
let g = fireworks (mkStdGen 1)
|
||||
t = testGame g r
|
||||
length (balls t) `shouldBe` 1
|
||||
it "picks up screen resize events" $ do
|
||||
r <- readRecord "test/records/balls-slow.gr"
|
||||
let g = fireworks (mkStdGen 1)
|
||||
t = testGame g r
|
||||
bslow t `shouldBe` True
|
||||
it "does not hang on empty/unclosed input" $
|
||||
let w = createGRec (80, 24) [Tick] in
|
||||
testGame aloneInARoom w `shouldBe` MyState (10, 10) Stop False
|
||||
modifyMaxSize (const 1000) $
|
||||
it "does not crash/hang on random input" $ Q.property $
|
||||
let genEvs = Q.listOf1 Q.arbitrary
|
||||
in Q.forAll genEvs $
|
||||
\es -> let w = createGRec (80, 24) es
|
||||
a = testGame aloneInARoom w
|
||||
in a == a
|
||||
@@ -1,59 +0,0 @@
|
||||
module Terminal.Game.PlaneSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Terminal.Game.Plane
|
||||
import Terminal.Game.Draw
|
||||
|
||||
import qualified Control.Exception as E
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
||||
let testPlane = blankPlane 2 2 &
|
||||
(1,1) % box 2 2 '.' &
|
||||
(1,2) % cell ' '
|
||||
|
||||
describe "listPlane" $ do
|
||||
it "creates a plane from string" $
|
||||
listPlane (2,2) (map creaCell ". ..") `shouldBe` testPlane
|
||||
it "ignores extra characters" $
|
||||
listPlane (2,2) (map creaCell ". ..abc") `shouldBe` testPlane
|
||||
|
||||
describe "pastePlane" $ do
|
||||
it "pastes a simple plane onto another" $
|
||||
pastePlane (cell 'a') (cell 'b') (1,1) `shouldBe` cell 'a'
|
||||
|
||||
describe "stringPlane" $ do
|
||||
it "creates plane from spec" $
|
||||
stringPlane ".\n.." `shouldBe` testPlane
|
||||
|
||||
describe "stringPlaneTrans" $ do
|
||||
it "allows transparency" $
|
||||
stringPlaneTrans '.' ".\n.." `shouldBe` makeTransparent '.' testPlane
|
||||
|
||||
describe "updatePlane" $ do
|
||||
let ma = listPlane (2,1) (map creaCell "ab")
|
||||
mb = listPlane (2,1) (map creaCell "xb")
|
||||
it "updates a Plane" $
|
||||
updatePlane ma [((1,1), creaCell 'x')] `shouldBe` mb
|
||||
|
||||
describe "subPlane" $ do
|
||||
let pa = word "prova" === word "fol"
|
||||
it "cuts out a plane" $
|
||||
planePaper (subPlane pa (1, 1) (2, 1)) `shouldBe` "p\nf\n"
|
||||
it "does not crash on OOB" $
|
||||
planeSize (subPlane pa (1, 1) (10, 10)) `shouldBe` (5, 2)
|
||||
it "errs on emptycell" $
|
||||
E.evaluate (subPlane pa (2, 3) (1, 1)) `shouldThrow`
|
||||
errorCall "subPlane: top-left point (2,3) > bottom-right point (1,1)."
|
||||
it "but not on a single cell" $
|
||||
subPlane pa (2, 3) (2, 3) `shouldBe` cell 'l'
|
||||
|
||||
describe "hcat/vcat" $ do
|
||||
let pa = blankPlane 2 1
|
||||
pb = blankPlane 3 4
|
||||
it "concats planes horizontally with hcat" $
|
||||
planeSize (hcat [pa, pb]) `shouldBe` (5, 4)
|
||||
it "concats planes horizontally with vcat" $
|
||||
planeSize (vcat [pa, pb]) `shouldBe` (3, 5)
|
||||
@@ -1,20 +0,0 @@
|
||||
module Terminal.Game.RandomSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck
|
||||
import Terminal.Game.Random
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
||||
describe "pickRandom" $ do
|
||||
prop "picks items at random from a list" $
|
||||
\i -> let g = mkStdGen i
|
||||
in fst (pickRandom ['a', 'b'] g) /= 'c'
|
||||
prop "does not exclude any item" $
|
||||
\i -> let g = mkStdGen i
|
||||
rf tg = pickRandom [1,2] tg
|
||||
rs = iterate (\(_, lg') -> rf lg') (rf g)
|
||||
ts = take 100 rs
|
||||
in sum (map fst ts) /= length ts
|
||||
@@ -1 +0,0 @@
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,10 +0,0 @@
|
||||
<svg width="71" height="55" viewBox="0 0 71 55" fill="none" xmlns="http://www.w3.org/2000/svg">
|
||||
<g clip-path="url(#clip0)">
|
||||
<path d="M60.1045 4.8978C55.5792 2.8214 50.7265 1.2916 45.6527 0.41542C45.5603 0.39851 45.468 0.440769 45.4204 0.525289C44.7963 1.6353 44.105 3.0834 43.6209 4.2216C38.1637 3.4046 32.7345 3.4046 27.3892 4.2216C26.905 3.0581 26.1886 1.6353 25.5617 0.525289C25.5141 0.443589 25.4218 0.40133 25.3294 0.41542C20.2584 1.2888 15.4057 2.8186 10.8776 4.8978C10.8384 4.9147 10.8048 4.9429 10.7825 4.9795C1.57795 18.7309 -0.943561 32.1443 0.293408 45.3914C0.299005 45.4562 0.335386 45.5182 0.385761 45.5576C6.45866 50.0174 12.3413 52.7249 18.1147 54.5195C18.2071 54.5477 18.305 54.5139 18.3638 54.4378C19.7295 52.5728 20.9469 50.6063 21.9907 48.5383C22.0523 48.4172 21.9935 48.2735 21.8676 48.2256C19.9366 47.4931 18.0979 46.6 16.3292 45.5858C16.1893 45.5041 16.1781 45.304 16.3068 45.2082C16.679 44.9293 17.0513 44.6391 17.4067 44.3461C17.471 44.2926 17.5606 44.2813 17.6362 44.3151C29.2558 49.6202 41.8354 49.6202 53.3179 44.3151C53.3935 44.2785 53.4831 44.2898 53.5502 44.3433C53.9057 44.6363 54.2779 44.9293 54.6529 45.2082C54.7816 45.304 54.7732 45.5041 54.6333 45.5858C52.8646 46.6197 51.0259 47.4931 49.0921 48.2228C48.9662 48.2707 48.9102 48.4172 48.9718 48.5383C50.038 50.6034 51.2554 52.5699 52.5959 54.435C52.6519 54.5139 52.7526 54.5477 52.845 54.5195C58.6464 52.7249 64.529 50.0174 70.6019 45.5576C70.6551 45.5182 70.6887 45.459 70.6943 45.3942C72.1747 30.0791 68.2147 16.7757 60.1968 4.9823C60.1772 4.9429 60.1437 4.9147 60.1045 4.8978ZM23.7259 37.3253C20.2276 37.3253 17.3451 34.1136 17.3451 30.1693C17.3451 26.225 20.1717 23.0133 23.7259 23.0133C27.308 23.0133 30.1626 26.2532 30.1066 30.1693C30.1066 34.1136 27.28 37.3253 23.7259 37.3253ZM47.3178 37.3253C43.8196 37.3253 40.9371 34.1136 40.9371 30.1693C40.9371 26.225 43.7636 23.0133 47.3178 23.0133C50.9 23.0133 53.7545 26.2532 53.6986 30.1693C53.6986 34.1136 50.9 37.3253 47.3178 37.3253Z" fill="#23272A"/>
|
||||
</g>
|
||||
<defs>
|
||||
<clipPath id="clip0">
|
||||
<rect width="71" height="55" fill="white"/>
|
||||
</clipPath>
|
||||
</defs>
|
||||
</svg>
|
||||
|
Before Width: | Height: | Size: 2.0 KiB |
208
www/LICENSE
208
www/LICENSE
@@ -1,208 +0,0 @@
|
||||
The ghcup website, excluding ghcup, fonts, bootstrap-haskell script are subject
|
||||
to the license below. Design, javascript and css are used from the rustup
|
||||
project: https://github.com/rust-lang/rustup.rs/tree/master/www
|
||||
|
||||
|
||||
|
||||
===============================================================================
|
||||
Apache License
|
||||
Version 2.0, January 2004
|
||||
http://www.apache.org/licenses/
|
||||
|
||||
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
|
||||
|
||||
1. Definitions.
|
||||
|
||||
"License" shall mean the terms and conditions for use, reproduction,
|
||||
and distribution as defined by Sections 1 through 9 of this document.
|
||||
|
||||
"Licensor" shall mean the copyright owner or entity authorized by
|
||||
the copyright owner that is granting the License.
|
||||
|
||||
"Legal Entity" shall mean the union of the acting entity and all
|
||||
other entities that control, are controlled by, or are under common
|
||||
control with that entity. For the purposes of this definition,
|
||||
"control" means (i) the power, direct or indirect, to cause the
|
||||
direction or management of such entity, whether by contract or
|
||||
otherwise, or (ii) ownership of fifty percent (50%) or more of the
|
||||
outstanding shares, or (iii) beneficial ownership of such entity.
|
||||
|
||||
"You" (or "Your") shall mean an individual or Legal Entity
|
||||
exercising permissions granted by this License.
|
||||
|
||||
"Source" form shall mean the preferred form for making modifications,
|
||||
including but not limited to software source code, documentation
|
||||
source, and configuration files.
|
||||
|
||||
"Object" form shall mean any form resulting from mechanical
|
||||
transformation or translation of a Source form, including but
|
||||
not limited to compiled object code, generated documentation,
|
||||
and conversions to other media types.
|
||||
|
||||
"Work" shall mean the work of authorship, whether in Source or
|
||||
Object form, made available under the License, as indicated by a
|
||||
copyright notice that is included in or attached to the work
|
||||
(an example is provided in the Appendix below).
|
||||
|
||||
"Derivative Works" shall mean any work, whether in Source or Object
|
||||
form, that is based on (or derived from) the Work and for which the
|
||||
editorial revisions, annotations, elaborations, or other modifications
|
||||
represent, as a whole, an original work of authorship. For the purposes
|
||||
of this License, Derivative Works shall not include works that remain
|
||||
separable from, or merely link (or bind by name) to the interfaces of,
|
||||
the Work and Derivative Works thereof.
|
||||
|
||||
"Contribution" shall mean any work of authorship, including
|
||||
the original version of the Work and any modifications or additions
|
||||
to that Work or Derivative Works thereof, that is intentionally
|
||||
submitted to Licensor for inclusion in the Work by the copyright owner
|
||||
or by an individual or Legal Entity authorized to submit on behalf of
|
||||
the copyright owner. For the purposes of this definition, "submitted"
|
||||
means any form of electronic, verbal, or written communication sent
|
||||
to the Licensor or its representatives, including but not limited to
|
||||
communication on electronic mailing lists, source code control systems,
|
||||
and issue tracking systems that are managed by, or on behalf of, the
|
||||
Licensor for the purpose of discussing and improving the Work, but
|
||||
excluding communication that is conspicuously marked or otherwise
|
||||
designated in writing by the copyright owner as "Not a Contribution."
|
||||
|
||||
"Contributor" shall mean Licensor and any individual or Legal Entity
|
||||
on behalf of whom a Contribution has been received by Licensor and
|
||||
subsequently incorporated within the Work.
|
||||
|
||||
2. Grant of Copyright License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
copyright license to reproduce, prepare Derivative Works of,
|
||||
publicly display, publicly perform, sublicense, and distribute the
|
||||
Work and such Derivative Works in Source or Object form.
|
||||
|
||||
3. Grant of Patent License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
(except as stated in this section) patent license to make, have made,
|
||||
use, offer to sell, sell, import, and otherwise transfer the Work,
|
||||
where such license applies only to those patent claims licensable
|
||||
by such Contributor that are necessarily infringed by their
|
||||
Contribution(s) alone or by combination of their Contribution(s)
|
||||
with the Work to which such Contribution(s) was submitted. If You
|
||||
institute patent litigation against any entity (including a
|
||||
cross-claim or counterclaim in a lawsuit) alleging that the Work
|
||||
or a Contribution incorporated within the Work constitutes direct
|
||||
or contributory patent infringement, then any patent licenses
|
||||
granted to You under this License for that Work shall terminate
|
||||
as of the date such litigation is filed.
|
||||
|
||||
4. Redistribution. You may reproduce and distribute copies of the
|
||||
Work or Derivative Works thereof in any medium, with or without
|
||||
modifications, and in Source or Object form, provided that You
|
||||
meet the following conditions:
|
||||
|
||||
(a) You must give any other recipients of the Work or
|
||||
Derivative Works a copy of this License; and
|
||||
|
||||
(b) You must cause any modified files to carry prominent notices
|
||||
stating that You changed the files; and
|
||||
|
||||
(c) You must retain, in the Source form of any Derivative Works
|
||||
that You distribute, all copyright, patent, trademark, and
|
||||
attribution notices from the Source form of the Work,
|
||||
excluding those notices that do not pertain to any part of
|
||||
the Derivative Works; and
|
||||
|
||||
(d) If the Work includes a "NOTICE" text file as part of its
|
||||
distribution, then any Derivative Works that You distribute must
|
||||
include a readable copy of the attribution notices contained
|
||||
within such NOTICE file, excluding those notices that do not
|
||||
pertain to any part of the Derivative Works, in at least one
|
||||
of the following places: within a NOTICE text file distributed
|
||||
as part of the Derivative Works; within the Source form or
|
||||
documentation, if provided along with the Derivative Works; or,
|
||||
within a display generated by the Derivative Works, if and
|
||||
wherever such third-party notices normally appear. The contents
|
||||
of the NOTICE file are for informational purposes only and
|
||||
do not modify the License. You may add Your own attribution
|
||||
notices within Derivative Works that You distribute, alongside
|
||||
or as an addendum to the NOTICE text from the Work, provided
|
||||
that such additional attribution notices cannot be construed
|
||||
as modifying the License.
|
||||
|
||||
You may add Your own copyright statement to Your modifications and
|
||||
may provide additional or different license terms and conditions
|
||||
for use, reproduction, or distribution of Your modifications, or
|
||||
for any such Derivative Works as a whole, provided Your use,
|
||||
reproduction, and distribution of the Work otherwise complies with
|
||||
the conditions stated in this License.
|
||||
|
||||
5. Submission of Contributions. Unless You explicitly state otherwise,
|
||||
any Contribution intentionally submitted for inclusion in the Work
|
||||
by You to the Licensor shall be under the terms and conditions of
|
||||
this License, without any additional terms or conditions.
|
||||
Notwithstanding the above, nothing herein shall supersede or modify
|
||||
the terms of any separate license agreement you may have executed
|
||||
with Licensor regarding such Contributions.
|
||||
|
||||
6. Trademarks. This License does not grant permission to use the trade
|
||||
names, trademarks, service marks, or product names of the Licensor,
|
||||
except as required for reasonable and customary use in describing the
|
||||
origin of the Work and reproducing the content of the NOTICE file.
|
||||
|
||||
7. Disclaimer of Warranty. Unless required by applicable law or
|
||||
agreed to in writing, Licensor provides the Work (and each
|
||||
Contributor provides its Contributions) on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
|
||||
implied, including, without limitation, any warranties or conditions
|
||||
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
|
||||
PARTICULAR PURPOSE. You are solely responsible for determining the
|
||||
appropriateness of using or redistributing the Work and assume any
|
||||
risks associated with Your exercise of permissions under this License.
|
||||
|
||||
8. Limitation of Liability. In no event and under no legal theory,
|
||||
whether in tort (including negligence), contract, or otherwise,
|
||||
unless required by applicable law (such as deliberate and grossly
|
||||
negligent acts) or agreed to in writing, shall any Contributor be
|
||||
liable to You for damages, including any direct, indirect, special,
|
||||
incidental, or consequential damages of any character arising as a
|
||||
result of this License or out of the use or inability to use the
|
||||
Work (including but not limited to damages for loss of goodwill,
|
||||
work stoppage, computer failure or malfunction, or any and all
|
||||
other commercial damages or losses), even if such Contributor
|
||||
has been advised of the possibility of such damages.
|
||||
|
||||
9. Accepting Warranty or Additional Liability. While redistributing
|
||||
the Work or Derivative Works thereof, You may choose to offer,
|
||||
and charge a fee for, acceptance of support, warranty, indemnity,
|
||||
or other liability obligations and/or rights consistent with this
|
||||
License. However, in accepting such obligations, You may act only
|
||||
on Your own behalf and on Your sole responsibility, not on behalf
|
||||
of any other Contributor, and only if You agree to indemnify,
|
||||
defend, and hold each Contributor harmless for any liability
|
||||
incurred by, or claims asserted against, such Contributor by reason
|
||||
of your accepting any such warranty or additional liability.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
APPENDIX: How to apply the Apache License to your work.
|
||||
|
||||
To apply the Apache License to your work, attach the following
|
||||
boilerplate notice, with the fields enclosed by brackets "[]"
|
||||
replaced with your own identifying information. (Don't include
|
||||
the brackets!) The text should be enclosed in the appropriate
|
||||
comment syntax for the file format. We also recommend that a
|
||||
file or class name and description of purpose be included on the
|
||||
same "printed page" as the copyright notice for easier
|
||||
identification within third-party archives.
|
||||
|
||||
Copyright [yyyy] [name of copyright owner]
|
||||
|
||||
Licensed under the Apache License, Version 2.0 (the "License");
|
||||
you may not use this file except in compliance with the License.
|
||||
You may obtain a copy of the License at
|
||||
|
||||
http://www.apache.org/licenses/LICENSE-2.0
|
||||
|
||||
Unless required by applicable law or agreed to in writing, software
|
||||
distributed under the License is distributed on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
See the License for the specific language governing permissions and
|
||||
limitations under the License.
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user