Compare commits

...

126 Commits
v0.1.11 ... arm

Author SHA1 Message Date
56feb7c09e Use stages in CI 2021-02-25 14:14:01 +01:00
f547a6eb68 Support ARM/AARCH 2021-02-25 11:53:36 +01:00
eab82b5d63 Update HLS to 1.0.0 2021-02-24 12:43:04 +01:00
c455b521a9 Fix ghcup-tui 2021-02-24 12:42:36 +01:00
b4f9e12293 Merge remote-tracking branch 'origin/merge-requests/54' 2021-02-24 10:13:46 +01:00
bbd353ea3a Merge branch 'PR/issue-107' 2021-02-23 18:40:04 +01:00
4189c5de69 Update CHANGELOG 2021-02-23 17:11:45 +01:00
dee3218723 Fix item selection with unavailable versions
Fixes #107
2021-02-23 17:10:48 +01:00
3c803a9f58 Merge branch 'PR/issue-104' 2021-02-23 12:52:19 +01:00
a9b0c0fbc9 Allow for dynamic post-install, post-remove and pre-compile msgs 2021-02-23 11:52:38 +01:00
38b6c918f9 Update CHANGELOG 2021-02-21 21:03:12 +01:00
6e584c96c4 Merge branch 'PR/issue-111' 2021-02-21 21:01:59 +01:00
20338f7d14 Alert user if upgraded ghcup is shadowed by old ghcup
Also alerts if the binary is not in PATH at all.

Fixes #111
2021-02-21 19:58:32 +01:00
1a995a5d63 Merge branch 'PR/cabal-3.4.0.0' 2021-02-21 16:34:18 +01:00
f964382175 Tighten checks, alpine 32bit bindists is 1st class 2021-02-21 15:37:05 +01:00
0c7f60fae6 Add more alpine 32bit bindists 2021-02-21 15:35:33 +01:00
413e63d1ca Update hasufell.de hosted bindists to webhost.haskell.org 2021-02-21 15:34:55 +01:00
8b000f4e48 Add cabal-3.4.0.0 final release 2021-02-20 23:30:28 +01:00
b0522507be Merge branch 'PR/ubunbu-20.10-update-reqs/110' 2021-02-16 16:40:03 +01:00
d4bcf7021e Merge branch 'PR/fix-109' 2021-02-16 16:26:13 +01:00
48cf0b1f67 Update libffi req for ubuntu groovy
Fixed #110
2021-02-16 14:41:49 +01:00
d82e189c01 Fix failed ghcup upgrade if destination dir doesn't exist
Fixes #109
2021-02-16 14:37:17 +01:00
e5a60d1b9a Merge branch 'ghc-8.10.4' 2021-02-06 22:39:52 +01:00
ff067351cb Add GHC-8.10.4 2021-02-06 14:28:58 +01:00
345712a617 Add freeze/project file for ghc-8.10.3 2021-02-05 11:59:57 +01:00
118dac6907 Merge branch 'bump-GHC-CI' 2021-02-05 11:51:11 +01:00
5ca40caf81 Bump GHC/Cabal in CI 2021-02-05 11:02:45 +01:00
d858187fd4 Merge remote-tracking branch 'origin/merge-requests/61' 2021-02-05 10:49:39 +01:00
bd65517df1 Add changelog for ghc-9.0.1 2021-02-04 23:20:19 +01:00
b1acad6c95 Set 8.10.3 as recommended 2021-02-04 22:59:17 +01:00
a8333281ac Bump to GHC-9.0.1 2021-02-04 22:49:49 +01:00
2fdb08ac00 Merge remote-tracking branch 'origin/merge-requests/59' 2021-01-31 11:19:22 +01:00
Javier Neira
bd4e5a2314 Update haskell-language-server to 0.9.0 2021-01-30 15:36:34 -05:00
34ed317b6b Merge remote-tracking branch 'origin/merge-requests/58' 2021-01-13 10:13:40 +08:00
Enrico Maria De Angelis
14661502ab #103: Rewording of warning message 2021-01-11 07:12:19 +00:00
097754ffdf Merge remote-tracking branch 'origin/merge-requests/57' 2021-01-05 08:24:30 +08:00
amesgen
f26ec6d295 update HLS to 0.8.0 2021-01-04 21:02:38 +01:00
858d430845 Add ghc-8.10.3 for alpine 32bit 2021-01-04 09:51:36 +08:00
5134eccbf8 Update HACKING.md 2021-01-02 16:07:41 +08:00
28b4737758 Merge remote-tracking branch 'origin/merge-requests/56' 2021-01-02 15:57:18 +08:00
amesgen
5c43ff4c9e error if we check nothing 2021-01-02 08:51:57 +01:00
amesgen
53db68e39f minor tarball filter format change 2021-01-02 07:58:08 +01:00
9e628e34dd Merge remote-tracking branch 'origin/merge-requests/55' 2021-01-02 14:27:11 +08:00
amesgen
62d5d53232 filter tool and version instead of URL 2021-01-02 05:53:11 +01:00
amesgen
56569a0698 use regex instead of substring 2021-01-02 05:05:05 +01:00
amesgen
ef44f818d0 add GHC 9.0.1-rc1 2021-01-01 05:50:54 +01:00
amesgen
8944ed6e36 allow to filter tarball validation by a URL substring
also, use nubOrd for linearithmic instead of quadratic complexity
2021-01-01 05:45:58 +01:00
51805b27aa Update CHANGELOG 2020-12-30 17:01:45 +08:00
0ec64510b3 Update CHANGELOG 2020-12-30 16:52:46 +08:00
20152443da Fix hash for 8.10.3 src dist 2020-12-30 11:47:26 +08:00
Ron Toland
7c8929fe9f add default install instructions for apple silicon 2020-12-26 06:33:32 -08:00
5617516c93 Merge remote-tracking branch 'origin/merge-requests/52' 2020-12-25 01:26:08 +08:00
f6fe08367d Fix cabal prerelease download URLs wrt #102 2020-12-24 04:46:05 +08:00
a5f02133e2 Merge remote-tracking branch 'origin/merge-requests/53' 2020-12-24 01:57:58 +08:00
Ron Toland
8ed9b4432d Add install cmd for Apple Silicon wrt #101 2020-12-23 06:51:54 -08:00
amesgen
db1d05e8ad add GHC 8.10.3 2020-12-21 00:52:00 +01:00
eae58137c8 Merge remote-tracking branch 'origin/merge-requests/47' 2020-12-20 01:45:49 +08:00
b0f90c096f Fix chmod on executables, wrt #97 2020-12-20 01:27:27 +08:00
e8361c564a Merge remote-tracking branch 'origin/merge-requests/51' 2020-12-19 03:30:40 +08:00
amesgen
54db9c9a92 update HLS to 0.7.1 2020-12-18 15:32:50 +01:00
amesgen
73db341dc8 update HLS to 0.7.0 2020-12-16 00:58:26 +01:00
5fd30b412b Merge remote-tracking branch 'origin/merge-requests/49' 2020-11-28 12:46:16 +01:00
Anton-Latukha
bbe2e87640 CHANGELOG.md: add note about ghcup directory fix` 2020-11-28 12:34:58 +02:00
Anton-Latukha
67f59f6895 bootstrap-haskell: fx XDG GHCUP_DIR value 2020-11-28 01:41:43 +02:00
Anton-Latukha
3e2df2e111 bootstrap-haskell: create GHCUP_DIR 2020-11-28 01:27:35 +02:00
824d2149c6 Merge remote-tracking branch 'origin/merge-requests/48' 2020-11-27 20:26:33 +01:00
Anton-Latukha
c86dbe043b bootstrap-haskell: mention the license
Since script is served separately from the main source code (can be opened over
https://get-ghcup.haskell.org) - mention the script license to the reciever.
2020-11-27 17:06:39 +02:00
Anton-Latukha
8043ac7f51 bootstrap-haskell: provide instructions for the main settings
Provide some basic instructive information to someone who views the script.
2020-11-27 17:04:00 +02:00
Paolo Martini
ead9d31647 Apply NO_COLOR to dimAttributes as well to cover all tui colors 2020-11-26 20:22:32 +01:00
Paolo Martini
a08e624309 Respect NO_COLOR environment variable in list and tui 2020-11-25 11:41:53 +01:00
b20371c3ac Add default values to all XDG_ variables documentation 2020-11-21 16:31:50 +01:00
0589a7cbcc Document XDG_CONFIG_HOME wrt #85 2020-11-21 16:29:26 +01:00
cf48961063 Bump ghcup to 0.1.12 2020-11-21 14:23:37 +01:00
6046582b9c Improve version ranges 2020-11-21 14:05:34 +01:00
82aa6c70ea Allow to encode version ranges for distro versions
Fixes #84
2020-11-21 01:12:15 +01:00
e829bd8235 Fix brick not updating downloads correctly 2020-11-21 00:32:58 +01:00
66f989e691 Fix FromJSONKey instances
This led to silent Nothing when the parser failed.
2020-11-20 23:18:25 +01:00
eebb91fbb0 Use extra-doc-files for CHANGELOG.md 2020-11-20 23:16:13 +01:00
1d3e88bdfe Fix disappearing HLS symlinks wrt #91
When installing a new GHC version, the corresponding
HLS symlink of that version may be accidentially removed.

Ooops.
2020-11-20 23:05:37 +01:00
fbb03dee7e Merge remote-tracking branch 'origin/merge-requests/44' into master 2020-11-12 10:49:26 +01:00
amesgen
88e5afb70f update HLS to 0.6.0 2020-11-11 23:19:05 +01:00
67eabfd3af Update CHANGELOG 2020-10-30 22:27:41 +01:00
cd1dd8c29e Merge branch 'PR/82' into master 2020-10-30 22:26:33 +01:00
08ddb591b7 Add toolchain sanity checks wrt #82 2020-10-30 21:07:49 +01:00
3e841b3c68 Merge branch 'settings' into master 2020-10-26 18:25:20 +01:00
53f5a08924 Allow configuring URLSource as well 2020-10-25 14:47:26 +01:00
d368863c3d Improve help output 2020-10-25 11:00:00 +01:00
c76cce5830 Add a --set option to install/compile, fixes #81 2020-10-25 10:54:04 +01:00
4fef93b7b1 Allow to configure ghcup with a yaml config file
Fixes #41
2020-10-25 10:22:45 +01:00
241dadbeb5 Update to versions-4.0.1 API 2020-10-25 10:22:35 +01:00
12459c2544 Add internal downloader and tui flags to stack 2020-10-25 10:22:35 +01:00
e250d6013f Redo Settings as AppState 2020-10-24 01:07:31 +02:00
0d41d180d6 Merge remote-tracking branch 'origin/merge-requests/40' into master 2020-10-14 11:59:15 +02:00
amesgen
ef251ce17e update to cabal-3.4.0.0-rc4 2020-10-13 20:53:09 +02:00
956e11c3f8 Bump version to 0.1.12 2020-10-13 00:09:35 +02:00
951b0843b2 Update hls to 0.5.1 2020-10-12 23:54:56 +02:00
a4e4080a1b Merge branch 'TUI-improvements' into master 2020-10-12 23:40:26 +02:00
2aa91c5d91 Update golden test 2020-10-12 21:48:06 +02:00
6471b3877f Bump ghcup version in bootstrap-haskell 2020-10-12 21:05:25 +02:00
778ee142d5 Upload golden files as artifacts on failure 2020-10-12 00:10:37 +02:00
1140132a25 Update hie.yaml 2020-10-11 23:40:02 +02:00
c5c299179d Remove text-conversion workaround 2020-10-11 23:39:49 +02:00
0ce4549eb8 Ditch the viewport logic 2020-10-11 23:37:27 +02:00
97d568ddd6 Show new versions in bright white 2020-10-11 21:44:11 +02:00
ea58465240 Expand the selected bar 2020-10-11 21:16:48 +02:00
7afd262b1b Put separators between tools 2020-10-11 21:07:21 +02:00
34ceaa0823 Add brick to stack.yaml 2020-10-11 21:06:58 +02:00
57c34a07f2 Allow to hide old versions of tools in TUI 2020-10-09 23:05:11 +02:00
73d1d97f1f Reverse order of tool list in TUI 2020-10-09 20:25:52 +02:00
f7ed1a4bde Commit ghc-8.8.4 cabal.project files
These are auto-generated from stack and meant for users.
2020-10-05 22:11:05 +02:00
bdd80d0229 Bump stack lts 2020-10-05 22:10:52 +02:00
0238f70c64 Bump hls to 0.5.0 2020-10-05 00:19:35 +02:00
24ff430c45 Add stack.yaml wrt #75 2020-10-01 17:49:23 +02:00
281fb14d4c Rename ghc-9.0.1-alpha1 to 9.0.0.20200925 wrt #73 2020-09-29 23:33:55 +02:00
03bac93929 Improve bootstrap test 2020-09-29 10:57:21 +02:00
1ae0c2a654 Move printf to the right place 2020-09-29 10:52:31 +02:00
8140936bd3 Test bootstrap-haskell wrt #72 2020-09-29 10:23:29 +02:00
8786acf476 Fix BOOTSTRAP_HASKELL_NONINTERACTIVE 2020-09-29 10:12:03 +02:00
c460d4c743 Update bindists for Mint to fedora 2020-09-29 00:22:58 +02:00
5294adf0d7 Fix bootstrap-script 2020-09-28 23:52:23 +02:00
00f3fa35fd Add hls installation to bootstrap-haskell 2020-09-28 23:48:59 +02:00
9c9aa4f9c0 Fix CI 2020-09-28 23:27:15 +02:00
e23a187cc4 Add ghc-9.0.1-alpha1 2020-09-28 23:23:11 +02:00
3e429945dc Also modify .bash_profile on mac 2020-09-28 09:59:35 +02:00
8be2a8eed7 Update CHANGELOG date for 0.1.11 2020-09-23 09:53:44 +02:00
6b65167581 Update yaml files 2020-09-23 00:27:28 +02:00
48 changed files with 27757 additions and 10918 deletions

View File

@@ -1,3 +1,7 @@
stages:
- test
- release
variables: variables:
GIT_SSL_NO_VERIFY: "1" GIT_SSL_NO_VERIFY: "1"
@@ -14,7 +18,7 @@ variables:
- x86_64-linux - x86_64-linux
variables: variables:
OS: "LINUX" OS: "LINUX"
BIT: "64" ARCH: "64"
.alpine:64bit: .alpine:64bit:
image: "alpine:3.12" image: "alpine:3.12"
@@ -22,7 +26,7 @@ variables:
- x86_64-linux - x86_64-linux
variables: variables:
OS: "LINUX" OS: "LINUX"
BIT: "64" ARCH: "64"
.alpine:32bit: .alpine:32bit:
image: "i386/alpine:3.12" image: "i386/alpine:3.12"
@@ -30,21 +34,37 @@ variables:
- x86_64-linux - x86_64-linux
variables: variables:
OS: "LINUX" OS: "LINUX"
BIT: "32" ARCH: "32"
.linux:armv7:
image: "arm32v7/fedora"
tags:
- armv7-linux
variables:
OS: "LINUX"
ARCH: "ARM"
.linux:aarch64:
image: "arm64v8/fedora"
tags:
- aarch64-linux
variables:
OS: "LINUX"
ARCH: "ARM64"
.darwin: .darwin:
tags: tags:
- x86_64-darwin - x86_64-darwin
variables: variables:
OS: "DARWIN" OS: "DARWIN"
BIT: "64" ARCH: "64"
.freebsd: .freebsd:
tags: tags:
- x86_64-freebsd - x86_64-freebsd
variables: variables:
OS: "FREEBSD" OS: "FREEBSD"
BIT: "64" ARCH: "64"
.root_cleanup: .root_cleanup:
after_script: after_script:
@@ -60,7 +80,12 @@ variables:
script: script:
- ./.gitlab/script/ghcup_version.sh - ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.2" JSON_VERSION: "0.0.4"
artifacts:
expire_in: 2 week
paths:
- golden
when: on_failure
.test_ghcup_version:linux: .test_ghcup_version:linux:
extends: extends:
@@ -76,6 +101,20 @@ variables:
before_script: before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh - ./.gitlab/before_script/linux/alpine/install_deps.sh
.test_ghcup_version:armv7:
extends:
- .test_ghcup_version
- .linux:armv7
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
.test_ghcup_version:aarch64:
extends:
- .test_ghcup_version
- .linux:aarch64
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
.test_ghcup_version:darwin: .test_ghcup_version:darwin:
extends: extends:
- .test_ghcup_version - .test_ghcup_version
@@ -101,65 +140,114 @@ variables:
- out - out
only: only:
- tags - tags
variables:
JSON_VERSION: "0.0.4"
######## stack test ########
test:linux:stack:
stage: test
before_script:
- ./.gitlab/before_script/linux/install_deps_minimal.sh
script:
- ./.gitlab/script/ghcup_stack.sh
extends:
- .debian
######## bootstrap test ########
test:linux:bootstrap_script:
stage: test
before_script:
- ./.gitlab/before_script/linux/install_deps_minimal.sh
script:
- ./.gitlab/script/ghcup_bootstrap.sh
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
extends:
- .debian
######## linux test ######## ######## linux test ########
test:linux:recommended: test:linux:recommended:
stage: test
extends: .test_ghcup_version:linux extends: .test_ghcup_version:linux
variables: variables:
GHC_VERSION: "8.8.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
test:linux:latest: test:linux:latest:
stage: test
extends: .test_ghcup_version:linux extends: .test_ghcup_version:linux
variables: variables:
GHC_VERSION: "8.10.2" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
allow_failure: true
######## linux 32bit test ######## ######## linux 32bit test ########
test:linux:recommended:32bit: test:linux:recommended:32bit:
stage: test
extends: .test_ghcup_version:linux32 extends: .test_ghcup_version:linux32
variables: variables:
GHC_VERSION: "8.8.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.2.0.0"
######## arm tests ########
test:linux:recommended:armv7:
extends: .test_ghcup_version:armv7
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
when: manual
test:linux:recommended:aarch64:
extends: .test_ghcup_version:aarch64
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
when: manual
######## darwin test ######## ######## darwin test ########
test:mac:recommended: test:mac:recommended:
stage: test
extends: .test_ghcup_version:darwin extends: .test_ghcup_version:darwin
variables: variables:
GHC_VERSION: "8.8.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
test:mac:latest: test:mac:latest:
stage: test
extends: .test_ghcup_version:darwin extends: .test_ghcup_version:darwin
variables: variables:
GHC_VERSION: "8.10.2" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
allow_failure: true
######## freebsd test ######## ######## freebsd test ########
test:freebsd:recommended: test:freebsd:recommended:
stage: test
extends: .test_ghcup_version:freebsd extends: .test_ghcup_version:freebsd
variables: variables:
GHC_VERSION: "8.8.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
test:freebsd:latest: test:freebsd:latest:
stage: test
extends: .test_ghcup_version:freebsd extends: .test_ghcup_version:freebsd
variables: variables:
GHC_VERSION: "8.10.2" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
allow_failure: true
######## linux release ######## ######## linux release ########
release:linux:64bit: release:linux:64bit:
stage: release
needs: ["test:linux:recommended", "test:linux:latest"]
extends: extends:
- .alpine:64bit - .alpine:64bit
- .release_ghcup - .release_ghcup
@@ -167,11 +255,13 @@ release:linux:64bit:
- ./.gitlab/before_script/linux/alpine/install_deps.sh - ./.gitlab/before_script/linux/alpine/install_deps.sh
variables: variables:
ARTIFACT: "x86_64-linux-ghcup" ARTIFACT: "x86_64-linux-ghcup"
GHC_VERSION: "8.8.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
release:linux:32bit: release:linux:32bit:
stage: release
needs: ["test:linux:recommended:32bit"]
extends: extends:
- .alpine:32bit - .alpine:32bit
- .release_ghcup - .release_ghcup
@@ -179,13 +269,40 @@ release:linux:32bit:
- ./.gitlab/before_script/linux/alpine/install_deps.sh - ./.gitlab/before_script/linux/alpine/install_deps.sh
variables: variables:
ARTIFACT: "i386-linux-ghcup" ARTIFACT: "i386-linux-ghcup"
GHC_VERSION: "8.8.4" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.2.0.0"
release:linux:armv7:
stage: release
needs: ["test:linux:recommended:armv7"]
extends:
- .linux:armv7
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
variables:
ARTIFACT: "armv7-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
release:linux:aarch64:
stage: release
needs: ["test:linux:recommended:aarch64"]
extends:
- .linux:aarch64
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/install_deps_manual.sh
variables:
ARTIFACT: "aarch64-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
######## darwin release ######## ######## darwin release ########
release:darwin: release:darwin:
stage: release
needs: ["test:mac:recommended", "test:mac:latest"]
extends: extends:
- .darwin - .darwin
- .release_ghcup - .release_ghcup
@@ -194,14 +311,16 @@ release:darwin:
- ./.gitlab/before_script/darwin/install_deps.sh - ./.gitlab/before_script/darwin/install_deps.sh
variables: variables:
ARTIFACT: "x86_64-apple-darwin-ghcup" ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VERSION: "8.8.3" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"
MACOSX_DEPLOYMENT_TARGET: "10.7" MACOSX_DEPLOYMENT_TARGET: "10.7"
######## freebsd release ######## ######## freebsd release ########
release:freebsd: release:freebsd:
stage: release
needs: ["test:freebsd:recommended", "test:freebsd:latest"]
extends: extends:
- .freebsd - .freebsd
- .release_ghcup - .release_ghcup
@@ -210,6 +329,6 @@ release:freebsd:
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
variables: variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup" ARTIFACT: "x86_64-portbld-freebsd-ghcup"
GHC_VERSION: "8.8.3" GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.2.0.0" CABAL_VERSION: "3.4.0.0"

View File

@@ -9,8 +9,9 @@ mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin install ${GHC_VERSION} ./ghcup-bin upgrade -i -f
./ghcup-bin set ${GHC_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
exit 0 exit 0

View File

@@ -11,8 +11,9 @@ mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin install ${GHC_VERSION} ./ghcup-bin upgrade -i -f
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
exit 0 exit 0

View File

@@ -10,6 +10,9 @@ apk add --no-cache \
curl \ curl \
gcc \ gcc \
g++ \ g++ \
binutils \
binutils-gold \
bsd-compat-headers \
gmp-dev \ gmp-dev \
ncurses-dev \ ncurses-dev \
libffi-dev \ libffi-dev \
@@ -18,14 +21,15 @@ apk add --no-cache \
tar \ tar \
perl perl
if [ "${BIT}" = "32" ] ; then if [ "${ARCH}" = "32" ] ; then
curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin
else else
curl -sSfL https://downloads.haskell.org/ghcup/x86_64-linux-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/ghcup/x86_64-linux-ghcup > ./ghcup-bin
fi fi
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin install ${GHC_VERSION} ./ghcup-bin upgrade -i -f
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
# utils # utils
apk add --no-cache \ apk add --no-cache \

View File

@@ -12,7 +12,8 @@ sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev li
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin install ${GHC_VERSION} ./ghcup-bin upgrade -i -f
./ghcup-bin set ${GHC_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION} ./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}

View File

@@ -0,0 +1,64 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}"
ednf() {
case "${ARCH}" in
"ARM")
sudo dnf -y --forcearch armv7hl "$@"
;;
"ARM64")
sudo dnf -y --forcearch aarch64 "$@"
;;
*) exit 1 ;;
esac
}
ednf update
ednf install gcc gcc-c++ gmp gmp-devel make ncurses ncurses-devel xz xz-devel perl zlib zlib-devel openssl-devel openssl-libs openssl libffi libffi-devel
if [ "${ARCH}" = "ARM64" ] ; then
ednf install numactl numactl-libs numactl-devel
fi
ednf install bash wget curl git tar
ednf install llvm9.0 llvm9.0-devel llvm9.0-libs llvm9.0-static
case "${ARCH}" in
"ARM")
ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-armv7-deb10-linux.tar.xz
cabal_url=home.smart-cactus.org/~ben/cabal-install-${CABAL_VERSION}-armv7-linux-bootstrapped.tar.xz
;;
"ARM64")
ghc_url=https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-aarch64-deb10-linux.tar.xz
cabal_url=https://downloads.haskell.org/~cabal/cabal-install-${CABAL_VERSION}/cabal-install-${CABAL_VERSION}-aarch64-ubuntu-18.04.tar.xz
;;
*) exit 1 ;;
esac
mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
curl -O "${ghc_url}"
tar -xf ghc-*.tar.*
cd ghc-${GHC_VERSION}
./configure --prefix="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}
make install
for i in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/ghc/${GHC_VERSION}/bin/*-${GHC_VERSION} ; do
ln -s "${i}" "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/${i##*/}
done
for x in "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/*-${GHC_VERSION} ; do
ln -s ${x##*/} ${x%-${GHC_VERSION}}
done
cd ..
rm -rf ghc-${GHC_VERSION} ghc-*.tar.*
unset x i
mkdir cabal-install
cd cabal-install
curl -O "${cabal_url}"
tar -xf cabal-install-*
mv cabal "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/cabal
cd ..
rm -rf cabal-install

View File

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

View File

@@ -0,0 +1,30 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal --store-dir="$(pwd)"/.store "$@"
}
eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always
### build
ecabal update
export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
./bootstrap-haskell
[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]

View File

@@ -16,15 +16,17 @@ git describe
ecabal update ecabal update
if [ "${OS}" = "LINUX" ] ; then if [ "${OS}" = "LINUX" ] ; then
if [ "${BIT}" = "32" ] ; then if [ "${ARCH}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar
else elif [ "${ARCH}" = "64" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
else
ecabal build -w ghc-${GHC_VERSION} -ftui
fi fi
elif [ "${OS}" = "FREEBSD" ] ; then elif [ "${OS}" = "FREEBSD" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib static" -ftui ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib +static" -ftui
else else
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib static" --constraint="lzma static" -ftui ecabal build -w ghc-${GHC_VERSION} --constraint="zlib +static" --constraint="lzma +static" -ftui
fi fi
mkdir out mkdir out

21
.gitlab/script/ghcup_stack.sh Executable file
View File

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

View File

@@ -26,7 +26,7 @@ if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION} -ftui ecabal build -w ghc-${GHC_VERSION} -ftui
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
elif [ "${OS}" = "LINUX" ] ; then elif [ "${OS}" = "LINUX" ] ; then
if [ "${BIT}" = "32" ] ; then if [ "${ARCH}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ghcup-test ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ghcup-test
else else
@@ -80,17 +80,17 @@ ghci-$(ghc --numeric-version) --version
# test installing new ghc doesn't mess with currently set GHC # test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7 # https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "LINUX" ] ; then if [ "${OS}" = "LINUX" ] ; then
eghcup --downloader=wget install 8.4.4 eghcup --downloader=wget install 8.10.3
else # test wget a bit else # test wget a bit
eghcup install 8.4.4 eghcup install 8.10.3
fi fi
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup set 8.4.4 eghcup set 8.10.3
eghcup set 8.4.4 eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.4.4" ] [ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set ${GHC_VERSION} eghcup set ${GHC_VERSION}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup rm 8.4.4 eghcup rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
# install hls # install hls
@@ -98,7 +98,7 @@ if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls eghcup install hls
haskell-language-server-wrapper --version haskell-language-server-wrapper --version
elif [ "${OS}" = "LINUX" ] ; then elif [ "${OS}" = "LINUX" ] ; then
if [ "${BIT}" = "64" ] ; then if [ "${ARCH}" = "64" ] ; then
eghcup install hls eghcup install hls
haskell-language-server-wrapper --version haskell-language-server-wrapper --version
fi fi

View File

@@ -2,23 +2,21 @@
set -ex set -ex
## install ghc via old ghcup
mkdir -p ~/.ghcup/bin mkdir -p ~/.ghcup/bin
curl https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > ~/.ghcup/bin/ghcup curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ~/.ghcup/bin/ghcup
chmod +x ~/.ghcup/bin/ghcup chmod +x ~/.ghcup/bin/ghcup
export PATH="$HOME/.ghcup/bin:$PATH" export PATH="$HOME/.ghcup/bin:$PATH"
ghcup install 8.8.3 ghcup install 8.10.3
ghcup install-cabal 3.2.0.0 ghcup install-cabal 3.4.0.0-rc4
ghcup set 8.8.3 ghcup set 8.10.3
## install ghcup ## install ghcup
cabal update cabal update
cabal build --constraint="zlib static" --constraint="lzma static" -ftui cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" . cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
strip ./ghcup strip ./ghcup
cp ghcup "./${ARTIFACT}" cp ghcup "./${ARTIFACT}"

View File

@@ -1,6 +1,30 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.11 -- ????-??-?? ## 0.1.13 -- ????-??-??
* Fix item selection with unavailable versions wrt [#107](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/107)
* Allow for dynamic post-install, post-remove and pre-compile msgs wrt [MR #68](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/68)
* Alert user if upgraded ghcup is shadowed by old ghcup wrt [#111](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/111)
* Fix to `ghcup` directory creation and placement for the XDG install mode ([MR #49](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/49))
* Do 755 permissions on executables, wrt #97
* Add [NO_COLOR](https://no-color.org/) support wrt [MR #47](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/47)
## 0.1.12 -- 2020-11-21
* Fix disappearing HLS symlinks wrt #91
* improve TUI:
- separators between tools sections
- reverse list order so latest is on top
- expand the blues selected bar
- show new latest versions in bright white
* allow configuration file and setting TUI hotkeys wrt #41
- see https://gitlab.haskell.org/haskell/ghcup-hs#configuration for a more in-depth explanation
* add a `--set` switch to `ghcup install ghc` to automatically set as default after install
* emit warnings when CC/LD is set wrt #82
* add support for version ranges in distro specifiers wrt #84
- e.g. `"(>= 19 && <= 20) || ==0.2.2"` is a valid version key for distro
## 0.1.11 -- 2020-09-23
* Add support for installing haskell-language-server, wrt #65 * Add support for installing haskell-language-server, wrt #65
* When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51 * When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51

View File

@@ -52,8 +52,19 @@ organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
Anything dealing with ghcup specific directories is in Anything dealing with ghcup specific directories is in
`GHCup.Utils.Dirs`. `GHCup.Utils.Dirs`.
Download information on where to fetch bindists from is in Download information on where to fetch bindists from is in the appropriate
`GHCup.Data.GHCupDownloads`. yaml files: `ghcup-<yaml-ver>.yaml`.
## Common Tasks
### Adding a new GHC version
1. open the latest `ghcup-<yaml-ver>.yaml`
2. find the latest ghc version (in yaml tree e.g. `ghcupDownloads -> GHC -> 8.10.3`)
3. copy-paste it
4. adjust the version, tags, changelog, source url
5. adjust the various bindist urls (make sure to also change the yaml anchors)
6. run `cabal run exe:ghcup-gen -- check-tarballs -f ghcup-<yaml-ver>.yaml -u 'ghc-8\.10\.4'`
## Major refactors ## Major refactors

View File

@@ -13,6 +13,7 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
* [Manual install](#manual-install) * [Manual install](#manual-install)
* [Vim integration](#vim-integration) * [Vim integration](#vim-integration)
* [Usage](#usage) * [Usage](#usage)
* [Configuration](#configuration)
* [Manpages](#manpages) * [Manpages](#manpages)
* [Shell-completion](#shell-completion) * [Shell-completion](#shell-completion)
* [Cross support](#cross-support) * [Cross support](#cross-support)
@@ -80,6 +81,13 @@ ghcup upgrade
Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler) of `ghc` is available, which `ghcup` can do. handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler) of `ghc` is available, which `ghcup` can do.
### Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
explaining all possible configurations can be found in this repo: [config.yaml](./config.yaml).
Partial configuration is fine. Command line options always overwrite the config file settings.
### Manpages ### Manpages
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc. For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
@@ -111,9 +119,10 @@ To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIR
Then you can control the locations via XDG environment variables as such: Then you can control the locations via XDG environment variables as such:
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir * `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir (default: `~/.local/share`)
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir * `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir (default: `~/.cache`)
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`) * `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
* `XDG_CONFIG_HOME`: the config file is stored in `ghcup` subdir as `config.yaml` (default: `~/.config`)
### Installing custom bindists ### Installing custom bindists
@@ -163,6 +172,17 @@ In addition this script can also install `cabal-install`.
## Known problems ## Known problems
### Custom ghc version names
When installing ghc bindists with custom version names as outlined in
[installing custom bindists](#installing-custom-bindists), then cabal might
be unable to find the correct `ghc-pkg` (also see [#73](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/73))
if you use `cabal build --with-compiler=ghc-foo`. Instead, point it to the full path, such as:
`cabal build --with-compiler=$HOME/.ghcup/ghc/<version-name>/bin/ghc` or set that GHC version
as the current one via: `ghcup set ghc <version-name>`.
This problem doesn't exist for regularly installed GHC versions.
### Limited distributions supported ### Limited distributions supported
Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported. Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.

View File

@@ -14,6 +14,7 @@ import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Logger import GHCup.Utils.Logger
import Data.Char ( toLower )
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) ) import Data.Semigroup ( (<>) )
#endif #endif
@@ -21,6 +22,7 @@ import Options.Applicative hiding ( style )
import System.Console.Pretty import System.Console.Pretty
import System.Exit import System.Exit
import System.IO ( stdout ) import System.IO ( stdout )
import Text.Regex.Posix
import Validate import Validate
import qualified Data.ByteString as B import qualified Data.ByteString as B
@@ -32,7 +34,7 @@ data Options = Options
} }
data Command = ValidateYAML ValidateYAMLOpts data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts | ValidateTarballs ValidateYAMLOpts TarballFilter
data Input data Input
@@ -63,6 +65,22 @@ data ValidateYAMLOpts = ValidateYAMLOpts
validateYAMLOpts :: Parser ValidateYAMLOpts validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
tarballFilterP :: Parser TarballFilter
tarballFilterP = option readm $
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
<> help "Only check certain tarballs (format: <tool>-<version>)"
where
def = TarballFilter Nothing (makeRegex ("" :: String))
readm = do
s <- str
case span (/= '-') s of
(_, []) -> fail "invalid format, missing '-' after the tool name"
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
TarballFilter <$> pure (Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
_ -> fail "invalid tool"
low = fmap toLower
opts :: Parser Options opts :: Parser Options
opts = Options <$> com opts = Options <$> com
@@ -78,11 +96,9 @@ com = subparser
) )
<> (command <> (command
"check-tarballs" "check-tarballs"
( ValidateTarballs (info
<$> (info ((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
(validateYAMLOpts <**> helper) (progDesc "Validate all tarballs (download and checksum)")
(progDesc "Validate all tarballs (download and checksum)")
)
) )
) )
) )
@@ -100,13 +116,13 @@ main = do
B.getContents >>= valAndExit validate B.getContents >>= valAndExit validate
ValidateYAMLOpts { vInput = Just (FileInput file) } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit validate B.readFile file >>= valAndExit validate
ValidateTarballs vopts -> case vopts of ValidateTarballs vopts tarballFilter -> case vopts of
ValidateYAMLOpts { vInput = Nothing } -> ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit validateTarballs B.getContents >>= valAndExit (validateTarballs tarballFilter)
ValidateYAMLOpts { vInput = Just StdInput } -> ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit validateTarballs B.getContents >>= valAndExit (validateTarballs tarballFilter)
ValidateYAMLOpts { vInput = Just (FileInput file) } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit validateTarballs B.readFile file >>= valAndExit (validateTarballs tarballFilter)
pure () pure ()
where where

View File

@@ -7,6 +7,7 @@ module Validate where
import GHCup import GHCup
import GHCup.Download import GHCup.Download
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
@@ -21,6 +22,7 @@ import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.Trans.Resource ( runResourceT import Control.Monad.Trans.Resource ( runResourceT
, MonadUnliftIO , MonadUnliftIO
) )
import Data.Containers.ListUtils ( nubOrd )
import Data.IORef import Data.IORef
import Data.List import Data.List
import Data.String.Interpolate import Data.String.Interpolate
@@ -30,6 +32,7 @@ import Optics
import System.Exit import System.Exit
import System.IO import System.IO
import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadP
import Text.Regex.Posix
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@@ -64,7 +67,7 @@ validate dls = do
forM_ (M.toList dls) $ \(t, versions) -> forM_ (M.toList dls) $ \(t, versions) ->
forM_ (M.toList versions) $ \(v, vi) -> forM_ (M.toList versions) $ \(v, vi) ->
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v arch (M.keys pspecs) checkHasRequiredPlatforms t v (_viTags vi) arch (M.keys pspecs)
checkGHCVerIsValid checkGHCVerIsValid
forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
@@ -78,17 +81,18 @@ validate dls = do
lift $ $(logInfo) [i|All good|] lift $ $(logInfo) [i|All good|]
pure ExitSuccess pure ExitSuccess
where where
checkHasRequiredPlatforms t v arch pspecs = do checkHasRequiredPlatforms t v tags arch pspecs = do
let v' = prettyVer v let v' = prettyVer v
arch' = prettyArch arch
when (not $ any (== Linux UnknownLinux) pspecs) $ do when (not $ any (== Linux UnknownLinux) pspecs) $ do
lift $ $(logError) lift $ $(logError)
[i|Linux UnknownLinux missing for for #{t} #{v'} #{arch}|] [i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|]
addError addError
when ((not $ any (== Darwin) pspecs) && arch == A_64) $ do when ((not $ any (== Darwin) pspecs) && arch == A_64) $ do
lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch}|] lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch'}|]
addError addError
when ((not $ any (== FreeBSD) pspecs) && arch == A_64) $ lift $ $(logWarn) when ((not $ any (== FreeBSD) pspecs) && arch == A_64) $ lift $ $(logWarn)
[i|FreeBSD missing for #{t} #{v'} #{arch}|] [i|FreeBSD missing for #{t} #{v'} #{arch'}|]
-- alpine needs to be set explicitly, because -- alpine needs to be set explicitly, because
-- we cannot assume that "Linux UnknownLinux" runs on Alpine -- we cannot assume that "Linux UnknownLinux" runs on Alpine
@@ -96,8 +100,11 @@ validate dls = do
when (not $ any (== Linux Alpine) pspecs) $ when (not $ any (== Linux Alpine) pspecs) $
case t of case t of
GHCup -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError GHCup -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
Cabal | v > [vver|2.4.1.0|] -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError Cabal | v > [vver|2.4.1.0|]
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch}|] , arch `elem` [A_64, A_32] -> (lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError
GHC | Latest `elem` tags || Recommended `elem` tags
, arch `elem` [A_64, A_32] -> lift $ $(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
checkUniqueTags tool = do checkUniqueTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool let allTags = join $ M.elems $ availableToolVersions dls tool
@@ -122,6 +129,7 @@ validate dls = do
where where
isUniqueTag Latest = True isUniqueTag Latest = True
isUniqueTag Recommended = True isUniqueTag Recommended = True
isUniqueTag Old = False
isUniqueTag Prerelease = False isUniqueTag Prerelease = False
isUniqueTag (Base _) = False isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False isUniqueTag (UnknownTag _) = False
@@ -156,6 +164,11 @@ validate dls = do
isBase (Base _) = True isBase (Base _) = True
isBase _ = False isBase _ = False
data TarballFilter = TarballFilter
{ tfTool :: Maybe Tool
, tfVersion :: Regex
}
validateTarballs :: ( Monad m validateTarballs :: ( Monad m
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
@@ -163,23 +176,20 @@ validateTarballs :: ( Monad m
, MonadUnliftIO m , MonadUnliftIO m
, MonadMask m , MonadMask m
) )
=> GHCupDownloads => TarballFilter
-> GHCupDownloads
-> m ExitCode -> m ExitCode
validateTarballs dls = do validateTarballs (TarballFilter tool versionRegex) dls = do
ref <- liftIO $ newIORef 0 ref <- liftIO $ newIORef 0
flip runReaderT ref $ do flip runReaderT ref $ do
-- download/verify all binary tarballs -- download/verify all tarballs
let let dlis = nubOrd $ dls ^.. each
dlbis = nub $ join $ (M.elems dls) <&> \versions -> %& indices (maybe (const True) (==) tool) %> each
join $ (M.elems versions) <&> \vi -> %& indices (matchTest versionRegex . T.unpack . prettyVer)
join $ (M.elems $ _viArch vi) <&> \pspecs -> % (viSourceDL % _Just `summing` viArch % each % each % each)
join $ (M.elems pspecs) <&> \pverspecs -> (M.elems pverspecs) when (null dlis) $ $(logError) [i|no tarballs selected by filter|] *> addError
forM_ dlbis $ downloadAll forM_ dlis $ downloadAll
let dlsrc = nub $ join $ (M.elems dls) <&> \versions ->
join $ (M.elems versions) <&> maybe [] (: []) . _viSourceDL
forM_ dlsrc $ downloadAll
-- exit -- exit
e <- liftIO $ readIORef ref e <- liftIO $ readIORef ref
@@ -190,13 +200,13 @@ validateTarballs dls = do
pure ExitSuccess pure ExitSuccess
where where
runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())
}
downloadAll dli = do downloadAll dli = do
dirs <- liftIO getDirs dirs <- liftIO getDirs
let settings = Settings True False Never Curl False dirs let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())
}
r <- r <-
runLogger runLogger

View File

@@ -1,9 +1,11 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module BrickMain where module BrickMain where
@@ -14,12 +16,16 @@ import GHCup.Types
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.Prelude hiding ((!?))
import Brick import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
import Brick.Widgets.Border.Style import Brick.Widgets.Border.Style
import Brick.Widgets.Center import Brick.Widgets.Center
import Brick.Widgets.List import Brick.Widgets.List ( listSelectedFocusedAttr
, listSelectedAttr
, listAttr
)
#if !defined(TAR) #if !defined(TAR)
import Codec.Archive import Codec.Archive
#endif #endif
@@ -31,47 +37,95 @@ import Data.Bool
import Data.Functor import Data.Functor
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Char
import Data.IORef import Data.IORef
import Data.String.Interpolate import Data.String.Interpolate
import Data.Vector ( Vector ) import Data.Vector ( Vector
, (!?)
)
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Environment
import System.Exit import System.Exit
import System.IO.Unsafe import System.IO.Unsafe
import URI.ByteString import URI.ByteString
import qualified GHCup.Types as GT
import qualified Data.Text as T import qualified Data.Text as T
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Data.Vector as V import qualified Data.Vector as V
data AppState = AppState {
lr :: LR data BrickData = BrickData
, dls :: GHCupDownloads { lr :: [ListResult]
, dls :: GHCupDownloads
, pfreq :: PlatformRequest , pfreq :: PlatformRequest
} }
deriving Show
type LR = GenericList String Vector ListResult data BrickSettings = BrickSettings
{ showAll :: Bool
}
deriving Show
data BrickInternalState = BrickInternalState
{ clr :: Vector ListResult
, ix :: Int
}
deriving Show
data BrickState = BrickState
{ appData :: BrickData
, appSettings :: BrickSettings
, appState :: BrickInternalState
, appKeys :: KeyBindings
}
deriving Show
keyHandlers :: [(Char, String, AppState -> EventM n (Next AppState))] keyHandlers :: KeyBindings
keyHandlers = -> [ ( Vty.Key
[ ('q', "Quit" , halt) , BrickSettings -> String
, ('i', "Install" , withIOAction install') , BrickState -> EventM n (Next BrickState)
, ('u', "Uninstall", withIOAction del') )
, ('s', "Set" , withIOAction set') ]
, ('c', "ChangeLog", withIOAction changelog') keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction set')
, (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAll
, (\BrickSettings {..} ->
if showAll then "Hide old versions" else "Show all versions"
)
, hideShowHandler
)
, (bUp, const "Up", \BrickState {..} -> continue (BrickState { appState = (moveCursor 1 appState Up), .. }))
, (bDown, const "Down", \BrickState {..} -> continue (BrickState { appState = (moveCursor 1 appState Down), .. }))
] ]
where
hideShowHandler (BrickState {..}) =
let newAppSettings = appSettings { showAll = not . showAll $ appSettings }
newInternalState = constructList appData newAppSettings (Just appState)
in continue (BrickState appData newAppSettings newInternalState appKeys)
ui :: AppState -> Widget String showKey :: Vty.Key -> String
ui AppState {..} = showKey (Vty.KChar c) = [c]
( padBottom Max showKey (Vty.KUp) = ""
showKey (Vty.KDown) = ""
showKey key = tail (show key)
ui :: AttrMap -> BrickState -> Widget String
ui dimAttrs BrickState { appSettings = as@(BrickSettings {}), ..}
= ( padBottom Max
$ ( withBorderStyle unicode $ ( withBorderStyle unicode
$ borderWithLabel (str "GHCup") $ borderWithLabel (str "GHCup")
$ (center $ (header <=> hBorder <=> renderList renderItem True lr)) $ (center $ (header <=> hBorder <=> renderList' appState))
) )
) )
<=> footer <=> footer
@@ -82,15 +136,15 @@ ui AppState {..} =
. txtWrap . txtWrap
. T.pack . T.pack
. foldr1 (\x y -> x <> " " <> y) . foldr1 (\x y -> x <> " " <> y)
. (++ ["↑↓:Navigation"]) $ (fmap (\(key, s, _) -> (showKey key <> ":" <> s as)) $ keyHandlers appKeys)
$ (fmap (\(c, s, _) -> (c : ':' : s)) keyHandlers)
header = header =
(minHSize 2 $ emptyWidget) (minHSize 2 $ emptyWidget)
<+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool") <+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
<+> (minHSize 15 $ str "Version") <+> (minHSize 15 $ str "Version")
<+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags") <+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
<+> (padLeft (Pad 5) $ str "Notes") <+> (padLeft (Pad 5) $ str "Notes")
renderItem b listResult@(ListResult {..}) = renderList' = withDefAttr listAttr . drawListElements renderItem True
renderItem _ b listResult@(ListResult {..}) =
let marks = if let marks = if
| lSet -> (withAttr "set" $ str "✔✔") | lSet -> (withAttr "set" $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "") | lInstalled -> (withAttr "installed" $ str "")
@@ -98,24 +152,29 @@ ui AppState {..} =
ver = case lCross of ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer) Just c -> T.unpack (c <> "-" <> prettyVer lVer)
dim = if lNoBindist dim
then updateAttrMap (const dimAttributes) . withAttr "no-bindist" | lNoBindist && (not lInstalled)
else id && (not b) -- TODO: overloading dim and active ignores active
active = if b then withAttr "active" else id -- so we hack around it here
in dim = updateAttrMap (const dimAttrs) . withAttr "no-bindist"
| otherwise = id
hooray
| elem Latest lTag && not lInstalled =
withAttr "hooray"
| otherwise = id
active = if b then forceAttr "active" else id
in hooray $ active $ dim
( marks ( marks
<+> (( padLeft (Pad 2) <+> (( padLeft (Pad 2)
$ active
$ minHSize 6 $ minHSize 6
$ (str (fmap toLower . show $ lTool)) $ (printTool lTool)
) )
) )
<+> (minHSize 15 $ active $ (str ver)) <+> (minHSize 15 $ (str ver))
<+> (padLeft (Pad 1) $ minHSize 25 $ if null lTag <+> (let l = catMaybes . fmap printTag $ sort lTag
then emptyWidget in padLeft (Pad 1) $ minHSize 25 $ if null l
else then emptyWidget
foldr1 (\x y -> x <+> str "," <+> y) else foldr1 (\x y -> x <+> str "," <+> y) l
$ (fmap printTag $ sort lTag)
) )
<+> ( padLeft (Pad 5) <+> ( padLeft (Pad 5)
$ let notes = printNotes listResult $ let notes = printNotes listResult
@@ -123,13 +182,20 @@ ui AppState {..} =
then emptyWidget then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) $ notes else foldr1 (\x y -> x <+> str "," <+> y) $ notes
) )
<+> (vLimit 1 $ fill ' ')
) )
printTag Recommended = withAttr "recommended" $ str "recommended" printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
printTag Latest = withAttr "latest" $ str "latest" printTag Latest = Just $ withAttr "latest" $ str "latest"
printTag Prerelease = withAttr "prerelease" $ str "prerelease" printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
printTag (Base pvp'') = str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag (UnknownTag t ) = str t printTag Old = Nothing
printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
printTool GHC = str "GHC"
printTool GHCup = str "GHCup"
printTool HLS = str "HLS"
printNotes ListResult {..} = printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
@@ -137,121 +203,247 @@ ui AppState {..} =
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty) ++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty) ++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
-- | Draws the list elements.
--
-- Evaluates the underlying container up to, and a bit beyond, the
-- selected element. The exact amount depends on available height
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
-- available height.
drawListElements :: (Int -> Bool -> ListResult -> Widget String)
-> Bool
-> BrickInternalState
-> Widget String
drawListElements drawElem foc is@(BrickInternalState clr _) =
Widget Greedy Greedy $
let
es = clr
listSelected = fmap fst $ listSelectedElement' is
drawnElements = flip V.imap es $ \i' e ->
let addSeparator w = case es !? (i' - 1) of
Just e' | lTool e' /= lTool e ->
hBorder <=> w
_ -> w
isSelected = Just i' == listSelected
elemWidget = drawElem i' isSelected e
selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr
makeVisible = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible elemWidget
in render
$ viewport "GHCup" Vertical
$ vBox
$ V.toList drawnElements
minHSize :: Int -> Widget n -> Widget n minHSize :: Int -> Widget n -> Widget n
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ') minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
app :: App AppState e String app :: AttrMap -> AttrMap -> App BrickState e String
app = App { appDraw = \st -> [ui st] app attrs dimAttrs =
, appHandleEvent = eventHandler App { appDraw = \st -> [ui dimAttrs st]
, appStartEvent = return , appHandleEvent = eventHandler
, appAttrMap = const defaultAttributes , appStartEvent = return
, appChooseCursor = neverShowCursor , appAttrMap = const attrs
} , appChooseCursor = neverShowCursor
}
defaultAttributes :: AttrMap defaultAttributes :: Bool -> AttrMap
defaultAttributes = attrMap defaultAttributes no_color = attrMap
Vty.defAttr Vty.defAttr
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue) [ ("active" , Vty.defAttr `withBackColor` Vty.blue)
, ("not-installed", Vty.defAttr `Vty.withForeColor` Vty.red) , ("not-installed", Vty.defAttr `withForeColor` Vty.red)
, ("set" , Vty.defAttr `Vty.withForeColor` Vty.green) , ("set" , Vty.defAttr `withForeColor` Vty.green)
, ("installed" , Vty.defAttr `Vty.withForeColor` Vty.green) , ("installed" , Vty.defAttr `withForeColor` Vty.green)
, ("recommended" , Vty.defAttr `Vty.withForeColor` Vty.green) , ("recommended" , Vty.defAttr `withForeColor` Vty.green)
, ("hls-powered" , Vty.defAttr `Vty.withForeColor` Vty.green) , ("hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, ("latest" , Vty.defAttr `Vty.withForeColor` Vty.yellow) , ("latest" , Vty.defAttr `withForeColor` Vty.yellow)
, ("prerelease" , Vty.defAttr `Vty.withForeColor` Vty.red) , ("prerelease" , Vty.defAttr `withForeColor` Vty.red)
, ("compiled" , Vty.defAttr `Vty.withForeColor` Vty.blue) , ("compiled" , Vty.defAttr `withForeColor` Vty.blue)
, ("stray" , Vty.defAttr `Vty.withForeColor` Vty.blue) , ("stray" , Vty.defAttr `withForeColor` Vty.blue)
, ("help" , Vty.defAttr `Vty.withStyle` Vty.italic) , ("help" , Vty.defAttr `withStyle` Vty.italic)
, ("hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
] ]
where
withForeColor | no_color = const
| otherwise = Vty.withForeColor
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
dimAttributes :: AttrMap withStyle = Vty.withStyle
dimAttributes = attrMap
dimAttributes :: Bool -> AttrMap
dimAttributes no_color = attrMap
(Vty.defAttr `Vty.withStyle` Vty.dim) (Vty.defAttr `Vty.withStyle` Vty.dim)
[ ("active" , Vty.defAttr `Vty.withBackColor` Vty.blue) [ ("active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim) , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
] ]
where
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState)
eventHandler st@(BrickState {..}) ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef settings'
case ev of
(MouseDown _ Vty.BScrollUp _ _) ->
continue (BrickState { appState = moveCursor 1 appState Up, .. })
(MouseDown _ Vty.BScrollDown _ _) ->
continue (BrickState { appState = moveCursor 1 appState Down, .. })
(VtyEvent (Vty.EvResize _ _)) -> continue st
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
continue (BrickState { appState = (moveCursor 1 appState Up), .. })
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
continue (BrickState { appState = (moveCursor 1 appState Down), .. })
(VtyEvent (Vty.EvKey key _)) ->
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
Nothing -> continue st
Just (_, _, handler) -> handler st
_ -> continue st
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState) moveCursor steps ais@(BrickInternalState {..}) direction =
eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st let newIx = if direction == Down then ix + steps else ix - steps
eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st in case clr !? newIx of
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st Just _ -> BrickInternalState { ix = newIx, .. }
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) = Nothing -> ais
continue (AppState (listMoveUp lr) dls pfreq)
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
continue (AppState (listMoveDown lr) dls pfreq)
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
case find (\(c', _, _) -> c' == c) keyHandlers of
Nothing -> continue as
Just (_, _, handler) -> handler as
eventHandler st _ = continue st
-- | Suspend the current UI and run an IO action in terminal. If the -- | 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. -- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a)) withIOAction :: (BrickState -> (Int, ListResult) -> IO (Either String a))
-> AppState -> BrickState
-> EventM n (Next AppState) -> EventM n (Next BrickState)
withIOAction action as = case listSelectedElement (lr as) of withIOAction action as = case listSelectedElement' (appState as) of
Nothing -> continue as Nothing -> continue as
Just (ix, e) -> suspendAndResume $ do Just (ix, e) -> suspendAndResume $ do
action as (ix, e) >>= \case action as (ix, e) >>= \case
Left err -> putStrLn $ ("Error: " <> err) Left err -> putStrLn $ ("Error: " <> err)
Right _ -> putStrLn "Success" Right _ -> putStrLn "Success"
apps <- (fmap . fmap) getAppData Nothing (pfreq . appData $ as) >>= \case
(\AppState {..} -> AppState { lr = listMoveTo ix lr, .. }) Right data' -> do
$ getAppState Nothing (pfreq as)
case apps of
Right nas -> do
putStrLn "Press enter to continue" putStrLn "Press enter to continue"
_ <- getLine _ <- getLine
pure nas pure (updateList data' as)
Left err -> throwIO $ userError err Left err -> throwIO $ userError err
install' :: AppState -> (Int, ListResult) -> IO (Either String ()) -- | Update app data and list internal state based on new evidence.
install' AppState {..} (_, ListResult {..}) = do -- This synchronises @BrickInternalState@ with @BrickData@
-- and @BrickSettings@.
updateList :: BrickData -> BrickState -> BrickState
updateList appD (BrickState {..}) =
let newInternalState = constructList appD appSettings (Just appState)
in BrickState { appState = newInternalState
, appData = appD
, appSettings = appSettings
, appKeys = appKeys
}
constructList :: BrickData
-> BrickSettings
-> Maybe BrickInternalState
-> BrickInternalState
constructList appD appSettings mapp =
replaceLR (filterVisible (showAll appSettings)) (lr appD) mapp
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
listSelectedElement' (BrickInternalState {..}) = fmap (ix, ) $ clr !? ix
selectLatest :: Vector ListResult -> Int
selectLatest v =
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
Just ix -> ix
Nothing -> 0
-- | Replace the @appState@ or construct it based on a filter function
-- and a new @[ListResult]@ evidence.
-- When passed an existing @appState@, tries to keep the selected element.
replaceLR :: (ListResult -> Bool)
-> [ListResult]
-> Maybe BrickInternalState
-> BrickInternalState
replaceLR filterF lr s =
let oldElem = s >>= listSelectedElement'
newVec = V.fromList . filter filterF $ lr
newSelected =
case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
Just ix -> ix
Nothing -> selectLatest newVec
in BrickInternalState newVec newSelected
where
toolEqual e1 e2 =
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
filterVisible :: Bool -> ListResult -> Bool
filterVisible showAll e | lInstalled e = True
| showAll = True
| otherwise = not (elem Old (lTag e))
install' :: BrickState -> (Int, ListResult) -> IO (Either String ())
install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
let runLogger = myLoggerT l let runLogger = myLoggerT l
let let run =
run = runLogger
runLogger . flip runReaderT settings
. flip runReaderT settings . runResourceT
. runResourceT . runE
. runE @'[ AlreadyInstalled
@'[AlreadyInstalled
, UnknownArchive
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
, FileDoesNotExistError , UnknownArchive
, CopyError , FileDoesNotExistError
, NoDownload , CopyError
, NotInstalled , NoDownload
, BuildFailed , NotInstalled
, TagNotFound , BuildFailed
, DigestError , TagNotFound
, DownloadFailed , DigestError
, NoUpdate , DownloadFailed
, TarDirDoesNotExist , NoUpdate
] , TarDirDoesNotExist
, VerNotFound
]
(run $ do (run $ do
case lTool of case lTool of
GHC -> liftE $ installGHCBin dls lVer pfreq GHC -> do
Cabal -> liftE $ installCabalBin dls lVer pfreq vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer GHC dls
GHCup -> liftE $ upgradeGHCup dls Nothing False pfreq $> () ?? VerNotFound lVer GHC
HLS -> liftE $ installHLSBin dls lVer pfreq $> () liftE $ installGHCBin dls lVer pfreq $> vi
Cabal -> do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer Cabal dls
?? VerNotFound lVer Cabal
liftE $ installCabalBin dls lVer pfreq $> vi
GHCup -> do
let vi = fromJust $ snd <$> getLatest dls GHCup
liftE $ upgradeGHCup dls Nothing False pfreq $> vi
HLS -> do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer HLS dls
?? VerNotFound lVer HLS
liftE $ installHLSBin dls lVer pfreq $> vi
) )
>>= \case >>= \case
VRight _ -> pure $ Right () VRight vi -> do
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right () VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V (BuildFailed _ e)) -> VLeft (V (BuildFailed _ e)) ->
pure $ Left [i|Build failed with #{e}|] pure $ Left [i|Build failed with #{e}|]
@@ -262,7 +454,7 @@ install' AppState {..} (_, ListResult {..}) = do
Also check the logs in ~/.ghcup/logs|] Also check the logs in ~/.ghcup/logs|]
set' :: AppState -> (Int, ListResult) -> IO (Either String ()) set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
set' _ (_, ListResult {..}) = do set' _ (_, ListResult {..}) = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
@@ -271,7 +463,7 @@ set' _ (_, ListResult {..}) = do
let run = let run =
runLogger runLogger
. flip runReaderT settings . flip runReaderT settings
. runE @'[FileDoesNotExistError, NotInstalled, TagNotFound] . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
(run $ do (run $ do
case lTool of case lTool of
@@ -285,57 +477,62 @@ set' _ (_, ListResult {..}) = do
VLeft e -> pure $ Left [i|#{e}|] VLeft e -> pure $ Left [i|#{e}|]
del' :: AppState -> (Int, ListResult) -> IO (Either String ()) del' :: BrickState -> (Int, ListResult) -> IO (Either String ())
del' _ (_, ListResult {..}) = do del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
let runLogger = myLoggerT l let runLogger = myLoggerT l
let run = runLogger . flip runReaderT settings . runE @'[NotInstalled] let run = runLogger . flip runReaderT settings . runE @'[NotInstalled, VerNotFound]
(run $ do (run $ do
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo lVer lTool dls
?? VerNotFound lVer lTool
case lTool of case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> () GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> Just vi
Cabal -> liftE $ rmCabalVer lVer $> () Cabal -> liftE $ rmCabalVer lVer $> Just vi
HLS -> liftE $ rmHLSVer lVer $> () HLS -> liftE $ rmHLSVer lVer $> Just vi
GHCup -> pure () GHCup -> pure Nothing
) )
>>= \case >>= \case
VRight (Just vi) -> do
forM_ (_viPostRemove vi) $ \msg ->
runLogger $ $(logInfo) msg
pure $ Right ()
VRight _ -> pure $ Right () VRight _ -> pure $ Right ()
VLeft e -> pure $ Left [i|#{e}|] VLeft e -> pure $ Left [i|#{e}|]
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ()) changelog' :: BrickState -> (Int, ListResult) -> IO (Either String ())
changelog' AppState {..} (_, ListResult {..}) = do changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
case getChangeLog dls lTool (Left lVer) of case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left Nothing -> pure $ Left
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|] [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
Just uri -> do Just uri -> do
let cmd = case _rPlatform pfreq of let cmd = case _rPlatform pfreq of
Darwin -> "open" Darwin -> "open"
Linux _ -> "xdg-open" Linux _ -> "xdg-open"
FreeBSD -> "xdg-open" FreeBSD -> "xdg-open"
exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
Right _ -> pure $ Right () Right _ -> pure $ Right ()
Left e -> pure $ Left [i|#{e}|] Left e -> pure $ Left [i|#{e}|]
uri' :: IORef (Maybe URI) settings' :: IORef AppState
{-# NOINLINE uri' #-}
uri' = unsafePerformIO (newIORef Nothing)
settings' :: IORef Settings
{-# NOINLINE settings' #-} {-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do settings' = unsafePerformIO $ do
dirs <- getDirs dirs <- getDirs
newIORef Settings { cache = True newIORef $ AppState (Settings { cache = True
, noVerify = False , noVerify = False
, keepDirs = Never , keepDirs = Never
, downloader = Curl , downloader = Curl
, verbose = False , verbose = False
, .. , urlSource = GHCupURL
} , ..
})
dirs
defaultKeyBindings
logger' :: IORef LoggerConfig logger' :: IORef LoggerConfig
@@ -348,32 +545,42 @@ logger' = unsafePerformIO
) )
brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO () brickMain :: AppState
brickMain s muri l av pfreq' = do -> LoggerConfig
writeIORef uri' muri -> GHCupDownloads
-> PlatformRequest
-> IO ()
brickMain s l av pfreq' = do
writeIORef settings' s writeIORef settings' s
-- logger interpreter -- logger interpreter
writeIORef logger' l writeIORef logger' l
let runLogger = myLoggerT l let runLogger = myLoggerT l
eApps <- getAppState (Just av) pfreq' no_color <- isJust <$> lookupEnv "NO_COLOR"
case eApps of
Right as -> defaultMain app (selectLatest as) $> () eAppData <- getAppData (Just av) pfreq'
Left e -> do case eAppData of
Right ad ->
defaultMain
(app (defaultAttributes no_color) (dimAttributes no_color))
(BrickState ad
defaultAppSettings
(constructList ad defaultAppSettings Nothing)
(keyBindings s)
)
$> ()
Left e -> do
runLogger ($(logError) [i|Error building app state: #{show e}|]) runLogger ($(logError) [i|Error building app state: #{show e}|])
exitWith $ ExitFailure 2 exitWith $ ExitFailure 2
where
selectLatest :: AppState -> AppState
selectLatest AppState {..} =
(\ix -> AppState { lr = listMoveTo ix lr, .. })
. fromJust
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
$ (listElements lr)
getAppState :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppState) defaultAppSettings :: BrickSettings
getAppState mg pfreq' = do defaultAppSettings = BrickSettings { showAll = False }
muri <- readIORef uri'
getDownloads' :: IO (Either String GHCupDownloads)
getDownloads' = do
settings <- readIORef settings' settings <- readIORef settings'
l <- readIORef logger' l <- readIORef logger'
let runLogger = myLoggerT l let runLogger = myLoggerT l
@@ -381,14 +588,30 @@ getAppState mg pfreq' = do
r <- r <-
runLogger runLogger
. flip runReaderT settings . flip runReaderT settings
. runE . runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
@'[JSONError, DownloadFailed, FileDoesNotExistError] $ fmap _ghcupDownloads
$ do $ liftE
dls <- maybe (fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)) pure mg $ getDownloadsF (urlSource . GT.settings $ settings)
lV <- lift $ listVersions dls Nothing Nothing pfreq'
pure $ (AppState (list "Tool versions" (V.fromList lV) 1) dls pfreq')
case r of case r of
VRight a -> pure $ Right a VRight a -> pure $ Right a
VLeft e -> pure $ Left [i|#{e}|] VLeft e -> pure $ Left [i|#{e}|]
getAppData :: Maybe GHCupDownloads
-> PlatformRequest
-> IO (Either String BrickData)
getAppData mg pfreq' = do
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
r <- maybe getDownloads' (pure . Right) mg
runLogger . flip runReaderT settings $ do
case r of
Right dls -> do
lV <- listVersions dls Nothing Nothing pfreq'
pure $ Right $ (BrickData (reverse lV) dls pfreq')
Left e -> pure $ Left [i|#{e}|]

View File

@@ -32,6 +32,7 @@ import GHCup.Version
#if !defined(TAR) #if !defined(TAR)
import Codec.Archive import Codec.Archive
#endif #endif
import Control.Concurrent
import Control.Exception.Safe import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -59,7 +60,8 @@ import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import Safe import Safe
import System.Console.Pretty import System.Console.Pretty hiding ( color )
import qualified System.Console.Pretty as Pretty
import System.Environment import System.Environment
import System.Exit import System.Exit
import System.IO hiding ( appendFile ) import System.IO hiding ( appendFile )
@@ -81,12 +83,12 @@ import qualified Text.Megaparsec.Char as MPC
data Options = Options data Options = Options
{ {
-- global options -- global options
optVerbose :: Bool optVerbose :: Maybe Bool
, optCache :: Bool , optCache :: Maybe Bool
, optUrlSource :: Maybe URI , optUrlSource :: Maybe URI
, optNoVerify :: Bool , optNoVerify :: Maybe Bool
, optKeepDirs :: KeepDirs , optKeepDirs :: Maybe KeepDirs
, optsDownloader :: Downloader , optsDownloader :: Maybe Downloader
-- commands -- commands
, optCommand :: Command , optCommand :: Command
} }
@@ -122,6 +124,7 @@ data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion { instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest , instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI , instBindist :: Maybe URI
, instSet :: Bool
} }
data SetCommand = SetGHC SetOptions data SetCommand = SetGHC SetOptions
@@ -158,6 +161,7 @@ data GHCCompileOptions = GHCCompileOptions
, patchDir :: Maybe (Path Abs) , patchDir :: Maybe (Path Abs)
, crossTarget :: Maybe Text , crossTarget :: Maybe Text
, addConfArgs :: [Text] , addConfArgs :: [Text]
, setCompile :: Bool
} }
data CabalCompileOptions = CabalCompileOptions data CabalCompileOptions = CabalCompileOptions
@@ -180,13 +184,48 @@ data ChangeLogOptions = ChangeLogOptions
} }
-- https://github.com/pcapriotti/optparse-applicative/issues/148
-- | A switch that can be enabled using --foo and disabled using --no-foo.
--
-- The option modifier is applied to only the option that is *not* enabled
-- by default. For example:
--
-- > invertableSwitch "recursive" True (help "do not recurse into directories")
--
-- This example makes --recursive enabled by default, so
-- the help is shown only for --no-recursive.
invertableSwitch
:: String -- ^ long option
-> Char -- ^ short option for the non-default option
-> Bool -- ^ is switch enabled by default?
-> Mod FlagFields Bool -- ^ option modifier
-> Parser (Maybe Bool)
invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shortopt defv
(if defv then mempty else optmod)
(if defv then optmod else mempty)
-- | Allows providing option modifiers for both --foo and --no-foo.
invertableSwitch'
:: String -- ^ long option (eg "foo")
-> Char -- ^ short option for the non-default option
-> Bool -- ^ is switch enabled by default?
-> Mod FlagFields Bool -- ^ option modifier for --foo
-> Mod FlagFields Bool -- ^ option modifier for --no-foo
-> Parser (Maybe Bool)
invertableSwitch' longopt shortopt defv enmod dismod = optional
( flag' True (enmod <> long longopt <> if defv then mempty else short shortopt)
<|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
)
where
nolongopt = "no-" ++ longopt
opts :: Parser Options opts :: Parser Options
opts = opts =
Options Options
<$> switch (short 'v' <> long "verbose" <> help "Enable verbosity") <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
<*> switch <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
(short 'c' <> long "cache" <> help "Cache downloads in ~/.ghcup/cache"
)
<*> (optional <*> (optional
(option (option
(eitherReader parseUri) (eitherReader parseUri)
@@ -198,35 +237,29 @@ opts =
) )
) )
) )
<*> switch <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
(short 'n' <> long "no-verify" <> help <*> optional (option
"Skip tarball checksum verification"
)
<*> option
(eitherReader keepOnParser) (eitherReader keepOnParser)
( long "keep" ( long "keep"
<> metavar "<always|errors|never>" <> metavar "<always|errors|never>"
<> help <> help
"Keep build directories? (default: errors)" "Keep build directories? (default: errors)"
<> value Errors
<> hidden <> hidden
) ))
<*> option <*> optional (option
(eitherReader downloaderParser) (eitherReader downloaderParser)
( long "downloader" ( long "downloader"
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
<> metavar "<internal|curl|wget>" <> metavar "<internal|curl|wget>"
<> help <> help
"Downloader to use (default: internal)" "Downloader to use (default: internal)"
<> value Internal
#else #else
<> metavar "<curl|wget>" <> metavar "<curl|wget>"
<> help <> help
"Downloader to use (default: curl)" "Downloader to use (default: curl)"
<> value Curl
#endif #endif
<> hidden <> hidden
) ))
<*> com <*> com
where where
parseUri s' = parseUri s' =
@@ -343,20 +376,20 @@ com =
installToolFooter = [s|Discussion: installToolFooter = [s|Discussion:
Installs GHC or cabal. When no command is given, installs GHC Installs GHC or cabal. When no command is given, installs GHC
with the specified version/tag. with the specified version/tag.
It is recommended to always specify a subcommand ('ghc' or 'cabal').|] It is recommended to always specify a subcommand (ghc/cabal/hls).|]
setFooter :: String setFooter :: String
setFooter = [s|Discussion: setFooter = [s|Discussion:
Sets the currently active GHC or cabal version. When no command is given, Sets the currently active GHC or cabal version. When no command is given,
defaults to setting GHC with the specified version/tag (if no tag defaults to setting GHC with the specified version/tag (if no tag
is given, sets GHC to 'recommended' version). is given, sets GHC to 'recommended' version).
It is recommended to always specify a subcommand ('ghc' or 'cabal').|] It is recommended to always specify a subcommand (ghc/cabal/hls).|]
rmFooter :: String rmFooter :: String
rmFooter = [s|Discussion: rmFooter = [s|Discussion:
Remove the given GHC or cabal version. When no command is given, Remove the given GHC or cabal version. When no command is given,
defaults to removing GHC with the specified version. defaults to removing GHC with the specified version.
It is recommended to always specify a subcommand ('ghc' or 'cabal').|] It is recommended to always specify a subcommand (ghc/cabal/hls).|]
changeLogFooter :: String changeLogFooter :: String
changeLogFooter = [s|Discussion: changeLogFooter = [s|Discussion:
@@ -441,7 +474,7 @@ Examples:
installOpts :: Parser InstallOptions installOpts :: Parser InstallOptions
installOpts = installOpts =
(\p (u, v) -> InstallOptions v p u) (\p (u, v) b -> InstallOptions v p u b)
<$> (optional <$> (optional
(option (option
(eitherReader platformParser) (eitherReader platformParser)
@@ -466,6 +499,12 @@ installOpts =
) )
<|> ((,) <$> pure Nothing <*> optional toolVersionArgument) <|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
) )
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
setParser :: Parser (Either SetCommand SetOptions) setParser :: Parser (Either SetCommand SetOptions)
@@ -635,7 +674,7 @@ Examples:
ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts :: Parser GHCCompileOptions
ghcCompileOpts = ghcCompileOpts =
(\CabalCompileOptions {..} crossTarget addConfArgs -> GHCCompileOptions { .. } (\CabalCompileOptions {..} crossTarget addConfArgs setCompile -> GHCCompileOptions { .. }
) )
<$> cabalCompileOpts <$> cabalCompileOpts
<*> (optional <*> (optional
@@ -647,6 +686,12 @@ ghcCompileOpts =
) )
) )
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)")) <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
cabalCompileOpts :: Parser CabalCompileOptions cabalCompileOpts :: Parser CabalCompileOptions
cabalCompileOpts = cabalCompileOpts =
@@ -709,9 +754,9 @@ cabalCompileOpts =
toolVersionParser :: Parser ToolVersion toolVersionParser :: Parser ToolVersion
toolVersionParser = verP <|> toolP toolVersionParser = verP' <|> toolP
where where
verP = ToolVersion <$> versionParser verP' = ToolVersion <$> versionParser
toolP = toolP =
ToolTag ToolTag
<$> (option <$> (option
@@ -839,32 +884,52 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
, MP.chunk "exherbo" $> Exherbo , MP.chunk "exherbo" $> Exherbo
, MP.chunk "unknown" $> UnknownLinux , MP.chunk "unknown" $> UnknownLinux
] ]
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP suffix = do
ver <- parseUntil suffix
if T.null ver
then fail "empty version"
else do
rest <- MP.getInput
MP.setInput ver
v <- versioning'
MP.setInput rest
pure v
bindistParser :: String -> Either String URI bindistParser :: String -> Either String URI
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
toSettings :: Options -> IO Settings toSettings :: Options -> IO AppState
toSettings Options {..} = do toSettings options = do
let cache = optCache
noVerify = optNoVerify
keepDirs = optKeepDirs
downloader = optsDownloader
verbose = optVerbose
dirs <- getDirs dirs <- getDirs
pure $ Settings { .. } userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
VRight r -> pure r
VLeft (V (JSONDecodeError e)) -> do
B.hPut stderr ("Error decoding config file: " <> (E.encodeUtf8 . T.pack . show $ e))
pure defaultUserSettings
_ -> do
die "Unexpected error!"
pure $ mergeConf options dirs userConf
where
mergeConf :: Options -> Dirs -> UserSettings -> AppState
mergeConf (Options {..}) dirs (UserSettings {..}) =
let cache = fromMaybe (fromMaybe False uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
in AppState (Settings {..}) dirs keyBindings
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
#else
defaultDownloader = Curl
#endif
mergeKeys :: UserKeyBindings -> KeyBindings
mergeKeys UserKeyBindings {..} =
let KeyBindings {..} = defaultKeyBindings
in KeyBindings {
bUp = fromMaybe bUp kUp
, bDown = fromMaybe bDown kDown
, bQuit = fromMaybe bQuit kQuit
, bInstall = fromMaybe bInstall kInstall
, bUninstall = fromMaybe bUninstall kUninstall
, bSet = fromMaybe bSet kSet
, bChangelog = fromMaybe bChangelog kChangelog
, bShowAll = fromMaybe bShowAll kShowAll
}
upgradeOptsP :: Parser UpgradeOpts upgradeOptsP :: Parser UpgradeOpts
@@ -931,6 +996,7 @@ main = do
ENV variables: ENV variables:
* TMPDIR: where ghcup does the work (unpacking, building, ...) * TMPDIR: where ghcup does the work (unpacking, building, ...)
* GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME) * GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME)
* GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories
Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|] Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
@@ -940,15 +1006,15 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(footerDoc (Just $ text main_footer)) (footerDoc (Just $ text main_footer))
) )
>>= \opt@Options {..} -> do >>= \opt@Options {..} -> do
settings@Settings{dirs = Dirs{..}, ..} <- toSettings opt appstate@AppState{dirs = Dirs{..}, ..} <- toSettings opt
-- create ~/.ghcup dir -- create ~/.ghcup dir
createDirRecursive' baseDir createDirRecursive' baseDir
-- logger interpreter -- logger interpreter
logfile <- flip runReaderT settings $ initGHCupFileLogging [rel|ghcup.log|] logfile <- flip runReaderT appstate $ initGHCupFileLogging [rel|ghcup.log|]
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = optVerbose { lcPrintDebug = verbose settings
, colorOutter = B.hPut stderr , colorOutter = B.hPut stderr
, rawOutter = appendFile logfile , rawOutter = appendFile logfile
} }
@@ -959,9 +1025,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-- Effect interpreters -- -- Effect interpreters --
------------------------- -------------------------
let runInstTool' settings' = let runInstTool' appstate' =
runLogger runLogger
. flip runReaderT settings' . flip runReaderT appstate'
. runResourceT . runResourceT
. runE . runE
@'[ AlreadyInstalled @'[ AlreadyInstalled
@@ -975,55 +1041,59 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, NotInstalled , NotInstalled
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, VerNotFound
, DigestError , DigestError
, DownloadFailed , DownloadFailed
, TarDirDoesNotExist , TarDirDoesNotExist
] ]
let runInstTool = runInstTool' settings let runInstTool = runInstTool' appstate
let let
runSetGHC = runSetGHC =
runLogger runLogger
. flip runReaderT settings . flip runReaderT appstate
. runE . runE
@'[ FileDoesNotExistError @'[ FileDoesNotExistError
, NotInstalled , NotInstalled
, TagNotFound , TagNotFound
, VerNotFound
] ]
let let
runSetCabal = runSetCabal =
runLogger runLogger
. flip runReaderT settings . flip runReaderT appstate
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, TagNotFound , TagNotFound
, VerNotFound
] ]
let let
runSetHLS = runSetHLS =
runLogger runLogger
. flip runReaderT settings . flip runReaderT appstate
. runE . runE
@'[ NotInstalled @'[ NotInstalled
, TagNotFound , TagNotFound
, VerNotFound
] ]
let runListGHC = runLogger . flip runReaderT settings let runListGHC = runLogger . flip runReaderT appstate
let runRm = let runRm =
runLogger . flip runReaderT settings . runE @'[NotInstalled] runLogger . flip runReaderT appstate . runE @'[NotInstalled, VerNotFound]
let runDebugInfo = let runDebugInfo =
runLogger runLogger
. flip runReaderT settings . flip runReaderT appstate
. runE . runE
@'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] @'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
let runCompileGHC = let runCompileGHC =
runLogger runLogger
. flip runReaderT settings . flip runReaderT appstate
. runResourceT . runResourceT
. runE . runE
@'[ AlreadyInstalled @'[ AlreadyInstalled
@@ -1037,6 +1107,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, NotInstalled , NotInstalled
, VerNotFound
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
@@ -1044,7 +1115,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let runUpgrade = let runUpgrade =
runLogger runLogger
. flip runReaderT settings . flip runReaderT appstate
. runResourceT . runResourceT
. runE . runE
@'[ DigestError @'[ DigestError
@@ -1072,10 +1143,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(GHCupInfo treq dls) <- (GHCupInfo treq dls) <-
( runLogger ( runLogger
. flip runReaderT settings . flip runReaderT appstate
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError] . runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
$ liftE $ liftE
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource) $ getDownloadsF (urlSource settings)
) )
>>= \case >>= \case
VRight r -> pure r VRight r -> pure r
@@ -1086,7 +1157,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
case optCommand of case optCommand of
Upgrade _ _ -> pure () Upgrade _ _ -> pure ()
_ -> runLogger $ flip runReaderT settings $ checkForUpdates dls pfreq _ -> runLogger $ flip runReaderT appstate $ checkForUpdates dls pfreq
@@ -1097,25 +1168,31 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installGHC InstallOptions{..} = let installGHC InstallOptions{..} =
(case instBindist of (case instBindist of
Nothing -> runInstTool $ do Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC (v, vi) <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> runInstTool' settings{noVerify = True} $ do when instSet $ void $ liftE $ setGHC v SetGHCOnly
v <- liftE $ fromVersion dls instVer GHC pure vi
Just uri -> runInstTool' appstate{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBindist liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "") (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v) (_tvVersion v)
(fromMaybe pfreq instPlatform) (fromMaybe pfreq instPlatform)
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
) )
>>= \case >>= \case
VRight _ -> do VRight vi -> do
runLogger $ $(logInfo) ("GHC installation successful") runLogger $ $(logInfo) ("GHC installation successful")
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed, you may want to run 'ghcup rm ghc #{prettyVer v}' first|] [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
pure ExitSuccess pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do VLeft (V (BuildFailed tmpdir e)) -> do
case keepDirs of case keepDirs settings of
Never -> runLogger ($(logError) [i|Build failed with #{e}|]) Never -> runLogger ($(logError) [i|Build failed with #{e}|])
_ -> runLogger ($(logError) [i|Build failed with #{e} _ -> runLogger ($(logError) [i|Build failed with #{e}
Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues. Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
@@ -1138,22 +1215,26 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installCabal InstallOptions{..} = let installCabal InstallOptions{..} =
(case instBindist of (case instBindist of
Nothing -> runInstTool $ do Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal (v, vi) <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> runInstTool' settings{noVerify = True} $ do pure vi
v <- liftE $ fromVersion dls instVer Cabal Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBindist liftE $ installCabalBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
(fromMaybe pfreq instPlatform) (fromMaybe pfreq instPlatform)
pure vi
) )
>>= \case >>= \case
VRight _ -> do VRight vi -> do
runLogger $ $(logInfo) ("Cabal installation successful") runLogger $ $(logInfo) ("Cabal installation successful")
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|Cabal ver #{prettyVer v} already installed, you may want to run 'ghcup rm cabal #{prettyVer v}' first|] [i|Cabal ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal #{prettyVer v}' first|]
pure ExitSuccess pure ExitSuccess
VLeft (V NoDownload) -> do VLeft (V NoDownload) -> do
@@ -1171,22 +1252,26 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installHLS InstallOptions{..} = let installHLS InstallOptions{..} =
(case instBindist of (case instBindist of
Nothing -> runInstTool $ do Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer HLS (v, vi) <- liftE $ fromVersion dls instVer HLS
liftE $ installHLSBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) liftE $ installHLSBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> runInstTool' settings{noVerify = True} $ do pure vi
v <- liftE $ fromVersion dls instVer HLS Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion dls instVer HLS
liftE $ installHLSBindist liftE $ installHLSBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
(fromMaybe pfreq instPlatform) (fromMaybe pfreq instPlatform)
pure vi
) )
>>= \case >>= \case
VRight _ -> do VRight vi -> do
runLogger $ $(logInfo) ("HLS installation successful") runLogger $ $(logInfo) ("HLS installation successful")
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|HLS ver #{prettyVer v} already installed, you may want to run 'ghcup rm hls #{prettyVer v}' first|] [i|HLS ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls #{prettyVer v}' first|]
pure ExitSuccess pure ExitSuccess
VLeft (V NoDownload) -> do VLeft (V NoDownload) -> do
@@ -1204,7 +1289,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let setGHC' SetOptions{..} = let setGHC' SetOptions{..} =
(runSetGHC $ do (runSetGHC $ do
v <- liftE $ fromVersion dls sToolVer GHC v <- liftE $ fst <$> fromVersion dls sToolVer GHC
liftE $ setGHC v SetGHCOnly liftE $ setGHC v SetGHCOnly
) )
>>= \case >>= \case
@@ -1219,7 +1304,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let setCabal' SetOptions{..} = let setCabal' SetOptions{..} =
(runSetCabal $ do (runSetCabal $ do
v <- liftE $ fromVersion dls sToolVer Cabal v <- liftE $ fst <$> fromVersion dls sToolVer Cabal
liftE $ setCabal (_tvVersion v) liftE $ setCabal (_tvVersion v)
) )
>>= \case >>= \case
@@ -1230,7 +1315,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let setHLS' SetOptions{..} = let setHLS' SetOptions{..} =
(runSetHLS $ do (runSetHLS $ do
v <- liftE $ fromVersion dls sToolVer HLS v <- liftE $ fst <$> fromVersion dls sToolVer HLS
liftE $ setHLS (_tvVersion v) liftE $ setHLS (_tvVersion v)
) )
>>= \case >>= \case
@@ -1241,30 +1326,51 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let rmGHC' RmOptions{..} = let rmGHC' RmOptions{..} =
(runRm $ do (runRm $ do
liftE $ rmGHCVer ghcVer liftE $
rmGHCVer ghcVer
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo (_tvVersion ghcVer) GHC dls
?? VerNotFound (_tvVersion ghcVer) GHC
pure vi
) )
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight vi -> do
forM_ (_viPostRemove vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 7 pure $ ExitFailure 7
let rmCabal' tv = let rmCabal' tv =
(runRm $ do (runRm $ do
liftE $ rmCabalVer tv liftE $
rmCabalVer tv
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo tv Cabal dls
?? VerNotFound tv Cabal
pure vi
) )
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight vi -> do
forM_ (_viPostRemove vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 15 pure $ ExitFailure 15
let rmHLS' tv = let rmHLS' tv =
(runRm $ do (runRm $ do
liftE $ rmHLSVer tv liftE $
rmHLSVer tv
vi <- liftE @_ @'[VerNotFound] $ getVersionInfo tv HLS dls
?? VerNotFound tv HLS
pure vi
) )
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight vi -> do
forM_ (_viPostRemove vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft e -> do VLeft e -> do
runLogger ($(logError) [i|#{e}|]) runLogger ($(logError) [i|#{e}|])
pure $ ExitFailure 15 pure $ ExitFailure 15
@@ -1272,7 +1378,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
res <- case optCommand of res <- case optCommand of
#if defined(BRICK) #if defined(BRICK)
Interactive -> liftIO $ brickMain settings optUrlSource loggerConfig dls pfreq >> pure ExitSuccess Interactive -> liftIO $ brickMain appstate loggerConfig dls pfreq >> pure ExitSuccess
#endif #endif
Install (Right iopts) -> do Install (Right iopts) -> do
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|]) runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
@@ -1317,26 +1423,39 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 8 pure $ ExitFailure 8
Compile (CompileGHC GHCCompileOptions {..}) -> Compile (CompileGHC GHCCompileOptions {..}) ->
(runCompileGHC $ liftE $ compileGHC dls (runCompileGHC $ do
(GHCTargetVersion crossTarget targetVer) vi <- liftE @_ @'[VerNotFound] $ getVersionInfo targetVer GHC dls
bootstrapGhc ?? VerNotFound targetVer GHC
jobs forM_ (_viPreCompile vi) $ \msg -> do
buildConfig lift $ $(logInfo) msg
patchDir lift $ $(logInfo)
addConfArgs ("...waiting for 5 seconds, you can still abort...")
pfreq liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
liftE $ compileGHC dls
(GHCTargetVersion crossTarget targetVer)
bootstrapGhc
jobs
buildConfig
patchDir
addConfArgs
pfreq
when setCompile $ void $ liftE $
setGHC (GHCTargetVersion crossTarget targetVer) SetGHCOnly
pure vi
) )
>>= \case >>= \case
VRight _ -> do VRight vi -> do
runLogger $ $(logInfo) runLogger $ $(logInfo)
("GHC successfully compiled and installed") ("GHC successfully compiled and installed")
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ $(logWarn) runLogger $ $(logWarn)
[i|GHC ver #{prettyVer v} already installed, you may want to run 'ghcup rm ghc #{prettyVer v}' first|] [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
pure ExitSuccess pure ExitSuccess
VLeft (V (BuildFailed tmpdir e)) -> do VLeft (V (BuildFailed tmpdir e)) -> do
case keepDirs of case keepDirs settings of
Never -> runLogger ($(logError) [i|Build failed with #{e} Never -> runLogger ($(logError) [i|Build failed with #{e}
Check the logs at #{logsDir}|]) Check the logs at #{logsDir}|])
_ -> runLogger ($(logError) [i|Build failed with #{e} _ -> runLogger ($(logError) [i|Build failed with #{e}
@@ -1359,8 +1478,11 @@ Make sure to clean up #{tmpdir} afterwards.|])
(runUpgrade $ (liftE $ upgradeGHCup dls target force pfreq)) >>= \case (runUpgrade $ (liftE $ upgradeGHCup dls target force pfreq)) >>= \case
VRight v' -> do VRight v' -> do
let pretty_v = prettyVer v' let pretty_v = prettyVer v'
let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo) runLogger $ $(logInfo)
[i|Successfully upgraded GHCup to version #{pretty_v}|] [i|Successfully upgraded GHCup to version #{pretty_v}|]
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft (V NoUpdate) -> do VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) [i|No GHCup update available|] runLogger $ $(logWarn) [i|No GHCup update available|]
@@ -1436,23 +1558,25 @@ fromVersion :: Monad m
=> GHCupDownloads => GHCupDownloads
-> Maybe ToolVersion -> Maybe ToolVersion
-> Tool -> Tool
-> Excepts '[TagNotFound] m GHCTargetVersion -> Excepts '[TagNotFound, VerNotFound] m (GHCTargetVersion, VersionInfo)
fromVersion av Nothing tool = fromVersion av Nothing tool =
mkTVer <$> getRecommended av tool ?? TagNotFound Recommended tool (\(x, y) -> (mkTVer x, y)) <$> getRecommended av tool
fromVersion av (Just (ToolVersion v)) _ = do ?? TagNotFound Recommended tool
fromVersion av (Just (ToolVersion v)) tool = do
vi <- getVersionInfo (_tvVersion v) tool av ?? VerNotFound (_tvVersion v) tool
case pvp $ prettyVer (_tvVersion v) of case pvp $ prettyVer (_tvVersion v) of
Left _ -> pure v Left _ -> pure (v, vi)
Right (PVP (major' :|[minor'])) -> Right (PVP (major' :|[minor'])) ->
case getLatestGHCFor (fromIntegral major') (fromIntegral minor') av of case getLatestGHCFor (fromIntegral major') (fromIntegral minor') av of
Just v' -> pure $ GHCTargetVersion (_tvTarget v) v' Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', vi')
Nothing -> pure v Nothing -> pure (v, vi)
Right _ -> pure v Right _ -> pure (v, vi)
fromVersion av (Just (ToolTag Latest)) tool = fromVersion av (Just (ToolTag Latest)) tool =
mkTVer <$> getLatest av tool ?? TagNotFound Latest tool (\(x, y) -> (mkTVer x, y)) <$> getLatest av tool ?? TagNotFound Latest tool
fromVersion av (Just (ToolTag Recommended)) tool = fromVersion av (Just (ToolTag Recommended)) tool =
mkTVer <$> getRecommended av tool ?? TagNotFound Recommended tool (\(x, y) -> (mkTVer x, y)) <$> getRecommended av tool ?? TagNotFound Recommended tool
fromVersion av (Just (ToolTag (Base pvp''))) GHC = fromVersion av (Just (ToolTag (Base pvp''))) GHC =
mkTVer <$> getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC (\(x, y) -> (mkTVer x, y)) <$> getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion _ (Just (ToolTag t')) tool = fromVersion _ (Just (ToolTag t')) tool =
throwE $ TagNotFound t' tool throwE $ TagNotFound t' tool
@@ -1462,6 +1586,20 @@ printListResult raw lr = do
-- https://gitlab.haskell.org/ghc/ghc/issues/8118 -- https://gitlab.haskell.org/ghc/ghc/issues/8118
setLocaleEncoding utf8 setLocaleEncoding utf8
no_color <- isJust <$> lookupEnv "NO_COLOR"
let
color | raw || no_color = flip const
| otherwise = Pretty.color
let
printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
printTag Old = ""
let let
rows = rows =
(\x -> if raw (\x -> if raw
@@ -1480,16 +1618,16 @@ printListResult raw lr = do
, case lCross of , case lCross of
Nothing -> T.unpack . prettyVer $ lVer Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer) Just c -> T.unpack (c <> "-" <> prettyVer lVer)
, intercalate "," $ (fmap printTag $ sort lTag) , intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag)
, intercalate "," , intercalate ","
$ (if hlsPowered $ (if hlsPowered
then [color' Green "hls-powered"] then [color Green "hls-powered"]
else mempty else mempty
) )
++ (if fromSrc then [color' Blue "compiled"] else mempty) ++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color' Yellow "stray"] else mempty) ++ (if lStray then [color Yellow "stray"] else mempty)
++ (if lNoBindist ++ (if lNoBindist
then [color' Red "no-bindist"] then [color Red "no-bindist"]
else mempty else mempty
) )
] ]
@@ -1502,15 +1640,6 @@ printListResult raw lr = do
forM_ padded $ \row -> putStrLn $ intercalate " " row forM_ padded $ \row -> putStrLn $ intercalate " " row
where where
printTag Recommended = color' Green "recommended"
printTag Latest = color' Yellow "latest"
printTag Prerelease = color' Red "prerelease"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
color' = case raw of
True -> flip const
False -> color
padTo str' x = padTo str' x =
let lstr = strWidth str' let lstr = strWidth str'
@@ -1601,32 +1730,39 @@ printListResult raw lr = do
| otherwise -> 1 | otherwise -> 1
checkForUpdates :: (MonadReader Settings m, MonadCatch m, MonadLogger m, MonadThrow m, MonadIO m, MonadFail m, MonadLogger m) checkForUpdates :: ( MonadReader AppState m
, MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadIO m
, MonadFail m
, MonadLogger m
)
=> GHCupDownloads => GHCupDownloads
-> PlatformRequest -> PlatformRequest
-> m () -> m ()
checkForUpdates dls pfreq = do checkForUpdates dls pfreq = do
forM_ (getLatest dls GHCup) $ \l -> do forM_ (getLatest dls GHCup) $ \(l, _) -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver) when (l > ghc_ver)
$ $(logWarn) $ $(logWarn)
[i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|] [i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
forM_ (getLatest dls GHC) $ \l -> do forM_ (getLatest dls GHC) $ \(l, _) -> do
mghc_ver <- latestInstalled GHC mghc_ver <- latestInstalled GHC
forM mghc_ver $ \ghc_ver -> forM mghc_ver $ \ghc_ver ->
when (l > ghc_ver) when (l > ghc_ver)
$ $(logWarn) $ $(logWarn)
[i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|] [i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
forM_ (getLatest dls Cabal) $ \l -> do forM_ (getLatest dls Cabal) $ \(l, _) -> do
mcabal_ver <- latestInstalled Cabal mcabal_ver <- latestInstalled Cabal
forM mcabal_ver $ \cabal_ver -> forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver) when (l > cabal_ver)
$ $(logWarn) $ $(logWarn)
[i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|] [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
forM_ (getLatest dls HLS) $ \l -> do forM_ (getLatest dls HLS) $ \(l, _) -> do
mcabal_ver <- latestInstalled HLS mcabal_ver <- latestInstalled HLS
forM mcabal_ver $ \cabal_ver -> forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver) when (l > cabal_ver)

View File

@@ -1,5 +1,16 @@
#!/bin/sh #!/bin/sh
# Main settings:
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
# * BOOTSTRAP_HASKELL_GHC_VERSION
# * BOOTSTRAP_HASKELL_CABAL_VERSION
# License: LGPL-3.0
# safety subshell to avoid executing anything in case this script is not downloaded properly # safety subshell to avoid executing anything in case this script is not downloaded properly
( (
@@ -8,7 +19,7 @@
export GHCUP_USE_XDG_DIRS export GHCUP_USE_XDG_DIRS
if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local}/ghcup GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
GHCUP_BIN=${XDG_BIN_HOME:=$HOME/.local/bin} GHCUP_BIN=${XDG_BIN_HOME:=$HOME/.local/bin}
else else
GHCUP_DIR=${GHCUP_INSTALL_BASE_PREFIX}/.ghcup GHCUP_DIR=${GHCUP_INSTALL_BASE_PREFIX}/.ghcup
@@ -23,8 +34,7 @@ die() {
exit 2 exit 2
} }
edo() edo() {
{
"$@" || die "\"$*\" failed!" "$@" || die "\"$*\" failed!"
} }
@@ -59,7 +69,7 @@ _done() {
download_ghcup() { download_ghcup() {
_plat="$(uname -s)" _plat="$(uname -s)"
_arch=$(uname -m) _arch=$(uname -m)
_ghver="0.1.10" _ghver="0.1.12"
_base_url="https://downloads.haskell.org/~ghcup" _base_url="https://downloads.haskell.org/~ghcup"
case "${_plat}" in case "${_plat}" in
@@ -114,6 +124,7 @@ download_ghcup() {
edo chmod +x "${GHCUP_BIN}"/ghcup edo chmod +x "${GHCUP_BIN}"/ghcup
edo mkdir -p "${GHCUP_DIR}"
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file" cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH" export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
EOF EOF
@@ -188,7 +199,30 @@ printf "\\033[0;35m%s\\033[0m\\n" ""
printf "\\033[0;35m%s\\033[0m\\n" "Installation done!" printf "\\033[0;35m%s\\033[0m\\n" "Installation done!"
printf "\\033[0;35m%s\\033[0m\\n" "" printf "\\033[0;35m%s\\033[0m\\n" ""
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
printf "\\033[0;35m%s\\033[0m\\n" "Do you want to install haskell-language-server (HLS) now?"
printf "\\033[0;35m%s\\033[0m\\n" "HLS is a language-server that provides IDE-like functionality"
printf "\\033[0;35m%s\\033[0m\\n" "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
printf "\\033[0;35m%s\\033[0m\\n" "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
printf "\\033[0;35m%s\\033[0m\\n" ""
printf "\\033[0;35m%s\\033[0m\\n" "Answer with YES or NO and press ENTER."
printf "\\033[0;35m%s\\033[0m\\n" ""
while true; do
read -r hls_answer </dev/tty
case $hls_answer in
[Yy]*)
eghcup --cache install hls
break ;;
[Nn]*)
break ;;
*)
echo "Please type YES or NO and press enter.";;
esac
done
echo "In order to run ghc and cabal, you need to adjust your PATH variable." echo "In order to run ghc and cabal, you need to adjust your PATH variable."
echo "You may want to source '$GHCUP_DIR/env' in your shell" echo "You may want to source '$GHCUP_DIR/env' in your shell"
echo "configuration to do so (e.g. ~/.bashrc)." echo "configuration to do so (e.g. ~/.bashrc)."
@@ -238,7 +272,20 @@ if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH" >> "${GHCUP_PROFILE_FILE}" echo "test -f $GHCUP_DIR/env ; and set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH" >> "${GHCUP_PROFILE_FILE}"
fi fi
break ;; break ;;
*) bash)
if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
fi
case "$(uname -s)" in
"Darwin"|"darwin")
if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
fi
;;
esac
break ;;
zsh)
if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then if ! grep -q "ghcup-env" "${GHCUP_PROFILE_FILE}" ; then
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}" echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
fi fi

38
cabal.ghc8103.project Normal file
View File

@@ -0,0 +1,38 @@
with-compiler: ghc-8.10.3
packages: ./ghcup.cabal
optional-packages: ./3rdparty/*/*.cabal
source-repository-package
type: git
location: https://github.com/haskus/packages.git
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdir: haskus-utils-types
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-io
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory
optimization: 2
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell

View File

@@ -0,0 +1,261 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0,
any.HUnit ==1.6.2.0,
any.IfElse ==0.85,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.1,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==1.5.5.1,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only,
any.alex ==3.2.6,
alex +small_base,
any.ansi-terminal ==0.11,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.ascii-string ==1.0.1.4,
any.assoc ==1.0.2,
any.async ==2.2.2,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.4,
attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.14.1.0,
any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2,
any.base-orphans ==0.8.4,
any.base16-bytestring ==1.0.1.0,
any.base64-bytestring ==1.2.0.1,
any.bifunctors ==5.5.10,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1,
any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.7,
c2hs +base3 -regression,
any.call-stack ==0.3.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.1,
cereal -bytestring-builder,
any.chs-cabal ==0.1.1.0,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.clock ==0.8.2,
clock -llvm,
any.cmdargs ==0.10.20,
cmdargs +quotation -testprog,
any.colour ==2.3.5,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.concurrent-output ==1.10.12,
any.conduit ==1.3.4,
any.conduit-extra ==1.3.5,
any.containers ==0.6.2.1,
any.contravariant ==1.5.3,
contravariant +semigroups +statevar +tagged,
any.cryptohash-sha256 ==0.11.102.0,
cryptohash-sha256 -exe +use-cbits,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.0,
any.deepseq ==1.4.4.0,
any.deferred-folds ==0.9.15,
any.directory ==1.3.6.0,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4,
any.fast-logger ==3.0.2,
any.filepath ==1.4.2.1,
any.focus ==1.0.2,
any.foldl ==1.4.10,
any.free ==5.1.6,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.0,
any.ghc-boot-th ==8.10.3,
any.ghc-prim ==0.6.1,
ghcup -internal-downloader -tar -tui,
any.happy ==1.20.0,
any.hashable ==1.3.0.0,
hashable -examples +integer-gmp +sse2 -sse41,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.5,
any.haskus-utils-data ==1.3,
any.haskus-utils-types ==1.5,
any.haskus-utils-variant ==3.0,
any.heaps ==0.3.6.1,
any.hpath ==0.11.0,
any.hpath-directory ==0.14.1,
any.hpath-filepath ==0.10.4,
any.hpath-io ==0.14.1,
any.hpath-posix ==0.13.2,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.8,
any.hspec-core ==2.7.8,
any.hspec-discover ==2.7.8,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.7.0.0,
any.indexed-profunctors ==0.1,
any.indexed-traversable ==0.1.1,
any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.8.3,
language-c -allwarnings +iecfpextension +separatesyb +usebytestrings,
any.libarchive ==3.0.2.1,
libarchive -cross -low-memory -system-libarchive,
any.libyaml ==0.1.2,
libyaml -no-unicode -system-libyaml,
any.lifted-base ==0.2.3.12,
any.list-t ==1.0.4,
any.lockfree-queue ==0.2.3.1,
lzma -static,
any.math-functions ==0.3.4.1,
math-functions +system-erf +system-expm1,
any.megaparsec ==9.0.1,
megaparsec -dev,
any.microlens ==0.4.11.2,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.9,
any.mmorph ==1.1.4,
any.monad-control ==1.0.2.3,
any.monad-logger ==0.3.36,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2,
any.mwc-random ==0.15.0.1,
any.network ==3.1.2.1,
network -devel,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.optics ==0.3,
any.optics-core ==0.3.0.1,
any.optics-extra ==0.3,
any.optics-th ==0.3.0.2,
any.optics-vl ==0.2.1,
any.optparse-applicative ==0.16.1.0,
optparse-applicative +process,
any.os-release ==1.0.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.2.1,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.0.1,
any.primitive-extras ==0.8,
any.primitive-unlifted ==0.1.3.0,
any.process ==1.6.9.0,
any.profunctors ==5.6.1,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.0,
any.recursion-schemes ==5.2.1,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.0,
any.regex-posix ==0.96.0.0,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2,
any.rts ==1.0,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.1,
any.scientific ==0.3.6.2,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.sop-core ==0.5.0.1,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.3,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.2.1,
streaming-commons -use-bytestring-builder,
any.streamly ==0.7.2,
streamly -debug -dev -examples -examples-sdl -fusion-plugin -has-llvm -inspection -no-fusion -streamk,
any.streamly-bytestring ==0.1.2,
any.streamly-posix ==0.1.0.1,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.0.2,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tasty ==1.3.1,
tasty +clock,
any.tasty-hunit ==0.10.0.3,
any.tasty-quickcheck ==0.10.1.2,
any.template-haskell ==2.16.0.0,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4,
any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-short ==0.1.3,
text-short -asserts,
any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1,
any.th-expand-syns ==0.4.6.0,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
any.th-reify-many ==0.1.9,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.5,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances,
any.transformers-compat ==0.6.6,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unbounded-delays ==0.1.1.1,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.13.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.0,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.3,
any.vector ==0.12.2.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.4,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.versions ==4.0.2,
any.vty ==5.32,
any.wcwidth ==0.0.2,
wcwidth -cli +split-base,
any.word8 ==0.1.3,
any.yaml ==0.11.5.0,
yaml +no-examples +no-exe,
zlib -non-blocking-ffi -pkg-config -static
index-state: hackage.haskell.org 2021-02-04T20:08:20Z

47
cabal.ghc884.project Normal file
View File

@@ -0,0 +1,47 @@
-- Generated by stackage-to-hackage
index-state: 2020-10-24T20:53:55Z
with-compiler: ghc-8.8.4
packages:
./
, 3rdparty/lzma/
, 3rdparty/lzma-clib/
, 3rdparty/zlib/
source-repository-package
type: git
location: https://github.com/haskus/packages.git
tag: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdir: haskus-utils-types
source-repository-package
type: git
location: https://github.com/hasufell/hpath.git
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory
hpath-io
source-repository-package
type: git
location: https://github.com/hasufell/text-conversions.git
tag: 9abf0e5e5664a3178367597c32db19880477a53c
allow-older: *
allow-newer: *
package lzma
ghc-options: -O2
package lzma-clib
ghc-options: -O2
package zlib
ghc-options: -O2
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

2521
cabal.ghc884.project.freeze Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -20,11 +20,10 @@ source-repository-package
tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2 tag: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdir: hpath-directory subdir: hpath-directory
-- https://github.com/cjdev/text-conversions/pull/10
source-repository-package source-repository-package
type: git type: git
location: https://github.com/hasufell/text-conversions.git location: https://github.com/hasufell/streamly.git
tag: 9abf0e5e5664a3178367597c32db19880477a53c tag: f921e78236c6b44a6673b5e1a1803d2e7102d806
optimization: 2 optimization: 2

61
config.yaml Normal file
View File

@@ -0,0 +1,61 @@
# Cache downloads in ~/.ghcup/cache
cache: False
# Skip tarball checksum verification
no-verify: False
# enable verbosity
verbose: False
# When to keep build directories
keep-dirs: Errors # Always | Never | Errors
# Which downloader to use
downloader: Curl # Curl | Wget | Internal
# TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values.
key-bindings:
up:
KUp: []
down:
KDown: []
quit:
KChar: 'q'
install:
KChar: 'i'
uninstall:
KChar: 'u'
set:
KChar: 's'
changelog:
KChar: 'c'
show-all:
KChar: 'a'
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
url-source:
## Use the internal download uri, this is the default
GHCupURL: []
## Example 1: Read download info from this location instead
## Accepts file/http/https scheme
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
# AddSource:
# Left:
# toolRequirements: {} # this is ignored
# ghcupDownloads:
# GHC:
# 9.10.2:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
# dlSubdir: ghc-7.10.3
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
# AddSource:
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

View File

@@ -1117,7 +1117,6 @@ ghcupDownloads:
unknown_versioning: *ghc-8101-32-deb9 unknown_versioning: *ghc-8101-32-deb9
8.10.2: 8.10.2:
viTags: viTags:
- Latest
- base-4.14.1.0 - base-4.14.1.0
viChangeLog: https://downloads.haskell.org/~ghc/8.10.2/docs/html/users_guide/8.10.2-notes.html viChangeLog: https://downloads.haskell.org/~ghc/8.10.2/docs/html/users_guide/8.10.2-notes.html
viSourceDL: viSourceDL:
@@ -1193,6 +1192,79 @@ ghcupDownloads:
dlUri: https://files.hasufell.de/ghc/ghc-8.10.2-i386-alpine-linux.tar.xz dlUri: https://files.hasufell.de/ghc/ghc-8.10.2-i386-alpine-linux.tar.xz
dlSubdir: ghc-8.10.2 dlSubdir: ghc-8.10.2
dlHash: 9ee1cf1e85e9536088b3c9e80e975074e525ea378cd4eb156071bbc4b7b38327 dlHash: 9ee1cf1e85e9536088b3c9e80e975074e525ea378cd4eb156071bbc4b7b38327
8.10.3:
viTags:
- Latest
- base-4.14.1.0
viChangeLog: https://downloads.haskell.org/~ghc/8.10.3/docs/html/users_guide/8.10.3-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-src.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 9c573a4621a78723950617c223559bdc325ea6a3409264aedf68f05510b0880b
viArch:
A_64:
Linux_Debian:
'9': &ghc-8103-64-deb9
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-deb9-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 95e4aadea30701fe5ab84d15f757926d843ded7115e11c4cd827809ca830718d
'10': &ghc-8103-64-deb10
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-deb10-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: c8f3d9f0e61a89eaba1d3ad8fb2eced1af0e81576811261b887993bee12538ac
unknown_versioning: *ghc-8103-64-deb9
Linux_Ubuntu:
unknown_versioning: &ghc-8103-64-fedora
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-fedora27-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: f8739b12008712d6b6a9ffc6c39f9d05af77ef3bcb932c9aff20fa0893c8c159
'16.04': *ghc-8103-64-deb9
'18.04': *ghc-8103-64-deb9
Linux_Mint:
unknown_versioning: *ghc-8103-64-deb10
Linux_Fedora:
'27': *ghc-8103-64-fedora
unknown_versioning: *ghc-8103-64-fedora
Linux_CentOS:
'7': &ghc-8103-64-centos
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-centos7-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: f562ca61979ff1d21e34e69e59028cb742a8eff8d84e46bbd3a750f2ac7d8ed1
unknown_versioning: *ghc-8103-64-centos
Linux_RedHat:
unknown_versioning: *ghc-8103-64-centos
Linux_Alpine:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-alpine3.10-linux-integer-simple.tar.xz
dlSubdir: ghc-8.10.3-x86_64-unknown-linux
dlHash: 8506c478ebbfb5441c3c36c07c36fc8532cacb2b3e13c6733bd44cb17b3ce96c
Linux_AmazonLinux:
unknown_versioning: *ghc-8103-64-centos
Linux_UnknownLinux:
unknown_versioning: *ghc-8103-64-fedora
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-apple-darwin.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 2635f35d76e44e69afdfd37cae89d211975cc20f71f784363b72003e59f22015
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-portbld-freebsd.tar.xz
dlSubdir: ghc-8.10.3
dlHash: 749007e995104db05cf6e3ad5bc36238cab8afac8055145661e5730e8f8af040
A_32:
Linux_Debian:
'9': &ghc-8103-32-deb9
dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-i386-deb9-linux.tar.xz
dlSubdir: ghc-8.10.3
dlHash: f0addd2a16b705f58ff9e8702c3ddf3e2d6bd0d3555707b5b5095e51bafee7b1
unknown_versioning: *ghc-8103-32-deb9
Linux_Ubuntu:
unknown_versioning: *ghc-8103-32-deb9
Linux_Mint:
unknown_versioning: *ghc-8103-32-deb9
Linux_UnknownLinux:
unknown_versioning: *ghc-8103-32-deb9
Cabal: Cabal:
2.4.1.0: 2.4.1.0:
viTags: [] viTags: []
@@ -1287,32 +1359,32 @@ ghcupDownloads:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz
dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93 dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93
3.4.0.0-rc3: 3.4.0.0-rc4:
viTags: viTags:
- Prerelease - Prerelease
viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md
viArch: viArch:
A_64: A_64:
Linux_Ubuntu: Linux_Ubuntu:
unknown_versioning: &cabal-3400rc3-ubuntu unknown_versioning: &cabal-3400rc4-ubuntu
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz
dlHash: a97f0362b8cdc78ba4a7891f8b288082dc11e20c64b1b3c8e6c2bd3766446d10 dlHash: a1be168876816a624b206c55596d9bb5f442541c889ee2438d664698122b9ffe
Linux_Alpine: Linux_Alpine:
unknown_versioning: unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-alpine-3.11.6-static-noofd.tar.xz dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-alpine-3.11.6-static-noofd.tar.xz
dlHash: a82c7dc7e46da823f6a982465b9b29e0640a5ce2e5b573d3dd55a47e20740305 dlHash: 49dab6684483594e4c7c3e561ec477268002605253ad34701b471277efbe91bc
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: *cabal-3400rc3-ubuntu unknown_versioning: *cabal-3400rc4-ubuntu
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-darwin-sierra.tar.xz dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-darwin-sierra.tar.xz
dlHash: 4553eaea3031c09ab5156af8d4a62bf1ecbbea2c3b57a876f267cbf4b5a15658 dlHash: a3f809a3388e90b9fdf52444e30ea9aad3894e2cbe53c37fc3311ceb106eda9e
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc3/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
dlHash: 44e25e0b0d15361acb369f4bf2206a39d2432a08fb922cc40a9b8a045d0a3a6f dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
GHCup: GHCup:
0.1.10: 0.1.11:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -1322,39 +1394,22 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-linux-ghcup-0.1.10 dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-linux-ghcup-0.1.11
dlHash: 87661bd127f857b990174ac8d96ad4bd629865306b2058c8cc64d3b36ed317c9 dlHash: 99d97c9a1dce76892001e5cffd50cc23bf804f2282998c546d1b965aa2179699
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-apple-darwin-ghcup-0.1.10 dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-apple-darwin-ghcup-0.1.11
dlHash: e71666fde6a7700f307e1a55720859d3a042fe27c68ff32f3d1181f4436b7391 dlHash: 4b91dcd9bfdc40534156b8fadea3f317b3c44af1255169895f4911a221f819c6
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/x86_64-portbld-freebsd-ghcup-0.1.10 dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-portbld-freebsd-ghcup-0.1.11
dlHash: b5ef1b0454f1a9c5a62b378c1e9c48c2b794d64a22086adf482b064dfb34e68d dlHash: 6f04ce98d3f3eb9299ce74f8264aa956f0dc38a64a3bd12ee048b7f146e9e1b4
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.10/i386-linux-ghcup-0.1.10 dlUri: https://downloads.haskell.org/~ghcup/0.1.11/i386-linux-ghcup-0.1.11
dlHash: 50ac43199b64bc0724400b0a3db674bef3ec53cf6d41acc04a2c4ca8557e534f dlHash: ec339e4c2b8b4d502f66a03c0d3f112cb68cd922dd3c4a6f66323628cf6a76c2
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32
HLS:
0.4.0:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#040
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.4.0/haskell-language-server-Linux-0.4.0.tar.gz
dlHash: 325b21b38a5e570f00b983885e8ec1eadcb5504a29b28ea4cbe1b85b32058f6d
Darwin:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.4.0/haskell-language-server-macOS-0.4.0.tar.gz
dlHash: 06a23f1495086438e9676213f7aeddbbc382014ad8016ed7c8ad241a2a15fcfe

1500
ghcup-0.0.3.yaml Normal file

File diff suppressed because it is too large Load Diff

1720
ghcup-0.0.4.yaml Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.11 version: 0.1.12
synopsis: ghc toolchain installer as an exe/library synopsis: ghc toolchain installer as an exe/library
description: description:
A rewrite of the shell script ghcup, for providing A rewrite of the shell script ghcup, for providing
@@ -15,7 +15,7 @@ maintainer: hasufell@posteo.de
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
category: System category: System
build-type: Simple build-type: Simple
extra-source-files: CHANGELOG.md extra-doc-files: CHANGELOG.md
source-repository head source-repository head
type: git type: git
@@ -72,6 +72,9 @@ common bz2
common case-insensitive common case-insensitive
build-depends: case-insensitive >=1.2.1.0 build-depends: case-insensitive >=1.2.1.0
common casing
build-depends: casing >=0.1.4.1
common concurrent-output common concurrent-output
build-depends: concurrent-output >=1.10.11 build-depends: concurrent-output >=1.10.11
@@ -226,7 +229,7 @@ common vector
build-depends: vector >=0.12 build-depends: vector >=0.12
common versions common versions
build-depends: versions >=3.5 build-depends: versions >=4.0.1
common vty common vty
build-depends: vty >=5.28.2 build-depends: vty >=5.28.2
@@ -266,6 +269,7 @@ library
, bytestring , bytestring
, bz2 , bz2
, case-insensitive , case-insensitive
, casing
, concurrent-output , concurrent-output
, containers , containers
, cryptohash-sha256 , cryptohash-sha256
@@ -307,6 +311,7 @@ library
, utf8-string , utf8-string
, vector , vector
, versions , versions
, vty
, word8 , word8
, yaml , yaml
, zlib , zlib
@@ -426,6 +431,7 @@ executable ghcup-gen
, optics , optics
, optparse-applicative , optparse-applicative
, pretty-terminal , pretty-terminal
, regex-posix
, resourcet , resourcet
, safe-exceptions , safe-exceptions
, string-interpolate , string-interpolate

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,19 @@
cradle: cradle:
cabal: cabal:
- path: "." - path: "./lib"
component: "ghcup:lib:ghcup" component: "lib:ghcup"
- path: "."
- path: "./app/ghcup/Main.hs"
component: "ghcup:exe:ghcup" component: "ghcup:exe:ghcup"
- path: "./app/ghcup/BrickMain.hs"
component: "ghcup:exe:ghcup"
- path: "./app/ghcup-gen/Main.hs"
component: "ghcup:exe:ghcup-gen"
- path: "./app/ghcup-gen/Validate.hs"
component: "ghcup:exe:ghcup-gen"
- path: "./test"
component: "ghcup:test:ghcup-test"

View File

@@ -74,7 +74,7 @@ import Prelude hiding ( abs
) )
import Safe hiding ( at ) import Safe hiding ( at )
import System.IO.Error import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment ) import System.Posix.Env.ByteString ( getEnvironment, getEnv )
import System.Posix.FilePath ( getSearchPath, takeExtension ) import System.Posix.FilePath ( getSearchPath, takeExtension )
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import Text.Regex.Posix import Text.Regex.Posix
@@ -99,7 +99,7 @@ import qualified Data.Text.Encoding as E
installGHCBindist :: ( MonadFail m installGHCBindist :: ( MonadFail m
, MonadMask m , MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -134,15 +134,28 @@ installGHCBindist dlinfo ver pfreq = do
-- prepare paths -- prepare paths
ghcdir <- lift $ ghcupGHCDir tver ghcdir <- lift $ ghcupGHCDir tver
toolchainSanityChecks
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver pfreq liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver pfreq
liftE $ postGHCInstall tver liftE $ postGHCInstall tver
where
toolchainSanityChecks = do
r <- forM ["CC", "LD"] (liftIO . getEnv)
case catMaybes r of
[] -> pure ()
_ -> do
lift $ $(logWarn) "CC/LD environment variable is set. This will change the compiler/linker"
lift $ $(logWarn) "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall."
-- | Install a packed GHC distribution. This only deals with unpacking and the GHC -- | Install a packed GHC distribution. This only deals with unpacking and the GHC
-- build system and nothing else. -- build system and nothing else.
installPackedGHC :: ( MonadMask m installPackedGHC :: ( MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
@@ -178,7 +191,7 @@ installPackedGHC dl msubdir inst ver pfreq@(PlatformRequest {..}) = do
-- | Install an unpacked GHC distribution. This only deals with the GHC -- | Install an unpacked GHC distribution. This only deals with the GHC
-- build system and nothing else. -- build system and nothing else.
installUnpackedGHC :: ( MonadReader Settings m installUnpackedGHC :: ( MonadReader AppState m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
@@ -214,7 +227,7 @@ installUnpackedGHC path inst ver (PlatformRequest {..}) = do
installGHCBin :: ( MonadFail m installGHCBin :: ( MonadFail m
, MonadMask m , MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -246,7 +259,7 @@ installGHCBin bDls ver pfreq = do
-- argument instead of looking it up from 'GHCupDownloads'. -- argument instead of looking it up from 'GHCupDownloads'.
installCabalBindist :: ( MonadMask m installCabalBindist :: ( MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -273,7 +286,7 @@ installCabalBindist :: ( MonadMask m
installCabalBindist dlinfo ver (PlatformRequest {..}) = do installCabalBindist dlinfo ver (PlatformRequest {..}) = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
whenM whenM
(lift (cabalInstalled ver) >>= \a -> liftIO $ (lift (cabalInstalled ver) >>= \a -> liftIO $
@@ -320,7 +333,7 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do
(path </> cabalFile) (path </> cabalFile)
(destPath) (destPath)
Overwrite Overwrite
lift $ chmod_777 destPath lift $ chmod_755 destPath
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and -- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
@@ -328,7 +341,7 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do
-- the latest installed version. -- the latest installed version.
installCabalBin :: ( MonadMask m installCabalBin :: ( MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -361,7 +374,7 @@ installCabalBin bDls ver pfreq = do
-- argument instead of looking it up from 'GHCupDownloads'. -- argument instead of looking it up from 'GHCupDownloads'.
installHLSBindist :: ( MonadMask m installHLSBindist :: ( MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -388,7 +401,7 @@ installHLSBindist :: ( MonadMask m
installHLSBindist dlinfo ver (PlatformRequest {..}) = do installHLSBindist dlinfo ver (PlatformRequest {..}) = do
lift $ $(logDebug) [i|Requested to install hls version #{ver}|] lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
whenM (lift (hlsInstalled ver)) whenM (lift (hlsInstalled ver))
$ (throwE $ AlreadyInstalled HLS ver) $ (throwE $ AlreadyInstalled HLS ver)
@@ -436,7 +449,7 @@ installHLSBindist dlinfo ver (PlatformRequest {..}) = do
(path </> f) (path </> f)
(inst </> toF) (inst </> toF)
Overwrite Overwrite
lift $ chmod_777 (inst </> toF) lift $ chmod_755 (inst </> toF)
-- install haskell-language-server-wrapper -- install haskell-language-server-wrapper
let wrapper = [rel|haskell-language-server-wrapper|] let wrapper = [rel|haskell-language-server-wrapper|]
@@ -445,14 +458,14 @@ installHLSBindist dlinfo ver (PlatformRequest {..}) = do
(path </> wrapper) (path </> wrapper)
(inst </> toF) (inst </> toF)
Overwrite Overwrite
lift $ chmod_777 (inst </> toF) lift $ chmod_755 (inst </> toF)
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@ -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m installHLSBin :: ( MonadMask m
, MonadCatch m , MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadResource m , MonadResource m
, MonadIO m , MonadIO m
@@ -498,7 +511,7 @@ installHLSBin bDls ver pfreq = do
-- --
-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@ -- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@
-- for 'SetGHCOnly' constructor. -- for 'SetGHCOnly' constructor.
setGHC :: ( MonadReader Settings m setGHC :: ( MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
@@ -515,15 +528,15 @@ setGHC ver sghc = do
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))) whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
-- symlink destination -- symlink destination
Settings { dirs = Dirs {..} } <- lift ask AppState { dirs = Dirs {..} } <- lift ask
liftIO $ createDirRecursive' binDir liftIO $ createDirRecursive' binDir
-- first delete the old symlinks (this fixes compatibility issues -- first delete the old symlinks (this fixes compatibility issues
-- with old ghcup) -- with old ghcup)
case sghc of case sghc of
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver) SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
SetGHC_XY -> lift $ rmMajorSymlinks ver SetGHC_XY -> liftE $ rmMajorSymlinks ver
SetGHC_XYZ -> lift $ rmMinorSymlinks ver SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
-- for ghc tools (ghc, ghci, haddock, ...) -- for ghc tools (ghc, ghci, haddock, ...)
verfiles <- ghcToolFiles ver verfiles <- ghcToolFiles ver
@@ -556,12 +569,12 @@ setGHC ver sghc = do
where where
symlinkShareDir :: (MonadReader Settings m, MonadIO m, MonadLogger m) symlinkShareDir :: (MonadReader AppState m, MonadIO m, MonadLogger m)
=> Path Abs => Path Abs
-> ByteString -> ByteString
-> m () -> m ()
symlinkShareDir ghcdir verBS = do symlinkShareDir ghcdir verBS = do
Settings { dirs = Dirs {..} } <- ask AppState { dirs = Dirs {..} } <- ask
let destdir = baseDir let destdir = baseDir
case sghc of case sghc of
SetGHCOnly -> do SetGHCOnly -> do
@@ -579,7 +592,7 @@ setGHC ver sghc = do
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink. -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
setCabal :: (MonadReader Settings m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) setCabal :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version => Version
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
setCabal ver = do setCabal ver = do
@@ -587,7 +600,7 @@ setCabal ver = do
targetFile <- parseRel ("cabal-" <> verBS) targetFile <- parseRel ("cabal-" <> verBS)
-- symlink destination -- symlink destination
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
liftIO $ createDirRecursive' binDir liftIO $ createDirRecursive' binDir
whenM (liftIO $ fmap not $ doesFileExist (binDir </> targetFile)) whenM (liftIO $ fmap not $ doesFileExist (binDir </> targetFile))
@@ -613,7 +626,7 @@ setCabal ver = do
-- | Set the haskell-language-server symlinks. -- | Set the haskell-language-server symlinks.
setHLS :: ( MonadCatch m setHLS :: ( MonadCatch m
, MonadReader Settings m , MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
@@ -622,7 +635,7 @@ setHLS :: ( MonadCatch m
=> Version => Version
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
setHLS ver = do setHLS ver = do
Settings { dirs = Dirs {..} } <- lift ask AppState { dirs = Dirs {..} } <- lift ask
liftIO $ createDirRecursive' binDir liftIO $ createDirRecursive' binDir
-- Delete old symlinks, since these might have different ghc versions than the -- Delete old symlinks, since these might have different ghc versions than the
@@ -703,7 +716,7 @@ listVersions :: ( MonadCatch m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
, MonadReader Settings m , MonadReader AppState m
) )
=> GHCupDownloads => GHCupDownloads
-> Maybe Tool -> Maybe Tool
@@ -736,7 +749,7 @@ listVersions av lt criteria pfreq = do
pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers) pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers)
where where
strayGHCs :: (MonadCatch m, MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m) strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag] => Map.Map Version [Tag]
-> m [ListResult] -> m [ListResult]
strayGHCs avTools = do strayGHCs avTools = do
@@ -778,7 +791,7 @@ listVersions av lt criteria pfreq = do
[i|Could not parse version of stray directory #{toFilePath e}|] [i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing pure Nothing
strayCabals :: (MonadReader Settings m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m) strayCabals :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag] => Map.Map Version [Tag]
-> m [ListResult] -> m [ListResult]
strayCabals avTools = do strayCabals avTools = do
@@ -806,7 +819,7 @@ listVersions av lt criteria pfreq = do
[i|Could not parse version of stray directory #{toFilePath e}|] [i|Could not parse version of stray directory #{toFilePath e}|]
pure Nothing pure Nothing
strayHLS :: (MonadReader Settings m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m) strayHLS :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag] => Map.Map Version [Tag]
-> m [ListResult] -> m [ListResult]
strayHLS avTools = do strayHLS avTools = do
@@ -835,7 +848,7 @@ listVersions av lt criteria pfreq = do
pure Nothing pure Nothing
-- NOTE: this are not cross ones, because no bindists -- NOTE: this are not cross ones, because no bindists
toListResult :: (MonadReader Settings m, MonadIO m, MonadCatch m) => Tool -> (Version, [Tag]) -> m ListResult toListResult :: (MonadReader AppState m, MonadIO m, MonadCatch m) => Tool -> (Version, [Tag]) -> m ListResult
toListResult t (v, tags) = case t of toListResult t (v, tags) = case t of
GHC -> do GHC -> do
let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av
@@ -904,7 +917,7 @@ listVersions av lt criteria pfreq = do
-- This may leave GHCup without a "set" version. -- This may leave GHCup without a "set" version.
-- Will try to fix the ghc-x.y symlink after removal (e.g. to an -- Will try to fix the ghc-x.y symlink after removal (e.g. to an
-- older version). -- older version).
rmGHCVer :: ( MonadReader Settings m rmGHCVer :: ( MonadReader AppState m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
@@ -924,16 +937,17 @@ rmGHCVer ver = do
lift $ $(logInfo) [i|Removing ghc symlinks|] lift $ $(logInfo) [i|Removing ghc symlinks|]
liftE $ rmPlain (_tvTarget ver) liftE $ rmPlain (_tvTarget ver)
lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
liftIO $ deleteDirRecursive dir
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|] lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
lift $ rmMinorSymlinks ver liftE $ rmMinorSymlinks ver
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|] lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
-- first remove -- first remove
handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
-- then fix them (e.g. with an earlier version) -- then fix them (e.g. with an earlier version)
lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
liftIO $ deleteDirRecursive dir
v' <- v' <-
handle handle
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
@@ -942,7 +956,7 @@ rmGHCVer ver = do
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver)) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
Settings { dirs = Dirs {..} } <- lift ask AppState { dirs = Dirs {..} } <- lift ask
liftIO liftIO
$ hideError doesNotExistErrorType $ hideError doesNotExistErrorType
@@ -952,7 +966,7 @@ rmGHCVer ver = do
-- | Delete a cabal version. Will try to fix the @cabal@ symlink -- | Delete a cabal version. Will try to fix the @cabal@ symlink
-- after removal (e.g. setting it to an older version). -- after removal (e.g. setting it to an older version).
rmCabalVer :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m) rmCabalVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
=> Version => Version
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmCabalVer ver = do rmCabalVer ver = do
@@ -960,7 +974,7 @@ rmCabalVer ver = do
cSet <- lift $ cabalSet cSet <- lift $ cabalSet
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
cabalFile <- lift $ parseRel ("cabal-" <> verToBS ver) cabalFile <- lift $ parseRel ("cabal-" <> verToBS ver)
liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir </> cabalFile) liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir </> cabalFile)
@@ -975,7 +989,7 @@ rmCabalVer ver = do
-- | Delete a hls version. Will try to fix the hls symlinks -- | Delete a hls version. Will try to fix the hls symlinks
-- after removal (e.g. setting it to an older version). -- after removal (e.g. setting it to an older version).
rmHLSVer :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m) rmHLSVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m)
=> Version => Version
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmHLSVer ver = do rmHLSVer ver = do
@@ -983,7 +997,7 @@ rmHLSVer ver = do
isHlsSet <- lift $ hlsSet isHlsSet <- lift $ hlsSet
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
bins <- lift $ hlsAllBinaries ver bins <- lift $ hlsAllBinaries ver
forM_ bins $ \f -> liftIO $ deleteFile (binDir </> f) forM_ bins $ \f -> liftIO $ deleteFile (binDir </> f)
@@ -1008,13 +1022,13 @@ rmHLSVer ver = do
------------------ ------------------
getDebugInfo :: (MonadReader Settings m, MonadLogger m, MonadCatch m, MonadIO m) getDebugInfo :: (MonadReader AppState m, MonadLogger m, MonadCatch m, MonadIO m)
=> Excepts => Excepts
'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
m m
DebugInfo DebugInfo
getDebugInfo = do getDebugInfo = do
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
let diBaseDir = baseDir let diBaseDir = baseDir
let diBinDir = binDir let diBinDir = binDir
diGHCDir <- lift ghcupGHCBaseDir diGHCDir <- lift ghcupGHCBaseDir
@@ -1034,7 +1048,7 @@ getDebugInfo = do
-- | Compile a GHC from source. This behaves wrt symlinks and installation -- | Compile a GHC from source. This behaves wrt symlinks and installation
-- the same as 'installGHCBin'. -- the same as 'installGHCBin'.
compileGHC :: ( MonadMask m compileGHC :: ( MonadMask m
, MonadReader Settings m , MonadReader AppState m
, MonadThrow m , MonadThrow m
, MonadResource m , MonadResource m
, MonadLogger m , MonadLogger m
@@ -1135,7 +1149,7 @@ BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO HADDOCK_DOCS = NO
Stage1Only = YES|] Stage1Only = YES|]
compileBindist :: ( MonadReader Settings m compileBindist :: ( MonadReader AppState m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
, MonadLogger m , MonadLogger m
@@ -1153,7 +1167,7 @@ Stage1Only = YES|]
lift $ $(logInfo) [i|configuring build|] lift $ $(logInfo) [i|configuring build|]
liftE $ checkBuildConfig liftE $ checkBuildConfig
Settings { dirs = Dirs {..} } <- lift ask AppState { dirs = Dirs {..} } <- lift ask
forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
@@ -1270,7 +1284,7 @@ Stage1Only = YES|]
-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@, -- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
-- if no path is provided. -- if no path is provided.
upgradeGHCup :: ( MonadMask m upgradeGHCup :: ( MonadMask m
, MonadReader Settings m , MonadReader AppState m
, MonadCatch m , MonadCatch m
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
@@ -1292,20 +1306,32 @@ upgradeGHCup :: ( MonadMask m
m m
Version Version
upgradeGHCup dls mtarget force pfreq = do upgradeGHCup dls mtarget force pfreq = do
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
lift $ $(logInfo) [i|Upgrading GHCup...|] lift $ $(logInfo) [i|Upgrading GHCup...|]
let latestVer = fromJust $ getLatest dls GHCup let latestVer = fromJust $ fst <$> getLatest dls GHCup
when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|] let fn = [rel|ghcup|]
p <- liftE $ download dli tmp (Just fn) p <- liftE $ download dli tmp (Just fn)
let fullDest = fromMaybe (binDir </> fn) mtarget let destDir = dirname destFile
liftIO $ hideError NoSuchThing $ deleteFile fullDest destFile = fromMaybe (binDir </> fn) mtarget
lift $ $(logDebug) [i|mkdir -p #{toFilePath destDir}|]
liftIO $ createDirRecursive' destDir
lift $ $(logDebug) [i|rm -f #{toFilePath destFile}|]
liftIO $ hideError NoSuchThing $ deleteFile destFile
lift $ $(logDebug) [i|cp #{toFilePath p} #{toFilePath destFile}|]
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
fullDest destFile
Overwrite Overwrite
lift $ chmod_777 fullDest lift $ chmod_755 destFile
liftIO (isInPath destFile) >>= \b -> when (not b) $
lift $ $(logWarn) [i|"#{toFilePath (dirname destFile)}" is not in PATH! You have to add it in order to use ghcup.|]
liftIO (isShadowed destFile) >>= \case
Nothing -> pure ()
Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{toFilePath pa}". The upgrade will not be in effect, unless you remove "#{toFilePath pa}" or make sure "#{toFilePath destDir}" comes before "#{toFilePath (dirname pa)}" in PATH.|]
pure latestVer pure latestVer
@@ -1317,7 +1343,7 @@ upgradeGHCup dls mtarget force pfreq = do
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for -- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
-- both installing from source and bindist. -- both installing from source and bindist.
postGHCInstall :: ( MonadReader Settings m postGHCInstall :: ( MonadReader AppState m
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m

View File

@@ -57,6 +57,7 @@ import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( CI )
#endif #endif
import Data.List ( find )
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Time.Clock import Data.Time.Clock
@@ -83,9 +84,9 @@ import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
#endif #endif
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@@ -104,8 +105,8 @@ import qualified System.Posix.RawFilePath.Directory
------------------ ------------------
-- | Like 'getDownloads', but tries to fall back to
-- cached ~/.ghcup/cache/ghcup-<format-ver>.yaml -- | Downloads the download information! But only if we need to ;P
getDownloadsF :: ( FromJSONKey Tool getDownloadsF :: ( FromJSONKey Tool
, FromJSONKey Version , FromJSONKey Version
, FromJSON VersionInfo , FromJSON VersionInfo
@@ -114,7 +115,7 @@ getDownloadsF :: ( FromJSONKey Tool
, MonadLogger m , MonadLogger m
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadReader Settings m , MonadReader AppState m
) )
=> URLSource => URLSource
-> Excepts -> Excepts
@@ -123,17 +124,24 @@ getDownloadsF :: ( FromJSONKey Tool
GHCupInfo GHCupInfo
getDownloadsF urlSource = do getDownloadsF urlSource = do
case urlSource of case urlSource of
GHCupURL -> GHCupURL -> liftE getBase
liftE (OwnSource url) -> do
$ handleIO (\_ -> readFromCache) bs <- reThrowAll DownloadFailed $ downloadBS url
$ catchE @_ @'[JSONError , FileDoesNotExistError] lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(\(DownloadFailed _) -> readFromCache) (OwnSpec av) -> pure av
$ getDownloads urlSource (AddSource (Left ext)) -> do
(OwnSource _) -> liftE $ getDownloads urlSource base <- liftE getBase
(OwnSpec _) -> liftE $ getDownloads urlSource pure (mergeGhcupInfo base ext)
(AddSource (Right uri)) -> do
base <- liftE getBase
bsExt <- reThrowAll DownloadFailed $ downloadBS uri
ext <- lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bsExt)
pure (mergeGhcupInfo base ext)
where where
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
=> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache = do readFromCache = do
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
lift $ $(logWarn) lift $ $(logWarn)
[i|Could not get download info, trying cached version (this may not be recent!)|] [i|Could not get download info, trying cached version (this may not be recent!)|]
let path = view pathL' ghcupURL let path = view pathL' ghcupURL
@@ -145,32 +153,25 @@ getDownloadsF urlSource = do
$ readFile yaml_file $ readFile yaml_file
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs) lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
=> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
getBase =
handleIO (\_ -> readFromCache)
$ catchE @_ @'[JSONError, FileDoesNotExistError]
(\(DownloadFailed _) -> readFromCache)
$ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
-- | Downloads the download information! But only if we need to ;P mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
getDownloads :: ( FromJSONKey Tool -> GHCupInfo -- ^ extension overwriting the base
, FromJSONKey Version -> GHCupInfo
, FromJSON VersionInfo mergeGhcupInfo (GHCupInfo tr base) (GHCupInfo _ ext) =
, MonadIO m let new = M.mapWithKey (\k a -> case M.lookup k ext of
, MonadCatch m Just a' -> M.union a' a
, MonadLogger m Nothing -> a
, MonadThrow m ) base
, MonadFail m in GHCupInfo tr new
, MonadReader Settings m
)
=> URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
getDownloads urlSource = do
lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
case urlSource of
GHCupURL -> do
bs <- reThrowAll DownloadFailed $ smartDl ghcupURL
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSource url) -> do
bs <- reThrowAll DownloadFailed $ downloadBS url
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSpec av) -> pure $ av
where
-- First check if the json file is in the ~/.ghcup/cache dir -- First check if the json file is in the ~/.ghcup/cache dir
-- and check it's access time. If it has been accessed within the -- and check it's access time. If it has been accessed within the
-- last 5 minutes, just reuse it. -- last 5 minutes, just reuse it.
@@ -185,7 +186,7 @@ getDownloads urlSource = do
, MonadIO m1 , MonadIO m1
, MonadFail m1 , MonadFail m1
, MonadLogger m1 , MonadLogger m1
, MonadReader Settings m1 , MonadReader AppState m1
) )
=> URI => URI
-> Excepts -> Excepts
@@ -200,7 +201,7 @@ getDownloads urlSource = do
m1 m1
L.ByteString L.ByteString
smartDl uri' = do smartDl uri' = do
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
let path = view pathL' uri' let path = view pathL' uri'
json_file <- (cacheDir </>) <$> urlBaseName path json_file <- (cacheDir </>) <$> urlBaseName path
e <- liftIO $ doesFileExist json_file e <- liftIO $ doesFileExist json_file
@@ -292,7 +293,8 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
(case p of (case p of
-- non-musl won't work on alpine -- non-musl won't work on alpine
Linux Alpine -> with_distro <|> without_distro_ver Linux Alpine -> with_distro <|> without_distro_ver
_ -> with_distro <|> without_distro_ver <|> without_distro) _ -> with_distro <|> without_distro_ver <|> without_distro
)
where where
with_distro = distro_preview id id with_distro = distro_preview id id
@@ -300,7 +302,18 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing) without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
distro_preview f g = distro_preview f g =
preview (ix t % ix v % viArch % ix a % ix (f p) % ix (g mv)) dls let platformVersionSpec =
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
mv' = g mv
in fmap snd
. find
(\(mverRange, _) -> maybe
(mv' == Nothing)
(\range -> maybe False (flip versionRange range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
-- | Tries to download from the given http or https url -- | Tries to download from the given http or https url
@@ -311,7 +324,7 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
-- --
-- The file must not exist. -- The file must not exist.
download :: ( MonadMask m download :: ( MonadMask m
, MonadReader Settings m , MonadReader AppState m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
@@ -383,7 +396,7 @@ downloadCached :: ( MonadMask m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
, MonadReader Settings m , MonadReader AppState m
) )
=> DownloadInfo => DownloadInfo
-> Maybe (Path Rel) -- ^ optional filename -> Maybe (Path Rel) -- ^ optional filename
@@ -392,7 +405,7 @@ downloadCached dli mfn = do
cache <- lift getCache cache <- lift getCache
case cache of case cache of
True -> do True -> do
Settings {dirs = Dirs {..}} <- lift ask AppState {dirs = Dirs {..}} <- lift ask
fn <- maybe (urlBaseName $ view (dlUri % pathL') dli) pure mfn fn <- maybe (urlBaseName $ view (dlUri % pathL') dli) pure mfn
let cachfile = cacheDir </> fn let cachfile = cacheDir </> fn
fileExists <- liftIO $ doesFileExist cachfile fileExists <- liftIO $ doesFileExist cachfile
@@ -416,7 +429,7 @@ downloadCached dli mfn = do
-- | This is used for downloading the JSON. -- | This is used for downloading the JSON.
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m) downloadBS :: (MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m)
=> URI => URI
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
@@ -473,12 +486,12 @@ downloadBS uri'
#endif #endif
checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader Settings m) checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m)
=> DownloadInfo => DownloadInfo
-> Path Abs -> Path Abs
-> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
checkDigest dli file = do checkDigest dli file = do
verify <- lift ask <&> (not . noVerify) verify <- lift ask <&> (not . noVerify . settings)
when verify $ do when verify $ do
p' <- toFilePath <$> basename file p' <- toFilePath <$> basename file
lift $ $(logInfo) [i|verifying digest of: #{p'}|] lift $ $(logInfo) [i|verifying digest of: #{p'}|]

View File

@@ -67,6 +67,10 @@ data CopyError = CopyError String
data TagNotFound = TagNotFound Tag Tool data TagNotFound = TagNotFound Tag Tool
deriving Show deriving Show
-- | Unable to find a version of a tool.
data VerNotFound = VerNotFound Version Tool
deriving Show
-- | The tool (such as GHC) is already installed with that version. -- | The tool (such as GHC) is already installed with that version.
data AlreadyInstalled = AlreadyInstalled Tool Version data AlreadyInstalled = AlreadyInstalled Tool Version
deriving Show deriving Show

View File

@@ -14,8 +14,10 @@ module GHCup.Requirements where
import GHCup.Types import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Version
import Control.Applicative import Control.Applicative
import Data.List ( find )
import Data.Maybe import Data.Maybe
import Optics import Optics
import Prelude hiding ( abs import Prelude hiding ( abs
@@ -23,6 +25,7 @@ import Prelude hiding ( abs
, writeFile , writeFile
) )
import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
@@ -33,15 +36,25 @@ getCommonRequirements :: PlatformResult
-> ToolRequirements -> ToolRequirements
-> Maybe Requirements -> Maybe Requirements
getCommonRequirements pr tr = getCommonRequirements pr tr =
preview (ix GHC % ix Nothing % ix (_platform pr) % ix (_distroVersion pr)) tr with_distro <|> without_distro_ver <|> without_distro
<|> preview (ix GHC % ix Nothing % ix (_platform pr) % ix Nothing) tr where
<|> preview with_distro = distro_preview _platform _distroVersion
( ix GHC without_distro_ver = distro_preview _platform (const Nothing)
% ix Nothing without_distro = distro_preview (set _Linux UnknownLinux . _platform) (const Nothing)
% ix (set _Linux UnknownLinux $ _platform pr)
% ix Nothing distro_preview f g =
) let platformVersionSpec =
tr preview (ix GHC % ix Nothing % ix (f pr)) tr
mv' = g pr
in fmap snd
. find
(\(mverRange, _) -> maybe
(mv' == Nothing)
(\range -> maybe False (flip versionRange range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
prettyRequirements :: Requirements -> T.Text prettyRequirements :: Requirements -> T.Text

View File

@@ -14,6 +14,7 @@ Portability : POSIX
module GHCup.Types where module GHCup.Types where
import Data.Map.Strict ( Map ) import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import HPath import HPath
@@ -21,6 +22,7 @@ import URI.ByteString
import qualified Data.Text as T import qualified Data.Text as T
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
import qualified Graphics.Vty as Vty
@@ -45,7 +47,7 @@ data GHCupInfo = GHCupInfo
type ToolRequirements = Map Tool ToolReqVersionSpec type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe Versioning) Requirements type PlatformReqVersionSpec = Map (Maybe VersionRange) Requirements
data Requirements = Requirements data Requirements = Requirements
@@ -69,7 +71,7 @@ type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map Version VersionInfo type ToolVersionSpec = Map Version VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
-- | An installable tool. -- | An installable tool.
@@ -77,16 +79,20 @@ data Tool = GHC
| Cabal | Cabal
| GHCup | GHCup
| HLS | HLS
deriving (Eq, GHC.Generic, Ord, Show) deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
-- | All necessary information of a tool version, including -- | All necessary information of a tool version, including
-- source download and per-architecture downloads. -- source download and per-architecture downloads.
data VersionInfo = VersionInfo data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag { _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI , _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch , _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
-- informative messages
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
} }
deriving (Eq, GHC.Generic, Show) deriving (Eq, GHC.Generic, Show)
@@ -96,6 +102,7 @@ data Tag = Latest
| Recommended | Recommended
| Prerelease | Prerelease
| Base PVP | Base PVP
| Old -- ^ old version are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -169,7 +176,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir , _dlSubdir :: Maybe TarDir
, _dlHash :: Text , _dlHash :: Text
} }
deriving (Eq, GHC.Generic, Show) deriving (Eq, Ord, GHC.Generic, Show)
@@ -182,34 +189,89 @@ data DownloadInfo = DownloadInfo
-- | How to descend into a tar archive. -- | How to descend into a tar archive.
data TarDir = RealDir (Path Rel) data TarDir = RealDir (Path Rel)
| RegexDir String -- ^ will be compiled to regex, the first match will "win" | RegexDir String -- ^ will be compiled to regex, the first match will "win"
deriving (Eq, GHC.Generic, Show) deriving (Eq, Ord, GHC.Generic, Show)
-- | Where to fetch GHCupDownloads from. -- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL data URLSource = GHCupURL
| OwnSource URI | OwnSource URI
| OwnSpec GHCupInfo | OwnSpec GHCupInfo
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
deriving (GHC.Generic, Show) deriving (GHC.Generic, Show)
data UserSettings = UserSettings
{ uCache :: Maybe Bool
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Vty.Key
, kDown :: Maybe Vty.Key
, kQuit :: Maybe Vty.Key
, kInstall :: Maybe Vty.Key
, kUninstall :: Maybe Vty.Key
, kSet :: Maybe Vty.Key
, kChangelog :: Maybe Vty.Key
, kShowAll :: Maybe Vty.Key
}
deriving (Show, GHC.Generic)
data KeyBindings = KeyBindings
{ bUp :: Vty.Key
, bDown :: Vty.Key
, bQuit :: Vty.Key
, bInstall :: Vty.Key
, bUninstall :: Vty.Key
, bSet :: Vty.Key
, bChangelog :: Vty.Key
, bShowAll :: Vty.Key
}
deriving (Show, GHC.Generic)
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
{ bUp = Vty.KUp
, bDown = Vty.KDown
, bQuit = Vty.KChar 'q'
, bInstall = Vty.KChar 'i'
, bUninstall = Vty.KChar 'u'
, bSet = Vty.KChar 's'
, bChangelog = Vty.KChar 'c'
, bShowAll = Vty.KChar 'a'
}
data AppState = AppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
} deriving (Show)
data Settings = Settings data Settings = Settings
{ -- set by user { cache :: Bool
cache :: Bool
, noVerify :: Bool , noVerify :: Bool
, keepDirs :: KeepDirs , keepDirs :: KeepDirs
, downloader :: Downloader , downloader :: Downloader
, verbose :: Bool , verbose :: Bool
, urlSource :: URLSource
-- set on app start
, dirs :: Dirs
} }
deriving Show deriving (Show, GHC.Generic)
data Dirs = Dirs data Dirs = Dirs
{ baseDir :: Path Abs { baseDir :: Path Abs
, binDir :: Path Abs , binDir :: Path Abs
, cacheDir :: Path Abs , cacheDir :: Path Abs
, logsDir :: Path Abs , logsDir :: Path Abs
, confDir :: Path Abs
} }
deriving Show deriving Show
@@ -250,7 +312,7 @@ data PlatformResult = PlatformResult
prettyPlatform :: PlatformResult -> String prettyPlatform :: PlatformResult -> String
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' } prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> show v' = show plat <> ", " <> T.unpack (prettyV v')
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing } prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat = show plat
@@ -287,3 +349,19 @@ prettyTVer :: GHCTargetVersion -> Text
prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v' prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
prettyTVer (GHCTargetVersion Nothing v') = prettyVer v' prettyTVer (GHCTargetVersion Nothing v') = prettyVer v'
-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
| VR_gteq Versioning
| VR_lt Versioning
| VR_lteq Versioning
| VR_eq Versioning
deriving (Eq, GHC.Generic, Ord, Show)
-- | A version range. Supports && and ||, but not arbitrary
-- combinations. This is a little simplified.
data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
| OrRange (NonEmpty VersionCmp) VersionRange
deriving (Eq, GHC.Generic, Ord, Show)

View File

@@ -22,25 +22,34 @@ Portability : POSIX
module GHCup.Types.JSON where module GHCup.Types.JSON where
import GHCup.Types import GHCup.Types
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.Applicative ( (<|>) ) import Control.Applicative ( (<|>) )
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import Data.Aeson.Types import Data.Aeson.Types
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Text.Encoding as E import Data.Text.Encoding as E
import Data.Versions import Data.Versions
import Data.Void
import Data.Word8 import Data.Word8
import HPath import HPath
import URI.ByteString import URI.ByteString
import Text.Casing
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
@@ -50,11 +59,18 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Versio
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key
instance ToJSON Tag where instance ToJSON Tag where
toJSON Latest = String "Latest" toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended" toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease" toJSON Prerelease = String "Prerelease"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'') toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON (UnknownTag x ) = String (T.pack x) toJSON (UnknownTag x ) = String (T.pack x)
@@ -63,6 +79,7 @@ instance FromJSON Tag where
"Latest" -> pure Latest "Latest" -> pure Latest
"Recommended" -> pure Recommended "Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease "Prerelease" -> pure Prerelease
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x Right x -> pure $ Base x
Left e -> fail . show $ e Left e -> fail . show $ e
@@ -100,10 +117,10 @@ instance ToJSONKey (Maybe Versioning) where
instance FromJSONKey (Maybe Versioning) where instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t -> fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else pure $ just t if t == T.pack "unknown_versioning" then pure Nothing else just t
where where
just t = case versioning t of just t = case versioning t of
Right x -> pure x Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
instance ToJSONKey Platform where instance ToJSONKey Platform where
@@ -146,10 +163,10 @@ instance ToJSONKey (Maybe Version) where
instance FromJSONKey (Maybe Version) where instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t -> fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else pure $ just t if t == T.pack "unknown_version" then pure Nothing else just t
where where
just t = case version t of just t = case version t of
Right x -> pure x Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where instance ToJSON Version where
@@ -209,3 +226,101 @@ instance FromJSON TarDir where
regexDir = withObject "TarDir" $ \o -> do regexDir = withObject "TarDir" $ \o -> do
r <- o .: "RegexDir" r <- o .: "RegexDir"
pure $ RegexDir r pure $ RegexDir r
instance ToJSON VersionCmp where
toJSON = String . versionCmpToText
instance FromJSON VersionCmp where
parseJSON = withText "VersionCmp" $ \t -> do
case MP.parse versionCmpP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionCmpToText :: VersionCmp -> T.Text
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
versionCmpToText (VR_lt ver') = "< " <> prettyV ver'
versionCmpToText (VR_lteq ver') = "<= " <> prettyV ver'
versionCmpToText (VR_eq ver') = "== " <> prettyV ver'
versionCmpP :: MP.Parsec Void T.Text VersionCmp
versionCmpP =
fmap VR_gt (MP.try $ MPC.space *> MP.chunk ">" *> MPC.space *> versioningEnd)
<|> fmap
VR_gteq
(MP.try $ MPC.space *> MP.chunk ">=" *> MPC.space *> versioningEnd)
<|> fmap
VR_lt
(MP.try $ MPC.space *> MP.chunk "<" *> MPC.space *> versioningEnd)
<|> fmap
VR_lteq
(MP.try $ MPC.space *> MP.chunk "<=" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> MP.chunk "==" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> versioningEnd)
instance ToJSON VersionRange where
toJSON = String . verRangeToText
verRangeToText :: VersionRange -> T.Text
verRangeToText (SimpleRange cmps) =
let inner = foldr1 (\x y -> x <> " && " <> y)
(versionCmpToText <$> NE.toList cmps)
in "( " <> inner <> " )"
verRangeToText (OrRange cmps range) =
let left = verRangeToText $ (SimpleRange cmps)
right = verRangeToText range
in left <> " || " <> right
instance FromJSON VersionRange where
parseJSON = withText "VersionRange" $ \t -> do
case MP.parse versionRangeP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionRangeP :: MP.Parsec Void T.Text VersionRange
versionRangeP = go <* MP.eof
where
go =
MP.try orParse
<|> MP.try (fmap SimpleRange andParse)
<|> (fmap (SimpleRange . pure) versionCmpP)
orParse :: MP.Parsec Void T.Text VersionRange
orParse =
(\a o -> OrRange a o)
<$> (MP.try andParse <|> fmap pure versionCmpP)
<*> (MPC.space *> MP.chunk "||" *> MPC.space *> go)
andParse :: MP.Parsec Void T.Text (NonEmpty VersionCmp)
andParse =
fmap (\h t -> h :| t)
(MPC.space *> MP.chunk "(" *> MPC.space *> versionCmpP)
<*> ( MP.try
$ MP.many (MPC.space *> MP.chunk "&&" *> MPC.space *> versionCmpP)
)
<* MPC.space
<* MP.chunk ")"
<* MPC.space
versioningEnd :: MP.Parsec Void T.Text Versioning
versioningEnd =
MP.try (verP (MP.chunk " " <|> MP.chunk ")" <|> MP.chunk "&&") <* MPC.space)
<|> versioning'
instance ToJSONKey (Maybe VersionRange) where
toJSONKey = toJSONKeyText $ \case
Just x -> verRangeToText x
Nothing -> "unknown_versioning"
instance FromJSONKey (Maybe VersionRange) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case MP.parse versionRangeP "" t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e

View File

@@ -50,6 +50,7 @@ import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.Foldable import Data.Foldable
import Data.List import Data.List
import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.List.Split import Data.List.Split
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
@@ -99,45 +100,52 @@ import qualified Text.Megaparsec as MP
-- | The symlink destination of a ghc tool. -- | The symlink destination of a ghc tool.
ghcLinkDestination :: (MonadReader Settings m, MonadThrow m, MonadIO m) ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> ByteString -- ^ the tool, such as 'ghc', 'haddock' etc. => ByteString -- ^ the tool, such as 'ghc', 'haddock' etc.
-> GHCTargetVersion -> GHCTargetVersion
-> m ByteString -> m ByteString
ghcLinkDestination tool ver = do ghcLinkDestination tool ver = do
Settings {dirs = Dirs {..}} <- ask AppState { dirs = Dirs {..} } <- ask
t <- parseRel tool t <- parseRel tool
ghcd <- ghcupGHCDir ver ghcd <- ghcupGHCDir ver
pure (relativeSymlink binDir (ghcd </> [rel|bin|] </> t)) pure (relativeSymlink binDir (ghcd </> [rel|bin|] </> t))
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5. -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: (MonadReader Settings m, MonadIO m, MonadLogger m) => GHCTargetVersion -> m () rmMinorSymlinks :: ( MonadReader AppState m
rmMinorSymlinks GHCTargetVersion {..} = do , MonadIO m
Settings {dirs = Dirs {..}} <- ask , MonadLogger m
, MonadThrow m
files <- liftIO $ findFiles' , MonadFail m
binDir , MonadReader AppState m
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget )
*> parseUntil1 (MP.chunk $ prettyVer _tvVersion) => GHCTargetVersion
*> (MP.chunk $ prettyVer _tvVersion) -> Excepts '[NotInstalled] m ()
*> MP.eof rmMinorSymlinks tv@(GHCTargetVersion {..}) = do
) AppState { dirs = Dirs {..} } <- lift ask
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do forM_ files $ \f -> do
let fullF = (binDir </> f) f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion)
$(logDebug) [i|rm -f #{toFilePath fullF}|] let fullF = (binDir </> f_xyz)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- | Removes the set ghc version for the given target, if any. -- | Removes the set ghc version for the given target, if any.
rmPlain :: (MonadReader Settings m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) rmPlain :: ( MonadReader AppState m
=> Maybe Text -- ^ target , MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
)
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmPlain target = do rmPlain target = do
Settings {dirs = Dirs {..}} <- lift ask AppState { dirs = Dirs {..} } <- lift ask
mtv <- lift $ ghcSet target mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do forM_ files $ \f -> do
let fullF = (binDir </> f) let fullF = (binDir </> f)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
@@ -149,25 +157,25 @@ rmPlain target = do
-- | Remove the major GHC symlink, e.g. ghc-8.6. -- | Remove the major GHC symlink, e.g. ghc-8.6.
rmMajorSymlinks :: (MonadReader Settings m, MonadThrow m, MonadLogger m, MonadIO m) rmMajorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> GHCTargetVersion => GHCTargetVersion
-> m () -> Excepts '[NotInstalled] m ()
rmMajorSymlinks GHCTargetVersion {..} = do rmMajorSymlinks tv@(GHCTargetVersion {..}) = do
Settings {dirs = Dirs {..}} <- ask AppState { dirs = Dirs {..} } <- lift ask
(mj, mi) <- getMajorMinorV _tvVersion (mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi let v' = intToText mj <> "." <> intToText mi
files <- liftIO $ findFiles' files <- liftE $ ghcToolFiles tv
binDir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk v')
*> MP.chunk v'
*> MP.eof
)
forM_ files $ \f -> do forM_ files $ \f -> do
let fullF = (binDir </> f) f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v')
$(logDebug) [i|rm -f #{toFilePath fullF}|] let fullF = (binDir </> f_xyz)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
@@ -179,26 +187,26 @@ rmMajorSymlinks GHCTargetVersion {..} = do
-- | Whethe the given GHC versin is installed. -- | Whethe the given GHC versin is installed.
ghcInstalled :: (MonadIO m, MonadReader Settings m, MonadThrow m) => GHCTargetVersion -> m Bool ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver ghcdir <- ghcupGHCDir ver
liftIO $ doesDirectoryExist ghcdir liftIO $ doesDirectoryExist ghcdir
-- | Whether the given GHC version is installed from source. -- | Whether the given GHC version is installed from source.
ghcSrcInstalled :: (MonadIO m, MonadReader Settings m, MonadThrow m) => GHCTargetVersion -> m Bool ghcSrcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled ver = do ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver ghcdir <- ghcupGHCDir ver
liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile) liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
-- | Whether the given GHC version is set as the current. -- | Whether the given GHC version is set as the current.
ghcSet :: (MonadReader Settings m, MonadThrow m, MonadIO m) ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any => Maybe Text -- ^ the target of the GHC version, if any
-- (e.g. armv7-unknown-linux-gnueabihf) -- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersion) -> m (Maybe GHCTargetVersion)
ghcSet mtarget = do ghcSet mtarget = do
Settings {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
ghc <- parseRel $ E.encodeUtf8 (maybe "ghc" (<> "-ghc") mtarget) ghc <- parseRel $ E.encodeUtf8 (maybe "ghc" (<> "-ghc") mtarget)
let ghcBin = binDir </> ghc let ghcBin = binDir </> ghc
@@ -231,7 +239,7 @@ ghcLinkVersion bs = do
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>. -- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
-- If a dir cannot be parsed, returns left. -- If a dir cannot be parsed, returns left.
getInstalledGHCs :: (MonadReader Settings m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion] getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs = do getInstalledGHCs = do
ghcdir <- ghcupGHCBaseDir ghcdir <- ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir
@@ -241,10 +249,10 @@ getInstalledGHCs = do
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@. -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
getInstalledCabals :: (MonadReader Settings m, MonadIO m, MonadCatch m) getInstalledCabals :: (MonadReader AppState m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version] => m [Either (Path Rel) Version]
getInstalledCabals = do getInstalledCabals = do
Settings {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString)) (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
@@ -257,16 +265,16 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed. -- | Whether the given cabal version is installed.
cabalInstalled :: (MonadIO m, MonadReader Settings m, MonadCatch m) => Version -> m Bool cabalInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
cabalInstalled ver = do cabalInstalled ver = do
vers <- fmap rights $ getInstalledCabals vers <- fmap rights $ getInstalledCabals
pure $ elem ver $ vers pure $ elem ver $ vers
-- Return the currently set cabal version, if any. -- Return the currently set cabal version, if any.
cabalSet :: (MonadReader Settings m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) cabalSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet = do cabalSet = do
Settings {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
let cabalbin = binDir </> [rel|cabal|] let cabalbin = binDir </> [rel|cabal|]
b <- handleIO (\_ -> pure False) $ fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin b <- handleIO (\_ -> pure False) $ fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin
if if
@@ -303,10 +311,10 @@ cabalSet = do
-- | Get all installed hls, by matching on -- | Get all installed hls, by matching on
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@. -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
getInstalledHLSs :: (MonadReader Settings m, MonadIO m, MonadCatch m) getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version] => m [Either (Path Rel) Version]
getInstalledHLSs = do getInstalledHLSs = do
Settings { dirs = Dirs {..} } <- ask AppState { dirs = Dirs {..} } <- ask
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts compExtended (makeRegexOpts compExtended
@@ -326,7 +334,7 @@ getInstalledHLSs = do
-- | Whether the given HLS version is installed. -- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader Settings m, MonadCatch m) => Version -> m Bool hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
hlsInstalled ver = do hlsInstalled ver = do
vers <- fmap rights $ getInstalledHLSs vers <- fmap rights $ getInstalledHLSs
pure $ elem ver $ vers pure $ elem ver $ vers
@@ -334,9 +342,9 @@ hlsInstalled ver = do
-- Return the currently set hls version, if any. -- Return the currently set hls version, if any.
hlsSet :: (MonadReader Settings m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do hlsSet = do
Settings {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
let hlsBin = binDir </> [rel|haskell-language-server-wrapper|] let hlsBin = binDir </> [rel|haskell-language-server-wrapper|]
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
@@ -357,7 +365,7 @@ hlsSet = do
-- | Return the GHC versions the currently selected HLS supports. -- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader Settings m hlsGHCVersions :: ( MonadReader AppState m
, MonadIO m , MonadIO m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
@@ -383,11 +391,11 @@ hlsGHCVersions = do
-- | Get all server binaries for an hls version, if any. -- | Get all server binaries for an hls version, if any.
hlsServerBinaries :: (MonadReader Settings m, MonadIO m) hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
=> Version => Version
-> m [Path Rel] -> m [Path Rel]
hlsServerBinaries ver = do hlsServerBinaries ver = do
Settings { dirs = Dirs {..} } <- ask AppState { dirs = Dirs {..} } <- ask
liftIO $ handleIO (\_ -> pure []) $ findFiles liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts (makeRegexOpts
@@ -399,11 +407,11 @@ hlsServerBinaries ver = do
-- | Get the wrapper binary for an hls version, if any. -- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader Settings m, MonadThrow m, MonadIO m) hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> Version => Version
-> m (Maybe (Path Rel)) -> m (Maybe (Path Rel))
hlsWrapperBinary ver = do hlsWrapperBinary ver = do
Settings { dirs = Dirs {..} } <- ask AppState { dirs = Dirs {..} } <- ask
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts (makeRegexOpts
@@ -420,7 +428,7 @@ hlsWrapperBinary ver = do
-- | Get all binaries for an hls version, if any. -- | Get all binaries for an hls version, if any.
hlsAllBinaries :: (MonadReader Settings m, MonadIO m, MonadThrow m) => Version -> m [Path Rel] hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [Path Rel]
hlsAllBinaries ver = do hlsAllBinaries ver = do
hls <- hlsServerBinaries ver hls <- hlsServerBinaries ver
wrapper <- hlsWrapperBinary ver wrapper <- hlsWrapperBinary ver
@@ -428,9 +436,9 @@ hlsAllBinaries ver = do
-- | Get the active symlinks for hls. -- | Get the active symlinks for hls.
hlsSymlinks :: (MonadReader Settings m, MonadIO m, MonadCatch m) => m [Path Rel] hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [Path Rel]
hlsSymlinks = do hlsSymlinks = do
Settings { dirs = Dirs {..} } <- ask AppState { dirs = Dirs {..} } <- ask
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts compExtended (makeRegexOpts compExtended
@@ -455,7 +463,7 @@ hlsSymlinks = do
-- | Extract (major, minor) from any version. -- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int) getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version {..} = case _vChunks of getMajorMinorV Version {..} = case _vChunks of
([Digits x] : [Digits y] : _) -> pure (fromIntegral x, fromIntegral y) ((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
_ -> throwM $ ParseError "Could not parse X.Y from version" _ -> throwM $ ParseError "Could not parse X.Y from version"
@@ -467,7 +475,7 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
-- | Get the latest installed full GHC version that satisfies X.Y. -- | Get the latest installed full GHC version that satisfies X.Y.
-- This reads `ghcupGHCBaseDir`. -- This reads `ghcupGHCBaseDir`.
getGHCForMajor :: (MonadReader Settings m, MonadIO m, MonadThrow m) getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m)
=> Int -- ^ major version component => Int -- ^ major version component
-> Int -- ^ minor version component -> Int -- ^ minor version component
-> Maybe Text -- ^ the target triple -> Maybe Text -- ^ the target triple
@@ -489,11 +497,11 @@ getGHCForMajor major' minor' mt = do
getLatestGHCFor :: Int -- ^ major version component getLatestGHCFor :: Int -- ^ major version component
-> Int -- ^ minor version component -> Int -- ^ minor version component
-> GHCupDownloads -> GHCupDownloads
-> Maybe Version -> Maybe (Version, VersionInfo)
getLatestGHCFor major' minor' dls = do getLatestGHCFor major' minor' dls = do
join join
. fmap (lastMay . filter (\v -> matchMajor v major' minor')) . fmap (lastMay . filter (\(v, _) -> matchMajor v major' minor'))
. preview (ix GHC % to Map.keys) . preview (ix GHC % to Map.toDescList)
$ dls $ dls
@@ -588,31 +596,31 @@ getTagged tag =
% _head % _head
) )
getLatest :: GHCupDownloads -> Tool -> Maybe Version getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest % to fst) $ av getLatest av tool = headOf (ix tool % getTagged Latest) $ av
getRecommended :: GHCupDownloads -> Tool -> Maybe Version getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended % to fst) $ av getRecommended av tool = headOf (ix tool % getTagged Recommended) $ av
-- | Gets the latest GHC with a given base version. -- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe Version getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
getLatestBaseVersion av pvpVer = getLatestBaseVersion av pvpVer =
headOf (ix GHC % getTagged (Base pvpVer) % to fst) av headOf (ix GHC % getTagged (Base pvpVer)) av
----------------------- -----------------------
--[ Settings Getter ]-- --[ AppState Getter ]--
----------------------- -----------------------
getCache :: MonadReader Settings m => m Bool getCache :: MonadReader AppState m => m Bool
getCache = ask <&> cache getCache = ask <&> cache . settings
getDownloader :: MonadReader Settings m => m Downloader getDownloader :: MonadReader AppState m => m Downloader
getDownloader = ask <&> downloader getDownloader = ask <&> downloader . settings
@@ -633,7 +641,7 @@ urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
-- Returns unversioned relative files, e.g.: -- Returns unversioned relative files, e.g.:
-- --
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@ -- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
ghcToolFiles :: (MonadReader Settings m, MonadThrow m, MonadFail m, MonadIO m) ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion => GHCTargetVersion
-> Excepts '[NotInstalled] m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles ver = do ghcToolFiles ver = do
@@ -686,7 +694,7 @@ ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
-- | Calls gmake if it exists in PATH, otherwise make. -- | Calls gmake if it exists in PATH, otherwise make.
make :: (MonadThrow m, MonadIO m, MonadReader Settings m) make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
=> [ByteString] => [ByteString]
-> Maybe (Path Abs) -> Maybe (Path Abs)
-> m (Either ProcessError ()) -> m (Either ProcessError ())
@@ -739,13 +747,13 @@ getChangeLog dls tool (Right tag) =
-- --
-- 1. the build directory, depending on the KeepDirs setting -- 1. the build directory, depending on the KeepDirs setting
-- 2. the install destination, depending on whether the build failed -- 2. the install destination, depending on whether the build failed
runBuildAction :: (Show (V e), MonadReader Settings m, MonadIO m, MonadMask m) runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
=> Path Abs -- ^ build directory (cleaned up depending on Settings) => Path Abs -- ^ build directory (cleaned up depending on Settings)
-> Maybe (Path Abs) -- ^ dir to *always* clean up on exception -> Maybe (Path Abs) -- ^ dir to *always* clean up on exception
-> Excepts e m a -> Excepts e m a
-> Excepts '[BuildFailed] m a -> Excepts '[BuildFailed] m a
runBuildAction bdir instdir action = do runBuildAction bdir instdir action = do
Settings {..} <- lift ask AppState { settings = Settings {..} } <- lift ask
let exAction = do let exAction = do
forM_ instdir $ \dir -> forM_ instdir $ \dir ->
liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir
@@ -787,3 +795,16 @@ createDirRecursive' p =
_ -> throwIO e _ -> throwIO e
_ -> throwIO e _ -> throwIO e
getVersionInfo :: Version
-> Tool
-> GHCupDownloads
-> Maybe VersionInfo
getVersionInfo v' tool dls =
headOf
( ix tool
% to (Map.filterWithKey (\k _ -> k == v'))
% to Map.elems
% _head
)
dls

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
@@ -14,16 +15,18 @@ Portability : POSIX
-} -}
module GHCup.Utils.Dirs module GHCup.Utils.Dirs
( getDirs ( getDirs
, ghcupConfigFile
, ghcupGHCBaseDir , ghcupGHCBaseDir
, ghcupGHCDir , ghcupGHCDir
, parseGHCupGHCDir
, mkGhcupTmpDir , mkGhcupTmpDir
, withGHCupTmpDir , parseGHCupGHCDir
, relativeSymlink , relativeSymlink
, withGHCupTmpDir
) )
where where
import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
@@ -34,8 +37,11 @@ import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Maybe import Data.Maybe
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts
import HPath import HPath
import HPath.IO import HPath.IO
import Optics import Optics
@@ -49,8 +55,10 @@ import System.Posix.Env.ByteString ( getEnv
import System.Posix.FilePath hiding ( (</>) ) import System.Posix.FilePath hiding ( (</>) )
import System.Posix.Temp.ByteString ( mkdtemp ) import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y
import qualified System.Posix.FilePath as FP import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU import qualified System.Posix.User as PU
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
@@ -84,6 +92,28 @@ ghcupBaseDir = do
pure (bdir </> [rel|.ghcup|]) pure (bdir </> [rel|.ghcup|])
-- | ~/.ghcup by default
--
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
ghcupConfigDir :: IO (Path Abs)
ghcupConfigDir = do
xdg <- useXDG
if xdg
then do
bdir <- getEnv "XDG_CONFIG_HOME" >>= \case
Just r -> parseAbs r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> [rel|.config|])
pure (bdir </> [rel|ghcup|])
else do
bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> parseAbs r
Nothing -> liftIO getHomeDirectory
pure (bdir </> [rel|.ghcup|])
-- | If 'GHCUP_USE_XDG_DIRS' is set (to anything), -- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin' -- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
-- (which, sadly is not strictly xdg spec). -- (which, sadly is not strictly xdg spec).
@@ -142,27 +172,44 @@ getDirs = do
binDir <- ghcupBinDir binDir <- ghcupBinDir
cacheDir <- ghcupCacheDir cacheDir <- ghcupCacheDir
logsDir <- ghcupLogsDir logsDir <- ghcupLogsDir
confDir <- ghcupConfigDir
pure Dirs { .. } pure Dirs { .. }
-------------------
--[ GHCup files ]--
-------------------
ghcupConfigFile :: (MonadIO m)
=> Excepts '[JSONError] m UserSettings
ghcupConfigFile = do
confDir <- liftIO $ ghcupConfigDir
let file = confDir </> [rel|config.yaml|]
bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ fmap Just $ readFile file
case bs of
Nothing -> pure defaultUserSettings
Just bs' -> lE' JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict $ bs'
------------------------- -------------------------
--[ GHCup directories ]-- --[ GHCup directories ]--
------------------------- -------------------------
-- | ~/.ghcup/ghc by default. -- | ~/.ghcup/ghc by default.
ghcupGHCBaseDir :: (MonadReader Settings m) => m (Path Abs) ghcupGHCBaseDir :: (MonadReader AppState m) => m (Path Abs)
ghcupGHCBaseDir = do ghcupGHCBaseDir = do
Settings {..} <- ask AppState { dirs = Dirs {..} } <- ask
pure (baseDir dirs </> [rel|ghc|]) pure (baseDir </> [rel|ghc|])
-- | Gets '~/.ghcup/ghc/<ghcupGHCDir>'. -- | Gets '~/.ghcup/ghc/<ghcupGHCDir>'.
-- The dir may be of the form -- The dir may be of the form
-- * armv7-unknown-linux-gnueabihf-8.8.3 -- * armv7-unknown-linux-gnueabihf-8.8.3
-- * 8.8.4 -- * 8.8.4
ghcupGHCDir :: (MonadReader Settings m, MonadThrow m) ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
=> GHCTargetVersion => GHCTargetVersion
-> m (Path Abs) -> m (Path Abs)
ghcupGHCDir ver = do ghcupGHCDir ver = do

View File

@@ -117,7 +117,7 @@ executeOut path args chdir = captureOutStreams $ do
SPPB.executeFile (toFilePath path) True args Nothing SPPB.executeFile (toFilePath path) True args Nothing
execLogged :: (MonadReader Settings m, MonadIO m, MonadThrow m) execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
=> ByteString -- ^ thing to execute => ByteString -- ^ thing to execute
-> Bool -- ^ whether to search PATH for the thing -> Bool -- ^ whether to search PATH for the thing
-> [ByteString] -- ^ args for the thing -> [ByteString] -- ^ args for the thing
@@ -126,7 +126,7 @@ execLogged :: (MonadReader Settings m, MonadIO m, MonadThrow m)
-> Maybe [(ByteString, ByteString)] -- ^ optional environment -> Maybe [(ByteString, ByteString)] -- ^ optional environment
-> m (Either ProcessError ()) -> m (Either ProcessError ())
execLogged exe spath args lfile chdir env = do execLogged exe spath args lfile chdir env = do
Settings {dirs = Dirs {..}, ..} <- ask AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
logfile <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log") logfile <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log")
liftIO $ bracket (createFile (toFilePath logfile) newFilePerms) liftIO $ bracket (createFile (toFilePath logfile) newFilePerms)
closeFd closeFd
@@ -407,6 +407,32 @@ searchPath paths needle = go paths
else pure False else pure False
-- | Check wether a binary is shadowed by another one that comes before
-- it in PATH. Returns the path to said binary, if any.
isShadowed :: Path Abs -> IO (Maybe (Path Abs))
isShadowed p = do
let dir = dirname p
fn <- basename p
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
if dir `elem` spaths
then do
let shadowPaths = takeWhile (/= dir) spaths
searchPath shadowPaths fn
else pure Nothing
-- | Check whether the binary is in PATH. This returns only `True`
-- if the directory containing the binary is part of PATH.
isInPath :: Path Abs -> IO Bool
isInPath p = do
let dir = dirname p
fn <- basename p
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
if dir `elem` spaths
then isJust <$> searchPath [dir] fn
else pure False
findFiles :: Path Abs -> Regex -> IO [Path Rel] findFiles :: Path Abs -> Regex -> IO [Path Rel]
findFiles path regex = do findFiles path regex = do
dirStream <- openDirStream (toFilePath path) dirStream <- openDirStream (toFilePath path)
@@ -440,13 +466,16 @@ isBrokenSymlink p =
pure False pure False
chmod_777 :: (MonadLogger m, MonadIO m) => Path a -> m () chmod_755 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_777 (toFilePath -> fp) = do chmod_755 (toFilePath -> fp) = do
let exe_mode = let exe_mode =
newFilePerms nullFileMode
`unionFileModes` ownerExecuteMode `unionFileModes` ownerExecuteMode
`unionFileModes` ownerReadMode
`unionFileModes` ownerWriteMode
`unionFileModes` groupExecuteMode `unionFileModes` groupExecuteMode
`unionFileModes` groupReadMode
`unionFileModes` otherExecuteMode `unionFileModes` otherExecuteMode
$(logDebug) [i|chmod 777 #{fp}|] `unionFileModes` otherReadMode
$(logDebug) [i|chmod 755 #{fp}|]
liftIO $ setFileMode fp exe_mode liftIO $ setFileMode fp exe_mode

View File

@@ -65,9 +65,9 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
rawOutter outr rawOutter outr
initGHCupFileLogging :: (MonadIO m, MonadReader Settings m) => Path Rel -> m (Path Abs) initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => Path Rel -> m (Path Abs)
initGHCupFileLogging context = do initGHCupFileLogging context = do
Settings {dirs = Dirs {..}} <- ask AppState {dirs = Dirs {..}} <- ask
let logfile = logsDir </> context let logfile = logsDir </> context
liftIO $ do liftIO $ do
createDirRecursive' logsDir createDirRecursive' logsDir

View File

@@ -25,6 +25,7 @@ import Data.Text ( Text )
import Data.Versions import Data.Versions
import Data.Void import Data.Void
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T import qualified Data.Text as T
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
@@ -73,13 +74,13 @@ ghcTargetBinP t =
ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion
ghcTargetVerP = ghcTargetVerP =
(\x y -> GHCTargetVersion x y) (\x y -> GHCTargetVersion x y)
<$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP)) <* MP.chunk "-") <$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP')) <* MP.chunk "-")
<|> (flip const Nothing <$> mempty) <|> (flip const Nothing <$> mempty)
) )
<*> (version' <* MP.eof) <*> (version' <* MP.eof)
where where
verP :: MP.Parsec Void Text Text verP' :: MP.Parsec Void Text Text
verP = do verP' = do
v <- version' v <- version'
let startsWithDigists = let startsWithDigists =
and and
@@ -90,7 +91,22 @@ ghcTargetVerP =
(Digits _) -> True (Digits _) -> True
(Str _) -> False (Str _) -> False
) )
. fmap NE.toList
. NE.toList
$ (_vChunks v) $ (_vChunks v)
if startsWithDigists && not (isJust (_vEpoch v)) if startsWithDigists && not (isJust (_vEpoch v))
then pure $ prettyVer v then pure $ prettyVer v
else fail "Oh" else fail "Oh"
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP suffix = do
ver <- parseUntil suffix
if T.null ver
then fail "empty version"
else do
rest <- MP.getInput
MP.setInput ver
v <- versioning'
MP.setInput rest
pure v

View File

@@ -42,6 +42,8 @@ deriving instance Data SemVer
deriving instance Lift SemVer deriving instance Lift SemVer
deriving instance Data Mess deriving instance Data Mess
deriving instance Lift Mess deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP deriving instance Data PVP
deriving instance Lift PVP deriving instance Lift PVP
deriving instance Lift VSep deriving instance Lift VSep

View File

@@ -3,7 +3,7 @@
{-| {-|
Module : GHCup.Version Module : GHCup.Version
Description : Static version information Description : Version information and version handling.
Copyright : (c) Julian Ospald, 2020 Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0 License : LGPL-3.0
Maintainer : hasufell@hasufell.de Maintainer : hasufell@hasufell.de
@@ -13,6 +13,7 @@ Portability : POSIX
module GHCup.Version where module GHCup.Version where
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
import GHCup.Types
import Data.Versions import Data.Versions
import URI.ByteString import URI.ByteString
@@ -22,12 +23,25 @@ import qualified Data.Text as T
-- | This reflects the API version of the YAML. -- | This reflects the API version of the YAML.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.3.yaml|] ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.4.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: PVP ghcUpVer :: PVP
ghcUpVer = [pver|0.1.11|] ghcUpVer = [pver|0.1.12|]
-- | ghcup version as numeric string. -- | ghcup version as numeric string.
numericVer :: String numericVer :: String
numericVer = T.unpack . prettyPVP $ ghcUpVer numericVer = T.unpack . prettyPVP $ ghcUpVer
versionCmp :: Versioning -> VersionCmp -> Bool
versionCmp ver1 (VR_gt ver2) = ver1 > ver2
versionCmp ver1 (VR_gteq ver2) = ver1 >= ver2
versionCmp ver1 (VR_lt ver2) = ver1 < ver2
versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range

72
stack.yaml Normal file
View File

@@ -0,0 +1,72 @@
resolver: lts-16.17
packages:
- .
extra-deps:
- 3rdparty/lzma
- 3rdparty/lzma-clib
- 3rdparty/zlib
- git: https://github.com/haskus/packages.git
commit: 80a1c5fc07f7226c424250ec17f674cd4d618f42
subdirs:
- haskus-utils-types
- git: https://github.com/hasufell/hpath.git
commit: bf6d28cf989b70286e12fecc183d5bbf5454a1a2
subdirs:
- hpath-io
- hpath-directory
- git: https://github.com/hasufell/text-conversions.git
commit: 9abf0e5e5664a3178367597c32db19880477a53c
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base64-bytestring-1.1.0.0@sha256:190264fef9e65d9085f00ccda419137096d1dc94777c58272bc96821dc7f37c3,2334
- brick-0.55@sha256:f98736eca0cd694837062e06da4655eed969d53b789dfd919716e9b6f5b4c5ce,15858
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
- composition-prelude-3.0.0.0@sha256:7407835ce8c1e0e2fd6febd25391b12989b216773e685e3cf95bd89072af0ecc,1149
- haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466
- haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
- hpath-0.11.0@sha256:12b8405bee13d0007d644a888ef8407069ce7bbbd76970f8746b801447124ade,1440
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.2@sha256:eec4ff2b00dc86be847aca0f409fc8f6212ffd2170ec36a17dc9a52b46562392,1615
- http-io-streams-0.1.4.0@sha256:9a74a059daeddf7a41d361919190b9f4d4292f05e0e4bdf156e2098a116a8145,3582
- libarchive-3.0.0.0@sha256:e4157b307acf16cca0ec3d398ac5093cc06f092b33a9743be559ef0f6c6ae52f,11204
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
- primitive-unlifted-0.1.3.0@sha256:a98f827740f5dcf097d885b3a47c32f4462204449620abc9d51b8c4f8619f9e6,1427
- random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094
- splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- tar-bytestring-0.6.3.2@sha256:88f29bed56b688c543a4cb3986402d64b360f76b3fd9b88ac618b8344f8da712,5715
- versions-4.0.1@sha256:0f644c1587d38f0eb3c3fe364bf1822424db43cbd4d618d0e21473b062c45239,1936
- vty-5.30@sha256:4af3938d7b9e6096e222bf52d0ea5d39873bc6fe19febd34106906306af13730,20857
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
flags:
http-io-streams:
brotli: false
libarchive:
system-libarchive: false
ghcup:
tui: true
internal-downloader: true
system-ghc: true
compiler: ghc-8.8.4
compiler-check: match-exact
ghc-options:
"$locals": -O2
streamly: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
ghcup: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

View File

@@ -159,6 +159,18 @@ instance Arbitrary VersionInfo where
arbitrary = genericArbitrary arbitrary = genericArbitrary
shrink = genericShrink shrink = genericShrink
instance Arbitrary VersionRange where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (NonEmpty VersionCmp) where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionCmp where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (Path Rel) where instance Arbitrary (Path Rel) where
arbitrary = arbitrary =
(either (error . show) id . parseRel . E.encodeUtf8 . T.pack) (either (error . show) id . parseRel . E.encodeUtf8 . T.pack)

View File

@@ -32,7 +32,10 @@
<div id="platform-instructions-mac" class="instructions" style="display: none;"> <div id="platform-instructions-mac" class="instructions" style="display: none;">
<p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p> <p>Run the following in your terminal (as a user other than root), then follow the onscreen instructions.</p>
<p>On Intel:</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div> <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p>On Apple Silicon:</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p> <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.<br/>You appear to be running macOS. If not, <a class="default-platform-button" href="#">display all supported installers</a>.</p>
</div> </div>
@@ -101,9 +104,11 @@
<div id="platform-instructions-default" class="instructions"> <div id="platform-instructions-default" class="instructions">
<div> <div>
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following <p>To install Haskell, if you are running Linux, macOS (on Intel), FreeBSD or Windows Subsystem for Linux, run the following
in your terminal (as a user other than root), then follow the onscreen instructions.</p> in your terminal (as a user other than root), then follow the onscreen instructions.</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div> <div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p>For macOS on Apple Silicon, run this instead:</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p> <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
</div> </div>
@@ -146,9 +151,11 @@
<div id="platform-instructions-default" class="instructions"> <div id="platform-instructions-default" class="instructions">
<div> <div>
<p>To install Haskell, if you are running Linux, macOS, FreeBSD or Windows Subsystem for Linux, run the following <p>To install Haskell, if you are running Linux, macOS (on Intel), FreeBSD or Windows Subsystem for Linux, run the following
in your terminal (as a user other than root), then follow the onscreen instructions.</p> in your terminal (as a user other than root), then follow the onscreen instructions.</p>
<pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre> <pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span></pre>
<p>For macOS on Apple Silicon, run this instead:</p>
<div class="command-button"><pre><span class='ghcup-command'>curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | arch -x86_64 /bin/bash</span></pre><button class="tooltip" onclick="copyToClipboard()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p> <p class="other-help">If you don't like curl | sh, see <a href="https://gitlab.haskell.org/haskell/ghcup-hs#manual-install">other installation methods</a>.</p>
</div> </div>