Compare commits

...

145 Commits

Author SHA1 Message Date
43a97fa419 Code sign binaries after stripping wrt #318 2022-03-02 18:07:40 +01:00
7e359d7b3c Revert "Add darwin code signing wrt #322 and #318"
This reverts commit 8cc333d8d5.
2022-03-02 18:06:35 +01:00
8cc333d8d5 Add darwin code signing wrt #322 and #318 2022-03-02 13:53:45 +01:00
d67dafaf1b Skip binary stipping on mac due to code signing issues 2022-02-26 20:29:22 +01:00
8afabf3ffb Update guide wrt with_hls wrapper 2022-02-26 20:17:02 +01:00
ebf6c60a10 Fix changelog link 2022-02-26 19:11:49 +01:00
9a8291d391 Fix disable-upgrade flag description 2022-02-26 19:02:37 +01:00
a6426901c5 Update dev.md 2022-02-26 18:50:58 +01:00
3b7dd36aa6 Merge branch 'ghcup-0.1.17.5' 2022-02-26 18:49:26 +01:00
dc635a6601 Finalize release 2022-02-26 18:47:18 +01:00
08ec1bd923 Update release scripts 2022-02-26 18:06:41 +01:00
b78aab884e Prepare 0.1.17.5 release 2022-02-26 15:57:44 +01:00
36e192ec32 Refreeze 2022-02-26 15:57:43 +01:00
510675622b Prepare 0.1.17.5 release 2022-02-26 15:33:44 +01:00
651722b935 Fix all rtd links to stable 2022-02-25 16:06:05 +01:00
7a0d5a95c1 Update cabal rtd link 2022-02-25 13:50:10 +01:00
2c583bcae9 Fix NoAdjustCabalConfig on windows 2022-02-21 16:39:25 +01:00
ab36d4418e Update stackage to 18.25 2022-02-19 23:19:12 +01:00
f146c77797 Update CHANGELOG 2022-02-18 19:58:13 +01:00
d863ac570b Merge branch 'windows-fix-whitespace' 2022-02-13 21:17:37 +01:00
d05fad49a1 Fix installation with whitespaces in username, fixes #314 2022-02-13 21:11:48 +01:00
fbbc4497ca Merge remote-tracking branch 'origin/merge-requests/239' 2022-02-12 13:57:18 +01:00
4223586e62 Merge branch 'issue-137' 2022-02-12 11:46:41 +01:00
c859b3ee2b Exclude FreeBSD from 'ghcup run' test 2022-02-11 19:24:39 +01:00
8a16b0de7c Fix tests 2022-02-11 18:51:16 +01:00
9faf17634b Fix hlint and windows build 2022-02-10 21:49:19 +01:00
66a62c170c Fix 'ghcup run' for legacy HLS 2022-02-10 20:35:09 +01:00
5186d959bc Avoid metadata download when possible 2022-02-10 19:29:32 +01:00
09a8a0bda0 Fix build on windows and stack 2022-02-10 18:35:25 +01:00
191f49adfc Add 'ghcup run' test 2022-02-10 18:31:38 +01:00
MorrowM
26b79c5763 Update site description 2022-02-09 22:25:19 +00:00
c72841ca58 Implement 'ghcup run' 2022-02-09 18:57:59 +01:00
63350dab71 Fix recyclePathForcibly on windows 2022-02-06 22:56:22 +01:00
d110d20879 Fix HLS removal on windows 2022-02-06 22:25:23 +01:00
b4e58478c3 Fix error handling for HLS make 2022-02-06 22:24:52 +01:00
12d2acd7fd Bump version to 0.1.17.5 2022-02-06 20:54:16 +01:00
6073ebe476 Fix HLS support and compile errors with boot and TH files 2022-02-06 00:32:18 +01:00
5c026591cb Merge branch 'hls-dynamic-builds' 2022-02-05 21:25:21 +01:00
907365ddff Fix FreeBSD CI 2022-02-05 19:43:24 +01:00
684953464b Silence hlint 2022-02-05 19:39:00 +01:00
6b978b42bc Improve rmHLSNoGHC 2022-02-05 19:12:13 +01:00
6831337289 Refactoring and fixes 2022-02-05 19:11:56 +01:00
e40777a5d3 Resolve paths when using XDG dirs, fixes #311 2022-02-05 16:48:20 +01:00
51690d1df3 Support HLS dynamic builds 2022-02-05 16:33:05 +01:00
72a06e964c Update supported platform notes 2022-02-03 15:39:11 +01:00
9ffd402481 Add kowainik Haskell course to First steps 2022-02-03 15:21:41 +01:00
dee8d4bc09 Add symlink ftp script 2022-01-31 21:18:24 +01:00
6c57661797 Update docs wrt CI 2022-01-30 18:24:42 +01:00
b9ff7c5af4 Merge branch 'issue-291' 2022-01-30 18:22:55 +01:00
072161ada2 Don't fail to set ghc version if already installed
Fixes #291
2022-01-30 17:59:27 +01:00
a67b3e8a57 Merge branch 'improve-hls-compile-help' 2022-01-29 20:37:32 +01:00
c9216fb444 Improve help output of hls compile 2022-01-29 20:02:33 +01:00
2aac17ac5f Merge branch 'issue-305' 2022-01-28 23:47:36 +01:00
17a403b8ce Merge branch 'issue-307' 2022-01-28 23:20:16 +01:00
b245c11b1d Allow to disable self-upgrade functionality wrt #305 2022-01-28 23:08:35 +01:00
2ed047515e Merge remote-tracking branch 'origin/merge-requests/232' 2022-01-28 22:51:22 +01:00
b16e561384 Allow unpacking legacy lzma archives, fixes #307 2022-01-28 22:48:23 +01:00
Phil Ruffwind
2ebff1e887 Fix the indentation in env files
This changes the indentation from tabs to spaces, since tabs get
stripped by the heredoc.
2022-01-26 01:15:06 -08:00
655ee432f8 Merge remote-tracking branch 'origin/merge-requests/231' 2022-01-19 17:03:29 +01:00
67b7b2f292 Don't print to stdout during logging 2022-01-19 15:40:58 +01:00
66961101c6 Add documentation about mirrors, fixes #300 2022-01-19 13:04:00 +01:00
326af49a8f Merge remote-tracking branch 'origin/merge-requests/229' 2022-01-17 21:15:30 +01:00
3a7ed5ee2d Fix hlint warnings 2022-01-12 22:55:00 +01:00
56fa798406 Merge remote-tracking branch 'origin/merge-requests/230' 2022-01-12 22:34:46 +01:00
James Hobson
3fd9fae66a Changed to use IO Exceptions 2022-01-12 13:31:10 +01:00
James Hobson
5d43168370 Updated help message for ghcup compile ghc -h 2022-01-12 10:06:38 +01:00
James Hobson
f8548fefb3 Added support for quilt series files when patching 2022-01-12 10:01:48 +01:00
Phil Ruffwind
3565c32d51 Avoid adding duplicates to PATH
Without this, each time the env script gets executed it will add a copy
of the paths to PATH. This can happen when shells are nested.

The "case" trick was inspired by:
184a899f45/src/cli/self_update/env.sh
2022-01-08 00:34:16 -08:00
7fab328acc Document versions and tags better 2022-01-06 15:54:27 +08:00
a043b82b27 Fix docs 2021-12-06 20:00:41 +01:00
20652fed94 Fix comments in bootstrap-haskell.ps1 2021-12-06 20:00:17 +01:00
6fc52a4ec7 Merge branch 'freebsd1333' 2021-12-02 17:49:19 +01:00
834bcfa02c Use FreeBSD 13 in bootstrap script as well 2021-12-02 17:48:56 +01:00
c99ecc0a66 Fix FreeBSD 13 build 2021-12-02 17:48:33 +01:00
061e5dd832 Fix FreeBSD 13 build 2021-12-02 15:53:06 +01:00
c97ade81fa Revert "Fix arch detection on macos"
This reverts commit dbadcf1858.
2021-12-01 20:54:44 +01:00
82a22fe993 Merge branch 'darwin-arch' 2021-12-01 20:39:05 +01:00
dbadcf1858 Fix arch detection on macos 2021-12-01 20:27:03 +01:00
ff8865c5c3 Fix bootstrap on FreeBSD 2021-11-30 22:40:18 +01:00
9833dee925 Fix freebsd bootstrap 2021-11-30 21:35:33 +01:00
aac2874f8f Fix boostrap-haskell on FreeBSD 13 2021-11-30 19:00:33 +01:00
17524b21b3 Merge branch 'issue-289' 2021-11-22 23:18:52 +01:00
3f0befe30d Fix ghcup whereis ghc for non-standard versions, fixes #289 2021-11-22 22:53:59 +01:00
76c286f95e Use upstream terminal-size 2021-11-22 22:51:58 +01:00
0c415314b6 Bump GHC version in bootstrap-haskell 2021-11-16 20:11:32 +01:00
717f386077 Merge branch 'issue-285' 2021-11-14 17:52:08 +01:00
7a841a480b Run cabal update with --ignore-project, fixes #285 2021-11-14 17:49:59 +01:00
43ea85b495 Also fix redundant upgrade warnings for 'ghcup upgrade' 2021-11-14 16:24:13 +01:00
8a6badca1d Update changelog 2021-11-14 14:03:06 +01:00
4064803e23 Merge branch 'issue-283' 2021-11-14 00:23:07 +01:00
2e03b075f8 Avoid redundant warnings when installing tools, fixes #283 2021-11-13 22:59:52 +01:00
fe9c125bd6 Refreeze 2021-11-13 22:53:39 +01:00
503fd57d7c Merge branch 'issue-282' 2021-11-13 20:42:13 +01:00
e74e746213 Trim whitespaces wrt #282 2021-11-13 20:35:50 +01:00
065f9c4965 Fix compile HLS CI 2021-11-13 16:56:38 +01:00
32f3c36589 Set HOMEBREW_TEMP to something shorter
This fixes unix socket errors, because there's a max path length for
those.
2021-11-13 16:53:31 +01:00
c2a8d39fb4 Bump to 0.1.17.4 2021-11-12 20:52:08 +01:00
f08cbe70fb Merge branch 'issue-281' 2021-11-12 20:42:43 +01:00
a9630d0802 Cooler patching 2021-11-12 19:52:00 +01:00
c5c6c431b5 Allow remote URIs for --cabal-project-local wrt #281 2021-11-12 19:05:13 +01:00
71d78d2d72 Update cabal.project 2021-11-12 19:04:46 +01:00
ccecda2eff Merge branch 'dynamic-hls' 2021-11-12 17:57:15 +01:00
3a5f8d6139 Fix build on windows 2021-11-12 15:01:24 +01:00
74e0f39bc2 Fix stack.yaml 2021-11-12 01:28:40 +01:00
274978a8a7 Allow to pass cabal args to 'compile hls'
This breaks the existing cli interface, but whatever.
2021-11-12 01:13:57 +01:00
8eea9bd6a5 Prefer forM_ when possible 2021-11-12 01:04:27 +01:00
626a2dd020 More debug logging 2021-11-12 01:01:21 +01:00
6b6ce221e0 Use patched haskus-utils-variant, fixing applicative instance 2021-11-12 00:57:39 +01:00
d038c361c0 Revert "Fix HLS rebuilds"
This reverts commit 8e8198546f.
2021-11-11 21:40:02 +01:00
c05876cc60 Fix build with ghc-8.6.5 2021-11-02 19:53:22 +01:00
b9c4c9a0b7 Fix hlint 2021-11-02 10:57:27 +01:00
6697e804ee Merge branch 'fix-ghc-version-parser' 2021-11-02 10:56:21 +01:00
2c57def8f1 Fix parsing of atypical ghc versions 2021-11-02 01:22:06 +01:00
62b16e957b Merge branch 'issue-276' 2021-10-30 14:17:52 +02:00
18d7bdd85c Merge branch 'issue-278' 2021-10-30 14:17:11 +02:00
190b5dedba Allow to control the metadata cache, fixes #278 2021-10-30 14:16:45 +02:00
886e45f788 Update hie.yaml 2021-10-30 13:47:45 +02:00
360daf2a09 Make upgrading ghcup in TUI more pleasant 2021-10-30 12:54:05 +02:00
7bb67dd4c6 Merge branch 'ghcup-gen' 2021-10-27 15:55:51 +02:00
72c4ea70c4 Migrate ghcup-gen to haskell/ghcup-metadata 2021-10-27 15:33:39 +02:00
0ae42dd71e Refreeze 2021-10-27 14:47:49 +02:00
1df1e7eb98 Add links to metadata yaml files 2021-10-27 14:43:10 +02:00
9592021c48 Bump version in bootstrap script 2021-10-27 14:28:32 +02:00
9a9c3b340e Remove metadata from ghcup.cabal 2021-10-27 14:02:13 +02:00
abd64cb3fa Disable darwin M1 jobs by default 2021-10-27 13:58:10 +02:00
b366a50af1 Force Cabal 3.6.2.0 2021-10-27 13:13:35 +02:00
e4b9eeefc6 Update GHC/cabal on github CI 2021-10-27 12:18:12 +02:00
4d7a8557eb Fix yaml format 2021-10-27 12:09:07 +02:00
c23357df81 Only clone when necessary 2021-10-27 12:06:24 +02:00
f728d5aa23 Revert bootstrap-haskell 2021-10-27 12:04:53 +02:00
ac59563adf Release 0.1.17.3 2021-10-27 11:56:18 +02:00
b2d2996077 Merge branch 'fix-nix' 2021-10-27 11:48:28 +02:00
df2337abf9 Get rid of nix and use homebrew, fixes #274 2021-10-27 11:48:06 +02:00
d68ab3b657 Merge branch 'github-metadata' 2021-10-25 22:20:33 +02:00
c10821c332 Use github.com/haskell/ghcup-metadata 2021-10-25 21:47:42 +02:00
219cba5fc7 Fix arm-ness 2021-10-25 21:01:19 +02:00
8e3c74958a Update cabal constraint 2021-10-24 14:22:39 +02:00
ed08e0b166 Use aeson-pretty from hackage 2021-10-24 13:51:23 +02:00
168f2e6d16 Merge branch 'improve-config' 2021-10-22 09:35:46 +02:00
4574f3aa4f Switch to yaml-streamly 2021-10-21 23:39:07 +02:00
2a11e85a95 Allow to specify config value as JSON 2021-10-19 20:46:38 +02:00
69df100b18 Update module graphs 2021-10-17 21:17:14 +02:00
920b027a32 Merge branch 'reduce-win-cpp' 2021-10-17 21:16:59 +02:00
9f8c9c228d Reduce IS_WINDOWS CPP 2021-10-17 20:57:22 +02:00
9d8fdfe090 Merge branch 'refactor-main' 2021-10-17 19:46:20 +02:00
82 changed files with 3699 additions and 17060 deletions

View File

@@ -44,8 +44,8 @@ jobs:
- uses: haskell/actions/setup@v1.2 - uses: haskell/actions/setup@v1.2
with: with:
ghc-version: 8.10.4 ghc-version: 8.10.7
cabal-version: 3.4.0.0 cabal-version: 3.6.2.0
- name: create ~/.local/bin - name: create ~/.local/bin
run: mkdir -p "$HOME/.local/bin" run: mkdir -p "$HOME/.local/bin"

View File

@@ -11,6 +11,13 @@ variables:
# Commit of ghc/ci-images repository from which to pull Docker images # Commit of ghc/ci-images repository from which to pull Docker images
DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11 DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
CACHE_REV: 0
GIT_SUBMODULE_STRATEGY: recursive
############################################################ ############################################################
# CI Step # CI Step
############################################################ ############################################################
@@ -111,7 +118,7 @@ variables:
script: script:
- bash ./.gitlab/script/ghcup_version.sh - bash ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.6" JSON_VERSION: "0.0.7"
artifacts: artifacts:
expire_in: 2 week expire_in: 2 week
paths: paths:
@@ -164,26 +171,40 @@ variables:
- .test_ghcup_version - .test_ghcup_version
- .darwin:aarch64 - .darwin:aarch64
- .root_cleanup - .root_cleanup
cache:
key: darwin-brew-$CACHE_REV
paths:
- .brew
- .brew_cache
before_script:
# Install brew locally in the project dir. Packages will also be installed here.
- '[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew'
- export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# otherwise we seem to get intel binaries
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
# make sure to not pollute the machine with temp files etc
- mkdir -p $CI_PROJECT_DIR/.brew_cache
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
- mkdir -p $CI_PROJECT_DIR/.brew_logs
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
- mkdir -p /private/tmp/.brew_tmp
- export HOMEBREW_TEMP=/private/tmp/.brew_tmp
# update and install packages
- brew update
- brew install llvm
- brew install autoconf automake coreutils
script: | script: |
set -Eeuo pipefail export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
function runInNixShell() { export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \ export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \ export LD=ld
--argstr system "aarch64-darwin" \ export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
--pure \ export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
--keep CI_PROJECT_DIR \ ./.gitlab/before_script/darwin/install_deps.sh
--keep MACOSX_DEPLOYMENT_TARGET \ ./.gitlab/script/ghcup_version.sh
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
.test_ghcup_version:freebsd12: .test_ghcup_version:freebsd12:
extends: extends:
@@ -199,6 +220,9 @@ variables:
- .freebsd13 - .freebsd13
- .root_cleanup - .root_cleanup
before_script: before_script:
- sudo pkg update
- sudo pkg install --yes compat12x-amd64
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
.test_ghcup_version:windows: .test_ghcup_version:windows:
@@ -227,7 +251,7 @@ variables:
only: only:
- tags - tags
variables: variables:
JSON_VERSION: "0.0.6" JSON_VERSION: "0.0.7"
######## stack test ######## ######## stack test ########
@@ -388,6 +412,7 @@ test:mac:aarch64:
CABAL_VERSION: "3.6.2.0" CABAL_VERSION: "3.6.2.0"
needs: [] needs: []
allow_failure: true allow_failure: true
when: manual
######## freebsd test ######## ######## freebsd test ########
@@ -508,32 +533,47 @@ release:darwin:aarch64:
- .darwin:aarch64 - .darwin:aarch64
- .release_ghcup - .release_ghcup
- .root_cleanup - .root_cleanup
cache:
key: darwin-brew-$CACHE_REV
paths:
- .brew
- .brew_cache
before_script:
# Install brew locally in the project dir. Packages will also be installed here.
- '[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew'
- export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# otherwise we seem to get intel binaries
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
# make sure to not pollute the machine with temp files etc
- mkdir -p $CI_PROJECT_DIR/.brew_cache
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
- mkdir -p $CI_PROJECT_DIR/.brew_logs
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
- mkdir -p /private/tmp/.brew_tmp
- export HOMEBREW_TEMP=/private/tmp/.brew_tmp
# update and install packages
- brew update
- brew install llvm
- brew install autoconf automake
script: | script: |
set -Eeuo pipefail export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
function runInNixShell() { export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \ export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \ export LD=ld
--argstr system "aarch64-darwin" \ export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
--pure \ export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
--keep CI_PROJECT_DIR \ ./.gitlab/before_script/darwin/install_deps.sh
--keep MACOSX_DEPLOYMENT_TARGET \ ./.gitlab/script/ghcup_release.sh
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_release.sh 2>&1
variables: variables:
ARTIFACT: "aarch64-apple-darwin-ghcup" ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VERSION: "8.10.7" GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0" CABAL_VERSION: "3.6.2.0"
MACOSX_DEPLOYMENT_TARGET: "10.7" MACOSX_DEPLOYMENT_TARGET: "10.7"
allow_failure: true allow_failure: true
when: manual
######## freebsd release ######## ######## freebsd release ########
@@ -561,6 +601,9 @@ release:freebsd13:
- .release_ghcup - .release_ghcup
- .root_cleanup - .root_cleanup
before_script: before_script:
- sudo pkg update
- sudo pkg install --yes compat12x-amd64
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
- ./.gitlab/before_script/freebsd/install_deps.sh - ./.gitlab/before_script/freebsd/install_deps.sh
variables: variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup" ARTIFACT: "x86_64-portbld-freebsd-ghcup"

View File

@@ -12,4 +12,8 @@ if [ "${OS}" = "WINDOWS" ] ; then
rm -Rf /c/ghcup rm -Rf /c/ghcup
fi fi
if [ "${OS}" = "DARWIN" ] ; then
rm -Rf /private/tmp/.brew_tmp
fi
exit 0 exit 0

View File

@@ -8,7 +8,15 @@ set -eux
mkdir -p "${TMPDIR}" mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin if freebsd-version | grep -E '^12.*' ; then
freebsd_ver=12
elif freebsd-version | grep -E '^13.*' ; then
freebsd_ver=13
else
(>&2 echo "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues")
exit 1
fi
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-freebsd${freebsd_ver}-ghcup > ./ghcup-bin
chmod +x ghcup-bin chmod +x ghcup-bin
./ghcup-bin -v upgrade -i -f ./ghcup-bin -v upgrade -i -f

37
.gitlab/ghcup-run.files Normal file
View File

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

View File

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

View File

@@ -6,6 +6,6 @@ if [ "${OS}" = "WINDOWS" ] ; then
else else
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR" export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin" export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH" export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
export TMPDIR="$CI_PROJECT_DIR/tmp" export TMPDIR="$CI_PROJECT_DIR/tmp"
fi fi

View File

@@ -41,7 +41,7 @@ cabal --version
eghcup debug-info eghcup debug-info
eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION} eghcup compile hls -j $(nproc) -v ${HLS_TARGET_VERSION} --ghc ${GHC_VERSION}
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ] [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]

View File

@@ -37,6 +37,9 @@ binary=$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'c
ver=$("${binary}" --numeric-version) ver=$("${binary}" --numeric-version)
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
strip "${binary}" strip "${binary}"
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/318
codesign -s - -o linker-signed -i ghcup -v "${binary}"
:
else else
strip -s "${binary}" strip -s "${binary}"
fi fi

View File

@@ -83,7 +83,6 @@ else
ext='' ext=''
fi fi
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext} cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext}
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" "$CI_PROJECT_DIR"/.local/bin/ghcup-gen${ext}
### cleanup ### cleanup
@@ -92,12 +91,11 @@ rm -rf "${GHCUP_DIR}"
### manual cli based testing ### manual cli based testing
ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
eghcup --numeric-version eghcup --numeric-version
eghcup install ghc ${GHC_VERSION} eghcup install ghc ${GHC_VERSION}
[ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ] [ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
[ `eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version` = "${GHC_VERSION}" ]
eghcup set ghc ${GHC_VERSION} eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION} eghcup install cabal ${CABAL_VERSION}
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ] [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
@@ -105,6 +103,22 @@ eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit || echo yes "$GHCUP_BIN"/cabal --version && exit || echo yes
eghcup set cabal ${CABAL_VERSION} eghcup set cabal ${CABAL_VERSION}
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ] [ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
[ `eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version` = "${CABAL_VERSION}" ]
if [ "${OS}" != "FREEBSD" ] ; then
if [ "${ARCH}" = "64" ] ; then
eghcup run --ghc 8.10.7 --cabal 3.4.1.0 --hls 1.6.1.0 --stack 2.7.3 --install --bindir "$(pwd)/.bin"
if [ "${OS}" == "WINDOWS" ] ; then
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.windows" | sort)
else
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files" | sort)
fi
actual=$(cd ".bin" && find . | sort)
[ "${actual}" = "${expected}" ]
unset actual expected
rm -rf .bin
fi
fi
cabal --version cabal --version
@@ -134,7 +148,7 @@ else
eghcup --offline install ghc 8.10.3 eghcup --offline install ghc 8.10.3
if [ "${ARCH}" = "64" ] ; then if [ "${ARCH}" = "64" ] ; then
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort) expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort) actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
[ "${actual}" = "${expected}" ] [ "${actual}" = "${expected}" ]
unset actual expected unset actual expected
fi fi
@@ -142,7 +156,7 @@ else
eghcup prefetch ghc 8.10.3 eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3 eghcup --offline install ghc 8.10.3
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort) expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort) actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
[ "${actual}" = "${expected}" ] [ "${actual}" = "${expected}" ]
unset actual expected unset actual expected
else else
@@ -183,6 +197,8 @@ else
fi fi
fi fi
# check that lazy loading works for 'whereis' # check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"

View File

@@ -1,90 +0,0 @@
{ system ? "aarch64-darwin"
#, nixpkgs ? fetchTarball https://github.com/angerman/nixpkgs/archive/257cb120334.tar.gz #apple-silicon.tar.gz
, pkgs ? import <nixpkgs> { inherit system; }
, compiler ? if system == "aarch64-darwin" then "ghc8103Binary" else "ghc8103"
}: pkgs.mkShell {
# this prevents nix from trying to write the env-vars file.
# we can't really, as NIX_BUILD_TOP/env-vars is not set.
noDumpEnvVars=1;
# stop polluting LDFLAGS with -liconv
dontAddExtraLibs = true;
# we need to inject ncurses into --with-curses-libraries.
# the real fix is to teach terminfo to use libcurses on macOS.
# CONFIGURE_ARGS = "--with-intree-gmp --with-curses-libraries=${pkgs.ncurses.out}/lib";
CONFIGURE_ARGS = "--with-intree-gmp --with-curses-libraries=/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib --with-iconv-includes=/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include --with-iconv-libraries=/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib SH=/bin/bash";
# magic speedup pony :facepalm:
#
# nix has the ugly habbit of duplicating ld flags more than necessary. This
# somewhat consolidates this.
shellHook = ''
export NIX_LDFLAGS=$(for a in $NIX_LDFLAGS; do echo $a; done |sort|uniq|xargs)
export NIX_LDFLAGS_FOR_TARGET=$(for a in $NIX_LDFLAGS_FOR_TARGET; do echo $a; done |sort|uniq|xargs)
export NIX_LDFLAGS_FOR_TARGET=$(comm -3 <(for l in $NIX_LDFLAGS_FOR_TARGET; do echo $l; done) <(for l in $NIX_LDFLAGS; do echo $l; done))
# Impurity hack for GHC releases.
#################################
# We don't want binary releases to depend on nix, thus we'll need to make sure we don't leak in references.
# GHC externally depends only on iconv and curses. However we can't force a specific curses library for
# the terminfo package, as such we'll need to make sure we only look in the system path for the curses library
# and not pick up the tinfo from the nix provided ncurses package.
#
# We also need to force us to use the systems COREFOUNDATION, not the one that nix builds. Again this is impure,
# but it will allow us to have proper binary distributions.
#
# do not use nixpkgs provided core foundation
export NIX_COREFOUNDATION_RPATH=/System/Library/Frameworks
# drop curses from the LDFLAGS, we really want the system ones, not the nix ones.
export NIX_LDFLAGS=$(for lib in $NIX_LDFLAGS; do case "$lib" in *curses*);; *) echo -n "$lib ";; esac; done;)
export NIX_CFLAGS_COMPILE+=" -Wno-nullability-completeness -Wno-availability -Wno-expansion-to-defined -Wno-builtin-requires-header -Wno-unused-command-line-argument"
# unconditionally add the MacOSX.sdk and TargetConditional.h
export NIX_CFLAGS_COMPILE+=" -isystem /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include"
export NIX_LDFLAGS="-L/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib $NIX_LDFLAGS"
'';
nativeBuildInputs = (with pkgs; [
# This needs to come *before* ghc,
# otherwise we migth end up with the clang from
# the bootstrap GHC in PATH with higher priority.
clang_11
llvm_11
haskell.compiler.${compiler}
haskell.packages.${compiler}.cabal-install
haskell.packages.${compiler}.alex
haskell.packages.${compiler}.happy # _1_19_12 is needed for older GHCs.
automake
autoconf
m4
gmp
zlib.out
zlib.dev
glibcLocales
# locale doesn't build yet :-/
# locale
git
python3
# python3Full
# python3Packages.sphinx
perl
which
wget
curl
file
xz
xlibs.lndir
cacert ])
++ (with pkgs.darwin.apple_sdk.frameworks; [ Foundation Security ]);
}

4
.gitmodules vendored Normal file
View File

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

View File

@@ -1,5 +1,34 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.17.5 -- 2022-02-26
* Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)
* Support installation of dynamic HLS bindists wrt [HLS #2675](https://github.com/haskell/haskell-language-server/pull/2675) and [#237](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/237)
* Fix XDG support when `~/.local/bin` is a symlink wrt [#311](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/311)
* Add support for quilt-style patches wrt [#230](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/230), by James Hobson
* Fix redundant upgrade warnings in `ghcup upgrade`
* Fix `ghcup whereis ghc` for non-standard versions wrt [#289](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/289)
* Don't print logs to stdout, but stderr
* Allow unpacking legacy lzma archives wrt [#307](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/307)
* Allow to disable self-upgrade functionality wrt [#305](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/305)
* Fix `ghcup install ghc --set` when ghc is already installed wrt [#291](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/291)
## 0.1.17.4 -- 2021-11-13
* add `--metadata-caching` option, allowing to also disable yaml metadata caching wrt [#278](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/278)
* make upgrading ghcup in TUI more pleasant wrt [#276](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/276)
* fix parsing of atypical GHC versions (e.g. `8.10.5-patch1`)
* fix compiling HLS dynamically linked, also see [#245](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/245)
* redo (and break) some of the `ghcup compile <tool>` interface, improving patch options and setting custom cabal.project files
* avoid redundant update warnings wrt [#283](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283)
## 0.1.17.3 -- 2021-10-27
* clean up during unpack failures as well
* migrate te aeson-2.0.1.0
* switch to yaml-streamly to fix performance regression wrt [#270](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/270)
* use [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) for metadata file download (better caching)
## 0.1.17.2 -- 2021-09-30 ## 0.1.17.2 -- 2021-09-30
* Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250) * Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250)

View File

@@ -9,3 +9,5 @@
GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/). GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/).
Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions. Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions.
If you're looking for the metadata YAML files, see here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)

View File

@@ -1,154 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import GHCup.Types
import GHCup.Errors
import GHCup.Platform
import GHCup.Utils.Dirs
import GHCup.Utils.Logger
import GHCup.Types.JSON ( )
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.IO.Class
import Data.Char ( toLower )
import Data.Maybe
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) )
#endif
import Options.Applicative hiding ( style )
import Haskus.Utils.Variant.Excepts
import System.Console.Pretty
import System.Environment
import System.Exit
import System.IO ( stderr )
import Text.Regex.Posix
import Validate
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.YAML.Aeson as Y
data Options = Options
{ optCommand :: Command
}
data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts TarballFilter
data Input
= FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
| StdInput
fileInput :: Parser Input
fileInput =
FileInput
<$> strOption
(long "file" <> short 'f' <> metavar "FILENAME" <> help
"Input file to validate"
)
stdInput :: Parser Input
stdInput = flag'
StdInput
(short 'i' <> long "stdin" <> help "Validate from stdin (default)")
inputP :: Parser Input
inputP = fileInput <|> stdInput
data ValidateYAMLOpts = ValidateYAMLOpts
{ vInput :: Maybe Input
}
validateYAMLOpts :: Parser ValidateYAMLOpts
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 (Right 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 ] ->
pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
_ -> fail "invalid tool"
low = fmap toLower
opts :: Parser Options
opts = Options <$> com
com :: Parser Command
com = subparser
( command
"check"
( ValidateYAML
<$> info (validateYAMLOpts <**> helper)
(progDesc "Validate the YAML")
)
<> command
"check-tarballs"
(info
((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
)
)
main :: IO ()
main = do
no_color <- isJust <$> lookupEnv "NO_COLOR"
let loggerConfig = LoggerConfig { lcPrintDebug = True
, consoleOutter = T.hPutStr stderr
, fileOutter = \_ -> pure ()
, fancyColors = not no_color
}
dirs <- liftIO getAllDirs
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig
pfreq <- (
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
) >>= \case
VRight r -> pure r
VLeft e -> do
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
liftIO $ exitWith (ExitFailure 2)
let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of
ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
pure ()
where
withValidateYamlOpts vopts f = case vopts of
ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit f
ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit f
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit f
valAndExit f contents = do
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
Right r -> pure r
Left (_, e) -> die (color Red $ show e)
f av gt
>>= exitWith

View File

@@ -1,280 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Validate where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Version.QQ
import Codec.Archive
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader.Class
import Control.Monad.Trans.Class ( lift )
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.Trans.Resource ( runResourceT
, MonadUnliftIO
)
import Data.Containers.ListUtils ( nubOrd )
import Data.IORef
import Data.List
import Data.Versions
import Haskus.Utils.Variant.Excepts
import Optics
import System.FilePath
import System.Exit
import Text.ParserCombinators.ReadP
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Version as V
data ValidationError = InternalError String
deriving Show
instance Exception ValidationError
addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m ()
addError = do
ref <- ask
liftIO $ modifyIORef ref (+ 1)
validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m)
=> GHCupDownloads
-> M.Map GlobalTool DownloadInfo
-> m ExitCode
validate dls _ = do
ref <- liftIO $ newIORef 0
-- verify binary downloads --
flip runReaderT ref $ do
-- unique tags
forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t
-- required platforms
forM_ (M.toList dls) $ \(t, versions) ->
forM_ (M.toList versions) $ \(v, vi) ->
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v (_viTags vi) arch (M.keys pspecs)
checkGHCVerIsValid
forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
_ <- checkGHCHasBaseVersion
-- exit
e <- liftIO $ readIORef ref
if e > 0
then pure $ ExitFailure e
else do
lift $ logInfo "All good"
pure ExitSuccess
where
checkHasRequiredPlatforms t v tags arch pspecs = do
let v' = prettyVer v
arch' = prettyShow arch
when (Linux UnknownLinux `notElem` pspecs) $ do
lift $ logError $
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
when ((Darwin `notElem` pspecs) && arch == A_64) $ do
lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
when ((FreeBSD `notElem` pspecs) && arch == A_64) $ lift $ logWarn $
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
when (Windows `notElem` pspecs && arch == A_64) $ do
lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
-- alpine needs to be set explicitly, because
-- we cannot assume that "Linux UnknownLinux" runs on Alpine
-- (although it could be static)
when (Linux Alpine `notElem` pspecs) $
case t of
GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
Cabal | v > [vver|2.4.1.0|]
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
GHC | Latest `elem` tags || Recommended `elem` tags
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
_ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
checkUniqueTags tool = do
let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)
<$> ( mapM
(\case
[] -> throwM $ InternalError "empty inner list"
(t : ts) ->
pure $ (t, ) (not (isUniqueTag t) || null ts)
)
. group
. sort
$ allTags
)
case join nonUnique of
[] -> pure ()
xs -> do
lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
addError
where
isUniqueTag Latest = True
isUniqueTag Recommended = True
isUniqueTag Old = False
isUniqueTag Prerelease = False
isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False
checkGHCVerIsValid = do
let ghcVers = toListOf (ix GHC % to M.keys % folded) dls
forM_ ghcVers $ \v ->
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
[_] -> pure ()
_ -> do
lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
addError
-- a tool must have at least one of each mandatory tags
checkMandatoryTags tool = do
let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
forM_ [Latest, Recommended] $ \t -> case t `elem` allTags of
False -> do
lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
addError
True -> pure ()
-- all GHC versions must have a base tag
checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
False -> do
lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
addError
True -> pure ()
isBase (Base _) = True
isBase _ = False
data TarballFilter = TarballFilter
{ tfTool :: Either GlobalTool (Maybe Tool)
, tfVersion :: Regex
}
validateTarballs :: ( Monad m
, MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadThrow m
, MonadIO m
, MonadUnliftIO m
, MonadMask m
, Alternative m
, MonadFail m
)
=> TarballFilter
-> GHCupDownloads
-> M.Map GlobalTool DownloadInfo
-> m ExitCode
validateTarballs (TarballFilter etool versionRegex) dls gt = do
ref <- liftIO $ newIORef 0
-- download/verify all tarballs
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
let gdlis = nubOrd $ gt ^.. each
let allDls = either (const gdlis) (const dlis) etool
when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref
forM_ allDls (downloadAll ref)
-- exit
e <- liftIO $ readIORef ref
if e > 0
then pure $ ExitFailure e
else do
logInfo "All good"
pure ExitSuccess
where
downloadAll :: ( MonadUnliftIO m
, MonadIO m
, MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadCatch m
, MonadMask m
, MonadThrow m
)
=> IORef Int
-> DownloadInfo
-> m ()
downloadAll ref dli = do
r <- runResourceT
. runE @'[DigestError
, GPGError
, DownloadFailed
, UnknownArchive
, ArchiveResult
]
$ do
case etool of
Right (Just GHCup) -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
Right _ -> do
p <- liftE $ downloadCached dli Nothing
fmap (Just . head . splitDirectories . head)
. liftE
. getArchiveFiles
$ p
Left ShimGen -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
case r of
VRight (Just basePath) -> do
case _dlSubdir dli of
Just (RealDir prel) -> do
logInfo
$ " verifying subdir: " <> T.pack prel
when (basePath /= prel) $ do
logError $
"Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
runReaderT addError ref
Just (RegexDir regexString) -> do
logInfo $
"verifying subdir (regex): " <> T.pack regexString
let regex = makeRegexOpts
compIgnoreCase
execBlank
regexString
unless (match regex basePath) $ do
logError $
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
runReaderT addError ref
Nothing -> pure ()
VRight Nothing -> pure ()
VLeft e -> do
logError $
"Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
runReaderT addError ref

View File

@@ -10,6 +10,7 @@ module BrickMain where
import GHCup import GHCup
import GHCup.Download import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics ( getDirs )
import GHCup.Types hiding ( LeanAppState(..) ) import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Logger import GHCup.Utils.Logger
@@ -26,6 +27,9 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
) )
import Codec.Archive import Codec.Archive
import Control.Exception.Safe import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
@@ -40,6 +44,8 @@ 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.Directory ( canonicalizePath )
import System.FilePath
import System.Exit import System.Exit
import System.IO.Unsafe import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -48,6 +54,8 @@ import URI.ByteString
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
import System.Environment (getExecutablePath)
import qualified System.Posix.Process as SPP
hiddenTools :: [Tool] hiddenTools :: [Tool]
@@ -432,27 +440,42 @@ install' _ (_, ListResult {..}) = do
] ]
run (do run (do
ce <- liftIO $ fmap (either (const Nothing) Just) $
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
dirs <- lift getDirs
case lTool of case lTool of
GHC -> do GHC -> do
let vi = getVersionInfo lVer GHC dls let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer Nothing False $> vi liftE $ installGHCBin lVer Nothing False $> (vi, dirs, ce)
Cabal -> do Cabal -> do
let vi = getVersionInfo lVer Cabal dls let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer Nothing False $> vi liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce)
HLS -> do HLS -> do
let vi = getVersionInfo lVer HLS dls let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer Nothing False $> vi liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)
Stack -> do Stack -> do
let vi = getVersionInfo lVer Stack dls let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer Nothing False $> vi liftE $ installStackBin lVer Nothing False $> (vi, dirs, ce)
) )
>>= \case >>= \case
VRight vi -> do VRight (vi, Dirs{..}, Just ce) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo msg case lTool of
GHCup -> do
up <- liftIO $ fmap (either (const Nothing) Just)
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
when ((normalise <$> up) == Just (normalise ce)) $
-- TODO: track cli arguments of previous invocation
liftIO $ SPP.executeFile ce False ["tui"] Nothing
logInfo "Please restart 'ghcup' for the changes to take effect"
_ -> pure ()
pure $ Right ()
VRight (vi, _, _) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo "Please restart 'ghcup' for the changes to take effect"
pure $ Right () pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right () VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right () VLeft (V NoUpdate) -> pure $ Right ()
@@ -470,9 +493,9 @@ set' _ (_, ListResult {..}) = do
run (do run (do
case lTool of case lTool of
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> () GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
Cabal -> liftE $ setCabal lVer $> () Cabal -> liftE $ setCabal lVer $> ()
HLS -> liftE $ setHLS lVer $> () HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
Stack -> liftE $ setStack lVer $> () Stack -> liftE $ setStack lVer $> ()
GHCup -> pure () GHCup -> pure ()
) )
@@ -536,17 +559,7 @@ settings' = unsafePerformIO $ do
, fileOutter = \_ -> pure () , fileOutter = \_ -> pure ()
, fancyColors = True , fancyColors = True
} }
newIORef $ AppState (Settings { cache = True newIORef $ AppState defaultSettings
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, noNetwork = False
, gpgSetting = GPGNone
, noColor = False
, ..
})
dirs dirs
defaultKeyBindings defaultKeyBindings
(GHCupInfo mempty mempty mempty) (GHCupInfo mempty mempty mempty)
@@ -605,4 +618,3 @@ getAppData mgi = runExceptT $ do
flip runReaderT settings $ do flip runReaderT settings $ do
lV <- listVersions Nothing Nothing lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV) pure $ BrickData (reverse lV)

View File

@@ -15,13 +15,16 @@ module GHCup.OptParse (
, module GHCup.OptParse.Config , module GHCup.OptParse.Config
, module GHCup.OptParse.Whereis , module GHCup.OptParse.Whereis
, module GHCup.OptParse.List , module GHCup.OptParse.List
#ifndef DISABLE_UPGRADE
, module GHCup.OptParse.Upgrade , module GHCup.OptParse.Upgrade
#endif
, module GHCup.OptParse.ChangeLog , module GHCup.OptParse.ChangeLog
, module GHCup.OptParse.Prefetch , module GHCup.OptParse.Prefetch
, module GHCup.OptParse.GC , module GHCup.OptParse.GC
, module GHCup.OptParse.DInfo , module GHCup.OptParse.DInfo
, module GHCup.OptParse.Nuke , module GHCup.OptParse.Nuke
, module GHCup.OptParse.ToolRequirements , module GHCup.OptParse.ToolRequirements
, module GHCup.OptParse.Run
, module GHCup.OptParse , module GHCup.OptParse
) where ) where
@@ -31,11 +34,14 @@ import GHCup.OptParse.Install
import GHCup.OptParse.Set import GHCup.OptParse.Set
import GHCup.OptParse.UnSet import GHCup.OptParse.UnSet
import GHCup.OptParse.Rm import GHCup.OptParse.Rm
import GHCup.OptParse.Run
import GHCup.OptParse.Compile import GHCup.OptParse.Compile
import GHCup.OptParse.Config import GHCup.OptParse.Config
import GHCup.OptParse.Whereis import GHCup.OptParse.Whereis
import GHCup.OptParse.List import GHCup.OptParse.List
#ifndef DISABLE_UPGRADE
import GHCup.OptParse.Upgrade import GHCup.OptParse.Upgrade
#endif
import GHCup.OptParse.ChangeLog import GHCup.OptParse.ChangeLog
import GHCup.OptParse.Prefetch import GHCup.OptParse.Prefetch
import GHCup.OptParse.GC import GHCup.OptParse.GC
@@ -67,6 +73,7 @@ data Options = Options
-- global options -- global options
optVerbose :: Maybe Bool optVerbose :: Maybe Bool
, optCache :: Maybe Bool , optCache :: Maybe Bool
, optMetaCache :: Maybe Integer
, optUrlSource :: Maybe URI , optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool , optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs , optKeepDirs :: Maybe KeepDirs
@@ -88,7 +95,9 @@ data Command
| Compile CompileCommand | Compile CompileCommand
| Config ConfigCommand | Config ConfigCommand
| Whereis WhereisOptions WhereisCommand | Whereis WhereisOptions WhereisCommand
#ifndef DISABLE_UPGRADE
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool
#endif
| ToolRequirements | ToolRequirements
| ChangeLog ChangeLogOptions | ChangeLog ChangeLogOptions
| Nuke | Nuke
@@ -97,6 +106,7 @@ data Command
#endif #endif
| Prefetch PrefetchCommand | Prefetch PrefetchCommand
| GC GCOptions | GC GCOptions
| Run RunOptions
@@ -105,6 +115,7 @@ opts =
Options Options
<$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)") <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
<*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)") <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
<*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
<*> optional <*> optional
(option (option
(eitherReader parseUri) (eitherReader parseUri)
@@ -206,6 +217,7 @@ com =
(info (List <$> listOpts <**> helper) (info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools") (progDesc "Show available GHCs and other tools")
) )
#ifndef DISABLE_UPGRADE
<> command <> command
"upgrade" "upgrade"
(info (info
@@ -216,6 +228,7 @@ com =
) )
(progDesc "Upgrade ghcup") (progDesc "Upgrade ghcup")
) )
#endif
<> command <> command
"compile" "compile"
( Compile ( Compile
@@ -253,6 +266,16 @@ com =
(progDesc "Garbage collection" (progDesc "Garbage collection"
<> footerDoc ( Just $ text gcFooter )) <> footerDoc ( Just $ text gcFooter ))
) )
<> command
"run"
(Run
<$>
info
(runOpts <**> helper)
(progDesc "Run a command with the given tool in PATH"
<> footerDoc ( Just $ text runFooter )
)
)
<> commandGroup "Main commands:" <> commandGroup "Main commands:"
) )
<|> subparser <|> subparser

View File

@@ -196,8 +196,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
] ]
bindistParser :: String -> Either String URI uriParser :: String -> Either String URI
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
absolutePathParser :: FilePath -> Either String FilePath absolutePathParser :: FilePath -> Either String FilePath
@@ -246,18 +246,6 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
where t = T.toLower (T.pack s') where t = T.toLower (T.pack s')
toolVersionParser :: Parser ToolVersion
toolVersionParser = verP' <|> toolP
where
verP' = ToolVersion <$> versionParser
toolP =
ToolTag
<$> option
(eitherReader tagEither)
(short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
keepOnParser :: String -> Either String KeepDirs keepOnParser :: String -> Either String KeepDirs
keepOnParser s' | t == T.pack "always" = Right Always keepOnParser s' | t == T.pack "always" = Right Always
@@ -299,7 +287,7 @@ tagCompleter tool add = listIOCompleter $ do
, fancyColors = False , fancyColors = False
} }
let appState = LeanAppState let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True GPGNone False) (defaultSettings { noNetwork = True })
dirs' dirs'
defaultKeyBindings defaultKeyBindings
loggerConfig loggerConfig
@@ -322,7 +310,7 @@ versionCompleter criteria tool = listIOCompleter $ do
, fileOutter = mempty , fileOutter = mempty
, fancyColors = False , fancyColors = False
} }
let settings = Settings True False Never Curl False GHCupURL True GPGNone False let settings = defaultSettings { noNetwork = True }
let leanAppState = LeanAppState let leanAppState = LeanAppState
settings settings
dirs' dirs'
@@ -399,7 +387,7 @@ fromVersion' (SetToolVersion v) tool = do
Right pvpIn -> Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do Just (pvp_, vi') -> do
v' <- lift $ pvpToVersion pvp_ v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v') when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion (_tvTarget v) v', Just vi') pure (GHCTargetVersion (_tvTarget v) v', Just vi')
Nothing -> pure (v, vi) Nothing -> pure (v, vi)
@@ -472,42 +460,22 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
=> m () => m [(Tool, Version)]
checkForUpdates = do checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled) lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
forM_ (getLatest dls GHCup) $ \(l, _) -> do ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver) if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
$ logWarn $
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
forM_ (getLatest dls GHC) $ \(l, _) -> do otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
let mghc_ver = latestInstalled GHC forMM (getLatest dls t) $ \(l, _) -> do
forM mghc_ver $ \ghc_ver -> let mver = latestInstalled t
when (l > ghc_ver) forMM mver $ \ver ->
$ logWarn $ if (l > ver) then pure $ Just (t, l) else pure Nothing
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
forM_ (getLatest dls Cabal) $ \(l, _) -> do pure $ catMaybes (ghcup:otherTools)
let mcabal_ver = latestInstalled Cabal where
forM mcabal_ver $ \cabal_ver -> forMM a f = fmap join $ forM a f
when (l > cabal_ver)
$ logWarn $
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
forM_ (getLatest dls HLS) $ \(l, _) -> do
let mhls_ver = latestInstalled HLS
forM mhls_ver $ \hls_ver ->
when (l > hls_ver)
$ logWarn $
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
forM_ (getLatest dls Stack) $ \(l, _) -> do
let mstack_ver = latestInstalled Stack
forM mstack_ver $ \stack_ver ->
when (l > stack_ver)
$ logWarn $
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"

View File

@@ -40,6 +40,7 @@ import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import System.FilePath (isPathSeparator) import System.FilePath (isPathSeparator)
@@ -68,7 +69,7 @@ data GHCCompileOptions = GHCCompileOptions
, bootstrapGhc :: Either Version FilePath , bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe FilePath , buildConfig :: Maybe FilePath
, patchDir :: Maybe FilePath , patches :: Maybe (Either FilePath [URI])
, crossTarget :: Maybe Text , crossTarget :: Maybe Text
, addConfArgs :: [Text] , addConfArgs :: [Text]
, setCompile :: Bool , setCompile :: Bool
@@ -84,10 +85,11 @@ data HLSCompileOptions = HLSCompileOptions
, setCompile :: Bool , setCompile :: Bool
, ovewrwiteVer :: Maybe Version , ovewrwiteVer :: Maybe Version
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
, cabalProject :: Maybe FilePath , cabalProject :: Maybe (Either FilePath URI)
, cabalProjectLocal :: Maybe FilePath , cabalProjectLocal :: Maybe URI
, patchDir :: Maybe FilePath , patches :: Maybe (Either FilePath [URI])
, targetGHCs :: [ToolVersion] , targetGHCs :: [ToolVersion]
, cabalArgs :: [Text]
} }
@@ -148,7 +150,10 @@ Examples:
These need to be available in PATH prior to compilation. These need to be available in PATH prior to compilation.
Examples: Examples:
ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|] # compile 1.4.0 for ghc 8.10.5 and 8.10.7
ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
# compile from master for ghc 8.10.7, linking everything dynamically
ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts :: Parser GHCCompileOptions
@@ -195,13 +200,23 @@ ghcCompileOpts =
"Absolute path to build config file" "Absolute path to build config file"
) )
) )
<*> optional <*> (optional
(option (
str (fmap Right $ many $ option
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (eitherReader uriParser)
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)"
)
)
<|>
(fmap Left $ option
str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
)
) )
) )
)
<*> optional <*> optional
(option (option
str str
@@ -296,26 +311,42 @@ hlsCompileOpts =
) )
<*> optional <*> optional
(option (option
str ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
"If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over." "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
) )
) )
<*> optional <*> optional
(option (option
(eitherReader absolutePathParser) (eitherReader uriParser)
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
"Absolute path to a cabal.project.local to be used for the build. Will be copied over." "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
) )
) )
<*> optional <*> (optional
(option (
(eitherReader absolutePathParser) (fmap Right $ many $ option
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help (eitherReader uriParser)
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)" (long "patch" <> metavar "PATCH_URI" <> help
"URI to a patch (https/http/file)"
)
)
<|>
(fmap Left $ option
str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
)
) )
) )
<*> some (toolVersionArgument Nothing (Just GHC)) )
<*> some (
option (eitherReader toolVersionEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC [])
<> completer (versionCompleter Nothing GHC))
)
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@@ -403,11 +434,11 @@ compile :: ( Monad m
) )
=> CompileCommand => CompileCommand
-> Settings -> Settings
-> Dirs
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a)) -> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
compile compileCommand settings runAppState runLogger = do compile compileCommand settings Dirs{..} runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
case compileCommand of case compileCommand of
(CompileHLS HLSCompileOptions { .. }) -> do (CompileHLS HLSCompileOptions { .. }) -> do
runCompileHLS runAppState (do runCompileHLS runAppState (do
@@ -430,11 +461,12 @@ compile compileCommand settings runAppState runLogger = do
isolateDir isolateDir
cabalProject cabalProject
cabalProjectLocal cabalProjectLocal
patchDir patches
cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls let vi = getVersionInfo targetVer HLS dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setHLS targetVer setHLS targetVer SetHLSOnly Nothing
pure (vi, targetVer) pure (vi, targetVer)
) )
>>= \case >>= \case
@@ -477,7 +509,7 @@ compile compileCommand settings runAppState runLogger = do
bootstrapGhc bootstrapGhc
jobs jobs
buildConfig buildConfig
patchDir patches
addConfArgs addConfArgs
buildFlavour buildFlavour
hadrian hadrian
@@ -485,7 +517,7 @@ compile compileCommand settings runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly setGHC targetVer SetGHCOnly Nothing
pure (vi, targetVer) pure (vi, targetVer)
) )
>>= \case >>= \case

View File

@@ -21,19 +21,20 @@ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
#endif #endif
import Control.Exception ( displayException )
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Bifunctor
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.YAML.Aeson as Y import qualified Data.Yaml.Aeson as Y
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -46,7 +47,7 @@ import Control.Exception.Safe (MonadMask)
data ConfigCommand data ConfigCommand
= ShowConfig = ShowConfig
| SetConfig String String | SetConfig String (Maybe String)
| InitConfig | InitConfig
@@ -67,8 +68,8 @@ configP = subparser
where where
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml") initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
showP = info (pure ShowConfig) (progDesc "Show current config (default)") showP = info (pure ShowConfig) (progDesc "Show current config (default)")
setP = info argsP (progDesc "Set config KEY to VALUE") setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
argsP = SetConfig <$> argument str (metavar "KEY") <*> argument str (metavar "VALUE") argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
@@ -88,7 +89,19 @@ configFooter = [s|Examples:
ghcup config init ghcup config init
# set <key> <value> configuration pair # set <key> <value> configuration pair
ghcup config <key> <value>|] ghcup config set <key> <value>|]
configSetFooter :: String
configSetFooter = [s|Examples:
# disable caching
ghcup config set cache false
# switch downloader to wget
ghcup config set downloader Wget
# set mirror for ghcup metadata
ghcup config set '{url-source: { OwnSource: "<url>"}}'|]
@@ -98,17 +111,18 @@ configFooter = [s|Examples:
formatConfig :: UserSettings -> String formatConfig :: UserSettings -> String
formatConfig = UTF8.toString . Y.encode1Strict formatConfig = UTF8.toString . Y.encode
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
updateSettings config' settings = do updateSettings config' settings = do
settings' <- lE' JSONDecodeError . first snd . Y.decode1Strict $ config' settings' <- lE' (JSONDecodeError . displayException) . Y.decodeEither' $ config'
pure $ mergeConf settings' settings pure $ mergeConf settings' settings
where where
mergeConf :: UserSettings -> Settings -> Settings mergeConf :: UserSettings -> Settings -> Settings
mergeConf UserSettings{..} Settings{..} = mergeConf UserSettings{..} Settings{..} =
let cache' = fromMaybe cache uCache let cache' = fromMaybe cache uCache
metaCache' = fromMaybe metaCache uMetaCache
noVerify' = fromMaybe noVerify uNoVerify noVerify' = fromMaybe noVerify uNoVerify
keepDirs' = fromMaybe keepDirs uKeepDirs keepDirs' = fromMaybe keepDirs uKeepDirs
downloader' = fromMaybe downloader uDownloader downloader' = fromMaybe downloader uDownloader
@@ -116,7 +130,7 @@ updateSettings config' settings = do
urlSource' = fromMaybe urlSource uUrlSource urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting gpgSetting' = fromMaybe gpgSetting uGPGSetting
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
@@ -147,22 +161,27 @@ config configCommand settings keybindings runLogger = case configCommand of
liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings) liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
pure ExitSuccess pure ExitSuccess
(SetConfig k v) -> do (SetConfig k (Just v)) ->
case v of case v of
"" -> do "" -> do
runLogger $ logError "Empty values are not allowed" runLogger $ logError "Empty values are not allowed"
pure $ ExitFailure 55 pure $ ExitFailure 55
_ -> do _ -> doConfig (k <> ": " <> v <> "\n")
r <- runE @'[JSONError] $ do
settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
lift $ runLogger $ logDebug $ T.pack $ show settings'
pure ()
case r of (SetConfig json Nothing) -> doConfig json
VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do where
runLogger $ logError $ "Error decoding config: " <> T.pack e doConfig val = do
pure $ ExitFailure 65 r <- runE @'[JSONError] $ do
VLeft _ -> pure $ ExitFailure 65 settings' <- updateSettings (UTF8.fromString val) settings
path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
lift $ runLogger $ logDebug $ T.pack $ show settings'
pure ()
case r of
VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do
runLogger $ logError $ "Error decoding config: " <> T.pack e
pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65

View File

@@ -51,7 +51,7 @@ describe_result = $( LitE . StringL <$>
runIO (do runIO (do
CapturedProcess{..} <- do CapturedProcess{..} <- do
dirs <- liftIO getAllDirs dirs <- liftIO getAllDirs
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False) let settings = AppState (defaultSettings { noNetwork = True })
dirs dirs
defaultKeyBindings defaultKeyBindings
flip runReaderT settings $ executeOut "git" ["describe"] Nothing flip runReaderT settings $ executeOut "git" ["describe"] Nothing

View File

@@ -132,7 +132,7 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
when gcOldGHC rmOldGHC when gcOldGHC rmOldGHC
lift $ when gcProfilingLibs rmProfilingLibs lift $ when gcProfilingLibs rmProfilingLibs
lift $ when gcShareDir rmShareDir lift $ when gcShareDir rmShareDir
lift $ when gcHLSNoGHC rmHLSNoGHC liftE $ when gcHLSNoGHC rmHLSNoGHC
lift $ when gcCache rmCache lift $ when gcCache rmCache
lift $ when gcTmp rmTmp lift $ when gcTmp rmTmp
) >>= \case ) >>= \case

View File

@@ -17,7 +17,6 @@ import GHCup.OptParse.Common
import GHCup import GHCup
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Utils.File
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
@@ -37,7 +36,7 @@ import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T import qualified Data.Text as T
@@ -187,7 +186,7 @@ installOpts tool =
<*> ( ( (,) <*> ( ( (,)
<$> optional <$> optional
(option (option
(eitherReader bindistParser) (eitherReader uriParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist" "Install the specified version from this bindist"
) )
@@ -268,6 +267,64 @@ runInstTool appstate' mInstPlatform =
@InstallEffects @InstallEffects
type InstallGHCEffects = '[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
, BuildFailed
, DirNotEmpty
, AlreadyInstalled
, (AlreadyInstalled, NotInstalled)
, (UnknownArchive, NotInstalled)
, (ArchiveResult, NotInstalled)
, (FileDoesNotExistError, NotInstalled)
, (CopyError, NotInstalled)
, (NotInstalled, NotInstalled)
, (DirNotEmpty, NotInstalled)
, (NoDownload, NotInstalled)
, (BuildFailed, NotInstalled)
, (TagNotFound, NotInstalled)
, (DigestError, NotInstalled)
, (GPGError, NotInstalled)
, (DownloadFailed, NotInstalled)
, (TarDirDoesNotExist, NotInstalled)
, (NextVerNotFound, NotInstalled)
, (NoToolVersionSet, NotInstalled)
, (FileAlreadyExistsError, NotInstalled)
, (ProcessError, NotInstalled)
, (AlreadyInstalled, ())
, (UnknownArchive, ())
, (ArchiveResult, ())
, (FileDoesNotExistError, ())
, (CopyError, ())
, (NotInstalled, ())
, (DirNotEmpty, ())
, (NoDownload, ())
, (BuildFailed, ())
, (TagNotFound, ())
, (DigestError, ())
, (GPGError, ())
, (DownloadFailed, ())
, (TarDirDoesNotExist, ())
, (NextVerNotFound, ())
, (NoToolVersionSet, ())
, (FileAlreadyExistsError, ())
, (ProcessError, ())
, ((), NotInstalled)
]
runInstGHC :: AppState
-> Maybe PlatformRequest
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
runInstGHC appstate' mInstPlatform =
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. runResourceT
. runE
@InstallGHCEffects
------------------- -------------------
--[ Entrypoints ]-- --[ Entrypoints ]--
@@ -288,23 +345,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
installGHC InstallOptions{..} = do installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState' s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of (case instBindist of
Nothing -> runInstTool s' instPlatform $ do Nothing -> runInstGHC s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBin void $ liftE $ sequenceE (installGHCBin
(_tvVersion v)
isolateDir
forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
Just uri -> do
runInstTool s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly )
$ when instSet $ void $ setGHC v SetGHCOnly Nothing
pure vi
Just uri -> do
runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
void $ liftE $ sequenceE (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
isolateDir
forceInstall
)
$ when instSet $ void $ setGHC v SetGHCOnly Nothing
pure vi pure vi
) )
>>= \case >>= \case
@@ -313,14 +372,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V (AlreadyInstalled _ v, ())) -> do
runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'" "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logWarn $ runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless." "Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft (V (DirNotEmpty fp, ())) -> do
runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyShow err) Never -> runLogger (logError $ T.pack $ prettyShow err)
@@ -328,6 +398,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <> "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.") "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3 pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _, ())) -> do
case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyShow err)
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3
VLeft e -> do VLeft e -> do
runLogger $ do runLogger $ do
logError $ T.pack $ prettyShow e logError $ T.pack $ prettyShow e
@@ -390,8 +468,9 @@ install installCommand settings getAppState' runLogger = case installCommand of
Just uri -> do Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS (v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy
liftE $ installHLSBindist liftE $ installHLSBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall forceInstall

View File

@@ -11,6 +11,7 @@ module GHCup.OptParse.List where
import GHCup import GHCup
import GHCup.Utils.Prelude
import GHCup.Types import GHCup.Types
import GHCup.OptParse.Common import GHCup.OptParse.Common
@@ -115,15 +116,9 @@ printListResult no_color raw lr = do
. fmap . fmap
(\ListResult {..} -> (\ListResult {..} ->
let marks = if let marks = if
#if defined(IS_WINDOWS) | lSet -> (color Green (if isWindows then "IS" else "✔✔"))
| lSet -> (color Green "IS") | lInstalled -> (color Green (if isWindows then "I " else ""))
| lInstalled -> (color Green "I ") | otherwise -> (color Red (if isWindows then "X " else " "))
| otherwise -> (color Red "X ")
#else
| lSet -> (color Green "✔✔")
| lInstalled -> (color Green "")
| otherwise -> (color Red "")
#endif
in in
(if raw then [] else [marks]) (if raw then [] else [marks])
++ [ fmap toLower . show $ lTool ++ [ fmap toLower . show $ lTool

View File

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

View File

@@ -271,10 +271,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
-> m ExitCode -> m ExitCode
setGHC' SetOptions{ sToolVer } = setGHC' SetOptions{ sToolVer } =
case sToolVer of case sToolVer of
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly >> pure v) (SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
_ -> runSetGHC runAppState (do _ -> runSetGHC runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer GHC v <- liftE $ fst <$> fromVersion' sToolVer GHC
liftE $ setGHC v SetGHCOnly liftE $ setGHC v SetGHCOnly Nothing
) )
>>= \case >>= \case
VRight GHCTargetVersion{..} -> do VRight GHCTargetVersion{..} -> do
@@ -311,10 +311,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
-> m ExitCode -> m ExitCode
setHLS' SetOptions{ sToolVer } = setHLS' SetOptions{ sToolVer } =
case sToolVer of case sToolVer of
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) >> pure v) (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
_ -> runSetHLS runAppState (do _ -> runSetHLS runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer HLS v <- liftE $ fst <$> fromVersion' sToolVer HLS
liftE $ setHLS (_tvVersion v) liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
pure v pure v
) )
>>= \case >>= \case

View File

@@ -113,17 +113,17 @@ runUpgrade runAppState =
upgrade :: ( Monad m upgrade :: ( Monad m
, MonadMask m , MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> UpgradeOpts => UpgradeOpts
-> Bool -> Bool
-> Dirs
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a)) -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
upgrade uOpts force' runAppState runLogger = do upgrade uOpts force' Dirs{..} runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
target <- case uOpts of target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath UpgradeInplace -> Just <$> liftIO getExecutablePath
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p

View File

@@ -20,6 +20,7 @@ import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Platform import GHCup.Platform
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics hiding ( toolRequirements )
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
@@ -39,6 +40,7 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions
import GHC.IO.Encoding import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH import Language.Haskell.TH
@@ -55,6 +57,7 @@ import qualified Data.ByteString as B
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified GHCup.Types as Types
@@ -72,15 +75,16 @@ toSettings options = do
where where
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings) mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
mergeConf Options{..} UserSettings{..} noColor = mergeConf Options{..} UserSettings{..} noColor =
let cache = fromMaybe (fromMaybe False uCache) optCache let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
in (Settings {..}, keyBindings) in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal defaultDownloader = Internal
@@ -136,7 +140,12 @@ main = do
<> hidden <> hidden
) )
let listCommands = infoOption let listCommands = infoOption
"install set rm install-cabal list upgrade compile debug-info tool-requirements changelog" ("install set rm install-cabal list"
#ifndef DISABLE_UPGRADE
<> " upgrade"
#endif
<> " compile debug-info tool-requirements changelog"
)
( long "list-commands" ( long "list-commands"
<> help "List available commands for shell completion" <> help "List available commands for shell completion"
<> internal <> internal
@@ -189,7 +198,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
------------------------- -------------------------
appState = do let appState = do
pfreq <- ( pfreq <- (
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
) >>= \case ) >>= \case
@@ -225,8 +234,32 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#if defined(BRICK) #if defined(BRICK)
Interactive -> pure () Interactive -> pure ()
#endif #endif
-- check for new tools
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> runReaderT checkForUpdates s' Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
alreadyInstalling' <- alreadyInstalling optCommand newTool
when (not alreadyInstalling') $
case t of
#ifdef DISABLE_UPGRADE
GHCup -> pure ()
#else
GHCup -> runLogger $
logWarn ("New GHCup version available: "
<> prettyVer l
<> ". To upgrade, run 'ghcup upgrade'")
#endif
_ -> runLogger $
logWarn ("New "
<> T.pack (prettyShow t)
<> " version available. "
<> "To upgrade, run 'ghcup install "
<> T.pack (prettyShow t)
<> " "
<> prettyVer l
<> "'")
Just _ -> pure () Just _ -> pure ()
-- TODO: always run for windows -- TODO: always run for windows
@@ -268,16 +301,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
List lo -> list lo no_color runAppState List lo -> list lo no_color runAppState
Rm rmCommand -> rm rmCommand runAppState runLogger Rm rmCommand -> rm rmCommand runAppState runLogger
DInfo -> dinfo runAppState runLogger DInfo -> dinfo runAppState runLogger
Compile compileCommand -> compile compileCommand settings runAppState runLogger Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
Config configCommand -> config configCommand settings keybindings runLogger Config configCommand -> config configCommand settings keybindings runLogger
Whereis whereisOptions Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
Upgrade uOpts force' -> upgrade uOpts force' runAppState runLogger #ifndef DISABLE_UPGRADE
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
#endif
ToolRequirements -> toolRequirements runAppState runLogger ToolRequirements -> toolRequirements runAppState runLogger
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
Nuke -> nuke appState runLogger Nuke -> nuke appState runLogger
Prefetch pfCom -> prefetch pfCom runAppState runLogger Prefetch pfCom -> prefetch pfCom runAppState runLogger
GC gcOpts -> gc gcOpts runAppState runLogger GC gcOpts -> gc gcOpts runAppState runLogger
Run runCommand -> run runCommand runAppState leanAppstate runLogger
case res of case res of
ExitSuccess -> pure () ExitSuccess -> pure ()
@@ -285,4 +321,58 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure () pure ()
where
alreadyInstalling :: ( HasLog env
, MonadFail m
, MonadReader env m
, HasGHCupInfo env
, HasDirs env
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Command
-> (Tool, Version)
-> Excepts
'[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
#ifndef DISABLE_UPGRADE
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
#endif
alreadyInstalling _ _ = pure False
cmp' :: ( HasLog env
, MonadFail m
, MonadReader env m
, HasGHCupInfo env
, HasDirs env
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Tool
-> Maybe ToolVersion
-> Version
-> Excepts
'[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool
pure (v == mkTVer ver)

View File

@@ -8,7 +8,14 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
constraints: http-io-streams -brotli source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
@@ -19,6 +26,9 @@ package aeson-pretty
package cabal-plan package cabal-plan
flags: -exe flags: -exe
package aeson
flags: +ordered-keymap
allow-newer: base, ghc-prim, template-haskell, language-c allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-8.10.7 with-compiler: ghc-8.10.7

View File

@@ -1,49 +1,50 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0, constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic, Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2, any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0, any.OneTuple ==0.3.1,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
any.aeson ==1.5.6.0, any.abstract-deque ==0.3,
aeson -bytestring-builder -cffi -developer -fast, abstract-deque -usecas,
any.aeson-pretty ==0.8.8, any.aeson ==2.0.2.0,
aeson -bytestring-builder -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only, aeson-pretty +lib-only,
any.alex ==3.2.6, any.alex ==3.2.7.1,
alex +small_base, any.ansi-terminal ==0.11.1,
any.ansi-terminal ==0.11,
ansi-terminal -example, ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9, any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example, ansi-wl-pprint -example,
any.array ==0.5.4.0, any.array ==0.5.4.0,
any.assoc ==1.0.2, any.assoc ==1.0.2,
any.async ==2.2.3, any.async ==2.2.4,
async -bench, async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.base ==4.14.3.0, any.base ==4.14.3.0,
any.base-compat ==0.12.0, any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.0, any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.5, any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.1.0, any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.1.0.0, any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.2,
any.brick ==0.64.1, any.brick ==0.64.2,
brick -demos, brick -demos,
any.bytestring ==0.10.12.0, any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib, bz2 -cross +with-bzlib,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0, any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report, cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
@@ -51,7 +52,7 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.chs-cabal ==0.1.1.1, any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0, any.chs-deps ==0.1.0.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.2, any.clock ==0.8.3,
clock -llvm, clock -llvm,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
@@ -65,8 +66,8 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
any.cryptohash-sha1 ==0.11.100.1, any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.0, any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3, any.data-clist ==0.1.2.3,
any.data-fix ==0.3.2, any.data-fix ==0.3.2,
@@ -80,17 +81,19 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.7, any.free ==5.1.7,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.1.0, any.generic-arbitrary ==0.1.0,
any.ghc-boot-th ==8.10.7, any.ghc-boot-th ==8.10.7,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1, any.ghc-prim ==0.6.1,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.3.0, any.hashable ==1.4.0.2,
hashable +integer-gmp -random-initial-seed, hashable +containers +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.2.1,
any.hsc2hs ==0.68.7, any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
@@ -100,8 +103,8 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor, http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1, any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1, any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1, any.indexed-traversable-instances ==0.1.1,
any.integer-gmp ==1.0.3.0, any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1, any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp, integer-logarithms -check-bounds +integer-gmp,
@@ -109,16 +112,20 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
io-streams +network -nointeractivetests +zlib, io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1, any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings, language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.0, any.libarchive ==3.0.3.2,
libarchive -cross -low-memory -system-libarchive, libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4, any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1, any.megaparsec ==9.0.1,
megaparsec -dev, megaparsec -dev,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3.1,
any.mtl ==2.2.2, any.mtl ==2.2.2,
any.network ==3.1.2.2, any.network ==3.1.2.7,
network -devel, network -devel,
any.network-uri ==2.6.4.1, any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0, any.openssl-streams ==1.2.3.0,
@@ -129,7 +136,7 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.optics-th ==0.4, any.optics-th ==0.4,
any.optparse-applicative ==0.16.1.0, any.optparse-applicative ==0.16.1.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2, any.os-release ==1.0.2.1,
os-release -devel, os-release -devel,
any.parallel ==3.2.2.0, any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0, any.parsec ==3.1.14.0,
@@ -138,30 +145,36 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.2.0, any.primitive ==0.7.3.0,
any.process ==1.6.13.2, any.process ==1.6.13.2,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.random ==1.2.1, any.random ==1.2.1,
any.recursion-schemes ==5.2.2.1, any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.3, any.resourcet ==1.2.4.3,
any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0.1, any.rts ==1.0.1,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0, any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple, scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5, any.semialign ==1.2.0.1,
semialign +semigroupoids,
any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.4,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.1, any.stm ==2.5.0.1,
any.streamly ==0.8.1.1,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
any.strict ==0.4.0.1, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
@@ -173,12 +186,14 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.terminal-size ==0.3.2.1, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.4,
any.text ==1.2.4.1, any.text ==1.2.4.1,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.11, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.3.0, any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3, any.th-compat ==0.1.3,
any.th-lift ==0.8.2, any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18, any.th-lift-instances ==0.1.19,
any.these ==1.1.1.1, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
@@ -187,14 +202,16 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.0,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3, any.unix-bytestring ==0.3.7.6,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.4,
unix-compat -old-time, unix-compat -old-time,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0, any.unordered-containers ==0.2.16.0,
unordered-containers -debug, unordered-containers -debug,
any.uri-bytestring ==0.3.3.1, any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror, uri-bytestring -lib-werror,
@@ -202,12 +219,15 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.uuid-types ==1.0.5, any.uuid-types ==1.0.5,
any.vector ==0.12.3.1, any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall, vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.0, any.versions ==5.0.2,
any.vty ==5.33, any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5, any.word-wrap ==0.5,
any.word8 ==0.1.3, any.word8 ==0.1.3,
any.xor ==0.0.1.0, any.xor ==0.0.1.0,
any.yaml-streamly ==0.12.1,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.2.3, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5 any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-01T15:16:26Z index-state: hackage.haskell.org 2022-02-15T12:16:42Z

View File

@@ -1,24 +0,0 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
tests: True
flags: +tui
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.1

34
cabal.ghc902.project Normal file
View File

@@ -0,0 +1,34 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
package ghcup
tests: True
flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.2

View File

@@ -1,49 +1,50 @@
active-repositories: hackage.haskell.org:merge active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0, constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic, Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0, any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2, any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0, any.OneTuple ==0.3.1,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2, any.StateVar ==1.2.2,
any.aeson ==1.5.6.0, any.abstract-deque ==0.3,
aeson -bytestring-builder -cffi -developer -fast, abstract-deque -usecas,
any.aeson-pretty ==0.8.8, any.aeson ==2.0.2.0,
aeson -bytestring-builder -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only, aeson-pretty +lib-only,
any.alex ==3.2.6, any.alex ==3.2.7.1,
alex +small_base, any.ansi-terminal ==0.11.1,
any.ansi-terminal ==0.11,
ansi-terminal -example, ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9, any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example, ansi-wl-pprint -example,
any.array ==0.5.4.0, any.array ==0.5.4.0,
any.assoc ==1.0.2, any.assoc ==1.0.2,
any.async ==2.2.3, any.async ==2.2.4,
async -bench, async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.5, any.attoparsec ==0.13.2.5,
attoparsec -developer, attoparsec -developer,
any.base ==4.15.0.0, any.base ==4.15.1.0,
any.base-compat ==0.12.0, any.base-compat ==0.12.1,
any.base-compat-batteries ==0.12.0, any.base-compat-batteries ==0.12.1,
any.base-orphans ==0.8.5, any.base-orphans ==0.8.6,
any.base16-bytestring ==1.0.1.0, any.base16-bytestring ==1.0.2.0,
any.base64-bytestring ==1.1.0.0, any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11, any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged, bifunctors +semigroups +tagged,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.2,
any.brick ==0.64.1, any.brick ==0.64.2,
brick -demos, brick -demos,
any.bytestring ==0.10.12.1, any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib, bz2 -cross +with-bzlib,
any.c2hs ==0.28.8, any.c2hs ==0.28.8,
c2hs +base3 -regression, c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0, any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report, cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0, any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0, any.case-insensitive ==1.2.1.0,
@@ -51,7 +52,7 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.chs-cabal ==0.1.1.1, any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0, any.chs-deps ==0.1.0.0,
chs-deps -cross, chs-deps -cross,
any.clock ==0.8.2, any.clock ==0.8.3,
clock -llvm, clock -llvm,
any.colour ==2.3.6, any.colour ==2.3.6,
any.comonad ==5.0.8, any.comonad ==5.0.8,
@@ -65,13 +66,13 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
any.cryptohash-sha1 ==0.11.100.1, any.cryptohash-sha1 ==0.11.101.0,
any.cryptohash-sha256 ==0.11.102.0, any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits, cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3, any.data-clist ==0.1.2.3,
any.data-fix ==0.3.2, any.data-fix ==0.3.2,
any.deepseq ==1.4.5.0, any.deepseq ==1.4.5.0,
any.directory ==1.3.6.1, any.directory ==1.3.6.2,
any.disk-free-space ==0.1.0.1, any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1, any.distributive ==0.6.2.1,
distributive +semigroups +tagged, distributive +semigroups +tagged,
@@ -80,18 +81,20 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.exceptions ==0.10.4, any.exceptions ==0.10.4,
any.filepath ==1.4.2.1, any.filepath ==1.4.2.1,
any.free ==5.1.7, any.free ==5.1.7,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.1.0, any.generic-arbitrary ==0.1.0,
any.ghc-bignum ==1.0, any.ghc-bignum ==1.1,
any.ghc-boot-th ==9.0.1, any.ghc-boot-th ==9.0.2,
any.ghc-byteorder ==4.11.0.0.10, any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0, any.ghc-prim ==0.7.0,
any.happy ==1.20.0, any.happy ==1.20.0,
any.hashable ==1.3.3.0, any.hashable ==1.4.0.2,
hashable +integer-gmp -random-initial-seed, hashable +containers +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4, any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1, any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1, any.haskus-utils-variant ==3.2.1,
any.hsc2hs ==0.68.7, any.heaps ==0.4,
any.hsc2hs ==0.68.8,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
@@ -101,24 +104,28 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor, http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1, any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1, any.indexed-traversable ==0.1.2,
any.indexed-traversable-instances ==0.1, any.indexed-traversable-instances ==0.1.1,
any.integer-logarithms ==1.0.3.1, any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp, integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.1, any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib, io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1, any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings, language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.0, any.libarchive ==3.0.3.2,
libarchive -cross -low-memory -system-libarchive, libarchive -cross -low-memory +no-exe -system-libarchive,
any.libyaml-streamly ==0.2.1,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4, any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1, any.megaparsec ==9.0.1,
megaparsec -dev, megaparsec -dev,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3.1,
any.mtl ==2.2.2, any.mtl ==2.2.2,
any.network ==3.1.2.2, any.network ==3.1.2.7,
network -devel, network -devel,
any.network-uri ==2.6.4.1, any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0, any.openssl-streams ==1.2.3.0,
@@ -129,7 +136,7 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.optics-th ==0.4, any.optics-th ==0.4,
any.optparse-applicative ==0.16.1.0, any.optparse-applicative ==0.16.1.0,
optparse-applicative +process, optparse-applicative +process,
any.os-release ==1.0.2, any.os-release ==1.0.2.1,
os-release -devel, os-release -devel,
any.parallel ==3.2.2.0, any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0, any.parsec ==3.1.14.0,
@@ -138,30 +145,36 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.polyparse ==1.13, any.polyparse ==1.13,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0, any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.2.0, any.primitive ==0.7.3.0,
any.process ==1.6.11.0, any.process ==1.6.13.2,
any.profunctors ==5.6.2, any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0, any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0, any.quickcheck-io ==0.2.0,
any.random ==1.2.1, any.random ==1.2.1,
any.recursion-schemes ==5.2.2.1, any.recursion-schemes ==5.2.2.2,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.2,
any.regex-posix ==0.96.0.1, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.3, any.resourcet ==1.2.4.3,
any.rts ==1.0, any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0.2,
any.safe ==0.3.19, any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2, any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0, any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple, scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5, any.semialign ==1.2.0.1,
semialign +semigroupoids,
any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3, any.setenv ==0.1.1.3,
any.split ==0.2.3.4, any.split ==0.2.3.4,
any.splitmix ==0.1.0.3, any.splitmix ==0.1.0.4,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.stm ==2.5.0.0, any.stm ==2.5.0.0,
any.streamly ==0.8.1.1,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
any.strict ==0.4.0.1, any.strict ==0.4.0.1,
strict +assoc, strict +assoc,
any.strict-base ==0.4.0.0, any.strict-base ==0.4.0.0,
@@ -171,14 +184,16 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.temporary ==1.3, any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1, any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1, any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4, any.terminfo ==0.4.1.5,
any.text ==1.2.4.1, any.text ==1.2.5.0,
any.text-short ==0.1.5,
text-short -asserts,
any.text-zipper ==0.11, any.text-zipper ==0.11,
any.tf-random ==0.5, any.tf-random ==0.5,
any.th-abstraction ==0.4.3.0, any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3, any.th-compat ==0.1.3,
any.th-lift ==0.8.2, any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18, any.th-lift-instances ==0.1.19,
any.these ==1.1.1.1, any.these ==1.1.1.1,
these +assoc, these +assoc,
any.time ==1.9.3, any.time ==1.9.3,
@@ -187,14 +202,16 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6, any.transformers-base ==0.4.6,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.7, any.transformers-compat ==0.7.1,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unicode-data ==0.3.0,
unicode-data -ucd2haskell,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3, any.unix-bytestring ==0.3.7.6,
any.unix-compat ==0.5.3, any.unix-compat ==0.5.4,
unix-compat -old-time, unix-compat -old-time,
any.unliftio-core ==0.2.0.1, any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0, any.unordered-containers ==0.2.16.0,
unordered-containers -debug, unordered-containers -debug,
any.uri-bytestring ==0.3.3.1, any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror, uri-bytestring -lib-werror,
@@ -202,12 +219,15 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.uuid-types ==1.0.5, any.uuid-types ==1.0.5,
any.vector ==0.12.3.1, any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall, vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.0, any.versions ==5.0.2,
any.vty ==5.33, any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5, any.word-wrap ==0.5,
any.word8 ==0.1.3, any.word8 ==0.1.3,
any.xor ==0.0.1.0, any.xor ==0.0.1.0,
any.yaml-streamly ==0.12.1,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.2.3, any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5 any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-01T15:16:26Z index-state: hackage.haskell.org 2022-02-15T12:16:42Z

View File

@@ -8,20 +8,15 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size.git
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli, constraints: http-io-streams -brotli,
any.Cabal ==3.4.0.0 || ==3.6.2.0, any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0 any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/hasufell/aeson-pretty.git
tag: e902ab866bb41d990b66af3644aeb352ff7aaf6f
source-repository-package
type: git
location: https://github.com/hasufell/HsYAML-aeson.git
tag: b4b4ab8592918b52a9f2e5bb0c5a795b9721b4f3
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive

View File

@@ -36,6 +36,10 @@ key-bindings:
show-all-tools: show-all-tools:
KChar: 't' KChar: 't'
# The caching for the metadata files containing download info, depending on last access time
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
meta-cache: 300 # in seconds
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code. # check the 'URLSource' type in the code.
url-source: url-source:

1
data/metadata Submodule

Submodule data/metadata added at b1d0995221

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -12,8 +12,7 @@ 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 the appropriate Download information on where to fetch bindists from is in the [ghcup-metadata](https://github.com/haskell/ghcup-metadata) repository.
yaml files: `data/metadata/ghcup-<yaml-ver>.yaml`.
## Design decisions ## Design decisions
@@ -66,18 +65,14 @@ Some light suggestions:
### Adding a new GHC version ### Adding a new GHC version
1. open the latest `data/metadata/ghcup-<yaml-ver>.yaml` Head over to: [https://github.com/haskell/ghcup-metadata#adding-a-new-ghc-version](https://github.com/haskell/ghcup-metadata#adding-a-new-ghc-version)
2. find the latest ghc version (in yaml tree e.g. `ghcupDownloads -> GHC -> 8.10.7`)
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 -f data/metadata/ghcup-<yaml-ver>.yaml`
7. run `cabal run exe:ghcup-gen -- check-tarballs -f data/metadata/ghcup-<yaml-ver>.yaml -u 'ghc-8\.10\.8'`
### Adding a new CLI command ### Adding a new CLI command
An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26) An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/app/ghcup/GHCup/OptParse).
## Major refactors ## Major refactors
1. First major refactor included adding cross support. This added 1. First major refactor included adding cross support. This added
@@ -89,30 +84,37 @@ An example illustration on how to deal with [optparse-applicative](https://hacka
The major changes here were switching `hpath` library out for `filepath`/`directory` (sadly) and The major changes here were switching `hpath` library out for `filepath`/`directory` (sadly) and
introducing a non-unix way of handling processes via the `process` library. It also introduced considerable introducing a non-unix way of handling processes via the `process` library. It also introduced considerable
amounts of CPP wrt file handling, installation etc. amounts of CPP wrt file handling, installation etc.
3. This refactor split up the huge `Main.hs` and put every subcommand in its own module: [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/212)
# Releasing # Releasing
1. Update version in `ghcup.cabal` and `boostrap-haskell` (`ghver` variable at the top of the script) 1. Update version in `ghcup.cabal`
2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`. 2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`.
3. Add ChangeLog entry 3. Add ChangeLog entry
4. Add/fix downloads in `ghcup-<ver>.yaml` (under `data/metadata`), then verify with `ghcup-gen check -f data/metadata/ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f data/metadata/ghcup-<ver>.yaml -u 'ghc-8.10.7'`. Generally, new GHC/cabal/stack/hls versions are only added to the latest yaml file. New GHCup versions are added to all (great care must be taken here to not break the parser... e.g. ARM platforms don't parse in all older formats). 4. If a new ghcup yaml version is needed, create one at [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata) and push to a temporary release branch, then update the `data/metadata` submodule in ghcup-hs repo to that branch, so CI can pass
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build. 5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
6. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`) 6. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (also check `scripts/releasing/pull_release_artifacts.sh` and `scripts/releasing/sftp-upload-artifacts.sh`)
7. Add ghcup release artifacts to ALL yaml files (see point 4.) 7. Add ghcup release artifacts to ALL yaml files, see [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata)
8. Upload the final `data/metadata/ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/`. 8. Upload the final `ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/` (for yaml versions <= 0.0.6) as well as [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) (for all versions).
9. Update `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/` 9. Update version in `scripts/bootstrap/bootstrap-haskell` (`ghver` variable at the top of the script)
10. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup` 10. Upload `scripts/bootstrap/bootstrap-haskell` and `scripts/bootstrap/bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
11. Post on reddit/discourse/etc. and collect rewards 11. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup` (see `scripts/releasing/sftp-symlink-artifacts.sh`)
12. Update the `data/metadata` submodule in ghcup-hs repo to master
13. Do hackage release
14. Post on reddit/discourse/etc. and collect rewards
# Documentation # Documentation

View File

@@ -32,6 +32,17 @@ ghcup install cabal
ghcup upgrade ghcup upgrade
``` ```
### Tags and shortcuts
GHCup has a number of tags and version shortcuts, that can be used as arguments to **install**/**set** etc.
All of the following are valid arguments to `ghcup install ghc`:
* `latest`, `recommended`
* `base-4.15.1.0`
* `9.0.2`, `9.0`, `9`
If the argument is omitted, the default is `recommended`.
## Configuration ## Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
@@ -53,6 +64,25 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros). (`/usr/share/bash-completion/bash_completion` on some distros).
## Caching
GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default.
### Downloads cache
Downloaded tarballs (such as GHC, cabal, etc.) are not cached by default unless you pass `ghcup --cache` or set caching
in your [config](#configuration) via `ghcup config set cache true`.
### Metadata cache
The metadata files (also see [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata))
have a 5 minutes cache per default depending on the last access time of the file. That means if you run
`ghcup list` 10 times in a row, only the first time will trigger a download attempt.
### Clearing the cache
If you experience problems, consider clearing the cache via `ghcup gc --cache`.
## Compiling GHC from source ## Compiling GHC from source
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help` Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
@@ -119,6 +149,31 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected). detected).
## Mirrors
GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
To use a mirror, set the following option in `~/.ghcup/config.yaml`:
```yml
url-source:
# Accepts file/http/https scheme
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
```
See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
for more options.
Alternatively you can do it via a cli switch:
```sh
ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
```
### Known mirrors
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
## Isolated installs ## Isolated installs
Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing. Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.
@@ -169,66 +224,10 @@ For the full list of env variables and parameters to tweak the script behavior,
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7) * [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17) * [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
### Example github workflow ### github workflows
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/) On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
If you want to install ghcup manually though, here's an example config:
```yml
name: Haskell CI
on:
push:
branches: [ master ]
pull_request:
branches: [ master ]
jobs:
build-cabal:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-latest, macOS-latest, windows-latest]
ghc: ['8.10.7', '9.0.1']
cabal: ['3.4.0.0']
steps:
- uses: actions/checkout@v2
- if: matrix.os == 'windows-latest'
name: Install ghcup on windows
run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
- if: matrix.os == 'windows-latest'
name: Add ghcup to PATH
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
shell: bash
- if: matrix.os != 'windows-latest'
name: Install ghcup on non-windows
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
- name: Install ghc/cabal
run: |
ghcup install ghc ${{ matrix.ghc }}
ghcup install cabal ${{ matrix.cabal }}
shell: bash
- name: Update cabal index
run: cabal update
shell: bash
- name: Build
run: cabal build --enable-tests --enable-benchmarks
shell: bash
- name: Run tests
run: cabal test
shell: bash
```
## GPG verification ## GPG verification
@@ -260,48 +259,14 @@ You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
## Tips and tricks ## Tips and tricks
### with_ghc wrapper (e.g. for HLS) ### Execute command with certain GHC in PATH
Due to some HLS [bugs](https://github.com/mpickering/hie-bios/issues/194) it's necessary that the `ghc` in PATH If you don't want to explicitly switch the active GHC all the time and are using
is the one defined in `cabal.project`. With some simple shell functions, we can start our editor with the appropriate tools that rely on the plain `ghc` binary, GHCup provides an easy way to execute
path prepended. commands with a certain toolchain prepended to PATH, e.g.:
For bash, in e.g. `~/.bashrc` define:
```sh ```sh
with_ghc() { ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- code Setup.hs
local np=$(ghcup --offline whereis -d ghc $1 || { ghcup --cache install ghc $1 && ghcup whereis -d ghc $1 ;})
if [ -e "${np}" ] ; then
shift
PATH="$np:$PATH" "$@"
else
>&2 echo "Cannot find or install GHC version $1"
return 1
fi
}
``` ```
For fish shell, in e.g. `~/.config/fish/config.fish` define: This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
```fish
function with_ghc
set --local np (ghcup --offline whereis -d ghc $argv[1] ; or begin ghcup --cache install ghc $argv[1] ; and ghcup whereis -d ghc $argv[1] ; end)
if test -e "$np"
PATH="$np:$PATH" $argv[2..-1]
else
echo "Cannot find or install GHC version $argv[1]" 1>&2
return 1
end
end
```
Then start a new shell and issue:
```sh
# replace 'code' with your editor
with_ghc 8.10.5 code path/to/haskell/source
```
Cabal and HLS will now see `8.10.5` as the primary GHC, without the need to
run `ghcup set` all the time when switching between projects.

View File

@@ -24,10 +24,20 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries. If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
### Which versions get installed?
GHCup has two main channels for every tool: **recommended** and **latest**. By default, it installs *recommended*.
*latest* follows the latest release of every tool, while *recommended* is at the discretion of the GHCup maintainers and based on community adoption (hackage libraries, tools like HLS, stackage support, etc.) and known bugs.
Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
## First steps ## First steps
1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/latest/getting-started.html) guide 1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/stable/getting-started.html) guide
2. To properly learn Haskell, run through the [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises 2. To learn Haskell, try any of those:
- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
- An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md) 3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
## Uninstallation ## Uninstallation
@@ -41,9 +51,9 @@ On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on you
GHCup supports the following tools, which are also known as the **Haskell Toolchain**: GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
1. [GHC](https://www.haskell.org/ghc/) 1. [GHC](https://www.haskell.org/ghc/)
2. [cabal-install](https://cabal.readthedocs.io/en/latest/) 2. [cabal-install](https://cabal.readthedocs.io/en/stable/)
3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/latest/) 3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/stable/)
4. [stack](https://docs.haskellstack.org/en/latest/README/) 4. [stack](https://docs.haskellstack.org/en/stable/README/)
## Supported platforms ## Supported platforms
@@ -78,14 +88,15 @@ May or may not work, several issues:
Unsupported. GHC may or may not work. Upgrade to WSL2. Unsupported. GHC may or may not work. Upgrade to WSL2.
### MacOS <13 ### MacOS <10.13
Not supported. Would require separate binaries, since >=13 binaries are incompatible. Not supported. Would require separate binaries, since >=10.13 binaries are incompatible.
Please upgrade. Please upgrade.
### MacOS aarch64 ### MacOS aarch64
HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet. HLS bindists are still experimental. Stack has only unofficial binaries for this platform.
There are various issues with GHC itself.
### FreeBSD ### FreeBSD
@@ -94,7 +105,7 @@ HLS bindists are experimental.
### Linux ARMv7/AARCH64 ### Linux ARMv7/AARCH64
Lower availability of bindists. HLS only has experimental ones. Stack not supported currently. Lower availability of bindists. Stack and HLS binaries are experimental.
## Manual install ## Manual install

View File

@@ -4,363 +4,638 @@
<!-- Generated by graphviz version 2.44.0 (0) <!-- Generated by graphviz version 2.44.0 (0)
--> -->
<!-- Title: G Pages: 1 --> <!-- Title: G Pages: 1 -->
<svg width="719pt" height="648pt" <svg width="720pt" height="648pt"
viewBox="0.00 0.00 719.28 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"> viewBox="0.00 0.00 719.60 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.81 0.81) rotate(0) translate(4 794.2)"> <g id="graph0" class="graph" transform="scale(0.45 0.45) rotate(0) translate(4 1421.5)">
<title>G</title> <title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-794.2 882,-794.2 882,4 -4,4"/> <polygon fill="white" stroke="transparent" points="-4,4 -4,-1421.5 1579,-1421.5 1579,4 -4,4"/>
<g id="clust1" class="cluster"> <g id="clust1" class="cluster">
<title>cluster_0</title> <title>cluster_0</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-8.95 8,-660.37 870,-660.37 870,-8.95 8,-8.95"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-12.99 8,-1346.06 1567,-1346.06 1567,-12.99 8,-12.99"/>
<text text-anchor="middle" x="439" y="-645.17" font-family="Times-Roman" font-size="14.00">GHCup</text> <text text-anchor="middle" x="787.5" y="-1330.86" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g> </g>
<g id="clust2" class="cluster"> <g id="clust2" class="cluster">
<title>cluster_1</title> <title>cluster_1</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="190,-364.88 190,-541.72 450,-541.72 450,-364.88 190,-364.88"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1102,-529.33 1102,-823.22 1362,-823.22 1362,-529.33 1102,-529.33"/>
<text text-anchor="middle" x="320" y="-526.52" font-family="Times-Roman" font-size="14.00">Download</text> <text text-anchor="middle" x="1232" y="-808.02" font-family="Times-Roman" font-size="14.00">Download</text>
</g> </g>
<g id="clust3" class="cluster"> <g id="clust3" class="cluster">
<title>cluster_2</title> <title>cluster_2</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="271,-191.39 271,-355.93 452,-355.93 452,-191.39 271,-191.39"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="16,-940.13 16,-1295.72 1559,-1295.72 1559,-940.13 16,-940.13"/>
<text text-anchor="middle" x="361.5" y="-340.73" font-family="Times-Roman" font-size="14.00">Types</text> <text text-anchor="middle" x="787.5" y="-1280.52" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g> </g>
<g id="clust4" class="cluster"> <g id="clust4" class="cluster">
<title>cluster_3</title> <title>cluster_3</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="566,-17.91 566,-576.42 862,-576.42 862,-17.91 566,-17.91"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1196,-277.65 1196,-516.34 1377,-516.34 1377,-277.65 1196,-277.65"/>
<text text-anchor="middle" x="714" y="-561.22" font-family="Times-Roman" font-size="14.00">Utils</text> <text text-anchor="middle" x="1286.5" y="-501.14" font-family="Times-Roman" font-size="14.00">Types</text>
</g> </g>
<g id="clust5" class="cluster"> <g id="clust5" class="cluster">
<title>cluster_4</title> <title>cluster_4</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="640,-271.98 640,-448.82 758,-448.82 758,-271.98 640,-271.98"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="586,-25.98 586,-701.44 1082,-701.44 1082,-25.98 586,-25.98"/>
<text text-anchor="middle" x="699" y="-433.62" font-family="Times-Roman" font-size="14.00">File</text> <text text-anchor="middle" x="834" y="-686.24" font-family="Times-Roman" font-size="14.00">Utils</text>
</g> </g>
<g id="clust6" class="cluster"> <g id="clust6" class="cluster">
<title>cluster_5</title> <title>cluster_5</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="583,-26.86 583,-110.81 653,-110.81 653,-26.86 583,-26.86"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="744,-394.56 744,-651.11 862,-651.11 862,-394.56 744,-394.56"/>
<text text-anchor="middle" x="618" y="-95.61" font-family="Times-Roman" font-size="14.00">String</text> <text text-anchor="middle" x="803" y="-635.91" font-family="Times-Roman" font-size="14.00">File</text>
</g> </g>
<g id="clust7" class="cluster"> <g id="clust7" class="cluster">
<title>cluster_6</title> <title>cluster_6</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="712,-457.78 712,-541.72 782,-541.72 782,-457.78 712,-457.78"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="995,-38.97 995,-160.75 1065,-160.75 1065,-38.97 995,-38.97"/>
<text text-anchor="middle" x="747" y="-526.52" font-family="Times-Roman" font-size="14.00">Version</text> <text text-anchor="middle" x="1030" y="-145.55" font-family="Times-Roman" font-size="14.00">String</text>
</g>
<g id="clust8" class="cluster">
<title>cluster_7</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="594,-529.33 594,-651.11 664,-651.11 664,-529.33 594,-529.33"/>
<text text-anchor="middle" x="629" y="-635.91" font-family="Times-Roman" font-size="14.00">Version</text>
</g> </g>
<!-- u1 --> <!-- u1 -->
<g id="node1" class="node"> <g id="node1" class="node">
<title>u1</title> <title>u1</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="387" cy="-486.95" rx="55.49" ry="18"/> <ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1165" cy="-743.99" rx="55.49" ry="18"/>
<text text-anchor="middle" x="387" y="-483.25" font-family="Times-Roman" font-size="14.00">Download</text> <text text-anchor="middle" x="1165" y="-740.29" font-family="Times-Roman" font-size="14.00">Download</text>
</g> </g>
<!-- u12 --> <!-- u12 -->
<g id="node7" class="node"> <g id="node24" class="node">
<title>u12</title> <title>u12</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="688" cy="-393.95" rx="27" ry="18"/> <ellipse fill="#ffbbff" stroke="black" stroke-width="2" cx="825" cy="-571.99" rx="27" ry="18"/>
<text text-anchor="middle" x="688" y="-390.25" font-family="Times-Roman" font-size="14.00">File</text> <text text-anchor="middle" x="825" y="-568.29" font-family="Times-Roman" font-size="14.00">File</text>
</g> </g>
<!-- u1&#45;&gt;u12 --> <!-- u1&#45;&gt;u12 -->
<g id="edge15" class="edge"> <g id="edge13" class="edge">
<title>u1&#45;&gt;u12</title> <title>u1&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M416.08,-471.48C425.43,-467.42 435.96,-463.44 446,-460.95 491.68,-449.63 616.67,-467.2 657,-442.95 665.62,-437.77 672.27,-429.17 677.16,-420.67"/> <path fill="none" stroke="black" d="M1125,-731.45C1042,-707.49 858.55,-654.33 856,-651.99 841.25,-638.47 833.42,-617.06 829.33,-599.94"/>
<polygon fill="black" stroke="black" points="680.34,-422.15 681.79,-411.65 674.11,-418.95 680.34,-422.15"/> <polygon fill="black" stroke="black" points="832.71,-599.01 827.23,-589.94 825.86,-600.45 832.71,-599.01"/>
</g> </g>
<!-- u11 --> <!-- u11 -->
<g id="node15" class="node"> <g id="node32" class="node">
<title>u11</title> <title>u11</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="603" cy="-393.95" rx="28.7" ry="18"/> <ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1045" cy="-571.99" rx="28.7" ry="18"/>
<text text-anchor="middle" x="603" y="-390.25" font-family="Times-Roman" font-size="14.00">Dirs</text> <text text-anchor="middle" x="1045" y="-568.29" font-family="Times-Roman" font-size="14.00">Dirs</text>
</g> </g>
<!-- u1&#45;&gt;u11 --> <!-- u1&#45;&gt;u11 -->
<g id="edge14" class="edge"> <g id="edge12" class="edge">
<title>u1&#45;&gt;u11</title> <title>u1&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M419.14,-472.31C427.86,-468.62 437.29,-464.63 446,-460.95 489.08,-442.77 538.85,-421.87 570.6,-408.54"/> <path fill="none" stroke="black" d="M1152.43,-726.38C1138.8,-708.25 1116.51,-678.31 1098,-651.99 1085.29,-633.92 1071.4,-613.17 1061.02,-597.47"/>
<polygon fill="black" stroke="black" points="571.98,-411.76 579.85,-404.66 569.27,-405.3 571.98,-411.76"/> <polygon fill="black" stroke="black" points="1063.78,-595.29 1055.36,-588.87 1057.94,-599.14 1063.78,-595.29"/>
</g> </g>
<!-- u13 --> <!-- u13 -->
<g id="node18" class="node"> <g id="node35" class="node">
<title>u13</title> <title>u13</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-300.95" rx="44.39" ry="18"/> <ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1414" cy="-571.99" rx="44.39" ry="18"/>
<text text-anchor="middle" x="109" y="-297.25" font-family="Times-Roman" font-size="14.00">Version</text> <text text-anchor="middle" x="1414" y="-568.29" font-family="Times-Roman" font-size="14.00">Version</text>
</g> </g>
<!-- u1&#45;&gt;u13 --> <!-- u1&#45;&gt;u13 -->
<g id="edge13" class="edge"> <g id="edge11" class="edge">
<title>u1&#45;&gt;u13</title> <title>u1&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M356.68,-471.88C346.23,-467.63 334.3,-463.44 323,-460.95 290.82,-453.87 49.58,-466.95 27,-442.95 4.16,-418.68 12.6,-398.02 27,-367.95 36.61,-347.88 55.63,-331.97 72.94,-320.81"/> <path fill="none" stroke="black" d="M1206.8,-732.08C1250.56,-718.96 1319.26,-693.39 1366,-651.99 1382.37,-637.49 1394.91,-616.04 1403.06,-599.16"/>
<polygon fill="black" stroke="black" points="75.07,-323.61 81.77,-315.4 71.41,-317.64 75.07,-323.61"/> <polygon fill="black" stroke="black" points="1406.35,-600.37 1407.35,-589.82 1399.99,-597.45 1406.35,-600.37"/>
</g> </g>
<!-- u17 --> <!-- u17 -->
<g id="node2" class="node"> <g id="node2" class="node">
<title>u17</title> <title>u17</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="332" cy="-393.95" rx="30.59" ry="18"/> <ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1267" cy="-571.99" rx="30.59" ry="18"/>
<text text-anchor="middle" x="332" y="-390.25" font-family="Times-Roman" font-size="14.00">Utils</text> <text text-anchor="middle" x="1267" y="-568.29" font-family="Times-Roman" font-size="14.00">Utils</text>
</g> </g>
<!-- u5 --> <!-- u5 -->
<g id="node6" class="node"> <g id="node23" class="node">
<title>u5</title> <title>u5</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="410" cy="-300.95" rx="33.6" ry="18"/> <ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1238" cy="-436.99" rx="33.6" ry="18"/>
<text text-anchor="middle" x="410" y="-297.25" font-family="Times-Roman" font-size="14.00">JSON</text> <text text-anchor="middle" x="1238" y="-433.29" font-family="Times-Roman" font-size="14.00">JSON</text>
</g> </g>
<!-- u17&#45;&gt;u5 --> <!-- u17&#45;&gt;u5 -->
<g id="edge16" class="edge"> <g id="edge14" class="edge">
<title>u17&#45;&gt;u5</title> <title>u17&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M345.23,-377.52C357.37,-363.35 375.54,-342.16 389.55,-325.81"/> <path fill="none" stroke="black" d="M1263.27,-553.87C1258.35,-531.33 1249.65,-491.44 1243.86,-464.85"/>
<polygon fill="black" stroke="black" points="392.59,-327.64 396.44,-317.77 387.28,-323.09 392.59,-327.64"/> <polygon fill="black" stroke="black" points="1247.27,-464.06 1241.72,-455.04 1240.43,-465.56 1247.27,-464.06"/>
</g> </g>
<!-- u19 --> <!-- u19 -->
<g id="node3" class="node"> <g id="node3" class="node">
<title>u19</title> <title>u19</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="256" cy="-486.95" rx="57.69" ry="18"/> <ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1296" cy="-743.99" rx="57.69" ry="18"/>
<text text-anchor="middle" x="256" y="-483.25" font-family="Times-Roman" font-size="14.00">IOStreams</text> <text text-anchor="middle" x="1296" y="-740.29" font-family="Times-Roman" font-size="14.00">IOStreams</text>
</g> </g>
<!-- u19&#45;&gt;u17 --> <!-- u19&#45;&gt;u17 -->
<g id="edge17" class="edge"> <g id="edge15" class="edge">
<title>u19&#45;&gt;u17</title> <title>u19&#45;&gt;u17</title>
<path fill="none" stroke="black" d="M272.49,-469.68C280.19,-461.83 289.33,-452.14 297,-442.95 303.18,-435.56 309.51,-427.17 315.06,-419.49"/> <path fill="none" stroke="black" d="M1293.06,-725.75C1288.01,-696.15 1277.65,-635.42 1271.63,-600.1"/>
<polygon fill="black" stroke="black" points="318.21,-421.09 321.16,-410.91 312.51,-417.03 318.21,-421.09"/> <polygon fill="black" stroke="black" points="1275.04,-599.29 1269.9,-590.02 1268.14,-600.46 1275.04,-599.29"/>
</g>
<!-- u3 -->
<g id="node4" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="399" cy="-220.95" rx="36.29" ry="18"/>
<text text-anchor="middle" x="399" y="-217.25" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node5" class="node">
<title>u4</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="319" cy="-300.95" rx="39.79" ry="18"/>
<text text-anchor="middle" x="319" y="-297.25" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge18" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M335.19,-284.17C346.87,-272.78 362.8,-257.24 375.83,-244.55"/>
<polygon fill="black" stroke="black" points="378.39,-246.94 383.11,-237.45 373.5,-241.92 378.39,-246.94"/>
</g>
<!-- u6 -->
<g id="node12" class="node">
<title>u6</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="638" cy="-486.95" rx="64.19" ry="18"/>
<text text-anchor="middle" x="638" y="-483.25" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge19" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M425.28,-317.32C443.67,-335.87 472.3,-364.95 474,-367.95 491,-397.97 469.27,-418.9 494,-442.95 518.89,-467.15 536.76,-450.95 570,-460.95 577.45,-463.2 585.27,-465.82 592.85,-468.5"/>
<polygon fill="black" stroke="black" points="591.68,-471.8 602.27,-471.91 594.06,-465.22 591.68,-471.8"/>
</g>
<!-- u7 -->
<g id="node13" class="node">
<title>u7</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="618" cy="-220.95" rx="44.39" ry="18"/>
<text text-anchor="middle" x="618" y="-217.25" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge20" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M429.11,-285.89C434.97,-281.99 441.58,-277.99 448,-274.95 487.67,-256.18 535.63,-241.92 570.48,-232.95"/>
<polygon fill="black" stroke="black" points="571.56,-236.29 580.4,-230.45 569.85,-229.51 571.56,-236.29"/>
</g>
<!-- u9 -->
<g id="node8" class="node">
<title>u9</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="699" cy="-300.95" rx="51.19" ry="18"/>
<text text-anchor="middle" x="699" y="-297.25" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge30" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M690.07,-375.84C691.65,-362.75 693.87,-344.43 695.69,-329.32"/>
<polygon fill="black" stroke="black" points="699.21,-329.34 696.94,-318.99 692.27,-328.5 699.21,-329.34"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge31" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M682.22,-283.79C670.52,-272.53 654.74,-257.34 641.76,-244.83"/>
<polygon fill="black" stroke="black" points="644.12,-242.24 634.48,-237.83 639.26,-247.29 644.12,-242.24"/>
</g>
<!-- u10 -->
<g id="node9" class="node">
<title>u10</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="618" cy="-55.95" rx="27" ry="18"/>
<text text-anchor="middle" x="618" y="-52.25" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node10" class="node">
<title>u16</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="747" cy="-486.95" rx="27" ry="18"/>
<text text-anchor="middle" x="747" y="-483.25" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15 -->
<g id="node11" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="823" cy="-486.95" rx="30.59" ry="18"/>
<text text-anchor="middle" x="823" y="-483.25" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u15&#45;&gt;u12 -->
<g id="edge22" class="edge">
<title>u15&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M803.42,-472.71C797.8,-468.92 791.66,-464.77 786,-460.95 761.96,-444.74 734.59,-426.31 714.9,-413.05"/>
<polygon fill="black" stroke="black" points="716.68,-410.03 706.43,-407.35 712.77,-415.84 716.68,-410.03"/>
</g>
<!-- u15&#45;&gt;u11 -->
<g id="edge21" class="edge">
<title>u15&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M805.88,-471.91C799.92,-467.72 792.97,-463.55 786,-460.95 723.08,-437.5 693.45,-477.7 636,-442.95 627.23,-437.65 620.23,-429.02 614.98,-420.54"/>
<polygon fill="black" stroke="black" points="617.89,-418.57 609.96,-411.54 611.78,-421.98 617.89,-418.57"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge23" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M608.52,-470.77C594.78,-463.16 578.53,-453.36 565,-442.95 527.38,-414.03 523.93,-400.08 489,-367.95 479.95,-359.63 474.21,-360.56 468,-349.95 450.82,-320.62 469.18,-304.85 453,-274.95 446.44,-262.83 436.18,-251.74 426.36,-242.87"/>
<polygon fill="black" stroke="black" points="428.53,-240.12 418.66,-236.26 423.97,-245.43 428.53,-240.12"/>
</g>
<!-- u8 -->
<g id="node14" class="node">
<title>u8</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="618" cy="-139.95" rx="42.49" ry="18"/>
<text text-anchor="middle" x="618" y="-136.25" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge25" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M618,-202.81C618,-192.67 618,-179.59 618,-168.07"/>
<polygon fill="black" stroke="black" points="621.5,-168.06 618,-158.06 614.5,-168.06 621.5,-168.06"/>
</g>
<!-- u2 -->
<g id="node17" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="520" cy="-300.95" rx="37.89" ry="18"/>
<text text-anchor="middle" x="520" y="-297.25" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge24" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M598.83,-237.21C584.07,-248.96 563.49,-265.34 547.06,-278.42"/>
<polygon fill="black" stroke="black" points="544.54,-275.95 538.9,-284.91 548.9,-281.43 544.54,-275.95"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge26" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M576.88,-144.38C511.17,-150.66 386.55,-166.09 354,-194.95 331.93,-214.52 323.74,-248.37 320.73,-272.34"/>
<polygon fill="black" stroke="black" points="317.22,-272.27 319.67,-282.57 324.18,-272.99 317.22,-272.27"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge27" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M637.21,-156.09C648.59,-166.01 662.41,-179.89 671,-194.95 684.9,-219.32 692.1,-250.8 695.69,-272.91"/>
<polygon fill="black" stroke="black" points="692.25,-273.56 697.18,-282.94 699.17,-272.53 692.25,-273.56"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge28" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M618,-121.56C618,-110.73 618,-96.56 618,-84.25"/>
<polygon fill="black" stroke="black" points="621.5,-84.04 618,-74.04 614.5,-84.04 621.5,-84.04"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge29" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M575.99,-387.58C537.44,-379.55 469,-363.89 448,-349.95 439.06,-344.02 431.26,-335.31 425.1,-326.92"/>
<polygon fill="black" stroke="black" points="427.82,-324.71 419.28,-318.44 422.05,-328.67 427.82,-324.71"/>
</g>
<!-- u0 -->
<g id="node16" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="627" cy="-605.95" rx="42.49" ry="18"/>
<text text-anchor="middle" x="627" y="-602.25" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u0&#45;&gt;u1 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M584.67,-604.4C545.83,-602.07 488.09,-593.82 446,-566.95 425.91,-554.13 410.22,-531.89 400.09,-514.27"/>
<polygon fill="black" stroke="black" points="402.91,-512.13 395.04,-505.04 396.77,-515.5 402.91,-512.13"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge6" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M663.33,-596.57C681.18,-590.83 701.84,-581.54 716,-566.95 729.77,-552.77 737.62,-531.76 741.97,-514.97"/>
<polygon fill="black" stroke="black" points="745.4,-515.69 744.26,-505.16 738.58,-514.11 745.4,-515.69"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge5" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M669.23,-604.64C704.08,-602.27 753,-593.85 786,-566.95 801.95,-553.96 811.39,-532.52 816.74,-515.25"/>
<polygon fill="black" stroke="black" points="820.24,-515.72 819.56,-505.15 813.5,-513.84 820.24,-515.72"/>
</g>
<!-- u14 -->
<g id="node19" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="508" cy="-486.95" rx="48.19" ry="18"/>
<text text-anchor="middle" x="508" y="-483.25" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M599.25,-592.23C586.98,-585.76 572.9,-577.11 562,-566.95 545.64,-551.71 531.56,-530.66 521.88,-514.12"/>
<polygon fill="black" stroke="black" points="524.68,-511.96 516.71,-504.98 518.59,-515.41 524.68,-511.96"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge7" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M498.37,-286.01C479.01,-273.53 450.45,-255.12 428.91,-241.23"/>
<polygon fill="black" stroke="black" points="430.75,-238.25 420.45,-235.78 426.95,-244.14 430.75,-238.25"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge8" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M144.85,-290.31C198.89,-275.78 300.93,-248.33 357.9,-233.01"/>
<polygon fill="black" stroke="black" points="358.91,-236.36 367.66,-230.38 357.09,-229.6 358.91,-236.36"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge9" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M492.36,-469.49C485.88,-461.9 478.78,-452.48 474,-442.95 458.54,-412.12 468.2,-399.39 454,-367.95 447.34,-353.21 437.53,-338.1 428.85,-326.06"/>
<polygon fill="black" stroke="black" points="431.57,-323.84 422.81,-317.89 425.94,-328.01 431.57,-323.84"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge10" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M534.95,-471.89C543.43,-467.9 552.95,-463.86 562,-460.95 602.92,-447.83 621.35,-466.95 657,-442.95 665.13,-437.48 671.61,-429.08 676.49,-420.83"/>
<polygon fill="black" stroke="black" points="679.72,-422.21 681.33,-411.74 673.54,-418.92 679.72,-422.21"/>
</g>
<!-- u18 -->
<g id="node20" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-393.95" rx="73.39" ry="18"/>
<text text-anchor="middle" x="109" y="-390.25" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge12" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M147.73,-378.58C159.84,-374.58 173.34,-370.6 186,-367.95 265.56,-351.31 295.73,-387.15 368,-349.95 378.45,-344.58 387.45,-335.41 394.41,-326.53"/>
<polygon fill="black" stroke="black" points="397.39,-328.37 400.44,-318.22 391.73,-324.26 397.39,-328.37"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge11" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M109,-375.84C109,-362.75 109,-344.43 109,-329.32"/>
<polygon fill="black" stroke="black" points="112.5,-328.99 109,-318.99 105.5,-328.99 112.5,-328.99"/>
</g>
<!-- u20 -->
<g id="node21" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-769.95" rx="32.49" ry="18"/>
<text text-anchor="middle" x="627" y="-766.25" font-family="Times-Roman" font-size="14.00">Main</text>
</g> </g>
<!-- u21 --> <!-- u21 -->
<g id="node22" class="node"> <g id="node4" class="node">
<title>u21</title> <title>u21</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-689.95" rx="46.29" ry="18"/> <ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="742" cy="-1215.99" rx="51.99" ry="18"/>
<text text-anchor="middle" x="627" y="-686.25" font-family="Times-Roman" font-size="14.00">Validate</text> <text text-anchor="middle" x="742" y="-1212.29" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g>
<!-- u23 -->
<g id="node6" class="node">
<title>u23</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="846" cy="-1098.99" rx="38.19" ry="18"/>
<text text-anchor="middle" x="846" y="-1095.29" font-family="Times-Roman" font-size="14.00">Install</text>
</g>
<!-- u21&#45;&gt;u23 -->
<g id="edge16" class="edge">
<title>u21&#45;&gt;u23</title>
<path fill="none" stroke="black" d="M756.9,-1198.51C774.61,-1178.93 804.29,-1146.11 824.49,-1123.77"/>
<polygon fill="black" stroke="black" points="827.35,-1125.83 831.46,-1116.07 822.16,-1121.13 827.35,-1125.83"/>
</g>
<!-- u24 -->
<g id="node7" class="node">
<title>u24</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="929" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="929" y="-1095.29" font-family="Times-Roman" font-size="14.00">Set</text>
</g>
<!-- u21&#45;&gt;u24 -->
<g id="edge17" class="edge">
<title>u21&#45;&gt;u24</title>
<path fill="none" stroke="black" d="M766.45,-1199.96C801.13,-1178.63 864.45,-1139.69 900.98,-1117.22"/>
<polygon fill="black" stroke="black" points="902.97,-1120.1 909.66,-1111.88 899.31,-1114.14 902.97,-1120.1"/>
</g>
<!-- u25 -->
<g id="node8" class="node">
<title>u25</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1197" cy="-1098.99" rx="38.19" ry="18"/>
<text text-anchor="middle" x="1197" y="-1095.29" font-family="Times-Roman" font-size="14.00">UnSet</text>
</g>
<!-- u21&#45;&gt;u25 -->
<g id="edge18" class="edge">
<title>u21&#45;&gt;u25</title>
<path fill="none" stroke="black" d="M785.46,-1206.08C860.33,-1190.39 1018.18,-1155.79 1149,-1116.99 1152.09,-1116.07 1155.28,-1115.07 1158.47,-1114.03"/>
<polygon fill="black" stroke="black" points="1159.62,-1117.34 1167.97,-1110.82 1157.37,-1110.7 1159.62,-1117.34"/>
</g>
<!-- u26 -->
<g id="node9" class="node">
<title>u26</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1001" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="1001" y="-1095.29" font-family="Times-Roman" font-size="14.00">Rm</text>
</g>
<!-- u21&#45;&gt;u26 -->
<g id="edge19" class="edge">
<title>u21&#45;&gt;u26</title>
<path fill="none" stroke="black" d="M773.51,-1201.46C816.81,-1182.8 897.08,-1147.94 965,-1116.99 966.79,-1116.17 968.63,-1115.33 970.49,-1114.47"/>
<polygon fill="black" stroke="black" points="972.15,-1117.56 979.72,-1110.15 969.18,-1111.21 972.15,-1117.56"/>
</g>
<!-- u27 -->
<g id="node10" class="node">
<title>u27</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1093" cy="-1098.99" rx="47.39" ry="18"/>
<text text-anchor="middle" x="1093" y="-1095.29" font-family="Times-Roman" font-size="14.00">Compile</text>
</g>
<!-- u21&#45;&gt;u27 -->
<g id="edge20" class="edge">
<title>u21&#45;&gt;u27</title>
<path fill="none" stroke="black" d="M778.57,-1203.01C843.42,-1181.76 978.33,-1137.56 1048.47,-1114.58"/>
<polygon fill="black" stroke="black" points="1049.92,-1117.79 1058.34,-1111.35 1047.74,-1111.13 1049.92,-1117.79"/>
</g>
<!-- u28 -->
<g id="node11" class="node">
<title>u28</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="64" cy="-1098.99" rx="40.09" ry="18"/>
<text text-anchor="middle" x="64" y="-1095.29" font-family="Times-Roman" font-size="14.00">Config</text>
</g>
<!-- u21&#45;&gt;u28 -->
<g id="edge21" class="edge">
<title>u21&#45;&gt;u28</title>
<path fill="none" stroke="black" d="M692.47,-1210.33C585.48,-1199.59 325.33,-1169.91 113,-1116.99 109.85,-1116.21 106.62,-1115.31 103.4,-1114.34"/>
<polygon fill="black" stroke="black" points="104.39,-1110.98 93.8,-1111.28 102.27,-1117.65 104.39,-1110.98"/>
</g>
<!-- u29 -->
<g id="node12" class="node">
<title>u29</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="415" cy="-1098.99" rx="46.59" ry="18"/>
<text text-anchor="middle" x="415" y="-1095.29" font-family="Times-Roman" font-size="14.00">Whereis</text>
</g>
<!-- u21&#45;&gt;u29 -->
<g id="edge22" class="edge">
<title>u21&#45;&gt;u29</title>
<path fill="none" stroke="black" d="M706.69,-1202.57C646.37,-1181.36 523.67,-1138.21 458.29,-1115.21"/>
<polygon fill="black" stroke="black" points="459.28,-1111.85 448.69,-1111.84 456.96,-1118.46 459.28,-1111.85"/>
</g>
<!-- u30 -->
<g id="node13" class="node">
<title>u30</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="507" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="507" y="-1095.29" font-family="Times-Roman" font-size="14.00">List</text>
</g>
<!-- u21&#45;&gt;u30 -->
<g id="edge23" class="edge">
<title>u21&#45;&gt;u30</title>
<path fill="none" stroke="black" d="M713.18,-1200.89C668.44,-1178.99 582.69,-1137.03 537.15,-1114.75"/>
<polygon fill="black" stroke="black" points="538.6,-1111.55 528.07,-1110.3 535.52,-1117.84 538.6,-1111.55"/>
</g>
<!-- u31 -->
<g id="node14" class="node">
<title>u31</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1303" cy="-1098.99" rx="50.09" ry="18"/>
<text text-anchor="middle" x="1303" y="-1095.29" font-family="Times-Roman" font-size="14.00">Upgrade</text>
</g>
<!-- u21&#45;&gt;u31 -->
<g id="edge24" class="edge">
<title>u21&#45;&gt;u31</title>
<path fill="none" stroke="black" d="M787.97,-1207.41C876.68,-1192.47 1077.4,-1157.17 1244,-1116.99 1248.02,-1116.02 1252.18,-1114.95 1256.34,-1113.84"/>
<polygon fill="black" stroke="black" points="1257.28,-1117.21 1265.99,-1111.19 1255.42,-1110.46 1257.28,-1117.21"/>
</g>
<!-- u32 -->
<g id="node15" class="node">
<title>u32</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="614" cy="-1098.99" rx="61.99" ry="18"/>
<text text-anchor="middle" x="614" y="-1095.29" font-family="Times-Roman" font-size="14.00">ChangeLog</text>
</g>
<!-- u21&#45;&gt;u32 -->
<g id="edge25" class="edge">
<title>u21&#45;&gt;u32</title>
<path fill="none" stroke="black" d="M724.2,-1199C702.26,-1179.29 664.8,-1145.63 639.73,-1123.11"/>
<polygon fill="black" stroke="black" points="641.84,-1120.29 632.06,-1116.21 637.16,-1125.5 641.84,-1120.29"/>
</g>
<!-- u33 -->
<g id="node16" class="node">
<title>u33</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-1098.99" rx="48.19" ry="18"/>
<text text-anchor="middle" x="742" y="-1095.29" font-family="Times-Roman" font-size="14.00">Prefetch</text>
</g>
<!-- u21&#45;&gt;u33 -->
<g id="edge26" class="edge">
<title>u21&#45;&gt;u33</title>
<path fill="none" stroke="black" d="M742,-1197.52C742,-1178.93 742,-1149.23 742,-1127.49"/>
<polygon fill="black" stroke="black" points="745.5,-1127.24 742,-1117.24 738.5,-1127.24 745.5,-1127.24"/>
</g>
<!-- u34 -->
<g id="node17" class="node">
<title>u34</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="235" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="235" y="-1095.29" font-family="Times-Roman" font-size="14.00">GC</text>
</g>
<!-- u21&#45;&gt;u34 -->
<g id="edge27" class="edge">
<title>u21&#45;&gt;u34</title>
<path fill="none" stroke="black" d="M694.23,-1208.86C608.04,-1196.96 421.48,-1167.38 271,-1116.99 269.08,-1116.35 267.13,-1115.63 265.19,-1114.86"/>
<polygon fill="black" stroke="black" points="266.16,-1111.47 255.6,-1110.73 263.4,-1117.9 266.16,-1111.47"/>
</g>
<!-- u35 -->
<g id="node18" class="node">
<title>u35</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="315" cy="-1098.99" rx="35.19" ry="18"/>
<text text-anchor="middle" x="315" y="-1095.29" font-family="Times-Roman" font-size="14.00">DInfo</text>
</g>
<!-- u21&#45;&gt;u35 -->
<g id="edge28" class="edge">
<title>u21&#45;&gt;u35</title>
<path fill="none" stroke="black" d="M699.03,-1205.74C627.68,-1189.99 480.59,-1155.89 359,-1116.99 356.46,-1116.18 353.84,-1115.29 351.23,-1114.37"/>
<polygon fill="black" stroke="black" points="352.41,-1111.08 341.81,-1110.93 350,-1117.65 352.41,-1111.08"/>
</g>
<!-- u36 -->
<g id="node19" class="node">
<title>u36</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1461" cy="-1098.99" rx="90.18" ry="18"/>
<text text-anchor="middle" x="1461" y="-1095.29" font-family="Times-Roman" font-size="14.00">ToolRequirements</text>
</g>
<!-- u21&#45;&gt;u36 -->
<g id="edge29" class="edge">
<title>u21&#45;&gt;u36</title>
<path fill="none" stroke="black" d="M788.7,-1207.83C892.07,-1191.92 1148.03,-1152.27 1362,-1116.99 1369.56,-1115.74 1377.44,-1114.42 1385.32,-1113.09"/>
<polygon fill="black" stroke="black" points="1385.98,-1116.53 1395.25,-1111.41 1384.81,-1109.63 1385.98,-1116.53"/>
</g>
<!-- u37 -->
<g id="node20" class="node">
<title>u37</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="156" cy="-1098.99" rx="33.6" ry="18"/>
<text text-anchor="middle" x="156" y="-1095.29" font-family="Times-Roman" font-size="14.00">Nuke</text>
</g>
<!-- u21&#45;&gt;u37 -->
<g id="edge30" class="edge">
<title>u21&#45;&gt;u37</title>
<path fill="none" stroke="black" d="M693.33,-1209.49C597.41,-1197.93 377.73,-1167.91 199,-1116.99 196.41,-1116.25 193.76,-1115.42 191.12,-1114.52"/>
<polygon fill="black" stroke="black" points="192.23,-1111.2 181.64,-1111.08 189.84,-1117.78 192.23,-1111.2"/>
</g>
<!-- u22 -->
<g id="node5" class="node">
<title>u22</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-981.99" rx="51.19" ry="18"/>
<text text-anchor="middle" x="742" y="-978.29" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u0 -->
<g id="node33" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="705" cy="-864.99" rx="42.49" ry="18"/>
<text text-anchor="middle" x="705" y="-861.29" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u22&#45;&gt;u0 -->
<g id="edge31" class="edge">
<title>u22&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M736.54,-964.02C730.5,-945.25 720.69,-914.76 713.61,-892.76"/>
<polygon fill="black" stroke="black" points="716.88,-891.48 710.48,-883.03 710.21,-893.62 716.88,-891.48"/>
</g>
<!-- u23&#45;&gt;u22 -->
<g id="edge32" class="edge">
<title>u23&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M831.54,-1082C813.97,-1062.57 784.14,-1029.59 763.78,-1007.08"/>
<polygon fill="black" stroke="black" points="766.31,-1004.66 757.01,-999.59 761.12,-1009.35 766.31,-1004.66"/>
</g>
<!-- u24&#45;&gt;u22 -->
<g id="edge33" class="edge">
<title>u24&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M909.69,-1086.12C877.99,-1066.62 814.52,-1027.58 775.4,-1003.53"/>
<polygon fill="black" stroke="black" points="776.84,-1000.31 766.49,-998.05 773.18,-1006.27 776.84,-1000.31"/>
</g>
<!-- u25&#45;&gt;u0 -->
<g id="edge34" class="edge">
<title>u25&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1170.9,-1085.68C1088.88,-1047.01 836.24,-927.88 741.44,-883.17"/>
<polygon fill="black" stroke="black" points="742.78,-879.94 732.24,-878.84 739.8,-886.27 742.78,-879.94"/>
</g>
<!-- u26&#45;&gt;u22 -->
<g id="edge35" class="edge">
<title>u26&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M979.72,-1087.83C974.89,-1085.55 969.78,-1083.17 965,-1080.99 901.54,-1052.07 827.31,-1019.75 782.51,-1000.4"/>
<polygon fill="black" stroke="black" points="783.71,-997.11 773.14,-996.36 780.94,-1003.53 783.71,-997.11"/>
</g>
<!-- u27&#45;&gt;u22 -->
<g id="edge36" class="edge">
<title>u27&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M1058.38,-1086.65C994.71,-1065.79 859,-1021.32 787.79,-997.99"/>
<polygon fill="black" stroke="black" points="788.78,-994.63 778.19,-994.85 786.6,-1001.29 788.78,-994.63"/>
</g>
<!-- u15 -->
<g id="node28" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="705" cy="-571.99" rx="30.59" ry="18"/>
<text text-anchor="middle" x="705" y="-568.29" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u28&#45;&gt;u15 -->
<g id="edge37" class="edge">
<title>u28&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M67.99,-1080.83C82.87,-1020.89 141.11,-819.44 271,-725.99 416.7,-621.17 526.05,-761.83 668,-651.99 684.52,-639.21 693.98,-617.26 699.19,-599.74"/>
<polygon fill="black" stroke="black" points="702.58,-600.61 701.79,-590.04 695.82,-598.8 702.58,-600.61"/>
</g>
<!-- u29&#45;&gt;u22 -->
<g id="edge38" class="edge">
<title>u29&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M448.46,-1086.22C507.6,-1065.42 630.64,-1022.15 697.09,-998.78"/>
<polygon fill="black" stroke="black" points="698.59,-1001.97 706.86,-995.35 696.27,-995.36 698.59,-1001.97"/>
</g>
<!-- u30&#45;&gt;u22 -->
<g id="edge39" class="edge">
<title>u30&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M528.27,-1087.58C568.07,-1068.1 654.29,-1025.91 704.21,-1001.48"/>
<polygon fill="black" stroke="black" points="705.94,-1004.53 713.38,-996.99 702.86,-998.25 705.94,-1004.53"/>
</g>
<!-- u31&#45;&gt;u0 -->
<g id="edge40" class="edge">
<title>u31&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1271.29,-1084.99C1209.35,-1059.66 1067.86,-1002.15 948,-955.99 877.11,-928.69 794.01,-898.24 745.65,-880.68"/>
<polygon fill="black" stroke="black" points="746.76,-877.36 736.17,-877.24 744.37,-883.94 746.76,-877.36"/>
</g>
<!-- u32&#45;&gt;u22 -->
<g id="edge41" class="edge">
<title>u32&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M632.07,-1081.76C654.08,-1061.98 691.42,-1028.44 716.39,-1006"/>
<polygon fill="black" stroke="black" points="718.92,-1008.43 724.02,-999.14 714.25,-1003.22 718.92,-1008.43"/>
</g>
<!-- u33&#45;&gt;u22 -->
<g id="edge42" class="edge">
<title>u33&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M742,-1080.52C742,-1061.93 742,-1032.23 742,-1010.49"/>
<polygon fill="black" stroke="black" points="745.5,-1010.24 742,-1000.24 738.5,-1010.24 745.5,-1010.24"/>
</g>
<!-- u34&#45;&gt;u0 -->
<g id="edge43" class="edge">
<title>u34&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M253.73,-1086.02C294.34,-1060.34 393.93,-998.82 482,-955.99 543.91,-925.88 618.59,-897.22 663.9,-880.63"/>
<polygon fill="black" stroke="black" points="665.18,-883.89 673.38,-877.18 662.79,-877.31 665.18,-883.89"/>
</g>
<!-- u35&#45;&gt;u0 -->
<g id="edge44" class="edge">
<title>u35&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M337.09,-1084.85C402.43,-1045.98 595.06,-931.39 672.36,-885.41"/>
<polygon fill="black" stroke="black" points="674.39,-888.27 681.2,-880.15 670.81,-882.25 674.39,-888.27"/>
</g>
<!-- u14 -->
<g id="node36" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="934" cy="-743.99" rx="48.19" ry="18"/>
<text text-anchor="middle" x="934" y="-740.29" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u36&#45;&gt;u14 -->
<g id="edge45" class="edge">
<title>u36&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M1436.29,-1081.44C1349.76,-1023.48 1060.5,-829.72 964.94,-765.71"/>
<polygon fill="black" stroke="black" points="966.82,-762.76 956.56,-760.1 962.93,-768.58 966.82,-762.76"/>
</g>
<!-- u18 -->
<g id="node37" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1461" cy="-743.99" rx="73.39" ry="18"/>
<text text-anchor="middle" x="1461" y="-740.29" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u36&#45;&gt;u18 -->
<g id="edge46" class="edge">
<title>u36&#45;&gt;u18</title>
<path fill="none" stroke="black" d="M1461,-1080.96C1461,-1024.36 1461,-842.13 1461,-772.44"/>
<polygon fill="black" stroke="black" points="1464.5,-772.26 1461,-762.26 1457.5,-772.26 1464.5,-772.26"/>
</g>
<!-- u37&#45;&gt;u0 -->
<g id="edge47" class="edge">
<title>u37&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M175.44,-1084.01C214.9,-1056.2 307.95,-993.37 394,-955.99 483.86,-916.95 595.52,-889.35 657.64,-875.71"/>
<polygon fill="black" stroke="black" points="658.52,-879.1 667.55,-873.56 657.03,-872.26 658.52,-879.1"/>
</g>
<!-- u3 -->
<g id="node21" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1257" cy="-319.99" rx="36.29" ry="18"/>
<text text-anchor="middle" x="1257" y="-316.29" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node22" class="node">
<title>u4</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1329" cy="-436.99" rx="39.79" ry="18"/>
<text text-anchor="middle" x="1329" y="-433.29" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge48" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1318.68,-419.51C1306.65,-400.3 1286.64,-368.33 1272.68,-346.04"/>
<polygon fill="black" stroke="black" points="1275.57,-344.05 1267.3,-337.44 1269.64,-347.77 1275.57,-344.05"/>
</g>
<!-- u6 -->
<g id="node29" class="node">
<title>u6</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="934" cy="-571.99" rx="64.19" ry="18"/>
<text text-anchor="middle" x="934" y="-568.29" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge49" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M1225.64,-453.75C1216.72,-464.19 1203.86,-477.47 1190,-485.99 1117.08,-530.81 1088.16,-518.79 1007,-545.99 999.06,-548.65 990.64,-551.5 982.45,-554.3"/>
<polygon fill="black" stroke="black" points="981.32,-550.99 972.99,-557.53 983.58,-557.61 981.32,-550.99"/>
</g>
<!-- u7 -->
<g id="node30" class="node">
<title>u7</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-319.99" rx="44.39" ry="18"/>
<text text-anchor="middle" x="1030" y="-316.29" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge50" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M1218.11,-422.39C1212.34,-418.59 1205.98,-414.53 1200,-410.99 1154.95,-384.33 1101.33,-356.57 1066.52,-339.06"/>
<polygon fill="black" stroke="black" points="1067.74,-335.75 1057.23,-334.4 1064.6,-342.01 1067.74,-335.75"/>
</g>
<!-- u9 -->
<g id="node25" class="node">
<title>u9</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="803" cy="-436.99" rx="51.19" ry="18"/>
<text text-anchor="middle" x="803" y="-433.29" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge59" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M822.17,-553.87C818.46,-531.43 811.9,-491.79 807.5,-465.2"/>
<polygon fill="black" stroke="black" points="810.91,-464.33 805.82,-455.04 804,-465.48 810.91,-464.33"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge60" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M831.29,-421.66C872.57,-400.75 949.27,-361.89 994.36,-339.05"/>
<polygon fill="black" stroke="black" points="996.13,-342.07 1003.47,-334.43 992.97,-335.83 996.13,-342.07"/>
</g>
<!-- u10 -->
<g id="node26" class="node">
<title>u10</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1030" cy="-80.99" rx="27" ry="18"/>
<text text-anchor="middle" x="1030" y="-77.29" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node27" class="node">
<title>u16</title>
<ellipse fill="#7777ff" stroke="black" stroke-width="0" cx="629" cy="-571.99" rx="27" ry="18"/>
<text text-anchor="middle" x="629" y="-568.29" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15&#45;&gt;u1 -->
<g id="edge51" class="edge">
<title>u15&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M707.81,-589.96C711.74,-608.15 720.7,-636.49 740,-651.99 869.4,-755.91 944.8,-686.54 1106,-725.99 1109.21,-726.78 1112.51,-727.62 1115.82,-728.5"/>
<polygon fill="black" stroke="black" points="1115.2,-731.95 1125.77,-731.2 1117.04,-725.2 1115.2,-731.95"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge52" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M972.89,-557.62C1042.12,-533.81 1179.56,-486.5 1180,-485.99 1202.36,-460.38 1181.75,-442.3 1195,-410.99 1205.36,-386.51 1222.94,-361.88 1236.75,-344.58"/>
<polygon fill="black" stroke="black" points="1239.56,-346.68 1243.17,-336.72 1234.13,-342.25 1239.56,-346.68"/>
</g>
<!-- u8 -->
<g id="node31" class="node">
<title>u8</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-202.99" rx="42.49" ry="18"/>
<text text-anchor="middle" x="1030" y="-199.29" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge54" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1030,-301.52C1030,-282.93 1030,-253.23 1030,-231.49"/>
<polygon fill="black" stroke="black" points="1033.5,-231.24 1030,-221.24 1026.5,-231.24 1033.5,-231.24"/>
</g>
<!-- u2 -->
<g id="node34" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1128" cy="-436.99" rx="37.89" ry="18"/>
<text text-anchor="middle" x="1128" y="-433.29" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge53" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M1043.83,-337.21C1060.5,-356.78 1088.66,-389.83 1107.78,-412.26"/>
<polygon fill="black" stroke="black" points="1105.22,-414.66 1114.37,-420 1110.55,-410.12 1105.22,-414.66"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge55" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M1072.08,-205.27C1132.49,-209.51 1242.99,-226.65 1302,-293.99 1329.81,-325.73 1332.74,-377.05 1331.47,-408.52"/>
<polygon fill="black" stroke="black" points="1327.96,-408.58 1330.88,-418.77 1334.95,-408.98 1327.96,-408.58"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge56" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1014.36,-219.98C975.12,-260.08 872.38,-365.08 826.14,-412.34"/>
<polygon fill="black" stroke="black" points="823.45,-410.08 818.96,-419.68 828.46,-414.98 823.45,-410.08"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge57" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M1030,-184.8C1030,-165.1 1030,-132.57 1030,-109.38"/>
<polygon fill="black" stroke="black" points="1033.5,-109.15 1030,-99.15 1026.5,-109.15 1033.5,-109.15"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge58" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1062.1,-557.23C1067.11,-553.42 1072.68,-549.4 1078,-545.99 1125.54,-515.51 1144.66,-519.65 1190,-485.99 1199.71,-478.78 1209.34,-469.64 1217.41,-461.28"/>
<polygon fill="black" stroke="black" points="1220.04,-463.58 1224.33,-453.89 1214.94,-458.8 1220.04,-463.58"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M700.59,-847.09C687.91,-798.57 651.35,-658.57 635.96,-599.64"/>
<polygon fill="black" stroke="black" points="639.34,-598.73 633.43,-589.94 632.57,-600.5 639.34,-598.73"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M705,-846.66C705,-797.93 705,-659.45 705,-600.31"/>
<polygon fill="black" stroke="black" points="708.5,-600.23 705,-590.23 701.5,-600.23 708.5,-600.23"/>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge2" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M730.82,-850.57C771.64,-829.36 851.2,-788.02 897.73,-763.84"/>
<polygon fill="black" stroke="black" points="899.59,-766.81 906.85,-759.1 896.37,-760.6 899.59,-766.81"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge5" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1145.13,-420.72C1167.39,-400.87 1206.44,-366.06 1232.01,-343.27"/>
<polygon fill="black" stroke="black" points="1234.66,-345.59 1239.8,-336.32 1230.01,-340.37 1234.66,-345.59"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge6" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1413.93,-553.61C1413.03,-522.51 1407.48,-456.35 1378,-410.99 1356.72,-378.25 1319.17,-353.11 1291.53,-337.83"/>
<polygon fill="black" stroke="black" points="1293.04,-334.67 1282.57,-333.03 1289.73,-340.84 1293.04,-334.67"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge7" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M970.19,-731.9C1005.99,-718.88 1059.19,-693.62 1086,-651.99 1111.67,-612.13 1073.1,-586.34 1098,-545.99 1123.63,-504.44 1152.09,-516.75 1190,-485.99 1199.39,-478.37 1208.96,-469.15 1217.06,-460.83"/>
<polygon fill="black" stroke="black" points="1219.67,-463.17 1224.04,-453.52 1214.6,-458.34 1219.67,-463.17"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge8" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M917.2,-726.88C899.99,-709.65 873.37,-680.88 856,-651.99 846.1,-635.52 838.24,-615.33 832.91,-599.48"/>
<polygon fill="black" stroke="black" points="836.18,-598.22 829.78,-589.77 829.52,-600.36 836.18,-598.22"/>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge10" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1467.83,-725.94C1481.37,-689.08 1507.02,-600.87 1467,-545.99 1415.57,-475.47 1352.95,-533.91 1280,-485.99 1270.56,-479.79 1261.98,-470.91 1255.06,-462.47"/>
<polygon fill="black" stroke="black" points="1257.62,-460.06 1248.74,-454.29 1252.09,-464.34 1257.62,-460.06"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge9" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M1456.23,-725.75C1448.05,-696.15 1431.26,-635.42 1421.5,-600.1"/>
<polygon fill="black" stroke="black" points="1424.75,-598.72 1418.71,-590.02 1418,-600.59 1424.75,-598.72"/>
</g>
<!-- u20 -->
<g id="node38" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="742" cy="-1387.99" rx="32.49" ry="18"/>
<text text-anchor="middle" x="742" y="-1384.29" font-family="Times-Roman" font-size="14.00">Main</text>
</g> </g>
<!-- u20&#45;&gt;u21 --> <!-- u20&#45;&gt;u21 -->
<g id="edge1" class="edge"> <g id="edge1" class="edge">
<title>u20&#45;&gt;u21</title> <title>u20&#45;&gt;u21</title>
<path fill="none" stroke="black" d="M627,-751.64C627,-741.85 627,-729.38 627,-718.29"/> <path fill="none" stroke="black" d="M742,-1369.75C742,-1340.15 742,-1279.42 742,-1244.1"/>
<polygon fill="black" stroke="black" points="630.5,-718.22 627,-708.22 623.5,-718.22 630.5,-718.22"/> <polygon fill="black" stroke="black" points="745.5,-1244.02 742,-1234.02 738.5,-1244.02 745.5,-1244.02"/>
</g>
<!-- u21&#45;&gt;u0 -->
<g id="edge2" class="edge">
<title>u21&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M627,-671.56C627,-660.73 627,-646.56 627,-634.25"/>
<polygon fill="black" stroke="black" points="630.5,-634.04 627,-624.04 623.5,-634.04 630.5,-634.04"/>
</g> </g>
</g> </g>
</svg> </svg>

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 32 KiB

View File

@@ -4,363 +4,638 @@
<!-- Generated by graphviz version 2.44.0 (0) <!-- Generated by graphviz version 2.44.0 (0)
--> -->
<!-- Title: G Pages: 1 --> <!-- Title: G Pages: 1 -->
<svg width="1075pt" height="648pt" <svg width="1076pt" height="648pt"
viewBox="0.00 0.00 1075.16 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"> viewBox="0.00 0.00 1076.37 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.91 0.91) rotate(0) translate(4 710)"> <g id="graph0" class="graph" transform="scale(0.68 0.68) rotate(0) translate(4 949)">
<title>G</title> <title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-710 1180.67,-710 1180.67,4 -4,4"/> <polygon fill="white" stroke="transparent" points="-4,4 -4,-949 1579,-949 1579,4 -4,4"/>
<g id="clust1" class="cluster"> <g id="clust1" class="cluster">
<title>cluster_0</title> <title>cluster_0</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="10.72,-8 10.72,-590 1165.95,-590 1165.95,-8 10.72,-8"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-8.66 8,-897.37 1567,-897.37 1567,-8.66 8,-8.66"/>
<text text-anchor="middle" x="588.33" y="-574.8" font-family="Times-Roman" font-size="14.00">GHCup</text> <text text-anchor="middle" x="787.5" y="-882.17" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g> </g>
<g id="clust2" class="cluster"> <g id="clust2" class="cluster">
<title>cluster_1</title> <title>cluster_1</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="254.63,-326 254.63,-484 603.08,-484 603.08,-326 254.63,-326"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1102,-352.89 1102,-548.81 1362,-548.81 1362,-352.89 1102,-352.89"/>
<text text-anchor="middle" x="428.85" y="-468.8" font-family="Times-Roman" font-size="14.00">Download</text> <text text-anchor="middle" x="1232" y="-533.61" font-family="Times-Roman" font-size="14.00">Download</text>
</g> </g>
<g id="clust3" class="cluster"> <g id="clust3" class="cluster">
<title>cluster_2</title> <title>cluster_2</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="363.19,-171 363.19,-318 605.76,-318 605.76,-171 363.19,-171"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="16,-626.75 16,-863.81 1559,-863.81 1559,-626.75 16,-626.75"/>
<text text-anchor="middle" x="484.47" y="-302.8" font-family="Times-Roman" font-size="14.00">Types</text> <text text-anchor="middle" x="787.5" y="-848.61" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g> </g>
<g id="clust4" class="cluster"> <g id="clust4" class="cluster">
<title>cluster_3</title> <title>cluster_3</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="758.53,-16 758.53,-515 1155.22,-515 1155.22,-16 758.53,-16"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1196,-185.1 1196,-344.23 1377,-344.23 1377,-185.1 1196,-185.1"/>
<text text-anchor="middle" x="956.88" y="-499.8" font-family="Times-Roman" font-size="14.00">Utils</text> <text text-anchor="middle" x="1286.5" y="-329.03" font-family="Times-Roman" font-size="14.00">Types</text>
</g> </g>
<g id="clust5" class="cluster"> <g id="clust5" class="cluster">
<title>cluster_4</title> <title>cluster_4</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="857.71,-243 857.71,-401 1015.85,-401 1015.85,-243 857.71,-243"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="586,-17.32 586,-467.63 1082,-467.63 1082,-17.32 586,-17.32"/>
<text text-anchor="middle" x="936.78" y="-385.8" font-family="Times-Roman" font-size="14.00">File</text> <text text-anchor="middle" x="834" y="-452.43" font-family="Times-Roman" font-size="14.00">Utils</text>
</g> </g>
<g id="clust6" class="cluster"> <g id="clust6" class="cluster">
<title>cluster_5</title> <title>cluster_5</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="781.32,-24 781.32,-99 875.13,-99 875.13,-24 781.32,-24"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="744,-263.04 744,-434.07 862,-434.07 862,-263.04 744,-263.04"/>
<text text-anchor="middle" x="828.22" y="-83.8" font-family="Times-Roman" font-size="14.00">String</text> <text text-anchor="middle" x="803" y="-418.87" font-family="Times-Roman" font-size="14.00">File</text>
</g> </g>
<g id="clust7" class="cluster"> <g id="clust7" class="cluster">
<title>cluster_6</title> <title>cluster_6</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="954.2,-409 954.2,-484 1048.01,-484 1048.01,-409 954.2,-409"/> <polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="995,-25.98 995,-107.16 1065,-107.16 1065,-25.98 995,-25.98"/>
<text text-anchor="middle" x="1001.1" y="-468.8" font-family="Times-Roman" font-size="14.00">Version</text> <text text-anchor="middle" x="1030" y="-91.96" font-family="Times-Roman" font-size="14.00">String</text>
</g>
<g id="clust8" class="cluster">
<title>cluster_7</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="594,-352.89 594,-434.07 664,-434.07 664,-352.89 594,-352.89"/>
<text text-anchor="middle" x="629" y="-418.87" font-family="Times-Roman" font-size="14.00">Version</text>
</g> </g>
<!-- u1 --> <!-- u1 -->
<g id="node1" class="node"> <g id="node1" class="node">
<title>u1</title> <title>u1</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="518.39" cy="-435" rx="55.49" ry="18"/> <ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1165" cy="-495.66" rx="55.49" ry="18"/>
<text text-anchor="middle" x="518.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Download</text> <text text-anchor="middle" x="1165" y="-491.96" font-family="Times-Roman" font-size="14.00">Download</text>
</g> </g>
<!-- u12 --> <!-- u12 -->
<g id="node7" class="node"> <g id="node24" class="node">
<title>u12</title> <title>u12</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="922.39" cy="-352" rx="27" ry="18"/> <ellipse fill="#ffbbff" stroke="black" stroke-width="2" cx="825" cy="-380.66" rx="27" ry="18"/>
<text text-anchor="middle" x="922.39" y="-348.3" font-family="Times-Roman" font-size="14.00">File</text> <text text-anchor="middle" x="825" y="-376.96" font-family="Times-Roman" font-size="14.00">File</text>
</g> </g>
<!-- u1&#45;&gt;u12 --> <!-- u1&#45;&gt;u12 -->
<g id="edge15" class="edge"> <g id="edge13" class="edge">
<title>u1&#45;&gt;u12</title> <title>u1&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M546.79,-419.43C556.27,-415.25 567.06,-411.24 577.39,-409 594.44,-405.31 876.17,-409.54 891.39,-401 900.16,-396.08 906.84,-387.53 911.72,-379"/> <path fill="none" stroke="black" d="M1127.19,-482.48C1120.21,-480.6 1112.93,-478.88 1106,-477.66 1078.58,-472.83 878.46,-477.12 856,-460.66 839.51,-448.58 831.79,-426.38 828.17,-408.59"/>
<polygon fill="black" stroke="black" points="914.92,-380.43 916.31,-369.92 908.67,-377.26 914.92,-380.43"/> <polygon fill="black" stroke="black" points="831.62,-407.99 826.49,-398.73 824.72,-409.17 831.62,-407.99"/>
</g> </g>
<!-- u11 --> <!-- u11 -->
<g id="node15" class="node"> <g id="node32" class="node">
<title>u11</title> <title>u11</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="808.39" cy="-352" rx="28.7" ry="18"/> <ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1045" cy="-380.66" rx="28.7" ry="18"/>
<text text-anchor="middle" x="808.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Dirs</text> <text text-anchor="middle" x="1045" y="-376.96" font-family="Times-Roman" font-size="14.00">Dirs</text>
</g> </g>
<!-- u1&#45;&gt;u11 --> <!-- u1&#45;&gt;u11 -->
<g id="edge14" class="edge"> <g id="edge12" class="edge">
<title>u1&#45;&gt;u11</title> <title>u1&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M548.95,-419.93C557.99,-416.08 567.99,-412.11 577.39,-409 586.69,-405.92 709.34,-376.59 772.03,-361.65"/> <path fill="none" stroke="black" d="M1130.87,-481.48C1119.63,-476.1 1107.57,-469.13 1098,-460.66 1081.15,-445.74 1067.22,-424.32 1057.88,-407.55"/>
<polygon fill="black" stroke="black" points="772.99,-365.02 781.91,-359.3 771.37,-358.21 772.99,-365.02"/> <polygon fill="black" stroke="black" points="1060.73,-405.46 1052.92,-398.3 1054.56,-408.76 1060.73,-405.46"/>
</g> </g>
<!-- u13 --> <!-- u13 -->
<g id="node18" class="node"> <g id="node35" class="node">
<title>u13</title> <title>u13</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-269" rx="44.39" ry="18"/> <ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1414" cy="-380.66" rx="44.39" ry="18"/>
<text text-anchor="middle" x="146.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Version</text> <text text-anchor="middle" x="1414" y="-376.96" font-family="Times-Roman" font-size="14.00">Version</text>
</g> </g>
<!-- u1&#45;&gt;u13 --> <!-- u1&#45;&gt;u13 -->
<g id="edge13" class="edge"> <g id="edge11" class="edge">
<title>u1&#45;&gt;u13</title> <title>u1&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M477.97,-422.58C457.84,-417.42 433.02,-411.85 410.39,-409 400.85,-407.8 71.11,-407.88 64.39,-401 41.09,-377.16 48.83,-355.48 64.39,-326 73.49,-308.76 90.55,-295.83 106.76,-286.76"/> <path fill="none" stroke="black" d="M1205.09,-483.12C1212.97,-481.1 1221.21,-479.17 1229,-477.66 1259.12,-471.82 1340.24,-477.32 1366,-460.66 1384.87,-448.45 1397.46,-425.95 1405,-408.08"/>
<polygon fill="black" stroke="black" points="108.39,-289.86 115.62,-282.11 105.14,-283.66 108.39,-289.86"/> <polygon fill="black" stroke="black" points="1408.27,-409.31 1408.67,-398.72 1401.76,-406.75 1408.27,-409.31"/>
</g> </g>
<!-- u17 --> <!-- u17 -->
<g id="node2" class="node"> <g id="node2" class="node">
<title>u17</title> <title>u17</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="445.39" cy="-352" rx="30.59" ry="18"/> <ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1267" cy="-380.66" rx="30.59" ry="18"/>
<text text-anchor="middle" x="445.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Utils</text> <text text-anchor="middle" x="1267" y="-376.96" font-family="Times-Roman" font-size="14.00">Utils</text>
</g> </g>
<!-- u5 --> <!-- u5 -->
<g id="node6" class="node"> <g id="node23" class="node">
<title>u5</title> <title>u5</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="549.39" cy="-269" rx="33.6" ry="18"/> <ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1238" cy="-291.66" rx="33.6" ry="18"/>
<text text-anchor="middle" x="549.39" y="-265.3" font-family="Times-Roman" font-size="14.00">JSON</text> <text text-anchor="middle" x="1238" y="-287.96" font-family="Times-Roman" font-size="14.00">JSON</text>
</g> </g>
<!-- u17&#45;&gt;u5 --> <!-- u17&#45;&gt;u5 -->
<g id="edge16" class="edge"> <g id="edge14" class="edge">
<title>u17&#45;&gt;u5</title> <title>u17&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M463.03,-337.26C479.49,-324.44 504.26,-305.15 523.05,-290.51"/> <path fill="none" stroke="black" d="M1261.41,-362.89C1257.3,-350.57 1251.64,-333.58 1246.91,-319.4"/>
<polygon fill="black" stroke="black" points="525.22,-293.26 530.96,-284.35 520.92,-287.74 525.22,-293.26"/> <polygon fill="black" stroke="black" points="1250.16,-318.06 1243.67,-309.68 1243.52,-320.27 1250.16,-318.06"/>
</g> </g>
<!-- u19 --> <!-- u19 -->
<g id="node3" class="node"> <g id="node3" class="node">
<title>u19</title> <title>u19</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="343.39" cy="-435" rx="57.69" ry="18"/> <ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1296" cy="-495.66" rx="57.69" ry="18"/>
<text text-anchor="middle" x="343.39" y="-431.3" font-family="Times-Roman" font-size="14.00">IOStreams</text> <text text-anchor="middle" x="1296" y="-491.96" font-family="Times-Roman" font-size="14.00">IOStreams</text>
</g> </g>
<!-- u19&#45;&gt;u17 --> <!-- u19&#45;&gt;u17 -->
<g id="edge17" class="edge"> <g id="edge15" class="edge">
<title>u19&#45;&gt;u17</title> <title>u19&#45;&gt;u17</title>
<path fill="none" stroke="black" d="M378.72,-420.5C389.55,-415.38 401.06,-408.84 410.39,-401 418.16,-394.47 425.12,-385.87 430.76,-377.75"/> <path fill="none" stroke="black" d="M1291.6,-477.5C1286.88,-459.14 1279.35,-429.78 1273.86,-408.39"/>
<polygon fill="black" stroke="black" points="433.77,-379.54 436.33,-369.25 427.92,-375.7 433.77,-379.54"/> <polygon fill="black" stroke="black" points="1277.23,-407.43 1271.35,-398.61 1270.45,-409.17 1277.23,-407.43"/>
</g>
<!-- u3 -->
<g id="node4" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="534.39" cy="-197" rx="36.29" ry="18"/>
<text text-anchor="middle" x="534.39" y="-193.3" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node5" class="node">
<title>u4</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="427.39" cy="-269" rx="39.79" ry="18"/>
<text text-anchor="middle" x="427.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge18" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M449.04,-253.83C464.95,-243.42 486.78,-229.15 504.37,-217.64"/>
<polygon fill="black" stroke="black" points="506.68,-220.31 513.13,-211.91 502.85,-214.45 506.68,-220.31"/>
</g>
<!-- u6 -->
<g id="node12" class="node">
<title>u6</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="855.39" cy="-435" rx="64.19" ry="18"/>
<text text-anchor="middle" x="855.39" y="-431.3" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge19" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M566.7,-284.68C579.52,-295.01 597.75,-308.62 615.39,-318 624.58,-322.89 630.09,-318.59 637.39,-326 662.15,-351.13 635.32,-379.63 663.39,-401 674.37,-409.36 773.88,-406.14 787.39,-409 795.7,-410.76 804.37,-413.33 812.61,-416.16"/>
<polygon fill="black" stroke="black" points="811.46,-419.47 822.06,-419.57 813.84,-412.88 811.46,-419.47"/>
</g>
<!-- u7 -->
<g id="node13" class="node">
<title>u7</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="828.39" cy="-197" rx="44.39" ry="18"/>
<text text-anchor="middle" x="828.39" y="-193.3" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge20" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M567.9,-253.71C573.85,-249.71 580.65,-245.72 587.39,-243 648.94,-218.19 724.91,-206.91 774.9,-201.88"/>
<polygon fill="black" stroke="black" points="775.54,-205.33 785.16,-200.9 774.87,-198.36 775.54,-205.33"/>
</g>
<!-- u9 -->
<g id="node8" class="node">
<title>u9</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="936.39" cy="-269" rx="51.19" ry="18"/>
<text text-anchor="middle" x="936.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge30" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M925.36,-333.82C927.2,-323.19 929.6,-309.31 931.69,-297.2"/>
<polygon fill="black" stroke="black" points="935.17,-297.6 933.42,-287.15 928.27,-296.41 935.17,-297.6"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge31" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M912.96,-252.81C897.32,-242.68 876.58,-229.24 859.56,-218.2"/>
<polygon fill="black" stroke="black" points="861.33,-215.18 851.04,-212.68 857.53,-221.06 861.33,-215.18"/>
</g>
<!-- u10 -->
<g id="node9" class="node">
<title>u10</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="828.39" cy="-50" rx="27" ry="18"/>
<text text-anchor="middle" x="828.39" y="-46.3" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node10" class="node">
<title>u16</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1001.39" cy="-435" rx="27" ry="18"/>
<text text-anchor="middle" x="1001.39" y="-431.3" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15 -->
<g id="node11" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1103.39" cy="-435" rx="30.59" ry="18"/>
<text text-anchor="middle" x="1103.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u15&#45;&gt;u12 -->
<g id="edge22" class="edge">
<title>u15&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M1080.91,-422.68C1072.07,-418.31 1061.8,-413.33 1052.39,-409 1019.33,-393.79 981.02,-377.44 954.59,-366.35"/>
<polygon fill="black" stroke="black" points="955.66,-363.01 945.08,-362.38 952.96,-369.47 955.66,-363.01"/>
</g>
<!-- u15&#45;&gt;u11 -->
<g id="edge21" class="edge">
<title>u15&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M1082.81,-421.48C1073.8,-416.65 1062.9,-411.66 1052.39,-409 1009.49,-398.14 893.64,-419.41 853.39,-401 842.1,-395.84 832.28,-386.4 824.72,-377.25"/>
<polygon fill="black" stroke="black" points="827.3,-374.87 818.44,-369.07 821.75,-379.13 827.3,-374.87"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge23" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M817.86,-420.3C799.34,-413.36 779.12,-405.48 770.39,-401 716.1,-373.14 711.12,-350.84 655.39,-326 642.79,-320.38 635.87,-326.98 625.39,-318 597.74,-294.3 614.8,-271.71 592.39,-243 584.81,-233.29 574.68,-224.49 565.01,-217.31"/>
<polygon fill="black" stroke="black" points="566.89,-214.35 556.71,-211.43 562.85,-220.06 566.89,-214.35"/>
</g>
<!-- u8 -->
<g id="node14" class="node">
<title>u8</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="828.39" cy="-125" rx="42.49" ry="18"/>
<text text-anchor="middle" x="828.39" y="-121.3" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge25" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M828.39,-178.7C828.39,-170.98 828.39,-161.71 828.39,-153.11"/>
<polygon fill="black" stroke="black" points="831.89,-153.1 828.39,-143.1 824.89,-153.1 831.89,-153.1"/>
</g>
<!-- u2 -->
<g id="node17" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="696.39" cy="-269" rx="37.89" ry="18"/>
<text text-anchor="middle" x="696.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge24" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M802.53,-211.71C781.65,-222.79 752.12,-238.45 729.51,-250.44"/>
<polygon fill="black" stroke="black" points="727.8,-247.38 720.6,-255.16 731.07,-253.57 727.8,-247.38"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge26" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M786.3,-127.22C706.73,-130.23 537.84,-140.15 489.39,-171 463.54,-187.46 446.42,-218.99 436.84,-241.64"/>
<polygon fill="black" stroke="black" points="433.54,-240.45 433.08,-251.04 440.04,-243.06 433.54,-240.45"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge27" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M849.03,-140.76C859.52,-148.9 872,-159.65 881.39,-171 899.5,-192.89 914.92,-221.56 924.79,-242.04"/>
<polygon fill="black" stroke="black" points="921.62,-243.54 929.04,-251.1 927.96,-240.56 921.62,-243.54"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge28" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M828.39,-106.7C828.39,-98.25 828.39,-87.87 828.39,-78.37"/>
<polygon fill="black" stroke="black" points="831.89,-78.18 828.39,-68.18 824.89,-78.18 831.89,-78.18"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge29" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M781.07,-346.57C749.06,-341.43 694.42,-332.79 647.39,-326 620.76,-322.16 610.78,-331.29 587.39,-318 577.83,-312.56 569.78,-303.68 563.6,-295.02"/>
<polygon fill="black" stroke="black" points="566.46,-293 558.04,-286.57 560.61,-296.85 566.46,-293"/>
</g>
<!-- u0 -->
<g id="node16" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="840.39" cy="-541" rx="42.49" ry="18"/>
<text text-anchor="middle" x="840.39" y="-537.3" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u0&#45;&gt;u1 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M798.15,-540.08C733.62,-539.53 614.12,-535.65 577.39,-515 556.17,-503.07 540.32,-480.02 530.42,-461.88"/>
<polygon fill="black" stroke="black" points="533.49,-460.2 525.79,-452.93 527.27,-463.42 533.49,-460.2"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge6" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M881.32,-536.43C914.21,-532.8 957.04,-526.09 970.39,-515 985.87,-502.13 993.66,-480.49 997.55,-463.11"/>
<polygon fill="black" stroke="black" points="1001.06,-463.44 999.51,-452.96 994.18,-462.12 1001.06,-463.44"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge5" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M882.83,-539.21C936.42,-537.51 1024.95,-532.11 1052.39,-515 1071.91,-502.83 1085.39,-480.12 1093.57,-462.17"/>
<polygon fill="black" stroke="black" points="1096.87,-463.35 1097.57,-452.78 1090.43,-460.6 1096.87,-463.35"/>
</g>
<!-- u14 -->
<g id="node19" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="680.39" cy="-435" rx="48.19" ry="18"/>
<text text-anchor="middle" x="680.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M801.74,-533.4C786.24,-529.61 768.7,-523.78 754.39,-515 731.68,-501.06 711.42,-478.33 697.87,-460.82"/>
<polygon fill="black" stroke="black" points="700.58,-458.59 691.78,-452.7 694.98,-462.8 700.58,-458.59"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge7" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M669.27,-256.28C642.05,-244.52 599.95,-226.33 570.04,-213.4"/>
<polygon fill="black" stroke="black" points="571.35,-210.16 560.79,-209.41 568.58,-216.59 571.35,-210.16"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge8" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M186.09,-260.84C259.14,-247.66 414.32,-219.66 490.43,-205.93"/>
<polygon fill="black" stroke="black" points="491.41,-209.31 500.63,-204.09 490.17,-202.42 491.41,-209.31"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge9" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M656.5,-419.22C649.64,-414.1 642.62,-407.9 637.39,-401 615.71,-372.38 627.41,-355.8 607.39,-326 598.66,-313.01 586.48,-300.68 575.54,-290.91"/>
<polygon fill="black" stroke="black" points="577.72,-288.16 567.86,-284.28 573.14,-293.46 577.72,-288.16"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge10" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M711.94,-421.27C724.88,-416.59 740.15,-411.77 754.39,-409 784.33,-403.18 865.04,-416.36 891.39,-401 900.07,-395.94 906.74,-387.36 911.63,-378.84"/>
<polygon fill="black" stroke="black" points="914.82,-380.3 916.24,-369.8 908.58,-377.12 914.82,-380.3"/>
</g>
<!-- u18 -->
<g id="node20" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-352" rx="73.39" ry="18"/>
<text text-anchor="middle" x="146.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge12" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M192.35,-337.85C210.3,-333.27 231.16,-328.62 250.39,-326 300.18,-319.2 428.51,-333.26 476.39,-318 493.93,-312.41 511.26,-301.32 524.62,-291.22"/>
<polygon fill="black" stroke="black" points="527.1,-293.72 532.79,-284.78 522.77,-288.22 527.1,-293.72"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge11" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M146.39,-333.82C146.39,-323.19 146.39,-309.31 146.39,-297.2"/>
<polygon fill="black" stroke="black" points="149.89,-297.15 146.39,-287.15 142.89,-297.15 149.89,-297.15"/>
</g>
<!-- u20 -->
<g id="node21" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-688" rx="32.49" ry="18"/>
<text text-anchor="middle" x="840.39" y="-684.3" font-family="Times-Roman" font-size="14.00">Main</text>
</g> </g>
<!-- u21 --> <!-- u21 -->
<g id="node22" class="node"> <g id="node4" class="node">
<title>u21</title> <title>u21</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-616" rx="46.29" ry="18"/> <ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="742" cy="-810.66" rx="51.99" ry="18"/>
<text text-anchor="middle" x="840.39" y="-612.3" font-family="Times-Roman" font-size="14.00">Validate</text> <text text-anchor="middle" x="742" y="-806.96" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g>
<!-- u23 -->
<g id="node6" class="node">
<title>u23</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="846" cy="-732.66" rx="38.19" ry="18"/>
<text text-anchor="middle" x="846" y="-728.96" font-family="Times-Roman" font-size="14.00">Install</text>
</g>
<!-- u21&#45;&gt;u23 -->
<g id="edge16" class="edge">
<title>u21&#45;&gt;u23</title>
<path fill="none" stroke="black" d="M763.3,-794.1C778.98,-782.63 800.48,-766.92 817.63,-754.39"/>
<polygon fill="black" stroke="black" points="820.13,-756.9 826.14,-748.17 816,-751.25 820.13,-756.9"/>
</g>
<!-- u24 -->
<g id="node7" class="node">
<title>u24</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="929" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="929" y="-728.96" font-family="Times-Roman" font-size="14.00">Set</text>
</g>
<!-- u21&#45;&gt;u24 -->
<g id="edge17" class="edge">
<title>u21&#45;&gt;u24</title>
<path fill="none" stroke="black" d="M776.15,-797.08C806.94,-785.56 853.32,-767.76 893,-750.66 894.81,-749.88 896.66,-749.06 898.53,-748.23"/>
<polygon fill="black" stroke="black" points="900.16,-751.33 907.79,-743.97 897.24,-744.97 900.16,-751.33"/>
</g>
<!-- u25 -->
<g id="node8" class="node">
<title>u25</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1197" cy="-732.66" rx="38.19" ry="18"/>
<text text-anchor="middle" x="1197" y="-728.96" font-family="Times-Roman" font-size="14.00">UnSet</text>
</g>
<!-- u21&#45;&gt;u25 -->
<g id="edge18" class="edge">
<title>u21&#45;&gt;u25</title>
<path fill="none" stroke="black" d="M792.1,-805.59C869.52,-798.59 1022.5,-781.91 1149,-750.66 1152.18,-749.88 1155.44,-748.96 1158.69,-747.97"/>
<polygon fill="black" stroke="black" points="1159.91,-751.26 1168.34,-744.84 1157.75,-744.6 1159.91,-751.26"/>
</g>
<!-- u26 -->
<g id="node9" class="node">
<title>u26</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1001" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="1001" y="-728.96" font-family="Times-Roman" font-size="14.00">Rm</text>
</g>
<!-- u21&#45;&gt;u26 -->
<g id="edge19" class="edge">
<title>u21&#45;&gt;u26</title>
<path fill="none" stroke="black" d="M785.47,-800.63C830.94,-790.62 904.05,-772.9 965,-750.66 966.85,-749.98 968.74,-749.25 970.62,-748.47"/>
<polygon fill="black" stroke="black" points="972.2,-751.6 979.95,-744.38 969.39,-745.19 972.2,-751.6"/>
</g>
<!-- u27 -->
<g id="node10" class="node">
<title>u27</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1093" cy="-732.66" rx="47.39" ry="18"/>
<text text-anchor="middle" x="1093" y="-728.96" font-family="Times-Roman" font-size="14.00">Compile</text>
</g>
<!-- u21&#45;&gt;u27 -->
<g id="edge20" class="edge">
<title>u21&#45;&gt;u27</title>
<path fill="none" stroke="black" d="M787.79,-801.93C846.05,-791.76 949.62,-772.61 1037,-750.66 1040.61,-749.75 1044.34,-748.76 1048.07,-747.72"/>
<polygon fill="black" stroke="black" points="1049.25,-751.02 1057.9,-744.89 1047.32,-744.29 1049.25,-751.02"/>
</g>
<!-- u28 -->
<g id="node11" class="node">
<title>u28</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="64" cy="-732.66" rx="40.09" ry="18"/>
<text text-anchor="middle" x="64" y="-728.96" font-family="Times-Roman" font-size="14.00">Config</text>
</g>
<!-- u21&#45;&gt;u28 -->
<g id="edge21" class="edge">
<title>u21&#45;&gt;u28</title>
<path fill="none" stroke="black" d="M689.99,-808.99C581.5,-806.67 323.62,-796.37 113,-750.66 109.64,-749.93 106.2,-749.04 102.77,-748.06"/>
<polygon fill="black" stroke="black" points="103.8,-744.71 93.21,-745.08 101.72,-751.4 103.8,-744.71"/>
</g>
<!-- u29 -->
<g id="node12" class="node">
<title>u29</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="415" cy="-732.66" rx="46.59" ry="18"/>
<text text-anchor="middle" x="415" y="-728.96" font-family="Times-Roman" font-size="14.00">Whereis</text>
</g>
<!-- u21&#45;&gt;u29 -->
<g id="edge22" class="edge">
<title>u21&#45;&gt;u29</title>
<path fill="none" stroke="black" d="M697.62,-801.14C643.73,-790.53 550.22,-771.27 471,-750.66 467.24,-749.68 463.35,-748.61 459.45,-747.51"/>
<polygon fill="black" stroke="black" points="460.41,-744.14 449.83,-744.71 458.45,-750.86 460.41,-744.14"/>
</g>
<!-- u30 -->
<g id="node13" class="node">
<title>u30</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="507" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="507" y="-728.96" font-family="Times-Roman" font-size="14.00">List</text>
</g>
<!-- u21&#45;&gt;u30 -->
<g id="edge23" class="edge">
<title>u21&#45;&gt;u30</title>
<path fill="none" stroke="black" d="M700.99,-799.47C660.33,-788.91 596.53,-771.1 543,-750.66 541.16,-749.96 539.28,-749.2 537.4,-748.41"/>
<polygon fill="black" stroke="black" points="538.65,-745.13 528.09,-744.28 535.81,-751.53 538.65,-745.13"/>
</g>
<!-- u31 -->
<g id="node14" class="node">
<title>u31</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1303" cy="-732.66" rx="50.09" ry="18"/>
<text text-anchor="middle" x="1303" y="-728.96" font-family="Times-Roman" font-size="14.00">Upgrade</text>
</g>
<!-- u21&#45;&gt;u31 -->
<g id="edge24" class="edge">
<title>u21&#45;&gt;u31</title>
<path fill="none" stroke="black" d="M792.66,-806.46C883.72,-800.09 1080.77,-783.54 1244,-750.66 1248.17,-749.82 1252.48,-748.83 1256.78,-747.75"/>
<polygon fill="black" stroke="black" points="1257.95,-751.06 1266.72,-745.12 1256.16,-744.29 1257.95,-751.06"/>
</g>
<!-- u32 -->
<g id="node15" class="node">
<title>u32</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="614" cy="-732.66" rx="61.99" ry="18"/>
<text text-anchor="middle" x="614" y="-728.96" font-family="Times-Roman" font-size="14.00">ChangeLog</text>
</g>
<!-- u21&#45;&gt;u32 -->
<g id="edge25" class="edge">
<title>u21&#45;&gt;u32</title>
<path fill="none" stroke="black" d="M717.02,-794.83C697.66,-783.34 670.61,-767.27 649.09,-754.49"/>
<polygon fill="black" stroke="black" points="650.63,-751.34 640.24,-749.24 647.05,-757.36 650.63,-751.34"/>
</g>
<!-- u33 -->
<g id="node16" class="node">
<title>u33</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-732.66" rx="48.19" ry="18"/>
<text text-anchor="middle" x="742" y="-728.96" font-family="Times-Roman" font-size="14.00">Prefetch</text>
</g>
<!-- u21&#45;&gt;u33 -->
<g id="edge26" class="edge">
<title>u21&#45;&gt;u33</title>
<path fill="none" stroke="black" d="M742,-792.41C742,-783.18 742,-771.59 742,-761.15"/>
<polygon fill="black" stroke="black" points="745.5,-760.84 742,-750.84 738.5,-760.84 745.5,-760.84"/>
</g>
<!-- u34 -->
<g id="node17" class="node">
<title>u34</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="235" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="235" y="-728.96" font-family="Times-Roman" font-size="14.00">GC</text>
</g>
<!-- u21&#45;&gt;u34 -->
<g id="edge27" class="edge">
<title>u21&#45;&gt;u34</title>
<path fill="none" stroke="black" d="M690.05,-808.49C602.09,-805.33 418.98,-793.68 271,-750.66 269.06,-750.1 267.09,-749.44 265.13,-748.72"/>
<polygon fill="black" stroke="black" points="266.08,-745.32 255.5,-744.7 263.39,-751.78 266.08,-745.32"/>
</g>
<!-- u35 -->
<g id="node18" class="node">
<title>u35</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="315" cy="-732.66" rx="35.19" ry="18"/>
<text text-anchor="middle" x="315" y="-728.96" font-family="Times-Roman" font-size="14.00">DInfo</text>
</g>
<!-- u21&#45;&gt;u35 -->
<g id="edge28" class="edge">
<title>u21&#45;&gt;u35</title>
<path fill="none" stroke="black" d="M692.02,-805.43C618.22,-798.41 476.17,-781.93 359,-750.66 356.35,-749.95 353.63,-749.14 350.92,-748.26"/>
<polygon fill="black" stroke="black" points="351.81,-744.86 341.22,-744.85 349.49,-751.47 351.81,-744.86"/>
</g>
<!-- u36 -->
<g id="node19" class="node">
<title>u36</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1461" cy="-732.66" rx="90.18" ry="18"/>
<text text-anchor="middle" x="1461" y="-728.96" font-family="Times-Roman" font-size="14.00">ToolRequirements</text>
</g>
<!-- u21&#45;&gt;u36 -->
<g id="edge29" class="edge">
<title>u21&#45;&gt;u36</title>
<path fill="none" stroke="black" d="M792.37,-806.16C898.17,-798.52 1151.13,-778.76 1362,-750.66 1370.05,-749.59 1378.45,-748.34 1386.8,-747.02"/>
<polygon fill="black" stroke="black" points="1387.62,-750.44 1396.94,-745.38 1386.51,-743.53 1387.62,-750.44"/>
</g>
<!-- u37 -->
<g id="node20" class="node">
<title>u37</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="156" cy="-732.66" rx="33.6" ry="18"/>
<text text-anchor="middle" x="156" y="-728.96" font-family="Times-Roman" font-size="14.00">Nuke</text>
</g>
<!-- u21&#45;&gt;u37 -->
<g id="edge30" class="edge">
<title>u21&#45;&gt;u37</title>
<path fill="none" stroke="black" d="M690.3,-808.63C592.81,-805.69 375.74,-794.35 199,-750.66 196.22,-749.97 193.39,-749.15 190.56,-748.24"/>
<polygon fill="black" stroke="black" points="191.69,-744.93 181.1,-744.88 189.35,-751.52 191.69,-744.93"/>
</g>
<!-- u22 -->
<g id="node5" class="node">
<title>u22</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-654.66" rx="51.19" ry="18"/>
<text text-anchor="middle" x="742" y="-650.96" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u0 -->
<g id="node33" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="705" cy="-576.66" rx="42.49" ry="18"/>
<text text-anchor="middle" x="705" y="-572.96" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u22&#45;&gt;u0 -->
<g id="edge31" class="edge">
<title>u22&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M733.79,-636.79C729.05,-627.05 722.98,-614.59 717.64,-603.63"/>
<polygon fill="black" stroke="black" points="720.71,-601.94 713.19,-594.48 714.42,-605 720.71,-601.94"/>
</g>
<!-- u23&#45;&gt;u22 -->
<g id="edge32" class="edge">
<title>u23&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M825.95,-717.01C810.53,-705.74 788.99,-690 771.59,-677.28"/>
<polygon fill="black" stroke="black" points="773.56,-674.39 763.42,-671.31 769.43,-680.04 773.56,-674.39"/>
</g>
<!-- u24&#45;&gt;u22 -->
<g id="edge33" class="edge">
<title>u24&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M907.79,-721.35C902.96,-719.08 897.82,-716.74 893,-714.66 857.2,-699.23 815.93,-683.23 785.6,-671.79"/>
<polygon fill="black" stroke="black" points="786.75,-668.48 776.15,-668.24 784.29,-675.03 786.75,-668.48"/>
</g>
<!-- u25&#45;&gt;u0 -->
<g id="edge34" class="edge">
<title>u25&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1167.62,-721.04C1161.48,-718.88 1155.04,-716.66 1149,-714.66 1003.04,-666.32 828.31,-614.02 748.55,-590.45"/>
<polygon fill="black" stroke="black" points="749.43,-587.06 738.85,-587.59 747.45,-593.77 749.43,-587.06"/>
</g>
<!-- u26&#45;&gt;u22 -->
<g id="edge35" class="edge">
<title>u26&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M979.97,-720.89C975.13,-718.64 969.95,-716.43 965,-714.66 892.52,-688.77 871.13,-693.36 797,-672.66 794.25,-671.89 791.42,-671.08 788.58,-670.25"/>
<polygon fill="black" stroke="black" points="789.48,-666.87 778.9,-667.37 787.48,-673.58 789.48,-666.87"/>
</g>
<!-- u27&#45;&gt;u22 -->
<g id="edge36" class="edge">
<title>u27&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M1058.23,-720.39C1051.24,-718.33 1043.92,-716.31 1037,-714.66 931.66,-689.55 902.27,-698.03 797,-672.66 794.04,-671.95 791,-671.16 787.94,-670.33"/>
<polygon fill="black" stroke="black" points="788.79,-666.93 778.21,-667.56 786.87,-673.66 788.79,-666.93"/>
</g>
<!-- u15 -->
<g id="node28" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="705" cy="-380.66" rx="30.59" ry="18"/>
<text text-anchor="middle" x="705" y="-376.96" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u28&#45;&gt;u15 -->
<g id="edge37" class="edge">
<title>u28&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M71.46,-714.85C93.67,-667.18 164.47,-531.09 271,-477.66 310.47,-457.87 631.26,-485.14 668,-460.66 685.49,-449.01 694.89,-426.77 699.83,-408.86"/>
<polygon fill="black" stroke="black" points="703.29,-409.46 702.25,-398.92 696.49,-407.8 703.29,-409.46"/>
</g>
<!-- u29&#45;&gt;u22 -->
<g id="edge38" class="edge">
<title>u29&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M449.8,-720.49C456.78,-718.42 464.1,-716.37 471,-714.66 565.92,-691.09 592.14,-696.47 687,-672.66 689.96,-671.92 692.99,-671.11 696.04,-670.26"/>
<polygon fill="black" stroke="black" points="697.13,-673.6 705.77,-667.46 695.19,-666.87 697.13,-673.6"/>
</g>
<!-- u30&#45;&gt;u22 -->
<g id="edge39" class="edge">
<title>u30&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M528.08,-721.03C532.92,-718.78 538.09,-716.52 543,-714.66 605.33,-691.02 623.15,-691.84 687,-672.66 689.74,-671.84 692.55,-670.99 695.38,-670.12"/>
<polygon fill="black" stroke="black" points="696.5,-673.44 705.04,-667.17 694.46,-666.75 696.5,-673.44"/>
</g>
<!-- u31&#45;&gt;u0 -->
<g id="edge40" class="edge">
<title>u31&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1267.21,-719.95C1204.45,-699.67 1070.24,-657.41 955,-628.66 885.44,-611.3 803.91,-595.51 753.35,-586.24"/>
<polygon fill="black" stroke="black" points="753.82,-582.77 743.35,-584.42 752.56,-589.65 753.82,-582.77"/>
</g>
<!-- u32&#45;&gt;u22 -->
<g id="edge41" class="edge">
<title>u32&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M639.9,-716.28C659.59,-704.59 686.84,-688.41 708.23,-675.71"/>
<polygon fill="black" stroke="black" points="710.2,-678.61 717.01,-670.5 706.62,-672.6 710.2,-678.61"/>
</g>
<!-- u33&#45;&gt;u22 -->
<g id="edge42" class="edge">
<title>u33&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M742,-714.41C742,-705.18 742,-693.59 742,-683.15"/>
<polygon fill="black" stroke="black" points="745.5,-682.84 742,-672.84 738.5,-682.84 745.5,-682.84"/>
</g>
<!-- u34&#45;&gt;u0 -->
<g id="edge43" class="edge">
<title>u34&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M256.18,-721.27C261.01,-719.01 266.15,-716.68 271,-714.66 321.21,-693.69 336.18,-694.54 386,-672.66 424.95,-655.55 430.98,-643.09 471,-628.66 532.58,-606.45 606.93,-592.27 655.04,-584.64"/>
<polygon fill="black" stroke="black" points="655.85,-588.06 665.19,-583.07 654.78,-581.14 655.85,-588.06"/>
</g>
<!-- u35&#45;&gt;u0 -->
<g id="edge44" class="edge">
<title>u35&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M342.11,-720.95C409.78,-694.23 586.34,-624.51 665.55,-593.24"/>
<polygon fill="black" stroke="black" points="667.14,-596.37 675.16,-589.44 664.57,-589.86 667.14,-596.37"/>
</g>
<!-- u14 -->
<g id="node36" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="934" cy="-495.66" rx="48.19" ry="18"/>
<text text-anchor="middle" x="934" y="-491.96" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u36&#45;&gt;u14 -->
<g id="edge45" class="edge">
<title>u36&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M1426.01,-716.06C1331.57,-673.94 1071.92,-558.16 972.98,-514.04"/>
<polygon fill="black" stroke="black" points="974.21,-510.76 963.65,-509.88 971.36,-517.15 974.21,-510.76"/>
</g>
<!-- u18 -->
<g id="node37" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1461" cy="-495.66" rx="73.39" ry="18"/>
<text text-anchor="middle" x="1461" y="-491.96" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u36&#45;&gt;u18 -->
<g id="edge46" class="edge">
<title>u36&#45;&gt;u18</title>
<path fill="none" stroke="black" d="M1461,-714.38C1461,-673.98 1461,-573.06 1461,-524.13"/>
<polygon fill="black" stroke="black" points="1464.5,-523.97 1461,-513.97 1457.5,-523.97 1464.5,-523.97"/>
</g>
<!-- u37&#45;&gt;u0 -->
<g id="edge47" class="edge">
<title>u37&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M178.73,-719.04C219.16,-697.17 306.76,-652.29 386,-628.66 478.02,-601.22 589.65,-587.67 653.49,-581.71"/>
<polygon fill="black" stroke="black" points="654.05,-585.17 663.7,-580.78 653.42,-578.2 654.05,-585.17"/>
</g>
<!-- u3 -->
<g id="node21" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1257" cy="-213.66" rx="36.29" ry="18"/>
<text text-anchor="middle" x="1257" y="-209.96" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node22" class="node">
<title>u4</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1329" cy="-291.66" rx="39.79" ry="18"/>
<text text-anchor="middle" x="1329" y="-287.96" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge48" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1314.08,-274.91C1303.94,-264.21 1290.37,-249.88 1278.99,-237.88"/>
<polygon fill="black" stroke="black" points="1281.32,-235.24 1271.9,-230.39 1276.24,-240.05 1281.32,-235.24"/>
</g>
<!-- u6 -->
<g id="node29" class="node">
<title>u6</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="934" cy="-380.66" rx="64.19" ry="18"/>
<text text-anchor="middle" x="934" y="-376.96" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge49" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M1226.6,-309.05C1217.94,-320.06 1204.99,-333.77 1190,-340.66 1152.94,-357.69 1046.95,-346.43 1007,-354.66 997.85,-356.55 988.26,-359.26 979.16,-362.21"/>
<polygon fill="black" stroke="black" points="977.86,-358.96 969.51,-365.48 980.11,-365.59 977.86,-358.96"/>
</g>
<!-- u7 -->
<g id="node30" class="node">
<title>u7</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-213.66" rx="44.39" ry="18"/>
<text text-anchor="middle" x="1030" y="-209.96" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge50" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M1218.91,-276.55C1213.05,-272.65 1206.44,-268.67 1200,-265.66 1160.61,-247.27 1113.01,-233.67 1078.21,-225.15"/>
<polygon fill="black" stroke="black" points="1078.83,-221.7 1068.29,-222.78 1077.21,-228.51 1078.83,-221.7"/>
</g>
<!-- u9 -->
<g id="node25" class="node">
<title>u9</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="803" cy="-291.66" rx="51.19" ry="18"/>
<text text-anchor="middle" x="803" y="-287.96" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge59" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M820.65,-362.47C817.58,-350.32 813.4,-333.77 809.87,-319.84"/>
<polygon fill="black" stroke="black" points="813.18,-318.65 807.34,-309.81 806.4,-320.37 813.18,-318.65"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge60" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M831.8,-276.66C840.15,-272.85 849.35,-268.89 858,-265.66 899.83,-250.04 948.74,-235.92 983.69,-226.52"/>
<polygon fill="black" stroke="black" points="984.85,-229.83 993.61,-223.88 983.05,-223.07 984.85,-229.83"/>
</g>
<!-- u10 -->
<g id="node26" class="node">
<title>u10</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1030" cy="-53.66" rx="27" ry="18"/>
<text text-anchor="middle" x="1030" y="-49.96" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node27" class="node">
<title>u16</title>
<ellipse fill="#7777ff" stroke="black" stroke-width="0" cx="629" cy="-380.66" rx="27" ry="18"/>
<text text-anchor="middle" x="629" y="-376.96" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15&#45;&gt;u1 -->
<g id="edge51" class="edge">
<title>u15&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M707.32,-398.87C710.83,-417.56 719.45,-446.6 740,-460.66 773.6,-483.65 1065.83,-471.03 1106,-477.66 1109.69,-478.27 1113.47,-479.03 1117.26,-479.89"/>
<polygon fill="black" stroke="black" points="1116.67,-483.35 1127.21,-482.36 1118.35,-476.55 1116.67,-483.35"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge52" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M969.52,-365.51C981.28,-361.37 994.54,-357.25 1007,-354.66 1044.76,-346.8 1151.18,-366.3 1180,-340.66 1205.4,-318.06 1177.53,-294.82 1195,-265.66 1202.54,-253.08 1214.35,-242.23 1225.65,-233.81"/>
<polygon fill="black" stroke="black" points="1227.95,-236.47 1234.11,-227.86 1223.92,-230.75 1227.95,-236.47"/>
</g>
<!-- u8 -->
<g id="node31" class="node">
<title>u8</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-135.66" rx="42.49" ry="18"/>
<text text-anchor="middle" x="1030" y="-131.96" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge54" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1030,-195.41C1030,-186.18 1030,-174.59 1030,-164.15"/>
<polygon fill="black" stroke="black" points="1033.5,-163.84 1030,-153.84 1026.5,-163.84 1033.5,-163.84"/>
</g>
<!-- u2 -->
<g id="node34" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1128" cy="-291.66" rx="37.89" ry="18"/>
<text text-anchor="middle" x="1128" y="-287.96" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge53" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M1049.85,-230.05C1064.58,-241.48 1084.85,-257.2 1101.05,-269.76"/>
<polygon fill="black" stroke="black" points="1099.06,-272.64 1109.1,-276.01 1103.35,-267.11 1099.06,-272.64"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge55" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M1071.74,-139.12C1139.49,-143.98 1269.17,-157.08 1302,-187.66 1322.76,-207 1328.33,-240.18 1329.47,-263.64"/>
<polygon fill="black" stroke="black" points="1325.97,-263.75 1329.71,-273.66 1332.97,-263.58 1325.97,-263.75"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge56" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1008.49,-151.25C968.13,-178.63 880.88,-237.82 834.11,-269.55"/>
<polygon fill="black" stroke="black" points="831.91,-266.82 825.6,-275.33 835.84,-272.61 831.91,-266.82"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge57" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M1030,-117.3C1030,-106.96 1030,-93.6 1030,-81.88"/>
<polygon fill="black" stroke="black" points="1033.5,-81.71 1030,-71.71 1026.5,-81.71 1033.5,-81.71"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge58" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1060.4,-365.35C1065.63,-361.25 1071.74,-357.21 1078,-354.66 1124.47,-335.76 1144.94,-362.7 1190,-340.66 1201.46,-335.05 1211.82,-325.6 1219.95,-316.56"/>
<polygon fill="black" stroke="black" points="1222.7,-318.72 1226.49,-308.83 1217.36,-314.2 1222.7,-318.72"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M698.39,-558.78C685.1,-524.87 655.09,-448.27 639.25,-407.82"/>
<polygon fill="black" stroke="black" points="642.45,-406.39 635.54,-398.36 635.93,-408.95 642.45,-406.39"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M705,-558.44C705,-524.72 705,-449.72 705,-409.09"/>
<polygon fill="black" stroke="black" points="708.5,-408.84 705,-398.84 701.5,-408.84 708.5,-408.84"/>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge2" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M736.84,-564.68C776.8,-550.89 845.52,-527.18 890.35,-511.72"/>
<polygon fill="black" stroke="black" points="891.51,-515.02 899.82,-508.45 889.22,-508.4 891.51,-515.02"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge5" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1150.77,-277.25C1171.58,-264.98 1202.56,-246.73 1225.7,-233.1"/>
<polygon fill="black" stroke="black" points="1227.62,-236.03 1234.46,-227.94 1224.07,-230 1227.62,-236.03"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge6" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1412.98,-362.38C1410.65,-337.92 1403.02,-293.12 1378,-265.66 1357.81,-243.49 1326.42,-230.64 1300.67,-223.38"/>
<polygon fill="black" stroke="black" points="1301.32,-219.94 1290.76,-220.78 1299.54,-226.71 1301.32,-219.94"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge7" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M980.15,-490.19C1019.57,-485.37 1072.04,-476.2 1086,-460.66 1117.68,-425.38 1065.12,-388.82 1098,-354.66 1126.68,-324.86 1153.09,-359.32 1190,-340.66 1201.39,-334.9 1211.73,-325.43 1219.87,-316.41"/>
<polygon fill="black" stroke="black" points="1222.61,-318.59 1226.43,-308.71 1217.28,-314.05 1222.61,-318.59"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge8" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M895.43,-484.64C881.53,-479.41 866.66,-471.72 856,-460.66 842.29,-446.43 834.43,-425.42 830.06,-408.64"/>
<polygon fill="black" stroke="black" points="833.46,-407.78 827.77,-398.84 826.64,-409.37 833.46,-407.78"/>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge10" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1468.63,-477.37C1480.29,-447.97 1498.11,-388.19 1467,-354.66 1438.65,-324.11 1317.28,-359.28 1280,-340.66 1269.49,-335.41 1260.48,-326.27 1253.53,-317.36"/>
<polygon fill="black" stroke="black" points="1256.2,-315.09 1247.51,-309.03 1250.53,-319.18 1256.2,-315.09"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge9" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M1453.86,-477.5C1446.19,-459.06 1433.9,-429.51 1425,-408.1"/>
<polygon fill="black" stroke="black" points="1428.12,-406.5 1421.05,-398.61 1421.66,-409.19 1428.12,-406.5"/>
</g>
<!-- u20 -->
<g id="node38" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="742" cy="-925.66" rx="32.49" ry="18"/>
<text text-anchor="middle" x="742" y="-921.96" font-family="Times-Roman" font-size="14.00">Main</text>
</g> </g>
<!-- u20&#45;&gt;u21 --> <!-- u20&#45;&gt;u21 -->
<g id="edge1" class="edge"> <g id="edge1" class="edge">
<title>u20&#45;&gt;u21</title> <title>u20&#45;&gt;u21</title>
<path fill="none" stroke="black" d="M840.39,-669.7C840.39,-661.98 840.39,-652.71 840.39,-644.11"/> <path fill="none" stroke="black" d="M742,-907.5C742,-889.33 742,-860.38 742,-839.05"/>
<polygon fill="black" stroke="black" points="843.89,-644.1 840.39,-634.1 836.89,-644.1 843.89,-644.1"/> <polygon fill="black" stroke="black" points="745.5,-838.98 742,-828.98 738.5,-838.98 745.5,-838.98"/>
</g>
<!-- u21&#45;&gt;u0 -->
<g id="edge2" class="edge">
<title>u21&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M840.39,-597.7C840.39,-589.25 840.39,-578.87 840.39,-569.37"/>
<polygon fill="black" stroke="black" points="843.89,-569.18 840.39,-559.18 836.89,-569.18 843.89,-569.18"/>
</g> </g>
</g> </g>
</svg> </svg>

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 33 KiB

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.17.2 version: 0.1.17.5
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
@@ -16,11 +16,8 @@ description:
category: System category: System
build-type: Simple build-type: Simple
extra-doc-files: extra-doc-files:
data/config.yaml
data/metadata/ghcup-0.0.4.yaml
data/metadata/ghcup-0.0.5.yaml
data/metadata/ghcup-0.0.6.yaml
CHANGELOG.md CHANGELOG.md
data/config.yaml
README.md README.md
extra-source-files: extra-source-files:
@@ -46,6 +43,18 @@ flag internal-downloader
default: False default: False
manual: True manual: True
flag no-exe
description: Don't build any executables
default: False
manual: True
flag disable-upgrade
description:
Disable upgrade functionality. This is mainly to support brew packagers.
default: False
manual: True
library library
exposed-modules: exposed-modules:
GHCup GHCup
@@ -56,6 +65,7 @@ library
GHCup.Requirements GHCup.Requirements
GHCup.Types GHCup.Types
GHCup.Types.JSON GHCup.Types.JSON
GHCup.Types.JSON.Utils
GHCup.Types.Optics GHCup.Types.Optics
GHCup.Utils GHCup.Utils
GHCup.Utils.Dirs GHCup.Utils.Dirs
@@ -94,7 +104,7 @@ library
build-depends: build-depends:
, aeson >=1.4 , aeson >=1.4
, async >=0.8 && <2.3 , async >=0.8 && <2.3
, base >=4.13 && <5 , base >=4.12 && <5
, base16-bytestring >=0.1.1.6 && <1.1 , base16-bytestring >=0.1.1.6 && <1.1
, binary ^>=0.8.6.0 , binary ^>=0.8.6.0
, bytestring ^>=0.10 , bytestring ^>=0.10
@@ -108,8 +118,7 @@ library
, disk-free-space ^>=0.1.0.1 , disk-free-space ^>=0.1.0.1
, filepath ^>=1.4.2.1 , filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5 , haskus-utils-types ^>=1.5
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant ^>=3.2.1
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0 , libarchive ^>=3.0.3.0
, lzma-static ^>=5.2.5.3 , lzma-static ^>=5.2.5.3
, megaparsec >=8.0.0 && <9.1 , megaparsec >=8.0.0 && <9.1
@@ -120,6 +129,7 @@ library
, pretty-terminal ^>=0.1.0.0 , pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96 , regex-posix ^>=0.96
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, retry ^>=0.8.1.2
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, split ^>=0.2.3.4 , split ^>=0.2.3.4
@@ -135,6 +145,7 @@ library
, vector ^>=0.12 , vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2 , zlib ^>=0.6.2.2
if (flag(internal-downloader) && !os(windows)) if (flag(internal-downloader) && !os(windows))
@@ -148,21 +159,25 @@ library
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
other-modules: GHCup.Utils.File.Windows other-modules:
GHCup.Utils.File.Windows
GHCup.Utils.Prelude.Windows
GHCup.Utils.Windows
build-depends: build-depends:
, bzlib , bzlib
, process ^>=1.6.11.0 , process ^>=1.6.11.0
, retry ^>=0.8.1.2
, Win32 ^>=2.10 , Win32 ^>=2.10
else else
other-modules: other-modules:
GHCup.Utils.File.Posix GHCup.Utils.File.Posix
System.Console.Terminal.Common GHCup.Utils.Posix
System.Console.Terminal.Posix GHCup.Utils.Prelude.Posix
build-depends: build-depends:
, bz2 >=0.5.0.5 && <1.1 , bz2 >=0.5.0.5 && <1.1
, terminal-size ^>=0.3.2.1
, unix ^>=2.7 , unix ^>=2.7
, unix-bytestring ^>=0.3.7.3 , unix-bytestring ^>=0.3.7.3
@@ -172,23 +187,25 @@ library
executable ghcup executable ghcup
main-is: Main.hs main-is: Main.hs
other-modules: GHCup.OptParse.Install other-modules:
GHCup.OptParse.Common GHCup.OptParse
GHCup.OptParse.Set GHCup.OptParse.ChangeLog
GHCup.OptParse.UnSet GHCup.OptParse.Common
GHCup.OptParse.Rm GHCup.OptParse.Compile
GHCup.OptParse.Compile GHCup.OptParse.Config
GHCup.OptParse.Config GHCup.OptParse.DInfo
GHCup.OptParse.Whereis GHCup.OptParse.GC
GHCup.OptParse.List GHCup.OptParse.Install
GHCup.OptParse.DInfo GHCup.OptParse.List
GHCup.OptParse.Upgrade GHCup.OptParse.Nuke
GHCup.OptParse.ToolRequirements GHCup.OptParse.Prefetch
GHCup.OptParse.ChangeLog GHCup.OptParse.Rm
GHCup.OptParse.Nuke GHCup.OptParse.Run
GHCup.OptParse.Prefetch GHCup.OptParse.Set
GHCup.OptParse.GC GHCup.OptParse.ToolRequirements
GHCup.OptParse GHCup.OptParse.UnSet
GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup hs-source-dirs: app/ghcup
default-language: Haskell2010 default-language: Haskell2010
default-extensions: default-extensions:
@@ -209,15 +226,15 @@ executable ghcup
, aeson >=1.4 , aeson >=1.4
, aeson-pretty ^>=0.8.8 , aeson-pretty ^>=0.8.8
, async ^>=2.2.3 , async ^>=2.2.3
, base >=4.13 && <5 , base >=4.12 && <5
, bytestring ^>=0.10 , bytestring ^>=0.10
, cabal-plan ^>=0.7.2 , cabal-plan ^>=0.7.2
, containers ^>=0.6 , containers ^>=0.6
, deepseq ^>=1.4 , deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1 , filepath ^>=1.4.2.1
, ghcup , ghcup
, haskus-utils-variant >=3.0 && <3.2 , haskus-utils-variant ^>=3.2.1
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0 , libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.1 , megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2 , mtl ^>=2.2
@@ -227,11 +244,13 @@ executable ghcup
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, temporary ^>=1.3
, template-haskell >=2.7 && <2.18 , template-haskell >=2.7 && <2.18
, text ^>=1.2.4.0 , text ^>=1.2.4.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
if flag(internal-downloader) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
@@ -242,56 +261,24 @@ executable ghcup
build-depends: build-depends:
, brick ^>=0.64 , brick ^>=0.64
, transformers ^>=0.5 , transformers ^>=0.5
, unix ^>=2.7
, vector ^>=0.12 , vector ^>=0.12
, vty >=5.28.2 && <5.34 , vty >=5.28.2 && <5.34
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
else
build-depends:
, unix ^>=2.7
executable ghcup-gen if flag(no-exe)
main-is: Main.hs buildable: False
hs-source-dirs: app/ghcup-gen
other-modules: Validate
default-language: Haskell2010
default-extensions:
DeriveGeneric
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
QuasiQuotes
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
TypeApplications
TypeFamilies
ViewPatterns
ghc-options: if (flag(disable-upgrade))
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns cpp-options: -DDISABLE_UPGRADE
-fwarn-incomplete-record-updates -threaded else
other-modules:
build-depends: GHCup.OptParse.Upgrade
, base >=4.13 && <5
, bytestring ^>=0.10
, containers ^>=0.6
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-variant >=3.0 && <3.2
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0
, mtl ^>=2.2
, optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, safe-exceptions ^>=0.1
, text ^>=1.2.4.0
, transformers ^>=0.5
, versions >=4.0.1 && <5.1
test-suite ghcup-test test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@@ -317,7 +304,7 @@ test-suite ghcup-test
-fwarn-incomplete-record-updates -fwarn-incomplete-record-updates
build-depends: build-depends:
, base >=4.13 && <5 , base >=4.12 && <5
, bytestring ^>=0.10 , bytestring ^>=0.10
, containers ^>=0.6 , containers ^>=0.6
, generic-arbitrary ^>=0.1.0 , generic-arbitrary ^>=0.1.0

View File

@@ -4,7 +4,5 @@ cradle:
path: ./lib path: ./lib
- component: "ghcup:exe:ghcup" - component: "ghcup:exe:ghcup"
path: ./app/ghcup path: ./app/ghcup
- component: "ghcup:exe:ghcup-gen"
path: "./app/ghcup-gen"
- component: "ghcup:test:ghcup-test" - component: "ghcup:test:ghcup-test"
path: ./test path: ./test

View File

@@ -5,8 +5,8 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-| {-|
Module : GHCup Module : GHCup
@@ -52,9 +52,7 @@ import Control.Monad.Fail ( MonadFail )
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
#if defined(IS_WINDOWS)
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) ) import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
#endif
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.List import Data.List
@@ -64,7 +62,7 @@ import Data.String ( fromString )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Format.ISO8601 import Data.Time.Format.ISO8601
import Data.Versions import Data.Versions hiding ( patch )
import Distribution.Types.Version hiding ( Version ) import Distribution.Types.Version hiding ( Version )
import Distribution.Types.PackageId import Distribution.Types.PackageId
import Distribution.Types.PackageDescription import Distribution.Types.PackageDescription
@@ -86,6 +84,7 @@ import System.IO.Error
import System.IO.Temp import System.IO.Temp
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix import Text.Regex.Posix
import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
@@ -96,9 +95,6 @@ import qualified Data.Map.Strict as Map
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
#if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32
#endif
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
@@ -305,22 +301,6 @@ installPackedGHC dl msubdir inst ver forceInstall = do
liftE $ runBuildAction tmpUnpack liftE $ runBuildAction tmpUnpack
(Just inst) (Just inst)
(installUnpackedGHC workdir inst ver) (installUnpackedGHC workdir inst ver)
where
-- | Does basic checks for isolated installs
-- Isolated Directory:
-- 1. if it doesn't exist -> proceed
-- 2. if it exists and is empty -> proceed
-- 3. if it exists and is non-empty -> panic and leave the house
installDestSanityCheck :: ( MonadIO m
, MonadCatch m
) =>
FilePath ->
Excepts '[DirNotEmpty] m ()
installDestSanityCheck isoDir = do
hideErrorDef [doesNotExistErrorType] () $ do
contents <- liftIO $ getDirectoryContentsRecursive isoDir
unless (null contents) (throwE $ DirNotEmpty isoDir)
-- | Install an unpacked GHC distribution. This only deals with the GHC -- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -339,36 +319,35 @@ installUnpackedGHC :: ( MonadReader env m
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Version -- ^ The GHC version -> Version -- ^ The GHC version
-> Excepts '[ProcessError] m () -> Excepts '[ProcessError] m ()
installUnpackedGHC path inst ver = do installUnpackedGHC path inst ver
#if defined(IS_WINDOWS) | isWindows = do
lift $ logInfo "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need -- Windows bindists are relocatable and don't need
-- to run configure. -- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg. -- We also must make sure to preserve mtime to not confuse ghc-pkg.
lift $ withRunInIO $ \run -> flip onException (run $ recyclePathForcibly inst) $ copyDirectoryRecursive path inst $ \source dest -> do lift $ withRunInIO $ \run -> flip onException (run $ recyclePathForcibly inst) $ copyDirectoryRecursive path inst $ \source dest -> do
mtime <- getModificationTime source mtime <- getModificationTime source
Win32.moveFile source dest moveFilePortable source dest
setModificationTime dest mtime setModificationTime dest mtime
#else | otherwise = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
let alpineArgs let alpineArgs
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
= ["--disable-ld-override"] = ["--disable-ld-override"]
| otherwise | otherwise
= [] = []
lift $ logInfo "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh" lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> inst) ("./configure" : ("--prefix=" <> inst)
: alpineArgs : alpineArgs
) )
(Just path) (Just path)
"ghc-configure" "ghc-configure"
Nothing Nothing
lEM $ make ["install"] (Just path) lEM $ make ["install"] (Just path)
pure () pure ()
#endif
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the -- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
@@ -587,6 +566,8 @@ installHLSBindist :: ( MonadMask m
, TarDirDoesNotExist , TarDirDoesNotExist
, ArchiveResult , ArchiveResult
, FileAlreadyExistsError , FileAlreadyExistsError
, ProcessError
, DirNotEmpty
] ]
m m
() ()
@@ -622,26 +603,55 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
legacy <- liftIO $ isLegacyHLSBindist workdir
if
| not forceInstall
, not legacy
, (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp
| otherwise -> pure ()
case isoFilepath of case isoFilepath of
Just isoDir -> do Just isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall if legacy
then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall
else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir isoDir ver
Nothing -> do Nothing -> do
liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall if legacy
then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall
else do
inst <- ghcupHLSDir ver
liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
liftE $ setHLS ver SetHLS_XYZ Nothing
liftE $ installHLSPostInst isoFilepath ver liftE $ installHLSPostInst isoFilepath ver
isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
-> IO Bool
isLegacyHLSBindist path = do
not <$> doesFileExist (path </> "GNUmakefile")
-- | Install an unpacked hls distribution. -- | Install an unpacked hls distribution.
installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m) installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Version
-> Bool -- ^ is it a force install -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m () installHLSUnpacked path inst _ = do
installHLSUnpacked path inst mver' forceInstall = do lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' inst
lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
-- | Install an unpacked hls distribution (legacy).
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install
-> Bool -- ^ is it a force install
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy path inst mver' forceInstall = do
lift $ logInfo "Installing HLS" lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
@@ -697,7 +707,7 @@ installHLSPostInst isoFilepath ver =
-- create symlink if this is the latest version in a regular install -- create symlink if this is the latest version in a regular install
hlsVers <- lift $ fmap rights getInstalledHLSs hlsVers <- lift $ fmap rights getInstalledHLSs
let lInstHLS = headMay . reverse . sort $ hlsVers let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly Nothing
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@ -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
@@ -730,6 +740,8 @@ installHLSBin :: ( MonadMask m
, TarDirDoesNotExist , TarDirDoesNotExist
, ArchiveResult , ArchiveResult
, FileAlreadyExistsError , FileAlreadyExistsError
, ProcessError
, DirNotEmpty
] ]
m m
() ()
@@ -756,9 +768,10 @@ compileHLS :: ( MonadMask m
-> Maybe Int -> Maybe Int
-> Maybe Version -> Maybe Version
-> Maybe FilePath -> Maybe FilePath
-> Maybe FilePath -> Maybe (Either FilePath URI)
-> Maybe FilePath -> Maybe URI
-> Maybe FilePath -> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to cabal install
-> Excepts '[ NoDownload -> Excepts '[ NoDownload
, GPGError , GPGError
, DownloadFailed , DownloadFailed
@@ -769,11 +782,12 @@ compileHLS :: ( MonadMask m
, BuildFailed , BuildFailed
, NotInstalled , NotInstalled
] m Version ] m Version
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patchdir = do compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patches cabalArgs = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs Dirs { .. } <- lift getDirs
(workdir, tver) <- case targetHLS of (workdir, tver) <- case targetHLS of
-- unpack from version tarball -- unpack from version tarball
Left tver -> do Left tver -> do
@@ -840,48 +854,51 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
liftE $ runBuildAction liftE $ runBuildAction
workdir workdir
Nothing Nothing
(reThrowAll @_ @'[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
let installDir = workdir </> "out" let installDir = workdir </> "out"
liftIO $ createDirRecursive' installDir liftIO $ createDirRecursive' installDir
-- apply patches -- apply patches
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir) liftE $ applyAnyPatch patches workdir
-- set up project files -- set up project files
cp <- case cabalProject of cp <- case cabalProject of
Just cp Just (Left cp)
| isAbsolute cp -> do | isAbsolute cp -> do
copyFileE cp (workdir </> "cabal.project") copyFileE cp (workdir </> "cabal.project")
pure "cabal.project" pure "cabal.project"
| otherwise -> pure (takeFileName cp) | otherwise -> pure (takeFileName cp)
Just (Right uri) -> do
tmpUnpack <- lift withGHCupTmpDir
cp <- liftE $ download uri Nothing Nothing tmpUnpack (Just "cabal.project") False
copyFileE cp (workdir </> "cabal.project")
pure "cabal.project"
Nothing -> pure "cabal.project" Nothing -> pure "cabal.project"
forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir </> cp <.> "local") forM_ cabalProjectLocal $ \uri -> do
tmpUnpack <- lift withGHCupTmpDir
let targets = ["exe:haskell-language-server", "exe:haskell-language-server-wrapper"] cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
copyFileE cpl (workdir </> cp <.> "local")
artifacts <- forM (sort ghcs) $ \ghc -> do artifacts <- forM (sort ghcs) $ \ghc -> do
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc) let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
liftIO $ createDirRecursive' ghcInstallDir liftIO $ createDirRecursive' installDir
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
liftE $ lEM @_ @'[ProcessError] $ liftE $ lEM @_ @'[ProcessError] $
execLogged "cabal" ( [ "v2-build" execLogged "cabal" ( [ "v2-install"
, "-w" , "-w"
, "ghc-" <> T.unpack (prettyVer ghc) , "ghc-" <> T.unpack (prettyVer ghc)
, "--install-method=copy"
] ++ ] ++
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++ maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
[ "--project-file=" <> cp [ "--overwrite-policy=always"
] ++ targets , "--disable-profiling"
, "--disable-tests"
, "--installdir=" <> ghcInstallDir
, "--project-file=" <> cp
] ++ fmap T.unpack cabalArgs ++ [
"exe:haskell-language-server"
, "exe:haskell-language-server-wrapper"]
) )
(Just workdir) "cabal" Nothing (Just workdir) "cabal" Nothing
forM_ targets $ \target -> do
let cabal = "cabal"
args = ["list-bin", target]
CapturedProcess{..} <- lift $ executeOut cabal args (Just workdir)
case _exitCode of
ExitFailure i -> throwE (NonZeroExit i cabal args)
_ -> pure ()
let cbin = stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
copyFileE cbin (ghcInstallDir </> takeFileName cbin)
pure ghcInstallDir pure ghcInstallDir
forM_ artifacts $ \artifact -> do forM_ artifacts $ \artifact -> do
@@ -894,9 +911,9 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
case isolateDir of case isolateDir of
Just isoDir -> do Just isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpacked installDir isoDir Nothing True liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
Nothing -> do Nothing -> do
liftE $ installHLSUnpacked installDir binDir (Just installVer) True liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
) )
liftE $ installHLSPostInst isolateDir installVer liftE $ installHLSPostInst isolateDir installVer
@@ -1075,22 +1092,29 @@ setGHC :: ( MonadReader env m
) )
=> GHCTargetVersion => GHCTargetVersion
-> SetGHC -> SetGHC
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
-- and don't want mess with other versions
-> Excepts '[NotInstalled] m GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC ver sghc = do setGHC ver sghc mBinDir = do
let verS = T.unpack $ prettyVer (_tvVersion ver) let verS = T.unpack $ prettyVer (_tvVersion ver)
ghcdir <- lift $ ghcupGHCDir ver ghcdir <- lift $ ghcupGHCDir ver
whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver)) whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver))
-- symlink destination -- symlink destination
Dirs {..} <- lift getDirs binDir <- case mBinDir of
Just x -> pure x
Nothing -> do
Dirs {binDir = f} <- lift getDirs
pure f
-- 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 when (isNothing mBinDir) $
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver) case sghc of
SetGHC_XY -> liftE $ rmMajorSymlinks ver SetGHCOnly -> liftE $ rmPlainGHC (_tvTarget ver)
SetGHC_XYZ -> liftE $ rmMinorSymlinks ver SetGHC_XY -> liftE $ rmMajorGHCSymlinks ver
SetGHC_XYZ -> liftE $ rmMinorGHCSymlinks ver
-- for ghc tools (ghc, ghci, haddock, ...) -- for ghc tools (ghc, ghci, haddock, ...)
verfiles <- ghcToolFiles ver verfiles <- ghcToolFiles ver
@@ -1108,16 +1132,18 @@ setGHC ver sghc = do
pure $ Just (file <> "-" <> verS) pure $ Just (file <> "-" <> verS)
-- create symlink -- create symlink
forM mTargetFile $ \targetFile -> do forM_ mTargetFile $ \targetFile -> do
bindir <- ghcInternalBinDir ver
let fullF = binDir </> targetFile <> exeExt let fullF = binDir </> targetFile <> exeExt
fileWithExt = file <> exeExt fileWithExt = bindir </> file <> exeExt
destL <- lift $ ghcLinkDestination fileWithExt ver destL <- binarySymLinkDestination binDir fileWithExt
lift $ createLink destL fullF lift $ createLink destL fullF
-- create symlink for share dir when (isNothing mBinDir) $ do
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS -- create symlink for share dir
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
pure ver pure ver
@@ -1147,15 +1173,17 @@ setGHC ver sghc = do
logDebug $ "rm -f " <> T.pack fullF logDebug $ "rm -f " <> T.pack fullF
hideError doesNotExistErrorType $ rmDirectoryLink fullF hideError doesNotExistErrorType $ rmDirectoryLink fullF
logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
liftIO
#if defined(IS_WINDOWS) if isWindows
-- On windows we need to be more permissive then liftIO
-- in case symlinks can't be created, be just -- On windows we need to be more permissive
-- give up here. This symlink isn't strictly necessary. -- in case symlinks can't be created, be just
$ hideError permissionErrorType -- give up here. This symlink isn't strictly necessary.
$ hideError illegalOperationErrorType $ hideError permissionErrorType
#endif $ hideError illegalOperationErrorType
$ createDirectoryLink targetF fullF $ createDirectoryLink targetF fullF
else liftIO
$ createDirectoryLink targetF fullF
_ -> pure () _ -> pure ()
unsetGHC :: ( MonadReader env m unsetGHC :: ( MonadReader env m
@@ -1168,7 +1196,7 @@ unsetGHC :: ( MonadReader env m
) )
=> Maybe Text => Maybe Text
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
unsetGHC = rmPlain unsetGHC = rmPlainGHC
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink. -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
@@ -1220,35 +1248,60 @@ setHLS :: ( MonadReader env m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => Version
-> SetHLS -- Nothing for legacy
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
-- and don't want mess with other versions
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
setHLS ver = do setHLS ver shls mBinDir = do
Dirs {..} <- lift getDirs whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
-- Delete old symlinks, since these might have different ghc versions than the -- symlink destination
-- selected version, so we could end up with stray or incorrect symlinks. binDir <- case mBinDir of
oldSyms <- lift hlsSymlinks Just x -> pure x
forM_ oldSyms $ \f -> do Nothing -> do
lift $ logDebug $ "rm " <> T.pack (binDir </> f) Dirs {binDir = f} <- lift getDirs
lift $ rmLink (binDir </> f) pure f
-- set haskell-language-server-<ghcver> symlinks -- first delete the old symlinks
bins <- lift $ hlsServerBinaries ver Nothing when (isNothing mBinDir) $
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver) case shls of
-- not for legacy
SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
-- legacy and new
SetHLSOnly -> liftE rmPlainHLS
forM_ bins $ \f -> do case shls of
let destL = f -- not for legacy
let target = (<> exeExt) . head . splitOn "~" $ f SetHLS_XYZ -> do
lift $ createLink destL (binDir </> target) bins <- lift $ hlsInternalServerScripts ver Nothing
-- set haskell-language-server-wrapper symlink forM_ bins $ \f -> do
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt let fname = takeFileName f
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt destL <- binarySymLinkDestination binDir f
let target = if "haskell-language-server-wrapper" `isPrefixOf` fname
then fname <> "-" <> T.unpack (prettyVer ver) <> exeExt
else fname <> "~" <> T.unpack (prettyVer ver) <> exeExt
lift $ createLink destL (binDir </> target)
lift $ createLink destL wrapper -- legacy and new
SetHLSOnly -> do
-- set haskell-language-server-<ghcver> symlinks
bins <- lift $ hlsServerBinaries ver Nothing
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
lift warnAboutHlsCompatibility forM_ bins $ \f -> do
let destL = f
let target = (<> exeExt) . head . splitOn "~" $ f
lift $ createLink destL (binDir </> target)
pure () -- set haskell-language-server-wrapper symlink
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
lift $ createLink destL wrapper
when (isNothing mBinDir) $
lift warnAboutHlsCompatibility
unsetHLS :: ( MonadMask m unsetHLS :: ( MonadMask m
@@ -1578,7 +1631,7 @@ listVersions lt' criteria = do
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
currentGHCup av = currentGHCup av =
let currentVer = fromJust $ pvpToVersion ghcUpVer let currentVer = fromJust $ pvpToVersion ghcUpVer ""
listVer = Map.lookup currentVer av listVer = Map.lookup currentVer av
latestVer = fst <$> headOf (getTagged Latest) av latestVer = fst <$> headOf (getTagged Latest) av
recommendedVer = fst <$> headOf (getTagged Latest) av recommendedVer = fst <$> headOf (getTagged Latest) av
@@ -1718,14 +1771,14 @@ rmGHCVer ver = do
-- this isn't atomic, order matters -- this isn't atomic, order matters
when isSetGHC $ do when isSetGHC $ do
lift $ logInfo "Removing ghc symlinks" lift $ logInfo "Removing ghc symlinks"
liftE $ rmPlain (_tvTarget ver) liftE $ rmPlainGHC (_tvTarget ver)
lift $ logInfo "Removing ghc-x.y.z symlinks" lift $ logInfo "Removing ghc-x.y.z symlinks"
liftE $ rmMinorSymlinks ver liftE $ rmMinorGHCSymlinks ver
lift $ logInfo "Removing/rewiring ghc-x.y symlinks" lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
-- first remove -- first remove
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorGHCSymlinks ver
-- then fix them (e.g. with an earlier version) -- then fix them (e.g. with an earlier version)
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
@@ -1737,7 +1790,7 @@ rmGHCVer ver = do
$ fmap Just $ fmap Just
$ getMajorMinorV (_tvVersion ver) $ getMajorMinorV (_tvVersion ver)
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) (_tvTarget ver)) forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) (_tvTarget ver))
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -1792,24 +1845,19 @@ rmHLSVer :: ( MonadMask m
rmHLSVer ver = do rmHLSVer ver = do
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)) whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
isHlsSet <- lift hlsSet isHlsSet <- lift hlsSet
Dirs {..} <- lift getDirs liftE $ rmMinorHLSSymlinks ver
hlsDir <- ghcupHLSDir ver
bins <- lift $ hlsAllBinaries ver recyclePathForcibly hlsDir
forM_ bins $ \f -> lift $ recycleFile (binDir </> f)
when (Just ver == isHlsSet) $ do when (Just ver == isHlsSet) $ do
-- delete all set symlinks -- delete all set symlinks
oldSyms <- lift hlsSymlinks rmPlainHLS
forM_ oldSyms $ \f -> do
let fullF = binDir </> f
lift $ logDebug $ "rm " <> T.pack fullF
lift $ rmLink fullF
-- set latest hls -- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs hlsVers <- lift $ fmap rights getInstalledHLSs
case headMay . reverse . sort $ hlsVers of case headMay . reverse . sort $ hlsVers of
Just latestver -> setHLS latestver Just latestver -> setHLS latestver SetHLSOnly Nothing
Nothing -> pure () Nothing -> pure ()
@@ -1876,17 +1924,17 @@ rmGhcup = do
unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
#if defined(IS_WINDOWS) if isWindows
-- since it doesn't seem possible to delete a running exe on windows then do
-- we move it to temp dir, to be deleted at next reboot -- since it doesn't seem possible to delete a running exe on windows
tempFilepath <- mkGhcupTmpDir -- we move it to temp dir, to be deleted at next reboot
hideError UnsupportedOperation $ tempFilepath <- mkGhcupTmpDir
liftIO $ hideError NoSuchThing $ hideError UnsupportedOperation $
Win32.moveFileEx ghcupFilepath (Just (tempFilepath </> "ghcup")) 0 liftIO $ hideError NoSuchThing $
#else moveFile ghcupFilepath (tempFilepath </> "ghcup")
-- delete it. else
hideError doesNotExistErrorType $ rmFile ghcupFilepath -- delete it.
#endif hideError doesNotExistErrorType $ rmFile ghcupFilepath
where where
handlePathNotPresent fp _err = do handlePathNotPresent fp _err = do
@@ -1946,10 +1994,9 @@ rmGhcupDirs = do
handleRm $ rmBinDir binDir handleRm $ rmBinDir binDir
handleRm $ rmDir recycleDir handleRm $ rmDir recycleDir
#if defined(IS_WINDOWS) when isWindows $ do
logInfo $ "removing " <> T.pack (baseDir </> "msys64") logInfo $ "removing " <> T.pack (baseDir </> "msys64")
handleRm $ rmPathForcibly (baseDir </> "msys64") handleRm $ rmPathForcibly (baseDir </> "msys64")
#endif
handleRm $ removeEmptyDirsRecursive baseDir handleRm $ removeEmptyDirsRecursive baseDir
@@ -1983,15 +2030,13 @@ rmGhcupDirs = do
forM_ contents (deleteFile . (dir </>)) forM_ contents (deleteFile . (dir </>))
rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmBinDir binDir = do rmBinDir binDir
#if !defined(IS_WINDOWS) | isWindows = removeDirIfEmptyOrIsSymlink binDir
isXDGStyle <- liftIO useXDG | otherwise = do
if not isXDGStyle isXDGStyle <- liftIO useXDG
then removeDirIfEmptyOrIsSymlink binDir if not isXDGStyle
else pure () then removeDirIfEmptyOrIsSymlink binDir
#else else pure ()
removeDirIfEmptyOrIsSymlink binDir
#endif
reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath] reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
reportRemainingFiles dir = do reportRemainingFiles dir = do
@@ -2097,7 +2142,7 @@ compileGHC :: ( MonadMask m
-> Either Version FilePath -- ^ version to bootstrap with -> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
-> Maybe FilePath -- ^ build config -> Maybe FilePath -- ^ build config
-> Maybe FilePath -- ^ patch directory -> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to ./configure -> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour -> Maybe String -- ^ build flavour
-> Bool -> Bool
@@ -2126,7 +2171,7 @@ compileGHC :: ( MonadMask m
] ]
m m
GHCTargetVersion GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir
= do = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -2150,7 +2195,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
workdir <- maybe (pure tmpUnpack) workdir <- maybe (pure tmpUnpack)
(liftE . intoSubdir tmpUnpack) (liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo) (view dlSubdir dlInfo)
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir) liftE $ applyAnyPatch patches workdir
pure (workdir, tmpUnpack, tver) pure (workdir, tmpUnpack, tver)
@@ -2158,7 +2203,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
Right GitBranch{..} -> do Right GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH] DownloadFailed $ do tver <- reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] DownloadFailed $ do
let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)" lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ] lEM $ git [ "init" ]
@@ -2178,7 +2223,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
lEM $ git [ "checkout", "FETCH_HEAD" ] lEM $ git [ "checkout", "FETCH_HEAD" ]
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ] lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
forM_ patchdir (\dir -> liftE $ applyPatches dir tmpUnpack) liftE $ applyAnyPatch patches tmpUnpack
lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap" lEM $ execWithGhcEnv "python3" ["./boot"] (Just tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap" lEM $ execWithGhcEnv "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap"
CapturedProcess {..} <- lift $ makeOut CapturedProcess {..} <- lift $ makeOut
@@ -2246,7 +2291,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
Nothing -> do Nothing -> do
reThrowAll GHCupSetError $ postGHCInstall installVer reThrowAll GHCupSetError $ postGHCInstall installVer
-- restore -- restore
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing
_ -> pure () _ -> pure ()
@@ -2311,11 +2356,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
m m
FilePath FilePath
findHadrianFile workdir = do findHadrianFile workdir = do
#if defined(IS_WINDOWS) let possible_files = if isWindows
let possible_files = ((workdir </> "hadrian") </>) <$> ["build.bat"] then ((workdir </> "hadrian") </>) <$> ["build.bat"]
#else else ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
let possible_files = ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
#endif
exsists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f)) exsists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f))
case filter fst exsists of case filter fst exsists of
[] -> throwE HadrianNotFound [] -> throwE HadrianNotFound
@@ -2489,9 +2532,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(\x -> ["--target=" <> T.unpack x]) (\x -> ["--target=" <> T.unpack x])
(_tvTarget tver) (_tvTarget tver)
++ ["--prefix=" <> ghcdir] ++ ["--prefix=" <> ghcdir]
#if defined(IS_WINDOWS) ++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ ["--enable-tarballs-autodownload"]
#endif
++ fmap T.unpack aargs ++ fmap T.unpack aargs
) )
(Just workdir) (Just workdir)
@@ -2505,9 +2546,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(\x -> ["--target=" <> T.unpack x]) (\x -> ["--target=" <> T.unpack x])
(_tvTarget tver) (_tvTarget tver)
++ ["--prefix=" <> ghcdir] ++ ["--prefix=" <> ghcdir]
#if defined(IS_WINDOWS) ++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ ["--enable-tarballs-autodownload"]
#endif
++ fmap T.unpack aargs ++ fmap T.unpack aargs
) )
(Just workdir) (Just workdir)
@@ -2518,6 +2557,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
execWithGhcEnv :: ( MonadReader env m execWithGhcEnv :: ( MonadReader env m
, HasSettings env , HasSettings env
, HasDirs env , HasDirs env
, HasLog env
, MonadIO m , MonadIO m
, MonadThrow m) , MonadThrow m)
=> FilePath -- ^ thing to execute => FilePath -- ^ thing to execute
@@ -2589,7 +2629,7 @@ upgradeGHCup mtarget force' = do
lift $ logInfo "Upgrading GHCup..." lift $ logInfo "Upgrading GHCup..."
let latestVer = fromJust $ fst <$> getLatest dls GHCup let latestVer = fromJust $ fst <$> getLatest dls GHCup
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
@@ -2645,7 +2685,7 @@ postGHCInstall :: ( MonadReader env m
=> GHCTargetVersion => GHCTargetVersion
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
postGHCInstall ver@GHCTargetVersion {..} = do postGHCInstall ver@GHCTargetVersion {..} = do
void $ liftE $ setGHC ver SetGHC_XYZ void $ liftE $ setGHC ver SetGHC_XYZ Nothing
-- Create ghc-x.y symlinks. This may not be the current -- Create ghc-x.y symlinks. This may not be the current
-- version, create it regardless. -- version, create it regardless.
@@ -2654,7 +2694,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
$ fmap Just $ fmap Just
$ getMajorMinorV _tvVersion $ getMajorMinorV _tvVersion
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) _tvTarget) forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) _tvTarget)
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
-- | Reports the binary location of a given tool: -- | Reports the binary location of a given tool:
@@ -2693,7 +2733,11 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
HLS -> do HLS -> do
whenM (lift $ fmap not $ hlsInstalled _tvVersion) whenM (lift $ fmap not $ hlsInstalled _tvVersion)
$ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion)) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion))
pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt) ifM (lift $ isLegacyHLS _tvVersion)
(pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt))
$ do
bdir <- lift $ ghcupHLSDir _tvVersion
pure (bdir </> "bin" </> "haskell-language-server-wrapper" <> exeExt)
Stack -> do Stack -> do
whenM (lift $ fmap not $ stackInstalled _tvVersion) whenM (lift $ fmap not $ stackInstalled _tvVersion)
@@ -2711,13 +2755,21 @@ checkIfToolInstalled :: ( MonadIO m
Tool -> Tool ->
Version -> Version ->
m Bool m Bool
checkIfToolInstalled tool ver = checkIfToolInstalled' tool (mkTVer ver)
checkIfToolInstalled tool ver = checkIfToolInstalled' :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadCatch m) =>
Tool ->
GHCTargetVersion ->
m Bool
checkIfToolInstalled' tool ver =
case tool of case tool of
Cabal -> cabalInstalled ver Cabal -> cabalInstalled (_tvVersion ver)
HLS -> hlsInstalled ver HLS -> hlsInstalled (_tvVersion ver)
Stack -> stackInstalled ver Stack -> stackInstalled (_tvVersion ver)
GHC -> ghcInstalled $ mkTVer ver GHC -> ghcInstalled ver
_ -> pure False _ -> pure False
throwIfFileAlreadyExists :: ( MonadIO m ) => throwIfFileAlreadyExists :: ( MonadIO m ) =>
@@ -2806,21 +2858,31 @@ rmHLSNoGHC :: ( MonadReader env m
, HasLog env , HasLog env
, MonadIO m , MonadIO m
, MonadMask m , MonadMask m
, MonadFail m
, MonadUnliftIO m
) )
=> m () => Excepts '[NotInstalled] m ()
rmHLSNoGHC = do rmHLSNoGHC = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
ghcs <- fmap rights getInstalledGHCs ghcs <- fmap rights getInstalledGHCs
hlses <- fmap rights getInstalledHLSs hlses <- fmap rights getInstalledHLSs
forM_ hlses $ \hls -> do forM_ hlses $ \hls -> do
hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
forM_ hlsGHCs $ \ghc -> do let candidates = filter (`notElem` ghcs) hlsGHCs
when (ghc `notElem` ghcs) $ do if (length hlsGHCs - length candidates) <= 0
bins <- hlsServerBinaries hls (Just $ _tvVersion ghc) then rmHLSVer hls
forM_ bins $ \bin -> do else
let f = binDir </> bin forM_ candidates $ \ghc -> do
bins1 <- fmap (binDir </>) <$> hlsServerBinaries hls (Just $ _tvVersion ghc)
bins2 <- ifM (isLegacyHLS hls) (pure []) $ do
shs <- hlsInternalServerScripts hls (Just $ _tvVersion ghc)
bins <- hlsInternalServerBinaries hls (Just $ _tvVersion ghc)
libs <- hlsInternalServerLibs hls (_tvVersion ghc)
pure (shs ++ bins ++ libs)
forM_ (bins1 ++ bins2) $ \f -> do
logDebug $ "rm " <> T.pack f logDebug $ "rm " <> T.pack f
rmFile f rmFile f
pure ()
rmCache :: ( MonadReader env m rmCache :: ( MonadReader env m
@@ -2858,3 +2920,25 @@ rmTmp = do
let p = tmpdir </> f let p = tmpdir </> f
logDebug $ "rm -rf " <> T.pack p logDebug $ "rm -rf " <> T.pack p
rmPathForcibly p rmPathForcibly p
applyAnyPatch :: ( MonadReader env m
, HasDirs env
, HasLog env
, HasSettings env
, MonadUnliftIO m
, MonadCatch m
, MonadResource m
, MonadThrow m
, MonadMask m
, MonadIO m)
=> Maybe (Either FilePath [URI])
-> FilePath
-> Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Nothing _ = pure ()
applyAnyPatch (Just (Left pdir)) workdir = liftE $ applyPatches pdir workdir
applyAnyPatch (Just (Right uris)) workdir = do
tmpUnpack <- lift withGHCupTmpDir
forM_ uris $ \uri -> do
patch <- liftE $ download uri Nothing Nothing tmpUnpack Nothing False
liftE $ applyPatch patch workdir

View File

@@ -49,7 +49,6 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Data.Aeson import Data.Aeson
import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( mk ) import Data.CaseInsensitive ( mk )
@@ -87,7 +86,7 @@ import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.YAML.Aeson as Y import qualified Data.Yaml.Aeson as Y
@@ -183,15 +182,14 @@ getBase uri = do
-- if we didn't get a filepath from the download, use the cached yaml -- if we didn't get a filepath from the download, use the cached yaml
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE liftE
. onE_ (onError actualYaml) . onE_ (onError actualYaml)
. lE' @_ @_ @'[JSONError] JSONDecodeError . lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."]) . liftIO
. Y.decode1 . Y.decodeFileEither
$ yamlContents $ actualYaml
where where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed. -- may re-download and succeed.
@@ -244,14 +242,18 @@ getBase uri = do
e <- liftIO $ doesFileExist json_file e <- liftIO $ doesFileExist json_file
currentTime <- liftIO getCurrentTime currentTime <- liftIO getCurrentTime
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
Settings { metaCache } <- lift getSettings
-- for local files, let's short-circuit and ignore access time -- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
| e -> do | e -> do
accessTime <- liftIO $ getAccessTime json_file accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
let cacheInterval = fromInteger metaCache
lift $ logDebug $ "last access was " <> T.pack (show sinceLastAccess) <> " ago, cache interval is " <> T.pack (show cacheInterval)
-- access time won't work on most linuxes, but we can try regardless -- access time won't work on most linuxes, but we can try regardless
if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) -> if | metaCache <= 0 -> dlWithMod currentTime json_file
| (sinceLastAccess > cacheInterval) ->
-- no access in last 5 minutes, re-check upstream mod time -- no access in last 5 minutes, re-check upstream mod time
dlWithMod currentTime json_file dlWithMod currentTime json_file
| otherwise -> pure json_file | otherwise -> pure json_file

View File

@@ -1,9 +1,10 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-| {-|
@@ -27,6 +28,9 @@ import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad

View File

@@ -6,6 +6,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-| {-|
@@ -30,12 +31,15 @@ import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) ) import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text) import GHC.IO.Exception ( ExitCode )
import Optics ( makeLenses )
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text, (<+>))
import URI.ByteString import URI.ByteString
#if defined(BRICK) #if defined(BRICK)
import Graphics.Vty ( Key(..) ) import Graphics.Vty ( Key(..) )
#endif #endif
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
@@ -294,6 +298,7 @@ instance NFData (URIRef Absolute) where
data UserSettings = UserSettings data UserSettings = UserSettings
{ uCache :: Maybe Bool { uCache :: Maybe Bool
, uMetaCache :: Maybe Integer
, uNoVerify :: Maybe Bool , uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool , uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs , uKeepDirs :: Maybe KeepDirs
@@ -306,12 +311,13 @@ data UserSettings = UserSettings
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing = fromSettings Settings{..} Nothing =
UserSettings { UserSettings {
uCache = Just cache uCache = Just cache
, uMetaCache = Just metaCache
, uNoVerify = Just noVerify , uNoVerify = Just noVerify
, uVerbose = Just verbose , uVerbose = Just verbose
, uKeepDirs = Just keepDirs , uKeepDirs = Just keepDirs
@@ -335,6 +341,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
} }
in UserSettings { in UserSettings {
uCache = Just cache uCache = Just cache
, uMetaCache = Just metaCache
, uNoVerify = Just noVerify , uNoVerify = Just noVerify
, uVerbose = Just verbose , uVerbose = Just verbose
, uKeepDirs = Just keepDirs , uKeepDirs = Just keepDirs
@@ -410,6 +417,7 @@ instance NFData LeanAppState
data Settings = Settings data Settings = Settings
{ cache :: Bool { cache :: Bool
, metaCache :: Integer
, noVerify :: Bool , noVerify :: Bool
, keepDirs :: KeepDirs , keepDirs :: KeepDirs
, downloader :: Downloader , downloader :: Downloader
@@ -421,6 +429,12 @@ data Settings = Settings
} }
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
instance NFData Settings instance NFData Settings
data Dirs = Dirs data Dirs = Dirs
@@ -474,6 +488,10 @@ data SetGHC = SetGHCOnly -- ^ unversioned 'ghc'
| SetGHC_XYZ -- ^ ghc-x.y.z | SetGHC_XYZ -- ^ ghc-x.y.z
deriving (Eq, Show) deriving (Eq, Show)
data SetHLS = SetHLSOnly -- ^ unversioned 'hls'
| SetHLS_XYZ -- ^ haskell-language-server-a.b.c~x.y.z, where a.b.c is GHC version and x.y.z is HLS version
deriving (Eq, Show)
data PlatformResult = PlatformResult data PlatformResult = PlatformResult
{ _platform :: Platform { _platform :: Platform
@@ -586,3 +604,27 @@ data LoggerConfig = LoggerConfig
instance NFData LoggerConfig where instance NFData LoggerConfig where
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors) rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
data ProcessError = NonZeroExit Int FilePath [String]
| PTerminated FilePath [String]
| PStopped FilePath [String]
| NoSuchPid FilePath [String]
deriving Show
instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: BL.ByteString
, _stdErr :: BL.ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess

View File

@@ -22,10 +22,8 @@ Portability : portable
module GHCup.Types.JSON where module GHCup.Types.JSON where
import GHCup.Types import GHCup.Types
import GHCup.Types.JSON.Utils
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
-- This is due to the boot file.
import Control.Applicative ( (<|>) ) import Control.Applicative ( (<|>) )
import Data.Aeson hiding (Key) import Data.Aeson hiding (Key)
@@ -40,6 +38,7 @@ import Text.Casing
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding.Error as E
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC import qualified Text.Megaparsec.Char as MPC
@@ -78,7 +77,7 @@ instance FromJSON Tag where
x -> pure (UnknownTag x) x -> pure (UnknownTag x)
instance ToJSON URI where instance ToJSON URI where
toJSON = toJSON . decUTF8Safe . serializeURIRef' toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
instance FromJSON URI where instance FromJSON URI where
parseJSON = withText "URL" $ \t -> parseJSON = withText "URL" $ \t ->

View File

@@ -0,0 +1,17 @@
{-|
Module : GHCup.Types.JSON.Utils
Description : Utils for TH splices
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Types.JSON.Utils where
import qualified Data.Text as T
removeLensFieldLabel :: String -> String
removeLensFieldLabel str' =
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'

View File

@@ -3,7 +3,6 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
@@ -22,13 +21,21 @@ installation and introspection of files/versions etc.
module GHCup.Utils module GHCup.Utils
( module GHCup.Utils.Dirs ( module GHCup.Utils.Dirs
, module GHCup.Utils , module GHCup.Utils
#if defined(IS_WINDOWS)
, module GHCup.Utils.Windows
#else
, module GHCup.Utils.Posix
#endif
) )
where where
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
import GHCup.Download import GHCup.Utils.Windows
#else
import GHCup.Utils.Posix
#endif #endif
import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
@@ -51,9 +58,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) ) import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
#if defined(IS_WINDOWS) import Data.Bifunctor ( first )
import Data.Bits
#endif
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.Foldable import Data.Foldable
@@ -61,7 +66,7 @@ import Data.List
import Data.List.NonEmpty ( NonEmpty( (:|) )) import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions hiding ( patch )
import GHC.IO.Exception import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
@@ -69,11 +74,6 @@ import Safe
import System.Directory hiding ( findFiles ) import System.Directory hiding ( findFiles )
import System.FilePath import System.FilePath
import System.IO.Error import System.IO.Error
#if defined(IS_WINDOWS)
import System.Win32.Console
import System.Win32.File hiding ( copyFile )
import System.Win32.Types
#endif
import Text.Regex.Posix import Text.Regex.Posix
import URI.ByteString import URI.ByteString
@@ -110,8 +110,8 @@ import qualified Data.List.NonEmpty as NE
-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow ) -- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False } -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs -- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ] -- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False -- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc -- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory -- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL) -- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
@@ -124,31 +124,32 @@ import qualified Data.List.NonEmpty as NE
------------------------ ------------------------
-- | The symlink destination of a ghc tool. -- | Create a relative symlink destination for the binary directory,
ghcLinkDestination :: ( MonadReader env m -- given a target toolpath.
, HasDirs env binarySymLinkDestination :: ( MonadThrow m
, MonadThrow m, MonadIO m) , MonadIO m
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc. )
-> GHCTargetVersion => FilePath -- ^ binary dir
-> m FilePath -> FilePath -- ^ the full toolpath
ghcLinkDestination tool ver = do -> m FilePath
Dirs {..} <- getDirs binarySymLinkDestination binDir toolPath = do
ghcd <- ghcupGHCDir ver toolPath' <- liftIO $ canonicalizePath toolPath
pure (relativeSymlink binDir (ghcd </> "bin" </> tool)) binDir' <- liftIO $ canonicalizePath binDir
pure (relativeSymlink binDir' toolPath')
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5. -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: ( MonadReader env m rmMinorGHCSymlinks :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, HasLog env , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
) )
=> GHCTargetVersion => GHCTargetVersion
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmMinorSymlinks tv@GHCTargetVersion{..} = do rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
files <- liftE $ ghcToolFiles tv files <- liftE $ ghcToolFiles tv
@@ -160,17 +161,17 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
-- | Removes the set ghc version for the given target, if any. -- | Removes the set ghc version for the given target, if any.
rmPlain :: ( MonadReader env m rmPlainGHC :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadIO m , MonadIO m
, MonadMask m , MonadMask m
) )
=> Maybe Text -- ^ target => Maybe Text -- ^ target
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmPlain target = do rmPlainGHC target = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
mtv <- lift $ ghcSet target mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do forM_ mtv $ \tv -> do
@@ -186,17 +187,17 @@ 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 env m rmMajorGHCSymlinks :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, HasLog env , HasLog env
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
) )
=> GHCTargetVersion => GHCTargetVersion
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmMajorSymlinks tv@GHCTargetVersion{..} = do rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
(mj, mi) <- getMajorMinorV _tvVersion (mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi let v' = intToText mj <> "." <> intToText mi
@@ -209,6 +210,62 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
lift $ hideError doesNotExistErrorType $ rmLink fullF lift $ hideError doesNotExistErrorType $ rmLink fullF
-- | Removes the minor HLS files, e.g. 'haskell-language-server-8.10.7~1.6.1.0'
-- and 'haskell-language-server-wrapper-1.6.1.0'.
rmMinorHLSSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> Version
-> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks ver = do
Dirs {..} <- lift getDirs
hlsBins <- hlsAllBinaries ver
forM_ hlsBins $ \f -> do
let fullF = binDir </> f
lift $ logDebug ("rm -f " <> T.pack fullF)
-- on unix, this may be either a file (legacy) or a symlink
-- on windows, this is always a file... hence 'rmFile'
-- works consistently across platforms
lift $ rmFile fullF
-- | Removes the set HLS version, if any.
rmPlainHLS :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Excepts '[NotInstalled] m ()
rmPlainHLS = do
Dirs {..} <- lift getDirs
-- delete 'haskell-language-server-8.10.7'
hlsBins <- fmap (filter (\f -> not ("haskell-language-server-wrapper" `isPrefixOf` f) && ('~' `notElem` f)))
$ liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString))
forM_ hlsBins $ \f -> do
let fullF = binDir </> f
lift $ logDebug ("rm -f " <> T.pack fullF)
if isWindows
then lift $ rmLink fullF
else lift $ rmFile fullF
-- 'haskell-language-server-wrapper'
let hlswrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
lift $ logDebug ("rm -f " <> T.pack hlswrapper)
if isWindows
then lift $ hideError doesNotExistErrorType $ rmLink hlswrapper
else lift $ hideError doesNotExistErrorType $ rmFile hlswrapper
----------------------------------- -----------------------------------
@@ -352,7 +409,8 @@ 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\>@,
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version] => m [Either FilePath Version]
getInstalledHLSs = do getInstalledHLSs = do
@@ -363,7 +421,7 @@ getInstalledHLSs = do
execBlank execBlank
([s|^haskell-language-server-wrapper-.*$|] :: ByteString) ([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
) )
forM bins $ \f -> legacy <- forM bins $ \f ->
case case
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f) version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
of of
@@ -371,6 +429,14 @@ getInstalledHLSs = do
Just (Left _) -> pure $ Left f Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f Nothing -> pure $ Left f
hlsdir <- ghcupHLSBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory hlsdir
new <- forM fs $ \f -> case parseGHCupHLSDir f of
Right r -> pure $ Right r
Left _ -> pure $ Left f
pure (nub (new <> legacy))
-- | Get all installed stacks, by matching on -- | Get all installed stacks, by matching on
-- @~\/.ghcup\/bin/stack-<\stackver\>@. -- @~\/.ghcup\/bin/stack-<\stackver\>@.
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
@@ -446,6 +512,10 @@ hlsInstalled ver = do
vers <- fmap rights getInstalledHLSs vers <- fmap rights getInstalledHLSs
pure $ elem ver vers pure $ elem ver vers
isLegacyHLS :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
isLegacyHLS ver = do
bdir <- ghcupHLSDir ver
not <$> liftIO (doesDirectoryExist bdir)
-- Return the currently set hls version, if any. -- Return the currently set hls version, if any.
@@ -517,7 +587,7 @@ hlsGHCVersions' v' = do
pure . sortBy (flip compare) . rights $ vers pure . sortBy (flip compare) . rights $ vers
-- | Get all server binaries for an hls version, if any. -- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m) hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
=> Version => Version
-> Maybe Version -- ^ optional GHC version -> Maybe Version -- ^ optional GHC version
@@ -538,6 +608,44 @@ hlsServerBinaries ver mghcVer = do
) )
) )
-- | Get all scripts for a hls version from the ~/.ghcup/hls/<ver>/bin directory, if any.
-- Returns the full path.
hlsInternalServerScripts :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
=> Version
-> Maybe Version -- ^ optional GHC version
-> m [FilePath]
hlsInternalServerScripts ver mghcVer = do
dir <- ghcupHLSDir ver
let bdir = dir </> "bin"
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
<$> liftIO (listDirectory bdir)
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
-- Returns the full path.
hlsInternalServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
=> Version
-> Maybe Version -- ^ optional GHC version
-> m [FilePath]
hlsInternalServerBinaries ver mghcVer = do
dir <- ghcupHLSDir ver
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
<$> liftIO (listDirectory bdir)
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
-- directory, if any.
-- Returns the full path.
hlsInternalServerLibs :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
=> Version
-> Version -- ^ GHC version
-> m [FilePath]
hlsInternalServerLibs ver ghcVer = do
dir <- ghcupHLSDir ver
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
fmap (bdir </>) <$> liftIO (listDirectory bdir)
-- | Get the wrapper binary for an hls version, if any. -- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
@@ -568,22 +676,6 @@ hlsAllBinaries ver = do
pure (maybeToList wrapper ++ hls) pure (maybeToList wrapper ++ hls)
-- | Get the active symlinks for hls.
hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
hlsSymlinks = do
Dirs {..} <- getDirs
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-.*$|] :: ByteString)
)
filterM
( liftIO
. pathIsLink
. (binDir </>)
)
oldSyms
@@ -631,34 +723,34 @@ getGHCForPVP pvpIn mt = do
ghcs <- rights <$> getInstalledGHCs ghcs <- rights <$> getInstalledGHCs
-- we're permissive here... failed parse just means we have no match anyway -- we're permissive here... failed parse just means we have no match anyway
let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
pvp_ <- versionToPVP _tvVersion (pvp_, rest) <- versionToPVP _tvVersion
pure (pvp_, _tvTarget) pure (pvp_, rest, _tvTarget)
getGHCForPVP' pvpIn ghcs' mt getGHCForPVP' pvpIn ghcs' mt
-- | Like 'getGHCForPVP', except with explicit input parameter. -- | Like 'getGHCForPVP', except with explicit input parameter.
-- --
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing -- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- "Just 8.10.7" -- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4" -- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
-- "Just 8.10.4" -- "Just 8.10.4"
getGHCForPVP' :: MonadThrow m getGHCForPVP' :: MonadThrow m
=> PVP => PVP
-> [(PVP, Maybe Text)] -- ^ installed GHCs -> [(PVP, Text, Maybe Text)] -- ^ installed GHCs
-> Maybe Text -- ^ the target triple -> Maybe Text -- ^ the target triple
-> m (Maybe GHCTargetVersion) -> m (Maybe GHCTargetVersion)
getGHCForPVP' pvpIn ghcs' mt = do getGHCForPVP' pvpIn ghcs' mt = do
let mResult = lastMay let mResult = lastMay
. sortBy (\(x, _) (y, _) -> compare x y) . sortBy (\(x, _, _) (y, _, _) -> compare x y)
. filter . filter
(\(pvp_, target) -> (\(pvp_, _, target) ->
target == mt && matchPVPrefix pvp_ pvpIn target == mt && matchPVPrefix pvp_ pvpIn
) )
$ ghcs' $ ghcs'
forM mResult $ \(pvp_, target) -> do forM mResult $ \(pvp_, rest, target) -> do
ver' <- pvpToVersion pvp_ ver' <- pvpToVersion pvp_ rest
pure (GHCTargetVersion target ver') pure (GHCTargetVersion target ver')
@@ -679,7 +771,7 @@ getLatestToolFor :: MonadThrow m
getLatestToolFor tool pvpIn dls = do getLatestToolFor tool pvpIn dls = do
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
pure . headMay . filter (\(v, _) -> matchPVPrefix pvpIn v) $ ps pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
@@ -714,7 +806,7 @@ unpackToDir dfp av = do
(untar . GZip.decompress =<< rf av) (untar . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do | ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av filecontents <- liftE $ rf av
let decompressed = Lzma.decompress filecontents let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ untar decompressed liftE $ untar decompressed
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (untar . BZip.decompress =<< rf av) liftE (untar . BZip.decompress =<< rf av)
@@ -743,7 +835,7 @@ getArchiveFiles av = do
(entries . GZip.decompress =<< rf av) (entries . GZip.decompress =<< rf av)
| ".tar.xz" `isSuffixOf` fn -> do | ".tar.xz" `isSuffixOf` fn -> do
filecontents <- liftE $ rf av filecontents <- liftE $ rf av
let decompressed = Lzma.decompress filecontents let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
liftE $ entries decompressed liftE $ entries decompressed
| ".tar.bz2" `isSuffixOf` fn -> | ".tar.bz2" `isSuffixOf` fn ->
liftE (entries . BZip.decompress =<< rf av) liftE (entries . BZip.decompress =<< rf av)
@@ -808,8 +900,16 @@ getLatestBaseVersion av pvpVer =
--[ Other ]-- --[ Other ]--
------------- -------------
-- | Usually @~\/.ghcup\/ghc\/\<ver\>\/bin\/@
ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> m FilePath
ghcInternalBinDir ver = do
ghcdir <- ghcupGHCDir ver
pure (ghcdir </> "bin")
-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
-- | Get tool files from @~\/.ghcup\/ghc\/\<ver\>\/bin\/\*@
-- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix. -- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
-- --
-- Returns unversioned relative files without extension, e.g.: -- Returns unversioned relative files without extension, e.g.:
@@ -819,11 +919,10 @@ ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, Mona
=> GHCTargetVersion => GHCTargetVersion
-> Excepts '[NotInstalled] m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles ver = do ghcToolFiles ver = do
ghcdir <- lift $ ghcupGHCDir ver bindir <- ghcInternalBinDir ver
let bindir = ghcdir </> "bin"
-- fail if ghc is not installed -- fail if ghc is not installed
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) whenM (fmap not $ ghcInstalled ver)
(throwE (NotInstalled GHC ver)) (throwE (NotInstalled GHC ver))
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>))) files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
@@ -855,6 +954,7 @@ make :: ( MonadThrow m
, MonadIO m , MonadIO m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, HasSettings env , HasSettings env
) )
=> [String] => [String]
@@ -877,28 +977,43 @@ makeOut args workdir = do
executeOut mymake args workdir executeOut mymake args workdir
-- | Try to apply patches in order. Fails with 'PatchFailed' -- | Try to apply patches in order. The order is determined by
-- on first failure. -- a quilt series file (in the patch directory) if one exists,
-- else the patches are applied in lexicographical order.
-- Fails with 'PatchFailed' on first failure.
applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m) applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath -- ^ dir containing patches => FilePath -- ^ dir containing patches
-> FilePath -- ^ dir to apply patches in -> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m () -> Excepts '[PatchFailed] m ()
applyPatches pdir ddir = do applyPatches pdir ddir = do
patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles let lexicographical = (fmap . fmap) (pdir </>) $ sort <$> findFiles
pdir pdir
(makeRegexOpts compExtended (makeRegexOpts compExtended
execBlank execBlank
([s|.+\.(patch|diff)$|] :: ByteString) ([s|.+\.(patch|diff)$|] :: ByteString)
) )
forM_ (sort patches) $ \patch' -> do let quilt = map (pdir </>) . lines <$> readFile (pdir </> "series")
lift $ logInfo $ "Applying patch " <> T.pack patch'
fmap (either (const Nothing) Just) patches <- liftIO $ quilt `catchIO` (\e ->
(exec if isDoesNotExistError e || isPermissionError e then
"patch" lexicographical
["-p1", "-i", patch'] else throwIO e)
(Just ddir) forM_ patches $ \patch' -> applyPatch patch' ddir
Nothing)
!? PatchFailed
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath -- ^ Patch
-> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m ()
applyPatch patch ddir = do
lift $ logInfo $ "Applying patch " <> T.pack patch
fmap (either (const Nothing) Just)
(exec
"patch"
["-p1", "-s", "-f", "-i", patch]
(Just ddir)
Nothing)
!? PatchFailed
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
@@ -1000,50 +1115,17 @@ getVersionInfo v' tool =
-- | The file extension for executables. -- | The file extension for executables.
exeExt :: String exeExt :: String
#if defined(IS_WINDOWS) exeExt
exeExt = ".exe" | isWindows = ".exe"
#else | otherwise = ""
exeExt = ""
#endif
-- | The file extension for executables. -- | The file extension for executables.
exeExt' :: ByteString exeExt' :: ByteString
#if defined(IS_WINDOWS) exeExt'
exeExt' = ".exe" | isWindows = ".exe"
#else | otherwise = ""
exeExt' = ""
#endif
-- | Enables ANSI support on windows, does nothing on unix.
--
-- Returns 'Left str' on errors and 'Right bool' on success, where
-- 'bool' markes whether ansi support was already enabled.
--
-- This function never crashes.
--
-- Rip-off of https://docs.rs/ansi_term/0.12.1/x86_64-pc-windows-msvc/src/ansi_term/windows.rs.html#10-61
enableAnsiSupport :: IO (Either String Bool)
#if defined(IS_WINDOWS)
enableAnsiSupport = handleIO (pure . Left . displayException) $ do
-- ref: https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilew
-- Using `CreateFileW("CONOUT$", ...)` to retrieve the console handle works correctly even if STDOUT and/or STDERR are redirected
h <- createFile "CONOUT$" (gENERIC_WRITE .|. gENERIC_READ)
fILE_SHARE_WRITE Nothing oPEN_EXISTING 0 Nothing
when (h == iNVALID_HANDLE_VALUE ) $ fail "invalid handle value"
-- ref: https://docs.microsoft.com/en-us/windows/console/getconsolemode
m <- getConsoleMode h
-- VT processing not already enabled?
if ((m .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING) == 0)
-- https://docs.microsoft.com/en-us/windows/console/setconsolemode
then setConsoleMode h (m .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING)
>> pure (Right False)
else pure (Right True)
#else
enableAnsiSupport = pure (Right True)
#endif
-- | On unix, we can use symlinks, so we just get the -- | On unix, we can use symlinks, so we just get the
@@ -1052,33 +1134,27 @@ enableAnsiSupport = pure (Right True)
-- On windows, we have to emulate symlinks via shims, -- On windows, we have to emulate symlinks via shims,
-- see 'createLink'. -- see 'createLink'.
getLinkTarget :: FilePath -> IO FilePath getLinkTarget :: FilePath -> IO FilePath
getLinkTarget fp = do getLinkTarget fp
#if defined(IS_WINDOWS) | isWindows = do
content <- readFile (dropExtension fp <.> "shim") content <- readFile (dropExtension fp <.> "shim")
[p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content [p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
pure $ stripNewline $ dropPrefix "path = " p pure $ stripNewline $ dropPrefix "path = " p
#else | otherwise = getSymbolicLinkTarget fp
getSymbolicLinkTarget fp
#endif
-- | Checks whether the path is a link. -- | Checks whether the path is a link.
pathIsLink :: FilePath -> IO Bool pathIsLink :: FilePath -> IO Bool
#if defined(IS_WINDOWS) pathIsLink fp
pathIsLink fp = doesPathExist (dropExtension fp <.> "shim") | isWindows = doesPathExist (dropExtension fp <.> "shim")
#else | otherwise = pathIsSymbolicLink fp
pathIsLink = pathIsSymbolicLink
#endif
rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m () rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
#if defined(IS_WINDOWS) rmLink fp
rmLink fp = do | isWindows = do
hideError doesNotExistErrorType . recycleFile $ fp hideError doesNotExistErrorType . recycleFile $ fp
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim") hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
#else | otherwise = hideError doesNotExistErrorType . recycleFile $ fp
rmLink = hideError doesNotExistErrorType . recycleFile
#endif
-- | Creates a symbolic link on unix and a fake symlink on windows for -- | Creates a symbolic link on unix and a fake symlink on windows for
@@ -1102,31 +1178,30 @@ createLink :: ( MonadMask m
=> FilePath -- ^ path to the target executable => FilePath -- ^ path to the target executable
-> FilePath -- ^ path to be created -> FilePath -- ^ path to be created
-> m () -> m ()
createLink link exe = do createLink link exe
#if defined(IS_WINDOWS) | isWindows = do
dirs <- getDirs dirs <- getDirs
let shimGen = cacheDir dirs </> "gs.exe" let shimGen = cacheDir dirs </> "gs.exe"
let shim = dropExtension exe <.> "shim" let shim = dropExtension exe <.> "shim"
-- For hardlinks, link needs to be absolute. -- For hardlinks, link needs to be absolute.
-- If link is relative, it's relative to the target exe. -- If link is relative, it's relative to the target exe.
-- Note that (</>) drops lhs when rhs is absolute. -- Note that (</>) drops lhs when rhs is absolute.
fullLink = takeDirectory exe </> link fullLink = takeDirectory exe </> link
shimContents = "path = " <> fullLink shimContents = "path = " <> fullLink
logDebug $ "rm -f " <> T.pack exe logDebug $ "rm -f " <> T.pack exe
rmLink exe rmLink exe
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
liftIO $ copyFile shimGen exe liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents liftIO $ writeFile shim shimContents
#else | otherwise = do
logDebug $ "rm -f " <> T.pack exe logDebug $ "rm -f " <> T.pack exe
hideError doesNotExistErrorType $ recycleFile exe hideError doesNotExistErrorType $ recycleFile exe
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
liftIO $ createFileLink link exe liftIO $ createFileLink link exe
#endif
ensureGlobalTools :: ( MonadMask m ensureGlobalTools :: ( MonadMask m
@@ -1141,23 +1216,20 @@ ensureGlobalTools :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m () => Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
ensureGlobalTools = do ensureGlobalTools
#if defined(IS_WINDOWS) | isWindows = do
(GHCupInfo _ _ gTools) <- lift getGHCupInfo (GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload] shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _ _) -> do void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..." lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe")) lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe") lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[GPGError, DigestError , DownloadFailed] $ dl liftE @'[GPGError, DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl) ) `catchE` liftE @'[GPGError, DigestError , DownloadFailed] dl
pure () | otherwise = pure ()
#else
pure ()
#endif
-- | Ensure ghcup directory structure exists. -- | Ensure ghcup directory structure exists.
@@ -1175,11 +1247,27 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
-- | For ghc without arch triple, this is: -- | For ghc without arch triple, this is:
-- --
-- - ghc-<ver> (e.g. ghc-8.10.4) -- - ghc
-- --
-- For ghc with arch triple: -- For ghc with arch triple:
-- --
-- - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4) -- - <triple>-ghc (e.g. arm-linux-gnueabihf-ghc)
ghcBinaryName :: GHCTargetVersion -> String ghcBinaryName :: GHCTargetVersion -> String
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt) ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt) ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
-- | Does basic checks for isolated installs
-- Isolated Directory:
-- 1. if it doesn't exist -> proceed
-- 2. if it exists and is empty -> proceed
-- 3. if it exists and is non-empty -> panic and leave the house
installDestSanityCheck :: ( MonadIO m
, MonadCatch m
) =>
FilePath ->
Excepts '[DirNotEmpty] m ()
installDestSanityCheck isoDir = do
hideErrorDef [doesNotExistErrorType] () $ do
contents <- liftIO $ getDirectoryContentsRecursive isoDir
unless (null contents) (throwE $ DirNotEmpty isoDir)

View File

@@ -20,14 +20,15 @@ module GHCup.Utils.Dirs
, ghcupCacheDir , ghcupCacheDir
, ghcupGHCBaseDir , ghcupGHCBaseDir
, ghcupGHCDir , ghcupGHCDir
, ghcupHLSBaseDir
, ghcupHLSDir
, mkGhcupTmpDir , mkGhcupTmpDir
, parseGHCupGHCDir , parseGHCupGHCDir
, parseGHCupHLSDir
, relativeSymlink , relativeSymlink
, withGHCupTmpDir , withGHCupTmpDir
, getConfigFilePath , getConfigFilePath
#if !defined(IS_WINDOWS)
, useXDG , useXDG
#endif
, cleanupTrash , cleanupTrash
) )
where where
@@ -48,6 +49,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource hiding (throwM) import Control.Monad.Trans.Resource hiding (throwM)
import Data.Bifunctor import Data.Bifunctor
import Data.Maybe import Data.Maybe
import Data.Versions
import GHC.IO.Exception ( IOErrorType(NoSuchThing) ) import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
@@ -59,7 +61,7 @@ import System.IO.Temp
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.YAML.Aeson as Y import qualified Data.Yaml.Aeson as Y
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
@@ -75,26 +77,25 @@ import Control.Concurrent (threadDelay)
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_DATA_HOME/ghcup' as per xdg spec. -- then uses 'XDG_DATA_HOME/ghcup' as per xdg spec.
ghcupBaseDir :: IO FilePath ghcupBaseDir :: IO FilePath
ghcupBaseDir = do ghcupBaseDir
#if defined(IS_WINDOWS) | isWindows = do
bdir <- fromMaybe "C:\\" <$> lookupEnv "GHCUP_INSTALL_BASE_PREFIX" bdir <- fromMaybe "C:\\" <$> lookupEnv "GHCUP_INSTALL_BASE_PREFIX"
pure (bdir </> "ghcup")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_DATA_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "share")
pure (bdir </> "ghcup") pure (bdir </> "ghcup")
else do | otherwise = do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case xdg <- useXDG
Just r -> pure r if xdg
Nothing -> liftIO getHomeDirectory then do
pure (bdir </> ".ghcup") bdir <- lookupEnv "XDG_DATA_HOME" >>= \case
#endif Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "share")
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
-- | ~/.ghcup by default -- | ~/.ghcup by default
@@ -102,45 +103,41 @@ ghcupBaseDir = do
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec. -- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
ghcupConfigDir :: IO FilePath ghcupConfigDir :: IO FilePath
ghcupConfigDir = do ghcupConfigDir
#if defined(IS_WINDOWS) | isWindows = ghcupBaseDir
ghcupBaseDir | otherwise = do
#else xdg <- useXDG
xdg <- useXDG if xdg
if xdg then do
then do bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case Just r -> pure r
Just r -> pure r Nothing -> do
Nothing -> do home <- liftIO getHomeDirectory
home <- liftIO getHomeDirectory pure (home </> ".config")
pure (home </> ".config") pure (bdir </> "ghcup")
pure (bdir </> "ghcup") else do
else do bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case Just r -> pure r
Just r -> pure r Nothing -> liftIO getHomeDirectory
Nothing -> liftIO getHomeDirectory pure (bdir </> ".ghcup")
pure (bdir </> ".ghcup")
#endif
-- | 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).
ghcupBinDir :: IO FilePath ghcupBinDir :: IO FilePath
ghcupBinDir = do ghcupBinDir
#if defined(IS_WINDOWS) | isWindows = ghcupBaseDir <&> (</> "bin")
ghcupBaseDir <&> (</> "bin") | otherwise = do
#else xdg <- useXDG
xdg <- useXDG if xdg
if xdg then do
then do lookupEnv "XDG_BIN_HOME" >>= \case
lookupEnv "XDG_BIN_HOME" >>= \case Just r -> pure r
Just r -> pure r Nothing -> do
Nothing -> do home <- liftIO getHomeDirectory
home <- liftIO getHomeDirectory pure (home </> ".local" </> "bin")
pure (home </> ".local" </> "bin") else ghcupBaseDir <&> (</> "bin")
else ghcupBaseDir <&> (</> "bin")
#endif
-- | Defaults to '~/.ghcup/cache'. -- | Defaults to '~/.ghcup/cache'.
@@ -148,21 +145,19 @@ ghcupBinDir = do
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup' as per xdg spec. -- then uses 'XDG_CACHE_HOME/ghcup' as per xdg spec.
ghcupCacheDir :: IO FilePath ghcupCacheDir :: IO FilePath
ghcupCacheDir = do ghcupCacheDir
#if defined(IS_WINDOWS) | isWindows = ghcupBaseDir <&> (</> "cache")
ghcupBaseDir <&> (</> "cache") | otherwise = do
#else xdg <- useXDG
xdg <- useXDG if xdg
if xdg then do
then do bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case Just r -> pure r
Just r -> pure r Nothing -> do
Nothing -> do home <- liftIO getHomeDirectory
home <- liftIO getHomeDirectory pure (home </> ".cache")
pure (home </> ".cache") pure (bdir </> "ghcup")
pure (bdir </> "ghcup") else ghcupBaseDir <&> (</> "cache")
else ghcupBaseDir <&> (</> "cache")
#endif
-- | Defaults to '~/.ghcup/logs'. -- | Defaults to '~/.ghcup/logs'.
@@ -170,21 +165,19 @@ ghcupCacheDir = do
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/logs' as per xdg spec. -- then uses 'XDG_CACHE_HOME/ghcup/logs' as per xdg spec.
ghcupLogsDir :: IO FilePath ghcupLogsDir :: IO FilePath
ghcupLogsDir = do ghcupLogsDir
#if defined(IS_WINDOWS) | isWindows = ghcupBaseDir <&> (</> "logs")
ghcupBaseDir <&> (</> "logs") | otherwise = do
#else xdg <- useXDG
xdg <- useXDG if xdg
if xdg then do
then do bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case Just r -> pure r
Just r -> pure r Nothing -> do
Nothing -> do home <- liftIO getHomeDirectory
home <- liftIO getHomeDirectory pure (home </> ".cache")
pure (home </> ".cache") pure (bdir </> "ghcup" </> "logs")
pure (bdir </> "ghcup" </> "logs") else ghcupBaseDir <&> (</> "logs")
else ghcupBaseDir <&> (</> "logs")
#endif
-- | '~/.ghcup/trash'. -- | '~/.ghcup/trash'.
@@ -222,7 +215,7 @@ ghcupConfigFile = do
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
case contents of case contents of
Nothing -> pure defaultUserSettings Nothing -> pure defaultUserSettings
Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents' Just contents' -> lE' JSONDecodeError . first displayException . Y.decodeEither' $ contents'
------------------------- -------------------------
@@ -255,6 +248,24 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
parseGHCupGHCDir (T.pack -> fp) = parseGHCupGHCDir (T.pack -> fp) =
throwEither $ MP.parse ghcTargetVerP "" fp throwEither $ MP.parse ghcTargetVerP "" fp
parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
parseGHCupHLSDir (T.pack -> fp) =
throwEither $ MP.parse version' "" fp
-- | ~/.ghcup/hls by default, for new-style installs.
ghcupHLSBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
ghcupHLSBaseDir = do
Dirs {..} <- getDirs
pure (baseDir </> "hls")
-- | Gets '~/.ghcup/hls/<hls-ver>' for new-style installs.
ghcupHLSDir :: (MonadReader env m, HasDirs env, MonadThrow m)
=> Version
-> m FilePath
ghcupHLSDir ver = do
basedir <- ghcupHLSBaseDir
let verdir = T.unpack $ prettyVer ver
pure (basedir </> verdir)
mkGhcupTmpDir :: ( MonadReader env m mkGhcupTmpDir :: ( MonadReader env m
, HasDirs env , HasDirs env
@@ -320,12 +331,11 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
-------------- --------------
#if !defined(IS_WINDOWS)
useXDG :: IO Bool useXDG :: IO Bool
useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS" useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
#endif
-- | Like 'relpath'. Assumes the inputs are resolved in case of symlinks.
relativeSymlink :: FilePath -- ^ the path in which to create the symlink relativeSymlink :: FilePath -- ^ the path in which to create the symlink
-> FilePath -- ^ the symlink destination -> FilePath -- ^ the symlink destination
-> FilePath -> FilePath

View File

@@ -1,11 +1,14 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils.File.Common where module GHCup.Utils.File.Common (
module GHCup.Utils.File.Common
, ProcessError(..)
, CapturedProcess(..)
) where
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Types(ProcessError(..), CapturedProcess(..))
import Control.Monad.Reader import Control.Monad.Reader
import Data.Maybe import Data.Maybe
@@ -13,7 +16,7 @@ import Data.Text ( Text )
import Data.Void import Data.Void
import GHC.IO.Exception import GHC.IO.Exception
import Optics hiding ((<|), (|>)) import Optics hiding ((<|), (|>))
import System.Directory import System.Directory hiding (findFiles)
import System.FilePath import System.FilePath
import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import Text.Regex.Posix import Text.Regex.Posix
@@ -24,33 +27,6 @@ import qualified Text.Megaparsec as MP
data ProcessError = NonZeroExit Int FilePath [String]
| PTerminated FilePath [String]
| PStopped FilePath [String]
| NoSuchPid FilePath [String]
deriving Show
instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: BL.ByteString
, _stdErr :: BL.ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess
-- | Search for a file in the search paths. -- | Search for a file in the search paths.
-- --
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`. -- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
@@ -100,6 +76,21 @@ isInPath p = do
else pure False else pure False
-- | Follows the first match in case of Regex.
expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
expandFilePath = go ""
where
go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
go p [] = pure [p]
go p (x:xs) = do
case x of
Left s -> go (p </> s) xs
Right regex -> do
fps <- findFiles p regex
res <- forM fps $ \fp -> go (p </> fp) xs
pure $ mconcat res
findFiles :: FilePath -> Regex -> IO [FilePath] findFiles :: FilePath -> Regex -> IO [FilePath]
findFiles path regex = do findFiles path regex = do
contents <- listDirectory path contents <- listDirectory path

View File

@@ -35,7 +35,7 @@ import Data.Sequence ( Seq, (|>) )
import Data.List import Data.List
import Data.Word8 import Data.Word8
import GHC.IO.Exception import GHC.IO.Exception
import System.Console.Terminal.Common import System.IO ( stderr )
import System.IO.Error import System.IO.Error
import System.FilePath import System.FilePath
import System.Directory import System.Directory
@@ -51,7 +51,7 @@ import qualified Data.Sequence as Sq
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified System.Posix.Process as SPP import qualified System.Posix.Process as SPP
import qualified System.Console.Terminal.Posix as TP import qualified System.Console.Terminal.Size as TP
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified "unix-bytestring" System.Posix.IO.ByteString import qualified "unix-bytestring" System.Posix.IO.ByteString
@@ -73,6 +73,7 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
execLogged :: ( MonadReader env m execLogged :: ( MonadReader env m
, HasSettings env , HasSettings env
, HasLog env
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadThrow m) , MonadThrow m)
@@ -85,6 +86,7 @@ execLogged :: ( MonadReader env m
execLogged exe args chdir lfile env = do execLogged exe args chdir lfile env = do
Settings {..} <- getSettings Settings {..} <- getSettings
Dirs {..} <- getDirs Dirs {..} <- getDirs
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
let logfile = logsDir </> lfile <> ".log" let logfile = logsDir </> lfile <> ".log"
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True }) liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
closeFd closeFd
@@ -141,14 +143,14 @@ execLogged exe args chdir lfile env = do
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO () printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
printToRegion fileFd fdIn size pState no_color = do printToRegion fileFd fdIn size pState no_color = do
-- init region -- init region
forM_ [1..size] $ \_ -> BS.putStr "\n" forM_ [1..size] $ \_ -> BS.hPut stderr "\n"
void $ flip runStateT mempty void $ flip runStateT mempty
$ do $ do
handle handle
(\(ex :: SomeException) -> do (\(ex :: SomeException) -> do
ps <- liftIO $ takeMVar pState ps <- liftIO $ takeMVar pState
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen)) when ps (liftIO $ BS.hPut stderr (pos1 <> moveLineUp size <> clearScreen))
throw ex throw ex
) $ readTilEOF lineAction fdIn ) $ readTilEOF lineAction fdIn
@@ -180,10 +182,10 @@ execLogged exe args chdir lfile env = do
modify (swapRegs bs') modify (swapRegs bs')
liftIO TP.size >>= \case liftIO TP.size >>= \case
Nothing -> pure () Nothing -> pure ()
Just (Window _ w) -> do Just (TP.Window _ w) -> do
regs <- get regs <- get
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
BS.putStr BS.hPut stderr
. overwriteNthLine (size - i) . overwriteNthLine (size - i)
. trim w . trim w
. blue . blue

View File

@@ -18,6 +18,7 @@ module GHCup.Utils.File.Windows where
import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink ) import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.File.Common import GHCup.Utils.File.Common
import GHCup.Utils.Logger
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
@@ -40,6 +41,7 @@ import qualified Control.Exception as EX
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text as T
@@ -149,6 +151,7 @@ executeOut path args chdir = do
execLogged :: ( MonadReader env m execLogged :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, HasSettings env , HasSettings env
, MonadIO m , MonadIO m
, MonadThrow m) , MonadThrow m)
@@ -160,6 +163,7 @@ execLogged :: ( MonadReader env m
-> m (Either ProcessError ()) -> m (Either ProcessError ())
execLogged exe args chdir lfile env = do execLogged exe args chdir lfile env = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
let stdoutLogfile = logsDir </> lfile <> ".stdout.log" let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
stderrLogfile = logsDir </> lfile <> ".stderr.log" stderrLogfile = logsDir </> lfile <> ".stderr.log"
cp <- createProcessWithMingwPath ((proc exe args) cp <- createProcessWithMingwPath ((proc exe args)
@@ -192,7 +196,8 @@ execLogged exe args chdir lfile env = do
then pure () then pure ()
else do else do
void $ BS.appendFile logFile some void $ BS.appendFile logFile some
void $ BS.hPut stdout some -- subprocess stdout also goes to stderr for logging
void $ BS.hPut stderr some
go go

View File

@@ -1,5 +1,4 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@@ -18,7 +17,7 @@ module GHCup.Utils.Logger where
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.File.Common import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles)
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import Control.Exception.Safe import Control.Exception.Safe

View File

@@ -1,7 +1,5 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Logger where module GHCup.Utils.Logger where

14
lib/GHCup/Utils/Posix.hs Normal file
View File

@@ -0,0 +1,14 @@
module GHCup.Utils.Posix where
-- | Enables ANSI support on windows, does nothing on unix.
--
-- Returns 'Left str' on errors and 'Right bool' on success, where
-- 'bool' markes whether ansi support was already enabled.
--
-- This function never crashes.
--
-- Rip-off of https://docs.rs/ansi_term/0.12.1/x86_64-pc-windows-msvc/src/ansi_term/windows.rs.html#10-61
enableAnsiSupport :: IO (Either String Bool)
enableAnsiSupport = pure (Right True)

View File

@@ -17,14 +17,25 @@ Portability : portable
GHCup specific prelude. Lots of Excepts functionality. GHCup specific prelude. Lots of Excepts functionality.
-} -}
module GHCup.Utils.Prelude where module GHCup.Utils.Prelude
(module GHCup.Utils.Prelude,
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
import GHCup.Types module GHCup.Utils.Prelude.Windows
#else
module GHCup.Utils.Prelude.Posix
#endif #endif
)
where
import GHCup.Types
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.Logger import {-# SOURCE #-} GHCup.Utils.Logger (logWarn)
#if defined(IS_WINDOWS)
import GHCup.Utils.Prelude.Windows
#else
import GHCup.Utils.Prelude.Posix
#endif
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe
@@ -33,7 +44,7 @@ import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd ) import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd, intersperse )
import Data.Maybe import Data.Maybe
import Data.Foldable import Data.Foldable
import Data.List.NonEmpty ( NonEmpty( (:|) )) import Data.List.NonEmpty ( NonEmpty( (:|) ))
@@ -45,17 +56,13 @@ import Haskus.Utils.Types.List
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty ) import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
import System.IO.Error import System.IO.Error
#if defined(IS_WINDOWS)
import System.IO.Temp import System.IO.Temp
#endif
import System.IO.Unsafe import System.IO.Unsafe
import System.Directory import System.Directory
import System.FilePath import System.FilePath
#if defined(IS_WINDOWS)
import Control.Retry import Control.Retry
import GHC.IO.Exception import GHC.IO.Exception
#endif
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@@ -69,9 +76,6 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B import qualified Data.Text.Lazy.Builder.Int as B
import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Text.Lazy.Encoding as TLE
#if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32
#endif
-- $setup -- $setup
@@ -304,23 +308,46 @@ intToText :: Integral a => a -> T.Text
intToText = TL.toStrict . B.toLazyText . B.decimal intToText = TL.toStrict . B.toLazyText . B.decimal
removeLensFieldLabel :: String -> String pvpToVersion :: MonadThrow m => PVP -> Text -> m Version
removeLensFieldLabel str' = pvpToVersion pvp_ rest =
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str' either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
-- | Convert a version to a PVP and unparsable rest.
pvpToVersion :: MonadThrow m => PVP -> m Version --
pvpToVersion = -- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP versionToPVP :: MonadThrow m => Version -> m (PVP, Text)
versionToPVP (Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP :: MonadThrow m => Version -> m PVP versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . pvp . prettyVer $ v
versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
where where
alternative :: MonadThrow m => Version -> m PVP alternative :: MonadThrow m => Version -> m PVP
alternative v' = case NE.takeWhile isDigit (_vChunks v') of alternative v' = case NE.takeWhile isDigit (_vChunks v') of
[] -> throwM $ ParseError "Couldn't convert Version to PVP" [] -> throwM $ ParseError "Couldn't convert Version to PVP"
xs -> pure $ pvpFromList (unsafeDigit <$> xs) xs -> pure $ pvpFromList (unsafeDigit <$> xs)
rest :: Version -> Text
rest (Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: VUnit -> Text
f (Digits i) = T.pack $ show i
f (Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: VChunk -> Bool isDigit :: VChunk -> Bool
isDigit (Digits _ :| []) = True isDigit (Digits _ :| []) = True
isDigit _ = False isDigit _ = False
@@ -438,19 +465,19 @@ recyclePathForcibly :: ( MonadIO m
) )
=> FilePath => FilePath
-> m () -> m ()
recyclePathForcibly fp = do recyclePathForcibly fp
#if defined(IS_WINDOWS) | isWindows = do
Dirs { recycleDir } <- getDirs Dirs { recycleDir } <- getDirs
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly" tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
let dest = tmp </> takeFileName fp let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0) liftIO (moveFile fp dest)
`catch` `catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e) (\e -> if | isDoesNotExistError e -> pure ()
`finally` | isPermissionError e {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp)
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp) | otherwise -> throwIO e)
#else `finally`
liftIO $ removePathForcibly fp liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#endif | otherwise = liftIO $ removePathForcibly fp
rmPathForcibly :: ( MonadIO m rmPathForcibly :: ( MonadIO m
@@ -458,23 +485,17 @@ rmPathForcibly :: ( MonadIO m
) )
=> FilePath => FilePath
-> m () -> m ()
rmPathForcibly fp = rmPathForcibly fp
#if defined(IS_WINDOWS) | isWindows = recover (liftIO $ removePathForcibly fp)
recover (liftIO $ removePathForcibly fp) | otherwise = liftIO $ removePathForcibly fp
#else
liftIO $ removePathForcibly fp
#endif
rmDirectory :: (MonadIO m, MonadMask m) rmDirectory :: (MonadIO m, MonadMask m)
=> FilePath => FilePath
-> m () -> m ()
rmDirectory fp = rmDirectory fp
#if defined(IS_WINDOWS) | isWindows = recover (liftIO $ removeDirectory fp)
recover (liftIO $ removeDirectory fp) | otherwise = liftIO $ removeDirectory fp
#else
liftIO $ removeDirectory fp
#endif
-- https://www.sqlite.org/src/info/89f1848d7f -- https://www.sqlite.org/src/info/89f1848d7f
@@ -486,20 +507,18 @@ recycleFile :: ( MonadIO m
) )
=> FilePath => FilePath
-> m () -> m ()
recycleFile fp = do recycleFile fp
#if defined(IS_WINDOWS) | isWindows = do
Dirs { recycleDir } <- getDirs Dirs { recycleDir } <- getDirs
liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp)) liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
tmp <- liftIO $ createTempDirectory recycleDir "recycleFile" tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
let dest = tmp </> takeFileName fp let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0) liftIO (moveFile fp dest)
`catch` `catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e) (\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally` `finally`
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp) liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#else | otherwise = liftIO $ removeFile fp
liftIO $ removeFile fp
#endif
rmFile :: ( MonadIO m rmFile :: ( MonadIO m
@@ -507,26 +526,19 @@ rmFile :: ( MonadIO m
) )
=> FilePath => FilePath
-> m () -> m ()
rmFile fp = rmFile fp
#if defined(IS_WINDOWS) | isWindows = recover (liftIO $ removeFile fp)
recover (liftIO $ removeFile fp) | otherwise = liftIO $ removeFile fp
#else
liftIO $ removeFile fp
#endif
rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
=> FilePath => FilePath
-> m () -> m ()
rmDirectoryLink fp = rmDirectoryLink fp
#if defined(IS_WINDOWS) | isWindows = recover (liftIO $ removeDirectoryLink fp)
recover (liftIO $ removeDirectoryLink fp) | otherwise = liftIO $ removeDirectoryLink fp
#else
liftIO $ removeDirectoryLink fp
#endif
#if defined(IS_WINDOWS)
recover :: (MonadIO m, MonadMask m) => m a -> m a recover :: (MonadIO m, MonadMask m) => m a -> m a
recover action = recover action =
recovering (fullJitterBackoff 25000 <> limitRetries 10) recovering (fullJitterBackoff 25000 <> limitRetries 10)
@@ -535,7 +547,6 @@ recover action =
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints)) ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
] ]
(\_ -> action) (\_ -> action)
#endif
copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m () copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
@@ -752,5 +763,3 @@ breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn _ [] = ([], []) breakOn _ [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs breakOn needle (x:xs) = first (x:) $ breakOn needle xs

View File

@@ -0,0 +1,20 @@
module GHCup.Utils.Prelude.Posix where
import System.Directory
import System.Posix.Files
isWindows, isNotWindows :: Bool
isWindows = False
isNotWindows = not isWindows
moveFile :: FilePath -> FilePath -> IO ()
moveFile = rename
moveFilePortable :: FilePath -> FilePath -> IO ()
moveFilePortable from to = do
copyFile from to
removeFile from

View File

@@ -0,0 +1,17 @@
module GHCup.Utils.Prelude.Windows where
import qualified System.Win32.File as Win32
isWindows, isNotWindows :: Bool
isWindows = True
isNotWindows = not isWindows
moveFile :: FilePath -> FilePath -> IO ()
moveFile from to = Win32.moveFileEx from (Just to) 0
moveFilePortable :: FilePath -> FilePath -> IO ()
moveFilePortable = Win32.moveFile

View File

@@ -1,4 +1,4 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-| {-|
Module : GHCup.Utils.String.QQ Module : GHCup.Utils.String.QQ

View File

@@ -4,7 +4,7 @@
{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskellQuotes #-}
{-| {-|
@@ -53,6 +53,9 @@ deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word) deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif #endif
qq :: (Text -> Q Exp) -> QuasiQuoter qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@@ -0,0 +1,48 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Windows where
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Data.Bits
import System.Win32.Console
import System.Win32.File hiding ( copyFile )
import System.Win32.Types
-- | Enables ANSI support on windows, does nothing on unix.
--
-- Returns 'Left str' on errors and 'Right bool' on success, where
-- 'bool' markes whether ansi support was already enabled.
--
-- This function never crashes.
--
-- Rip-off of https://docs.rs/ansi_term/0.12.1/x86_64-pc-windows-msvc/src/ansi_term/windows.rs.html#10-61
enableAnsiSupport :: IO (Either String Bool)
enableAnsiSupport = handleIO (pure . Left . displayException) $ do
-- ref: https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilew
-- Using `CreateFileW("CONOUT$", ...)` to retrieve the console handle works correctly even if STDOUT and/or STDERR are redirected
h <- createFile "CONOUT$" (gENERIC_WRITE .|. gENERIC_READ)
fILE_SHARE_WRITE Nothing oPEN_EXISTING 0 Nothing
when (h == iNVALID_HANDLE_VALUE ) $ fail "invalid handle value"
-- ref: https://docs.microsoft.com/en-us/windows/console/getconsolemode
m <- getConsoleMode h
-- VT processing not already enabled?
if m .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING == 0
-- https://docs.microsoft.com/en-us/windows/console/setconsolemode
then setConsoleMode h (m .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING)
>> pure (Right False)
else pure (Right True)

View File

@@ -28,7 +28,7 @@ import qualified Data.Text as T
-- Note that when updating this, CI requires that the file exsists AND the same file exists at -- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added. -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|] ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: PVP ghcUpVer :: PVP

View File

@@ -1,43 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
#if __GLASGOW_HASKELL__ >= 702
#define LANGUAGE_DeriveGeneric
{-# LANGUAGE DeriveGeneric #-}
#endif
module System.Console.Terminal.Common
( Window(..)
) where
import Data.Data (Typeable, Data)
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
#endif
#ifdef LANGUAGE_DeriveGeneric
import GHC.Generics
( Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
)
#endif
-- | Terminal window width and height
data Window a = Window
{ height :: !a
, width :: !a
} deriving
( Show, Eq, Read, Data, Typeable
, Foldable, Functor, Traversable
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)

View File

@@ -1,65 +0,0 @@
{-# LANGUAGE CApiFFI #-}
module System.Console.Terminal.Posix
( size, fdSize, hSize
) where
import System.Console.Terminal.Common
import Control.Exception (catch)
import Data.Typeable (cast)
import Foreign
import Foreign.C.Error
import Foreign.C.Types
import GHC.IO.FD (FD(FD, fdFD))
import GHC.IO.Handle.Internals (withHandle_)
import GHC.IO.Handle.Types (Handle, Handle__(Handle__, haDevice))
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 706)
import Prelude hiding (catch)
#endif
import System.Posix.Types (Fd(Fd))
#include <sys/ioctl.h>
#include <unistd.h>
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
-- Interesting part of @struct winsize@
data CWin = CWin CUShort CUShort
instance Storable CWin where
sizeOf _ = (#size struct winsize)
alignment _ = (#alignment struct winsize)
peek ptr = do
row <- (#peek struct winsize, ws_row) ptr
col <- (#peek struct winsize, ws_col) ptr
return $ CWin row col
poke ptr (CWin row col) = do
(#poke struct winsize, ws_row) ptr row
(#poke struct winsize, ws_col) ptr col
fdSize :: Integral n => Fd -> IO (Maybe (Window n))
fdSize (Fd fd) = with (CWin 0 0) $ \ws -> do
_ <- throwErrnoIfMinus1 "ioctl" $
ioctl fd (#const TIOCGWINSZ) ws
CWin row col <- peek ws
return . Just $ Window (fromIntegral row) (fromIntegral col)
`catch`
handler
where
handler :: IOError -> IO (Maybe (Window h))
handler _ = return Nothing
foreign import capi "sys/ioctl.h ioctl"
ioctl :: CInt -> CULong -> Ptr CWin -> IO CInt
size :: Integral n => IO (Maybe (Window n))
size = fdSize (Fd (#const STDOUT_FILENO))
hSize :: Integral n => Handle -> IO (Maybe (Window n))
hSize h = withHandle_ "hSize" h $ \Handle__ { haDevice = dev } ->
case cast dev of
Nothing -> return Nothing
Just FD { fdFD = fd } -> fdSize (Fd fd)

View File

@@ -1,6 +1,6 @@
site_name: GHCup site_name: GHCup
site_url: https://www.haskell.org/ghcup site_url: https://www.haskell.org/ghcup
site_description: GHCup documentation site_description: GHCup is an installer for the general purpose language Haskell.
site_author: GHCup Team site_author: GHCup Team
site_favicon: haskell_logo.png site_favicon: haskell_logo.png

View File

@@ -25,7 +25,7 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.17.2" ghver="0.1.17.5"
base_url="https://downloads.haskell.org/~ghcup" base_url="https://downloads.haskell.org/~ghcup"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -39,7 +39,6 @@ case "${plat}" in
;; ;;
*) *)
: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}" : "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
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/share}/ghcup GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
@@ -201,10 +200,10 @@ download_ghcup() {
i*86) i*86)
_url=${base_url}/${ghver}/i386-linux-ghcup-${ghver} _url=${base_url}/${ghver}/i386-linux-ghcup-${ghver}
;; ;;
armv7*) armv7*|*armv8l*)
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver} _url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
;; ;;
aarch64|arm64|armv8l) aarch64|arm64)
# we could be in a 32bit docker container, in which # we could be in a 32bit docker container, in which
# case uname doesn't give us what we want # case uname doesn't give us what we want
if [ "$(getconf LONG_BIT)" = "32" ] ; then if [ "$(getconf LONG_BIT)" = "32" ] ; then
@@ -237,7 +236,7 @@ download_ghcup() {
*) die "Unknown architecture: ${arch}" *) die "Unknown architecture: ${arch}"
;; ;;
esac esac
_url=${base_url}/${ghver}/x86_64-portbld-freebsd${freebsd_ver}-ghcup-${ghver} _url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
;; ;;
"Darwin"|"darwin") "Darwin"|"darwin")
case "${arch}" in case "${arch}" in
@@ -281,7 +280,20 @@ download_ghcup() {
# we may overwrite this in adjust_bashrc # we may overwrite this in adjust_bashrc
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" case ":\$PATH:" in
*:"${GHCUP_BIN}":*)
;;
*)
export PATH="${GHCUP_BIN}:\$PATH"
;;
esac
case ":\$PATH:" in
*:"\$HOME/.cabal/bin":*)
;;
*)
export PATH="\$HOME/.cabal/bin:\$PATH"
;;
esac
EOF EOF
# shellcheck disable=SC1090 # shellcheck disable=SC1090
@@ -369,12 +381,38 @@ adjust_bashrc() {
case $1 in case $1 in
1) 1)
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" case ":\$PATH:" in
*:"${GHCUP_BIN}":*)
;;
*)
export PATH="${GHCUP_BIN}:\$PATH"
;;
esac
case ":\$PATH:" in
*:"\$HOME/.cabal/bin":*)
;;
*)
export PATH="\$HOME/.cabal/bin:\$PATH"
;;
esac
EOF EOF
;; ;;
2) 2)
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file" cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$PATH:\$HOME/.cabal/bin:${GHCUP_BIN}" case ":\$PATH:" in
*:"\$HOME/.cabal/bin":*)
;;
*)
export PATH="\$PATH:\$HOME/.cabal/bin"
;;
esac
case ":\$PATH:" in
*:"${GHCUP_BIN}":*)
;;
*)
export PATH="\$PATH:${GHCUP_BIN}"
;;
esac
EOF EOF
;; ;;
*) ;; *) ;;
@@ -487,7 +525,7 @@ ask_cabal_config_init() {
esac esac
done done
else else
return 1 return 0
fi fi
;; ;;
esac esac
@@ -505,8 +543,8 @@ do_cabal_config_init() {
adjust_cabal_config adjust_cabal_config
;; ;;
0) 0)
echo "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)." warn "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
echo "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation." warn "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
sleep 5 sleep 5
return ;; return ;;
*) ;; *) ;;
@@ -679,7 +717,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
do_cabal_config_init $ask_cabal_config_init_answer do_cabal_config_init $ask_cabal_config_init_answer
edo cabal new-update edo cabal new-update --ignore-project
else # don't install ghc and cabal else # don't install ghc and cabal
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)

View File

@@ -29,11 +29,11 @@ param (
[switch]$InstallStack, [switch]$InstallStack,
# Whether to install hls as well # Whether to install hls as well
[switch]$InstallHLS, [switch]$InstallHLS,
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[string]$InstallDir,
# Instead of installing a new MSys2, use an existing installation
[string]$BootstrapUrl,
# Specify the install root (default: 'C:\') # Specify the install root (default: 'C:\')
[string]$InstallDir,
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[string]$BootstrapUrl,
# Instead of installing a new MSys2, use an existing installation
[string]$ExistingMsys2Dir, [string]$ExistingMsys2Dir,
# Specify the cabal root directory (default: '$InstallDir\cabal') # Specify the cabal root directory (default: '$InstallDir\cabal')
[string]$CabalDir [string]$CabalDir
@@ -246,6 +246,7 @@ if ($Silent -and !($InstallDir)) {
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix) $GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
} }
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
if (!($GhcupBasePrefix)) { if (!($GhcupBasePrefix)) {
Print-Msg -color Red -msg "No directory specified!" Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) { } elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) {
@@ -333,6 +334,7 @@ if ($CabalDir) {
$CabalDirPrompt = Read-Host $CabalDirPrompt = Read-Host
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt] $CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
if (!($CabDirEnv)) { if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!" Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) { } elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
@@ -401,16 +403,17 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
# Download the archive # Download the archive
Print-Msg -msg 'Downloading Msys2 archive...' Print-Msg -msg 'Downloading Msys2 archive...'
$archive = 'msys2-x86_64-latest.sfx.exe' $archive = 'msys2-x86_64-latest.sfx.exe'
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
if (Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) { if (Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) {
Exec "curl.exe" '-o' ('{0}\{1}' -f $env:TEMP, $archive) ('https://repo.msys2.org/distrib/{0}' -f $archive) Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
} else { } else {
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder "$env:TEMP" -includeStats Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
} }
Print-Msg -msg 'Extracting Msys2 archive...' Print-Msg -msg 'Extracting Msys2 archive...'
$null = & "$env:TEMP\$archive" '-y' ('-o{0}' -f $GhcupDir) # Extract $null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
Remove-Item -Path ('{0}/{1}' -f $env:TEMP, $archive) Remove-Item -Path "$archivePath"
Print-Msg -msg 'Processing MSYS2 bash for first time use...' Print-Msg -msg 'Processing MSYS2 bash for first time use...'
Exec "$Bash" '-lc' 'exit' Exec "$Bash" '-lc' 'exit'
@@ -444,6 +447,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:' Print-Msg -color Magenta -msg 'Input existing MSys2 toolchain directory:'
$MsysDir = Read-Host $MsysDir = Read-Host
} }
$MsysDir = $MsysDir.TrimEnd().TrimStart()
if (!($MsysDir)) { if (!($MsysDir)) {
Print-Msg -color Red -msg "No directory specified!" Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) { } elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {

View File

@@ -0,0 +1,49 @@
set -eu
tag=v$1
ver=$1
dest=$2
gpg_user=$3
mkdir -p "${dest}"
cd "${dest}"
base_url="https://gitlab.haskell.org/api/v4/projects/618/jobs/artifacts/${tag}/raw"
curl -f -o "x86_64-apple-darwin-ghcup-${ver}" \
"${base_url}/out/x86_64-apple-darwin-ghcup-${ver}?job=release:darwin"
curl -f -o "aarch64-apple-darwin-ghcup-${ver}" \
"${base_url}/out/aarch64-apple-darwin-ghcup-${ver}?job=release:darwin:aarch64"
curl -f -o "x86_64-freebsd12-ghcup-${ver}" \
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd12"
curl -f -o "x86_64-freebsd13-ghcup-${ver}" \
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd13"
curl -f -o "i386-linux-ghcup-${ver}" \
"${base_url}/out/i386-linux-ghcup-${ver}?job=release:linux:32bit"
curl -f -o "x86_64-linux-ghcup-${ver}" \
"${base_url}/out/x86_64-linux-ghcup-${ver}?job=release:linux:64bit"
curl -f -o "aarch64-linux-ghcup-${ver}" \
"${base_url}/out/aarch64-linux-ghcup-${ver}?job=release:linux:aarch64"
curl -f -o "armv7-linux-ghcup-${ver}" \
"${base_url}/out/armv7-linux-ghcup-${ver}?job=release:linux:armv7"
curl -f -o "x86_64-mingw64-ghcup-${ver}.exe" \
"${base_url}/out/x86_64-mingw64-ghcup-${ver}.exe?job=release:windows"
rm -f *.sig
sha256sum *-ghcup-* > SHA256SUMS
gpg --detach-sign -u ${gpg_user} SHA256SUMS
for f in *-ghcup-* ; do gpg --detach-sign -u ${gpg_user} $f ; done

View File

@@ -0,0 +1,39 @@
#!/bin/bash
url=$1
ver=$2
die() {
(>&2 printf "%s\\n" "$1")
exit 2
}
[ -z $url ] && die "no url set"
[ -z $ver ] && die "no version set"
sftp $url <<EOF
cd ghcup
rm aarch64-apple-darwin-ghcup
rm aarch64-linux-ghcup
rm armv7-linux-ghcup
rm i386-linux-ghcup
rm x86_64-apple-darwin-ghcup
rm x86_64-linux-ghcup
rm x86_64-mingw64-ghcup.exe
rm x86_64-freebsd12-ghcup
rm x86_64-freebsd13-ghcup
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
EOF
curl -X PURGE https://downloads.haskell.org/~ghcup/
curl -X PURGE https://downloads.haskell.org/ghcup/

View File

@@ -0,0 +1,47 @@
#!/bin/bash
url=$1
ver=$2
artifacts_dir=$3
die() {
(>&2 printf "%s\\n" "$1")
exit 2
}
[ -z $url ] && die "no url set"
[ -z $ver ] && die "no version set"
[ -z "${artifacts_dir}" ] && die "artifacts_dir not set"
[ -e "${artifacts_dir}" ] || die "artifacts_dir \"${artifacts_dir}\" does not exist"
cd "${artifacts_dir}"
sftp $url <<EOF
cd ghcup
mkdir ${ver}
cd ${ver}
put SHA256SUMS
put SHA256SUMS.sig
put aarch64-apple-darwin-ghcup-${ver}
put aarch64-apple-darwin-ghcup-${ver}.sig
put aarch64-linux-ghcup-${ver}
put aarch64-linux-ghcup-${ver}.sig
put armv7-linux-ghcup-${ver}
put armv7-linux-ghcup-${ver}.sig
put i386-linux-ghcup-${ver}
put i386-linux-ghcup-${ver}.sig
put x86_64-apple-darwin-ghcup-${ver}
put x86_64-apple-darwin-ghcup-${ver}.sig
put x86_64-freebsd12-ghcup-${ver}
put x86_64-freebsd12-ghcup-${ver}.sig
put x86_64-freebsd13-ghcup-${ver}
put x86_64-freebsd13-ghcup-${ver}.sig
put x86_64-linux-ghcup-${ver}
put x86_64-linux-ghcup-${ver}.sig
put x86_64-mingw64-ghcup-${ver}.exe
put x86_64-mingw64-ghcup-${ver}.exe.sig
EOF
curl -X PURGE https://downloads.haskell.org/~ghcup/${ver}/
curl -X PURGE https://downloads.haskell.org/ghcup/${ver}/

View File

@@ -1,4 +1,4 @@
resolver: lts-18.12 resolver: lts-18.25
packages: packages:
- . - .
@@ -16,7 +16,7 @@ extra-deps:
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216 - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466 - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298 - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159 - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615 - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712 - hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
@@ -25,6 +25,7 @@ extra-deps:
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179 - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582 - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.3.0 - libarchive-3.0.3.0
- libyaml-streamly-0.2.0
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308 - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568 - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995 - optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
@@ -33,11 +34,15 @@ extra-deps:
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716 - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728 - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7 - regex-posix-clib-2.7
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421 - streamly-0.8.0@sha256:9784c80ee1ada51477520cabc4e92a0c76a6bb265f968a188f2fce818e7398e0,19654
- streamly-bytestring-0.1.2@sha256:cc828f41d1c714c711d38fb213b4ed186febabba598ab080e13255f69c20b13c,2469
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248 - strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- yaml-streamly-0.12.0
- git: https://github.com/hasufell/packages.git
commit: cc0b4688f8bb374fa92f17c856949de795b56291
subdirs:
- haskus-utils-variant
flags: flags:
http-io-streams: http-io-streams:

View File

@@ -3,7 +3,7 @@
module GHCup.Types.JSONSpec where module GHCup.Types.JSONSpec where
import GHCup.ArbitraryTypes () import GHCup.ArbitraryTypes ()
import GHCup.Types import GHCup.Types hiding ( defaultSettings )
import GHCup.Types.JSON () import GHCup.Types.JSON ()
import Test.Aeson.GenericSpecs import Test.Aeson.GenericSpecs