Compare commits
1 Commits
advance-in
...
bump-versi
| Author | SHA1 | Date | |
|---|---|---|---|
| 8573db904e |
28
.cirrus.yml
Normal file
28
.cirrus.yml
Normal file
@@ -0,0 +1,28 @@
|
||||
freebsd_instance:
|
||||
image_family: freebsd-13-2
|
||||
|
||||
build_task:
|
||||
name: build
|
||||
env:
|
||||
GHC_VER: 9.4.8
|
||||
CABAL_VER: 3.10.2.0
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
ARCH: 64
|
||||
RUNNER_OS: FreeBSD
|
||||
DISTRO: na
|
||||
GITHUB_WORKSPACE: ${CIRRUS_WORKING_DIR}
|
||||
JSON_VERSION: "0.0.7"
|
||||
CIRRUS_CLONE_SUBMODULES: true
|
||||
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
|
||||
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
|
||||
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
|
||||
install_script:
|
||||
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
|
||||
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
|
||||
script:
|
||||
- tzsetup Etc/GMT
|
||||
- adjkerntz -a
|
||||
- bash .github/scripts/build.sh
|
||||
- bash .github/scripts/test.sh
|
||||
binaries_artifacts:
|
||||
path: "out/*"
|
||||
4
.github/scripts/env.sh
vendored
4
.github/scripts/env.sh
vendored
@@ -9,10 +9,6 @@ fi
|
||||
export DEBIAN_FRONTEND=noninteractive
|
||||
export TZ=Asia/Singapore
|
||||
|
||||
if [ "${RUNNER_OS}" = "freebsd" ] ; then
|
||||
export RUNNER_OS=FreeBSD
|
||||
fi
|
||||
|
||||
export OS="$RUNNER_OS"
|
||||
export PATH="$HOME/.local/bin:$PATH"
|
||||
|
||||
|
||||
6
.github/scripts/test.sh
vendored
6
.github/scripts/test.sh
vendored
@@ -39,12 +39,6 @@ rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
# test PATH on windows wrt msys2
|
||||
# https://github.com/haskell/ghcup-hs/pull/992/checks
|
||||
if [ "${OS}" = "Windows" ] ; then
|
||||
eghcup run -m -- sh -c 'echo $PATH' | sed 's/:/\n/' | grep '^/mingw64/bin$'
|
||||
fi
|
||||
|
||||
eghcup install ghc "${GHC_VER}"
|
||||
eghcup unset ghc "${GHC_VER}"
|
||||
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
|
||||
|
||||
4
.github/workflows/bootstrap.yaml
vendored
4
.github/workflows/bootstrap.yaml
vendored
@@ -52,9 +52,7 @@ jobs:
|
||||
- if: runner.os == 'Windows'
|
||||
name: Run bootstrap
|
||||
run: |
|
||||
$ErrorActionPreference = [System.Management.Automation.ActionPreference]::Stop
|
||||
$curDir = Get-Location
|
||||
Write-Host "Current Working Directory: $curDir"
|
||||
./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash -Msys2Env "MINGW64"
|
||||
./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash
|
||||
shell: pwsh
|
||||
|
||||
|
||||
2
.github/workflows/cross.yaml
vendored
2
.github/workflows/cross.yaml
vendored
@@ -19,7 +19,7 @@ env:
|
||||
jobs:
|
||||
build:
|
||||
name: Build linux binary
|
||||
runs-on: [self-hosted, Linux, X64, maerwald]
|
||||
runs-on: ubuntu-latest
|
||||
env:
|
||||
CABAL_VER: 3.10.1.0
|
||||
JSON_VERSION: "0.0.7"
|
||||
|
||||
2
.github/workflows/docker.yaml
vendored
2
.github/workflows/docker.yaml
vendored
@@ -57,7 +57,6 @@ jobs:
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
name: Cleanup (aarch64 linux)
|
||||
continue-on-error: true
|
||||
with:
|
||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||
|
||||
@@ -94,7 +93,6 @@ jobs:
|
||||
steps:
|
||||
- uses: docker://arm64v8/ubuntu:focal
|
||||
name: Cleanup (aarch64 linux)
|
||||
continue-on-error: true
|
||||
with:
|
||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||
|
||||
|
||||
83
.github/workflows/release.yaml
vendored
83
.github/workflows/release.yaml
vendored
@@ -103,6 +103,11 @@ jobs:
|
||||
GHC_VER: 9.4.8
|
||||
ARCH: ARM64
|
||||
steps:
|
||||
- uses: docker://arm64v8/debian:10
|
||||
name: Cleanup (aarch64 linux)
|
||||
with:
|
||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||
|
||||
- name: git config
|
||||
run: |
|
||||
git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*"
|
||||
@@ -241,42 +246,6 @@ jobs:
|
||||
path: |
|
||||
./out/*
|
||||
|
||||
build-freebsd:
|
||||
name: Build binary (FreeBSD)
|
||||
runs-on: [self-hosted, FreeBSD, X64]
|
||||
env:
|
||||
CABAL_VER: 3.10.2.0
|
||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||
JSON_VERSION: "0.0.8"
|
||||
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||
S3_HOST: ${{ secrets.S3_HOST }}
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
GHC_VER: 9.4.8
|
||||
ARCH: 64
|
||||
DISTRO: na
|
||||
RUNNER_OS: FreeBSD
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
submodules: 'true'
|
||||
|
||||
- name: Run build
|
||||
run: |
|
||||
sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
|
||||
pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14 libiconv
|
||||
tzsetup Etc/GMT
|
||||
adjkerntz -a
|
||||
bash .github/scripts/build.sh
|
||||
- if: always()
|
||||
name: Upload artifact
|
||||
uses: actions/upload-artifact@v3
|
||||
with:
|
||||
name: artifacts
|
||||
path: |
|
||||
./out/*
|
||||
|
||||
test-linux:
|
||||
name: Test linux
|
||||
needs: "build-linux"
|
||||
@@ -377,6 +346,11 @@ jobs:
|
||||
DISTRO: Ubuntu
|
||||
|
||||
steps:
|
||||
- uses: docker://arm64v8/debian:10
|
||||
name: Cleanup (aarch64 linux)
|
||||
with:
|
||||
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
|
||||
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
@@ -493,41 +467,6 @@ jobs:
|
||||
name: testfiles
|
||||
path: |
|
||||
./test/ghcup-test/golden/unix/GHCupInfo*json
|
||||
test-freebsd:
|
||||
name: Test FreeBSD
|
||||
needs: "build-freebsd"
|
||||
runs-on: [self-hosted, FreeBSD, X64]
|
||||
env:
|
||||
CABAL_VER: 3.10.2.0
|
||||
MACOSX_DEPLOYMENT_TARGET: 10.13
|
||||
JSON_VERSION: "0.0.8"
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
GHC_VER: 9.4.8
|
||||
ARCH: 64
|
||||
DISTRO: na
|
||||
RUNNER_OS: FreeBSD
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
submodules: 'true'
|
||||
|
||||
- uses: actions/download-artifact@v3
|
||||
with:
|
||||
name: artifacts
|
||||
path: ./out
|
||||
|
||||
- name: Run test
|
||||
run: |
|
||||
bash .github/scripts/test.sh
|
||||
|
||||
- if: failure()
|
||||
name: Upload artifact
|
||||
uses: actions/upload-artifact@v3
|
||||
with:
|
||||
name: testfiles
|
||||
path: |
|
||||
./test/ghcup-test/golden/unix/GHCupInfo*json
|
||||
hls:
|
||||
name: hls
|
||||
needs: build-linux
|
||||
@@ -561,7 +500,7 @@ jobs:
|
||||
|
||||
release:
|
||||
name: release
|
||||
needs: ["test-linux", "test-arm", "test-macwin", "test-freebsd", "hls"]
|
||||
needs: ["test-linux", "test-arm", "test-macwin", "hls"]
|
||||
runs-on: ubuntu-latest
|
||||
if: startsWith(github.ref, 'refs/tags/v')
|
||||
steps:
|
||||
|
||||
689
.gitlab-ci.yml
Normal file
689
.gitlab-ci.yml
Normal file
@@ -0,0 +1,689 @@
|
||||
stages:
|
||||
- checks
|
||||
- quick-test
|
||||
- test
|
||||
- expensive-test
|
||||
- release
|
||||
|
||||
variables:
|
||||
GIT_SSL_NO_VERIFY: "1"
|
||||
|
||||
# Commit of ghc/ci-images repository from which to pull Docker images
|
||||
DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11
|
||||
|
||||
# Sequential version number of all cached things.
|
||||
# Bump to invalidate GitLab CI cache.
|
||||
CACHE_REV: 1
|
||||
|
||||
GIT_SUBMODULE_STRATEGY: recursive
|
||||
|
||||
|
||||
############################################################
|
||||
# CI Step
|
||||
############################################################
|
||||
|
||||
.debian:
|
||||
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
|
||||
tags:
|
||||
- x86_64-linux
|
||||
variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
CROSS: ""
|
||||
|
||||
.alpine:64bit:
|
||||
image: "alpine:3.12"
|
||||
tags:
|
||||
- x86_64-linux
|
||||
variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.alpine:32bit:
|
||||
image: "i386/alpine:3.12"
|
||||
tags:
|
||||
- x86_64-linux
|
||||
variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "32"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.linux:armv7:
|
||||
image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV"
|
||||
tags:
|
||||
- armv7-linux
|
||||
variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "ARM"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
retry: 2
|
||||
|
||||
.linux:aarch64:
|
||||
image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV"
|
||||
tags:
|
||||
- aarch64-linux
|
||||
variables:
|
||||
OS: "LINUX"
|
||||
ARCH: "ARM64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.darwin:
|
||||
tags:
|
||||
- x86_64-darwin
|
||||
variables:
|
||||
OS: "DARWIN"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.darwin:aarch64:
|
||||
tags:
|
||||
- aarch64-darwin-m1
|
||||
variables:
|
||||
OS: "DARWIN"
|
||||
ARCH: "ARM64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.freebsd13:
|
||||
tags:
|
||||
- x86_64-freebsd13
|
||||
variables:
|
||||
OS: "FREEBSD"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.freebsd12:
|
||||
tags:
|
||||
- x86_64-freebsd12
|
||||
variables:
|
||||
OS: "FREEBSD"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
|
||||
.windows:
|
||||
tags:
|
||||
- new-x86_64-windows
|
||||
variables:
|
||||
OS: "WINDOWS"
|
||||
ARCH: "64"
|
||||
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
|
||||
retry: 2
|
||||
|
||||
.root_cleanup:
|
||||
after_script:
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:
|
||||
script:
|
||||
- bash ./.gitlab/script/ghcup_version.sh
|
||||
variables:
|
||||
JSON_VERSION: "0.0.7"
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
- test/golden
|
||||
- dist-newstyle/cache/
|
||||
when: on_failure
|
||||
cache:
|
||||
key: ghcup-test-$CACHE_REV
|
||||
paths:
|
||||
- cabal-cache
|
||||
|
||||
# .test_ghcup_scoop:
|
||||
# script:
|
||||
# - cl /O1 scoop-better-shimexe/shim.c
|
||||
|
||||
.test_ghcup_version:linux:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .debian
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:linux32:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .alpine:32bit
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:armv7:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .linux:armv7
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:aarch64:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .linux:aarch64
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:darwin:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .darwin
|
||||
before_script:
|
||||
- ./.gitlab/before_script/darwin/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:darwin:aarch64:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .darwin:aarch64
|
||||
cache:
|
||||
key: darwin-brew-$CACHE_REV
|
||||
paths:
|
||||
- brew_cache
|
||||
key: ghcup-test-$CACHE_REV
|
||||
paths:
|
||||
- cabal-cache
|
||||
before_script:
|
||||
# extract brew cache
|
||||
- ./.gitlab/script/ci.sh extract_brew_cache
|
||||
# otherwise we seem to get intel binaries
|
||||
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
|
||||
# update and install packages
|
||||
- /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake coreutils
|
||||
# extract cabal cache
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
script: |
|
||||
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
|
||||
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
|
||||
export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
|
||||
export LD=ld
|
||||
export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
|
||||
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
|
||||
./.gitlab/before_script/darwin/install_deps.sh
|
||||
./.gitlab/script/ghcup_version.sh
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- ./.gitlab/script/ci.sh save_brew_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:freebsd12:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .freebsd12
|
||||
before_script:
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:freebsd13:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .freebsd13
|
||||
before_script:
|
||||
- sudo pkg update
|
||||
- sudo pkg install --yes compat12x-amd64
|
||||
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
.test_ghcup_version:windows:
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .windows
|
||||
before_script:
|
||||
- bash ./.gitlab/before_script/windows/install_deps.sh
|
||||
- bash ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
after_script:
|
||||
- bash ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- bash ./.gitlab/after_script.sh
|
||||
|
||||
# .test_ghcup_scoop:windows:
|
||||
# extends:
|
||||
# - .windows
|
||||
# - .test_ghcup_scoop
|
||||
|
||||
.release_ghcup:
|
||||
script:
|
||||
- bash ./.gitlab/script/ghcup_release.sh
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
- out
|
||||
- dist-newstyle/cache/
|
||||
only:
|
||||
- tags
|
||||
variables:
|
||||
JSON_VERSION: "0.0.7"
|
||||
|
||||
######## stack test ########
|
||||
|
||||
test:linux:stack:
|
||||
stage: test
|
||||
before_script:
|
||||
- ./.gitlab/script/ci.sh extract_stack_cache
|
||||
- ./.gitlab/before_script/linux/install_deps_minimal.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_stack.sh
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_stack_cache
|
||||
extends:
|
||||
- .debian
|
||||
needs: []
|
||||
|
||||
######## bootstrap test ########
|
||||
|
||||
test:linux:bootstrap_script:
|
||||
stage: quick-test
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps_minimal.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_bootstrap.sh
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
extends:
|
||||
- .debian
|
||||
- .root_cleanup
|
||||
needs: []
|
||||
|
||||
test:windows:bootstrap_powershell_script:
|
||||
stage: quick-test
|
||||
script:
|
||||
- ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash
|
||||
after_script:
|
||||
- "[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)"
|
||||
- "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)"
|
||||
- "[Environment]::SetEnvironmentVariable('CABAL_DIR', $null, [System.EnvironmentVariableTarget]::User)"
|
||||
- bash ./.gitlab/after_script.sh
|
||||
- bash ./.gitlab/script/ci.sh save_cabal_cache
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
extends:
|
||||
- .windows
|
||||
needs: []
|
||||
|
||||
######## linux test ########
|
||||
|
||||
test:linux:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:linux
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
|
||||
test:linux:hls:
|
||||
stage: expensive-test
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .debian
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
HLS_TARGET_VERSION: "1.4.0"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
when: manual
|
||||
allow_failure: true
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_hls.sh
|
||||
|
||||
test:linux:cross-armv7:
|
||||
stage: expensive-test
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .debian
|
||||
variables:
|
||||
GHC_VERSION: "8.10.6"
|
||||
GHC_TARGET_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CROSS: "arm-linux-gnueabihf"
|
||||
needs: []
|
||||
when: manual
|
||||
allow_failure: true
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_cross.sh
|
||||
|
||||
test:linux:git:hadrian:
|
||||
stage: expensive-test
|
||||
extends:
|
||||
- .test_ghcup_version
|
||||
- .debian
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
GHC_GIT_TAG: "ghc-9.0.1-release"
|
||||
GHC_GIT_VERSION: "9.0.1"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CROSS: ""
|
||||
needs: []
|
||||
when: manual
|
||||
allow_failure: true
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
script:
|
||||
- ./.gitlab/script/ghcup_git.sh
|
||||
|
||||
|
||||
######## linux 32bit test ########
|
||||
|
||||
test:linux:32bit:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:linux32
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
|
||||
######## arm tests ########
|
||||
|
||||
test:linux:armv7:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:armv7
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CROSS: ""
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
test:linux:aarch64:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:aarch64
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CROSS: ""
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
######## darwin test ########
|
||||
|
||||
test:mac:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:darwin
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
|
||||
test:mac:aarch64:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:darwin:aarch64
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
allow_failure: true
|
||||
when: manual
|
||||
|
||||
|
||||
######## freebsd test ########
|
||||
|
||||
test:freebsd12:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:freebsd12
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
allow_failure: true # freebsd runners are unreliable
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
test:freebsd13:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:freebsd13
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
allow_failure: true # freebsd runners are unreliable
|
||||
when: manual
|
||||
needs: []
|
||||
|
||||
######## windows test ########
|
||||
|
||||
test:windows:
|
||||
stage: test
|
||||
extends: .test_ghcup_version:windows
|
||||
variables:
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
|
||||
# test:windows:scoop:
|
||||
# stage: test
|
||||
# extends: .test_ghcup_scoop:windows
|
||||
# needs: []
|
||||
|
||||
######## linux release ########
|
||||
|
||||
release:linux:64bit:
|
||||
stage: release
|
||||
needs: ["test:linux"]
|
||||
extends:
|
||||
- .alpine:64bit
|
||||
- .release_ghcup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-linux-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
|
||||
|
||||
release:linux:32bit:
|
||||
stage: release
|
||||
needs: ["test:linux:32bit"]
|
||||
extends:
|
||||
- .alpine:32bit
|
||||
- .release_ghcup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "i386-linux-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
|
||||
release:linux:armv7:
|
||||
stage: release
|
||||
needs: ["test:linux:armv7"]
|
||||
extends:
|
||||
- .linux:armv7
|
||||
- .release_ghcup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "armv7-linux-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CROSS: ""
|
||||
|
||||
release:linux:aarch64:
|
||||
stage: release
|
||||
needs: ["test:linux:aarch64"]
|
||||
extends:
|
||||
- .linux:aarch64
|
||||
- .release_ghcup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "aarch64-linux-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
CROSS: ""
|
||||
|
||||
######## darwin release ########
|
||||
|
||||
release:darwin:
|
||||
stage: release
|
||||
needs: ["test:mac"]
|
||||
extends:
|
||||
- .darwin
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/darwin/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-apple-darwin-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
MACOSX_DEPLOYMENT_TARGET: "10.7"
|
||||
|
||||
release:darwin:aarch64:
|
||||
stage: release
|
||||
needs: ["test:mac:aarch64"]
|
||||
extends:
|
||||
- .darwin:aarch64
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
cache:
|
||||
key: darwin-brew-$CACHE_REV
|
||||
paths:
|
||||
- brew_cache
|
||||
key: ghcup-test-$CACHE_REV
|
||||
paths:
|
||||
- cabal-cache
|
||||
before_script:
|
||||
- ./.gitlab/script/ci.sh extract_brew_cache
|
||||
- ./.gitlab/script/ci.sh extract_cabal_cache
|
||||
# otherwise we seem to get intel binaries
|
||||
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
|
||||
# update and install packages
|
||||
- /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake coreutils
|
||||
script: |
|
||||
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
|
||||
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
|
||||
export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
|
||||
export LD=ld
|
||||
export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
|
||||
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
|
||||
./.gitlab/before_script/darwin/install_deps.sh
|
||||
./.gitlab/script/ghcup_release.sh
|
||||
after_script:
|
||||
- ./.gitlab/script/ci.sh save_cabal_cache
|
||||
- ./.gitlab/script/ci.sh save_brew_cache
|
||||
variables:
|
||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
MACOSX_DEPLOYMENT_TARGET: "10.7"
|
||||
allow_failure: true
|
||||
when: manual
|
||||
|
||||
|
||||
######## freebsd release ########
|
||||
|
||||
release:freebsd12:
|
||||
stage: release
|
||||
needs: ["test:freebsd12"]
|
||||
extends:
|
||||
- .freebsd12
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
allow_failure: true
|
||||
|
||||
release:freebsd13:
|
||||
stage: release
|
||||
needs: ["test:freebsd13"]
|
||||
extends:
|
||||
- .freebsd13
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- sudo pkg update
|
||||
- sudo pkg install --yes compat12x-amd64
|
||||
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
allow_failure: true
|
||||
|
||||
######## windows release ########
|
||||
|
||||
release:windows:
|
||||
stage: release
|
||||
needs: ["test:windows"]
|
||||
extends:
|
||||
- .windows
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- bash ./.gitlab/before_script/windows/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-mingw64-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
|
||||
######## hlint ########
|
||||
|
||||
hlint:
|
||||
stage: checks
|
||||
extends:
|
||||
- .debian
|
||||
script:
|
||||
- curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
|
||||
allow_failure: true
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
- report.html
|
||||
when: on_failure
|
||||
|
||||
######## mkdocs ########
|
||||
|
||||
mkdocs:
|
||||
stage: checks
|
||||
extends:
|
||||
- .debian
|
||||
before_script:
|
||||
- sudo apt-get update -y
|
||||
- sudo apt-get install -y python3-pip
|
||||
- pip3 install mkdocs
|
||||
script:
|
||||
- ~/.local/bin/mkdocs build
|
||||
allow_failure: true
|
||||
|
||||
######## shellcheck ########
|
||||
|
||||
shellcheck:
|
||||
image: "koalaman/shellcheck-alpine"
|
||||
tags:
|
||||
- x86_64-linux
|
||||
stage: checks
|
||||
script:
|
||||
- shellcheck scripts/bootstrap/bootstrap-haskell
|
||||
allow_failure: true
|
||||
|
||||
19
.gitlab/after_script.sh
Normal file
19
.gitlab/after_script.sh
Normal file
@@ -0,0 +1,19 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
BUILD_DIR=$CI_PROJECT_DIR
|
||||
echo "Cleaning $BUILD_DIR"
|
||||
cd $HOME
|
||||
test -n "$BUILD_DIR"
|
||||
shopt -s extglob
|
||||
rm -Rf "$BUILD_DIR"/!(out)
|
||||
if [ "${OS}" = "WINDOWS" ] ; then
|
||||
rm -Rf /c/ghcup
|
||||
fi
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
rm -Rf /private/tmp/.brew_tmp
|
||||
fi
|
||||
|
||||
exit 0
|
||||
32
.gitlab/before_script/darwin/install_deps.sh
Executable file
32
.gitlab/before_script/darwin/install_deps.sh
Executable file
@@ -0,0 +1,32 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
if [ $ARCH = 'ARM64' ] ; then
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/aarch64-apple-darwin-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
else
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
./ghcup-bin upgrade -i -f
|
||||
fi
|
||||
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin set ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
if [ $ARCH = 'ARM64' ] ; then
|
||||
cabal update
|
||||
mkdir vendored
|
||||
cd vendored
|
||||
cabal unpack network-3.1.2.1
|
||||
cd network*
|
||||
autoreconf -fi
|
||||
cd ../..
|
||||
fi
|
||||
|
||||
exit 0
|
||||
27
.gitlab/before_script/freebsd/install_deps.sh
Executable file
27
.gitlab/before_script/freebsd/install_deps.sh
Executable file
@@ -0,0 +1,27 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
# pkg install --force --yes --no-repo-update curl gcc gmp gmake ncurses perl5 libffi libiconv
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
if freebsd-version | grep -E '^12.*' ; then
|
||||
freebsd_ver=12
|
||||
elif freebsd-version | grep -E '^13.*' ; then
|
||||
freebsd_ver=13
|
||||
else
|
||||
(>&2 echo "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues")
|
||||
exit 1
|
||||
fi
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-freebsd${freebsd_ver}-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin -v upgrade -i -f
|
||||
./ghcup-bin -v install ${GHC_VERSION}
|
||||
./ghcup-bin -v set ${GHC_VERSION}
|
||||
./ghcup-bin -v install-cabal ${CABAL_VERSION}
|
||||
|
||||
exit 0
|
||||
58
.gitlab/before_script/linux/alpine/install_deps.sh
Executable file
58
.gitlab/before_script/linux/alpine/install_deps.sh
Executable file
@@ -0,0 +1,58 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../../ghcup_env"
|
||||
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
apk add --no-cache \
|
||||
curl \
|
||||
gcc \
|
||||
g++ \
|
||||
binutils \
|
||||
binutils-gold \
|
||||
bsd-compat-headers \
|
||||
gmp-dev \
|
||||
ncurses-dev \
|
||||
libffi-dev \
|
||||
make \
|
||||
xz \
|
||||
tar \
|
||||
perl
|
||||
|
||||
if [ "${ARCH}" = "32" ] ; then
|
||||
curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin
|
||||
else
|
||||
curl -sSfL https://downloads.haskell.org/ghcup/x86_64-linux-ghcup > ./ghcup-bin
|
||||
fi
|
||||
chmod +x ghcup-bin
|
||||
./ghcup-bin upgrade -i -f
|
||||
./ghcup-bin install ${GHC_VERSION}
|
||||
./ghcup-bin install-cabal ${CABAL_VERSION}
|
||||
|
||||
# utils
|
||||
apk add --no-cache \
|
||||
bash \
|
||||
git
|
||||
|
||||
## Package specific
|
||||
apk add --no-cache \
|
||||
zlib \
|
||||
zlib-dev \
|
||||
zlib-static \
|
||||
bzip2 \
|
||||
bzip2-dev \
|
||||
bzip2-static \
|
||||
gmp \
|
||||
gmp-dev \
|
||||
openssl-dev \
|
||||
openssl-libs-static \
|
||||
xz \
|
||||
xz-dev \
|
||||
ncurses-static
|
||||
|
||||
if [ "${ARCH}" = "32" ] ; then
|
||||
apk add --no-cache \
|
||||
bsd-compat-headers
|
||||
fi
|
||||
27
.gitlab/before_script/linux/install_deps.sh
Executable file
27
.gitlab/before_script/linux/install_deps.sh
Executable file
@@ -0,0 +1,27 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential
|
||||
|
||||
if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
|
||||
sudo apt-get install -y gcc-arm-linux-gnueabihf
|
||||
sudo dpkg --add-architecture armhf
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libncurses-dev:armhf
|
||||
fi
|
||||
|
||||
export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
|
||||
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
|
||||
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
|
||||
export BOOTSTRAP_HASKELL_VERBOSE=1
|
||||
|
||||
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
||||
|
||||
rm "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
|
||||
|
||||
10
.gitlab/before_script/linux/install_deps_minimal.sh
Executable file
10
.gitlab/before_script/linux/install_deps_minimal.sh
Executable file
@@ -0,0 +1,10 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget
|
||||
21
.gitlab/before_script/windows/install_deps.sh
Normal file
21
.gitlab/before_script/windows/install_deps.sh
Normal file
@@ -0,0 +1,21 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||
|
||||
mkdir -p "${TMPDIR}" "${CABAL_DIR}"
|
||||
|
||||
mkdir -p "$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
curl -o ghcup.exe https://downloads.haskell.org/~ghcup/x86_64-mingw64-ghcup.exe
|
||||
chmod +x ghcup.exe
|
||||
|
||||
./ghcup.exe install ${GHC_VERSION}
|
||||
./ghcup.exe set ${GHC_VERSION}
|
||||
./ghcup.exe install-cabal ${CABAL_VERSION}
|
||||
|
||||
rm ./ghcup.exe
|
||||
|
||||
exit 0
|
||||
8734
.gitlab/ghc-8.10.3-linux.files
Normal file
8734
.gitlab/ghc-8.10.3-linux.files
Normal file
File diff suppressed because it is too large
Load Diff
10321
.gitlab/ghc-8.10.3-windows.files
Normal file
10321
.gitlab/ghc-8.10.3-windows.files
Normal file
File diff suppressed because it is too large
Load Diff
37
.gitlab/ghcup-run.files
Normal file
37
.gitlab/ghcup-run.files
Normal file
@@ -0,0 +1,37 @@
|
||||
.
|
||||
./cabal
|
||||
./ghc
|
||||
./ghc-8.10.7
|
||||
./ghc-pkg
|
||||
./ghc-pkg-8.10.7
|
||||
./ghci
|
||||
./ghci-8.10.7
|
||||
./haddock
|
||||
./haddock-8.10.7
|
||||
./haskell-language-server-8.10.6
|
||||
./haskell-language-server-8.10.6~1.6.1.0
|
||||
./haskell-language-server-8.10.7
|
||||
./haskell-language-server-8.10.7~1.6.1.0
|
||||
./haskell-language-server-8.6.5
|
||||
./haskell-language-server-8.6.5~1.6.1.0
|
||||
./haskell-language-server-8.8.4
|
||||
./haskell-language-server-8.8.4~1.6.1.0
|
||||
./haskell-language-server-9.0.1
|
||||
./haskell-language-server-9.0.1~1.6.1.0
|
||||
./haskell-language-server-9.0.2
|
||||
./haskell-language-server-9.0.2~1.6.1.0
|
||||
./haskell-language-server-9.2.1
|
||||
./haskell-language-server-9.2.1~1.6.1.0
|
||||
./haskell-language-server-wrapper
|
||||
./haskell-language-server-wrapper-1.6.1.0
|
||||
./hp2ps
|
||||
./hp2ps-8.10.7
|
||||
./hpc
|
||||
./hpc-8.10.7
|
||||
./hsc2hs
|
||||
./hsc2hs-8.10.7
|
||||
./runghc
|
||||
./runghc-8.10.7
|
||||
./runhaskell
|
||||
./runhaskell-8.10.7
|
||||
./stack
|
||||
81
.gitlab/ghcup-run.files.windows
Normal file
81
.gitlab/ghcup-run.files.windows
Normal file
@@ -0,0 +1,81 @@
|
||||
.
|
||||
./cabal.exe
|
||||
./cabal.shim
|
||||
./ghc-8.10.7.exe
|
||||
./ghc-8.10.7.shim
|
||||
./ghc-pkg-8.10.7.exe
|
||||
./ghc-pkg-8.10.7.shim
|
||||
./ghc-pkg.exe
|
||||
./ghc-pkg.shim
|
||||
./ghc.exe
|
||||
./ghc.shim
|
||||
./ghci-8.10.7.exe
|
||||
./ghci-8.10.7.shim
|
||||
./ghci.exe
|
||||
./ghci.shim
|
||||
./ghcii-8.10.7.sh-8.10.7.exe
|
||||
./ghcii-8.10.7.sh-8.10.7.shim
|
||||
./ghcii-8.10.7.sh.exe
|
||||
./ghcii-8.10.7.sh.shim
|
||||
./ghcii.sh-8.10.7.exe
|
||||
./ghcii.sh-8.10.7.shim
|
||||
./ghcii.sh.exe
|
||||
./ghcii.sh.shim
|
||||
./haddock-8.10.7.exe
|
||||
./haddock-8.10.7.shim
|
||||
./haddock.exe
|
||||
./haddock.shim
|
||||
./haskell-language-server-8.10.6.exe
|
||||
./haskell-language-server-8.10.6.shim
|
||||
./haskell-language-server-8.10.6~1.6.1.0.exe
|
||||
./haskell-language-server-8.10.6~1.6.1.0.shim
|
||||
./haskell-language-server-8.10.7.exe
|
||||
./haskell-language-server-8.10.7.shim
|
||||
./haskell-language-server-8.10.7~1.6.1.0.exe
|
||||
./haskell-language-server-8.10.7~1.6.1.0.shim
|
||||
./haskell-language-server-8.6.5.exe
|
||||
./haskell-language-server-8.6.5.shim
|
||||
./haskell-language-server-8.6.5~1.6.1.0.exe
|
||||
./haskell-language-server-8.6.5~1.6.1.0.shim
|
||||
./haskell-language-server-8.8.4.exe
|
||||
./haskell-language-server-8.8.4.shim
|
||||
./haskell-language-server-8.8.4~1.6.1.0.exe
|
||||
./haskell-language-server-8.8.4~1.6.1.0.shim
|
||||
./haskell-language-server-9.0.1.exe
|
||||
./haskell-language-server-9.0.1.shim
|
||||
./haskell-language-server-9.0.1~1.6.1.0.exe
|
||||
./haskell-language-server-9.0.1~1.6.1.0.shim
|
||||
./haskell-language-server-9.0.2.exe
|
||||
./haskell-language-server-9.0.2.shim
|
||||
./haskell-language-server-9.0.2~1.6.1.0.exe
|
||||
./haskell-language-server-9.0.2~1.6.1.0.shim
|
||||
./haskell-language-server-9.2.1.exe
|
||||
./haskell-language-server-9.2.1.shim
|
||||
./haskell-language-server-9.2.1~1.6.1.0.exe
|
||||
./haskell-language-server-9.2.1~1.6.1.0.shim
|
||||
./haskell-language-server-wrapper-1.6.1.0.exe
|
||||
./haskell-language-server-wrapper-1.6.1.0.shim
|
||||
./haskell-language-server-wrapper.exe
|
||||
./haskell-language-server-wrapper.shim
|
||||
./hp2ps-8.10.7.exe
|
||||
./hp2ps-8.10.7.shim
|
||||
./hp2ps.exe
|
||||
./hp2ps.shim
|
||||
./hpc-8.10.7.exe
|
||||
./hpc-8.10.7.shim
|
||||
./hpc.exe
|
||||
./hpc.shim
|
||||
./hsc2hs-8.10.7.exe
|
||||
./hsc2hs-8.10.7.shim
|
||||
./hsc2hs.exe
|
||||
./hsc2hs.shim
|
||||
./runghc-8.10.7.exe
|
||||
./runghc-8.10.7.shim
|
||||
./runghc.exe
|
||||
./runghc.shim
|
||||
./runhaskell-8.10.7.exe
|
||||
./runhaskell-8.10.7.shim
|
||||
./runhaskell.exe
|
||||
./runhaskell.shim
|
||||
./stack.exe
|
||||
./stack.shim
|
||||
23
.gitlab/ghcup_env
Normal file
23
.gitlab/ghcup_env
Normal file
@@ -0,0 +1,23 @@
|
||||
if [ "${OS}" = "WINDOWS" ] ; then
|
||||
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
|
||||
export GHCUP_BIN="$CI_PROJECT_DIR/ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
|
||||
export TMPDIR="$CI_PROJECT_DIR/tmp"
|
||||
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
|
||||
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
|
||||
export STACK_ROOT="$CI_PROJECT_DIR/stack"
|
||||
export STACK_CACHE="$CI_PROJECT_DIR/stack-cache"
|
||||
export BREW_DIR="$CI_PROJECT_DIR/.brew_cache"
|
||||
export BREW_CACHE="$CI_PROJECT_DIR/brew-cache"
|
||||
else
|
||||
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
|
||||
export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
|
||||
export TMPDIR="$CI_PROJECT_DIR/tmp"
|
||||
export CABAL_DIR="$CI_PROJECT_DIR/cabal"
|
||||
export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
|
||||
export STACK_ROOT="$CI_PROJECT_DIR/stack"
|
||||
export STACK_CACHE="$CI_PROJECT_DIR/stack-cache"
|
||||
export BREW_DIR="$CI_PROJECT_DIR/.brew_cache"
|
||||
export BREW_CACHE="$CI_PROJECT_DIR/brew-cache"
|
||||
fi
|
||||
19
.gitlab/script/brew.sh
Executable file
19
.gitlab/script/brew.sh
Executable file
@@ -0,0 +1,19 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
set -Eeuxo pipefail
|
||||
|
||||
# Install brew locally in the project dir. Packages will also be installed here.
|
||||
[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew
|
||||
export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
|
||||
|
||||
# make sure to not pollute the machine with temp files etc
|
||||
mkdir -p $CI_PROJECT_DIR/.brew_cache
|
||||
export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
|
||||
mkdir -p $CI_PROJECT_DIR/.brew_logs
|
||||
export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
|
||||
mkdir -p /private/tmp/.brew_tmp
|
||||
export HOMEBREW_TEMP=/private/tmp/.brew_tmp
|
||||
|
||||
# update and install packages
|
||||
brew update
|
||||
brew install ${1+"$@"}
|
||||
70
.gitlab/script/ci.sh
Executable file
70
.gitlab/script/ci.sh
Executable file
@@ -0,0 +1,70 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
set -Eeuo pipefail
|
||||
|
||||
TOP="$( cd "$(dirname "$0")" ; pwd -P )"
|
||||
. "${TOP}/../ghcup_env"
|
||||
|
||||
function save_cabal_cache () {
|
||||
echo "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..."
|
||||
rm -Rf "$CABAL_CACHE"
|
||||
mkdir -p "$CABAL_CACHE"
|
||||
if [ -d "$CABAL_DIR" ]; then
|
||||
cp -Rf "$CABAL_DIR" "$CABAL_CACHE/"
|
||||
fi
|
||||
}
|
||||
|
||||
|
||||
function extract_cabal_cache () {
|
||||
if [ -d "$CABAL_CACHE" ]; then
|
||||
echo "Extracting cabal cache from $CABAL_CACHE to $CABAL_DIR..."
|
||||
mkdir -p "$CABAL_DIR"
|
||||
cp -Rf "$CABAL_CACHE"/* "$CABAL_DIR"
|
||||
fi
|
||||
}
|
||||
|
||||
function save_stack_cache () {
|
||||
echo "Storing stack cache from $STACK_ROOT to $STACK_CACHE..."
|
||||
rm -Rf "$STACK_CACHE"
|
||||
mkdir -p "$STACK_CACHE"
|
||||
if [ -d "$STACK_ROOT" ]; then
|
||||
cp -Rf "$STACK_DIR" "$STACK_CACHE"
|
||||
fi
|
||||
}
|
||||
|
||||
|
||||
function extract_stack_cache () {
|
||||
if [ -d "$STACK_CACHE" ]; then
|
||||
echo "Extracting stack cache from $STACK_CACHE to $STACK_ROOT..."
|
||||
mkdir -p "$STACK_ROOT"
|
||||
cp -Rf "$STACK_CACHE"/* "$STACK_ROOT"
|
||||
fi
|
||||
}
|
||||
|
||||
function save_brew_cache () {
|
||||
echo "Storing brew cache from $BREW_DIR to $BREW_CACHE..."
|
||||
rm -Rf "$BREW_CACHE"
|
||||
mkdir -p "$BREW_CACHE"
|
||||
if [ -d "$BREW_DIR" ]; then
|
||||
cp -Rf "$BREW_DIR" "$BREW_CACHE"
|
||||
fi
|
||||
}
|
||||
|
||||
|
||||
function extract_brew_cache () {
|
||||
if [ -d "$BREW_CACHE" ]; then
|
||||
echo "Extracting stack cache from $BREW_CACHE to $BREW_DIR..."
|
||||
mkdir -p "$BREW_DIR"
|
||||
cp -Rf "$BREW_CACHE"/* "$BREW_DIR"
|
||||
fi
|
||||
}
|
||||
|
||||
case $1 in
|
||||
extract_cabal_cache) extract_cabal_cache ;;
|
||||
save_cabal_cache) save_cabal_cache ;;
|
||||
extract_stack_cache) extract_stack_cache ;;
|
||||
save_stack_cache) save_stack_cache ;;
|
||||
extract_brew_cache) extract_brew_cache ;;
|
||||
save_brew_cache) save_brew_cache ;;
|
||||
*) echo "unknown mode $1" ; exit 11 ;;
|
||||
esac
|
||||
20
.gitlab/script/ghcup_bootstrap.sh
Executable file
20
.gitlab/script/ghcup_bootstrap.sh
Executable file
@@ -0,0 +1,20 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
|
||||
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
|
||||
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
|
||||
|
||||
./scripts/bootstrap/bootstrap-haskell
|
||||
|
||||
[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]
|
||||
|
||||
52
.gitlab/script/ghcup_cross.sh
Executable file
52
.gitlab/script/ghcup_cross.sh
Executable file
@@ -0,0 +1,52 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
}
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
ecabal update
|
||||
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
|
||||
|
||||
### cleanup
|
||||
|
||||
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
|
||||
cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
eghcup compile ghc -j $(nproc) -v ${GHC_TARGET_VERSION} -b ${GHC_VERSION} -x ${CROSS} -- --enable-unregisterised
|
||||
eghcup set ghc ${CROSS}-${GHC_TARGET_VERSION}
|
||||
|
||||
[ `$(eghcup whereis ghc ${CROSS}-${GHC_TARGET_VERSION}) --numeric-version` = "${GHC_TARGET_VERSION}" ]
|
||||
|
||||
# nuke
|
||||
eghcup nuke
|
||||
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
|
||||
|
||||
52
.gitlab/script/ghcup_git.sh
Executable file
52
.gitlab/script/ghcup_git.sh
Executable file
@@ -0,0 +1,52 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
}
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
ecabal update
|
||||
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
|
||||
|
||||
### cleanup
|
||||
|
||||
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
|
||||
cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
eghcup compile ghc -j $(nproc) -g ${GHC_GIT_TAG} -b ${GHC_VERSION} -- --enable-unregisterised
|
||||
eghcup set ghc ${GHC_GIT_VERSION}
|
||||
|
||||
[ `$(eghcup whereis ghc ${GHC_GIT_VERSION}) --numeric-version` = "${GHC_GIT_VERSION}" ]
|
||||
|
||||
# nuke
|
||||
eghcup nuke
|
||||
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
|
||||
|
||||
51
.gitlab/script/ghcup_hls.sh
Executable file
51
.gitlab/script/ghcup_hls.sh
Executable file
@@ -0,0 +1,51 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
}
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
ecabal update
|
||||
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
|
||||
|
||||
### cleanup
|
||||
|
||||
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
|
||||
cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} --ghc ${GHC_VERSION}
|
||||
|
||||
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
|
||||
|
||||
# nuke
|
||||
eghcup nuke
|
||||
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
|
||||
|
||||
44
.gitlab/script/ghcup_release.sh
Executable file
44
.gitlab/script/ghcup_release.sh
Executable file
@@ -0,0 +1,44 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
git describe
|
||||
|
||||
# build
|
||||
ecabal update
|
||||
|
||||
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${ARCH}" = "32" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
||||
elif [ "${ARCH}" = "64" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} -ftui
|
||||
fi
|
||||
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui
|
||||
elif [ "${OS}" = "WINDOWS" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib +bundled-c-zlib" --constraint="lzma +static"
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
|
||||
fi
|
||||
|
||||
mkdir out
|
||||
binary=$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')
|
||||
ver=$("${binary}" --numeric-version)
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
strip "${binary}"
|
||||
else
|
||||
strip -s "${binary}"
|
||||
fi
|
||||
cp "${binary}" out/${ARTIFACT}-${ver}
|
||||
|
||||
21
.gitlab/script/ghcup_stack.sh
Executable file
21
.gitlab/script/ghcup_stack.sh
Executable file
@@ -0,0 +1,21 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
curl -L -O https://get.haskellstack.org/stable/linux-x86_64.tar.gz
|
||||
tar xf linux-x86_64.tar.gz
|
||||
cp stack-*-linux-*/stack "$CI_PROJECT_DIR"/.local/bin/stack
|
||||
chmod +x "$CI_PROJECT_DIR"/.local/bin/stack
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.stack_root
|
||||
export TAR_OPTIONS=--no-same-owner
|
||||
stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root build
|
||||
stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root test
|
||||
314
.gitlab/script/ghcup_version.sh
Executable file
314
.gitlab/script/ghcup_version.sh
Executable file
@@ -0,0 +1,314 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
CI_PROJECT_DIR=$(pwd)
|
||||
|
||||
|
||||
ecabal() {
|
||||
cabal "$@"
|
||||
}
|
||||
|
||||
raw_eghcup() {
|
||||
ghcup -v -c "$@"
|
||||
}
|
||||
|
||||
eghcup() {
|
||||
if [ "${OS}" = "WINDOWS" ] ; then
|
||||
ghcup -v -c -s file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
else
|
||||
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
|
||||
fi
|
||||
}
|
||||
|
||||
if [ "${OS}" = "WINDOWS" ] ; then
|
||||
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
|
||||
else
|
||||
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||
fi
|
||||
|
||||
git describe --always
|
||||
|
||||
### build
|
||||
|
||||
rm -rf "${GHCUP_DIR}"/share
|
||||
|
||||
ecabal update
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} -ftui
|
||||
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
|
||||
ecabal haddock -w ghc-${GHC_VERSION} -ftui
|
||||
elif [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${ARCH}" = "32" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
|
||||
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
|
||||
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
# doctest
|
||||
curl -sL https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-docspec/cabal-docspec-0.0.0.20210228_p1.tar.bz2 > cabal-docspec.tar.bz2
|
||||
echo '3a10f6fec16dbd18efdd331b1cef5d2d342082da42f5b520726d1fa6a3990d12 cabal-docspec.tar.bz2' | sha256sum -c -
|
||||
tar -xjf cabal-docspec.tar.bz2 cabal-docspec
|
||||
mv cabal-docspec "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
|
||||
rm -f cabal-docspec.tar.bz2
|
||||
chmod a+x "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
|
||||
|
||||
cabal-docspec -XCPP -XTypeSynonymInstances -XOverloadedStrings -XPackageImports --check-properties
|
||||
fi
|
||||
fi
|
||||
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
|
||||
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd" ghcup-test
|
||||
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
|
||||
elif [ "${OS}" = "WINDOWS" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
ecabal test -w ghc-${GHC_VERSION} ghcup-test
|
||||
ecabal haddock -w ghc-${GHC_VERSION}
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
|
||||
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
|
||||
fi
|
||||
|
||||
|
||||
if [ "${OS}" = "WINDOWS" ] ; then
|
||||
ext=".exe"
|
||||
else
|
||||
ext=''
|
||||
fi
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext}
|
||||
|
||||
### cleanup
|
||||
|
||||
rm -rf "${GHCUP_DIR}"
|
||||
|
||||
### manual cli based testing
|
||||
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
eghcup unset ghc ${GHC_VERSION}
|
||||
ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})"
|
||||
[ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
|
||||
[ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
|
||||
[ "`ghcup run --ghc ${GHC_VERSION} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VERSION}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
|
||||
eghcup unset cabal
|
||||
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
|
||||
|
||||
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
|
||||
[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
|
||||
eghcup set cabal ${CABAL_VERSION}
|
||||
|
||||
[ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
|
||||
|
||||
if [ "${OS}" != "FREEBSD" ] ; then
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
eghcup run --ghc 8.10.7 --cabal 3.4.1.0 --hls 1.6.1.0 --stack 2.7.3 --install --bindir "$(pwd)/.bin"
|
||||
if [ "${OS}" == "WINDOWS" ] ; then
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.windows" | sort)
|
||||
else
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files" | sort)
|
||||
fi
|
||||
actual=$(cd ".bin" && find . | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
rm -rf .bin
|
||||
fi
|
||||
fi
|
||||
|
||||
cabal --version
|
||||
|
||||
eghcup debug-info
|
||||
|
||||
# also test etags
|
||||
eghcup list
|
||||
eghcup list -t ghc
|
||||
eghcup list -t cabal
|
||||
|
||||
ghc_ver=$(ghc --numeric-version)
|
||||
ghc --version
|
||||
ghc-${ghc_ver} --version
|
||||
if [ "${OS}" != "WINDOWS" ] ; then
|
||||
ghci --version
|
||||
ghci-${ghc_ver} --version
|
||||
fi
|
||||
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] && [ "${ARCH}" = "ARM64" ] ; then
|
||||
echo
|
||||
else
|
||||
# test installing new ghc doesn't mess with currently set GHC
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
eghcup --downloader=wget prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
fi
|
||||
elif [ "${OS}" = "WINDOWS" ] ; then
|
||||
eghcup prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
else
|
||||
eghcup prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
fi
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup --offline set 8.10.3
|
||||
eghcup set 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "8.10.3" ]
|
||||
eghcup set ${GHC_VERSION}
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup unset ghc
|
||||
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
|
||||
eghcup set ${GHC_VERSION}
|
||||
eghcup --offline rm 8.10.3
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
|
||||
|
||||
ls -lah "$GHCUP_BIN"
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
eghcup install hls
|
||||
$(eghcup whereis hls) --version
|
||||
|
||||
eghcup install stack
|
||||
$(eghcup whereis stack) --version
|
||||
elif [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
eghcup install hls
|
||||
haskell-language-server-wrapper --version
|
||||
eghcup unset hls
|
||||
"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit 1 || echo yes
|
||||
|
||||
eghcup install stack
|
||||
stack --version
|
||||
eghcup unset stack
|
||||
"$GHCUP_BIN"/stack --version && exit 1 || echo yes
|
||||
fi
|
||||
fi
|
||||
fi
|
||||
|
||||
|
||||
|
||||
# check that lazy loading works for 'whereis'
|
||||
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
eghcup whereis ghc $(ghc --numeric-version)
|
||||
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
|
||||
eghcup rm $(ghc --numeric-version)
|
||||
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
eghcup install cabal -u https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.7.0.0-pre20220407/cabal-install-3.7-x86_64-linux-alpine.tar.xz 3.4.0.0-rc4
|
||||
eghcup rm cabal 3.4.0.0-rc4
|
||||
fi
|
||||
fi
|
||||
|
||||
eghcup gc -c
|
||||
|
||||
sha_sum() {
|
||||
if [ "${OS}" = "FREEBSD" ] ; then
|
||||
sha256 "$@"
|
||||
else
|
||||
sha256sum "$@"
|
||||
fi
|
||||
|
||||
}
|
||||
|
||||
# test etags
|
||||
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
|
||||
# snapshot yaml and etags file
|
||||
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
# invalidate access time timer, which is 5minutes, so we re-download
|
||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
# redownload same file with some newlines added
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
|
||||
# snapshot new yaml and etags file
|
||||
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
# compare
|
||||
[ "${etag}" != "${etag2}" ]
|
||||
[ "${sha}" != "${sha2}" ]
|
||||
# invalidate access time timer, which is 5minutes, but don't expect a re-download
|
||||
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
|
||||
# this time, we expect the same hash and etag
|
||||
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
|
||||
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
|
||||
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
|
||||
[ "${etag2}" = "${etag3}" ]
|
||||
[ "${sha2}" = "${sha3}" ]
|
||||
|
||||
# test isolated installs
|
||||
eghcup install ghc -i "$(pwd)/isolated" 8.10.5
|
||||
[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
|
||||
! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
if [ "${OS}" = "LINUX" ] || [ "${OS}" = "WINDOWS" ] ; then
|
||||
eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
|
||||
[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
|
||||
eghcup install stack -i "$(pwd)/isolated" 2.7.3
|
||||
[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
|
||||
eghcup install hls -i "$(pwd)/isolated" 1.3.0
|
||||
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
|
||||
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
|
||||
|
||||
# test that isolated installs don't clean up target directory
|
||||
cat <<EOF > "${GHCUP_BIN}/gmake"
|
||||
#!/bin/bash
|
||||
exit 1
|
||||
EOF
|
||||
chmod +x "${GHCUP_BIN}/gmake"
|
||||
mkdir isolated_tainted/
|
||||
touch isolated_tainted/lol
|
||||
|
||||
! eghcup install ghc -i "$(pwd)/isolated_tainted" 8.10.5 --force
|
||||
[ -e "$(pwd)/isolated_tainted/lol" ]
|
||||
rm "${GHCUP_BIN}/gmake"
|
||||
fi
|
||||
fi
|
||||
|
||||
eghcup upgrade
|
||||
eghcup upgrade -f
|
||||
|
||||
# test that doing fishy symlinks into GHCup dir doesn't cause weird stuff on 'ghcup nuke'
|
||||
mkdir no_nuke/
|
||||
mkdir no_nuke/bar
|
||||
echo 'foo' > no_nuke/file
|
||||
echo 'bar' > no_nuke/bar/file
|
||||
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/cache/no_nuke
|
||||
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/logs/no_nuke
|
||||
|
||||
# nuke
|
||||
eghcup nuke
|
||||
[ ! -e "${GHCUP_DIR}" ]
|
||||
|
||||
# make sure nuke doesn't resolve symlinks
|
||||
[ -e "$CI_PROJECT_DIR"/no_nuke/file ]
|
||||
[ -e "$CI_PROJECT_DIR"/no_nuke/bar/file ]
|
||||
|
||||
|
||||
19
.gitlab/script/hlint.sh
Executable file
19
.gitlab/script/hlint.sh
Executable file
@@ -0,0 +1,19 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -eux
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
|
||||
|
||||
mkdir -p "$CI_PROJECT_DIR"/.local/bin
|
||||
|
||||
ecabal() {
|
||||
cabal --store-dir="$(pwd)"/.store "$@"
|
||||
}
|
||||
|
||||
git describe
|
||||
|
||||
ecabal update
|
||||
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hlint
|
||||
|
||||
hlint -r app/ lib/ test/
|
||||
|
||||
28
.travis/build.sh
Executable file
28
.travis/build.sh
Executable file
@@ -0,0 +1,28 @@
|
||||
#!/bin/sh
|
||||
|
||||
set -ex
|
||||
|
||||
mkdir -p ~/.ghcup/bin
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ~/.ghcup/bin/ghcup
|
||||
chmod +x ~/.ghcup/bin/ghcup
|
||||
|
||||
export PATH="$HOME/.ghcup/bin:$PATH"
|
||||
|
||||
ghcup install 8.10.4
|
||||
ghcup install-cabal 3.4.0.0
|
||||
ghcup set 8.10.4
|
||||
|
||||
|
||||
## install ghcup
|
||||
|
||||
cabal update
|
||||
|
||||
(
|
||||
cd /tmp
|
||||
cabal install --installdir="$HOME"/.ghcup/bin hspec-discover
|
||||
)
|
||||
|
||||
cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui
|
||||
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
strip ./ghcup
|
||||
cp ghcup "./${ARTIFACT}"
|
||||
32
CHANGELOG.md
32
CHANGELOG.md
@@ -1,37 +1,5 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.22.0 -- ????-??-??
|
||||
|
||||
### New features
|
||||
|
||||
* Beef up `--overwrite-version`, fixes [#998](https://github.com/haskell/ghcup-hs/issues/998)
|
||||
* e.g. `ghcup compile hls -g master --overwrite-version='%v-%h' --ghc 9.4.8` will produce a binary called `haskell-language-server-wrapper-<version-from-cabal-file>-<short-git-commit-hash>`... refer to `ghcup compile hls --help` for more information
|
||||
* Allow to set ghcup msys2 environment wrt [#982](https://github.com/haskell/ghcup-hs/issues/982)
|
||||
* Add mechanism to warn on new metadata versions, fixes [#860](https://github.com/haskell/ghcup-hs/issues/860)
|
||||
|
||||
### Improvements and bug fixes
|
||||
|
||||
* Clean up on git clone errors, fixes [#1004](https://github.com/haskell/ghcup-hs/issues/1004)
|
||||
* Error out on empty UserSettings wrt [#922](https://github.com/haskell/ghcup-hs/issues/922)
|
||||
* Fix failure mode when metadata is garbage, fixes [#921](https://github.com/haskell/ghcup-hs/issues/921)
|
||||
* Be less confusing when user tries to 'set' ghcup in TUI, fixes [#923](https://github.com/haskell/ghcup-hs/issues/923)
|
||||
* Fix prefetch for cross bindists
|
||||
* Fix misinterpretation of '+' in URI paths, fixes [#408](https://github.com/haskell/ghcup-hs/issues/408)
|
||||
* Stricter (and better) file uri handling
|
||||
* Set LD=ld.bfd on Alpine linux during bindist configure
|
||||
* Add rocky/void detection
|
||||
* Logging improvements
|
||||
* Remove the "show all tool" config in the TUI
|
||||
* Fix opening changelog on windows
|
||||
* Don't remove share dir link prematurely
|
||||
* Require user to explicitly choose subcommand for 'ghcup config'
|
||||
* Don't download twice when trying stack decoding
|
||||
|
||||
### Refactoring and maintenance
|
||||
|
||||
* Large TUI code cleanup by @lsmor (Luis Morillo)... more coming up soon
|
||||
* Allow building with `tar` instead of `libarchive` (mainly to make contributions easier)
|
||||
|
||||
## 0.1.20.0 -- 2023-11-10
|
||||
|
||||
### New features
|
||||
|
||||
@@ -11,7 +11,6 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module BrickMain where
|
||||
|
||||
@@ -203,35 +202,34 @@ handleGenericListEvent (VtyEvent ev) = do
|
||||
handleGenericListEvent _ = pure ()
|
||||
|
||||
-- This re-uses Brick.Widget.List.renderList
|
||||
renderSectionList :: forall n t e . (Traversable t, Ord n, Show n, Eq n, L.Splittable t, Semigroup (t e))
|
||||
renderSectionList :: (Traversable t, Ord n, Show n, Eq n, L.Splittable t)
|
||||
=> (Bool -> e -> Widget n) -- ^ Rendering function of the list element, True for the selected element
|
||||
-> Bool -- ^ Whether the section list has focus
|
||||
-> GenericSectionList n t e -- ^ The section list to render
|
||||
-> Widget n
|
||||
renderSectionList renderElem sectionFocus ge@(GenericSectionList focus elms slName) =
|
||||
Brick.Widget Brick.Greedy Brick.Greedy $ Brick.render $ Brick.viewport slName Brick.Vertical $
|
||||
V.ifoldl' (\(!accWidget) !i list ->
|
||||
let hasFocusList = sectionIsFocused list
|
||||
makeVisible = if hasFocusList then Brick.visibleRegion (Brick.Location (c, r)) (1, 1) else id
|
||||
appendBorder = if i == 0 then id else (hBorder <=>)
|
||||
newWidget = appendBorder (makeVisible $ renderInnerList hasFocusList list)
|
||||
in accWidget <=> newWidget
|
||||
)
|
||||
Brick.emptyWidget
|
||||
elms
|
||||
where
|
||||
-- A section is focused if the whole thing is focused, and the inner list has focus
|
||||
sectionIsFocused :: L.GenericList n t e -> Bool
|
||||
sectionIsFocused l = sectionFocus && (Just (L.listName l) == F.focusGetCurrent focus)
|
||||
|
||||
renderInnerList :: Bool -> L.GenericList n t e -> Widget n
|
||||
renderInnerList hasFocus l = Brick.vLimit (length l) $ L.renderList (\b -> renderElem (b && hasFocus)) hasFocus l
|
||||
|
||||
-- compute the location to focus on within the active section
|
||||
(c, r) :: (Int, Int) = case sectionListSelectedElement ge of
|
||||
Nothing -> (0, 0)
|
||||
Just (selElIx, _) -> (0, selElIx)
|
||||
|
||||
renderSectionList render_elem section_focus (GenericSectionList focus elms sl_name) =
|
||||
Brick.Widget Brick.Greedy Brick.Greedy $ do
|
||||
c <- Brick.getContext
|
||||
let -- A section is focused if the whole thing is focused, and the inner list has focus
|
||||
section_is_focused l = section_focus && (Just (L.listName l) == F.focusGetCurrent focus)
|
||||
-- We need to limit the widget size when the length of the list is higher than the size of the terminal
|
||||
limit = min (Brick.windowHeight c) (Brick.availHeight c)
|
||||
s_idx = fromMaybe 0 $ V.findIndex section_is_focused elms
|
||||
render_inner_list has_focus l = Brick.vLimit (length l) $ L.renderList (\b -> render_elem (b && has_focus)) has_focus l
|
||||
(widget, off) =
|
||||
V.ifoldl' (\wacc i list ->
|
||||
let has_focus_list = section_is_focused list
|
||||
(!acc_widget, !acc_off) = wacc
|
||||
new_widget = if i == 0 then render_inner_list has_focus_list list else hBorder <=> render_inner_list has_focus_list list
|
||||
new_off
|
||||
| i < s_idx = 1 + L.listItemHeight list * length list
|
||||
| i == s_idx = 1 + L.listItemHeight list * fromMaybe 0 (L.listSelected list)
|
||||
| otherwise = 0
|
||||
in (acc_widget <=> new_widget, acc_off + new_off)
|
||||
)
|
||||
(Brick.emptyWidget, 0)
|
||||
elms
|
||||
Brick.render $ Brick.viewport sl_name Brick.Vertical $ Brick.translateBy (Brick.Location (0, min 0 (limit-off))) widget
|
||||
|
||||
-- | Equivalent to listSelectedElement
|
||||
sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e)
|
||||
|
||||
@@ -11,8 +11,7 @@
|
||||
module Main where
|
||||
|
||||
#if defined(BRICK)
|
||||
-- import BrickMain ( brickMain )
|
||||
import GHCup.BrickMain (brickMain)
|
||||
import BrickMain ( brickMain )
|
||||
#endif
|
||||
|
||||
import qualified GHCup.GHC as GHC
|
||||
@@ -42,7 +41,6 @@ import Data.Aeson ( decodeStrict', Value )
|
||||
import Data.Aeson.Encode.Pretty ( encodePretty )
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Versions (version)
|
||||
import Data.Maybe
|
||||
import GHC.IO.Encoding
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
@@ -343,14 +341,12 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
|
||||
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
|
||||
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ overwriteVer = Just [S over] })) (GHC, ver)
|
||||
| Right over' <- version (T.pack over) = cmp' GHC (Just $ GHCVersion (mkTVer over')) ver
|
||||
| otherwise = pure False
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
|
||||
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))
|
||||
(GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ overwriteVer = Just [S over] })) (HLS, ver)
|
||||
| Right over' <- version (T.pack over) = cmp' HLS (Just $ ToolVersion over') ver
|
||||
| otherwise = pure False
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion over) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.SourceDist tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))
|
||||
|
||||
@@ -44,7 +44,7 @@ package streamly
|
||||
package *
|
||||
test-show-details: direct
|
||||
|
||||
allow-newer: cabal-install-parsers:tar, streamly:Win32
|
||||
allow-newer: cabal-install-parsers:tar
|
||||
|
||||
|
||||
with-compiler: ghc-8.10.7
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.10.2.1,
|
||||
constraints: any.Cabal ==3.6.3.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.Cabal-syntax ==3.10.2.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.6,
|
||||
@@ -10,8 +11,8 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.2.1.0,
|
||||
aeson +ordered-keymap,
|
||||
any.aeson ==2.1.2.1,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.10,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.5.0.0,
|
||||
@@ -25,30 +26,31 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
assoc +tagged,
|
||||
any.async ==2.2.5,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.5,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.13.1,
|
||||
any.base-compat-batteries ==0.13.1,
|
||||
any.base-orphans ==0.9.1,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.6.1,
|
||||
bifunctors +tagged,
|
||||
any.bimap ==0.5.0,
|
||||
any.binary ==0.8.9.1,
|
||||
any.binary ==0.8.8.0,
|
||||
any.binary-instances ==1.0.4,
|
||||
any.binary-orphans ==1.0.4.1,
|
||||
any.blaze-builder ==0.4.2.3,
|
||||
any.brick ==2.1.1,
|
||||
brick -demos,
|
||||
any.bytestring ==0.11.5.3,
|
||||
any.bytestring ==0.10.12.0,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-install-parsers ==0.6.1.1,
|
||||
any.cabal-install-parsers ==0.6.1,
|
||||
any.cabal-plan ==0.7.3.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
@@ -76,7 +78,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.data-clist ==0.2,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.4.0,
|
||||
any.directory ==1.3.8.1,
|
||||
any.directory ==1.3.6.0,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
@@ -84,8 +86,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.4,
|
||||
any.file-uri ==0.1.0.0,
|
||||
any.filepath ==1.4.300.1,
|
||||
filepath -cpphs,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.foldable1-classes-compat ==0.1,
|
||||
foldable1-classes-compat +tagged,
|
||||
any.free ==5.2,
|
||||
@@ -110,18 +111,17 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.hspec-discover ==2.10.10,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.7.0,
|
||||
any.http-io-streams ==0.1.6.3,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1.1,
|
||||
any.indexed-traversable ==0.1.3,
|
||||
any.indexed-traversable-instances ==0.1.1.2,
|
||||
any.integer-conversion ==0.1.0.1,
|
||||
any.integer-gmp ==1.0.3.0,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.2,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.3,
|
||||
any.language-c ==0.9.2,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.4.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
@@ -159,11 +159,11 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.8.0.0,
|
||||
any.process ==1.6.18.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.2,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.5,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
@@ -205,12 +205,11 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.text ==2.0.2,
|
||||
text -developer +simdutf,
|
||||
any.text-binary ==0.2.1.1,
|
||||
any.text-iso8601 ==0.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.13,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.6.0.0,
|
||||
any.th-abstraction ==0.5.0.0,
|
||||
any.th-compat ==0.1.4,
|
||||
any.th-lift ==0.8.4,
|
||||
any.th-lift-instances ==0.1.20,
|
||||
@@ -225,8 +224,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unicode-data ==0.3.1,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.8.5.0,
|
||||
unix -os-string,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.8,
|
||||
any.unix-compat ==0.7.1,
|
||||
unix-compat -old-time,
|
||||
@@ -242,10 +240,10 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.vector-binary-instances ==0.2.5.2,
|
||||
any.vector-stream ==0.1.0.1,
|
||||
any.versions ==6.0.5,
|
||||
any.vty ==6.2,
|
||||
any.vty-crossplatform ==0.4.0.0,
|
||||
any.vty ==6.0,
|
||||
any.vty-crossplatform ==0.2.0.0,
|
||||
vty-crossplatform -demos,
|
||||
any.vty-unix ==0.2.0.0,
|
||||
any.vty-unix ==0.1.0.0,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
@@ -255,4 +253,4 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
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 2024-02-18T14:07:35Z
|
||||
index-state: hackage.haskell.org 2024-01-19T19:48:54Z
|
||||
|
||||
@@ -44,7 +44,7 @@ package streamly
|
||||
package *
|
||||
test-show-details: direct
|
||||
|
||||
allow-newer: cabal-install-parsers:tar, streamly:Win32
|
||||
allow-newer: cabal-install-parsers:tar
|
||||
|
||||
|
||||
with-compiler: ghc-9.0.2
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.10.2.1,
|
||||
constraints: any.Cabal ==3.6.3.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.Cabal-syntax ==3.10.2.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.6,
|
||||
@@ -10,8 +11,8 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.2.1.0,
|
||||
aeson +ordered-keymap,
|
||||
any.aeson ==2.1.2.1,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.10,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.5.0.0,
|
||||
@@ -25,19 +26,20 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
assoc +tagged,
|
||||
any.async ==2.2.5,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.5,
|
||||
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.13.1,
|
||||
any.base-compat-batteries ==0.13.1,
|
||||
any.base-orphans ==0.9.1,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.6.1,
|
||||
bifunctors +tagged,
|
||||
any.bimap ==0.5.0,
|
||||
any.binary ==0.8.9.1,
|
||||
any.binary ==0.8.8.0,
|
||||
any.binary-instances ==1.0.4,
|
||||
any.binary-orphans ==1.0.4.1,
|
||||
any.bindings-DSL ==1.0.25,
|
||||
@@ -46,13 +48,13 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.blaze-builder ==0.4.2.3,
|
||||
any.brick ==2.1.1,
|
||||
brick -demos,
|
||||
any.bytestring ==0.11.5.3,
|
||||
any.bytestring ==0.10.12.1,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-install-parsers ==0.6.1.1,
|
||||
any.cabal-install-parsers ==0.6.1,
|
||||
any.cabal-plan ==0.7.3.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
@@ -79,9 +81,9 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.5.0,
|
||||
any.digest ==0.0.2.1,
|
||||
any.digest ==0.0.2.0,
|
||||
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
|
||||
any.directory ==1.3.8.1,
|
||||
any.directory ==1.3.6.2,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
@@ -89,8 +91,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.4,
|
||||
any.file-uri ==0.1.0.0,
|
||||
any.filepath ==1.4.300.1,
|
||||
filepath -cpphs,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.foldable1-classes-compat ==0.1,
|
||||
foldable1-classes-compat +tagged,
|
||||
any.free ==5.2,
|
||||
@@ -116,17 +117,16 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.hspec-discover ==2.10.10,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.7.0,
|
||||
any.http-io-streams ==0.1.6.3,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1.1,
|
||||
any.indexed-traversable ==0.1.3,
|
||||
any.indexed-traversable-instances ==0.1.1.2,
|
||||
any.integer-conversion ==0.1.0.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.2,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.3,
|
||||
any.language-c ==0.9.2,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libyaml-streamly ==0.2.2,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
@@ -163,11 +163,11 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.8.0.0,
|
||||
any.process ==1.6.18.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.2,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.5,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
@@ -211,12 +211,11 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.text ==2.0.2,
|
||||
text -developer +simdutf,
|
||||
any.text-binary ==0.2.1.1,
|
||||
any.text-iso8601 ==0.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.13,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.6.0.0,
|
||||
any.th-abstraction ==0.5.0.0,
|
||||
any.th-compat ==0.1.4,
|
||||
any.th-lift ==0.8.4,
|
||||
any.th-lift-instances ==0.1.20,
|
||||
@@ -232,8 +231,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.typed-process ==0.2.11.1,
|
||||
any.unicode-data ==0.3.1,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.8.5.0,
|
||||
unix -os-string,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.8,
|
||||
any.unix-compat ==0.7.1,
|
||||
unix-compat -old-time,
|
||||
@@ -251,10 +249,10 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.vector-binary-instances ==0.2.5.2,
|
||||
any.vector-stream ==0.1.0.1,
|
||||
any.versions ==6.0.5,
|
||||
any.vty ==6.2,
|
||||
any.vty-crossplatform ==0.4.0.0,
|
||||
any.vty ==6.0,
|
||||
any.vty-crossplatform ==0.2.0.0,
|
||||
vty-crossplatform -demos,
|
||||
any.vty-unix ==0.2.0.0,
|
||||
any.vty-unix ==0.1.0.0,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
@@ -268,4 +266,4 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.3.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2024-02-18T14:07:35Z
|
||||
index-state: hackage.haskell.org 2024-01-19T19:48:54Z
|
||||
|
||||
@@ -44,7 +44,7 @@ package streamly
|
||||
package *
|
||||
test-show-details: direct
|
||||
|
||||
allow-newer: cabal-install-parsers:tar, streamly:Win32
|
||||
allow-newer: cabal-install-parsers:tar
|
||||
|
||||
|
||||
with-compiler: ghc-9.2.8
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.10.2.1,
|
||||
constraints: any.Cabal ==3.6.3.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.Cabal-syntax ==3.10.2.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.6,
|
||||
@@ -10,8 +11,8 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.2.1.0,
|
||||
aeson +ordered-keymap,
|
||||
any.aeson ==2.1.2.1,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.10,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.5.0.0,
|
||||
@@ -25,12 +26,13 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
assoc +tagged,
|
||||
any.async ==2.2.5,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.5,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.16.4.0,
|
||||
any.base-compat ==0.13.1,
|
||||
any.base-compat-batteries ==0.13.1,
|
||||
any.base-orphans ==0.9.1,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
@@ -52,7 +54,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-install-parsers ==0.6.1.1,
|
||||
any.cabal-install-parsers ==0.6.1,
|
||||
any.cabal-plan ==0.7.3.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
@@ -79,9 +81,9 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.6.1,
|
||||
any.digest ==0.0.2.1,
|
||||
any.digest ==0.0.2.0,
|
||||
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
|
||||
any.directory ==1.3.7.1,
|
||||
any.directory ==1.3.6.2,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
@@ -89,8 +91,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.4,
|
||||
any.file-uri ==0.1.0.0,
|
||||
any.filepath ==1.4.300.1,
|
||||
filepath -cpphs,
|
||||
any.filepath ==1.4.2.2,
|
||||
any.foldable1-classes-compat ==0.1,
|
||||
foldable1-classes-compat +tagged,
|
||||
any.free ==5.2,
|
||||
@@ -116,17 +117,16 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.hspec-discover ==2.10.10,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.7.0,
|
||||
any.http-io-streams ==0.1.6.3,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1.1,
|
||||
any.indexed-traversable ==0.1.3,
|
||||
any.indexed-traversable-instances ==0.1.1.2,
|
||||
any.integer-conversion ==0.1.0.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.2,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.3,
|
||||
any.language-c ==0.9.2,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libyaml-streamly ==0.2.2,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
@@ -163,11 +163,11 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.8.0.0,
|
||||
any.process ==1.6.18.0,
|
||||
any.process ==1.6.16.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.2,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.5,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
@@ -211,12 +211,11 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.text ==2.0.2,
|
||||
text -developer +simdutf,
|
||||
any.text-binary ==0.2.1.1,
|
||||
any.text-iso8601 ==0.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.13,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.6.0.0,
|
||||
any.th-abstraction ==0.5.0.0,
|
||||
any.th-compat ==0.1.4,
|
||||
any.th-lift ==0.8.4,
|
||||
any.th-lift-instances ==0.1.20,
|
||||
@@ -250,10 +249,10 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.vector-binary-instances ==0.2.5.2,
|
||||
any.vector-stream ==0.1.0.1,
|
||||
any.versions ==6.0.5,
|
||||
any.vty ==6.2,
|
||||
any.vty-crossplatform ==0.4.0.0,
|
||||
any.vty ==6.0,
|
||||
any.vty-crossplatform ==0.2.0.0,
|
||||
vty-crossplatform -demos,
|
||||
any.vty-unix ==0.2.0.0,
|
||||
any.vty-unix ==0.1.0.0,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
@@ -267,4 +266,4 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.3.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2024-02-18T14:07:35Z
|
||||
index-state: hackage.haskell.org 2024-01-19T19:48:54Z
|
||||
|
||||
@@ -44,7 +44,7 @@ package streamly
|
||||
package *
|
||||
test-show-details: direct
|
||||
|
||||
allow-newer: cabal-install-parsers:tar, streamly:Win32
|
||||
allow-newer: cabal-install-parsers:tar
|
||||
|
||||
|
||||
with-compiler: ghc-9.4.8
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
active-repositories: hackage.haskell.org:merge
|
||||
constraints: any.Cabal ==3.10.2.1,
|
||||
any.Cabal-syntax ==3.10.2.0,
|
||||
constraints: any.Cabal ==3.6.3.0 || ==3.8.1.0,
|
||||
Cabal -bundled-binary-generic,
|
||||
any.Cabal-syntax ==3.8.1.0 || ==3.10.2.0,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.6,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
@@ -10,8 +11,8 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.2.1.0,
|
||||
aeson +ordered-keymap,
|
||||
any.aeson ==2.1.2.1,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.10,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.5.0.0,
|
||||
@@ -25,12 +26,13 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
assoc +tagged,
|
||||
any.async ==2.2.5,
|
||||
async -bench,
|
||||
any.atomic-primops ==0.8.5,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.17.2.1,
|
||||
any.base-compat ==0.13.1,
|
||||
any.base-compat-batteries ==0.13.1,
|
||||
any.base-orphans ==0.9.1,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
@@ -52,7 +54,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.bzlib-conduit ==0.3.0.2,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-install-parsers ==0.6.1.1,
|
||||
any.cabal-install-parsers ==0.6.1,
|
||||
any.cabal-plan ==0.7.3.0,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
@@ -78,9 +80,9 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.data-default-class ==0.1.2.0,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.8.0,
|
||||
any.digest ==0.0.2.1,
|
||||
any.digest ==0.0.2.0,
|
||||
digest -have_arm64_crc32c -have_builtin_prefetch -have_mm_prefetch -have_sse42 -have_strong_getauxval -have_weak_getauxval +pkg-config,
|
||||
any.directory ==1.3.8.1,
|
||||
any.directory ==1.3.7.1,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
@@ -88,8 +90,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
dlist -werror,
|
||||
any.exceptions ==0.10.5,
|
||||
any.file-uri ==0.1.0.0,
|
||||
any.filepath ==1.4.300.1,
|
||||
filepath -cpphs,
|
||||
any.filepath ==1.4.2.2,
|
||||
any.foldable1-classes-compat ==0.1,
|
||||
foldable1-classes-compat +tagged,
|
||||
any.free ==5.2,
|
||||
@@ -115,17 +116,16 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.hspec-discover ==2.10.10,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.7.0,
|
||||
any.http-io-streams ==0.1.6.3,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1.1,
|
||||
any.indexed-traversable ==0.1.3,
|
||||
any.indexed-traversable-instances ==0.1.1.2,
|
||||
any.integer-conversion ==0.1.0.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.2,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.3,
|
||||
any.language-c ==0.9.2,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libyaml-streamly ==0.2.2,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
@@ -166,7 +166,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1.2,
|
||||
any.random ==1.2.1.1,
|
||||
any.recursion-schemes ==5.2.2.5,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
@@ -209,17 +209,16 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.terminfo ==0.4.1.5,
|
||||
any.text ==2.0.2,
|
||||
any.text-binary ==0.2.1.1,
|
||||
any.text-iso8601 ==0.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.13,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.6.0.0,
|
||||
any.th-abstraction ==0.5.0.0,
|
||||
any.th-compat ==0.1.4,
|
||||
any.th-lift ==0.8.4,
|
||||
any.th-lift-instances ==0.1.20,
|
||||
any.these ==1.2,
|
||||
any.time ==1.11.1.2,
|
||||
any.time ==1.11.1.2 || ==1.12.2,
|
||||
any.time-compat ==1.9.6.1,
|
||||
time-compat -old-locale,
|
||||
any.transformers ==0.5.6.2,
|
||||
@@ -230,8 +229,7 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.typed-process ==0.2.11.1,
|
||||
any.unicode-data ==0.3.1,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.8.5.0,
|
||||
unix -os-string,
|
||||
any.unix ==2.7.3,
|
||||
any.unix-bytestring ==0.3.7.8,
|
||||
any.unix-compat ==0.7.1,
|
||||
unix-compat -old-time,
|
||||
@@ -249,10 +247,10 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.vector-binary-instances ==0.2.5.2,
|
||||
any.vector-stream ==0.1.0.1,
|
||||
any.versions ==6.0.5,
|
||||
any.vty ==6.2,
|
||||
any.vty-crossplatform ==0.4.0.0,
|
||||
any.vty ==6.0,
|
||||
any.vty-crossplatform ==0.2.0.0,
|
||||
vty-crossplatform -demos,
|
||||
any.vty-unix ==0.2.0.0,
|
||||
any.vty-unix ==0.1.0.0,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
@@ -266,4 +264,4 @@ constraints: any.Cabal ==3.10.2.1,
|
||||
any.zlib-bindings ==0.1.1.5,
|
||||
any.zstd ==0.1.3.0,
|
||||
zstd +standalone
|
||||
index-state: hackage.haskell.org 2024-02-18T14:07:35Z
|
||||
index-state: hackage.haskell.org 2024-01-19T19:48:54Z
|
||||
|
||||
@@ -44,5 +44,5 @@ package streamly
|
||||
package *
|
||||
test-show-details: direct
|
||||
|
||||
allow-newer: cabal-install-parsers:tar, streamly:Win32
|
||||
allow-newer: cabal-install-parsers:tar
|
||||
|
||||
|
||||
2
cabal.project.freeze
Normal file
2
cabal.project.freeze
Normal file
@@ -0,0 +1,2 @@
|
||||
-- windows picks weird version
|
||||
constraints: any.hsc2hs ==0.68.8
|
||||
@@ -25,13 +25,11 @@ elif os(freebsd)
|
||||
constraints: zlib +bundled-c-zlib,
|
||||
zip +disable-zstd
|
||||
package *
|
||||
ghc-options: -split-sections
|
||||
ghc-options: -split-sections -pgmc clang++14
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.aeson >= 2.0.1.0,
|
||||
any.hsc2hs ==0.68.8,
|
||||
directory >= 1.3.8.3,
|
||||
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
|
||||
any.hsc2hs ==0.68.8
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
@@ -58,5 +56,5 @@ source-repository-package
|
||||
location: https://github.com/hasufell/uri-bytestring.git
|
||||
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
|
||||
|
||||
allow-newer: cabal-install-parsers:tar, streamly:Win32
|
||||
allow-newer: cabal-install-parsers:tar
|
||||
|
||||
|
||||
@@ -105,7 +105,6 @@ This is the complete list of env variables that change GHCup behavior:
|
||||
On windows, there's additionally:
|
||||
|
||||
* `GHCUP_MSYS2`: Has to point to the root of an existing MSYS2 installation (when installed by GHCup, that's e.g. `C:\ghcup\msys64`). GHCup bootstrap takes care of this usually.
|
||||
* `GHCUP_MSYS2_ENV`: The [MSYS2 environment](https://www.msys2.org/docs/environments/) to use when executing e.g. `ghcup run --mingw-path`. Possible values are `MSYS`, `UCRT64`, `CLANG64`, `CLANGARM64`, `CLANG32`, `MINGW64`, `MINGW32`. Defaults to `MINGW64`, `MINGW32` or `CLANGARM64`, depending on the architecture. `MSYS` is always added as the last component. If you change this value after running the bootstrap script, you may need to make sure that the cabal config reflects this change, more specifically `extra-prog-path`, `extra-include-dirs` and `extra-lib-dirs`. (**NOTE: specifying anything other than the default is considered experimental**)
|
||||
|
||||
### XDG support
|
||||
|
||||
@@ -509,7 +508,7 @@ See `ghcup compile ghc --help` for further information.
|
||||
|
||||
Since ghcup version 0.1.20.0, we provide cross bindists for GHC JS and WASM. These can be installed conveniently.
|
||||
However, these are intended as a developer preview only. By using these GHC variants, you are implicitly signing up to participate in GHC development!
|
||||
If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org.
|
||||
If you run into bugs or missing behavior, join the dev chat at https://matrix.to/#/#GHC:matrix.org.
|
||||
|
||||
First, add the cross release channel:
|
||||
|
||||
|
||||
80
ghcup.cabal
80
ghcup.cabal
@@ -1,9 +1,9 @@
|
||||
cabal-version: 2.4
|
||||
name: ghcup
|
||||
version: 0.1.22.0
|
||||
version: 0.1.20.0
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2024
|
||||
copyright: Julian Ospald 2020
|
||||
maintainer: hasufell@posteo.de
|
||||
author: Julian Ospald
|
||||
homepage: https://github.com/haskell/ghcup-hs
|
||||
@@ -43,7 +43,7 @@ flag tui
|
||||
description:
|
||||
Build the brick powered tui (ghcup tui).
|
||||
|
||||
default: True
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag internal-downloader
|
||||
@@ -75,7 +75,7 @@ common app-common-depends
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath >=1.4.101.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.3
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
@@ -96,7 +96,7 @@ common app-common-depends
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.5 && <6.1
|
||||
, versions >=6.0.5 && <6.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
if flag(tar)
|
||||
@@ -175,7 +175,7 @@ library
|
||||
, base16-bytestring >=0.1.1.6 && <1.1
|
||||
, binary ^>=0.8.6.0
|
||||
, bytestring >=0.10 && <0.12
|
||||
, Cabal ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0
|
||||
, Cabal ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0
|
||||
, case-insensitive ^>=1.2.1.0
|
||||
, casing ^>=0.1.4.1
|
||||
, containers ^>=0.6
|
||||
@@ -184,7 +184,7 @@ library
|
||||
, directory ^>=1.3.6.0
|
||||
, disk-free-space ^>=0.1.0.1
|
||||
, exceptions ^>=0.10
|
||||
, filepath >=1.4.101.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, file-uri ^>=0.1.0.0
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant ^>=3.3
|
||||
@@ -212,7 +212,7 @@ library
|
||||
, unordered-containers ^>=0.2.10.0
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, vector >=0.12 && <0.14
|
||||
, versions >=6.0.5 && <6.1
|
||||
, versions >=6.0.5 && <6.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml-streamly ^>=0.12.0
|
||||
, zlib ^>=0.6.2.2
|
||||
@@ -268,7 +268,7 @@ library
|
||||
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
build-depends: vty ^>=6.0 || ^>=6.1 || ^>=6.2
|
||||
build-depends: vty ^>=6.0
|
||||
|
||||
library ghcup-optparse
|
||||
import: app-common-depends
|
||||
@@ -323,61 +323,6 @@ library ghcup-optparse
|
||||
else
|
||||
build-depends: unix ^>=2.7 || ^>=2.8
|
||||
|
||||
library ghcup-tui
|
||||
import: app-common-depends
|
||||
exposed-modules:
|
||||
GHCup.BrickMain
|
||||
GHCup.Brick.Widgets.Navigation
|
||||
GHCup.Brick.Widgets.Tutorial
|
||||
GHCup.Brick.Widgets.KeyInfo
|
||||
GHCup.Brick.Widgets.SectionList
|
||||
GHCup.Brick.Widgets.Menu
|
||||
GHCup.Brick.Widgets.Menus.Context
|
||||
GHCup.Brick.Widgets.Menus.AdvanceInstall
|
||||
GHCup.Brick.Widgets.Menus.CompileGHC
|
||||
GHCup.Brick.Actions
|
||||
GHCup.Brick.App
|
||||
GHCup.Brick.BrickState
|
||||
GHCup.Brick.Attributes
|
||||
GHCup.Brick.Common
|
||||
|
||||
hs-source-dirs: lib-tui
|
||||
default-language: Haskell2010
|
||||
default-extensions:
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
PackageImports
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StrictData
|
||||
TupleSections
|
||||
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
build-depends:
|
||||
, ghcup
|
||||
, ghcup-optparse
|
||||
, optics ^>=0.4
|
||||
, brick ^>=2.1
|
||||
, transformers ^>=0.5
|
||||
, vty ^>=6.0
|
||||
, optics ^>=0.4
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
if flag(tui)
|
||||
cpp-options: -DBRICK
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
else
|
||||
build-depends: unix ^>=2.7
|
||||
|
||||
executable ghcup
|
||||
import: app-common-depends
|
||||
main-is: Main.hs
|
||||
@@ -401,7 +346,6 @@ executable ghcup
|
||||
build-depends:
|
||||
, ghcup
|
||||
, ghcup-optparse
|
||||
, ghcup-tui
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
@@ -412,7 +356,7 @@ executable ghcup
|
||||
build-depends:
|
||||
, brick ^>=2.1
|
||||
, transformers ^>=0.5
|
||||
, vty ^>=6.0 || ^>=6.1 || ^>=6.2
|
||||
, vty ^>=6.0
|
||||
, optics ^>=0.4
|
||||
|
||||
if os(windows)
|
||||
@@ -453,7 +397,7 @@ test-suite ghcup-test
|
||||
, bytestring >=0.10 && <0.12
|
||||
, containers ^>=0.6
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath >=1.4.101.0
|
||||
, 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
|
||||
@@ -464,7 +408,7 @@ test-suite ghcup-test
|
||||
, text ^>=2.0
|
||||
, time >=1.9.3 && <1.12
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, versions >=6.0.5 && <6.1
|
||||
, versions >=6.0.5 && <6.1
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
10
hie.yaml
10
hie.yaml
@@ -2,15 +2,9 @@ cradle:
|
||||
cabal:
|
||||
- component: "ghcup:lib:ghcup"
|
||||
path: ./lib
|
||||
- component: "ghcup:lib:ghcup-optparse"
|
||||
path: ./lib-opt
|
||||
- component: "ghcup:lib:ghcup-tui"
|
||||
path: ./lib-tui
|
||||
- component: "ghcup:exe:ghcup"
|
||||
path: ./app/ghcup
|
||||
- component: "ghcup:lib:ghcup-optparse"
|
||||
path: "./lib-opt"
|
||||
- component: "ghcup:test:ghcup-test"
|
||||
path: "./test/ghcup-test"
|
||||
path: ./test/ghcup-test
|
||||
- component: "ghcup:test:ghcup-optparse-test"
|
||||
path: "./test/optparse-test"
|
||||
path: ./test/optparse-test
|
||||
@@ -17,6 +17,7 @@ import GHCup.Platform
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.URI
|
||||
import GHCup.Prelude
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prelude.Logger
|
||||
@@ -77,6 +78,7 @@ import qualified Cabal.Config as CC
|
||||
--[ Types ]--
|
||||
-------------
|
||||
|
||||
|
||||
-- a superset of ToolVersion
|
||||
data SetToolVersion = SetGHCVersion GHCTargetVersion
|
||||
| SetToolVersion Version
|
||||
@@ -312,29 +314,6 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
|
||||
|
||||
|
||||
|
||||
overWriteVersionParser :: String -> Either String [VersionPattern]
|
||||
overWriteVersionParser = first (const "Not a valid version pattern") . MP.parse (MP.many versionPattern <* MP.eof) "" . T.pack
|
||||
where
|
||||
versionPattern :: MP.Parsec Void Text VersionPattern
|
||||
versionPattern = do
|
||||
str' <- T.unpack <$> MP.takeWhileP Nothing (/= '%')
|
||||
if str' /= mempty
|
||||
then pure (S str')
|
||||
else fmap (const CabalVer) v_cabal
|
||||
<|> fmap (const GitBranchName) b_name
|
||||
<|> fmap (const GitHashShort) s_hash
|
||||
<|> fmap (const GitHashLong) l_hash
|
||||
<|> fmap (const GitDescribe) g_desc
|
||||
<|> ((\a b -> S (a : T.unpack b)) <$> MP.satisfy (const True) <*> MP.takeWhileP Nothing (== '%')) -- invalid pattern, e.g. "%k"
|
||||
where
|
||||
v_cabal = MP.chunk "%v"
|
||||
b_name = MP.chunk "%b"
|
||||
s_hash = MP.chunk "%h"
|
||||
l_hash = MP.chunk "%H"
|
||||
g_desc = MP.chunk "%g"
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Completers ]--
|
||||
------------------
|
||||
|
||||
@@ -36,7 +36,7 @@ import qualified Data.Versions as V
|
||||
import Data.Text ( Text )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text, vsep )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
|
||||
@@ -74,7 +74,7 @@ data GHCCompileOptions = GHCCompileOptions
|
||||
, crossTarget :: Maybe Text
|
||||
, addConfArgs :: [Text]
|
||||
, setCompile :: Bool
|
||||
, overwriteVer :: Maybe [VersionPattern]
|
||||
, ovewrwiteVer :: Maybe Version
|
||||
, buildFlavour :: Maybe String
|
||||
, buildSystem :: Maybe BuildSystem
|
||||
, isolateDir :: Maybe FilePath
|
||||
@@ -86,7 +86,7 @@ data HLSCompileOptions = HLSCompileOptions
|
||||
, jobs :: Maybe Int
|
||||
, setCompile :: Bool
|
||||
, updateCabal :: Bool
|
||||
, overwriteVer :: Maybe [VersionPattern]
|
||||
, ovewrwiteVer :: Either Bool Version
|
||||
, isolateDir :: Maybe FilePath
|
||||
, cabalProject :: Maybe (Either FilePath URI)
|
||||
, cabalProjectLocal :: Maybe URI
|
||||
@@ -155,8 +155,8 @@ Examples:
|
||||
Examples:
|
||||
# compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
|
||||
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
|
||||
# compile from master for ghc 9.2.3, appending the short git commit hash to the version and ignore the pinned index state
|
||||
ghcup compile hls -g master -o '%v-%h' --ghc 9.2.3 -- --index-state=@(date '+%s')
|
||||
# compile from master for ghc 9.2.3 using 'git describe' to name the binary and ignore the pinned index state
|
||||
ghcup compile hls -g master --git-describe-version --ghc 9.2.3 -- --index-state=@(date '+%s')
|
||||
# compile a specific commit for ghc 9.2.3 and set a specific version for the binary name
|
||||
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
|
||||
|
||||
@@ -253,16 +253,11 @@ ghcCompileOpts =
|
||||
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader overWriteVersionParser
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION"
|
||||
<> helpDoc (Just $ vsep [ text "Overwrite the finally installed VERSION with a different one. Allows to specify patterns"
|
||||
, text "%v version"
|
||||
, text "%b branch name"
|
||||
, text "%h short commit hash"
|
||||
, text "%H long commit hash"
|
||||
, text "%g 'git describe' output"
|
||||
])
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||
<> (completer $ versionCompleter [] GHC)
|
||||
)
|
||||
)
|
||||
@@ -348,25 +343,19 @@ hlsCompileOpts =
|
||||
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
|
||||
<*>
|
||||
(
|
||||
optional (option
|
||||
(eitherReader overWriteVersionParser
|
||||
(Right <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION"
|
||||
<> helpDoc (Just $ vsep [ text "Overwrite the finally installed VERSION with a different one. Allows to specify patterns"
|
||||
, text "%v version from cabal file"
|
||||
, text "%b branch name"
|
||||
, text "%h short commit hash"
|
||||
, text "%H long commit hash"
|
||||
, text "%g 'git describe' output"
|
||||
])
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||
<> (completer $ versionCompleter [] HLS)
|
||||
)
|
||||
)
|
||||
<|>
|
||||
((\b -> if b then Just [GitDescribe] else Nothing) <$> (switch
|
||||
(Left <$> (switch
|
||||
(long "git-describe-version"
|
||||
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
|
||||
<> internal
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -540,7 +529,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
targetHLS
|
||||
ghcs
|
||||
jobs
|
||||
overwriteVer
|
||||
ovewrwiteVer
|
||||
(maybe GHCupInternal IsolateDir isolateDir)
|
||||
cabalProject
|
||||
cabalProjectLocal
|
||||
@@ -587,7 +576,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
targetVer <- liftE $ compileGHC
|
||||
targetGhc
|
||||
crossTarget
|
||||
overwriteVer
|
||||
ovewrwiteVer
|
||||
bootstrapGhc
|
||||
jobs
|
||||
buildConfig
|
||||
|
||||
@@ -1,551 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module GHCup.Brick.Actions where
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics ( getDirs, getPlatformReq )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.OptParse.Common (logGHCPostRm)
|
||||
import GHCup.Prelude ( decUTF8Safe, runBothE' )
|
||||
import GHCup.Prelude.Logger
|
||||
import GHCup.Prelude.Process
|
||||
import GHCup.Prompts
|
||||
import GHCup.Brick.Common (BrickData(..), BrickSettings(..), Name(..), Mode(..))
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import GHCup.Brick.BrickState
|
||||
import GHCup.Brick.Widgets.SectionList
|
||||
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
|
||||
import GHCup.Brick.Widgets.Navigation (BrickInternalState)
|
||||
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
|
||||
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
|
||||
|
||||
import qualified Brick
|
||||
import qualified Brick.Widgets.List as L
|
||||
import qualified Brick.Focus as F
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Bool
|
||||
import Data.Functor
|
||||
import Data.Function ( (&), on)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.IORef (IORef, readIORef, newIORef, modifyIORef)
|
||||
import Data.Versions hiding (Lens')
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import System.Process ( system )
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as B
|
||||
import qualified Data.Text.Lazy as L
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
import System.Environment (getExecutablePath)
|
||||
#if !IS_WINDOWS
|
||||
import GHCup.Prelude.File
|
||||
import System.FilePath
|
||||
import qualified System.Posix.Process as SPP
|
||||
#endif
|
||||
|
||||
import Optics.State (use)
|
||||
import Optics.State.Operators ( (.=))
|
||||
import Optics.Operators ((.~),(%~))
|
||||
import Optics.Getter (view)
|
||||
import Optics.Optic ((%))
|
||||
import Optics ((^.), to)
|
||||
|
||||
|
||||
|
||||
{- Core Logic.
|
||||
|
||||
This module defines the IO actions we can execute within the Brick App:
|
||||
- Install
|
||||
- Set
|
||||
- UnInstall
|
||||
- Launch the Changelog
|
||||
|
||||
-}
|
||||
|
||||
-- | Update app data and list internal state based on new evidence.
|
||||
-- This synchronises @BrickInternalState@ with @BrickData@
|
||||
-- and @BrickSettings@.
|
||||
updateList :: BrickData -> BrickState -> BrickState
|
||||
updateList appD bst =
|
||||
let newInternalState = constructList appD (bst ^. appSettings) (Just (bst ^. appState))
|
||||
in bst
|
||||
& appState .~ newInternalState
|
||||
& appData .~ appD
|
||||
& mode .~ Navigation
|
||||
|
||||
constructList :: BrickData
|
||||
-> BrickSettings
|
||||
-> Maybe BrickInternalState
|
||||
-> BrickInternalState
|
||||
constructList appD settings =
|
||||
replaceLR (filterVisible (_showAllVersions settings))
|
||||
(_lr appD)
|
||||
|
||||
-- | Focus on the tool section and the predicate which matches. If no result matches, focus on index 0
|
||||
selectBy :: Tool -> (ListResult -> Bool) -> BrickInternalState -> BrickInternalState
|
||||
selectBy tool predicate internal_state =
|
||||
let new_focus = F.focusSetCurrent (Singular tool) (view sectionListFocusRingL internal_state)
|
||||
tool_lens = sectionL (Singular tool)
|
||||
in internal_state
|
||||
& sectionListFocusRingL .~ new_focus
|
||||
& tool_lens %~ L.listMoveTo 0 -- We move to 0 first
|
||||
& tool_lens %~ L.listFindBy predicate -- The lookup by the predicate.
|
||||
|
||||
-- | Select the latests GHC tool
|
||||
selectLatest :: BrickInternalState -> BrickInternalState
|
||||
selectLatest = selectBy GHC (elem Latest . lTag)
|
||||
|
||||
|
||||
-- | 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 list_result s =
|
||||
let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e)
|
||||
newVec = [(Singular $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)]
|
||||
newSectionList = sectionList AllTools newVec 1
|
||||
in case oldElem of
|
||||
Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList
|
||||
Nothing -> selectLatest newSectionList
|
||||
where
|
||||
toolEqual e1 e2 =
|
||||
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
|
||||
|
||||
|
||||
filterVisible :: Bool -> ListResult -> Bool
|
||||
filterVisible v e | lInstalled e = True
|
||||
| v
|
||||
, Nightly `notElem` lTag e = True
|
||||
| not v
|
||||
, Old `notElem` lTag e
|
||||
, Nightly `notElem` lTag e = True
|
||||
| otherwise = (Old `notElem` lTag e) &&
|
||||
(Nightly `notElem` lTag e)
|
||||
|
||||
-- | Suspend the current UI and run an IO action in terminal. If the
|
||||
-- IO action returns a Left value, then it's thrown as userError.
|
||||
withIOAction :: (Ord n, Eq n)
|
||||
=> ( (Int, ListResult) -> ReaderT AppState IO (Either String a))
|
||||
-> Brick.EventM n BrickState ()
|
||||
withIOAction action = do
|
||||
as <- Brick.get
|
||||
case sectionListSelectedElement (view appState as) of
|
||||
Nothing -> pure ()
|
||||
Just (curr_ix, e) -> do
|
||||
Brick.suspendAndResume $ do
|
||||
settings <- readIORef settings'
|
||||
flip runReaderT settings $ action (curr_ix, e) >>= \case
|
||||
Left err -> liftIO $ putStrLn ("Error: " <> err)
|
||||
Right _ -> liftIO $ putStrLn "Success"
|
||||
getAppData Nothing >>= \case
|
||||
Right data' -> do
|
||||
putStrLn "Press enter to continue"
|
||||
_ <- getLine
|
||||
pure (updateList data' as)
|
||||
Left err -> throwIO $ userError err
|
||||
|
||||
installWithOptions :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> AdvanceInstall.InstallOptions
|
||||
-> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
installWithOptions opts (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
let
|
||||
misolated = opts ^. AdvanceInstall.isolateDirL
|
||||
shouldIsolate = maybe GHCupInternal IsolateDir (opts ^. AdvanceInstall.isolateDirL)
|
||||
shouldForce = opts ^. AdvanceInstall.forceInstallL
|
||||
shouldSet = opts ^. AdvanceInstall.instSetL
|
||||
extraArgs = opts ^. AdvanceInstall.addConfArgsL
|
||||
v = GHCTargetVersion lCross lVer
|
||||
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
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
, InstallSetError
|
||||
]
|
||||
|
||||
run (do
|
||||
ce <- liftIO $ fmap (either (const Nothing) Just) $
|
||||
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
|
||||
dirs <- lift getDirs
|
||||
case lTool of
|
||||
GHC -> do
|
||||
let vi = getVersionInfo v GHC dls
|
||||
case opts ^. AdvanceInstall.instBindistL of
|
||||
Nothing -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installGHCBin v shouldIsolate shouldForce extraArgs)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
|
||||
pure (vi, dirs, ce)
|
||||
Just uri -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
|
||||
v
|
||||
shouldIsolate
|
||||
shouldForce
|
||||
extraArgs)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setGHC v SetGHCOnly Nothing))
|
||||
pure (vi, dirs, ce)
|
||||
|
||||
Cabal -> do
|
||||
let vi = getVersionInfo v Cabal dls
|
||||
case opts ^. AdvanceInstall.instBindistL of
|
||||
Nothing -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installCabalBin lVer shouldIsolate shouldForce)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
|
||||
pure (vi, dirs, ce)
|
||||
Just uri -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installCabalBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setCabal lVer))
|
||||
pure (vi, dirs, ce)
|
||||
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
||||
HLS -> do
|
||||
let vi = getVersionInfo v HLS dls
|
||||
case opts ^. AdvanceInstall.instBindistL of
|
||||
Nothing -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installHLSBin lVer shouldIsolate shouldForce)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
|
||||
pure (vi, dirs, ce)
|
||||
Just uri -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installHLSBindist
|
||||
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
|
||||
lVer
|
||||
shouldIsolate
|
||||
shouldForce)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setHLS lVer SetHLSOnly Nothing))
|
||||
pure (vi, dirs, ce)
|
||||
|
||||
Stack -> do
|
||||
let vi = getVersionInfo v Stack dls
|
||||
case opts ^. AdvanceInstall.instBindistL of
|
||||
Nothing -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installStackBin lVer shouldIsolate shouldForce)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
|
||||
pure (vi, dirs, ce)
|
||||
Just uri -> do
|
||||
liftE $
|
||||
runBothE'
|
||||
(installStackBindist (DownloadInfo uri Nothing "" Nothing Nothing) lVer shouldIsolate shouldForce)
|
||||
(when (shouldSet && isNothing misolated) (liftE $ void $ setStack lVer))
|
||||
pure (vi, dirs, ce)
|
||||
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, Dirs{..}, Just ce) -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
#if !IS_WINDOWS
|
||||
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
|
||||
liftIO $ SPP.executeFile ce False ["tui"] Nothing
|
||||
#else
|
||||
logInfo "Please restart 'ghcup' for the changes to take effect"
|
||||
#endif
|
||||
_ -> 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 $ prettyHFError e <> "\n"
|
||||
<> "Also check the logs in ~/.ghcup/logs"
|
||||
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> (Int, ListResult) -> m (Either String ())
|
||||
install' = installWithOptions (AdvanceInstall.InstallOptions Nothing False Nothing False [])
|
||||
|
||||
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
|
||||
=> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
set' input@(_, ListResult {..}) = do
|
||||
settings <- liftIO $ readIORef settings'
|
||||
|
||||
let run =
|
||||
flip runReaderT settings
|
||||
. runResourceT
|
||||
. runE
|
||||
@'[ AlreadyInstalled
|
||||
, ArchiveResult
|
||||
, UnknownArchive
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, ContentLengthError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, DirNotEmpty
|
||||
, NoUpdate
|
||||
, TarDirDoesNotExist
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, ToolShadowed
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
, NoCompatiblePlatform
|
||||
, GHCup.Errors.ParseError
|
||||
, UnsupportedSetupCombo
|
||||
, DistroNotFound
|
||||
, NoCompatibleArch
|
||||
]
|
||||
|
||||
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 -> do
|
||||
promptAnswer <- getUserPromptResponse "Switching GHCup versions is not supported.\nDo you want to install the latest version? [Y/N]: "
|
||||
case promptAnswer of
|
||||
PromptYes -> do
|
||||
void $ liftE $ upgradeGHCup Nothing False False
|
||||
PromptNo -> pure ()
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure $ Right ()
|
||||
VLeft e -> case e of
|
||||
(V (NotInstalled tool _)) -> do
|
||||
promptAnswer <- getUserPromptResponse userPrompt
|
||||
case promptAnswer of
|
||||
PromptYes -> do
|
||||
res <- install' input
|
||||
case res of
|
||||
(Left err) -> pure $ Left err
|
||||
(Right _) -> do
|
||||
logInfo "Setting now..."
|
||||
set' input
|
||||
|
||||
PromptNo -> pure $ Left (prettyHFError 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 (prettyHFError e)
|
||||
|
||||
|
||||
|
||||
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
=> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
del' (_, ListResult {..}) = do
|
||||
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
|
||||
let run = runE @'[NotInstalled, UninstallFailed]
|
||||
|
||||
run (do
|
||||
let vi = getVersionInfo (GHCTargetVersion lCross 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
|
||||
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyHFError e)
|
||||
|
||||
|
||||
changelog' :: (MonadReader AppState m, MonadIO m)
|
||||
=> (Int, ListResult)
|
||||
-> m (Either String ())
|
||||
changelog' (_, ListResult {..}) = do
|
||||
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
|
||||
case getChangeLog dls lTool (ToolVersion lVer) of
|
||||
Nothing -> pure $ Left $
|
||||
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
|
||||
Just uri -> do
|
||||
case _rPlatform pfreq of
|
||||
Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||
Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||
FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
|
||||
Windows -> do
|
||||
let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
|
||||
c <- liftIO $ system $ args
|
||||
case c of
|
||||
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
|
||||
ExitSuccess -> pure $ Right ()
|
||||
|
||||
>>= \case
|
||||
Right _ -> pure $ Right ()
|
||||
Left e -> pure $ Left $ prettyHFError 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 Nothing)
|
||||
(PlatformRequest A_64 Darwin Nothing)
|
||||
loggerConfig
|
||||
|
||||
|
||||
getGHCupInfo :: IO (Either String GHCupInfo)
|
||||
getGHCupInfo = do
|
||||
settings <- readIORef settings'
|
||||
|
||||
r <-
|
||||
flip runReaderT settings
|
||||
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
|
||||
$ do
|
||||
pfreq <- lift getPlatformReq
|
||||
liftE $ getDownloadsF pfreq
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
VLeft e -> pure $ Left (prettyHFError e)
|
||||
|
||||
|
||||
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 [] False True (Nothing, Nothing)
|
||||
pure $ BrickData (reverse lV)
|
||||
|
||||
--
|
||||
|
||||
keyHandlers :: KeyBindings
|
||||
-> [ ( KeyCombination
|
||||
, BrickSettings -> String
|
||||
, Brick.EventM Name BrickState ()
|
||||
)
|
||||
]
|
||||
keyHandlers KeyBindings {..} =
|
||||
[ (bQuit, const "Quit" , Brick.halt)
|
||||
, (bInstall, const "Install" , withIOAction install')
|
||||
, (bUninstall, const "Uninstall", withIOAction del')
|
||||
, (bSet, const "Set" , withIOAction set')
|
||||
, (bChangelog, const "ChangeLog", withIOAction changelog')
|
||||
, ( bShowAllVersions
|
||||
, \BrickSettings {..} ->
|
||||
if _showAllVersions then "Don't show all versions" else "Show all versions"
|
||||
, hideShowHandler' (not . _showAllVersions)
|
||||
)
|
||||
, (bUp, const "Up", Common.zoom appState moveUp)
|
||||
, (bDown, const "Down", Common.zoom appState moveDown)
|
||||
, (KeyCombination (Vty.KChar 'h') [], const "help", mode .= KeyInfo)
|
||||
, (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool )
|
||||
]
|
||||
where
|
||||
createMenuforTool = do
|
||||
e <- use (appState % to sectionListSelectedElement)
|
||||
case e of
|
||||
Nothing -> pure ()
|
||||
Just (_, r) -> do
|
||||
-- Create new menus
|
||||
contextMenu .= ContextMenu.create r bQuit
|
||||
advanceInstallMenu .= AdvanceInstall.create bQuit
|
||||
compileGHCMenu .= CompileGHC.create bQuit
|
||||
-- Set mode to context
|
||||
mode .= ContextPanel
|
||||
pure ()
|
||||
|
||||
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
|
||||
hideShowHandler' f = do
|
||||
app_settings <- use appSettings
|
||||
let
|
||||
vers = f app_settings
|
||||
newAppSettings = app_settings & Common.showAllVersions .~ vers
|
||||
ad <- use appData
|
||||
current_app_state <- use appState
|
||||
appSettings .= newAppSettings
|
||||
appState .= constructList ad newAppSettings (Just current_app_state)
|
||||
@@ -1,184 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
{-
|
||||
This module defines the brick App. The pattern is very simple:
|
||||
|
||||
- Pattern match on the Mode
|
||||
- Dispatch drawing/events to the corresponding widget/s
|
||||
|
||||
In general each widget should know how to draw itself and how to handle its own events, so this
|
||||
module should only contain:
|
||||
|
||||
- how to draw non-widget information. For example the footer
|
||||
- how to change between modes (widgets aren't aware of the whole application state)
|
||||
|
||||
-}
|
||||
|
||||
module GHCup.Brick.App where
|
||||
|
||||
import qualified GHCup.Brick.Actions as Actions
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode, compileGHCMenu)
|
||||
import GHCup.Brick.Common (Mode (..), Name (..))
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
|
||||
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
|
||||
import qualified GHCup.Brick.Widgets.Navigation as Navigation
|
||||
import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
|
||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
||||
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
|
||||
|
||||
import GHCup.Types (AppState (AppState, keyBindings), KeyCombination (KeyCombination))
|
||||
|
||||
import qualified Brick.Focus as F
|
||||
import Brick (
|
||||
App (..),
|
||||
AttrMap,
|
||||
BrickEvent (VtyEvent),
|
||||
EventM,
|
||||
Widget (..),
|
||||
(<=>),
|
||||
)
|
||||
import qualified Brick
|
||||
import Control.Monad.Reader (
|
||||
MonadIO (liftIO),
|
||||
void,
|
||||
)
|
||||
import Data.IORef (readIORef)
|
||||
import Data.List (find, intercalate)
|
||||
import Prelude hiding (appendFile)
|
||||
|
||||
import qualified Graphics.Vty as Vty
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Optics.Getter (to)
|
||||
import Optics.Operators ((^.))
|
||||
import Optics.Optic ((%))
|
||||
import Optics.State (use)
|
||||
import Optics.State.Operators ((.=))
|
||||
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
|
||||
|
||||
app :: AttrMap -> AttrMap -> App BrickState () Name
|
||||
app attrs dimAttrs =
|
||||
App { appDraw = drawUI dimAttrs
|
||||
, appHandleEvent = eventHandler
|
||||
, appStartEvent = return ()
|
||||
, appAttrMap = const attrs
|
||||
, appChooseCursor = Brick.showFirstCursor
|
||||
}
|
||||
|
||||
drawUI :: AttrMap -> BrickState -> [Widget Name]
|
||||
drawUI dimAttrs st =
|
||||
let
|
||||
footer = Brick.withAttr Attributes.helpAttr
|
||||
. Brick.txtWrap
|
||||
. T.pack
|
||||
. foldr1 (\x y -> x <> " " <> y)
|
||||
. fmap (\(KeyCombination key mods, pretty_setting, _)
|
||||
-> intercalate "+" (Common.showKey key : (Common.showMod <$> mods)) <> ":" <> pretty_setting (st ^. appSettings)
|
||||
)
|
||||
$ Actions.keyHandlers (st ^. appKeys)
|
||||
navg = Navigation.draw dimAttrs (st ^. appState) <=> footer
|
||||
in case st ^. mode of
|
||||
Navigation -> [navg]
|
||||
Tutorial -> [Tutorial.draw, navg]
|
||||
KeyInfo -> [KeyInfo.draw (st ^. appKeys), navg]
|
||||
ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg]
|
||||
AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg]
|
||||
CompileGHCPanel -> [CompileGHC.draw (st ^. compileGHCMenu), navg]
|
||||
|
||||
|
||||
-- | On q, go back to navigation.
|
||||
-- On Enter, to go to tutorial
|
||||
keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
keyInfoHandler ev = case ev of
|
||||
VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
|
||||
VtyEvent (Vty.EvKey Vty.KEnter _ ) -> mode .= Tutorial
|
||||
_ -> pure ()
|
||||
|
||||
-- | On q, go back to navigation. Else, do nothing
|
||||
tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
tutorialHandler ev =
|
||||
case ev of
|
||||
VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
|
||||
_ -> pure ()
|
||||
|
||||
-- | Tab/Arrows to navigate.
|
||||
navigationHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
navigationHandler ev = do
|
||||
AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings'
|
||||
case ev of
|
||||
inner_event@(VtyEvent (Vty.EvKey key _)) ->
|
||||
case find (\(key', _, _) -> key' == KeyCombination key []) (Actions.keyHandlers kb) of
|
||||
Just (_, _, handler) -> handler
|
||||
Nothing -> void $ Common.zoom appState $ Navigation.handler inner_event
|
||||
inner_event -> Common.zoom appState $ Navigation.handler inner_event
|
||||
|
||||
contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
contextMenuHandler ev = do
|
||||
ctx <- use contextMenu
|
||||
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
|
||||
buttons = ctx ^. Menu.menuButtonsL
|
||||
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
|
||||
case (ev, focusedElement) of
|
||||
(_ , Nothing) -> pure ()
|
||||
(VtyEvent (Vty.EvKey k m), Just n)
|
||||
| k == exitKey
|
||||
&& m == mods
|
||||
&& n `elem` [Menu.fieldName button | button <- buttons]
|
||||
-> mode .= Navigation
|
||||
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel
|
||||
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompilieButton) ) -> mode .= Common.CompileGHCPanel
|
||||
_ -> Common.zoom contextMenu $ ContextMenu.handler ev
|
||||
--
|
||||
advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
advanceInstallHandler ev = do
|
||||
ctx <- use advanceInstallMenu
|
||||
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
|
||||
buttons = ctx ^. Menu.menuButtonsL
|
||||
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
|
||||
case (ev, focusedElement) of
|
||||
(_ , Nothing) -> pure ()
|
||||
(VtyEvent (Vty.EvKey k m), Just n)
|
||||
| k == exitKey
|
||||
&& m == mods
|
||||
&& n `elem` [Menu.fieldName button | button <- buttons]
|
||||
-> mode .= ContextPanel
|
||||
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
|
||||
let iopts = ctx ^. Menu.menuStateL
|
||||
Actions.withIOAction $ Actions.installWithOptions iopts
|
||||
_ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev
|
||||
|
||||
compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
compileGHCHandler ev = do
|
||||
ctx <- use compileGHCMenu
|
||||
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
|
||||
buttons = ctx ^. Menu.menuButtonsL
|
||||
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
|
||||
case (ev, focusedElement) of
|
||||
(_ , Nothing) -> pure ()
|
||||
(VtyEvent (Vty.EvKey k m), Just n)
|
||||
| k == exitKey
|
||||
&& m == mods
|
||||
&& n `elem` [Menu.fieldName button | button <- buttons]
|
||||
-> mode .= ContextPanel
|
||||
_ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
|
||||
|
||||
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
eventHandler ev = do
|
||||
m <- use mode
|
||||
case m of
|
||||
KeyInfo -> keyInfoHandler ev
|
||||
Tutorial -> tutorialHandler ev
|
||||
Navigation -> navigationHandler ev
|
||||
ContextPanel -> contextMenuHandler ev
|
||||
AdvanceInstallPanel -> advanceInstallHandler ev
|
||||
CompileGHCPanel -> compileGHCHandler ev
|
||||
@@ -1,86 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
{-
|
||||
This module defined the attributes. Despite of brick's capability to have a hierarchy of attributes, here
|
||||
we go for the most-simple-approach: a plain hierarchy
|
||||
-}
|
||||
|
||||
module GHCup.Brick.Attributes where
|
||||
|
||||
import Brick ( AttrMap)
|
||||
import qualified Brick
|
||||
import qualified Brick.Widgets.List as L
|
||||
import qualified Graphics.Vty as Vty
|
||||
|
||||
defaultAttributes :: Bool -> AttrMap
|
||||
defaultAttributes no_color = Brick.attrMap
|
||||
Vty.defAttr
|
||||
[ (L.listSelectedFocusedAttr , Vty.defAttr `withBackColor` Vty.blue)
|
||||
, (L.listSelectedAttr , Vty.defAttr)
|
||||
, (notInstalledAttr , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (setAttr , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (installedAttr , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (recommendedAttr , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (hlsPoweredAttr , Vty.defAttr `withForeColor` Vty.green)
|
||||
, (latestAttr , Vty.defAttr `withForeColor` Vty.yellow)
|
||||
, (latestPrereleaseAttr , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (latestNightlyAttr , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (prereleaseAttr , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (nightlyAttr , Vty.defAttr `withForeColor` Vty.red)
|
||||
, (compiledAttr , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (strayAttr , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (dayAttr , Vty.defAttr `withForeColor` Vty.blue)
|
||||
, (helpAttr , Vty.defAttr `withStyle` Vty.italic)
|
||||
, (hoorayAttr , Vty.defAttr `withForeColor` Vty.brightWhite)
|
||||
, (helpMsgAttr , Vty.defAttr `withForeColor` Vty.brightBlack)
|
||||
, (errMsgAttr , Vty.defAttr `withForeColor` Vty.red)
|
||||
]
|
||||
where
|
||||
withForeColor | no_color = const
|
||||
| otherwise = Vty.withForeColor
|
||||
|
||||
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
|
||||
| otherwise = Vty.withBackColor
|
||||
|
||||
withStyle = Vty.withStyle
|
||||
|
||||
|
||||
notInstalledAttr, setAttr, installedAttr, recommendedAttr, hlsPoweredAttr :: Brick.AttrName
|
||||
latestAttr, latestPrereleaseAttr, latestNightlyAttr, prereleaseAttr, nightlyAttr :: Brick.AttrName
|
||||
compiledAttr, strayAttr, dayAttr, helpAttr, hoorayAttr, helpMsgAttr, errMsgAttr :: Brick.AttrName
|
||||
|
||||
notInstalledAttr = Brick.attrName "not-installed"
|
||||
setAttr = Brick.attrName "set"
|
||||
installedAttr = Brick.attrName "installed"
|
||||
recommendedAttr = Brick.attrName "recommended"
|
||||
hlsPoweredAttr = Brick.attrName "hls-powered"
|
||||
latestAttr = Brick.attrName "latest"
|
||||
latestPrereleaseAttr = Brick.attrName "latest-prerelease"
|
||||
latestNightlyAttr = Brick.attrName "latest-nightly"
|
||||
prereleaseAttr = Brick.attrName "prerelease"
|
||||
nightlyAttr = Brick.attrName "nightly"
|
||||
compiledAttr = Brick.attrName "compiled"
|
||||
strayAttr = Brick.attrName "stray"
|
||||
dayAttr = Brick.attrName "day"
|
||||
helpAttr = Brick.attrName "help"
|
||||
hoorayAttr = Brick.attrName "hooray"
|
||||
helpMsgAttr = Brick.attrName "helpMsg"
|
||||
errMsgAttr = Brick.attrName "errMsg"
|
||||
|
||||
dimAttributes :: Bool -> AttrMap
|
||||
dimAttributes no_color = Brick.attrMap
|
||||
(Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
[ (Brick.attrName "active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
|
||||
, (Brick.attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
|
||||
]
|
||||
where
|
||||
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
|
||||
| otherwise = Vty.withBackColor
|
||||
@@ -1,52 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
|
||||
{-
|
||||
This module contains the BrickState. One could be tempted to include this data structure in GHCup.Brick.Common,
|
||||
but it is better to make a separated module in order to avoid cyclic dependencies.
|
||||
|
||||
This happens because the BrickState is sort of a container for all widgets,
|
||||
but widgets depends on common functionality, hence:
|
||||
|
||||
BrickState `depends on` Widgets.XYZ `depends on` Common
|
||||
|
||||
The linear relation above breaks if BrickState is defined in Common.
|
||||
|
||||
-}
|
||||
|
||||
module GHCup.Brick.BrickState where
|
||||
|
||||
import GHCup.Types ( KeyBindings )
|
||||
import GHCup.Brick.Common ( BrickData(..), BrickSettings(..), Mode(..))
|
||||
import GHCup.Brick.Widgets.Navigation ( BrickInternalState)
|
||||
import GHCup.Brick.Widgets.Menus.Context (ContextMenu)
|
||||
import GHCup.Brick.Widgets.Menus.AdvanceInstall (AdvanceInstallMenu)
|
||||
import GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCMenu)
|
||||
import Optics.TH (makeLenses)
|
||||
|
||||
|
||||
data BrickState = BrickState
|
||||
{ _appData :: BrickData
|
||||
, _appSettings :: BrickSettings
|
||||
, _appState :: BrickInternalState
|
||||
, _contextMenu :: ContextMenu
|
||||
, _advanceInstallMenu :: AdvanceInstallMenu
|
||||
, _compileGHCMenu :: CompileGHCMenu
|
||||
, _appKeys :: KeyBindings
|
||||
, _mode :: Mode
|
||||
}
|
||||
--deriving Show
|
||||
|
||||
makeLenses ''BrickState
|
||||
@@ -1,204 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
{-
|
||||
This module contains common values used across the library. Crucially it contains two important types for the brick app:
|
||||
|
||||
- Name: List all resources (widgets) used by the app. see https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#resource-names
|
||||
- Mode: Use to dispatch events and drawings. see: https://github.com/jtdaugherty/brick/issues/476#issuecomment-1629151920
|
||||
|
||||
-}
|
||||
|
||||
module GHCup.Brick.Common (
|
||||
installedSign,
|
||||
setSign,
|
||||
notInstalledSign,
|
||||
showKey,
|
||||
showMod,
|
||||
keyToWidget,
|
||||
separator,
|
||||
frontwardLayer,
|
||||
zoom,
|
||||
defaultAppSettings,
|
||||
lr,
|
||||
showAllVersions,
|
||||
Name(..),
|
||||
Mode(..),
|
||||
BrickData(..),
|
||||
BrickSettings(..),
|
||||
ResourceId (
|
||||
UrlEditBox, SetCheckBox, IsolateEditBox, ForceCheckBox, AdditionalEditBox
|
||||
, TargetGhcEditBox, BootstrapGhcEditBox, JobsEditBox, BuildConfigEditBox
|
||||
, PatchesEditBox, CrossTargetEditBox, AddConfArgsEditBox, OvewrwiteVerEditBox
|
||||
, BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
|
||||
, CompilieButton
|
||||
) ) where
|
||||
|
||||
import GHCup.List ( ListResult )
|
||||
import GHCup.Types ( Tool, KeyCombination (KeyCombination) )
|
||||
import Data.List (intercalate)
|
||||
import Prelude hiding ( appendFile )
|
||||
import qualified Graphics.Vty as Vty
|
||||
import Optics.TH (makeLenses)
|
||||
import Optics.Lens (toLensVL)
|
||||
import qualified Brick
|
||||
import qualified Brick.Widgets.Border as Border
|
||||
import Brick ((<+>))
|
||||
import qualified Data.Text as T
|
||||
import qualified Brick.Widgets.Center as Brick
|
||||
import qualified Brick.Widgets.Border.Style as Border
|
||||
|
||||
-- We could use regular ADTs but different menus share the same options.
|
||||
-- example: all of ghcup compile ghc, ghcup compile hls, ghcup install cabal, etc...
|
||||
-- all have a --set, --force, etc... common arguments. If we went for the ADT we'd end up
|
||||
-- with SetCompileHLSOption, SetCompileGHCOption, SetInstallCabalOption, etc...
|
||||
-- which isn't terrible, but verbose enough to reject it.
|
||||
|
||||
-- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms
|
||||
newtype ResourceId = ResourceId Int deriving (Eq, Ord, Show)
|
||||
|
||||
pattern OkButton :: ResourceId
|
||||
pattern OkButton = ResourceId 0
|
||||
pattern AdvanceInstallButton :: ResourceId
|
||||
pattern AdvanceInstallButton = ResourceId 100
|
||||
pattern CompilieButton :: ResourceId
|
||||
pattern CompilieButton = ResourceId 101
|
||||
|
||||
pattern UrlEditBox :: ResourceId
|
||||
pattern UrlEditBox = ResourceId 1
|
||||
pattern SetCheckBox :: ResourceId
|
||||
pattern SetCheckBox = ResourceId 2
|
||||
pattern IsolateEditBox :: ResourceId
|
||||
pattern IsolateEditBox = ResourceId 3
|
||||
pattern ForceCheckBox :: ResourceId
|
||||
pattern ForceCheckBox = ResourceId 4
|
||||
pattern AdditionalEditBox :: ResourceId
|
||||
pattern AdditionalEditBox = ResourceId 5
|
||||
|
||||
pattern TargetGhcEditBox :: ResourceId
|
||||
pattern TargetGhcEditBox = ResourceId 6
|
||||
pattern BootstrapGhcEditBox :: ResourceId
|
||||
pattern BootstrapGhcEditBox = ResourceId 7
|
||||
pattern JobsEditBox :: ResourceId
|
||||
pattern JobsEditBox = ResourceId 8
|
||||
pattern BuildConfigEditBox :: ResourceId
|
||||
pattern BuildConfigEditBox = ResourceId 9
|
||||
pattern PatchesEditBox :: ResourceId
|
||||
pattern PatchesEditBox = ResourceId 10
|
||||
pattern CrossTargetEditBox :: ResourceId
|
||||
pattern CrossTargetEditBox = ResourceId 11
|
||||
pattern AddConfArgsEditBox :: ResourceId
|
||||
pattern AddConfArgsEditBox = ResourceId 12
|
||||
pattern OvewrwiteVerEditBox :: ResourceId
|
||||
pattern OvewrwiteVerEditBox = ResourceId 13
|
||||
pattern BuildFlavourEditBox :: ResourceId
|
||||
pattern BuildFlavourEditBox = ResourceId 14
|
||||
pattern BuildSystemEditBox :: ResourceId
|
||||
pattern BuildSystemEditBox = ResourceId 15
|
||||
|
||||
-- | Name data type. Uniquely identifies each widget in the TUI.
|
||||
-- some constructors might end up unused, but still is a good practise
|
||||
-- to have all of them defined, just in case
|
||||
data Name = AllTools -- ^ The main list widget
|
||||
| Singular Tool -- ^ The particular list for each tool
|
||||
| KeyInfoBox -- ^ The text box widget with action informacion
|
||||
| TutorialBox -- ^ The tutorial widget
|
||||
| ContextBox -- ^ The resource for Context Menu
|
||||
| CompileGHCBox -- ^ The resource for CompileGHC Menu
|
||||
| AdvanceInstallBox -- ^ The resource for AdvanceInstall Menu
|
||||
| MenuElement ResourceId -- ^ Each element in a Menu. Resources must not be share for visible
|
||||
-- Menus, but MenuA and MenuB can share resources if they both are
|
||||
-- invisible, or just one of them is visible.
|
||||
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
-- | Mode type. It helps to dispatch events to different handlers.
|
||||
data Mode = Navigation
|
||||
| KeyInfo
|
||||
| Tutorial
|
||||
| ContextPanel
|
||||
| AdvanceInstallPanel
|
||||
| CompileGHCPanel
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
installedSign :: String
|
||||
#if IS_WINDOWS
|
||||
installedSign = "I "
|
||||
#else
|
||||
installedSign = "✓ "
|
||||
#endif
|
||||
|
||||
setSign :: String
|
||||
#if IS_WINDOWS
|
||||
setSign = "IS"
|
||||
#else
|
||||
setSign = "✔✔"
|
||||
#endif
|
||||
|
||||
notInstalledSign :: String
|
||||
#if IS_WINDOWS
|
||||
notInstalledSign = "X "
|
||||
#else
|
||||
notInstalledSign = "✗ "
|
||||
#endif
|
||||
|
||||
|
||||
showKey :: Vty.Key -> String
|
||||
showKey (Vty.KChar c) = [c]
|
||||
showKey Vty.KUp = "↑"
|
||||
showKey Vty.KDown = "↓"
|
||||
showKey key = tail (show key)
|
||||
|
||||
showMod :: Vty.Modifier -> String
|
||||
showMod = tail . show
|
||||
|
||||
-- | Given a KeyComb, produces a string widget with and user friendly text
|
||||
keyToWidget :: KeyCombination -> Brick.Widget n
|
||||
keyToWidget (KeyCombination key mods) = Brick.str $ intercalate "+" (showKey key : (showMod <$> mods))
|
||||
|
||||
-- | A section separator with max width. Looks like this: -------- o --------
|
||||
separator :: Brick.Widget n
|
||||
separator = Border.hBorder <+> Brick.str " o " <+> Border.hBorder
|
||||
|
||||
-- | Used to create a layer on top of the main navigation widget (tutorial, info, menus...)
|
||||
frontwardLayer :: T.Text -> Brick.Widget n -> Brick.Widget n
|
||||
frontwardLayer layer_name =
|
||||
Brick.centerLayer
|
||||
. Brick.hLimitPercent 75
|
||||
. Brick.vLimitPercent 50
|
||||
. Brick.withBorderStyle Border.unicode
|
||||
. Border.borderWithLabel (Brick.txt layer_name)
|
||||
|
||||
-- I refuse to give this a type signature.
|
||||
|
||||
-- | Given a lens, zoom on it. It is needed because Brick uses microlens but GHCup uses optics.
|
||||
zoom l = Brick.zoom (toLensVL l)
|
||||
|
||||
data BrickData = BrickData
|
||||
{ _lr :: [ListResult]
|
||||
}
|
||||
deriving Show
|
||||
|
||||
makeLenses ''BrickData
|
||||
|
||||
data BrickSettings = BrickSettings { _showAllVersions :: Bool}
|
||||
--deriving Show
|
||||
|
||||
makeLenses ''BrickSettings
|
||||
|
||||
defaultAppSettings :: BrickSettings
|
||||
defaultAppSettings = BrickSettings False
|
||||
@@ -1,72 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
{-
|
||||
A very simple information-only widget with no handler.
|
||||
-}
|
||||
|
||||
module GHCup.Brick.Widgets.KeyInfo where
|
||||
|
||||
import GHCup.Types ( KeyBindings(..) )
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
|
||||
|
||||
import Brick
|
||||
( Padding(Max),
|
||||
Widget(..),
|
||||
(<+>),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Center ( center )
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
|
||||
|
||||
draw :: KeyBindings -> Widget Common.Name
|
||||
draw KeyBindings {..} =
|
||||
let
|
||||
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
|
||||
in Common.frontwardLayer "Key Actions"
|
||||
$ Brick.vBox [
|
||||
center $
|
||||
mkTextBox [
|
||||
Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, Common.keyToWidget bUp, Brick.txt " and ", Common.keyToWidget bDown
|
||||
, Brick.txtWrap " to navigate the list of tools"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, Common.keyToWidget bInstall
|
||||
, Brick.txtWrap " to install the selected tool. Notice, you may need to set it as default afterwards"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, Common.keyToWidget bSet
|
||||
, Brick.txtWrap " to set a tool as the one for use"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, Common.keyToWidget bUninstall
|
||||
, Brick.txtWrap " to uninstall a tool"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, Common.keyToWidget bChangelog
|
||||
, Brick.txtWrap " to open the tool's changelog. It will open a web browser"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "Press "
|
||||
, Common.keyToWidget bShowAllVersions
|
||||
, Brick.txtWrap " to show older version of each tool"
|
||||
]
|
||||
]
|
||||
]
|
||||
<=> Brick.hBox [Brick.txt "Press q to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]
|
||||
@@ -1,360 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
|
||||
|
||||
{- **************
|
||||
|
||||
A general system inspired by Brick.Form. It uses optics instead of microlenses and it is less generic than
|
||||
Brick.Form, but generic enough to serve our purpose.
|
||||
|
||||
A Menu consists in
|
||||
a) A state value
|
||||
b) A list of fields. Each field is capable of modifying a part of the state
|
||||
c) some metadata
|
||||
|
||||
A field (type MenuField) consists in
|
||||
a) a Lens to a part of the Menu state, so the Menu can call that lens to modify its own state
|
||||
b) an input widget
|
||||
|
||||
An input (type FieldInput) consist in
|
||||
a) some state
|
||||
b) a validator function
|
||||
c) a handler and a renderer
|
||||
|
||||
We have to use existential types to achive a composable API since every FieldInput has a different
|
||||
internal type, and every MenuField has a different Lens. For example:
|
||||
- The menu state is a record (MyRecord {uri: URI, flag : Bool})
|
||||
- Then, there are two MenuField:
|
||||
- One MenuField has (Lens' MyRecord URI) and the other has (Lens' MyRecord Bool)
|
||||
- The MenuFields has FieldInputs with internal state Text and Bool, respectively
|
||||
- Obviously, the MenuField has to be polimorphic in the Lens' and in the Input internal state,
|
||||
But we must hide that polimorphisim (existential), in order to store all MenuField in a List
|
||||
|
||||
************** -}
|
||||
|
||||
module GHCup.Brick.Widgets.Menu where
|
||||
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
|
||||
import Brick
|
||||
( BrickEvent(..),
|
||||
EventM,
|
||||
Widget(..),
|
||||
(<+>))
|
||||
import qualified Brick
|
||||
import qualified Brick.Widgets.Border as Border
|
||||
import qualified Brick.Widgets.List as L
|
||||
import qualified Brick.Widgets.Edit as Edit
|
||||
import Brick.Focus (FocusRing)
|
||||
import qualified Brick.Focus as F
|
||||
import Data.Function ( (&))
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
import Optics.TH (makeLensesFor)
|
||||
import qualified Graphics.Vty as Vty
|
||||
import Optics.State.Operators ((%=), (.=))
|
||||
import Optics.Optic ((%))
|
||||
import Optics.State (use)
|
||||
import GHCup.Types (KeyCombination)
|
||||
import Optics (Lens', to, lens)
|
||||
import Optics.Operators ( (^.), (.~) )
|
||||
import Data.Foldable (foldl')
|
||||
|
||||
|
||||
-- | Just some type synonym to make things explicit
|
||||
type Formatter n = Bool -> Widget n -> Widget n
|
||||
-- | A label
|
||||
type Label = T.Text
|
||||
-- | A help message of an entry
|
||||
type HelpMessage = T.Text
|
||||
-- | A button name
|
||||
type ButtonName n = n
|
||||
|
||||
idFormatter :: Formatter n
|
||||
idFormatter = const id
|
||||
|
||||
|
||||
-- | An error message
|
||||
type ErrorMessage = T.Text
|
||||
data ErrorStatus = Valid | Invalid ErrorMessage
|
||||
|
||||
-- | A lens which does nothing. Usefull to defined no-op fields
|
||||
emptyLens :: Lens' s ()
|
||||
emptyLens = lens (const ()) (\s _ -> s)
|
||||
|
||||
-- | A FieldInput is a pair label-content
|
||||
-- a - is the type of the field it manipulates
|
||||
-- b - is its internal state (modified in the gui)
|
||||
-- n - your application's resource name type
|
||||
data FieldInput a b n =
|
||||
FieldInput
|
||||
{ inputState :: b -- ^ The state of the input field (what's rendered in the screen)
|
||||
, inputValidator :: b -> Either ErrorMessage a -- ^ A validator function
|
||||
, inputHelp :: HelpMessage -- ^ The input helpMessage
|
||||
, inputRender :: Bool
|
||||
-> ErrorStatus
|
||||
-> HelpMessage
|
||||
-> b
|
||||
-> (Widget n -> Widget n)
|
||||
-> Widget n -- ^ How to draw the input, with focus a help message and input.
|
||||
-- A extension function can be applied too
|
||||
, inputHandler :: BrickEvent n () -> EventM n b () -- ^ The handler
|
||||
}
|
||||
|
||||
makeLensesFor
|
||||
[ ("inputState", "inputStateL")
|
||||
, ("inputValidator", "inputValidatorL")
|
||||
, ("inputName", "inputNameL")
|
||||
, ("inputHelp", "inputHelpL")
|
||||
]
|
||||
''FieldInput
|
||||
|
||||
-- | The MenuField is an existential type which stores a Lens' to a part of the Menu state.
|
||||
-- In also contains a Field input which internal state is hidden
|
||||
data MenuField s n where
|
||||
MenuField ::
|
||||
{ fieldAccesor :: Lens' s a -- ^ A Lens pointing to some part of the state
|
||||
, fieldInput :: FieldInput a b n -- ^ The input which modifies the state
|
||||
, fieldLabel :: Label -- ^ The label
|
||||
, fieldStatus :: ErrorStatus -- ^ Whether the current is valid or not.
|
||||
, fieldName :: n
|
||||
} -> MenuField s n
|
||||
|
||||
|
||||
makeLensesFor
|
||||
[ ("fieldLabel", "fieldLabelL")
|
||||
, ("fieldStatus", "fieldStatusL")
|
||||
]
|
||||
''MenuField
|
||||
|
||||
-- | A fancy lens to the help message
|
||||
fieldHelpMsgL :: Lens' (MenuField s n) HelpMessage
|
||||
fieldHelpMsgL = lens g s
|
||||
where g (MenuField {..})= fieldInput ^. inputHelpL
|
||||
s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..}
|
||||
|
||||
-- | How to draw a field given a formater
|
||||
drawField :: Formatter n -> Bool -> MenuField s n -> Widget n
|
||||
drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
|
||||
let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
|
||||
in if focus
|
||||
then Brick.visible input
|
||||
else input
|
||||
|
||||
instance Brick.Named (MenuField s n) n where
|
||||
getName :: MenuField s n -> n
|
||||
getName entry = entry & fieldName
|
||||
|
||||
|
||||
{- *****************
|
||||
CheckBox widget
|
||||
***************** -}
|
||||
|
||||
type CheckBoxField = MenuField
|
||||
|
||||
createCheckBoxInput :: FieldInput Bool Bool n
|
||||
createCheckBoxInput = FieldInput False Right "" checkBoxRender checkBoxHandler
|
||||
where
|
||||
border = Border.border . Brick.padRight (Brick.Pad 1) . Brick.padLeft (Brick.Pad 2)
|
||||
drawBool b =
|
||||
if b
|
||||
then border . Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign
|
||||
else border . Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign
|
||||
checkBoxRender focus _ help check f =
|
||||
let core = f $ drawBool check
|
||||
in if focus
|
||||
then core
|
||||
else core <+> (Brick.padLeft (Brick.Pad 1) . centerV . renderAsHelpMsg $ help)
|
||||
checkBoxHandler = \case
|
||||
VtyEvent (Vty.EvKey Vty.KEnter []) -> Brick.modify not
|
||||
_ -> pure ()
|
||||
|
||||
createCheckBoxField :: n -> Lens' s Bool -> CheckBoxField s n
|
||||
createCheckBoxField name access = MenuField access createCheckBoxInput "" Valid name
|
||||
|
||||
{- *****************
|
||||
Editable widget
|
||||
***************** -}
|
||||
|
||||
type EditableField = MenuField
|
||||
|
||||
createEditableInput :: (Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> FieldInput a (Edit.Editor T.Text n) n
|
||||
createEditableInput name validator = FieldInput initEdit validateEditContent "" drawEdit Edit.handleEditorEvent
|
||||
where
|
||||
drawEdit focus errMsg help edi amp =
|
||||
let
|
||||
borderBox = amp . Border.border . Brick.padRight Brick.Max
|
||||
editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi
|
||||
isEditorEmpty = Edit.getEditContents edi == [mempty]
|
||||
in case errMsg of
|
||||
Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help
|
||||
| otherwise -> borderBox editorRender
|
||||
Invalid msg
|
||||
| focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
|
||||
| focus -> borderBox editorRender
|
||||
| otherwise -> borderBox $ renderAsErrMsg msg
|
||||
validateEditContent = validator . T.unlines . Edit.getEditContents
|
||||
initEdit = Edit.editorText name (Just 1) ""
|
||||
|
||||
createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a -> EditableField s n
|
||||
createEditableField name validator access = MenuField access input "" Valid name
|
||||
where
|
||||
input = createEditableInput name validator
|
||||
|
||||
{- *****************
|
||||
Button widget
|
||||
***************** -}
|
||||
|
||||
type Button = MenuField
|
||||
|
||||
createButtonInput :: FieldInput () () n
|
||||
createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
|
||||
where drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
|
||||
|
||||
createButtonField :: n -> Button s n
|
||||
createButtonField = MenuField emptyLens createButtonInput "" Valid
|
||||
|
||||
{- *****************
|
||||
Utilities
|
||||
***************** -}
|
||||
|
||||
-- | highlights a widget (using List.listSelectedFocusedAttr)
|
||||
highlighted :: Widget n -> Widget n
|
||||
highlighted = Brick.withAttr L.listSelectedFocusedAttr
|
||||
|
||||
-- | Given a text, crates a highlighted label on focus. An amplifier can be passed
|
||||
renderAslabel :: T.Text -> Bool -> Widget n
|
||||
renderAslabel t focus =
|
||||
if focus
|
||||
then highlighted $ Brick.txt t
|
||||
else Brick.txt t
|
||||
|
||||
-- | Creates a left align column.
|
||||
-- Example: |- col2 is align dispite the length of col1
|
||||
-- row1_col1 row1_col2
|
||||
-- row2_col1_large row2_col2
|
||||
leftify :: Int -> Brick.Widget n -> Brick.Widget n
|
||||
leftify i = Brick.hLimit i . Brick.padRight Brick.Max
|
||||
|
||||
-- | center a line in three rows.
|
||||
centerV :: Widget n -> Widget n
|
||||
centerV = Brick.padTopBottom 1
|
||||
|
||||
-- | render some Text using helpMsgAttr
|
||||
renderAsHelpMsg :: T.Text -> Widget n
|
||||
renderAsHelpMsg = Brick.withAttr Attributes.helpMsgAttr . Brick.txt
|
||||
|
||||
-- | render some Text using errMsgAttr
|
||||
renderAsErrMsg :: T.Text -> Widget n
|
||||
renderAsErrMsg = Brick.withAttr Attributes.errMsgAttr . Brick.txt
|
||||
|
||||
{- *****************
|
||||
Menu widget
|
||||
***************** -}
|
||||
|
||||
-- | A menu is a list of Fields and a state. Informally we can think about s in terms of the record type returned by
|
||||
-- a form.
|
||||
data Menu s n
|
||||
= Menu
|
||||
{ menuFields :: [MenuField s n] -- ^ The datatype representing the list of entries. Precisely, any array-like data type is highly unconvinient.
|
||||
, menuState :: s
|
||||
, menuButtons :: [Button s n] -- ^ The buttons. Commonly, the handlers for buttons are defined outside the menu handler.
|
||||
, menuFocusRing :: FocusRing n -- ^ The focus ring with the resource name for each entry and each button, in the order you want to loop them.
|
||||
, menuExitKey :: KeyCombination -- ^ The key to exit the Menu
|
||||
, menuName :: n -- ^ The resource Name.
|
||||
}
|
||||
|
||||
|
||||
makeLensesFor
|
||||
[ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
|
||||
, ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
|
||||
, ("menuExitKey", "menuExitKeyL"), ("menuName", "menuNameL")
|
||||
]
|
||||
''Menu
|
||||
|
||||
createMenu :: n -> s -> KeyCombination -> [Button s n] -> [MenuField s n] -> Menu s n
|
||||
createMenu n initial exitK buttons fields = Menu fields initial buttons ring exitK n
|
||||
where ring = F.focusRing $ [field & fieldName | field <- fields] ++ [button & fieldName | button <- buttons]
|
||||
|
||||
handlerMenu :: forall n e s. Eq n => BrickEvent n e -> EventM n (Menu s n) ()
|
||||
handlerMenu ev =
|
||||
case ev of
|
||||
VtyEvent (Vty.EvKey (Vty.KChar '\t') []) -> menuFocusRingL %= F.focusNext
|
||||
VtyEvent (Vty.EvKey Vty.KBackTab []) -> menuFocusRingL %= F.focusPrev
|
||||
VtyEvent (Vty.EvKey Vty.KDown []) -> menuFocusRingL %= F.focusNext
|
||||
VtyEvent (Vty.EvKey Vty.KUp []) -> menuFocusRingL %= F.focusPrev
|
||||
VtyEvent e -> do
|
||||
focused <- use $ menuFocusRingL % to F.focusGetCurrent
|
||||
fields <- use menuFieldsL
|
||||
case focused of
|
||||
Nothing -> pure ()
|
||||
Just n -> do
|
||||
updated_fields <- updateFields n (VtyEvent e) fields
|
||||
menuFieldsL .= updated_fields
|
||||
_ -> pure ()
|
||||
where
|
||||
updateFields :: n -> BrickEvent n () -> [MenuField s n] -> EventM n (Menu s n) [MenuField s n]
|
||||
updateFields n e [] = pure []
|
||||
updateFields n e (x@(MenuField {fieldInput = i@(FieldInput {..}) , ..}):xs) =
|
||||
if Brick.getName x == n
|
||||
then do
|
||||
newb <- Brick.nestEventM' inputState (inputHandler e)
|
||||
let newField = MenuField {fieldInput = (FieldInput {inputState=newb, ..}) , ..}
|
||||
case inputValidator newb of
|
||||
Left errmsg -> pure $ (newField & fieldStatusL .~ Invalid errmsg):xs
|
||||
Right a -> menuStateL % fieldAccesor .= a >> pure ((newField & fieldStatusL .~ Valid):xs)
|
||||
else fmap (x:) (updateFields n e xs)
|
||||
|
||||
|
||||
drawMenu :: (Eq n, Ord n, Show n, Brick.Named (MenuField s n) n) => Menu s n -> Widget n
|
||||
drawMenu menu =
|
||||
Brick.vBox
|
||||
[ Brick.vBox buttonWidgets
|
||||
, Common.separator
|
||||
, Brick.withVScrollBars Brick.OnRight
|
||||
$ Brick.viewport (menu ^. menuNameL) Brick.Vertical
|
||||
$ Brick.vBox fieldWidgets
|
||||
, Brick.txt " "
|
||||
, Brick.padRight Brick.Max $
|
||||
Brick.txt "Press "
|
||||
<+> Common.keyToWidget (menu ^. menuExitKeyL)
|
||||
<+> Brick.txt " to go back"
|
||||
]
|
||||
where
|
||||
fieldLabels = [field & fieldLabel | field <- menu ^. menuFieldsL]
|
||||
buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
|
||||
allLabels = fieldLabels ++ buttonLabels
|
||||
|
||||
maxWidth = foldl' max 5 (fmap Brick.textWidth allLabels)
|
||||
|
||||
-- A list of functions which draw a highlighted label with right padding at the left of a widget.
|
||||
amplifiers =
|
||||
let labelsWidgets = fmap renderAslabel fieldLabels
|
||||
in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets
|
||||
drawFields = fmap drawField amplifiers
|
||||
fieldWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawFields (menu ^. menuFieldsL)
|
||||
|
||||
buttonAmplifiers =
|
||||
let buttonAsWidgets = fmap renderAslabel buttonLabels
|
||||
in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
|
||||
drawButtons = fmap drawField buttonAmplifiers
|
||||
buttonWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawButtons (menu ^. menuButtonsL)
|
||||
|
||||
|
||||
@@ -1,118 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
|
||||
|
||||
module GHCup.Brick.Widgets.Menus.AdvanceInstall (
|
||||
InstallOptions (..),
|
||||
AdvanceInstallMenu,
|
||||
create,
|
||||
handler,
|
||||
draw,
|
||||
instBindistL,
|
||||
instSetL,
|
||||
isolateDirL,
|
||||
forceInstallL,
|
||||
addConfArgsL,
|
||||
) where
|
||||
|
||||
import GHCup.Brick.Widgets.Menu (Menu)
|
||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
||||
import GHCup.Brick.Common(Name(..))
|
||||
import Brick
|
||||
( BrickEvent(..),
|
||||
EventM,
|
||||
Widget(..))
|
||||
import Prelude hiding ( appendFile )
|
||||
import Optics.TH (makeLensesFor)
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import GHCup.Types (KeyCombination)
|
||||
import URI.ByteString (URI)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import GHCup.Utils (parseURI)
|
||||
import Data.Bifunctor (Bifunctor(..))
|
||||
import Data.Function ((&))
|
||||
import Optics ((.~))
|
||||
import Data.Char (isSpace)
|
||||
|
||||
data InstallOptions = InstallOptions
|
||||
{ instBindist :: Maybe URI
|
||||
, instSet :: Bool
|
||||
, isolateDir :: Maybe FilePath
|
||||
, forceInstall :: Bool
|
||||
, addConfArgs :: [T.Text]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLensesFor [
|
||||
("instBindist", "instBindistL")
|
||||
, ("instSet", "instSetL")
|
||||
, ("isolateDir", "isolateDirL")
|
||||
, ("forceInstall", "forceInstallL")
|
||||
, ("addConfArgs", "addConfArgsL")
|
||||
]
|
||||
''InstallOptions
|
||||
|
||||
type AdvanceInstallMenu = Menu InstallOptions Name
|
||||
|
||||
create :: KeyCombination -> AdvanceInstallMenu
|
||||
create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields
|
||||
where
|
||||
initialState = InstallOptions Nothing False Nothing False []
|
||||
-- Brick's internal editor representation is [mempty].
|
||||
emptyEditor i = T.null i || (i == "\n")
|
||||
|
||||
uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI)
|
||||
uriValidator i =
|
||||
case not $ emptyEditor i of
|
||||
True -> bimap (T.pack . show) Just . parseURI . UTF8.fromString . T.unpack $ i
|
||||
False -> Right Nothing
|
||||
|
||||
filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
|
||||
filepathValidator i =
|
||||
case not $ emptyEditor i of
|
||||
True -> Right . Just . T.unpack $ i
|
||||
False -> Right Nothing
|
||||
|
||||
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
|
||||
additionalValidator = Right . T.split isSpace
|
||||
|
||||
fields =
|
||||
[ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL
|
||||
& Menu.fieldLabelL .~ "url"
|
||||
& Menu.fieldHelpMsgL .~ "Install the specified version from this bindist"
|
||||
, Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) instSetL
|
||||
& Menu.fieldLabelL .~ "set"
|
||||
& Menu.fieldHelpMsgL .~ "Set as active version after install"
|
||||
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL
|
||||
& Menu.fieldLabelL .~ "isolated"
|
||||
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
|
||||
, Menu.createCheckBoxField (Common.MenuElement Common.ForceCheckBox) forceInstallL
|
||||
& Menu.fieldLabelL .~ "force"
|
||||
& Menu.fieldHelpMsgL .~ "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)"
|
||||
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgsL
|
||||
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
|
||||
& Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
|
||||
]
|
||||
|
||||
ok = Menu.createButtonField (Common.MenuElement Common.OkButton)
|
||||
& Menu.fieldLabelL .~ "Advance Install"
|
||||
& Menu.fieldHelpMsgL .~ "Install with options below"
|
||||
|
||||
handler :: BrickEvent Name e -> EventM Name AdvanceInstallMenu ()
|
||||
handler = Menu.handlerMenu
|
||||
|
||||
|
||||
draw :: AdvanceInstallMenu -> Widget Name
|
||||
draw = Common.frontwardLayer "Advance Install" . Menu.drawMenu
|
||||
@@ -1,177 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
|
||||
|
||||
module GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCOptions, CompileGHCMenu, create, handler, draw) where
|
||||
|
||||
import GHCup.Brick.Widgets.Menu (Menu)
|
||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
||||
import GHCup.Brick.Common(Name(..))
|
||||
import Brick
|
||||
( BrickEvent(..),
|
||||
EventM,
|
||||
Widget(..))
|
||||
import Prelude hiding ( appendFile )
|
||||
import Optics.TH (makeLenses)
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import GHCup.Types (KeyCombination, BuildSystem (Hadrian))
|
||||
import URI.ByteString (URI)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import GHCup.Utils (parseURI)
|
||||
import Data.Bifunctor (Bifunctor(..))
|
||||
import Data.Function ((&))
|
||||
import Optics ((.~))
|
||||
import Data.Char (isSpace)
|
||||
import Data.Versions (Version, version)
|
||||
import System.FilePath (isPathSeparator)
|
||||
import Control.Applicative (Alternative((<|>)))
|
||||
import Text.Read (readEither)
|
||||
|
||||
data CompileGHCOptions = CompileGHCOptions
|
||||
{ _bootstrapGhc :: Either Version FilePath
|
||||
, _jobs :: Maybe Int
|
||||
, _buildConfig :: Maybe FilePath
|
||||
, _patches :: Maybe (Either FilePath [URI])
|
||||
, _crossTarget :: Maybe T.Text
|
||||
, _addConfArgs :: [T.Text]
|
||||
, _setCompile :: Bool
|
||||
, _ovewrwiteVer :: Maybe Version
|
||||
, _buildFlavour :: Maybe String
|
||||
, _buildSystem :: Maybe BuildSystem
|
||||
, _isolateDir :: Maybe FilePath
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''CompileGHCOptions
|
||||
|
||||
type CompileGHCMenu = Menu CompileGHCOptions Name
|
||||
|
||||
create :: KeyCombination -> CompileGHCMenu
|
||||
create k = Menu.createMenu CompileGHCBox initialState k buttons fields
|
||||
where
|
||||
initialState =
|
||||
CompileGHCOptions
|
||||
(Right "")
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
[]
|
||||
False
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
-- Brick's internal editor representation is [mempty].
|
||||
emptyEditor i = T.null i || (i == "\n")
|
||||
whenEmpty :: a -> (T.Text -> Either Menu.ErrorMessage a) -> T.Text -> Either Menu.ErrorMessage a
|
||||
whenEmpty emptyval f i = if not (emptyEditor i) then f i else Right emptyval
|
||||
|
||||
bootstrapV :: T.Text -> Either Menu.ErrorMessage (Either Version FilePath)
|
||||
bootstrapV i =
|
||||
case not $ emptyEditor i of
|
||||
True ->
|
||||
let readVersion = bimap (const "Not a valid version") Left (version (T.init i)) -- Brick adds \n at the end, hence T.init
|
||||
readPath
|
||||
= if isPathSeparator (T.head i)
|
||||
then pure $ Right (T.unpack i)
|
||||
else Left "Not an absolute Path"
|
||||
in if T.any isPathSeparator i
|
||||
then readPath
|
||||
else readVersion
|
||||
False -> Left "Invalid Empty value"
|
||||
|
||||
versionV :: T.Text -> Either Menu.ErrorMessage (Maybe Version)
|
||||
versionV = bimap (const "Not a valid version") Just . version . T.init -- Brick adds \n at the end, hence T.init
|
||||
|
||||
jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
|
||||
jobsV =
|
||||
let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack
|
||||
in whenEmpty Nothing parseInt
|
||||
|
||||
patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
|
||||
patchesV = whenEmpty Nothing readPatches
|
||||
where
|
||||
readUri :: T.Text -> Either String URI
|
||||
readUri = first show . parseURI . UTF8.fromString . T.unpack
|
||||
readPatches j =
|
||||
let
|
||||
x = (bimap T.unpack (fmap Left) $ filepathV j)
|
||||
y = second (Just . Right) $ traverse readUri (T.split isSpace j)
|
||||
in first T.pack $ x <|> y
|
||||
|
||||
filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
|
||||
filepathV = whenEmpty Nothing (Right . Just . T.unpack)
|
||||
|
||||
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
|
||||
additionalValidator = Right . T.split isSpace
|
||||
|
||||
systemV :: T.Text -> Either Menu.ErrorMessage (Maybe BuildSystem)
|
||||
systemV = whenEmpty Nothing readSys
|
||||
where
|
||||
readSys i
|
||||
| T.toLower i == "hadrian" = Right $ Just Hadrian
|
||||
| T.toLower i == "make" = Right $ Just Hadrian
|
||||
| otherwise = Left "Not a valid Build System"
|
||||
|
||||
fields =
|
||||
[ Menu.createEditableField (Common.MenuElement Common.BootstrapGhcEditBox) bootstrapV bootstrapGhc
|
||||
& Menu.fieldLabelL .~ "bootstrap-ghc"
|
||||
& Menu.fieldHelpMsgL .~ "The GHC version (or full path) to bootstrap with (must be installed)"
|
||||
& Menu.fieldStatusL .~ Menu.Invalid "Invalid Empty value"
|
||||
, Menu.createEditableField (Common.MenuElement Common.JobsEditBox) jobsV jobs
|
||||
& Menu.fieldLabelL .~ "jobs"
|
||||
& Menu.fieldHelpMsgL .~ "How many jobs to use for make"
|
||||
, Menu.createEditableField (Common.MenuElement Common.BuildConfigEditBox) filepathV buildConfig
|
||||
& Menu.fieldLabelL .~ "build config"
|
||||
& Menu.fieldHelpMsgL .~ "Absolute path to build config file"
|
||||
, Menu.createEditableField (Common.MenuElement Common.PatchesEditBox) patchesV patches
|
||||
& Menu.fieldLabelL .~ "patches"
|
||||
& Menu.fieldHelpMsgL .~ "Either a URI to a patch (https/http/file) or Absolute path to patch directory"
|
||||
, Menu.createEditableField (Common.MenuElement Common.CrossTargetEditBox) (Right . Just) crossTarget
|
||||
& Menu.fieldLabelL .~ "cross target"
|
||||
& Menu.fieldHelpMsgL .~ "Build cross-compiler for this platform"
|
||||
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgs
|
||||
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
|
||||
& Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
|
||||
, Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) setCompile
|
||||
& Menu.fieldLabelL .~ "set"
|
||||
& Menu.fieldHelpMsgL .~ "Set as active version after install"
|
||||
, Menu.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) versionV ovewrwiteVer
|
||||
& Menu.fieldLabelL .~ "overwrite-version"
|
||||
& Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
|
||||
, Menu.createEditableField (Common.MenuElement Common.BuildFlavourEditBox) (Right . Just . T.unpack) buildFlavour
|
||||
& Menu.fieldLabelL .~ "flavour"
|
||||
& Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
||||
, Menu.createEditableField (Common.MenuElement Common.BuildSystemEditBox) systemV buildSystem
|
||||
& Menu.fieldLabelL .~ "build system"
|
||||
& Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
||||
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathV isolateDir
|
||||
& Menu.fieldLabelL .~ "isolated"
|
||||
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
|
||||
]
|
||||
|
||||
buttons = [
|
||||
Menu.createButtonField (Common.MenuElement Common.OkButton)
|
||||
& Menu.fieldLabelL .~ "Compile"
|
||||
& Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
|
||||
]
|
||||
|
||||
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
|
||||
handler = Menu.handlerMenu
|
||||
|
||||
|
||||
draw :: CompileGHCMenu -> Widget Name
|
||||
draw = Common.frontwardLayer "Compile GHC" . Menu.drawMenu
|
||||
@@ -1,78 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Brick.Widgets.Menus.Context (ContextMenu, create, draw, handler) where
|
||||
|
||||
import Brick (
|
||||
Widget (..), BrickEvent, EventM,
|
||||
)
|
||||
import Data.Function ((&))
|
||||
import Prelude hiding (appendFile)
|
||||
|
||||
import Data.Versions (prettyVer)
|
||||
import GHCup.List ( ListResult(..) )
|
||||
import GHCup.Types (KeyCombination, Tool (..))
|
||||
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
||||
import GHCup.Brick.Common (Name (..))
|
||||
import GHCup.Brick.Widgets.Menu (Menu)
|
||||
import qualified Brick.Widgets.Core as Brick
|
||||
import qualified Brick.Widgets.Border as Border
|
||||
import qualified Brick.Focus as F
|
||||
import Brick.Widgets.Core ((<+>))
|
||||
|
||||
import Optics (to)
|
||||
import Optics.Operators ((.~), (^.))
|
||||
import Optics.Optic ((%))
|
||||
import Data.Foldable (foldl')
|
||||
|
||||
type ContextMenu = Menu ListResult Name
|
||||
|
||||
create :: ListResult -> KeyCombination -> ContextMenu
|
||||
create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
|
||||
where
|
||||
advInstallButton =
|
||||
Menu.createButtonField (MenuElement Common.AdvanceInstallButton)
|
||||
& Menu.fieldLabelL .~ "Install"
|
||||
& Menu.fieldHelpMsgL .~ "Advance Installation Settings"
|
||||
compileButton =
|
||||
Menu.createButtonField (MenuElement Common.CompilieButton)
|
||||
& Menu.fieldLabelL .~ "Compile"
|
||||
& Menu.fieldHelpMsgL .~ "Compile tool from source"
|
||||
buttons =
|
||||
case lTool lr of
|
||||
GHC -> [advInstallButton, compileButton]
|
||||
HLS -> [advInstallButton, compileButton]
|
||||
_ -> [advInstallButton]
|
||||
|
||||
draw :: ContextMenu -> Widget Name
|
||||
draw menu =
|
||||
Common.frontwardLayer
|
||||
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
|
||||
$ Brick.vBox
|
||||
[ Brick.vBox buttonWidgets
|
||||
, Brick.txt " "
|
||||
, Brick.padRight Brick.Max $
|
||||
Brick.txt "Press "
|
||||
<+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
|
||||
<+> Brick.txt " to go back"
|
||||
]
|
||||
where
|
||||
buttonLabels = [button & Menu.fieldLabel | button <- menu ^. Menu.menuButtonsL]
|
||||
maxWidth = foldl' max 5 (fmap Brick.textWidth buttonLabels)
|
||||
|
||||
buttonAmplifiers =
|
||||
let buttonAsWidgets = fmap Menu.renderAslabel buttonLabels
|
||||
in fmap (\f b -> ((Menu.leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
|
||||
drawButtons = fmap Menu.drawField buttonAmplifiers
|
||||
buttonWidgets = zipWith (F.withFocusRing (menu ^. Menu.menuFocusRingL)) drawButtons (menu ^. Menu.menuButtonsL)
|
||||
tool_str =
|
||||
case menu ^. Menu.menuStateL % to lTool of
|
||||
GHC -> "GHC"
|
||||
GHCup -> "GHCup"
|
||||
Cabal -> "Cabal"
|
||||
HLS -> "HLS"
|
||||
Stack -> "Stack"
|
||||
|
||||
handler :: BrickEvent Name e -> EventM Name ContextMenu ()
|
||||
handler = Menu.handlerMenu
|
||||
@@ -1,148 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
{- Brick's navigation widget:
|
||||
It is a FocusRing over many list's. Each list contains the information for each tool. Each list has an internal name (for Brick's runtime)
|
||||
and a label which we can use in rendering. This data-structure helps to reuse Brick.Widget.List and to navegate easily across
|
||||
|
||||
-}
|
||||
|
||||
|
||||
module GHCup.Brick.Widgets.Navigation (BrickInternalState, create, handler, draw) where
|
||||
|
||||
import GHCup.List ( ListResult(..) )
|
||||
import GHCup.Types
|
||||
( GHCTargetVersion(GHCTargetVersion),
|
||||
Tool(..),
|
||||
Tag(..),
|
||||
tVerToText,
|
||||
tagToString )
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
import qualified GHCup.Brick.Widgets.SectionList as SectionList
|
||||
import Brick
|
||||
( BrickEvent(..),
|
||||
Padding(Max, Pad),
|
||||
AttrMap,
|
||||
EventM,
|
||||
Widget(..),
|
||||
(<+>),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Border ( hBorder, borderWithLabel)
|
||||
import Brick.Widgets.Border.Style ( unicode )
|
||||
import Brick.Widgets.Center ( center )
|
||||
import qualified Brick.Widgets.List as L
|
||||
import Data.List ( intercalate, sort )
|
||||
import Data.Maybe ( mapMaybe )
|
||||
import Data.Vector ( Vector)
|
||||
import Data.Versions ( prettyPVP, prettyVer )
|
||||
import Prelude hiding ( appendFile )
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
|
||||
|
||||
type BrickInternalState = SectionList.SectionList Common.Name ListResult
|
||||
|
||||
-- | How to create a navigation widget
|
||||
create :: Common.Name -- The name of the section list
|
||||
-> [(Common.Name, Vector ListResult)] -- a list of tuples (section name, collection of elements)
|
||||
-> Int -- The height of each item in a list. Commonly 1
|
||||
-> BrickInternalState
|
||||
create = SectionList.sectionList
|
||||
|
||||
-- | How the navigation handler handle events
|
||||
handler :: BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()
|
||||
handler = SectionList.handleGenericListEvent
|
||||
|
||||
-- | How to draw the navigation widget
|
||||
draw :: AttrMap -> BrickInternalState -> Widget Common.Name
|
||||
draw dimAttrs section_list
|
||||
= Brick.padBottom Max
|
||||
( Brick.withBorderStyle unicode
|
||||
$ borderWithLabel (Brick.str "GHCup")
|
||||
(center (header <=> hBorder <=> renderList' section_list))
|
||||
)
|
||||
where
|
||||
header =
|
||||
minHSize 2 Brick.emptyWidget
|
||||
<+> Brick.padLeft (Pad 2) (minHSize 6 $ Brick.str "Tool")
|
||||
<+> minHSize 15 (Brick.str "Version")
|
||||
<+> Brick.padLeft (Pad 1) (minHSize 25 $ Brick.str "Tags")
|
||||
<+> Brick.padLeft (Pad 5) (Brick.str "Notes")
|
||||
renderList' bis =
|
||||
let allElements = V.concatMap L.listElements $ SectionList.sectionListElements bis
|
||||
minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) allElements
|
||||
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) allElements
|
||||
in Brick.withDefAttr L.listAttr $ SectionList.renderSectionList (renderItem minTagSize minVerSize) True bis
|
||||
renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} =
|
||||
let marks = if
|
||||
| lSet -> (Brick.withAttr Attributes.setAttr $ Brick.str Common.setSign)
|
||||
| lInstalled -> (Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign)
|
||||
| otherwise -> (Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign)
|
||||
ver = case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
dim
|
||||
| lNoBindist && not lInstalled
|
||||
&& not b -- TODO: overloading dim and active ignores active
|
||||
-- so we hack around it here
|
||||
= Brick.updateAttrMap (const dimAttrs) . Brick.withAttr (Brick.attrName "no-bindist")
|
||||
| otherwise = id
|
||||
hooray
|
||||
| elem Latest lTag' && not lInstalled =
|
||||
Brick.withAttr Attributes.hoorayAttr
|
||||
| otherwise = id
|
||||
in hooray $ dim
|
||||
( marks
|
||||
<+> Brick.padLeft (Pad 2)
|
||||
( minHSize 6
|
||||
(printTool lTool)
|
||||
)
|
||||
<+> minHSize minVerSize (Brick.str ver)
|
||||
<+> (let l = mapMaybe printTag $ sort lTag'
|
||||
in Brick.padLeft (Pad 1) $ minHSize minTagSize $ if null l
|
||||
then Brick.emptyWidget
|
||||
else foldr1 (\x y -> x <+> Brick.str "," <+> y) l
|
||||
)
|
||||
<+> Brick.padLeft (Pad 5)
|
||||
( let notes = printNotes listResult
|
||||
in if null notes
|
||||
then Brick.emptyWidget
|
||||
else foldr1 (\x y -> x <+> Brick.str "," <+> y) notes
|
||||
)
|
||||
<+> Brick.vLimit 1 (Brick.fill ' ')
|
||||
)
|
||||
|
||||
printTag Recommended = Just $ Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
|
||||
printTag Latest = Just $ Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
|
||||
printTag Prerelease = Just $ Brick.withAttr Attributes.prereleaseAttr $ Brick.str "prerelease"
|
||||
printTag Nightly = Just $ Brick.withAttr Attributes.nightlyAttr $ Brick.str "nightly"
|
||||
printTag (Base pvp'') = Just $ Brick.str ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||
printTag Old = Nothing
|
||||
printTag LatestPrerelease = Just $ Brick.withAttr Attributes.latestPrereleaseAttr $ Brick.str "latest-prerelease"
|
||||
printTag LatestNightly = Just $ Brick.withAttr Attributes.latestNightlyAttr $ Brick.str "latest-nightly"
|
||||
printTag (UnknownTag t) = Just $ Brick.str t
|
||||
|
||||
printTool Cabal = Brick.str "cabal"
|
||||
printTool GHC = Brick.str "GHC"
|
||||
printTool GHCup = Brick.str "GHCup"
|
||||
printTool HLS = Brick.str "HLS"
|
||||
printTool Stack = Brick.str "Stack"
|
||||
|
||||
printNotes ListResult {..} =
|
||||
(if hlsPowered then [Brick.withAttr Attributes.hlsPoweredAttr $ Brick.str "hls-powered"] else mempty
|
||||
)
|
||||
++ (if lStray then [Brick.withAttr Attributes.strayAttr $ Brick.str "stray"] else mempty)
|
||||
++ (case lReleaseDay of
|
||||
Nothing -> mempty
|
||||
Just d -> [Brick.withAttr Attributes.dayAttr $ Brick.str (show d)])
|
||||
|
||||
minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ')
|
||||
@@ -1,193 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
|
||||
{- A general system for lists with sections
|
||||
|
||||
Consider this code as private. GenericSectionList should not be used directly as the FocusRing should be align with the Vector containing
|
||||
the elements, otherwise you'd be focusing on a non-existent widget with unknown result (In theory the code is safe unless you have an empty section list).
|
||||
|
||||
- To build a SectionList use the safe constructor sectionList
|
||||
- To access sections use the lens provider sectionL and the name of the section you'd like to access
|
||||
- You can modify Brick.Widget.List.GenericList within GenericSectionList via sectionL but do not
|
||||
modify the vector length
|
||||
|
||||
-}
|
||||
|
||||
|
||||
module GHCup.Brick.Widgets.SectionList where
|
||||
|
||||
|
||||
import Brick
|
||||
( BrickEvent(VtyEvent, MouseDown),
|
||||
EventM,
|
||||
Size(..),
|
||||
Widget(..),
|
||||
ViewportType (Vertical),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Border ( hBorder)
|
||||
import qualified Brick.Widgets.List as L
|
||||
import Brick.Focus (FocusRing)
|
||||
import qualified Brick.Focus as F
|
||||
import Data.Function ( (&))
|
||||
import Data.Maybe ( fromMaybe )
|
||||
import Data.Vector ( Vector )
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import Optics.TH (makeLensesFor)
|
||||
import Optics.State (use)
|
||||
import Optics.State.Operators ( (%=), (<%=))
|
||||
import Optics.Operators ((.~), (^.))
|
||||
import Optics.Lens (Lens', lens)
|
||||
|
||||
data GenericSectionList n t e
|
||||
= GenericSectionList
|
||||
{ sectionListFocusRing :: FocusRing n -- ^ The FocusRing for all sections
|
||||
, sectionListElements :: !(Vector (L.GenericList n t e)) -- ^ A vector of brick's built-in list
|
||||
, sectionListName :: n -- ^ The section list name
|
||||
}
|
||||
|
||||
makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListElements", "sectionListElementsL"), ("sectionListName", "sectionListNameL")] ''GenericSectionList
|
||||
|
||||
type SectionList n e = GenericSectionList n V.Vector e
|
||||
|
||||
|
||||
-- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses.
|
||||
sectionList :: Foldable t
|
||||
=> n -- The name of the section list
|
||||
-> [(n, t e)] -- a list of tuples (section name, collection of elements)
|
||||
-> Int
|
||||
-> GenericSectionList n t e
|
||||
sectionList name elements height
|
||||
= GenericSectionList
|
||||
{ sectionListFocusRing = F.focusRing [section_name | (section_name, _) <- elements]
|
||||
, sectionListElements = V.fromList [L.list section_name els height | (section_name, els) <- elements]
|
||||
, sectionListName = name
|
||||
}
|
||||
-- | This lens constructor, takes a name and looks if a section has such a name.
|
||||
-- Used to dispatch events to sections. It is a partial function only meant to
|
||||
-- be used with the FocusRing inside GenericSectionList
|
||||
sectionL :: Eq n => n -> Lens' (GenericSectionList n t e) (L.GenericList n t e)
|
||||
sectionL section_name = lens g s
|
||||
where is_section_name = (== section_name) . L.listName
|
||||
g section_list =
|
||||
let elms = section_list ^. sectionListElementsL
|
||||
zeroth = elms V.! 0 -- TODO: This crashes for empty vectors.
|
||||
in fromMaybe zeroth (V.find is_section_name elms)
|
||||
s gl@(GenericSectionList _ elms _) list =
|
||||
case V.findIndex is_section_name elms of
|
||||
Nothing -> gl
|
||||
Just i -> let new_elms = V.update elms (V.fromList [(i, list)])
|
||||
in gl & sectionListElementsL .~ new_elms
|
||||
|
||||
moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
|
||||
moveDown = do
|
||||
ring <- use sectionListFocusRingL
|
||||
case F.focusGetCurrent ring of
|
||||
Nothing -> pure ()
|
||||
Just l -> do -- If it is the last element, move to the first element of the next focus; else, just handle regular list event.
|
||||
current_list <- use (sectionL l)
|
||||
let current_idx = L.listSelected current_list
|
||||
list_length = current_list & length
|
||||
if current_idx == Just (list_length - 1)
|
||||
then do
|
||||
new_focus <- sectionListFocusRingL <%= F.focusNext
|
||||
case F.focusGetCurrent new_focus of
|
||||
Nothing -> pure () -- |- Optic.Zoom.zoom doesn't typecheck but Lens.Micro.Mtl.zoom does. It is re-exported by Brick
|
||||
Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToBeginning)
|
||||
else Common.zoom (sectionL l) $ Brick.modify L.listMoveDown
|
||||
|
||||
moveUp :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) ()
|
||||
moveUp = do
|
||||
ring <- use sectionListFocusRingL
|
||||
case F.focusGetCurrent ring of
|
||||
Nothing -> pure ()
|
||||
Just l -> do -- If it is the first element, move to the last element of the prev focus; else, just handle regular list event.
|
||||
current_list <- use (sectionL l)
|
||||
let current_idx = L.listSelected current_list
|
||||
if current_idx == Just 0
|
||||
then do
|
||||
new_focus <- sectionListFocusRingL <%= F.focusPrev
|
||||
case F.focusGetCurrent new_focus of
|
||||
Nothing -> pure ()
|
||||
Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd)
|
||||
else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp
|
||||
|
||||
-- | Handle events for list cursor movement. Events handled are:
|
||||
--
|
||||
-- * Up (up arrow key). If first element of section, then jump prev section
|
||||
-- * Down (down arrow key). If last element of section, then jump next section
|
||||
-- * Page Up (PgUp)
|
||||
-- * Page Down (PgDown)
|
||||
-- * Go to next section (Tab)
|
||||
-- * Go to prev section (BackTab)
|
||||
handleGenericListEvent :: (Foldable t, L.Splittable t, Ord n)
|
||||
=> BrickEvent n a
|
||||
-> EventM n (GenericSectionList n t e) ()
|
||||
handleGenericListEvent (VtyEvent (Vty.EvResize _ _)) = pure ()
|
||||
handleGenericListEvent (VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = sectionListFocusRingL %= F.focusNext
|
||||
handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KBackTab [])) = sectionListFocusRingL %= F.focusPrev
|
||||
handleGenericListEvent (MouseDown _ Vty.BScrollDown _ _) = moveDown
|
||||
handleGenericListEvent (MouseDown _ Vty.BScrollUp _ _) = moveUp
|
||||
handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KDown [])) = moveDown
|
||||
handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KUp [])) = moveUp
|
||||
handleGenericListEvent (VtyEvent ev) = do
|
||||
ring <- use sectionListFocusRingL
|
||||
case F.focusGetCurrent ring of
|
||||
Nothing -> pure ()
|
||||
Just l -> Common.zoom (sectionL l) $ L.handleListEvent ev
|
||||
handleGenericListEvent _ = pure ()
|
||||
|
||||
-- This re-uses Brick.Widget.List.renderList
|
||||
renderSectionList :: forall n t e . (Traversable t, Ord n, Show n, Eq n, L.Splittable t, Semigroup (t e))
|
||||
=> (Bool -> e -> Widget n) -- ^ Rendering function of the list element, True for the selected element
|
||||
-> Bool -- ^ Whether the section list has focus
|
||||
-> GenericSectionList n t e -- ^ The section list to render
|
||||
-> Widget n
|
||||
renderSectionList renderElem sectionFocus ge@(GenericSectionList focus elms slName) =
|
||||
Brick.Widget Brick.Greedy Brick.Greedy $ Brick.render $ Brick.viewport slName Brick.Vertical $
|
||||
V.ifoldl' (\(!accWidget) !i list ->
|
||||
let hasFocusList = sectionIsFocused list
|
||||
makeVisible = if hasFocusList then Brick.visibleRegion (Brick.Location (c, r)) (1, 1) else id
|
||||
appendBorder = if i == 0 then id else (hBorder <=>)
|
||||
newWidget = appendBorder (makeVisible $ renderInnerList hasFocusList list)
|
||||
in accWidget <=> newWidget
|
||||
)
|
||||
Brick.emptyWidget
|
||||
elms
|
||||
where
|
||||
-- A section is focused if the whole thing is focused, and the inner list has focus
|
||||
sectionIsFocused :: L.GenericList n t e -> Bool
|
||||
sectionIsFocused l = sectionFocus && (Just (L.listName l) == F.focusGetCurrent focus)
|
||||
|
||||
renderInnerList :: Bool -> L.GenericList n t e -> Widget n
|
||||
renderInnerList hasFocus l = Brick.vLimit (length l) $ L.renderList (\b -> renderElem (b && hasFocus)) hasFocus l
|
||||
|
||||
-- compute the location to focus on within the active section
|
||||
(c, r) :: (Int, Int) = case sectionListSelectedElement ge of
|
||||
Nothing -> (0, 0)
|
||||
Just (selElIx, _) -> (0, selElIx)
|
||||
|
||||
|
||||
-- | Equivalent to listSelectedElement
|
||||
sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e)
|
||||
sectionListSelectedElement generic_section_list = do
|
||||
current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent
|
||||
let current_section = generic_section_list ^. sectionL current_focus
|
||||
L.listSelectedElement current_section
|
||||
@@ -1,77 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
{-
|
||||
A very simple information-only widget with no handler.
|
||||
-}
|
||||
|
||||
module GHCup.Brick.Widgets.Tutorial (draw) where
|
||||
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
|
||||
import Brick
|
||||
( Padding(Max),
|
||||
Widget(..),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Center ( center )
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
|
||||
|
||||
draw :: Widget Common.Name
|
||||
draw =
|
||||
let
|
||||
mkTextBox = Brick.hLimitPercent 70 . Brick.vBox . fmap (Brick.padRight Brick.Max)
|
||||
|
||||
in Common.frontwardLayer "Tutorial"
|
||||
$ Brick.vBox
|
||||
(fmap center
|
||||
[ mkTextBox [Brick.txtWrap "GHCup is a distribution channel for Haskell's tools."]
|
||||
, Common.separator
|
||||
, mkTextBox [
|
||||
Brick.hBox [
|
||||
Brick.txt "This symbol "
|
||||
, Brick.withAttr Attributes.installedAttr (Brick.str Common.installedSign)
|
||||
, Brick.txtWrap " means that the tool is installed but not in used"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "This symbol "
|
||||
, Brick.withAttr Attributes.setAttr (Brick.str Common.setSign)
|
||||
, Brick.txtWrap " means that the tool is installed and in used"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.txt "This symbol "
|
||||
, Brick.withAttr Attributes.notInstalledAttr (Brick.str Common.notInstalledSign)
|
||||
, Brick.txt " means that the tool isn't installed"
|
||||
]
|
||||
]
|
||||
, Common.separator
|
||||
, mkTextBox [
|
||||
Brick.hBox [
|
||||
Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
|
||||
, Brick.txtWrap " tag is based on community adoption, known bugs, etc... So It makes this version the least experimental"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
|
||||
, Brick.txtWrap " tag is for the latest distributed version of the tool"
|
||||
]
|
||||
, Brick.hBox [
|
||||
Brick.withAttr Attributes.latestAttr $ Brick.str "hls-powered"
|
||||
, Brick.txt " denotes the compiler version supported by the currently set ("
|
||||
, Brick.withAttr Attributes.setAttr (Brick.str Common.setSign)
|
||||
, Brick.txt ") hls"
|
||||
]
|
||||
, Brick.txtWrap "base-X.Y.Z.W tag is the minimun version of the base package admited in such ghc version"
|
||||
]
|
||||
, Brick.txt " "
|
||||
])
|
||||
<=> Brick.padRight Brick.Max (Brick.txt "Press q to exit the tutorial")
|
||||
@@ -1,76 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
{-
|
||||
This module contains the entrypoint for the brick application and nothing else.
|
||||
|
||||
-}
|
||||
|
||||
module GHCup.BrickMain where
|
||||
|
||||
import GHCup.Types
|
||||
( Settings(noColor),
|
||||
AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..) )
|
||||
import GHCup.Prelude.Logger ( logError )
|
||||
import qualified GHCup.Brick.Actions as Actions
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.App as BrickApp
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
import qualified GHCup.Brick.BrickState as AppState
|
||||
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
|
||||
import qualified GHCup.Brick.Widgets.SectionList as Navigation
|
||||
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
|
||||
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
|
||||
import qualified Brick
|
||||
|
||||
import Control.Monad.Reader ( ReaderT(runReaderT) )
|
||||
import Data.Functor ( ($>) )
|
||||
import Data.IORef (writeIORef)
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit ( ExitCode(ExitFailure), exitWith )
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
|
||||
brickMain :: AppState
|
||||
-> IO ()
|
||||
brickMain s = do
|
||||
writeIORef Actions.settings' s
|
||||
|
||||
eAppData <- Actions.getAppData (Just $ ghcupInfo s)
|
||||
case eAppData of
|
||||
Right ad -> do
|
||||
let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
|
||||
current_element = Navigation.sectionListSelectedElement initial_list
|
||||
exit_key = bQuit . keyBindings $ s
|
||||
case current_element of
|
||||
Nothing -> do
|
||||
flip runReaderT s $ logError "Error building app state: empty ResultList"
|
||||
exitWith $ ExitFailure 2
|
||||
Just (_, e) ->
|
||||
let initapp =
|
||||
BrickApp.app
|
||||
(Attributes.defaultAttributes $ noColor $ settings s)
|
||||
(Attributes.dimAttributes $ noColor $ settings s)
|
||||
initstate =
|
||||
AppState.BrickState ad
|
||||
Common.defaultAppSettings
|
||||
initial_list
|
||||
(ContextMenu.create e exit_key)
|
||||
(AdvanceInstall.create (bQuit . keyBindings $ s ))
|
||||
(CompileGHC.create exit_key)
|
||||
(keyBindings s)
|
||||
Common.Navigation
|
||||
in Brick.defaultMain initapp initstate
|
||||
$> ()
|
||||
Left e -> do
|
||||
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
|
||||
exitWith $ ExitFailure 2
|
||||
@@ -92,8 +92,6 @@ import qualified Data.Yaml.Aeson as Y
|
||||
|
||||
|
||||
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -807,7 +807,7 @@ compileGHC :: ( MonadMask m
|
||||
)
|
||||
=> GHCVer
|
||||
-> Maybe Text -- ^ cross target
|
||||
-> Maybe [VersionPattern]
|
||||
-> Maybe Version -- ^ overwrite version
|
||||
-> Either Version FilePath -- ^ version to bootstrap with
|
||||
-> Maybe Int -- ^ jobs
|
||||
-> Maybe FilePath -- ^ build config
|
||||
@@ -843,12 +843,12 @@ compileGHC :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
GHCTargetVersion
|
||||
compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||
= do
|
||||
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
(workdir, tmpUnpack, tver, ov) <- case targetGhc of
|
||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||
-- unpack from version tarball
|
||||
SourceDist ver -> do
|
||||
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||
@@ -870,11 +870,7 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
|
||||
(view dlSubdir dlInfo)
|
||||
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern (Just ver) "" "" "" "" vps'
|
||||
Nothing -> pure Nothing
|
||||
|
||||
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver), ov)
|
||||
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
|
||||
|
||||
RemoteDist uri -> do
|
||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||
@@ -898,17 +894,13 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern tver "" "" "" "" vps'
|
||||
Nothing -> pure Nothing
|
||||
|
||||
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver, ov)
|
||||
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||
|
||||
-- clone from git
|
||||
GitDist GitBranch{..} -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
|
||||
(tver, ov) <- cleanUpOnError tmpUnpack $ reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
|
||||
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
|
||||
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
|
||||
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
||||
lEM $ git [ "init" ]
|
||||
@@ -940,7 +932,6 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
|
||||
then pure Nothing
|
||||
else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
||||
chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||
branch <- liftE $ gitOut ["rev-parse", "--abbrev-ref", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||
|
||||
-- clone submodules
|
||||
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
|
||||
@@ -958,19 +949,9 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
|
||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
||||
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern
|
||||
tver
|
||||
(take 7 $ T.unpack chash)
|
||||
(T.unpack chash)
|
||||
(maybe "" T.unpack git_describe)
|
||||
(T.unpack branch)
|
||||
vps'
|
||||
Nothing -> pure Nothing
|
||||
pure tver
|
||||
|
||||
pure (tver, ov)
|
||||
|
||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver, ov)
|
||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
|
||||
-- the version that's installed may differ from the
|
||||
-- compiled version, so the user can overwrite it
|
||||
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
||||
@@ -1110,7 +1091,7 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
|
||||
compileHadrianBindist tver workdir ghcdir = do
|
||||
liftE $ configureBindist tver workdir ghcdir
|
||||
|
||||
lift $ logInfo $ "Building GHC version " <> tVerToText tver <> " (this may take a while)..."
|
||||
lift $ logInfo "Building (this may take a while)..."
|
||||
hadrian_build <- liftE $ findHadrianFile workdir
|
||||
lEM $ execLogged hadrian_build
|
||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||
@@ -1182,7 +1163,7 @@ compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buil
|
||||
|
||||
liftE $ checkBuildConfig (build_mk workdir)
|
||||
|
||||
lift $ logInfo $ "Building GHC version " <> tVerToText tver <> " (this may take a while)..."
|
||||
lift $ logInfo "Building (this may take a while)..."
|
||||
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
|
||||
|
||||
if | isCross tver -> do
|
||||
|
||||
@@ -335,7 +335,7 @@ compileHLS :: ( MonadMask m
|
||||
=> HLSVer
|
||||
-> [Version]
|
||||
-> Maybe Int
|
||||
-> Maybe [VersionPattern]
|
||||
-> Either Bool Version
|
||||
-> InstallDir
|
||||
-> Maybe (Either FilePath URI)
|
||||
-> Maybe URI
|
||||
@@ -353,7 +353,7 @@ compileHLS :: ( MonadMask m
|
||||
, BuildFailed
|
||||
, NotInstalled
|
||||
] m Version
|
||||
compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
Dirs { .. } <- lift getDirs
|
||||
@@ -362,7 +362,7 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
|
||||
lift $ logInfo "Updating cabal DB"
|
||||
lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
|
||||
|
||||
(workdir, tmpUnpack, tver, ov) <- case targetHLS of
|
||||
(workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
|
||||
-- unpack from version tarball
|
||||
SourceDist tver -> do
|
||||
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
|
||||
@@ -382,11 +382,7 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
|
||||
(liftE . intoSubdir tmpUnpack)
|
||||
(view dlSubdir dlInfo)
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
|
||||
Nothing -> pure Nothing
|
||||
|
||||
pure (workdir, tmpUnpack, tver, ov)
|
||||
pure (workdir, tmpUnpack, tver, Nothing)
|
||||
|
||||
HackageDist tver -> do
|
||||
lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
|
||||
@@ -400,11 +396,7 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack hls
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
|
||||
Nothing -> pure Nothing
|
||||
|
||||
pure (workdir, tmpUnpack, tver, ov)
|
||||
pure (workdir, tmpUnpack, tver, Nothing)
|
||||
|
||||
RemoteDist uri -> do
|
||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||
@@ -427,17 +419,13 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
|
||||
|
||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
|
||||
Nothing -> pure Nothing
|
||||
|
||||
pure (workdir, tmpUnpack, tver, ov)
|
||||
pure (workdir, tmpUnpack, tver, Nothing)
|
||||
|
||||
-- clone from git
|
||||
GitDist GitBranch{..} -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
|
||||
cleanUpOnError tmpUnpack $ reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
|
||||
let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
|
||||
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
||||
lEM $ git [ "init" ]
|
||||
@@ -471,31 +459,28 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
|
||||
then pure Nothing
|
||||
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
|
||||
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||
branch <- gitOut ["rev-parse", "--abbrev-ref", "HEAD" ] (fromGHCupPath tmpUnpack)
|
||||
tver <- getCabalVersion (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal")
|
||||
|
||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||
|
||||
ov <- case vps of
|
||||
Just vps' -> fmap Just $ expandVersionPattern
|
||||
(Just tver)
|
||||
(take 7 $ T.unpack chash)
|
||||
(T.unpack chash)
|
||||
(maybe "" T.unpack git_describe)
|
||||
(T.unpack branch)
|
||||
vps'
|
||||
Nothing -> pure Nothing
|
||||
|
||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
||||
"HLS version (from cabal file): " <> prettyVer tver <>
|
||||
"\n branch: " <> branch <>
|
||||
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
|
||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
||||
pure (tmpUnpack, tmpUnpack, tver, ov)
|
||||
|
||||
pure (tmpUnpack, tmpUnpack, tver, git_describe)
|
||||
|
||||
-- the version that's installed may differ from the
|
||||
-- compiled version, so the user can overwrite it
|
||||
installVer <- maybe (pure tver) pure ov
|
||||
installVer <- case ov of
|
||||
Left True -> case git_describe of
|
||||
-- git describe
|
||||
Just h -> either (fail . displayException) pure . version $ h
|
||||
-- git describe, but not building from git, lol
|
||||
Nothing -> pure tver
|
||||
-- default: use detected version
|
||||
Left False -> pure tver
|
||||
-- overwrite version with users value
|
||||
Right v -> pure v
|
||||
|
||||
liftE $ runBuildAction
|
||||
tmpUnpack
|
||||
@@ -573,7 +558,9 @@ compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal upd
|
||||
|
||||
pure installVer
|
||||
where
|
||||
gitDescribeRequested = maybe False (GitDescribe `elem`) vps
|
||||
gitDescribeRequested = case ov of
|
||||
Left b -> b
|
||||
_ -> False
|
||||
|
||||
|
||||
-----------------
|
||||
|
||||
@@ -57,10 +57,12 @@ import qualified Data.Text.Lazy.Encoding as TLE
|
||||
|
||||
-- $setup
|
||||
-- >>> import Data.ByteString.Internal (c2w, w2c)
|
||||
-- >>> import Test.QuickCheck
|
||||
-- >>> import Data.Word8
|
||||
-- >>> import qualified Data.Text as T
|
||||
-- >>> import qualified Data.Char as C
|
||||
-- >>> import Data.List
|
||||
-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
|
||||
|
||||
|
||||
fS :: IsString a => String -> a
|
||||
@@ -297,7 +299,7 @@ escapeVerRex = B.pack . go . B.unpack . verToBS
|
||||
|
||||
|
||||
recover :: (MonadIO m, MonadMask m) => m a -> m a
|
||||
recover action =
|
||||
recover action =
|
||||
recovering (fullJitterBackoff 25000 <> limitRetries 10)
|
||||
[\_ -> Handler (\e -> pure $ isPermissionError e)
|
||||
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
|
||||
|
||||
@@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
@@ -99,12 +98,7 @@ execLogged exe args chdir lfile env = do
|
||||
Dirs {..} <- getDirs
|
||||
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||
let logfile = fromGHCupPath logsDir </> lfile <> ".log"
|
||||
liftIO $ bracket
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
(openFd logfile WriteOnly defaultFileFlags{ append = True, creat = Just newFilePerms })
|
||||
#else
|
||||
(openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
#endif
|
||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
closeFd
|
||||
(action verbose noColor)
|
||||
where
|
||||
@@ -345,11 +339,7 @@ cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd
|
||||
-- | Create a new regular file in write-only mode. The file must not exist.
|
||||
createRegularFileFd :: FileMode -> FilePath -> IO Fd
|
||||
createRegularFileFd fm dest =
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
openFd dest WriteOnly defaultFileFlags{ exclusive = True, creat = Just fm }
|
||||
#else
|
||||
openFd dest WriteOnly (Just fm) defaultFileFlags{ exclusive = True }
|
||||
#endif
|
||||
|
||||
|
||||
-- | Thin wrapper around `executeFile`.
|
||||
|
||||
@@ -263,9 +263,12 @@ createProcessWithMingwPath :: MonadIO m
|
||||
=> CreateProcess
|
||||
-> m CreateProcess
|
||||
createProcessWithMingwPath cp = do
|
||||
msys2Dir <- liftIO ghcupMsys2Dir
|
||||
cEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (env cp)
|
||||
mingWPaths <- liftIO ghcupMsys2BinDirs'
|
||||
let paths = ["PATH", "Path"]
|
||||
let mingWPaths = [msys2Dir </> "mingw64" </> "bin"
|
||||
,msys2Dir </> "usr" </> "bin"
|
||||
]
|
||||
paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
newPath = intercalate [searchPathSeparator] (mingWPaths ++ curPaths)
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
@@ -273,4 +276,11 @@ createProcessWithMingwPath cp = do
|
||||
liftIO $ setEnv "Path" newPath
|
||||
pure $ cp { env = Just $ Map.toList envWithNewPath }
|
||||
|
||||
ghcupMsys2Dir :: IO FilePath
|
||||
ghcupMsys2Dir =
|
||||
lookupEnv "GHCUP_MSYS2" >>= \case
|
||||
Just fp -> pure fp
|
||||
Nothing -> do
|
||||
baseDir <- liftIO ghcupBaseDir
|
||||
pure (fromGHCupPath baseDir </> "msys64")
|
||||
|
||||
|
||||
@@ -544,23 +544,11 @@ data Dirs = Dirs
|
||||
, dbDir :: GHCupPath
|
||||
, recycleDir :: GHCupPath -- mainly used on windows
|
||||
, tmpDir :: GHCupPath
|
||||
, msys2Dir :: FilePath
|
||||
}
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
instance NFData Dirs
|
||||
|
||||
data MSYS2Env = MSYS
|
||||
| UCRT64
|
||||
| CLANG64
|
||||
| CLANGARM64
|
||||
| CLANG32
|
||||
| MINGW64
|
||||
| MINGW32
|
||||
deriving (Eq, Show, Ord, GHC.Generic, Read)
|
||||
|
||||
instance NFData MSYS2Env
|
||||
|
||||
data KeepDirs = Always
|
||||
| Errors
|
||||
| Never
|
||||
@@ -789,13 +777,3 @@ instance Pretty ToolVersion where
|
||||
data BuildSystem = Hadrian
|
||||
| Make
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
||||
data VersionPattern = CabalVer
|
||||
| GitHashShort
|
||||
| GitHashLong
|
||||
| GitDescribe
|
||||
| GitBranchName
|
||||
| S String
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
@@ -108,7 +108,6 @@ import Data.Time (Day(..), diffDays, addDays)
|
||||
-- >>> import GHCup.Errors
|
||||
-- >>> import GHCup.Types
|
||||
-- >>> import GHCup.Types.Optics
|
||||
-- >>> import Data.Versions
|
||||
-- >>> import Optics
|
||||
-- >>> import GHCup.Prelude.Version.QQ
|
||||
-- >>> import qualified Data.Text.Encoding as E
|
||||
@@ -121,8 +120,8 @@ import Data.Time (Day(..), diffDays, addDays)
|
||||
-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
|
||||
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
|
||||
-- >>> cwd <- getCurrentDirectory
|
||||
-- >>> (Right ref) <- pure $ GHCup.Utils.parseURI $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
||||
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE (getBase ref) >>= liftE . decodeMetadata @GHCupInfo
|
||||
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
||||
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
|
||||
|
||||
|
||||
|
||||
@@ -1084,6 +1083,27 @@ cleanUpOnError bdir action = do
|
||||
flip onException (lift exAction) $ onE_ exAction action
|
||||
|
||||
|
||||
-- | Clean up the given directory if the action fails,
|
||||
-- depending on the Settings.
|
||||
cleanFinally :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
, HasLog env
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> GHCupPath -- ^ build directory (cleaned up depending on Settings)
|
||||
-> Excepts e m a
|
||||
-> Excepts e m a
|
||||
cleanFinally bdir action = do
|
||||
Settings {..} <- lift getSettings
|
||||
let exAction = when (keepDirs == Never) $ rmBDir bdir
|
||||
flip finally (lift exAction) $ onE_ exAction action
|
||||
|
||||
|
||||
-- | Remove a build directory, ignoring if it doesn't exist and gracefully
|
||||
-- printing other errors without crashing.
|
||||
rmBDir :: (MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) => GHCupPath -> m ()
|
||||
@@ -1135,7 +1155,7 @@ ensureShimGen
|
||||
|
||||
-- | Ensure ghcup directory structure exists.
|
||||
ensureDirectories :: Dirs -> IO ()
|
||||
ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir dbDir tmpDir _) = do
|
||||
ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir dbDir tmpDir) = do
|
||||
createDirRecursive' (fromGHCupPath baseDir)
|
||||
createDirRecursive' (fromGHCupPath baseDir </> "ghc")
|
||||
createDirRecursive' (fromGHCupPath baseDir </> "hls")
|
||||
@@ -1255,33 +1275,3 @@ processBranches str' = let lines' = lines (T.unpack str')
|
||||
branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
|
||||
in branches
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Versioning ]--
|
||||
------------------
|
||||
|
||||
|
||||
-- | Expand a list of version patterns describing a string such as "%v-%h".
|
||||
--
|
||||
-- >>> expandVersionPattern (either (const Nothing) Just $ version "3.4.3") "a386748" "a3867484ccc391daad1a42002c3a2ba6a93c5221" "v0.1.20.0-119-ga386748" "issue-998" [CabalVer, S "-", GitHashShort, S "-", GitHashLong, S "-", GitBranchName, S "-", GitDescribe, S "-coco"]
|
||||
-- Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 3 :| [Numeric 4,Numeric 3]), _vRel = Just (Release (Alphanum "a386748-a3867484ccc391daad1a42002c3a2ba6a93c5221-issue-998-v0" :| [Numeric 1,Numeric 20,Alphanum "0-119-ga386748-coco"])), _vMeta = Nothing}
|
||||
expandVersionPattern :: MonadFail m
|
||||
=> Maybe Version -- ^ cabal ver
|
||||
-> String -- ^ git hash (short), if any
|
||||
-> String -- ^ git hash (long), if any
|
||||
-> String -- ^ git describe output, if any
|
||||
-> String -- ^ git branch name, if any
|
||||
-> [VersionPattern]
|
||||
-> m Version
|
||||
expandVersionPattern cabalVer gitHashS gitHashL gitDescribe gitBranch
|
||||
= either (fail . displayException) pure . version . T.pack . go
|
||||
where
|
||||
go [] = ""
|
||||
go (CabalVer:xs) = T.unpack (maybe "" prettyVer cabalVer) <> go xs
|
||||
go (GitHashShort:xs) = gitHashS <> go xs
|
||||
go (GitHashLong:xs) = gitHashL <> go xs
|
||||
go (GitDescribe:xs) = gitDescribe <> go xs
|
||||
go (GitBranchName:xs) = gitBranch <> go xs
|
||||
go (S str:xs) = str <> go xs
|
||||
|
||||
|
||||
@@ -32,8 +32,6 @@ module GHCup.Utils.Dirs
|
||||
, getConfigFilePath'
|
||||
, useXDG
|
||||
, cleanupTrash
|
||||
, ghcupMsys2BinDirs
|
||||
, ghcupMsys2BinDirs'
|
||||
|
||||
, GHCupPath
|
||||
, appendGHCupPath
|
||||
@@ -138,7 +136,6 @@ import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics hiding ( uncons )
|
||||
import Safe
|
||||
import System.Info
|
||||
import System.Directory hiding ( removeDirectory
|
||||
, removeDirectoryRecursive
|
||||
, removePathForcibly
|
||||
@@ -341,48 +338,6 @@ ghcupTMPDir
|
||||
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "tmp"))
|
||||
|
||||
|
||||
ghcupMsys2Dir :: IO FilePath
|
||||
ghcupMsys2Dir =
|
||||
lookupEnv "GHCUP_MSYS2" >>= \case
|
||||
Just fp -> pure fp
|
||||
Nothing -> do
|
||||
baseDir <- liftIO ghcupBaseDir
|
||||
pure (fromGHCupPath baseDir </> "msys64")
|
||||
|
||||
ghcupMsys2BinDirs :: (MonadFail m, MonadIO m, MonadReader env m, HasDirs env) => m [FilePath]
|
||||
ghcupMsys2BinDirs = do
|
||||
Dirs{..} <- getDirs
|
||||
liftIO $ ghcupMsys2BinDirs_ msys2Dir
|
||||
|
||||
ghcupMsys2BinDirs' :: IO [FilePath]
|
||||
ghcupMsys2BinDirs' = do
|
||||
msys2Dir <- ghcupMsys2Dir
|
||||
ghcupMsys2BinDirs_ msys2Dir
|
||||
|
||||
ghcupMsys2BinDirs_ :: FilePath -> IO [FilePath]
|
||||
ghcupMsys2BinDirs_ msys2Dir' = do
|
||||
env <- liftIO (lookupEnv "GHCUP_MSYS2_ENV") >>= \case
|
||||
Just env -> maybe (fail parseFailMsg) pure $ readMay @MSYS2Env env
|
||||
Nothing
|
||||
| "x86_64" <- arch -> pure MINGW64
|
||||
| "i386" <- arch -> pure MINGW32
|
||||
| "aarch64" <- arch -> pure CLANGARM64
|
||||
| otherwise -> fail "No compatible architecture for msys2"
|
||||
pure [msys2Dir' </> toEnvDir env </> "bin", msys2Dir' </> toEnvDir MSYS </> "bin"]
|
||||
where
|
||||
-- https://www.msys2.org/docs/environments/
|
||||
toEnvDir :: MSYS2Env -> FilePath
|
||||
toEnvDir MSYS = "usr"
|
||||
toEnvDir UCRT64 = "ucrt64"
|
||||
toEnvDir CLANG64 = "clang64"
|
||||
toEnvDir CLANGARM64 = "clangarm64"
|
||||
toEnvDir CLANG32 = "clang32"
|
||||
toEnvDir MINGW64 = "mingw64"
|
||||
toEnvDir MINGW32 = "mingw32"
|
||||
|
||||
parseFailMsg = "Invalid value for GHCUP_MSYS2_ENV. Valid values are: MSYS, UCRT64, CLANG64, CLANGARM64, CLANG32, MINGW64, MINGW32"
|
||||
|
||||
|
||||
getAllDirs :: IO Dirs
|
||||
getAllDirs = do
|
||||
baseDir <- ghcupBaseDir
|
||||
@@ -393,7 +348,6 @@ getAllDirs = do
|
||||
recycleDir <- ghcupRecycleDir
|
||||
tmpDir <- ghcupTMPDir
|
||||
dbDir <- ghcupDbDir
|
||||
msys2Dir <- ghcupMsys2Dir
|
||||
pure Dirs { .. }
|
||||
|
||||
|
||||
|
||||
@@ -20,7 +20,6 @@
|
||||
# * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows
|
||||
# * BOOTSTRAP_HASKELL_DOWNLOADER - which downloader to use (default: curl)
|
||||
# * GHCUP_BASE_URL - the base url for ghcup binary download (use this to overwrite https://downloads.haskell.org/~ghcup with a mirror)
|
||||
# * GHCUP_MSYS2_ENV - the msys2 environment to use on windows, see https://www.msys2.org/docs/environments/ (defauts to MINGW64, MINGW32 or CLANGARM64, depending on the architecture)
|
||||
|
||||
# License: LGPL-3.0
|
||||
|
||||
@@ -28,15 +27,6 @@
|
||||
# safety subshell to avoid executing anything in case this script is not downloaded properly
|
||||
(
|
||||
|
||||
die() {
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
(>&2 printf "%s\\n" "$1")
|
||||
else
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
fi
|
||||
exit 2
|
||||
}
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.20.0"
|
||||
@@ -65,40 +55,18 @@ case "${plat}" in
|
||||
;;
|
||||
esac
|
||||
|
||||
case "${GHCUP_MSYS2_ENV}" in
|
||||
"")
|
||||
case "${arch}" in
|
||||
x86_64|amd64)
|
||||
GHCUP_MSYS2_ENV_DIR="mingw64" ;;
|
||||
i*86)
|
||||
GHCUP_MSYS2_ENV_DIR="mingw32" ;;
|
||||
aarch64|arm64)
|
||||
GHCUP_MSYS2_ENV_DIR="clangarm64" ;;
|
||||
*) die "Unknown architecture: ${arch}" ;;
|
||||
esac
|
||||
;;
|
||||
MSYS)
|
||||
GHCUP_MSYS2_ENV_DIR="usr" ;;
|
||||
UCRT64)
|
||||
GHCUP_MSYS2_ENV_DIR="ucrt64" ;;
|
||||
CLANG64)
|
||||
GHCUP_MSYS2_ENV_DIR="clang64" ;;
|
||||
CLANGARM64)
|
||||
GHCUP_MSYS2_ENV_DIR="clangarm64" ;;
|
||||
CLANG32)
|
||||
GHCUP_MSYS2_ENV_DIR="clang32" ;;
|
||||
MINGW64)
|
||||
GHCUP_MSYS2_ENV_DIR="mingw64" ;;
|
||||
MINGW32)
|
||||
GHCUP_MSYS2_ENV_DIR="mingw32" ;;
|
||||
*)
|
||||
die "Invalid value for GHCUP_MSYS2_ENV. Valid values are: MSYS, UCRT64, CLANG64, CLANGARM64, CLANG32, MINGW64, MINGW32" ;;
|
||||
esac
|
||||
|
||||
: "${BOOTSTRAP_HASKELL_GHC_VERSION:=recommended}"
|
||||
: "${BOOTSTRAP_HASKELL_CABAL_VERSION:=recommended}"
|
||||
|
||||
|
||||
die() {
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
(>&2 printf "%s\\n" "$1")
|
||||
else
|
||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||
fi
|
||||
exit 2
|
||||
}
|
||||
|
||||
warn() {
|
||||
if [ -n "${NO_COLOR}" ] ; then
|
||||
@@ -559,7 +527,7 @@ adjust_bashrc() {
|
||||
;;
|
||||
fish)
|
||||
mkdir -p "${GHCUP_PROFILE_FILE%/*}"
|
||||
sed -i -e '/# ghcup-env$/d' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
|
||||
sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
|
||||
case $1 in
|
||||
1)
|
||||
printf "\n%s" "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
|
||||
@@ -570,12 +538,12 @@ adjust_bashrc() {
|
||||
esac
|
||||
;;
|
||||
bash)
|
||||
sed -i -e '/# ghcup-env$/d' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
|
||||
printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && . \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
|
||||
sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
|
||||
printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
|
||||
case "${plat}" in
|
||||
"Darwin"|"darwin")
|
||||
if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
|
||||
printf "\n%s" "[[ -f ~/.bashrc ]] && . ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
||||
printf "\n%s" "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
|
||||
fi
|
||||
;;
|
||||
MSYS*|MINGW*|CYGWIN*)
|
||||
@@ -589,19 +557,15 @@ adjust_bashrc() {
|
||||
;;
|
||||
|
||||
zsh)
|
||||
sed -i -e '/# ghcup-env$/d' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
|
||||
printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && . \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
|
||||
sed -i -e '/# ghcup-env$/ s/^#*/#/' "$(posix_realpath "${GHCUP_PROFILE_FILE}")"
|
||||
printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
|
||||
;;
|
||||
esac
|
||||
if [ -e "$HOME/.profile" ] ; then
|
||||
sed -i -e '/# ghcup-env$/d' "$(posix_realpath "$HOME/.profile")"
|
||||
printf "\n%s" "[ -f \"${GHCUP_DIR}/env\" ] && . \"${GHCUP_DIR}/env\" # ghcup-env" >> "$HOME/.profile"
|
||||
fi
|
||||
echo
|
||||
echo "==============================================================================="
|
||||
echo
|
||||
warn "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
|
||||
warn "or type \". ${GHCUP_DIR}/env\" to apply them in your current terminal session."
|
||||
warn "or type \"source ${GHCUP_DIR}/env\" to apply them in your current terminal session."
|
||||
return
|
||||
;;
|
||||
*)
|
||||
@@ -627,7 +591,7 @@ adjust_cabal_config() {
|
||||
else
|
||||
cabal_bin="$HOME/AppData/Roaming/cabal/bin"
|
||||
fi
|
||||
ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/${GHCUP_MSYS2_ENV_DIR}/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/${GHCUP_MSYS2_ENV_DIR}/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/${GHCUP_MSYS2_ENV_DIR}/lib)" -f init
|
||||
ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
|
||||
}
|
||||
|
||||
ask_cabal_config_init() {
|
||||
|
||||
@@ -46,9 +46,7 @@ param (
|
||||
# Whether to disable creation of several desktop shortcuts
|
||||
[switch]$DontWriteDesktopShortcuts,
|
||||
# Whether to disable adjusting bashrc (in msys2 env) with PATH
|
||||
[switch]$DontAdjustBashRc,
|
||||
# The msys2 environment to use, see https://www.msys2.org/docs/environments/ (defauts to MINGW64, MINGW32 or CLANGARM64, depending on the architecture)
|
||||
[string]$Msys2Env
|
||||
[switch]$DontAdjustBashRc
|
||||
)
|
||||
|
||||
$DefaultMsys2Version = "20221216"
|
||||
@@ -189,43 +187,6 @@ function Exec
|
||||
}
|
||||
}
|
||||
|
||||
# Only x86 32/64-bit is supported
|
||||
$SupportedArchitectures = 'AMD64', 'x86'
|
||||
if (!$SupportedArchitectures.contains($env:PROCESSOR_ARCHITECTURE)) {
|
||||
Print-Msg -color Red -msg ("Unsupported processor architecture: {0}. Supported architectures: {1}." -f $env:PROCESSOR_ARCHITECTURE, ($SupportedArchitectures -join ", "))
|
||||
Exit 1
|
||||
}
|
||||
|
||||
# set default Msys2Env if not set
|
||||
if (!$Msys2Env) {
|
||||
if ($env:PROCESSOR_ARCHITECTURE -eq 'x86') {
|
||||
$Msys2Env = 'MINGW32'
|
||||
} elseif ($env:PROCESSOR_ARCHITECTURE -eq 'AMD64') {
|
||||
$Msys2Env = 'MINGW64'
|
||||
}
|
||||
}
|
||||
|
||||
# parse Msys2Env and set the corresponding variables
|
||||
if ($Msys2Env -eq 'MINGW32') {
|
||||
$ShellType = '-mingw32'
|
||||
$PkgConf = 'mingw-w64-i686-pkgconf'
|
||||
} elseif ($Msys2Env -eq 'MINGW64') {
|
||||
$ShellType = '-mingw64'
|
||||
$PkgConf = 'mingw-w64-x86_64-pkgconf'
|
||||
} elseif ($Msys2Env -eq 'MSYS') {
|
||||
$ShellType = '-msys2'
|
||||
$PkgConf = 'pkgconf'
|
||||
} elseif ($Msys2Env -eq 'UCRT64') {
|
||||
$ShellType = '-ucrt64'
|
||||
$PkgConf = 'mingw-w64-ucrt-x86_64-pkgconf'
|
||||
} elseif ($Msys2Env -eq 'CLANG64') {
|
||||
$ShellType = '-clang64'
|
||||
$PkgConf = 'mingw-w64-clang-x86_64-pkgconf'
|
||||
} else {
|
||||
Print-Msg -color Red -msg ("Unsupported Msys2 environment: {0}. Supported environments are: MINGW64, MINGW32, MSYS, UCRT64, CLANG64" -f $Msys2Env)
|
||||
Exit 1
|
||||
}
|
||||
|
||||
$ErrorActionPreference = 'Stop'
|
||||
|
||||
$GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
|
||||
@@ -533,7 +494,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
||||
|
||||
Print-Msg -msg 'Installing Dependencies...'
|
||||
Exec "$Bash" '-lc' ('pacman --noconfirm -S --needed curl autoconf {0}' -f $PkgConf)
|
||||
Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf'
|
||||
|
||||
Print-Msg -msg 'Updating SSL root certificate authorities...'
|
||||
Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'
|
||||
@@ -641,9 +602,9 @@ if ($Host.Name -eq "ConsoleHost")
|
||||
}
|
||||
'@
|
||||
|
||||
$GhcInstArgs = ('{0} -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"' -f $ShellType)
|
||||
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath 'Install GHC dev dependencies.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $ShellType -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath 'Mingw haskell shell.lnk' -TempPath $GhcupDir
|
||||
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath 'Mingw package management docs.url' -TempPath $GhcupDir
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
||||
@@ -692,15 +653,10 @@ if (!($DontAdjustBashRc)) {
|
||||
$AdjustBashRcExport = 'export BOOTSTRAP_HASKELL_ADJUST_BASHRC=1 ;'
|
||||
}
|
||||
|
||||
# set msys2 env export for the shell bootstrap script
|
||||
$Msys2EnvExport = ('export GHCUP_MSYS2_ENV={0} ;' -f $Msys2Env)
|
||||
# export GHCUP_MSYS2_ENV
|
||||
$null = [Environment]::SetEnvironmentVariable("GHCUP_MSYS2_ENV", $Msys2Env, [System.EnvironmentVariableTarget]::User)
|
||||
|
||||
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
|
||||
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} {12} {13} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript, $AdjustBashRcExport, $Msys2EnvExport)
|
||||
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} {12} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript, $AdjustBashRcExport)
|
||||
} else {
|
||||
Exec "$Msys2Shell" $ShellType '-mintty' '-shell' 'bash' '-c' ('{4} {6} {7} {8} {9} {10} {12} {13} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript, $AdjustBashRcExport, $Msys2EnvExport)
|
||||
Exec "$Msys2Shell" '-mingw64' '-mintty' '-shell' 'bash' '-c' ('{4} {6} {7} {8} {9} {10} {12} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript, $AdjustBashRcExport)
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -27,7 +27,11 @@ cd "gh-release-artifacts/${RELEASE}"
|
||||
# github
|
||||
gh release download "$RELEASE"
|
||||
|
||||
# cirrus
|
||||
curl -L -o "x86_64-portbld-freebsd-ghcup-${TAG}" \
|
||||
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${TAG}?branch=${RELEASE}"
|
||||
|
||||
sha256sum ./*-ghcup-* > SHA256SUMS
|
||||
gpg --detach-sign -u "${SIGNER}" SHA256SUMS
|
||||
|
||||
gh release upload "$RELEASE" "ghcup-${TAG}-src.tar.gz" SHA256SUMS SHA256SUMS.sig
|
||||
gh release upload "$RELEASE" "ghcup-${TAG}-src.tar.gz" "x86_64-portbld-freebsd-ghcup-${TAG}" SHA256SUMS SHA256SUMS.sig
|
||||
|
||||
70
stack.yaml
70
stack.yaml
@@ -1,66 +1,38 @@
|
||||
resolver: lts-21.25
|
||||
resolver: lts-20.26
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
||||
extra-deps:
|
||||
- Cabal-3.8.1.0
|
||||
- Cabal-syntax-3.8.1.0
|
||||
- Win32-2.14.0.0@sha256:e34af84fec733b5c0c8f052ec39499785e719e2fbbe308983adf26c82ea3704d,5942
|
||||
- brick-2.1.1@sha256:ff36d64f1027eac17a14a83de053067413accb58b79e5002dce2a79cb8a3dcb3,17385
|
||||
- bzlib-0.5.1.0@sha256:197ea0ba028dd1fe274f7601dae58d23607c4760119bf40bc2087720f6734e6c,2288
|
||||
- cabal-install-parsers-0.6
|
||||
- cabal-plan-0.7.3.0
|
||||
- chs-cabal-0.1.1.1@sha256:e8c8c1bf1dbeec64ad86d67ae6dca1c45afd644d20869546dfdcd03910d3848d,1149
|
||||
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
|
||||
- directory-1.3.8.3
|
||||
- file-uri-0.1.0.0@sha256:d6dcc12bde249362c93e413f87a41558b827333dfe3f97d953e47e1070c0da6f,1857
|
||||
- filepath-1.4.101.0
|
||||
- Cabal-3.6.3.0
|
||||
- Cabal-syntax-3.10.1.0
|
||||
- aeson-2.1.2.1
|
||||
- cabal-install-parsers-0.6.1
|
||||
- chs-cabal-0.1.1.1
|
||||
- chs-deps-0.1.0.0
|
||||
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
|
||||
- generically-0.1.1
|
||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||
- haskus-utils-variant-3.3@sha256:3df3fa0a557d75c0e8f94fe9954f76a692eaf8d368c401e30ab028624d55386b,2198
|
||||
- language-c-0.9.3
|
||||
- libarchive-3.0.4.2
|
||||
- libyaml-streamly-0.2.2@sha256:619b15826a4e221cae4f91cfc040f262cd19a4a81858b75e8270e4b009866969,2206
|
||||
- lzma-static-5.2.5.5@sha256:55ed074cda2b82008e020a51e2f8c22f2487a58a4989ab359bf04dd6c903b894,7431
|
||||
- megaparsec-9.2.2@sha256:c306a135ec25d91d252032c6128f03598a00e87ea12fcf5fc4878fdffc75c768,3219
|
||||
- os-release-1.0.2.1@sha256:2c3e8f7a9a0e17d5042d14d2036d52b42c8d5606e8d004697af462a95c87a9e2,2718
|
||||
- process-1.6.18.0@sha256:69fbbca4151e1a6d1a5da41a1e17c254871675a4f2aed5213bbdfb10b5e52742,3148
|
||||
- streamly-0.8.3@sha256:c8f1eed7a99d02c902f0338d8c5f53579cf5cf421a5c886405f331bd948214d5,24141
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- time-1.11.1.2@sha256:a957467595420495c2dd440d9efa1f58c62277cf9438c7e7a515d7a4c65571ec,6287
|
||||
- unicode-data-0.3.1@sha256:ae3a3aca89a32b912ddde7a644c0c04eaf23ee42014c74fe3d6b9aaf36ce7ec9,5481
|
||||
- unix-2.8.5.0@sha256:633f15ef0bd50a16a7b5c5e86e6659fee6e4e211e098cc8bd0029f452bfcfddc,9808
|
||||
- unix-bytestring-0.3.7.8@sha256:b8070935929a7654ce398fdecc9b5f90b02c455407db8ea7989256e821e33b1f,3053
|
||||
- versions-6.0.5
|
||||
- vty-6.2@sha256:3536dc83a3fee17d9a114baf58fe47b6f080c24987266f0cd0b7b4b1fcd9cf19,3520
|
||||
- vty-crossplatform-0.4.0.0@sha256:50593f91ad16777d921138475a8d2784d538fd206addd30664c620278d6c8544,3172
|
||||
- vty-unix-0.2.0.0@sha256:2af3d0bdae3c4b7b7e567ee374efe32c7439fabdf9096465ce011a6c6736e9ae,2932
|
||||
- vty-windows-0.2.0.1@sha256:6c75230057a708168dbc420975572511ad3ec09956bf73c3b6f4be03324e8b13,2815
|
||||
- yaml-streamly-0.12.4@sha256:b5250c5dc71d668c43c42ed6f86f956d69125136ea960858527a4b2ff712d3d1,5165
|
||||
- github: hasufell/uri-bytestring
|
||||
commit: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
|
||||
- github: haskell/tar
|
||||
commit: d94a988be4311b830149a9f8fc16739927e5fc1c
|
||||
|
||||
allow-newer: true
|
||||
|
||||
allow-newer-deps:
|
||||
- Cabal
|
||||
- Cabal-syntax
|
||||
- ansi-terminal
|
||||
- mintty
|
||||
- process
|
||||
- streamly
|
||||
- cabal-install-parsers
|
||||
- haskus-utils-variant-3.2.1
|
||||
- libarchive-3.0.3.2
|
||||
- libyaml-streamly-0.2.1
|
||||
- lzma-static-5.2.5.5
|
||||
- os-release-1.0.2.1
|
||||
- parsec-3.1.15.0
|
||||
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
|
||||
- strict-base-0.4.0.0
|
||||
- text-2.0.2
|
||||
- yaml-streamly-0.12.2
|
||||
- github: fosskers/versions
|
||||
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
brotli: false
|
||||
|
||||
libarchive:
|
||||
system-libarchive: false
|
||||
system-libarchive: true
|
||||
|
||||
regex-posix:
|
||||
_regex-posix-clib: true
|
||||
|
||||
@@ -47,7 +47,7 @@ mkDefaultHLSCompileOptions target ghcs =
|
||||
Nothing
|
||||
True
|
||||
False
|
||||
Nothing
|
||||
(Left False)
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
@@ -91,15 +91,15 @@ compileGhcCheckList = mapSecond CompileGHC
|
||||
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
|
||||
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
|
||||
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
|
||||
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.overwriteVer = Just [S "9.4.5-p1"]})
|
||||
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.overwriteVer = Just [S "9.4.5-p1"]})
|
||||
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
|
||||
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
|
||||
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
|
||||
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
|
||||
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
|
||||
, (baseCmd <> "--make", baseOptions{GHC.buildSystem = Just Make})
|
||||
#ifdef IS_WINDOWS
|
||||
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\tmp\\out_dir"})
|
||||
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\tmp\\out_dir"})
|
||||
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
||||
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
||||
#else
|
||||
, (baseCmd <> "-i /tmp/out_dir", baseOptions{GHC.isolateDir = Just "/tmp/out_dir"})
|
||||
, (baseCmd <> "--isolate /tmp/out_dir", baseOptions{GHC.isolateDir = Just "/tmp/out_dir"})
|
||||
@@ -158,14 +158,12 @@ compileHlsCheckList = mapSecond CompileHLS
|
||||
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
|
||||
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
|
||||
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
|
||||
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.overwriteVer = Just [S "2.0.0.0-p1"]})
|
||||
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.overwriteVer = Just [S "2.0.0.0-p1"]})
|
||||
, (baseCmd <> "--overwrite-version %v-%h-%H-%b-%g-coco%l", baseOptions{HLS.overwriteVer
|
||||
= Just [CabalVer, S "-", GitHashShort, S "-", GitHashLong, S "-", GitBranchName, S "-", GitDescribe, S "-coco", S "%", S "l"]})
|
||||
, (baseCmd <> "--git-describe-version", baseOptions{HLS.overwriteVer = Just [GitDescribe]})
|
||||
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
|
||||
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
|
||||
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
|
||||
#ifdef IS_WINDOWS
|
||||
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\tmp\\out_dir"})
|
||||
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\tmp\\out_dir"})
|
||||
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
||||
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
|
||||
#else
|
||||
, (baseCmd <> "-i /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
|
||||
, (baseCmd <> "--isolate /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
|
||||
|
||||
@@ -48,7 +48,7 @@ oldStyleCheckList =
|
||||
: ("install --set", Right defaultOptions{instSet = True})
|
||||
: ("install --force", Right defaultOptions{forceInstall = True})
|
||||
#ifdef IS_WINDOWS
|
||||
: ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\"})
|
||||
: ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\\\"})
|
||||
#else
|
||||
: ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"})
|
||||
#endif
|
||||
|
||||
@@ -43,8 +43,8 @@ runCheckList =
|
||||
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(versionQ "2.0")})
|
||||
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(versionQ "2.9") })
|
||||
#ifdef IS_WINDOWS
|
||||
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\tmp\\dir"})
|
||||
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\tmp\\dir"})
|
||||
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
|
||||
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
|
||||
#else
|
||||
, ("run -b /tmp/dir", defaultOptions{runBinDir = Just "/tmp/dir"})
|
||||
, ("run --bindir /tmp/dir", defaultOptions{runBinDir = Just "/tmp/dir"})
|
||||
|
||||
Reference in New Issue
Block a user