Compare commits

...

135 Commits

Author SHA1 Message Date
1793fa43cf Fix for screen readers 2024-03-23 15:10:55 +08:00
Luis Morillo
b375398416 makes ctrl+c the shourtcut to exit menus + fix trailing new line in editor 2024-03-17 09:47:03 +01:00
Luis Morillo
04b29b0b98 fix regression #875 and build system 2024-03-16 16:27:04 +01:00
Luis Morillo
255f7c8eac Remove trailing white space 2024-03-16 16:14:24 +01:00
Luis Morillo
80a6c67cf3 Execute action only if inputs are valid + better UX 2024-03-13 18:14:37 +01:00
Luis Morillo
cee4a0d610 untested compile HLS 2024-03-13 18:14:37 +01:00
Luis Morillo
9c4e64baf1 untested compileGHC IOAction 2024-03-13 18:14:37 +01:00
Luis Morillo
0b6e9289fc Visuals for compiling HLS 2024-03-13 18:14:37 +01:00
Luis Morillo
cd8d13ff2b Advance Install menu implements functionality. 2024-03-13 18:14:37 +01:00
Luis Morillo
40f94fa016 Better aesth for context menu 2024-03-13 18:14:37 +01:00
Luis Morillo
32c2cd2efa Add visuals for compile Menu 2024-03-13 18:14:37 +01:00
Luis Morillo
7b18cc9081 migrate #987 to new library 2024-03-13 18:14:37 +01:00
Luis Morillo
3f80d41dd7 Add visuals for Advance Install 2024-03-13 18:14:37 +01:00
Luis Morillo
6485e230cd Context Menu visuals 2024-03-13 18:14:37 +01:00
Luis Morillo
3a8c32ae87 Extract common functionality 2024-03-13 18:14:37 +01:00
Luis Morillo
5ebb800646 Create Menu system. Similar to Brick.Forms 2024-03-13 18:14:37 +01:00
Luis Morillo
f157cf809e Move tui code into its own library. 2024-03-13 18:14:36 +01:00
456200e747 Update CHANGELOG 2024-03-13 21:14:14 +08:00
09e199a176 Bump bootstrap script to 0.1.22.0 2024-03-13 20:54:23 +08:00
2ecc61ad92 Disable system-libyaml for release builds 2024-03-13 18:47:10 +08:00
dd8b23ff86 Force maerwald runners 2024-03-13 18:34:29 +08:00
d78e7af80c Update changelog 2024-03-13 16:22:34 +08:00
cf8ed4211b Merge branch 'checkout-4' 2024-03-13 12:05:44 +08:00
39931d98b9 Bump checkout action to 4 2024-03-13 10:34:46 +08:00
ac18c044e1 Merge branch 'cross-wasm-commits' 2024-03-11 21:45:18 +08:00
e5c941b4d7 Merge branch 'issue-1019' 2024-03-11 21:44:49 +08:00
065b307d60 Fix cabal.project.release 2024-03-11 17:59:45 +08:00
5eaae9916d Allow to remove all unset versions, fixes #1019 2024-03-11 17:42:26 +08:00
5d0a7b71a2 Merge branch 'issue-1016' 2024-03-11 17:34:21 +08:00
b4600b8183 Merge branch 'issue-1013' 2024-03-11 17:33:28 +08:00
f465243fc6 Merge branch 'bzlib-cve' 2024-03-11 17:32:29 +08:00
e4b0e8debf Use fixed bzlib 2024-03-11 17:31:57 +08:00
d9d13dda5f Fix crash in 'ghcup tui' on windows
* https://github.com/haskell/ghcup-hs/issues/1013
* https://github.com/jtdaugherty/brick/issues/502#issuecomment-1974980299
* 4c395182cb
2024-03-03 14:44:20 +08:00
aef10a699e Add viPreInstall wrt #1016 2024-03-02 17:44:40 +08:00
b413ade4db Update docs for ghc-wasm-meta 2024-03-02 13:01:28 +08:00
190d308ddf Bump ghcup to 0.1.22.0 2024-03-01 22:33:58 +08:00
4314146247 Merge remote-tracking branch 'origin/issue-1004' 2024-03-01 22:15:13 +08:00
4831798c9e Merge branch 'issue-982' 2024-02-21 16:50:24 +08:00
e999e6f5b8 Merge branch 'refreezeee' 2024-02-21 16:27:36 +08:00
3ad785c116 Refreeze, update stack.yaml, etc. 2024-02-21 15:32:35 +08:00
be3db87410 Clean up on error, fixes #1004 2024-02-18 20:07:12 +08:00
57d23c477d Update hie.yaml 2024-02-18 19:53:46 +08:00
0ec07636fb Merge branch 'issue-998' 2024-02-18 19:53:23 +08:00
bdd15ad6e7 Beef up --overwrite-version, fixes #998 2024-02-18 19:52:01 +08:00
96f7aa5c62 Allow to set ghcup msys2 environment
Fixes #982
2024-02-18 16:22:20 +08:00
2fdf896fbd Begone travis 2024-02-12 23:58:51 +08:00
251c82ee9f Begone gitlab 2024-02-12 23:58:10 +08:00
c2186bb33c Merge branch 'issue-233' 2024-02-09 21:45:02 +08:00
1a9d43ea1a Allow all runners 2024-02-09 21:41:34 +08:00
9de324d3c3 Merge remote-tracking branch 'origin/windows-bootstrap-fail-on-non-x86' 2024-02-09 21:40:40 +08:00
b53acfe61f Drop enforcing clang on FreeBSD (why did we ever do that?) 2024-02-09 21:36:53 +08:00
Rune K. Svendsen
c92f71471d Windows bootstrap: fail on non-x86 2024-02-07 10:50:38 +01:00
2a79c669a5 Update release scripts 2024-02-03 00:16:18 +08:00
9b2d326c38 Merge branch 'freebsd' 2024-02-03 00:15:53 +08:00
2bfca3760c Finalize FreeBSD CI 2024-02-02 23:05:14 +08:00
0f7f5347d8 Force x86 self hosted runners for cross 2024-02-02 16:22:24 +08:00
80703d7b29 Be more portable wrt sourcing scripts 2024-02-02 16:18:50 +08:00
942685f396 Also dump env into ~/.profile, fixes #763 2024-02-02 15:40:31 +08:00
02744ff4a0 Don't spam bashrc with commented lines 2024-02-02 15:31:32 +08:00
c74409b9a5 Remove cleanup hack on ARM64 Linux 2024-02-01 16:02:34 +08:00
1c32dbc88a Also install libiconv on FreeBSD 2024-02-01 16:02:20 +08:00
ab17270761 Use self-hosted FreeBSD runner 2024-02-01 00:08:25 +08:00
d0538a50e0 Don't error when cleanup action fails 2024-01-30 16:32:29 +08:00
318ac21e41 Merge branch 'tui-scrolling' 2024-01-25 19:48:24 +08:00
3e9bb7c369 Restore TUI scrolling to old behavior 2024-01-22 22:39:45 +08:00
2c64cd0f02 Merge branch 'issue-981' 2024-01-22 16:04:54 +08:00
59e6b65249 Make sure .bashrc is adjusted on windows during installation
Fixes #981
2024-01-22 15:52:27 +08:00
91ef2c7666 Merge branch 'issue-983' 2024-01-22 13:51:45 +08:00
935cb5541b Fix 'versions' version to resolver #983 2024-01-21 22:01:08 +08:00
9a7eb11c73 Merge branch 'issue-978' 2024-01-21 16:34:31 +08:00
4b338ccfd8 Fix windows ghcup test script 2024-01-21 15:29:12 +08:00
ca92b29ffe Fix optparse tests on windows 2024-01-21 14:00:53 +08:00
ec4e69e89d Fix indentation 2024-01-21 13:52:49 +08:00
c225f2cfee Fix language-c on windows 2024-01-21 13:51:54 +08:00
e325728f38 Fix windows golden test 2024-01-21 13:47:03 +08:00
c9a44d211e Update .gitignore 2024-01-20 18:24:17 +08:00
4b3ffd8570 Use file-uri for better URI handling, fixes #978 2024-01-20 18:23:08 +08:00
3e9746cf0c Fix cabal.project.release 2024-01-20 17:58:04 +08:00
950155cbe3 Fix hlint 2024-01-20 17:50:40 +08:00
dd978ff2fd Merge branch 'issue-967' 2024-01-20 17:48:51 +08:00
4bbaffaa6f Update project files 2024-01-20 17:43:12 +08:00
2a12362e75 Merge branch 'issue-408' 2024-01-20 17:40:21 +08:00
411ac8dc31 Refreeze 2024-01-20 17:37:08 +08:00
b837a93176 Merge remote-tracking branch 'origin/pr/943' 2024-01-20 16:59:53 +08:00
1c56e782d2 Revert GHC bump on alpine32 wrt #962 2024-01-20 16:58:38 +08:00
c6c61ca486 Merge remote-tracking branch 'origin/update-ci2' 2024-01-20 16:56:12 +08:00
6ae312c1f9 Merge remote-tracking branch 'origin/tar' 2024-01-20 16:55:46 +08:00
f6cf4cb90c Merge remote-tracking branch 'origin/fix-957' 2024-01-20 16:54:42 +08:00
3ff65219e8 Merge remote-tracking branch 'origin/pr/976' 2024-01-20 16:52:31 +08:00
e33f554838 Merge branch 'disable-cabal-xdg' 2024-01-20 16:48:43 +08:00
2850f343b9 Disable cabal XDG by default 2024-01-16 23:59:39 +08:00
Geoffrey Noel
8d6445c632 Assume /home/gnoel/.local/share if XDG_DATA_HOME is not set 2024-01-13 18:35:37 -05:00
Geoffrey Noel
de611e0d4e Consider STACK_XDG env to determine the stack root path 2024-01-13 15:34:14 -05:00
Rune K. Svendsen
6fec9d4737 Quote version in Pretty NotInstalled instance 2024-01-11 11:42:56 +01:00
Rune K. Svendsen
856e48aa14 Make HLint happy 2024-01-09 10:26:46 +01:00
Rune K. Svendsen
2cafd9d2bc Fix redundant import warning 2024-01-09 10:22:51 +01:00
Rune K. Svendsen
87ec8c756f Move ArchiveResult into GHCup.Utils.Tar.Types
So a module that wants to import ArchiveResult doesn't have to worry about CPP.
2024-01-09 10:19:58 +01:00
2ece023c0f Fix coding suggestions 2024-01-07 22:03:06 +08:00
16e20ed474 Set LD=ld.bfd on Alpine linux during bindist configure 2024-01-04 20:53:21 +08:00
afd7e7dc4f Re-introduce tar 2024-01-03 17:56:33 +08:00
d46bdbf959 Fix misinterpretation of '+' in URI paths, fixes #408 2024-01-03 00:42:01 +08:00
cac3cec135 Use i386/alpine:3.16 2024-01-02 19:08:56 +08:00
4e0efff4c4 Fix tests 2024-01-02 19:08:56 +08:00
71b7c96ddd Use alpine:3.12
It appears tat at least alpine:3.16 is broken
and produces linking errors.
2024-01-02 19:08:56 +08:00
5ff61cdf86 Bump toolchain in cirrus CI 2024-01-02 19:08:56 +08:00
7d0ba7fc62 Bump llvm to 13 2024-01-02 19:08:56 +08:00
bfe56aed1f Fix Dockerfile 2024-01-02 19:08:56 +08:00
a1103c05a5 Update ARM docker images 2024-01-02 19:08:56 +08:00
125125b9db Downgrade cabal on armv7 2024-01-02 19:08:55 +08:00
4eec582f1b Update alpine docker containers 2024-01-02 19:08:55 +08:00
e969489ca2 Fix build on windows 2024-01-02 19:08:55 +08:00
ec4a657b42 Update tools in CI 2024-01-02 19:08:55 +08:00
55030d83da Merge branch 'issue-958' 2024-01-01 21:40:36 +08:00
Rune K. Svendsen
dfe213824f Improve NoDownload Pretty instance on missing/unknown "mtarget"
The guard was only used for the "Perhaps you meant"-part, so include the other part regardless of what `mtarget` is.
2023-12-30 14:13:16 +01:00
c680a9f33b Support cygwin in bootstrap-haskell too
Fixes #958
2023-12-29 19:56:38 +08:00
df192ee18e Merge remote-tracking branch 'origin/pr/956' 2023-12-26 21:41:40 +08:00
Rune K. Svendsen
008def2ff4 Add comment about why we ignore this error 2023-12-20 10:26:42 +01:00
Rune K. Svendsen
3976daddb7 bootstrap-haskell.ps1: don't exit if tmp file removal fails 2023-12-20 10:21:22 +01:00
524cdbbeb1 Merge remote-tracking branch 'origin/pr/953' 2023-12-15 23:53:59 +08:00
a01c5acfe2 Update submodules 2023-12-15 23:53:41 +08:00
Rune K. Svendsen
6689312ac5 docs: remove "TUI not supported on Windows"
TUI works on Windows since v0.1.20.0 (cf. https://github.com/haskell/ghcup-hs/pull/912)
2023-12-15 16:49:55 +01:00
e214695a3e Merge remote-tracking branch 'origin/pr/850' 2023-12-02 18:42:22 +08:00
Yuto Tanaka
9d7f99bd00 Fix many typos 2023-11-30 18:12:46 +09:00
3cea6ef97c Merge remote-tracking branch 'origin/pr/937' 2023-11-28 21:25:12 +08:00
3b0f131a65 Merge remote-tracking branch 'origin/pr/940' 2023-11-28 21:08:49 +08:00
konsumlamm
e0a3020e34 Update WASM install instructions 2023-11-28 13:55:52 +01:00
Luis Morillo
0e46b9509a complete tutorial. remove show all tools from widgets. resolve some conflicts. 2023-11-23 16:05:12 +01:00
Luis Morillo
d3474d0cd9 add KeyInfo handler and widget. Improve tutorial 2023-11-23 15:32:23 +01:00
Luis Morillo
5c3dad1bb9 reorganize code by sections 2023-11-23 15:31:33 +01:00
Luis Morillo
987cdaf313 factor out attr names. Add windows symbols to tutotial widget. Improve tutorial aesthetics and text 2023-11-23 15:28:21 +01:00
Luis Morillo
835352428a simplify rendering for better ux 2023-11-23 15:28:19 +01:00
Luis Morillo
8f4246e716 Use proper Name type and Modal type. Create tutorial Widget 2023-11-23 15:27:33 +01:00
Luis Morillo
1353a2fd20 use map-like data structure 2023-11-23 15:26:49 +01:00
Luis Morillo
aa9fbdbfc2 Use MonadState Instance to simplify install', del', set' and changelog'. Lensify the app 2023-11-23 15:24:24 +01:00
3a8cdf9967 Fix opening changelog on windows 2023-11-20 22:36:17 +08:00
111 changed files with 27650 additions and 45031 deletions

View File

@@ -1,28 +0,0 @@
freebsd_instance:
image_family: freebsd-13-2
build_task:
name: build
env:
GHC_VER: 9.2.4
CABAL_VER: 3.8.1.0
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
ARCH: 64
RUNNER_OS: FreeBSD
DISTRO: na
GITHUB_WORKSPACE: ${CIRRUS_WORKING_DIR}
JSON_VERSION: "0.0.7"
CIRRUS_CLONE_SUBMODULES: true
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
install_script:
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
script:
- tzsetup Etc/GMT
- adjkerntz -a
- bash .github/scripts/build.sh
- bash .github/scripts/test.sh
binaries_artifacts:
path: "out/*"

View File

@@ -44,7 +44,7 @@ raw_eghcup() {
eghcup() {
if [ "${OS}" = "Windows" ] ; then
"$GHCUP_BIN/ghcup${ext}" -c -s "file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
"$GHCUP_BIN/ghcup${ext}" -c -s "file:${GITHUB_WORKSPACE//\\//}/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
else
"$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$@"
fi

View File

@@ -9,6 +9,10 @@ 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"

View File

@@ -11,6 +11,7 @@ else
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
env
git_describe
rm -rf "${GHCUP_DIR}"
@@ -38,6 +39,12 @@ 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}")"
@@ -193,7 +200,7 @@ sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# invalidate access time timer, which is 5minutes, so we re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# redownload same file with some newlines added
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-${JSON_VERSION}.yaml list
# snapshot new yaml and etags file
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
@@ -203,7 +210,7 @@ sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# invalidate access time timer, which is 5minutes, but don't expect a re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# this time, we expect the same hash and etag
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
raw_eghcup -s https://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-${JSON_VERSION}.yaml list
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
[ "${etag2}" = "${etag3}" ]

View File

@@ -52,7 +52,9 @@ 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
./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash -Msys2Env "MINGW64"
shell: pwsh

View File

@@ -19,7 +19,7 @@ env:
jobs:
build:
name: Build linux binary
runs-on: ubuntu-latest
runs-on: [self-hosted, Linux, X64, maerwald]
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"

View File

@@ -57,6 +57,7 @@ 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 -- {} +"
@@ -93,6 +94,7 @@ 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 -- {} +"

View File

@@ -21,8 +21,8 @@ jobs:
name: Build linux binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
CABAL_VER: 3.10.2.0
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 }}
@@ -36,11 +36,11 @@ jobs:
ARCH: 32
- os: ubuntu-latest
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
GHC_VER: 9.4.8
ARCH: 64
steps:
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
@@ -85,8 +85,8 @@ jobs:
name: Build ARM binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
CABAL_VER: 3.6.2.0
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 }}
@@ -94,27 +94,22 @@ jobs:
fail-fast: true
matrix:
include:
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, ARM64, maerwald]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
GHC_VER: 9.2.8
ARCH: ARM
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, ARM64, maerwald]
ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.6
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 "*"
shell: bash
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
@@ -158,9 +153,9 @@ jobs:
name: Build binary (Mac/Win)
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.10.2.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
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 }}
@@ -170,32 +165,32 @@ jobs:
include:
- os: [self-hosted, macOS, ARM64]
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.4.8
ARCH: ARM64
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.4.8
ARCH: 64
- os: windows-latest
ARTIFACT: "x86_64-mingw64-ghcup"
GHC_VER: 8.10.7
GHC_VER: 9.4.8
ARCH: 64
steps:
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
- if: matrix.ARCH == 'ARM64' && runner.os == 'macOS'
name: Run build
run: |
bash .github/scripts/brew.sh git coreutils llvm@11 autoconf automake
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$HOME/.brew/opt/llvm@11/bin:$PATH"
export CC="$HOME/.brew/opt/llvm@11/bin/clang"
export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
bash .github/scripts/brew.sh git coreutils llvm@13 autoconf automake
export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$HOME/.brew/opt/llvm@13/bin:$PATH"
export CC="$HOME/.brew/opt/llvm@13/bin/clang"
export CXX="$HOME/.brew/opt/llvm@13/bin/clang++"
export LD=ld
export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
export AR="$HOME/.brew/opt/llvm@13/bin/llvm-ar"
export RANLIB="$HOME/.brew/opt/llvm@13/bin/llvm-ranlib"
bash .github/scripts/build.sh
env:
ARTIFACT: ${{ matrix.ARTIFACT }}
@@ -246,13 +241,49 @@ 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@v4
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"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
CABAL_VER: 3.10.2.0
JSON_VERSION: "0.0.8"
strategy:
matrix:
include:
@@ -263,18 +294,18 @@ jobs:
DISTRO: Alpine
- os: ubuntu-latest
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
GHC_VER: 9.4.8
ARCH: 64
DISTRO: Alpine
- os: ubuntu-latest
ARTIFACT: "x86_64-linux-ghcup"
GHC_VER: 8.10.7
GHC_VER: 9.4.8
ARCH: 64
DISTRO: Ubuntu
steps:
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
@@ -329,30 +360,25 @@ jobs:
needs: "build-arm"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7"
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.8"
strategy:
matrix:
include:
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, ARM64, maerwald]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
GHC_VER: 9.2.8
ARCH: ARM
DISTRO: Ubuntu
- os: [self-hosted, Linux, ARM64]
- os: [self-hosted, Linux, ARM64, maerwald]
ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.4.8
ARCH: ARM64
DISTRO: Ubuntu
steps:
- uses: docker://arm64v8/debian:10
name: Cleanup (aarch64 linux)
with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
@@ -396,31 +422,31 @@ jobs:
needs: "build-macwin"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.10.1.0
CABAL_VER: 3.10.2.0
MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7"
JSON_VERSION: "0.0.8"
strategy:
matrix:
include:
- os: [self-hosted, macOS, ARM64]
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.4.8
ARCH: ARM64
DISTRO: na
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
GHC_VER: 9.4.8
ARCH: 64
DISTRO: na
- os: windows-latest
ARTIFACT: "x86_64-mingw64-ghcup"
GHC_VER: 8.10.7
GHC_VER: 9.4.8
ARCH: 64
DISTRO: na
steps:
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
@@ -467,6 +493,41 @@ 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@v4
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
@@ -475,7 +536,7 @@ jobs:
GHC_VERSION: "8.10.7"
HLS_TARGET_VERSION: "1.8.0.0"
CABAL_VERSION: "3.8.1.0"
JSON_VERSION: "0.0.7"
JSON_VERSION: "0.0.8"
ARTIFACT: "x86_64-linux-ghcup"
DISTRO: Ubuntu
ARCH: 64
@@ -484,7 +545,7 @@ jobs:
S3_HOST: ${{ secrets.S3_HOST }}
steps:
- name: Checkout code
uses: actions/checkout@v3
uses: actions/checkout@v4
with:
submodules: 'true'
@@ -500,7 +561,7 @@ jobs:
release:
name: release
needs: ["test-linux", "test-arm", "test-macwin", "hls"]
needs: ["test-linux", "test-arm", "test-macwin", "test-freebsd", "hls"]
runs-on: ubuntu-latest
if: startsWith(github.ref, 'refs/tags/v')
steps:

1
.gitignore vendored
View File

@@ -4,6 +4,7 @@ codex.tags
dist-newstyle/
cabal.project.local
.stack-work/
.hiefiles/
bin/
/*.prof
/*.ps

View File

@@ -1,689 +0,0 @@
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

View File

@@ -1,19 +0,0 @@
#!/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

View File

@@ -1,32 +0,0 @@
#!/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

View File

@@ -1,27 +0,0 @@
#!/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

View File

@@ -1,58 +0,0 @@
#!/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

View File

@@ -1,27 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}"
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev 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

View File

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

View File

@@ -1,21 +0,0 @@
#!/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

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

@@ -1,23 +0,0 @@
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

View File

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

View File

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

View File

@@ -1,20 +0,0 @@
#!/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}" ]

View File

@@ -1,52 +0,0 @@
#!/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" ]

View File

@@ -1,52 +0,0 @@
#!/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" ]

View File

@@ -1,51 +0,0 @@
#!/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" ]

View File

@@ -1,44 +0,0 @@
#!/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}

View File

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

View File

@@ -1,314 +0,0 @@
#!/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 ]

View File

@@ -1,19 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal --store-dir="$(pwd)"/.store "$@"
}
git describe
ecabal update
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hlint
hlint -r app/ lib/ test/

View File

@@ -1,28 +0,0 @@
#!/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}"

View File

@@ -1,5 +1,43 @@
# Revision history for ghcup
## 0.1.22.0 -- 2024-03-13
### New features
* A help screen/tutorial in the TUI by @lsmor (Luis Morillo)
* 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)
* Add pre-install message support via ghcup metadata, wrt [#1016](https://github.com/haskell/ghcup-hs/issues/1016)
* Allow to remove all unset versions, fixes [#1019](https://github.com/haskell/ghcup-hs/issues/1019)
* e.g.: `ghcup gc --unset`
### Improvements and bug fixes
* Fix potential [HSEC-2024-0002](https://haskell.github.io/security-advisories/advisory/HSEC-2024-0002.html)
* Fix TUI crash in windows terminal 1.19 [#1013](https://github.com/haskell/ghcup-hs/issues/1013)
* 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

File diff suppressed because it is too large Load Diff

View File

@@ -11,7 +11,8 @@
module Main where
#if defined(BRICK)
import BrickMain ( brickMain )
-- import BrickMain ( brickMain )
import GHCup.BrickMain (brickMain)
#endif
import qualified GHCup.GHC as GHC
@@ -41,6 +42,7 @@ 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
@@ -341,12 +343,14 @@ 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{ ovewrwiteVer = Just over }))
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) 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{ targetGhc = GHC.SourceDist tver }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion tver) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion over) 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{ targetHLS = HLS.SourceDist tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion tver) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = HLS.HackageDist tver }))

View File

@@ -2,13 +2,35 @@ packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
flags: +tui
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
@@ -25,5 +47,10 @@ package aeson
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-8.10.7

View File

@@ -1,55 +1,56 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.6.3.0,
Cabal -bundled-binary-generic,
any.Cabal-syntax ==3.8.1.0,
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==3.10.2.0,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.4,
any.HsOpenSSL ==0.11.7.6,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.OneTuple ==0.3.1,
any.QuickCheck ==2.14.2,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.1.1.0,
aeson -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.2.7.1,
any.ansi-terminal ==0.11.4,
ansi-terminal -example +win32-2-13-1,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.4,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.4,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.14.3.0,
any.base-compat ==0.12.2,
any.base-compat-batteries ==0.12.2,
any.base-orphans ==0.8.7,
any.base-compat ==0.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.5.14,
bifunctors +semigroups +tagged,
any.bifunctors ==5.6.1,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.8.0,
any.binary-instances ==1.0.3,
any.binary-orphans ==1.0.3,
any.blaze-builder ==0.4.2.2,
any.brick ==1.5,
any.binary ==0.8.9.1,
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.10.12.0,
any.bz2 ==1.0.1.0,
any.bytestring ==0.11.5.3,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.5,
any.cabal-plan ==0.7.2.3,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
@@ -62,7 +63,7 @@ constraints: any.Cabal ==3.6.3.0,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.5.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
@@ -76,51 +77,56 @@ constraints: any.Cabal ==3.6.3.0,
any.data-clist ==0.2,
any.data-fix ==0.3.2,
any.deepseq ==1.4.4.0,
any.directory ==1.3.6.0,
any.directory ==1.3.8.1,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.10,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1,
any.generically ==0.1.1,
any.ghc-boot-th ==8.10.7,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1,
any.happy ==1.20.0,
any.hashable ==1.4.2.0,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.2.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.8,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.8,
any.hspec-core ==2.10.8,
any.hspec-discover ==2.10.8,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
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.6.1,
any.http-io-streams ==0.1.7.0,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1.1.1,
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.2,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.2,
any.libarchive ==3.0.4.2,
libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
@@ -130,84 +136,86 @@ constraints: any.Cabal ==3.6.3.0,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.11,
any.microlens-th ==0.4.3.14,
any.mtl ==2.2.2,
any.network ==3.1.2.7,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2,
any.optics-core ==0.4.1,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.0.0,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1,
any.parsec ==3.1.17.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.4.0,
any.process ==1.6.13.2,
any.primitive ==0.8.0.0,
any.process ==1.6.18.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1.1,
any.recursion-schemes ==5.2.2.3,
any.random ==1.2.1.2,
any.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.6,
any.retry ==0.8.1.2,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.1,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.3,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.2.0.1,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==5.3.7,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.5,
any.splitmix ==0.1.0.4,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.0.1,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.4.0.1,
strict +assoc,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.6.1,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.5.1.1,
tar -old-bytestring -old-time,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.16.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.3,
any.terminal-progress-bar ==0.4.2,
any.terminal-size ==0.3.4,
any.terminfo ==0.4.1.4,
any.text ==2.0.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.12,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.4.5.0,
any.th-abstraction ==0.6.0.0,
any.th-compat ==0.1.4,
any.th-lift ==0.8.2,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.1.1.1,
these +assoc,
any.these ==1.2,
any.time ==1.9.3,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
@@ -218,29 +226,34 @@ constraints: any.Cabal ==3.6.3.0,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2,
any.unix ==2.8.5.0,
unix -os-string,
any.unix-bytestring ==0.3.7.8,
any.unix-compat ==0.6,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.19.1,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.1,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-binary-instances ==0.2.5.2,
any.versions ==5.0.4,
any.vty ==5.37,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.1,
any.yaml-streamly ==0.12.1,
any.xor ==0.0.1.2,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2023-01-12T04:22:48Z
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

56
cabal.ghc902.project Normal file
View File

@@ -0,0 +1,56 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-9.0.2

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

@@ -0,0 +1,272 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==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,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.15.1.0,
any.base-compat ==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-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.bindings-DSL ==1.0.25,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.11.5.3,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.bzlib-conduit ==0.3.0.3,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.2,
any.deepseq ==1.4.5.0,
any.digest ==0.0.2.1,
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.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-bignum ==1.1,
any.ghc-boot-th ==9.0.2,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
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,
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,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.2,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.monad-control ==1.0.3.1,
any.mono-traversable ==1.0.17.0,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.17.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
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.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.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.17.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.2,
any.terminal-size ==0.3.4,
any.terminfo ==0.4.1.5,
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-compat ==0.1.4,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2,
any.time ==1.9.3,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
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-bytestring ==0.3.7.8,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.2,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zip ==2.0.0,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

56
cabal.ghc928.project Normal file
View File

@@ -0,0 +1,56 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-9.2.8

271
cabal.ghc928.project.freeze Normal file
View File

@@ -0,0 +1,271 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==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,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.16.4.0,
any.base-compat ==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.0,
any.binary-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.bindings-DSL ==1.0.25,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.11.4.0,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.bzlib-conduit ==0.3.0.3,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-array-byte ==0.1.0.1,
any.data-clist ==0.2,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.2,
any.deepseq ==1.4.6.1,
any.digest ==0.0.2.1,
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.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.4,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-bignum ==1.2,
any.ghc-boot-th ==9.2.8,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.8.0,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
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,
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,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.2,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.monad-control ==1.0.3.1,
any.mono-traversable ==1.0.17.0,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.17.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
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.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.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.0.2,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.18.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.2,
any.terminal-size ==0.3.4,
any.terminfo ==0.4.1.5,
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-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.1,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.11.1,
any.unicode-data ==0.3.1,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.8,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.2,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zip ==2.0.0,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

56
cabal.ghc948.project Normal file
View File

@@ -0,0 +1,56 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
package streamly
flags: +use-unliftio
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32
with-compiler: ghc-9.4.8

270
cabal.ghc948.project.freeze Normal file
View File

@@ -0,0 +1,270 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.2.1,
any.Cabal-syntax ==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,
any.OneTuple ==0.4.1.1,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.2.1.0,
aeson +ordered-keymap,
any.aeson-pretty ==0.8.10,
aeson-pretty +lib-only,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.0.2,
ansi-terminal -example,
any.ansi-terminal-types ==0.11.5,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.1,
assoc +tagged,
any.async ==2.2.5,
async -bench,
any.atomic-primops ==0.8.5,
atomic-primops -debug,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.base ==4.17.2.1,
any.base-compat ==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-instances ==1.0.4,
any.binary-orphans ==1.0.4.1,
any.bindings-DSL ==1.0.25,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.brick ==2.1.1,
brick -demos,
any.bytestring ==0.11.5.3,
any.bz2 ==1.0.1.1,
bz2 -cross +with-bzlib,
any.bzip2-clib ==1.0.8,
any.bzlib-conduit ==0.3.0.3,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-install-parsers ==0.6.1.1,
any.cabal-plan ==0.7.3.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.containers ==0.6.7,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.2,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.2,
any.deepseq ==1.4.8.0,
any.digest ==0.0.2.1,
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.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.exceptions ==0.10.5,
any.file-uri ==0.1.0.0,
any.filepath ==1.4.300.1,
filepath -cpphs,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.free ==5.2,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.2.2,
any.generically ==0.1.1,
any.ghc-bignum ==1.3,
any.ghc-boot-th ==9.4.8,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.9.1,
any.happy ==1.20.1.1,
any.hashable ==1.4.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.3,
any.heaps ==0.4,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.10.10,
any.hspec-core ==2.10.10,
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,
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,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libyaml-streamly ==0.2.2,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.4,
any.lukko ==0.1.1.3,
lukko +ofd-locking,
any.lzma-static ==5.2.5.5,
any.megaparsec ==9.2.2,
megaparsec -dev,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.monad-control ==1.0.3.1,
any.mono-traversable ==1.0.17.0,
any.mtl ==2.2.2,
any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two,
any.network ==3.1.4.0,
network -devel,
any.network-uri ==2.6.4.2,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4.2.1,
any.optics-core ==0.4.1.1,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4.2.1,
any.optics-th ==0.4.1,
any.optparse-applicative ==0.17.1.0,
optparse-applicative +process,
any.os-release ==1.0.2.1,
os-release -devel,
any.parsec ==3.1.16.1,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
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.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.recursion-schemes ==5.2.2.5,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.6,
any.retry ==0.9.3.1,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semialign ==1.3,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.1.0,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.streamly ==0.8.3,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
any.strict ==0.5,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.tagsoup ==0.14.8,
any.tar ==0.6.0.0,
any.tasty ==1.5,
tasty +unix,
any.tasty-hunit ==0.10.1,
any.template-haskell ==2.19.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.2,
any.terminal-size ==0.3.4,
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-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-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
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-bytestring ==0.3.7.8,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.2,
any.vector-stream ==0.1.0.1,
any.versions ==6.0.6,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.2,
any.yaml-streamly ==0.12.4,
yaml-streamly +no-examples +no-exe,
any.zip ==2.0.0,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.3.0,
zstd +standalone
index-state: hackage.haskell.org 2024-03-10T10:13:56Z

View File

@@ -2,16 +2,35 @@ packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
package ghcup
flags: +tui
if impl(ghc < 9.0)
package ghcup
flags: +tui -tar
else
package ghcup
flags: +tui +tar
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
any.aeson >= 2.0.1.0,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
if os(mingw32)
constraints: vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
package libarchive
flags: -system-libarchive
@@ -30,3 +49,6 @@ package streamly
package *
test-show-details: direct
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

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

View File

@@ -5,7 +5,7 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
flags: +tui
flags: +tui -tar
if os(linux)
if arch(x86_64) || arch(i386)
@@ -18,20 +18,30 @@ elif os(mingw32)
constraints: zlib +bundled-c-zlib,
lzma +static,
text -simdutf,
vty-windows >=0.1.0.3
vty-windows >=0.2.0.2
if impl(ghc >= 9.4)
constraints: language-c >= 0.9.3
elif os(freebsd)
constraints: zlib +bundled-c-zlib,
zip +disable-zstd
package *
ghc-options: -split-sections -pgmc clang++14
ghc-options: -split-sections
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0,
any.hsc2hs ==0.68.8
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
package libarchive
flags: -system-libarchive
package libyaml-streamly
flags: -system-libyaml
package aeson-pretty
flags: +lib-only
@@ -44,3 +54,15 @@ package aeson
package streamly
flags: +use-unliftio
source-repository-package
type: git
location: https://github.com/haskell/tar.git
tag: d94a988be4311b830149a9f8fc16739927e5fc1c
source-repository-package
type: git
location: https://github.com/hasufell/uri-bytestring.git
tag: 4fb5ed14b500c192e6e7a97f6b2b1eb478806001
allow-newer: cabal-install-parsers:tar, streamly:Win32

View File

@@ -92,7 +92,7 @@ url-source:
# sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3
# This is a way to override platform detection, e.g. when you're running
# a Ubuntu derivate based on 18.04, you could do:
# a Ubuntu derivative based on 18.04, you could do:
#
# platform-override:
# arch: A_64

View File

@@ -1,4 +1,4 @@
FROM --platform=linux/i386 i386/alpine:3.12
FROM --platform=linux/i386 i386/alpine:3.16
ENV LANG C.UTF-8
@@ -37,8 +37,8 @@ RUN apk add --no-cache \
xz-dev \
ncurses-static
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.20.0
ARG GPG_KEY="7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C FFEB7CE81E16A36B3E2DED6F2DE04D4E97DB64AD 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4 EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF"
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
@@ -51,9 +51,9 @@ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ARG GHC=9.4.8
ARG CABAL_INSTALL=3.10.2.0
ARG STACK=2.13.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1
@@ -63,7 +63,7 @@ RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
rm -r "/usr/share/doc/ghc-${GHC}" && \
rm -rf "/usr/share/doc/ghc-${GHC}" && \
rm -rf /tmp/ghcup* && \
ghcup gc -p -s -c -t

View File

@@ -37,8 +37,8 @@ RUN apk add --no-cache \
xz-dev \
ncurses-static
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.20.0
ARG GPG_KEY="7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C FFEB7CE81E16A36B3E2DED6F2DE04D4E97DB64AD 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4 EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF"
# install ghcup
@@ -52,9 +52,9 @@ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ARG GHC=9.4.8
ARG CABAL_INSTALL=3.10.2.0
ARG STACK=2.13.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1
@@ -64,7 +64,7 @@ RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
rm -r "/usr/share/doc/ghc-${GHC}" && \
rm -rf "/usr/share/doc/ghc-${GHC}" && \
rm -rf /tmp/ghcup* && \
ghcup gc -p -s -c -t

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.20.0
ARG GPG_KEY="7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C FFEB7CE81E16A36B3E2DED6F2DE04D4E97DB64AD 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4 EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF"
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
@@ -43,9 +43,9 @@ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG GHC=9.2.8
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ARG STACK=2.13.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
ARG GHCUP_VERSION=0.1.20.0
ARG GPG_KEY="7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C FFEB7CE81E16A36B3E2DED6F2DE04D4E97DB64AD 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4 EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF"
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
@@ -43,9 +43,9 @@ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ARG GHC=9.4.8
ARG CABAL_INSTALL=3.10.2.0
ARG STACK=2.13.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1

View File

@@ -4,7 +4,7 @@ This is a more in-depth guide specific to GHCup. `ghcup --help` is your friend.
## Basic usage
For the simple, interactive, text-based user interface (TUI) (not available on windows), run:
For the simple, interactive, text-based user interface (TUI), run:
```sh
ghcup tui
@@ -67,8 +67,7 @@ and make sure your bashrc sources the startup script
`ghcup` is very portable. There are a few exceptions though:
1. `ghcup tui` is only available on non-windows platforms
2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
1. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
# Configuration
@@ -79,7 +78,7 @@ Partial configuration is fine. Command line options always override the config f
## Overriding distro detection
If you're running e.g. an Ubuntu derivate based on 18.04 and ghcup is picking bindists that
If you're running e.g. an Ubuntu derivative based on 18.04 and ghcup is picking bindists that
don't work well, you could do this in `config.yaml`:
```yml
@@ -106,6 +105,7 @@ 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 +509,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:
@@ -557,10 +557,12 @@ You need the required wasm toolchain:
git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta.git
cd ghc-wasm-meta/
export SKIP_GHC=yes
sh setup.sh
./setup.sh
source ~/.ghc-wasm/env
```
**Note that some wasm bindists don't work with the master branch of ghc-wasm-meta. GHCup will warn you about such cases prior to installation and point you to the right commit.**
To install, we need to invoke ghcup like so also passing the `--host=<host>` flag (adjust as needed):
```sh
@@ -611,7 +613,7 @@ Examples:
## Continuous integration
On Windows, GHCup can be installed automatically on a CI runner
non-interactively, as below. The paramaters to the PowerShell script are
non-interactively, as below. The parameters to the PowerShell script are
specified positionally, after `-ArgumentList`:
```ps

View File

@@ -1,9 +1,9 @@
cabal-version: 2.4
name: ghcup
version: 0.1.20.0
version: 0.1.22.0
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
copyright: Julian Ospald 2024
maintainer: hasufell@posteo.de
author: Julian Ospald
homepage: https://github.com/haskell/ghcup-hs
@@ -30,6 +30,11 @@ extra-source-files:
test/ghcup-test/golden/unix/GHCupInfo.json
test/ghcup-test/golden/windows/GHCupInfo.json
tested-with: GHC==9.4.8
, GHC==9.2.8
, GHC==9.0.2
, GHC==8.10.7
source-repository head
type: git
location: https://github.com/haskell/ghcup-hs.git
@@ -38,7 +43,7 @@ flag tui
description:
Build the brick powered tui (ghcup tui).
default: False
default: True
manual: True
flag internal-downloader
@@ -53,6 +58,11 @@ flag no-exe
default: False
manual: True
flag tar
description: Use haskell tar instead of libarchive.
default: False
manual: True
common app-common-depends
build-depends:
, aeson >=1.4
@@ -65,10 +75,9 @@ common app-common-depends
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, filepath >=1.4.101.0
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, haskus-utils-variant ^>=3.3
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
@@ -79,7 +88,7 @@ common app-common-depends
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.20
, template-haskell >=2.7 && <2.22
, temporary ^>=1.3
, text ^>=2.0
, time >=1.9.3 && <1.12
@@ -87,9 +96,18 @@ common app-common-depends
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector >=0.12 && <0.14
, versions >=6.0.3 && <6.1
, versions >=6.0.5 && <6.1
, yaml-streamly ^>=0.12.0
if flag(tar)
cpp-options: -DTAR
build-depends:
tar ^>=0.6.0.0
, zip ^>=2.0.0
else
build-depends: libarchive ^>=3.0.3.0
library
exposed-modules:
GHCup
@@ -122,6 +140,9 @@ library
GHCup.Types.Stack
GHCup.Utils
GHCup.Utils.Dirs
GHCup.Utils.Tar
GHCup.Utils.Tar.Types
GHCup.Utils.URI
GHCup.Version
hs-source-dirs: lib
@@ -154,7 +175,8 @@ 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
, bz2 ^>=1.0.1.1
, 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
, case-insensitive ^>=1.2.1.0
, casing ^>=0.1.4.1
, containers ^>=0.6
@@ -163,10 +185,10 @@ library
, directory ^>=1.3.6.0
, disk-free-space ^>=0.1.0.1
, exceptions ^>=0.10
, filepath ^>=1.4.2.1
, filepath >=1.4.101.0
, file-uri ^>=0.1.0.0
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, haskus-utils-variant ^>=3.3
, lzma-static ^>=5.2.5.3
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
@@ -182,7 +204,7 @@ library
, split ^>=0.2.3.4
, streamly ^>=0.8.2
, strict-base ^>=0.4
, template-haskell >=2.7 && <2.20
, template-haskell >=2.7 && <2.22
, temporary ^>=1.3
, text ^>=2.0
, time >=1.9.3 && <1.12
@@ -191,11 +213,20 @@ library
, unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2
, vector >=0.12 && <0.14
, versions >=6.0.3 && <6.1
, versions >=6.0.5 && <6.1
, word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2
if flag(tar)
cpp-options: -DTAR
build-depends:
tar ^>=0.6.0.0
, zip ^>=2.0.0
else
build-depends: libarchive ^>=3.0.3.0
if (flag(internal-downloader) && !os(windows))
exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER
@@ -214,7 +245,6 @@ library
-- GHCup.OptParse.Run uses this
exposed-modules: GHCup.Prelude.Process.Windows
build-depends:
, bzlib
, process ^>=1.6.11.0
, Win32 >=2.10
@@ -231,14 +261,13 @@ library
install-includes: dirutils.h
c-sources: cbits/dirutils.c
build-depends:
, bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.3
, unix ^>=2.7
, unix ^>=2.7 || ^>=2.8
, unix-bytestring ^>=0.3.7.3
if flag(tui)
cpp-options: -DBRICK
build-depends: vty ^>=6.0
build-depends: vty ^>=6.0 || ^>=6.1 || ^>=6.2
library ghcup-optparse
import: app-common-depends
@@ -281,6 +310,62 @@ library ghcup-optparse
build-depends: ghcup
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if flag(tui)
cpp-options: -DBRICK
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7 || ^>=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.Widgets.Menus.CompileHLS
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
@@ -316,6 +401,7 @@ executable ghcup
build-depends:
, ghcup
, ghcup-optparse
, ghcup-tui
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
@@ -326,13 +412,13 @@ executable ghcup
build-depends:
, brick ^>=2.1
, transformers ^>=0.5
, vty ^>=6.0
, vty ^>=6.0 || ^>=6.1 || ^>=6.2
, optics ^>=0.4
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
build-depends: unix ^>=2.7 || ^>=2.8
if flag(no-exe)
buildable: False
@@ -367,7 +453,7 @@ test-suite ghcup-test
, bytestring >=0.10 && <0.12
, containers ^>=0.6
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, filepath >=1.4.101.0
, generic-arbitrary >=0.1.0 && <0.2.1 || >=0.2.2 && <0.3
, ghcup
, hspec >=2.7.10 && <2.11
@@ -378,13 +464,13 @@ test-suite ghcup-test
, text ^>=2.0
, time >=1.9.3 && <1.12
, uri-bytestring ^>=0.3.2.2
, versions >=6.0.3 && <6.1
, versions >=6.0.5 && <6.1
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
build-depends: unix ^>=2.7 || ^>=2.8
test-suite ghcup-optparse-test
type: exitcode-stdio-1.0

View File

@@ -2,9 +2,15 @@ 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"

View File

@@ -29,6 +29,7 @@ import Data.Maybe
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import System.Process ( system )
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
@@ -128,21 +129,22 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
Just uri -> do
pfreq <- runAppState getPlatformReq
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
if clOpen
then do
runAppState $
exec cmd
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
Nothing
Nothing
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 ExitSuccess
Left e -> logError (T.pack $ prettyHFError e)
>> pure (ExitFailure 13)
else liftIO $ putStrLn uri' >> pure ExitSuccess

View File

@@ -59,7 +59,7 @@ import Safe
import System.Process ( readProcess )
import System.FilePath
import Text.HTML.TagSoup hiding ( Tag )
import URI.ByteString
import URI.ByteString hiding (parseURI)
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M
@@ -77,7 +77,6 @@ import qualified Cabal.Config as CC
--[ Types ]--
-------------
-- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolVersion Version
@@ -215,7 +214,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
uriParser :: String -> Either String URI
uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
uriParser = first show . parseURI . UTF8.fromString
absolutePathParser :: FilePath -> Either String FilePath
@@ -313,6 +312,29 @@ 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 ]--
------------------
@@ -834,11 +856,11 @@ parseUrlSource :: String -> Either String URLSource
parseUrlSource "GHCupURL" = pure GHCupURL
parseUrlSource "StackSetupURL" = pure StackSetupURL
parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI .UTF8.fromString $ s')
parseNewUrlSource :: String -> Either String NewURLSource
parseNewUrlSource "GHCupURL" = pure NewGHCupURL
parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')
<|> (fmap NewURI . first show . parseURI .UTF8.fromString $ s')

View File

@@ -25,7 +25,6 @@ import GHCup.OptParse.Common
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Codec.Archive ( ArchiveResult )
import Control.Concurrent (threadDelay)
import Control.Monad.Reader
import Control.Monad.Trans.Resource
@@ -37,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 )
import Options.Applicative.Help.Pretty ( text, vsep )
import Prelude hiding ( appendFile )
import System.Exit
@@ -75,7 +74,7 @@ data GHCCompileOptions = GHCCompileOptions
, crossTarget :: Maybe Text
, addConfArgs :: [Text]
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, overwriteVer :: Maybe [VersionPattern]
, buildFlavour :: Maybe String
, buildSystem :: Maybe BuildSystem
, isolateDir :: Maybe FilePath
@@ -87,7 +86,7 @@ data HLSCompileOptions = HLSCompileOptions
, jobs :: Maybe Int
, setCompile :: Bool
, updateCabal :: Bool
, ovewrwiteVer :: Either Bool Version
, overwriteVer :: Maybe [VersionPattern]
, isolateDir :: Maybe FilePath
, cabalProject :: Maybe (Either FilePath URI)
, cabalProjectLocal :: Maybe URI
@@ -156,9 +155,9 @@ 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 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 specifc version for the binary name
# 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 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|]
@@ -254,11 +253,16 @@ ghcCompileOpts =
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
<*> optional
(option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
(eitherReader overWriteVersionParser
)
(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'"
(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"
])
<> (completer $ versionCompleter [] GHC)
)
)
@@ -344,19 +348,25 @@ hlsCompileOpts =
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
<*>
(
(Right <$> option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
optional (option
(eitherReader overWriteVersionParser
)
(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'"
(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"
])
<> (completer $ versionCompleter [] HLS)
)
)
<|>
(Left <$> (switch
((\b -> if b then Just [GitDescribe] else Nothing) <$> (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
)
)
)
@@ -519,9 +529,14 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) HLS dls
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure ()
@@ -530,7 +545,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
targetHLS
ghcs
jobs
ovewrwiteVer
overwriteVer
(maybe GHCupInternal IsolateDir isolateDir)
cabalProject
cabalProjectLocal
@@ -568,16 +583,21 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (mkTVer targetVer) GHC dls
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure ()
targetVer <- liftE $ compileGHC
targetGhc
crossTarget
ovewrwiteVer
overwriteVer
bootstrapGhc
jobs
buildConfig

View File

@@ -47,6 +47,7 @@ data GCOptions = GCOptions
, gcHLSNoGHC :: Bool
, gcCache :: Bool
, gcTmp :: Bool
, gcUnset :: Bool
} deriving (Eq, Show)
@@ -77,6 +78,9 @@ gcP =
<*>
switch
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
<*>
switch
(short 'u' <> long "unset" <> help "Remove all tool versions that are not 'set'")
@@ -134,6 +138,7 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
liftE $ when gcHLSNoGHC rmHLSNoGHC
lift $ when gcCache rmCache
lift $ when gcTmp rmTmp
liftE $ when gcUnset rmUnsetTools
) >>= \case
VRight _ -> do
pure ExitSuccess

View File

@@ -24,7 +24,7 @@ import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Codec.Archive
import Control.Concurrent (threadDelay)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
@@ -328,6 +328,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installGHCBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -339,6 +344,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
v
@@ -400,6 +410,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installCabalBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -409,6 +424,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing Nothing)
v
@@ -449,6 +469,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installHLSBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -458,6 +483,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
-- TODO: support legacy
liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
@@ -499,6 +529,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
(case instBindist of
Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installStackBin
v
(maybe GHCupInternal IsolateDir isolateDir)
@@ -508,6 +543,11 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
forM_ (_viPreInstall =<< vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing Nothing)
v

View File

@@ -28,7 +28,6 @@ import Control.Exception.Safe ( MonadMask, MonadCatch )
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Codec.Archive
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor

View File

@@ -23,7 +23,6 @@ import GHCup.Utils.Dirs
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Codec.Archive
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif

View File

@@ -17,6 +17,7 @@ import GHCup.Types
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import Control.Concurrent (threadDelay)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
@@ -135,8 +136,15 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade runAppState (do
v' <- liftE $ upgradeGHCup target force' fatal
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Just (tver, vi) <- pure $ getLatest dls GHCup
let latestVer = _tvVersion tver
forM_ (_viPreInstall vi) $ \msg -> do
lift $ logWarn msg
lift $ logWarn
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
v' <- liftE $ upgradeGHCup' target force' fatal latestVer
pure (v', dls)
) >>= \case
VRight (v', dls) -> do

View File

@@ -0,0 +1,727 @@
{-# 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)
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
import Control.Concurrent (threadDelay)
import qualified GHCup.GHC as GHC
import qualified GHCup.OptParse.Common as OptParse
import qualified GHCup.HLS as HLS
{- 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
compileGHC :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> CompileGHC.CompileGHCOptions -> (Int, ListResult) -> m (Either String ())
compileGHC compopts (_, lr@ListResult{lTool = GHC, ..}) = do
appstate <- ask
let run =
runResourceT
. runE @'[ AlreadyInstalled
, BuildFailed
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
, DirNotEmpty
, ArchiveResult
, FileDoesNotExistError
, HadrianNotFound
, InvalidBuildConfig
, ProcessError
, CopyError
, BuildFailed
, UninstallFailed
, MergeFileTreeError
]
compileResult <- run (do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let vi = getVersionInfo (mkTVer lVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
logInfo msg
logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
targetVer <- liftE $ GHCup.compileGHC
(GHC.SourceDist lVer)
(compopts ^. CompileGHC.crossTarget)
(compopts ^. CompileGHC.overwriteVer)
(compopts ^. CompileGHC.bootstrapGhc)
(compopts ^. CompileGHC.jobs)
(compopts ^. CompileGHC.buildConfig)
(compopts ^. CompileGHC.patches)
(compopts ^. CompileGHC.addConfArgs)
(compopts ^. CompileGHC.buildFlavour)
(compopts ^. CompileGHC.buildSystem)
(maybe GHCupInternal IsolateDir $ compopts ^. CompileGHC.isolateDir)
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask
let vi2 = getVersionInfo targetVer GHC dls2
when
(compopts ^. CompileGHC.setCompile)
(liftE . void $ GHCup.setGHC targetVer SetGHCOnly Nothing)
pure (vi2, targetVer)
)
case compileResult of
VRight (vi, tv) -> do
logInfo "GHC successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
liftIO $ putStr (T.unpack $ tVerToText tv)
pure $ Right ()
VLeft (V (AlreadyInstalled _ v)) -> do
logWarn $
"GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall"
pure $ Right ()
VLeft (V (DirNotEmpty fp)) -> do
logError $
"Install directory " <> T.pack fp <> " is not empty."
pure $ Right ()
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs (appstate & settings) of
Never -> logError $ T.pack $ prettyHFError err
_ -> logError $ T.pack (prettyHFError err) <> "\n"
<> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir)
<> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n"
<> "Make sure to clean up " <> T.pack tmpdir <> " afterwards."
pure $ Right ()
VLeft e -> do
logError $ T.pack $ prettyHFError e
pure $ Right ()
-- This is the case when the tool is not GHC... which should be impossible but,
-- it exhaustes pattern matches
compileGHC _ (_, ListResult{lTool = _}) = pure (Right ())
compileHLS :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> CompileHLS.CompileHLSOptions -> (Int, ListResult) -> m (Either String ())
compileHLS compopts (_, lr@ListResult{lTool = HLS, ..}) = do
appstate <- ask
let run =
runResourceT
. runE @'[ AlreadyInstalled
, BuildFailed
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
, DirNotEmpty
, ArchiveResult
, UninstallFailed
, MergeFileTreeError
]
compileResult <- run (do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let vi = getVersionInfo (mkTVer lVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
logInfo msg
logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
ghcs <-
liftE $ forM (compopts ^. CompileHLS.targetGHCs)
(\ghc -> fmap (_tvVersion . fst) . OptParse.fromVersion (Just ghc) $ GHC)
targetVer <- liftE $ GHCup.compileHLS
(HLS.SourceDist lVer)
ghcs
(compopts ^. CompileHLS.jobs)
(compopts ^. CompileHLS.overwriteVer)
(maybe GHCupInternal IsolateDir $ compopts ^. CompileHLS.isolateDir)
(compopts ^. CompileHLS.cabalProject)
(compopts ^. CompileHLS.cabalProjectLocal)
(compopts ^. CompileHLS.updateCabal)
(compopts ^. CompileHLS.patches)
(compopts ^. CompileHLS.cabalArgs)
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask
let vi2 = getVersionInfo (mkTVer targetVer) GHC dls2
when
(compopts ^. CompileHLS.setCompile)
(liftE . void $ GHCup.setHLS targetVer SetHLSOnly Nothing)
pure (vi2, targetVer)
)
case compileResult of
VRight (vi, tv) -> do
logInfo "HLS successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
liftIO $ putStr (T.unpack $ prettyVer tv)
pure $ Right ()
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs (appstate & settings) of
Never -> logError $ T.pack $ prettyHFError err
_ -> logError $ T.pack (prettyHFError err) <> "\n"
<> "Check the logs at " <> T.pack (fromGHCupPath $ appstate & dirs & logsDir)
<> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n"
<> "Make sure to clean up " <> T.pack tmpdir <> " afterwards."
pure $ Right ()
VLeft e -> do
logError $ T.pack $ prettyHFError e
pure $ Right ()
-- This is the case when the tool is not HLS... which should be impossible but,
-- it exhaustes pattern matches
compileHLS _ (_, ListResult{lTool = _}) = pure (Right ())
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)
let exitKey = KeyCombination (Vty.KChar 'c') [Vty.MCtrl]
case e of
Nothing -> pure ()
Just (_, r) -> do
-- Create new menus
contextMenu .= ContextMenu.create r exitKey
advanceInstallMenu .= AdvanceInstall.create exitKey
compileGHCMenu .= CompileGHC.create exitKey
compileHLSMenu .= CompileHLS.create exitKey
-- 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)

192
lib-tui/GHCup/Brick/App.hs Normal file
View File

@@ -0,0 +1,192 @@
{-# 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, compileHLSMenu)
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
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
import Control.Monad (when)
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]
CompileHLSPanel -> [CompileHLS.draw (st ^. compileHLSMenu), 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 'c') [Vty.MCtrl]) -> 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 'c') [Vty.MCtrl]) -> 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 mods)) ->
case find (\(key', _, _) -> key' == KeyCombination key mods) (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
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= Navigation
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileGHCButton) ) -> mode .= Common.CompileGHCPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompileHLSButton) ) -> mode .= Common.CompileHLSPanel
_ -> 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
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> 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
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileGHC iopts)
_ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState ()
compileHLSHandler ev = do
ctx <- use compileHLSMenu
let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of
(_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileHLS iopts)
_ -> Common.zoom compileHLSMenu $ CompileHLS.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
CompileHLSPanel -> compileHLSHandler ev

View File

@@ -0,0 +1,84 @@
{-# 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

View File

@@ -0,0 +1,54 @@
{-# 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)
import GHCup.Brick.Widgets.Menus.CompileHLS (CompileHLSMenu)
data BrickState = BrickState
{ _appData :: BrickData
, _appSettings :: BrickSettings
, _appState :: BrickInternalState
, _contextMenu :: ContextMenu
, _advanceInstallMenu :: AdvanceInstallMenu
, _compileGHCMenu :: CompileGHCMenu
, _compileHLSMenu :: CompileHLSMenu
, _appKeys :: KeyBindings
, _mode :: Mode
}
--deriving Show
makeLenses ''BrickState

View File

@@ -0,0 +1,216 @@
{-# 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
, CompileGHCButton, CompileHLSButton, CabalProjectEditBox
, CabalProjectLocalEditBox, UpdateCabalCheckBox
) ) 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 CompileGHCButton :: ResourceId
pattern CompileGHCButton = ResourceId 101
pattern CompileHLSButton :: ResourceId
pattern CompileHLSButton = ResourceId 102
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
pattern CabalProjectEditBox :: ResourceId
pattern CabalProjectEditBox = ResourceId 16
pattern CabalProjectLocalEditBox :: ResourceId
pattern CabalProjectLocalEditBox = ResourceId 17
pattern UpdateCabalCheckBox :: ResourceId
pattern UpdateCabalCheckBox = ResourceId 18
-- | 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
| CompileHLSPanel
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

View File

@@ -0,0 +1,72 @@
{-# 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 c+ctrl to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]

View File

@@ -0,0 +1,370 @@
{-# 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 deriving (Eq)
-- | 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
isValidField :: MenuField s n -> Bool
isValidField = (== Valid) . fieldStatus
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.init . 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 True (Invalid err) _ _ amp = amp . centerV . renderAsErrMsg $ err
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
isValidMenu :: Menu s n -> Bool
isValidMenu = all isValidField . menuFields
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
if all isValidField updated_fields
then menuButtonsL %= fmap (fieldStatusL .~ Valid)
else menuButtonsL %= fmap (fieldStatusL .~ Invalid "Some fields are invalid")
menuFieldsL .= updated_fields
_ -> pure ()
where
-- runs the Event with the inner handler of MenuField.
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)

View File

@@ -0,0 +1,125 @@
{-# 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)
import System.FilePath (isValid, isAbsolute, normalise)
import GHCup.Prelude (stripNewlineEnd)
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 -> absolutePathParser (T.unpack i)
False -> Right Nothing
absolutePathParser :: FilePath -> Either Menu.ErrorMessage (Maybe FilePath)
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right . Just . stripNewlineEnd . normalise $ f
False -> Left "Please enter a valid absolute filepath."
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

View File

@@ -0,0 +1,207 @@
{-# 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,
bootstrapGhc,
jobs,
buildConfig,
patches,
crossTarget,
addConfArgs,
setCompile,
overwriteVer,
buildFlavour,
buildSystem,
isolateDir,
) 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(..), VersionPattern )
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, isValid, isAbsolute, normalise)
import Control.Applicative (Alternative((<|>)))
import Text.Read (readEither)
import GHCup.Prelude (stripNewlineEnd)
import qualified GHCup.OptParse.Common as OptParse
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
, _overwriteVer :: Maybe [VersionPattern]
, _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 i)
readPath = do
mfilepath <- filepathV i
case mfilepath of
Nothing -> Left "Invalid Empty value"
Just f -> Right (Right f)
in if T.any isPathSeparator i
then readPath
else readVersion
False -> Left "Invalid Empty value"
versionV :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
versionV = whenEmpty Nothing (bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack)
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 i =
case not $ emptyEditor i of
True -> absolutePathParser (T.unpack i)
False -> Right Nothing
absolutePathParser :: FilePath -> Either Menu.ErrorMessage (Maybe FilePath)
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right . Just . stripNewlineEnd . normalise $ f
False -> Left "Please enter a valid absolute filepath."
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 Make
| 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 overwriteVer
& Menu.fieldLabelL .~ "overwrite-version"
& Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
, Menu.createEditableField (Common.MenuElement Common.BuildSystemEditBox) systemV buildSystem
& Menu.fieldLabelL .~ "build system"
& Menu.fieldHelpMsgL .~ "either 'make' or 'hadrian'"
, 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.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"
& Menu.fieldStatusL .~ Menu.Invalid "bootstrap GHC is mandatory"
]
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
handler = Menu.handlerMenu
draw :: CompileGHCMenu -> Widget Name
draw = Common.frontwardLayer "Compile GHC" . Menu.drawMenu

View File

@@ -0,0 +1,191 @@
{-# 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.CompileHLS (
CompileHLSOptions,
CompileHLSMenu,
create,
handler,
draw,
jobs,
setCompile,
updateCabal,
overwriteVer,
isolateDir,
cabalProject,
cabalProjectLocal,
patches,
targetGHCs,
cabalArgs,
)
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, VersionPattern, ToolVersion)
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 System.FilePath (isValid, isAbsolute, normalise)
import Control.Applicative (Alternative((<|>)))
import Text.Read (readEither)
import GHCup.Prelude (stripNewlineEnd)
import qualified GHCup.OptParse.Common as OptParse
data CompileHLSOptions = CompileHLSOptions
{ _jobs :: Maybe Int
, _setCompile :: Bool
, _updateCabal :: Bool
, _overwriteVer :: Maybe [VersionPattern]
, _isolateDir :: Maybe FilePath
, _cabalProject :: Maybe (Either FilePath URI)
, _cabalProjectLocal :: Maybe URI
, _patches :: Maybe (Either FilePath [URI])
, _targetGHCs :: [ToolVersion]
, _cabalArgs :: [T.Text]
} deriving (Eq, Show)
makeLenses ''CompileHLSOptions
type CompileHLSMenu = Menu CompileHLSOptions Name
create :: KeyCombination -> CompileHLSMenu
create k = Menu.createMenu CompileGHCBox initialState k buttons fields
where
initialState =
CompileHLSOptions
Nothing
False
False
Nothing
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
cabalProjectV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath URI))
cabalProjectV i =
case not $ emptyEditor i of
True ->
let readPath = Right . Left . stripNewlineEnd . T.unpack $ i
in bimap T.pack Just $ second Right (readUri i) <|> readPath
False -> Right Nothing
{- There is an unwanted dependency to ghcup-opt... Alternatives are
- copy-paste a bunch of code
- define a new common library
-}
ghcVersionTagEither :: T.Text -> Either Menu.ErrorMessage [ToolVersion]
ghcVersionTagEither = first T.pack . traverse (OptParse.ghcVersionTagEither . T.unpack) . T.split isSpace
overWriteVersionParser :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
overWriteVersionParser = bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack
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
readUri :: T.Text -> Either String URI
readUri = first show . parseURI . UTF8.fromString . T.unpack
patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
patchesV = whenEmpty Nothing readPatches
where
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 i =
case not $ emptyEditor i of
True -> absolutePathParser (T.unpack i)
False -> Right Nothing
absolutePathParser :: FilePath -> Either Menu.ErrorMessage (Maybe FilePath)
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right . Just . stripNewlineEnd . normalise $ f
False -> Left "Please enter a valid absolute filepath."
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
additionalValidator = Right . T.split isSpace
fields =
[ Menu.createEditableField (Common.MenuElement Common.CabalProjectEditBox) cabalProjectV cabalProject
& Menu.fieldLabelL .~ "cabal project"
& Menu.fieldHelpMsgL .~ "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
, Menu.createEditableField (Common.MenuElement Common.CabalProjectLocalEditBox) (bimap T.pack Just . readUri) cabalProjectLocal
& Menu.fieldLabelL .~ "cabal project local"
& Menu.fieldHelpMsgL .~ "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
, Menu.createCheckBoxField (Common.MenuElement Common.UpdateCabalCheckBox) updateCabal
& Menu.fieldLabelL .~ "cabal update"
& Menu.fieldHelpMsgL .~ "Run 'cabal update' before the build"
, 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.TargetGhcEditBox) ghcVersionTagEither targetGHCs
& Menu.fieldLabelL .~ "target GHC"
& Menu.fieldHelpMsgL .~ "For which GHC version to compile for (can be specified multiple times)"
, 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.createCheckBoxField (Common.MenuElement Common.SetCheckBox) setCompile
& Menu.fieldLabelL .~ "set"
& Menu.fieldHelpMsgL .~ "Set as active version after install"
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator cabalArgs
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
& Menu.fieldHelpMsgL .~ "Additional arguments to cabal install, prefix with '-- ' (longopts)"
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathV isolateDir
& Menu.fieldLabelL .~ "isolated"
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
, Menu.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) overWriteVersionParser overwriteVer
& Menu.fieldLabelL .~ "overwrite version"
& Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
]
buttons = [
Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile HLS from source with options below"
]
handler :: BrickEvent Name e -> EventM Name CompileHLSMenu ()
handler = Menu.handlerMenu
draw :: CompileHLSMenu -> Widget Name
draw = Common.frontwardLayer "Compile HLS" . Menu.drawMenu

View File

@@ -0,0 +1,82 @@
{-# 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"
compileGhcButton =
Menu.createButtonField (MenuElement Common.CompileGHCButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile GHC from source"
compileHLSButton =
Menu.createButtonField (MenuElement Common.CompileHLSButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile HLS from source"
buttons =
case lTool lr of
GHC -> [advInstallButton, compileGhcButton]
HLS -> [advInstallButton, compileHLSButton]
_ -> [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

View File

@@ -0,0 +1,151 @@
{-# 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.Core ( putCursor )
import Brick.Types ( Location(..) )
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
active = if b then putCursor Common.AllTools (Location (0,0)) else id
in hooray $ active $ 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 ' ')

View File

@@ -0,0 +1,193 @@
{-# 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

View File

@@ -0,0 +1,77 @@
{-# 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 c+ctrl to exit the tutorial")

View File

@@ -0,0 +1,79 @@
{-# 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 (..), KeyCombination (KeyCombination) )
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 qualified Graphics.Vty as Vty
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
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
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 = KeyCombination (Vty.KChar 'c') [Vty.MCtrl] -- 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 exit_key)
(CompileGHC.create exit_key)
(CompileHLS.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

View File

@@ -273,7 +273,6 @@ getDebugInfo = do
--[ GHCup upgrade etc ]--
-------------------------
-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
-- if no path is provided.
upgradeGHCup :: ( MonadMask m
@@ -308,11 +307,48 @@ upgradeGHCup :: ( MonadMask m
m
Version
upgradeGHCup mtarget force' fatal = do
Dirs {..} <- lift getDirs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ logInfo "Upgrading GHCup..."
let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
upgradeGHCup' mtarget force' fatal latestVer
-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
-- if no path is provided.
upgradeGHCup' :: ( MonadMask m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
, HasSettings env
, MonadCatch m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadResource m
, MonadIO m
, MonadUnliftIO m
)
=> Maybe FilePath -- ^ full file destination to write ghcup into
-> Bool -- ^ whether to force update regardless
-- of currently installed version
-> Bool -- ^ whether to throw an error if ghcup is shadowed
-> Version
-> Excepts
'[ CopyError
, DigestError
, ContentLengthError
, GPGError
, GPGError
, DownloadFailed
, NoDownload
, NoUpdate
, ToolShadowed
]
m
Version
upgradeGHCup' mtarget force' fatal latestVer = do
Dirs {..} <- lift getDirs
lift $ logInfo "Upgrading GHCup..."
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -506,6 +542,26 @@ rmOldGHC = do
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
rmUnsetTools :: ( MonadReader env m
, HasGHCupInfo env
, HasPlatformReq env
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> Excepts '[NotInstalled, UninstallFailed] m ()
rmUnsetTools = do
vers <- lift $ listVersions Nothing [ListInstalled True, ListSet False] False True (Nothing, Nothing)
forM_ vers $ \ListResult{..} -> case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer)
HLS -> liftE $ rmHLSVer lVer
Cabal -> liftE $ rmCabalVer lVer
Stack -> liftE $ rmStackVer lVer
GHCup -> pure ()
rmProfilingLibs :: ( MonadReader env m
, HasDirs env

View File

@@ -26,7 +26,6 @@ import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad

View File

@@ -34,6 +34,7 @@ import qualified GHCup.Types.Stack as Stack
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Utils.URI
import GHCup.Platform
import GHCup.Prelude
import GHCup.Prelude.File
@@ -77,7 +78,7 @@ import System.Exit
import System.FilePath
import System.IO.Error
import System.IO.Temp
import URI.ByteString
import URI.ByteString hiding (parseURI)
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as B
@@ -91,6 +92,8 @@ import qualified Data.Yaml.Aeson as Y
-- $setup
-- >>> :set -XOverloadedStrings
@@ -165,7 +168,7 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
-> [String]
-> m GHCupInfo
fromStackSetupInfo (Stack.siGHCs -> ghcDli) keys = do
let ghcVersionsPerKey = (`M.lookup` ghcDli) <$> (T.pack <$> keys)
let ghcVersionsPerKey = (`M.lookup` ghcDli) . T.pack <$> keys
ghcVersions = fromMaybe mempty . listToMaybe . catMaybes $ ghcVersionsPerKey
(ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
@@ -174,11 +177,11 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
where
fromDownloadInfo :: DownloadInfo -> VersionInfo
fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing
in VersionInfo [] Nothing Nothing Nothing Nothing aspec Nothing Nothing Nothing Nothing
fromStackDownloadInfo :: MonadThrow m => Stack.GHCDownloadInfo -> m DownloadInfo
fromStackDownloadInfo (Stack.GHCDownloadInfo { gdiDownloadInfo = Stack.DownloadInfo{..} }) = do
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI . E.encodeUtf8 $ downloadInfoUrl
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
@@ -855,7 +858,7 @@ getGpgOpts =
-- "baz"
urlBaseName :: ByteString -- ^ the url path (without scheme and host)
-> ByteString
urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
urlBaseName = snd . B.breakEnd (== _slash)
-- | Curl saves all intermediate connect headers as well, not just the last one, so we make an effort to take the

View File

@@ -11,6 +11,7 @@ import GHCup.Download.Utils
import GHCup.Errors
import GHCup.Types.JSON ( )
import GHCup.Prelude
import GHCup.Utils.URI
import Control.Applicative
import Control.Exception.Safe
@@ -28,7 +29,7 @@ import Prelude hiding ( abs
, writeFile
)
import System.ProgressBar
import URI.ByteString
import URI.ByteString hiding (parseURI)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as M
@@ -114,7 +115,7 @@ downloadInternal = go (5 :: Int)
| otherwise -> throwE $ HTTPStatusError scode (getHeaderMap r)
)
followRedirectURL bs = case parseURI strictURIParserOptions bs of
followRedirectURL bs = case parseURI bs of
Right uri' -> do
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders eCSize

View File

@@ -21,7 +21,6 @@ module GHCup.Errors where
import GHCup.Types
import Codec.Archive
import Control.Exception.Safe
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
@@ -212,20 +211,22 @@ data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
deriving Show
instance Pretty NoDownload where
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
| (Just target) <- mtarget
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
= text $ "Unable to find a download for "
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq) =
let helperMsg
| (Just target) <- mtarget
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool)) =
"\nPerhaps you meant: 'ghcup <command> "
<> T.unpack target
<> " "
<> T.unpack (prettyVer vv)
<> "'"
| otherwise = ""
in text $ "Unable to find a download for "
<> show tool
<> " version '"
<> T.unpack (tVerToText tver)
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
<> "Perhaps you meant: 'ghcup <command> "
<> T.unpack target
<> " "
<> T.unpack (prettyVer vv)
<> "'"
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
<> " version "
<> "'" <> T.unpack (tVerToText tver) <> "'"
<> maybe "" (\pfreq -> " on detected platform " <> pfReqToString pfreq) mpfreq
<> helperMsg
instance HFErrorProject NoDownload where
eBase _ = 10
@@ -387,7 +388,7 @@ data NotInstalled = NotInstalled Tool GHCTargetVersion
instance Pretty NotInstalled where
pPrint (NotInstalled tool ver) =
text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
text "The version" <+> (text "'" <> pPrint ver <> text "'") <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
instance HFErrorProject NotInstalled where
eBase _ = 130
@@ -524,7 +525,7 @@ data HTTPNotModified = HTTPNotModified Text
instance Pretty HTTPNotModified where
pPrint (HTTPNotModified etag) =
text "Remote resource not modifed, etag was:" <+> pPrint etag
text "Remote resource not modified, etag was:" <+> pPrint etag
instance HFErrorProject HTTPNotModified where
eBase _ = 240
@@ -819,7 +820,7 @@ instance Exception ParseError
instance HFErrorProject ParseError where
eBase _ = 500
eDesc _ = "A parse error occured."
eDesc _ = "A parse error occurred."
data UnexpectedListLength = UnexpectedListLength String

View File

@@ -34,7 +34,6 @@ import GHCup.Prelude.String.QQ
import GHCup.Prelude.Version.QQ
import GHCup.Prelude.MegaParsec
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.Concurrent ( threadDelay )
import Control.Exception.Safe
@@ -449,13 +448,30 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
= []
lift $ logInfo "Installing GHC (this may take a while)"
env <- case _rPlatform of
-- https://github.com/haskell/ghcup-hs/issues/967
Linux Alpine
-- lets not touch LD for cross targets
| Nothing <- _tvTarget tver -> do
cEnv <- liftIO getEnvironment
spaths <- liftIO getSearchPath
has_ld_bfd <- isJust <$> liftIO (searchPath spaths "ld.bfd")
let ldSet = isJust $ lookup "LD" cEnv
-- only set LD if ld.bfd exists in PATH and LD is not set
-- already
if has_ld_bfd && not ldSet
then do
lift $ logInfo "Detected alpine linux... setting LD=ld.bfd"
pure $ Just (("LD", "ld.bfd") : cEnv)
else pure Nothing
_ -> pure Nothing
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst)
: (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
)
(Just $ fromGHCupPath path)
"ghc-configure"
Nothing
env
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
@@ -791,7 +807,7 @@ compileGHC :: ( MonadMask m
)
=> GHCVer
-> Maybe Text -- ^ cross target
-> Maybe Version -- ^ overwrite version
-> Maybe [VersionPattern]
-> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs
-> Maybe FilePath -- ^ build config
@@ -827,12 +843,12 @@ compileGHC :: ( MonadMask m
]
m
GHCTargetVersion
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
compileGHC targetGhc crossTarget vps bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
= do
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
(workdir, tmpUnpack, tver) <- case targetGhc of
(workdir, tmpUnpack, tver, ov) <- case targetGhc of
-- unpack from version tarball
SourceDist ver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
@@ -854,7 +870,11 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
(view dlSubdir dlInfo)
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
ov <- case vps of
Just vps' -> fmap Just $ expandVersionPattern (Just ver) "" "" "" "" vps'
Nothing -> pure Nothing
pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver), ov)
RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -878,13 +898,17 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
ov <- case vps of
Just vps' -> fmap Just $ expandVersionPattern tver "" "" "" "" vps'
Nothing -> pure Nothing
pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver, ov)
-- clone from git
GitDist GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do
(tver, ov) <- cleanUpOnError tmpUnpack $ 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" ]
@@ -916,6 +940,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
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" ]
@@ -933,9 +958,19 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
pure tver
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 (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
pure (tver, ov)
pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver, ov)
-- 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')
@@ -1075,7 +1110,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
compileHadrianBindist tver workdir ghcdir = do
liftE $ configureBindist tver workdir ghcdir
lift $ logInfo "Building (this may take a while)..."
lift $ logInfo $ "Building GHC version " <> tVerToText tver <> " (this may take a while)..."
hadrian_build <- liftE $ findHadrianFile workdir
lEM $ execLogged hadrian_build
( maybe [] (\j -> ["-j" <> show j] ) jobs
@@ -1102,8 +1137,8 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
let possible_files = if isWindows
then ((workdir </> "hadrian") </>) <$> ["build.bat"]
else ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
exsists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f))
case filter fst exsists of
exists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f))
case filter fst exists of
[] -> throwE HadrianNotFound
((_, x):_) -> pure x
@@ -1147,7 +1182,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
liftE $ checkBuildConfig (build_mk workdir)
lift $ logInfo "Building (this may take a while)..."
lift $ logInfo $ "Building GHC version " <> tVerToText tver <> " (this may take a while)..."
lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
if | isCross tver -> do

View File

@@ -30,7 +30,6 @@ import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prelude.String.QQ
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
@@ -336,7 +335,7 @@ compileHLS :: ( MonadMask m
=> HLSVer
-> [Version]
-> Maybe Int
-> Either Bool Version
-> Maybe [VersionPattern]
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
@@ -354,7 +353,7 @@ compileHLS :: ( MonadMask m
, BuildFailed
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
compileHLS targetHLS ghcs jobs vps installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
@@ -363,7 +362,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
lift $ logInfo "Updating cabal DB"
lEM $ exec "cabal" ["update"] (Just $ fromGHCupPath tmpDir) Nothing
(workdir, tmpUnpack, tver, git_describe) <- case targetHLS of
(workdir, tmpUnpack, tver, ov) <- case targetHLS of
-- unpack from version tarball
SourceDist tver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
@@ -383,7 +382,11 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
pure (workdir, tmpUnpack, tver, Nothing)
ov <- case vps of
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
Nothing -> pure Nothing
pure (workdir, tmpUnpack, tver, ov)
HackageDist tver -> do
lift $ logDebug $ "Requested to compile (from hackage): " <> prettyVer tver
@@ -397,7 +400,11 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
let workdir = appendGHCupPath tmpUnpack hls
pure (workdir, tmpUnpack, tver, Nothing)
ov <- case vps of
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
Nothing -> pure Nothing
pure (workdir, tmpUnpack, tver, ov)
RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -420,13 +427,17 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
let workdir = appendGHCupPath tmpUnpack (takeDirectory cf)
pure (workdir, tmpUnpack, tver, Nothing)
ov <- case vps of
Just vps' -> fmap Just $ expandVersionPattern (Just tver) "" "" "" "" vps'
Nothing -> pure Nothing
pure (workdir, tmpUnpack, tver, ov)
-- clone from git
GitDist GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
cleanUpOnError tmpUnpack $ 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" ]
@@ -460,28 +471,31 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
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, git_describe)
pure (tmpUnpack, tmpUnpack, tver, ov)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
installVer <- case ov of
Left True -> case git_describe of
-- git describe
Just h -> either (fail . displayException) pure . version $ h
-- git describe, but not building from git, lol
Nothing -> pure tver
-- default: use detected version
Left False -> pure tver
-- overwrite version with users value
Right v -> pure v
installVer <- maybe (pure tver) pure ov
liftE $ runBuildAction
tmpUnpack
@@ -559,9 +573,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
pure installVer
where
gitDescribeRequested = case ov of
Left b -> b
_ -> False
gitDescribeRequested = maybe False (GitDescribe `elem`) vps
-----------------

View File

@@ -8,7 +8,7 @@
{-|
Module : GHCup.Plaform
Module : GHCup.Platform
Description : Retrieving platform information
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0

View File

@@ -240,7 +240,7 @@ recreateSymlink symsource newsym fail' = do
createSymbolicLink sympoint newsym
-- copys files, recreates symlinks, fails on all other types
-- copies files, recreates symlinks, fails on all other types
install :: FilePath -> FilePath -> Bool -> IO ()
install from to fail' = do
fs <- PF.getSymbolicLinkStatus from

View File

@@ -57,12 +57,10 @@ 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
@@ -299,7 +297,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))

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
@@ -98,7 +99,12 @@ 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 (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
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
closeFd
(action verbose noColor)
where
@@ -148,7 +154,7 @@ execLogged exe args chdir lfile env = do
void $ SPIB.fdWrite fileFd (bs' <> "\n")
void $ SPIB.fdWrite stdOutput (bs' <> "\n")
-- Reads fdIn and logs the output in a continous scrolling area
-- Reads fdIn and logs the output in a continuous scrolling area
-- of 'size' terminal lines. Also writes to a log file.
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
printToRegion fileFd fdIn size pState no_color = do
@@ -339,7 +345,11 @@ 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`.

View File

@@ -263,12 +263,9 @@ createProcessWithMingwPath :: MonadIO m
=> CreateProcess
-> m CreateProcess
createProcessWithMingwPath cp = do
msys2Dir <- liftIO ghcupMsys2Dir
cEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (env cp)
let mingWPaths = [msys2Dir </> "mingw64" </> "bin"
,msys2Dir </> "usr" </> "bin"
]
paths = ["PATH", "Path"]
mingWPaths <- liftIO ghcupMsys2BinDirs'
let 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
@@ -276,11 +273,4 @@ 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")

View File

@@ -26,7 +26,6 @@ import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad

View File

@@ -24,10 +24,12 @@ module GHCup.Types
, Key(..)
, Modifier(..)
#endif
, ArchiveResult(..)
)
where
import GHCup.Types.Stack ( SetupInfo )
import GHCup.Utils.Tar.Types ( ArchiveResult(..) )
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.DeepSeq ( NFData, rnf )
@@ -147,6 +149,7 @@ data VersionInfo = VersionInfo
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
-- informative messages
, _viPreInstall :: Maybe Text
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
@@ -542,11 +545,23 @@ 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
@@ -776,3 +791,12 @@ data BuildSystem = Hadrian
| Make
deriving (Show, Eq)
data VersionPattern = CabalVer
| GitHashShort
| GitHashLong
| GitDescribe
| GitBranchName
| S String
deriving (Eq, Show)

View File

@@ -26,6 +26,7 @@ import GHCup.Types.Stack (SetupInfo)
import GHCup.Types.JSON.Utils
import GHCup.Types.JSON.Versions ()
import GHCup.Prelude.MegaParsec
import GHCup.Utils.URI
import Control.Applicative ( (<|>) )
import Data.Aeson hiding (Key)
@@ -38,7 +39,7 @@ import Data.Text.Encoding as E
import Data.Foldable
import Data.Versions
import Data.Void
import URI.ByteString
import URI.ByteString hiding (parseURI)
import Text.Casing
import qualified Data.List.NonEmpty as NE
@@ -95,7 +96,7 @@ instance ToJSON URI where
instance FromJSON URI where
parseJSON = withText "URL" $ \t ->
case parseURI strictURIParserOptions (encodeUtf8 t) of
case parseURI (encodeUtf8 t) of
Right x -> pure x
Left e -> fail . show $ e

View File

@@ -21,7 +21,9 @@ installation and introspection of files/versions etc.
-}
module GHCup.Utils
( module GHCup.Utils.Dirs
, module GHCup.Utils.Tar
, module GHCup.Utils
, module GHCup.Utils.URI
#if defined(IS_WINDOWS)
, module GHCup.Prelude.Windows
#else
@@ -42,6 +44,8 @@ import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Utils.Tar
import GHCup.Utils.URI
import GHCup.Version
import GHCup.Prelude
import GHCup.Prelude.File
@@ -49,7 +53,6 @@ import GHCup.Prelude.Logger.Internal
import GHCup.Prelude.MegaParsec
import GHCup.Prelude.Process
import GHCup.Prelude.String.QQ
import Codec.Archive hiding ( Directory )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
@@ -77,12 +80,8 @@ import System.FilePath
import System.IO.Error
import Text.Regex.Posix
import Text.PrettyPrint.HughesPJClass (prettyShow)
import URI.ByteString
import URI.ByteString hiding (parseURI)
import qualified Codec.Compression.BZip as BZip
import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.Lzma as Lzma
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@@ -109,6 +108,7 @@ 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 +121,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 $ 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
-- >>> (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
@@ -280,7 +280,7 @@ rmPlainHLS = do
-----------------------------------
-- | Whether the given GHC versin is installed.
-- | Whether the given GHC version is installed.
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver
@@ -783,99 +783,6 @@ getLatestToolFor tool target pvpIn dls = do
-----------------
--[ Unpacking ]--
-----------------
-- | Unpack an archive to a temporary directory and return that path.
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath -- ^ destination dir
-> FilePath -- ^ archive path
-> Excepts '[UnknownArchive
, ArchiveResult
] m ()
unpackToDir dfp av = do
let fn = takeFileName av
lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf = liftIO . BL.readFile
-- extract, depending on file extension
if
| ".tar.gz" `isSuffixOf` fn -> liftE
(untar . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ untar decompressed
| ".tar.bz2" `isSuffixOf` fn ->
liftE (untar . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
| ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
| otherwise -> throwE $ UnknownArchive fn
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath -- ^ archive path
-> Excepts '[UnknownArchive
, ArchiveResult
] m [FilePath]
getArchiveFiles av = do
let fn = takeFileName av
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries = (fmap . fmap) filepath . lE . readArchiveBSL
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf = liftIO . BL.readFile
-- extract, depending on file extension
if
| ".tar.gz" `isSuffixOf` fn -> liftE
(entries . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ entries decompressed
| ".tar.bz2" `isSuffixOf` fn ->
liftE (entries . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
| ".zip" `isSuffixOf` fn -> liftE (entries =<< rf av)
| otherwise -> throwE $ UnknownArchive fn
intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
=> GHCupPath -- ^ unpacked tar dir
-> TarDir -- ^ how to descend
-> Excepts '[TarDirDoesNotExist] m GHCupPath
intoSubdir bdir tardir = case tardir of
RealDir pr -> do
whenM (fmap not . liftIO . doesDirectoryExist $ fromGHCupPath (bdir `appendGHCupPath` pr))
(throwE $ TarDirDoesNotExist tardir)
pure (bdir `appendGHCupPath` pr)
RegexDir r -> do
let rs = split (`elem` pathSeparators) r
foldlM
(\y x ->
(handleIO (\_ -> pure []) . liftIO . findFiles (fromGHCupPath y) . regex $ x) >>= (\case
[] -> throwE $ TarDirDoesNotExist tardir
(p : _) -> pure (y `appendGHCupPath` p)) . sort
)
bdir
rs
where regex = makeRegexOpts compIgnoreCase execBlank
------------
--[ Tags ]--
------------
@@ -929,6 +836,28 @@ getLatestBaseVersion av pvpVer =
--[ Other ]--
-------------
intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
=> GHCupPath -- ^ unpacked tar dir
-> TarDir -- ^ how to descend
-> Excepts '[TarDirDoesNotExist] m GHCupPath
intoSubdir bdir tardir = case tardir of
RealDir pr -> do
whenM (fmap not . liftIO . doesDirectoryExist $ fromGHCupPath (bdir `appendGHCupPath` pr))
(throwE $ TarDirDoesNotExist tardir)
pure (bdir `appendGHCupPath` pr)
RegexDir r -> do
let rs = split (`elem` pathSeparators) r
foldlM
(\y x ->
(handleIO (\_ -> pure []) . liftIO . findFiles (fromGHCupPath y) . regex $ x) >>= (\case
[] -> throwE $ TarDirDoesNotExist tardir
(p : _) -> pure (y `appendGHCupPath` p)) . sort
)
bdir
rs
where regex = makeRegexOpts compIgnoreCase execBlank
-- | Usually @~\/.ghcup\/ghc\/\<ver\>\/bin\/@
ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
@@ -963,7 +892,7 @@ ghcToolFiles ver = do
groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
getUniqueTools :: [[(FilePath, String)]] -> [String]
getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . concatMap (filter ((== "") . snd))
blackListedTools :: [String]
blackListedTools = ["haddock-ghc"]
@@ -1155,27 +1084,6 @@ 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 ()
@@ -1227,7 +1135,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")
@@ -1347,3 +1255,33 @@ 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

View File

@@ -32,6 +32,8 @@ module GHCup.Utils.Dirs
, getConfigFilePath'
, useXDG
, cleanupTrash
, ghcupMsys2BinDirs
, ghcupMsys2BinDirs'
, GHCupPath
, appendGHCupPath
@@ -136,6 +138,7 @@ 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
@@ -338,6 +341,48 @@ 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
@@ -348,6 +393,7 @@ getAllDirs = do
recycleDir <- ghcupRecycleDir
tmpDir <- ghcupTMPDir
dbDir <- ghcupDbDir
msys2Dir <- ghcupMsys2Dir
pure Dirs { .. }

141
lib/GHCup/Utils/Tar.hs Normal file
View File

@@ -0,0 +1,141 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Utils.Tar
Description : GHCup tar abstractions
Copyright : (c) Julian Ospald, 2024
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.Tar where
import GHCup.Utils.Tar.Types ( ArchiveResult(..) )
import GHCup.Errors
import GHCup.Prelude
import GHCup.Prelude.Logger.Internal
import GHCup.Types.Optics
import Control.Monad.Catch (MonadThrow)
import Control.Monad.Reader
import Data.List
import Haskus.Utils.Variant.Excepts
import System.FilePath
#if defined(TAR)
import Codec.Archive.Zip
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Data.Map.Strict as Map
#else
import Codec.Archive hiding ( Directory
, ArchiveResult -- imported from "GHCup.Utils.Tar.Types"
)
#endif
import qualified Codec.Compression.BZip as BZip
import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.Lzma as Lzma
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
-- | Unpack an archive to a given directory.
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath -- ^ destination dir
-> FilePath -- ^ archive path
-> Excepts '[UnknownArchive
, ArchiveResult
] m ()
unpackToDir dfp av = do
let fn = takeFileName av
lift $ logInfo $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
#if defined(TAR)
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar = liftIO . Tar.unpack dfp . Tar.read
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf = liftIO . BL.readFile
#else
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf = liftIO . BL.readFile
#endif
-- extract, depending on file extension
if
| ".tar.gz" `isSuffixOf` fn -> liftE
(untar . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ untar decompressed
| ".tar.bz2" `isSuffixOf` fn ->
liftE (untar . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
#if defined(TAR)
| ".zip" `isSuffixOf` fn -> withArchive av (unpackInto dfp)
#else
-- libarchive supports zip
| ".zip" `isSuffixOf` fn -> liftE (untar =<< rf av)
#endif
| otherwise -> throwE $ UnknownArchive fn
-- | Get all files from an archive.
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath -- ^ archive path
-> Excepts '[ UnknownArchive
, ArchiveResult
] m [FilePath]
getArchiveFiles av = do
let fn = takeFileName av
#if defined(TAR)
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries =
lE @ArchiveResult
. Tar.foldEntries
(\e x -> fmap (Tar.entryTarPath e :) x)
(Right [])
(\_ -> Left ArchiveFailed)
. Tar.decodeLongNames
. Tar.read
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf = liftIO . BL.readFile
#else
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries = (fmap . fmap) filepath . lE . readArchiveBSL
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf = liftIO . BL.readFile
#endif
-- extract, depending on file extension
if
| ".tar.gz" `isSuffixOf` fn -> liftE
(entries . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ entries decompressed
| ".tar.bz2" `isSuffixOf` fn ->
liftE (entries . BZip.decompress =<< rf av)
| ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
| ".zip" `isSuffixOf` fn ->
#if defined(TAR)
withArchive av $ do
entries' <- getEntries
pure $ fmap unEntrySelector $ Map.keys entries'
#else
liftE (entries =<< rf av)
#endif
| otherwise -> throwE $ UnknownArchive fn

View File

@@ -0,0 +1,33 @@
{-# LANGUAGE CPP #-}
#if defined(TAR)
{-# LANGUAGE DeriveGeneric #-}
#endif
module GHCup.Utils.Tar.Types
( ArchiveResult(..)
)
where
#if defined(TAR)
import Control.Exception ( Exception )
import Control.DeepSeq ( NFData )
import qualified GHC.Generics as GHC
data ArchiveResult = ArchiveFatal
| ArchiveFailed
| ArchiveWarn
| ArchiveRetry
| ArchiveOk
| ArchiveEOF
deriving (Eq, Show, GHC.Generic)
instance NFData ArchiveResult
instance Exception ArchiveResult
#else
import Codec.Archive ( ArchiveResult(..) )
#endif

49
lib/GHCup/Utils/URI.hs Normal file
View File

@@ -0,0 +1,49 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Utils.URI
Description : GHCup domain specific URI utilities
Copyright : (c) Julian Ospald, 2024
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
This module contains GHCup helpers specific to
URI handling.
-}
module GHCup.Utils.URI where
import Data.ByteString
import URI.ByteString hiding (parseURI)
import System.URI.File
import qualified URI.ByteString as URI
-----------
--[ URI ]--
-----------
parseURI :: ByteString -> Either URIParseError (URIRef Absolute)
parseURI bs = case parseFile bs of
Left _ -> case URI.parseURI strictURIParserOptions bs of
Right (URI { uriScheme = (Scheme "file") }) ->
#if defined(IS_WINDOWS)
Left (OtherError "Invalid file URI. File URIs must be absolute (start with a drive letter or UNC path) and not contain backslashes.")
#else
Left (OtherError "Invalid file URI. File URIs must be absolute.")
#endif
o -> o
Right (FileURI (Just _) _) -> Left $ OtherError "File URIs with auth part are not supported!"
Right (FileURI _ fp) -> Right $ URI (Scheme "file") Nothing fp (Query []) Nothing
where
parseFile
#if defined(IS_WINDOWS)
= parseFileURI ExtendedWindows
#else
= parseFileURI ExtendedPosix
#endif

View File

@@ -31,7 +31,7 @@ import Data.Void (Void)
-- | This reflects the API version of the YAML.
--
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- Note that when updating this, CI requires that the file exists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]

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