Compare commits
174 Commits
cabal-comp
...
v0.1.17.6-
| Author | SHA1 | Date | |
|---|---|---|---|
|
00652f2887
|
|||
|
89b0a31f33
|
|||
|
85b05efcbb
|
|||
|
5a19613160
|
|||
|
c20b6bef29
|
|||
|
47bf8a6f31
|
|||
|
c3ddeb27bc
|
|||
|
0c70feb09c
|
|||
|
f9a38e616d
|
|||
|
e511fc3c0a
|
|||
|
3ff670134c
|
|||
|
4c0160bb28
|
|||
|
c1e0baedd3
|
|||
|
8f7d937e26
|
|||
|
604a6fc92b
|
|||
|
8c205fd18c
|
|||
|
2b6d970723
|
|||
|
41ecf897fb
|
|||
|
4c9c6e9223
|
|||
|
8be71c4c5c
|
|||
|
01d310e630
|
|||
|
96cb99e1b5
|
|||
|
2e08efeed7
|
|||
|
04fceb3134
|
|||
|
1f0a891bab
|
|||
|
6c63a65983
|
|||
|
199d3b7aee
|
|||
|
04fc04f586
|
|||
|
3f96a6460a
|
|||
|
bfcaa7f6fb
|
|||
|
e2bd4c4880
|
|||
|
ab702bba9b
|
|||
|
8afabf3ffb
|
|||
|
ebf6c60a10
|
|||
|
9a8291d391
|
|||
|
a6426901c5
|
|||
|
3b7dd36aa6
|
|||
|
dc635a6601
|
|||
|
08ec1bd923
|
|||
|
b78aab884e
|
|||
|
36e192ec32
|
|||
|
510675622b
|
|||
|
651722b935
|
|||
|
7a0d5a95c1
|
|||
|
2c583bcae9
|
|||
|
ab36d4418e
|
|||
|
f146c77797
|
|||
|
d863ac570b
|
|||
|
d05fad49a1
|
|||
|
fbbc4497ca
|
|||
|
4223586e62
|
|||
|
c859b3ee2b
|
|||
|
8a16b0de7c
|
|||
|
9faf17634b
|
|||
|
66a62c170c
|
|||
|
5186d959bc
|
|||
|
09a8a0bda0
|
|||
|
191f49adfc
|
|||
|
|
26b79c5763 | ||
|
c72841ca58
|
|||
|
63350dab71
|
|||
|
d110d20879
|
|||
|
b4e58478c3
|
|||
|
12d2acd7fd
|
|||
|
6073ebe476
|
|||
|
5c026591cb
|
|||
|
907365ddff
|
|||
|
684953464b
|
|||
|
6b978b42bc
|
|||
|
6831337289
|
|||
|
e40777a5d3
|
|||
|
51690d1df3
|
|||
|
72a06e964c
|
|||
|
9ffd402481
|
|||
|
dee8d4bc09
|
|||
|
6c57661797
|
|||
|
b9ff7c5af4
|
|||
|
072161ada2
|
|||
|
a67b3e8a57
|
|||
|
c9216fb444
|
|||
|
2aac17ac5f
|
|||
|
17a403b8ce
|
|||
|
b245c11b1d
|
|||
|
2ed047515e
|
|||
|
b16e561384
|
|||
|
|
2ebff1e887 | ||
|
655ee432f8
|
|||
|
67b7b2f292
|
|||
|
66961101c6
|
|||
|
326af49a8f
|
|||
|
3a7ed5ee2d
|
|||
|
56fa798406
|
|||
|
|
3fd9fae66a | ||
|
|
5d43168370 | ||
|
|
f8548fefb3 | ||
|
|
3565c32d51 | ||
|
7fab328acc
|
|||
|
a043b82b27
|
|||
|
20652fed94
|
|||
|
6fc52a4ec7
|
|||
|
834bcfa02c
|
|||
|
c99ecc0a66
|
|||
|
061e5dd832
|
|||
|
c97ade81fa
|
|||
|
82a22fe993
|
|||
|
dbadcf1858
|
|||
|
ff8865c5c3
|
|||
|
9833dee925
|
|||
|
aac2874f8f
|
|||
|
17524b21b3
|
|||
|
3f0befe30d
|
|||
|
76c286f95e
|
|||
|
0c415314b6
|
|||
|
717f386077
|
|||
|
7a841a480b
|
|||
|
43ea85b495
|
|||
|
8a6badca1d
|
|||
|
4064803e23
|
|||
|
2e03b075f8
|
|||
|
fe9c125bd6
|
|||
|
503fd57d7c
|
|||
|
e74e746213
|
|||
|
065f9c4965
|
|||
|
32f3c36589
|
|||
|
c2a8d39fb4
|
|||
|
f08cbe70fb
|
|||
|
a9630d0802
|
|||
|
c5c6c431b5
|
|||
|
71d78d2d72
|
|||
|
ccecda2eff
|
|||
|
3a5f8d6139
|
|||
|
74e0f39bc2
|
|||
|
274978a8a7
|
|||
|
8eea9bd6a5
|
|||
|
626a2dd020
|
|||
|
6b6ce221e0
|
|||
|
d038c361c0
|
|||
|
c05876cc60
|
|||
|
b9c4c9a0b7
|
|||
|
6697e804ee
|
|||
|
2c57def8f1
|
|||
|
62b16e957b
|
|||
|
18d7bdd85c
|
|||
|
190b5dedba
|
|||
|
886e45f788
|
|||
|
360daf2a09
|
|||
|
7bb67dd4c6
|
|||
|
72c4ea70c4
|
|||
|
0ae42dd71e
|
|||
|
1df1e7eb98
|
|||
|
9592021c48
|
|||
|
9a9c3b340e
|
|||
|
abd64cb3fa
|
|||
|
b366a50af1
|
|||
|
e4b9eeefc6
|
|||
|
4d7a8557eb
|
|||
|
c23357df81
|
|||
|
f728d5aa23
|
|||
|
ac59563adf
|
|||
|
b2d2996077
|
|||
|
df2337abf9
|
|||
|
d68ab3b657
|
|||
|
c10821c332
|
|||
|
219cba5fc7
|
|||
|
8e3c74958a
|
|||
|
ed08e0b166
|
|||
|
168f2e6d16
|
|||
|
4574f3aa4f
|
|||
|
2a11e85a95
|
|||
|
69df100b18
|
|||
|
920b027a32
|
|||
|
9f8c9c228d
|
|||
|
9d8fdfe090
|
|||
|
01956d694d
|
4
.github/workflows/release.yaml
vendored
4
.github/workflows/release.yaml
vendored
@@ -44,8 +44,8 @@ jobs:
|
||||
|
||||
- uses: haskell/actions/setup@v1.2
|
||||
with:
|
||||
ghc-version: 8.10.4
|
||||
cabal-version: 3.4.0.0
|
||||
ghc-version: 8.10.7
|
||||
cabal-version: 3.6.2.0
|
||||
|
||||
- name: create ~/.local/bin
|
||||
run: mkdir -p "$HOME/.local/bin"
|
||||
|
||||
2
.gitignore
vendored
2
.gitignore
vendored
@@ -13,3 +13,5 @@ TAGS
|
||||
/tmp/
|
||||
.entangled
|
||||
release/
|
||||
releases/
|
||||
site/
|
||||
|
||||
123
.gitlab-ci.yml
123
.gitlab-ci.yml
@@ -11,6 +11,13 @@ variables:
|
||||
# Commit of ghc/ci-images repository from which to pull Docker images
|
||||
DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11
|
||||
|
||||
# Sequential version number of all cached things.
|
||||
# Bump to invalidate GitLab CI cache.
|
||||
CACHE_REV: 0
|
||||
|
||||
GIT_SUBMODULE_STRATEGY: recursive
|
||||
|
||||
|
||||
############################################################
|
||||
# CI Step
|
||||
############################################################
|
||||
@@ -111,7 +118,7 @@ variables:
|
||||
script:
|
||||
- bash ./.gitlab/script/ghcup_version.sh
|
||||
variables:
|
||||
JSON_VERSION: "0.0.6"
|
||||
JSON_VERSION: "0.0.7"
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
@@ -164,26 +171,40 @@ variables:
|
||||
- .test_ghcup_version
|
||||
- .darwin:aarch64
|
||||
- .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: |
|
||||
set -Eeuo pipefail
|
||||
function runInNixShell() {
|
||||
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
|
||||
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
|
||||
--argstr system "aarch64-darwin" \
|
||||
--pure \
|
||||
--keep CI_PROJECT_DIR \
|
||||
--keep MACOSX_DEPLOYMENT_TARGET \
|
||||
--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
|
||||
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
|
||||
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
|
||||
export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
|
||||
export LD=ld
|
||||
export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
|
||||
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
|
||||
./.gitlab/before_script/darwin/install_deps.sh
|
||||
./.gitlab/script/ghcup_version.sh
|
||||
|
||||
.test_ghcup_version:freebsd12:
|
||||
extends:
|
||||
@@ -199,6 +220,9 @@ variables:
|
||||
- .freebsd13
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- sudo pkg update
|
||||
- sudo pkg install --yes compat12x-amd64
|
||||
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
|
||||
.test_ghcup_version:windows:
|
||||
@@ -227,7 +251,7 @@ variables:
|
||||
only:
|
||||
- tags
|
||||
variables:
|
||||
JSON_VERSION: "0.0.6"
|
||||
JSON_VERSION: "0.0.7"
|
||||
|
||||
######## stack test ########
|
||||
|
||||
@@ -388,6 +412,7 @@ test:mac:aarch64:
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
needs: []
|
||||
allow_failure: true
|
||||
when: manual
|
||||
|
||||
|
||||
######## freebsd test ########
|
||||
@@ -508,32 +533,47 @@ release:darwin:aarch64:
|
||||
- .darwin:aarch64
|
||||
- .release_ghcup
|
||||
- .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: |
|
||||
set -Eeuo pipefail
|
||||
function runInNixShell() {
|
||||
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
|
||||
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
|
||||
--argstr system "aarch64-darwin" \
|
||||
--pure \
|
||||
--keep CI_PROJECT_DIR \
|
||||
--keep MACOSX_DEPLOYMENT_TARGET \
|
||||
--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
|
||||
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
|
||||
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
|
||||
export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
|
||||
export LD=ld
|
||||
export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
|
||||
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
|
||||
./.gitlab/before_script/darwin/install_deps.sh
|
||||
./.gitlab/script/ghcup_release.sh
|
||||
variables:
|
||||
ARTIFACT: "aarch64-apple-darwin-ghcup"
|
||||
GHC_VERSION: "8.10.7"
|
||||
CABAL_VERSION: "3.6.2.0"
|
||||
MACOSX_DEPLOYMENT_TARGET: "10.7"
|
||||
allow_failure: true
|
||||
when: manual
|
||||
|
||||
|
||||
######## freebsd release ########
|
||||
@@ -561,6 +601,9 @@ release:freebsd13:
|
||||
- .release_ghcup
|
||||
- .root_cleanup
|
||||
before_script:
|
||||
- sudo pkg update
|
||||
- sudo pkg install --yes compat12x-amd64
|
||||
- sudo ln -s libncurses.so.6 /usr/local/lib/libncurses.so.6.2
|
||||
- ./.gitlab/before_script/freebsd/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
|
||||
|
||||
@@ -12,4 +12,8 @@ if [ "${OS}" = "WINDOWS" ] ; then
|
||||
rm -Rf /c/ghcup
|
||||
fi
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
rm -Rf /private/tmp/.brew_tmp
|
||||
fi
|
||||
|
||||
exit 0
|
||||
|
||||
@@ -8,7 +8,15 @@ set -eux
|
||||
|
||||
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
|
||||
|
||||
./ghcup-bin -v upgrade -i -f
|
||||
|
||||
37
.gitlab/ghcup-run.files
Normal file
37
.gitlab/ghcup-run.files
Normal file
@@ -0,0 +1,37 @@
|
||||
.
|
||||
./cabal
|
||||
./ghc
|
||||
./ghc-8.10.7
|
||||
./ghc-pkg
|
||||
./ghc-pkg-8.10.7
|
||||
./ghci
|
||||
./ghci-8.10.7
|
||||
./haddock
|
||||
./haddock-8.10.7
|
||||
./haskell-language-server-8.10.6
|
||||
./haskell-language-server-8.10.6~1.6.1.0
|
||||
./haskell-language-server-8.10.7
|
||||
./haskell-language-server-8.10.7~1.6.1.0
|
||||
./haskell-language-server-8.6.5
|
||||
./haskell-language-server-8.6.5~1.6.1.0
|
||||
./haskell-language-server-8.8.4
|
||||
./haskell-language-server-8.8.4~1.6.1.0
|
||||
./haskell-language-server-9.0.1
|
||||
./haskell-language-server-9.0.1~1.6.1.0
|
||||
./haskell-language-server-9.0.2
|
||||
./haskell-language-server-9.0.2~1.6.1.0
|
||||
./haskell-language-server-9.2.1
|
||||
./haskell-language-server-9.2.1~1.6.1.0
|
||||
./haskell-language-server-wrapper
|
||||
./haskell-language-server-wrapper-1.6.1.0
|
||||
./hp2ps
|
||||
./hp2ps-8.10.7
|
||||
./hpc
|
||||
./hpc-8.10.7
|
||||
./hsc2hs
|
||||
./hsc2hs-8.10.7
|
||||
./runghc
|
||||
./runghc-8.10.7
|
||||
./runhaskell
|
||||
./runhaskell-8.10.7
|
||||
./stack
|
||||
81
.gitlab/ghcup-run.files.windows
Normal file
81
.gitlab/ghcup-run.files.windows
Normal file
@@ -0,0 +1,81 @@
|
||||
.
|
||||
./cabal.exe
|
||||
./cabal.shim
|
||||
./ghc-8.10.7.exe
|
||||
./ghc-8.10.7.shim
|
||||
./ghc-pkg-8.10.7.exe
|
||||
./ghc-pkg-8.10.7.shim
|
||||
./ghc-pkg.exe
|
||||
./ghc-pkg.shim
|
||||
./ghc.exe
|
||||
./ghc.shim
|
||||
./ghci-8.10.7.exe
|
||||
./ghci-8.10.7.shim
|
||||
./ghci.exe
|
||||
./ghci.shim
|
||||
./ghcii-8.10.7.sh-8.10.7.exe
|
||||
./ghcii-8.10.7.sh-8.10.7.shim
|
||||
./ghcii-8.10.7.sh.exe
|
||||
./ghcii-8.10.7.sh.shim
|
||||
./ghcii.sh-8.10.7.exe
|
||||
./ghcii.sh-8.10.7.shim
|
||||
./ghcii.sh.exe
|
||||
./ghcii.sh.shim
|
||||
./haddock-8.10.7.exe
|
||||
./haddock-8.10.7.shim
|
||||
./haddock.exe
|
||||
./haddock.shim
|
||||
./haskell-language-server-8.10.6.exe
|
||||
./haskell-language-server-8.10.6.shim
|
||||
./haskell-language-server-8.10.6~1.6.1.0.exe
|
||||
./haskell-language-server-8.10.6~1.6.1.0.shim
|
||||
./haskell-language-server-8.10.7.exe
|
||||
./haskell-language-server-8.10.7.shim
|
||||
./haskell-language-server-8.10.7~1.6.1.0.exe
|
||||
./haskell-language-server-8.10.7~1.6.1.0.shim
|
||||
./haskell-language-server-8.6.5.exe
|
||||
./haskell-language-server-8.6.5.shim
|
||||
./haskell-language-server-8.6.5~1.6.1.0.exe
|
||||
./haskell-language-server-8.6.5~1.6.1.0.shim
|
||||
./haskell-language-server-8.8.4.exe
|
||||
./haskell-language-server-8.8.4.shim
|
||||
./haskell-language-server-8.8.4~1.6.1.0.exe
|
||||
./haskell-language-server-8.8.4~1.6.1.0.shim
|
||||
./haskell-language-server-9.0.1.exe
|
||||
./haskell-language-server-9.0.1.shim
|
||||
./haskell-language-server-9.0.1~1.6.1.0.exe
|
||||
./haskell-language-server-9.0.1~1.6.1.0.shim
|
||||
./haskell-language-server-9.0.2.exe
|
||||
./haskell-language-server-9.0.2.shim
|
||||
./haskell-language-server-9.0.2~1.6.1.0.exe
|
||||
./haskell-language-server-9.0.2~1.6.1.0.shim
|
||||
./haskell-language-server-9.2.1.exe
|
||||
./haskell-language-server-9.2.1.shim
|
||||
./haskell-language-server-9.2.1~1.6.1.0.exe
|
||||
./haskell-language-server-9.2.1~1.6.1.0.shim
|
||||
./haskell-language-server-wrapper-1.6.1.0.exe
|
||||
./haskell-language-server-wrapper-1.6.1.0.shim
|
||||
./haskell-language-server-wrapper.exe
|
||||
./haskell-language-server-wrapper.shim
|
||||
./hp2ps-8.10.7.exe
|
||||
./hp2ps-8.10.7.shim
|
||||
./hp2ps.exe
|
||||
./hp2ps.shim
|
||||
./hpc-8.10.7.exe
|
||||
./hpc-8.10.7.shim
|
||||
./hpc.exe
|
||||
./hpc.shim
|
||||
./hsc2hs-8.10.7.exe
|
||||
./hsc2hs-8.10.7.shim
|
||||
./hsc2hs.exe
|
||||
./hsc2hs.shim
|
||||
./runghc-8.10.7.exe
|
||||
./runghc-8.10.7.shim
|
||||
./runghc.exe
|
||||
./runghc.shim
|
||||
./runhaskell-8.10.7.exe
|
||||
./runhaskell-8.10.7.shim
|
||||
./runhaskell.exe
|
||||
./runhaskell.shim
|
||||
./stack.exe
|
||||
./stack.shim
|
||||
@@ -6,6 +6,6 @@ if [ "${OS}" = "WINDOWS" ] ; then
|
||||
else
|
||||
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
|
||||
export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
|
||||
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
|
||||
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
|
||||
export TMPDIR="$CI_PROJECT_DIR/tmp"
|
||||
fi
|
||||
|
||||
@@ -41,7 +41,7 @@ cabal --version
|
||||
|
||||
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}" ]
|
||||
|
||||
|
||||
@@ -83,7 +83,6 @@ else
|
||||
ext=''
|
||||
fi
|
||||
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext}
|
||||
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
|
||||
|
||||
@@ -92,12 +91,11 @@ rm -rf "${GHCUP_DIR}"
|
||||
### manual cli based testing
|
||||
|
||||
|
||||
ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
|
||||
|
||||
eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${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 install cabal ${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
|
||||
eghcup set cabal ${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
|
||||
|
||||
@@ -134,7 +148,7 @@ else
|
||||
eghcup --offline install ghc 8.10.3
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
fi
|
||||
@@ -142,7 +156,7 @@ else
|
||||
eghcup prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
else
|
||||
@@ -183,6 +197,8 @@ else
|
||||
fi
|
||||
fi
|
||||
|
||||
|
||||
|
||||
# check that lazy loading works for 'whereis'
|
||||
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
|
||||
@@ -15,5 +15,5 @@ git describe
|
||||
ecabal update
|
||||
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hlint
|
||||
|
||||
hlint -r lib/ test/
|
||||
hlint -r app/ lib/ test/
|
||||
|
||||
|
||||
@@ -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
4
.gitmodules
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
[submodule "data/metadata"]
|
||||
path = data/metadata
|
||||
url = https://github.com/haskell/ghcup-metadata.git
|
||||
branch = master
|
||||
40
CHANGELOG.md
40
CHANGELOG.md
@@ -1,5 +1,45 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.17.6 -- ????-??-??
|
||||
|
||||
* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
|
||||
* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
|
||||
* Fix bad error message wrt [#323](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/323)
|
||||
* Use predictable /tmp names for `ghcup run`, fixes [#329](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/329)
|
||||
* Fix bug with isolated installation of not previously installed versions
|
||||
* Add `--no-set` to install commands, fixes [#330](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/330)
|
||||
* Fix serious bug in `ghcup list --raw-format -t <tool> -c installed`
|
||||
* Overhaul metadata merging and add `ghcup config add-release-channel URI` wrt [#328](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/328)
|
||||
|
||||
## 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
|
||||
|
||||
* Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250)
|
||||
|
||||
@@ -9,3 +9,5 @@
|
||||
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.
|
||||
|
||||
If you're looking for the metadata YAML files, see here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)
|
||||
|
||||
@@ -1,157 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# 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
|
||||
@@ -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 (notElem (Linux UnknownLinux) pspecs) $ do
|
||||
lift $ logError $
|
||||
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
addError
|
||||
when ((notElem Darwin pspecs) && arch == A_64) $ do
|
||||
lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
addError
|
||||
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
|
||||
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
|
||||
when (notElem Windows 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 (notElem (Linux Alpine) 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 = join $ fmap _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 = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||
forM_ [Latest, Recommended] $ \t -> case elem t 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" *> (flip runReaderT ref addError)
|
||||
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
|
||||
(flip runReaderT ref addError)
|
||||
Just (RegexDir regexString) -> do
|
||||
logInfo $
|
||||
"verifying subdir (regex): " <> T.pack regexString
|
||||
let regex = makeRegexOpts
|
||||
compIgnoreCase
|
||||
execBlank
|
||||
regexString
|
||||
when (not (match regex basePath)) $ do
|
||||
logError $
|
||||
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
|
||||
(flip runReaderT ref addError)
|
||||
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)
|
||||
(flip runReaderT ref addError)
|
||||
@@ -2,10 +2,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module BrickMain where
|
||||
@@ -13,6 +10,7 @@ module BrickMain where
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Types hiding ( LeanAppState(..) )
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
@@ -29,6 +27,9 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||
)
|
||||
import Codec.Archive
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Resource
|
||||
@@ -43,6 +44,8 @@ import Data.Vector ( Vector
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Directory ( canonicalizePath )
|
||||
import System.FilePath
|
||||
import System.Exit
|
||||
import System.IO.Unsafe
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
@@ -51,6 +54,8 @@ import URI.ByteString
|
||||
import qualified Data.Text as T
|
||||
import qualified Graphics.Vty as Vty
|
||||
import qualified Data.Vector as V
|
||||
import System.Environment (getExecutablePath)
|
||||
import qualified System.Posix.Process as SPP
|
||||
|
||||
|
||||
hiddenTools :: [Tool]
|
||||
@@ -368,10 +373,7 @@ listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
|
||||
|
||||
|
||||
selectLatest :: Vector ListResult -> Int
|
||||
selectLatest v =
|
||||
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
|
||||
Just ix -> ix
|
||||
Nothing -> 0
|
||||
selectLatest = fromMaybe 0 . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
|
||||
|
||||
|
||||
-- | Replace the @appState@ or construct it based on a filter function
|
||||
@@ -398,14 +400,14 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
|
||||
filterVisible v t e | lInstalled e = True
|
||||
| v
|
||||
, not t
|
||||
, not (elem (lTool e) hiddenTools) = True
|
||||
, lTool e `notElem` hiddenTools = True
|
||||
| not v
|
||||
, t
|
||||
, not (elem Old (lTag e)) = True
|
||||
, Old `notElem` lTag e = True
|
||||
| v
|
||||
, t = True
|
||||
| otherwise = not (elem Old (lTag e)) &&
|
||||
not (elem (lTool e) hiddenTools)
|
||||
| otherwise = (Old `notElem` lTag e) &&
|
||||
(lTool e `notElem` hiddenTools)
|
||||
|
||||
|
||||
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
|
||||
@@ -438,27 +440,42 @@ install' _ (_, ListResult {..}) = do
|
||||
]
|
||||
|
||||
run (do
|
||||
ce <- liftIO $ fmap (either (const Nothing) Just) $
|
||||
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
|
||||
dirs <- lift getDirs
|
||||
case lTool of
|
||||
GHC -> do
|
||||
let vi = getVersionInfo lVer GHC dls
|
||||
liftE $ installGHCBin lVer Nothing False $> vi
|
||||
liftE $ installGHCBin lVer Nothing False $> (vi, dirs, ce)
|
||||
Cabal -> do
|
||||
let vi = getVersionInfo lVer Cabal dls
|
||||
liftE $ installCabalBin lVer Nothing False $> vi
|
||||
liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False $> vi
|
||||
liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce)
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
liftE $ installHLSBin lVer Nothing False $> vi
|
||||
liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)
|
||||
Stack -> do
|
||||
let vi = getVersionInfo lVer Stack dls
|
||||
liftE $ installStackBin lVer Nothing False $> vi
|
||||
liftE $ installStackBin lVer Nothing False $> (vi, dirs, ce)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
VRight (vi, Dirs{..}, Just ce) -> do
|
||||
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
|
||||
case lTool of
|
||||
GHCup -> do
|
||||
up <- liftIO $ fmap (either (const Nothing) Just)
|
||||
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
|
||||
when ((normalise <$> up) == Just (normalise ce)) $
|
||||
-- TODO: track cli arguments of previous invocation
|
||||
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 ()
|
||||
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
|
||||
VLeft (V NoUpdate) -> pure $ Right ()
|
||||
@@ -476,9 +493,9 @@ set' _ (_, ListResult {..}) = do
|
||||
|
||||
run (do
|
||||
case lTool of
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
|
||||
Cabal -> liftE $ setCabal lVer $> ()
|
||||
HLS -> liftE $ setHLS lVer $> ()
|
||||
HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
|
||||
Stack -> liftE $ setStack lVer $> ()
|
||||
GHCup -> pure ()
|
||||
)
|
||||
@@ -507,7 +524,7 @@ del' _ (_, ListResult {..}) = do
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
logInfo msg
|
||||
pure $ Right ()
|
||||
VLeft e -> pure $ Left (prettyShow e)
|
||||
@@ -542,17 +559,7 @@ settings' = unsafePerformIO $ do
|
||||
, fileOutter = \_ -> pure ()
|
||||
, fancyColors = True
|
||||
}
|
||||
newIORef $ AppState (Settings { cache = True
|
||||
, noVerify = False
|
||||
, keepDirs = Never
|
||||
, downloader = Curl
|
||||
, verbose = False
|
||||
, urlSource = GHCupURL
|
||||
, noNetwork = False
|
||||
, gpgSetting = GPGNone
|
||||
, noColor = False
|
||||
, ..
|
||||
})
|
||||
newIORef $ AppState defaultSettings
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
(GHCupInfo mempty mempty mempty)
|
||||
@@ -594,8 +601,7 @@ getGHCupInfo = do
|
||||
r <-
|
||||
flip runReaderT settings
|
||||
. runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloadsF
|
||||
$ liftE getDownloadsF
|
||||
|
||||
case r of
|
||||
VRight a -> pure $ Right a
|
||||
@@ -612,4 +618,3 @@ getAppData mgi = runExceptT $ do
|
||||
flip runReaderT settings $ do
|
||||
lV <- listVersions Nothing Nothing
|
||||
pure $ BrickData (reverse lV)
|
||||
|
||||
|
||||
331
app/ghcup/GHCup/OptParse.hs
Normal file
331
app/ghcup/GHCup/OptParse.hs
Normal file
@@ -0,0 +1,331 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
|
||||
module GHCup.OptParse (
|
||||
module GHCup.OptParse.Common
|
||||
, module GHCup.OptParse.Install
|
||||
, module GHCup.OptParse.Set
|
||||
, module GHCup.OptParse.UnSet
|
||||
, module GHCup.OptParse.Rm
|
||||
, module GHCup.OptParse.Compile
|
||||
, module GHCup.OptParse.Config
|
||||
, module GHCup.OptParse.Whereis
|
||||
, module GHCup.OptParse.List
|
||||
#ifndef DISABLE_UPGRADE
|
||||
, module GHCup.OptParse.Upgrade
|
||||
#endif
|
||||
, module GHCup.OptParse.ChangeLog
|
||||
, module GHCup.OptParse.Prefetch
|
||||
, module GHCup.OptParse.GC
|
||||
, module GHCup.OptParse.DInfo
|
||||
, module GHCup.OptParse.Nuke
|
||||
, module GHCup.OptParse.ToolRequirements
|
||||
, module GHCup.OptParse.Run
|
||||
, module GHCup.OptParse
|
||||
) where
|
||||
|
||||
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.OptParse.Install
|
||||
import GHCup.OptParse.Set
|
||||
import GHCup.OptParse.UnSet
|
||||
import GHCup.OptParse.Rm
|
||||
import GHCup.OptParse.Run
|
||||
import GHCup.OptParse.Compile
|
||||
import GHCup.OptParse.Config
|
||||
import GHCup.OptParse.Whereis
|
||||
import GHCup.OptParse.List
|
||||
#ifndef DISABLE_UPGRADE
|
||||
import GHCup.OptParse.Upgrade
|
||||
#endif
|
||||
import GHCup.OptParse.ChangeLog
|
||||
import GHCup.OptParse.Prefetch
|
||||
import GHCup.OptParse.GC
|
||||
import GHCup.OptParse.DInfo
|
||||
import GHCup.OptParse.ToolRequirements
|
||||
import GHCup.OptParse.Nuke
|
||||
|
||||
import GHCup.Types
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
|
||||
|
||||
|
||||
data Options = Options
|
||||
{
|
||||
-- global options
|
||||
optVerbose :: Maybe Bool
|
||||
, optCache :: Maybe Bool
|
||||
, optMetaCache :: Maybe Integer
|
||||
, optUrlSource :: Maybe URI
|
||||
, optNoVerify :: Maybe Bool
|
||||
, optKeepDirs :: Maybe KeepDirs
|
||||
, optsDownloader :: Maybe Downloader
|
||||
, optNoNetwork :: Maybe Bool
|
||||
, optGpg :: Maybe GPGSetting
|
||||
-- commands
|
||||
, optCommand :: Command
|
||||
}
|
||||
|
||||
data Command
|
||||
= Install (Either InstallCommand InstallOptions)
|
||||
| InstallCabalLegacy InstallOptions
|
||||
| Set (Either SetCommand SetOptions)
|
||||
| UnSet UnsetCommand
|
||||
| List ListOptions
|
||||
| Rm (Either RmCommand RmOptions)
|
||||
| DInfo
|
||||
| Compile CompileCommand
|
||||
| Config ConfigCommand
|
||||
| Whereis WhereisOptions WhereisCommand
|
||||
#ifndef DISABLE_UPGRADE
|
||||
| Upgrade UpgradeOpts Bool
|
||||
#endif
|
||||
| ToolRequirements ToolReqOpts
|
||||
| ChangeLog ChangeLogOptions
|
||||
| Nuke
|
||||
#if defined(BRICK)
|
||||
| Interactive
|
||||
#endif
|
||||
| Prefetch PrefetchCommand
|
||||
| GC GCOptions
|
||||
| Run RunOptions
|
||||
|
||||
|
||||
|
||||
opts :: Parser Options
|
||||
opts =
|
||||
Options
|
||||
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
|
||||
<*> invertableSwitch "cache" (Just '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
|
||||
(option
|
||||
(eitherReader parseUri)
|
||||
( short 's'
|
||||
<> long "url-source"
|
||||
<> metavar "URL"
|
||||
<> help "Alternative ghcup download info url"
|
||||
<> internal
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
|
||||
<*> optional (option
|
||||
(eitherReader keepOnParser)
|
||||
( long "keep"
|
||||
<> metavar "<always|errors|never>"
|
||||
<> help
|
||||
"Keep build directories? (default: errors)"
|
||||
<> hidden
|
||||
<> completer (listCompleter ["always", "errors", "never"])
|
||||
))
|
||||
<*> optional (option
|
||||
(eitherReader downloaderParser)
|
||||
( long "downloader"
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
<> metavar "<internal|curl|wget>"
|
||||
<> help
|
||||
"Downloader to use (default: internal)"
|
||||
<> completer (listCompleter ["internal", "curl", "wget"])
|
||||
#else
|
||||
<> metavar "<curl|wget>"
|
||||
<> help
|
||||
"Downloader to use (default: curl)"
|
||||
<> completer (listCompleter ["curl", "wget"])
|
||||
#endif
|
||||
<> hidden
|
||||
))
|
||||
<*> invertableSwitch "offline" (Just 'o') False (help "Don't do any network calls, trying cached assets and failing if missing.")
|
||||
<*> optional (option
|
||||
(eitherReader gpgParser)
|
||||
( long "gpg"
|
||||
<> metavar "<strict|lax|none>"
|
||||
<> help
|
||||
"GPG verification (default: none)"
|
||||
<> completer (listCompleter ["strict", "lax", "none"])
|
||||
))
|
||||
<*> com
|
||||
where
|
||||
parseUri s' =
|
||||
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
|
||||
|
||||
|
||||
com :: Parser Command
|
||||
com =
|
||||
subparser
|
||||
#if defined(BRICK)
|
||||
( command
|
||||
"tui"
|
||||
( (\_ -> Interactive)
|
||||
<$> info
|
||||
helper
|
||||
( progDesc "Start the interactive GHCup UI"
|
||||
)
|
||||
)
|
||||
<> command
|
||||
#else
|
||||
( command
|
||||
#endif
|
||||
"install"
|
||||
( Install
|
||||
<$> info
|
||||
(installParser <**> helper)
|
||||
( progDesc "Install or update GHC/cabal/HLS/stack"
|
||||
<> footerDoc (Just $ text installToolFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"set"
|
||||
(info
|
||||
(Set <$> setParser <**> helper)
|
||||
( progDesc "Set currently active GHC/cabal version"
|
||||
<> footerDoc (Just $ text setFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"unset"
|
||||
(info
|
||||
(UnSet <$> unsetParser <**> helper)
|
||||
( progDesc "Unset currently active GHC/cabal version"
|
||||
<> footerDoc (Just $ text unsetFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"rm"
|
||||
(info
|
||||
(Rm <$> rmParser <**> helper)
|
||||
( progDesc "Remove a GHC/cabal/HLS/stack version"
|
||||
<> footerDoc (Just $ text rmFooter)
|
||||
)
|
||||
)
|
||||
|
||||
<> command
|
||||
"list"
|
||||
(info (List <$> listOpts <**> helper)
|
||||
(progDesc "Show available GHCs and other tools")
|
||||
)
|
||||
#ifndef DISABLE_UPGRADE
|
||||
<> command
|
||||
"upgrade"
|
||||
(info
|
||||
( (Upgrade <$> upgradeOptsP <*> switch
|
||||
(short 'f' <> long "force" <> help "Force update")
|
||||
)
|
||||
<**> helper
|
||||
)
|
||||
(progDesc "Upgrade ghcup")
|
||||
)
|
||||
#endif
|
||||
<> command
|
||||
"compile"
|
||||
( Compile
|
||||
<$> info (compileP <**> helper)
|
||||
(progDesc "Compile a tool from source")
|
||||
)
|
||||
<> command
|
||||
"whereis"
|
||||
(info
|
||||
( (Whereis
|
||||
<$> (WhereisOptions <$> switch (short 'd' <> long "directory" <> help "return directory of the binary instead of the binary location"))
|
||||
<*> whereisP
|
||||
) <**> helper
|
||||
)
|
||||
(progDesc "Find a tools location"
|
||||
<> footerDoc ( Just $ text whereisFooter ))
|
||||
)
|
||||
<> command
|
||||
"prefetch"
|
||||
(info
|
||||
( (Prefetch
|
||||
<$> prefetchP
|
||||
) <**> helper
|
||||
)
|
||||
(progDesc "Prefetch assets"
|
||||
<> footerDoc ( Just $ text prefetchFooter ))
|
||||
)
|
||||
<> command
|
||||
"gc"
|
||||
(info
|
||||
( (GC
|
||||
<$> gcP
|
||||
) <**> helper
|
||||
)
|
||||
(progDesc "Garbage collection"
|
||||
<> 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:"
|
||||
)
|
||||
<|> subparser
|
||||
( command
|
||||
"debug-info"
|
||||
((\_ -> DInfo) <$> info helper (progDesc "Show debug info"))
|
||||
<> command
|
||||
"tool-requirements"
|
||||
( ToolRequirements
|
||||
<$> info (toolReqP <**> helper)
|
||||
(progDesc "Show the requirements for ghc/cabal")
|
||||
)
|
||||
<> command
|
||||
"changelog"
|
||||
(info
|
||||
(fmap ChangeLog changelogP <**> helper)
|
||||
( progDesc "Find/show changelog"
|
||||
<> footerDoc (Just $ text changeLogFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"config"
|
||||
( Config
|
||||
<$> info (configP <**> helper)
|
||||
(progDesc "Show or set config" <> footerDoc (Just $ text configFooter))
|
||||
)
|
||||
<> commandGroup "Other commands:"
|
||||
<> hidden
|
||||
)
|
||||
<|> subparser
|
||||
( command
|
||||
"install-cabal"
|
||||
(info
|
||||
((InstallCabalLegacy <$> installOpts (Just Cabal)) <**> helper)
|
||||
( progDesc "Install or update cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
)
|
||||
)
|
||||
<> internal
|
||||
)
|
||||
<|> subparser
|
||||
(command
|
||||
"nuke"
|
||||
(info (pure Nuke <**> helper)
|
||||
(progDesc "Completely remove ghcup from your system"))
|
||||
<> commandGroup "Nuclear Commands:"
|
||||
<> hidden
|
||||
)
|
||||
151
app/ghcup/GHCup/OptParse/ChangeLog.hs
Normal file
151
app/ghcup/GHCup/OptParse/ChangeLog.hs
Normal file
@@ -0,0 +1,151 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.ChangeLog where
|
||||
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import Data.Versions
|
||||
import URI.ByteString (serializeURIRef')
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.File (exec)
|
||||
import Data.Char (toLower)
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data ChangeLogOptions = ChangeLogOptions
|
||||
{ clOpen :: Bool
|
||||
, clTool :: Maybe Tool
|
||||
, clToolVer :: Maybe ToolVersion
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
changelogP :: Parser ChangeLogOptions
|
||||
changelogP =
|
||||
(\x y -> ChangeLogOptions x y)
|
||||
<$> switch (short 'o' <> long "open" <> help "xdg-open the changelog url")
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader
|
||||
(\s' -> case fmap toLower s' of
|
||||
"ghc" -> Right GHC
|
||||
"cabal" -> Right Cabal
|
||||
"ghcup" -> Right GHCup
|
||||
"stack" -> Right Stack
|
||||
e -> Left e
|
||||
)
|
||||
)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
|
||||
"Open changelog for given tool (default: ghc)"
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> optional (toolVersionArgument Nothing Nothing)
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
changeLogFooter :: String
|
||||
changeLogFooter = [s|Discussion:
|
||||
By default returns the URI of the ChangeLog of the latest GHC release.
|
||||
Pass '-o' to automatically open via xdg-open.|]
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
changelog :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> ChangeLogOptions
|
||||
-> (forall a . ReaderT AppState m a -> m a)
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
changelog ChangeLogOptions{..} runAppState runLogger = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||
let tool = fromMaybe GHC clTool
|
||||
ver' = maybe
|
||||
(Right Latest)
|
||||
(\case
|
||||
ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
|
||||
ToolTag t -> Right t
|
||||
)
|
||||
clToolVer
|
||||
muri = getChangeLog dls tool ver'
|
||||
case muri of
|
||||
Nothing -> do
|
||||
runLogger
|
||||
(logWarn $
|
||||
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
|
||||
)
|
||||
pure ExitSuccess
|
||||
Just uri -> do
|
||||
pfreq <- runAppState getPlatformReq
|
||||
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
|
||||
cmd = case _rPlatform pfreq of
|
||||
Darwin -> "open"
|
||||
Linux _ -> "xdg-open"
|
||||
FreeBSD -> "xdg-open"
|
||||
Windows -> "start"
|
||||
|
||||
if clOpen
|
||||
then do
|
||||
runAppState $
|
||||
exec cmd
|
||||
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
|
||||
Nothing
|
||||
Nothing
|
||||
>>= \case
|
||||
Right _ -> pure ExitSuccess
|
||||
Left e -> logError (T.pack $ prettyShow e)
|
||||
>> pure (ExitFailure 13)
|
||||
else liftIO $ putStrLn uri' >> pure ExitSuccess
|
||||
766
app/ghcup/GHCup/OptParse/Common.hs
Normal file
766
app/ghcup/GHCup/OptParse/Common.hs
Normal file
@@ -0,0 +1,766 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
|
||||
module GHCup.OptParse.Common where
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Platform
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
import Control.DeepSeq
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
import qualified Data.Aeson.Key as KM
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
#else
|
||||
import qualified Data.HashMap.Strict as KM
|
||||
#endif
|
||||
import Data.ByteString.Lazy ( ByteString )
|
||||
import Data.Bifunctor
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Void
|
||||
import qualified Data.Vector as V
|
||||
import GHC.IO.Exception
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import Safe
|
||||
import System.Directory
|
||||
import System.Process ( readProcess )
|
||||
import System.FilePath
|
||||
import Text.HTML.TagSoup hiding ( Tag )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified System.FilePath.Posix as FP
|
||||
import GHCup.Version
|
||||
import Control.Exception (evaluate)
|
||||
|
||||
|
||||
-------------
|
||||
--[ Types ]--
|
||||
-------------
|
||||
|
||||
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
|
||||
| ToolTag Tag
|
||||
|
||||
-- a superset of ToolVersion
|
||||
data SetToolVersion = SetToolVersion GHCTargetVersion
|
||||
| SetToolTag Tag
|
||||
| SetRecommended
|
||||
| SetNext
|
||||
|
||||
prettyToolVer :: ToolVersion -> String
|
||||
prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
|
||||
prettyToolVer (ToolTag t) = show t
|
||||
|
||||
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
|
||||
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
|
||||
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
|
||||
toSetToolVer Nothing = SetRecommended
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Parser ]--
|
||||
--------------
|
||||
|
||||
|
||||
-- | same as toolVersionParser, except as an argument.
|
||||
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionArgument criteria tool =
|
||||
argument (eitherReader toolVersionEither)
|
||||
(metavar (mv tool)
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
mv (Just GHC) = "GHC_VERSION|TAG"
|
||||
mv (Just HLS) = "HLS_VERSION|TAG"
|
||||
mv _ = "VERSION|TAG"
|
||||
|
||||
|
||||
versionParser :: Parser GHCTargetVersion
|
||||
versionParser = option
|
||||
(eitherReader tVersionEither)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
|
||||
)
|
||||
|
||||
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
|
||||
versionParser' criteria tool = argument
|
||||
(eitherReader (first show . version . T.pack))
|
||||
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
|
||||
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
|
||||
|
||||
|
||||
-- https://github.com/pcapriotti/optparse-applicative/issues/148
|
||||
|
||||
-- | A switch that can be enabled using --foo and disabled using --no-foo.
|
||||
--
|
||||
-- The option modifier is applied to only the option that is *not* enabled
|
||||
-- by default. For example:
|
||||
--
|
||||
-- > invertableSwitch "recursive" True (help "do not recurse into directories")
|
||||
--
|
||||
-- This example makes --recursive enabled by default, so
|
||||
-- the help is shown only for --no-recursive.
|
||||
invertableSwitch
|
||||
:: String -- ^ long option
|
||||
-> Maybe Char -- ^ short option for the non-default option
|
||||
-> Bool -- ^ is switch enabled by default?
|
||||
-> Mod FlagFields Bool -- ^ option modifier
|
||||
-> Parser (Maybe Bool)
|
||||
invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shortopt defv
|
||||
(if defv then mempty else optmod)
|
||||
(if defv then optmod else mempty)
|
||||
|
||||
-- | Allows providing option modifiers for both --foo and --no-foo.
|
||||
invertableSwitch'
|
||||
:: String -- ^ long option (eg "foo")
|
||||
-> Maybe Char -- ^ short option for the non-default option
|
||||
-> Bool -- ^ is switch enabled by default?
|
||||
-> Mod FlagFields Bool -- ^ option modifier for --foo
|
||||
-> Mod FlagFields Bool -- ^ option modifier for --no-foo
|
||||
-> Parser (Maybe Bool)
|
||||
invertableSwitch' longopt shortopt defv enmod dismod = optional
|
||||
( flag' True ( enmod <> long longopt <> if defv then mempty else maybe mempty short shortopt)
|
||||
<|> flag' False (dismod <> long nolongopt <> if defv then maybe mempty short shortopt else mempty)
|
||||
)
|
||||
where
|
||||
nolongopt = "no-" ++ longopt
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
--[ Either Parser ]--
|
||||
---------------------
|
||||
|
||||
|
||||
platformParser :: String -> Either String PlatformRequest
|
||||
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
Right r -> pure r
|
||||
Left e -> Left $ errorBundlePretty e
|
||||
where
|
||||
archP :: MP.Parsec Void Text Architecture
|
||||
archP = MP.try (MP.chunk "x86_64" $> A_64) <|> (MP.chunk "i386" $> A_32)
|
||||
platformP :: MP.Parsec Void Text PlatformRequest
|
||||
platformP = choice'
|
||||
[ (`PlatformRequest` FreeBSD)
|
||||
<$> (archP <* MP.chunk "-")
|
||||
<*> ( MP.chunk "portbld"
|
||||
*> ( MP.try (Just <$> verP (MP.chunk "-freebsd" <* MP.eof))
|
||||
<|> pure Nothing
|
||||
)
|
||||
<* MP.chunk "-freebsd"
|
||||
)
|
||||
, (`PlatformRequest` Darwin)
|
||||
<$> (archP <* MP.chunk "-")
|
||||
<*> ( MP.chunk "apple"
|
||||
*> ( MP.try (Just <$> verP (MP.chunk "-darwin" <* MP.eof))
|
||||
<|> pure Nothing
|
||||
)
|
||||
<* MP.chunk "-darwin"
|
||||
)
|
||||
, (\a d mv -> PlatformRequest a (Linux d) mv)
|
||||
<$> (archP <* MP.chunk "-")
|
||||
<*> distroP
|
||||
<*> ((MP.try (Just <$> verP (MP.chunk "-linux" <* MP.eof)) <|> pure Nothing
|
||||
)
|
||||
<* MP.chunk "-linux"
|
||||
)
|
||||
]
|
||||
distroP :: MP.Parsec Void Text LinuxDistro
|
||||
distroP = choice'
|
||||
[ MP.chunk "debian" $> Debian
|
||||
, MP.chunk "deb" $> Debian
|
||||
, MP.chunk "ubuntu" $> Ubuntu
|
||||
, MP.chunk "mint" $> Mint
|
||||
, MP.chunk "fedora" $> Fedora
|
||||
, MP.chunk "centos" $> CentOS
|
||||
, MP.chunk "redhat" $> RedHat
|
||||
, MP.chunk "alpine" $> Alpine
|
||||
, MP.chunk "gentoo" $> Gentoo
|
||||
, MP.chunk "exherbo" $> Exherbo
|
||||
, MP.chunk "unknown" $> UnknownLinux
|
||||
]
|
||||
|
||||
|
||||
uriParser :: String -> Either String URI
|
||||
uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
|
||||
|
||||
|
||||
absolutePathParser :: FilePath -> Either String FilePath
|
||||
absolutePathParser f = case isValid f && isAbsolute f of
|
||||
True -> Right $ normalise f
|
||||
False -> Left "Please enter a valid absolute filepath."
|
||||
|
||||
isolateParser :: FilePath -> Either String FilePath
|
||||
isolateParser f = case isValid f of
|
||||
True -> Right $ normalise f
|
||||
False -> Left "Please enter a valid filepath for isolate dir."
|
||||
|
||||
toolVersionEither :: String -> Either String ToolVersion
|
||||
toolVersionEither s' =
|
||||
second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
|
||||
|
||||
tagEither :: String -> Either String Tag
|
||||
tagEither s' = case fmap toLower s' of
|
||||
"recommended" -> Right Recommended
|
||||
"latest" -> Right Latest
|
||||
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
||||
Right x -> Right (Base x)
|
||||
Left _ -> Left $ "Invalid PVP version for base " <> ver'
|
||||
other -> Left $ "Unknown tag " <> other
|
||||
|
||||
|
||||
tVersionEither :: String -> Either String GHCTargetVersion
|
||||
tVersionEither =
|
||||
first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack
|
||||
|
||||
|
||||
toolParser :: String -> Either String Tool
|
||||
toolParser s' | t == T.pack "ghc" = Right GHC
|
||||
| t == T.pack "cabal" = Right Cabal
|
||||
| t == T.pack "hls" = Right HLS
|
||||
| t == T.pack "stack" = Right Stack
|
||||
| otherwise = Left ("Unknown tool: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
criteriaParser :: String -> Either String ListCriteria
|
||||
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
|
||||
| t == T.pack "set" = Right ListSet
|
||||
| t == T.pack "available" = Right ListAvailable
|
||||
| otherwise = Left ("Unknown criteria: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
|
||||
keepOnParser :: String -> Either String KeepDirs
|
||||
keepOnParser s' | t == T.pack "always" = Right Always
|
||||
| t == T.pack "errors" = Right Errors
|
||||
| t == T.pack "never" = Right Never
|
||||
| otherwise = Left ("Unknown keep value: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
downloaderParser :: String -> Either String Downloader
|
||||
downloaderParser s' | t == T.pack "curl" = Right Curl
|
||||
| t == T.pack "wget" = Right Wget
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
| t == T.pack "internal" = Right Internal
|
||||
#endif
|
||||
| otherwise = Left ("Unknown downloader value: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
gpgParser :: String -> Either String GPGSetting
|
||||
gpgParser s' | t == T.pack "strict" = Right GPGStrict
|
||||
| t == T.pack "lax" = Right GPGLax
|
||||
| t == T.pack "none" = Right GPGNone
|
||||
| otherwise = Left ("Unknown gpg setting value: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Completers ]--
|
||||
------------------
|
||||
|
||||
|
||||
toolCompleter :: Completer
|
||||
toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
|
||||
|
||||
gitFileUri :: [String] -> Completer
|
||||
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
|
||||
|
||||
fileUri :: Completer
|
||||
fileUri = mkCompleter $ fileUri' []
|
||||
|
||||
fileUri' :: [String] -> String -> IO [String]
|
||||
fileUri' add = \case
|
||||
"" -> do
|
||||
pwd <- getCurrentDirectory
|
||||
pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
|
||||
xs
|
||||
| "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
|
||||
case stripPrefix "file://" xs of
|
||||
Nothing -> pure []
|
||||
Just r -> do
|
||||
pwd <- getCurrentDirectory
|
||||
dirs <- compgen "directory" r ["-S", "/"]
|
||||
files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
|
||||
pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
|
||||
| xs `isPrefixOf` "file:///" -> pure ["file:///"]
|
||||
| xs `isPrefixOf` "https://" -> pure ["https://"]
|
||||
| xs `isPrefixOf` "http://" -> pure ["http://"]
|
||||
| otherwise -> pure []
|
||||
where
|
||||
compgen :: String -> String -> [String] -> IO [String]
|
||||
compgen action' r opts = do
|
||||
let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
|
||||
result <- tryIO $ readProcess "bash" ["-c", cmd] ""
|
||||
return . lines . either (const []) id $ result
|
||||
|
||||
-- | Strongly quote the string we pass to compgen.
|
||||
--
|
||||
-- We need to do this so bash doesn't expand out any ~ or other
|
||||
-- chars we want to complete on, or emit an end of line error
|
||||
-- when seeking the close to the quote.
|
||||
--
|
||||
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
|
||||
requote :: String -> String
|
||||
requote s =
|
||||
let
|
||||
-- Bash doesn't appear to allow "mixed" escaping
|
||||
-- in bash completions. So we don't have to really
|
||||
-- worry about people swapping between strong and
|
||||
-- weak quotes.
|
||||
unescaped =
|
||||
case s of
|
||||
-- It's already strongly quoted, so we
|
||||
-- can use it mostly as is, but we must
|
||||
-- ensure it's closed off at the end and
|
||||
-- there's no single quotes in the
|
||||
-- middle which might confuse bash.
|
||||
('\'': rs) -> unescapeN rs
|
||||
|
||||
-- We're weakly quoted.
|
||||
('"': rs) -> unescapeD rs
|
||||
|
||||
-- We're not quoted at all.
|
||||
-- We need to unescape some characters like
|
||||
-- spaces and quotation marks.
|
||||
elsewise -> unescapeU elsewise
|
||||
in
|
||||
strong unescaped
|
||||
|
||||
where
|
||||
strong ss = '\'' : foldr go "'" ss
|
||||
where
|
||||
-- If there's a single quote inside the
|
||||
-- command: exit from the strong quote and
|
||||
-- emit it the quote escaped, then resume.
|
||||
go '\'' t = "'\\''" ++ t
|
||||
go h t = h : t
|
||||
|
||||
-- Unescape a strongly quoted string
|
||||
-- We have two recursive functions, as we
|
||||
-- can enter and exit the strong escaping.
|
||||
unescapeN = goX
|
||||
where
|
||||
goX ('\'' : xs) = goN xs
|
||||
goX (x : xs) = x : goX xs
|
||||
goX [] = []
|
||||
|
||||
goN ('\\' : '\'' : xs) = '\'' : goN xs
|
||||
goN ('\'' : xs) = goX xs
|
||||
goN (x : xs) = x : goN xs
|
||||
goN [] = []
|
||||
|
||||
-- Unescape an unquoted string
|
||||
unescapeU = goX
|
||||
where
|
||||
goX [] = []
|
||||
goX ('\\' : x : xs) = x : goX xs
|
||||
goX (x : xs) = x : goX xs
|
||||
|
||||
-- Unescape a weakly quoted string
|
||||
unescapeD = goX
|
||||
where
|
||||
-- Reached an escape character
|
||||
goX ('\\' : x : xs)
|
||||
-- If it's true escapable, strip the
|
||||
-- slashes, as we're going to strong
|
||||
-- escape instead.
|
||||
| x `elem` ("$`\"\\\n" :: String) = x : goX xs
|
||||
| otherwise = '\\' : x : goX xs
|
||||
-- We've ended quoted section, so we
|
||||
-- don't recurse on goX, it's done.
|
||||
goX ('"' : xs)
|
||||
= xs
|
||||
-- Not done, but not a special character
|
||||
-- just continue the fold.
|
||||
goX (x : xs)
|
||||
= x : goX xs
|
||||
goX []
|
||||
= []
|
||||
|
||||
|
||||
tagCompleter :: Tool -> [String] -> Completer
|
||||
tagCompleter tool add = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, consoleOutter = mempty
|
||||
, fileOutter = mempty
|
||||
, fancyColors = False
|
||||
}
|
||||
let appState = LeanAppState
|
||||
(defaultSettings { noNetwork = True })
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
|
||||
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
|
||||
case mGhcUpInfo of
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (/= Old)
|
||||
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
|
||||
|
||||
|
||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
let loggerConfig = LoggerConfig
|
||||
{ lcPrintDebug = False
|
||||
, consoleOutter = mempty
|
||||
, fileOutter = mempty
|
||||
, fancyColors = False
|
||||
}
|
||||
let settings = defaultSettings { noNetwork = True }
|
||||
let leanAppState = LeanAppState
|
||||
settings
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
loggerConfig
|
||||
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
|
||||
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
|
||||
forFold mpFreq $ \pfreq -> do
|
||||
forFold mGhcUpInfo $ \ghcupInfo -> do
|
||||
let appState = AppState
|
||||
settings
|
||||
dirs'
|
||||
defaultKeyBindings
|
||||
ghcupInfo
|
||||
pfreq
|
||||
loggerConfig
|
||||
|
||||
runEnv = flip runReaderT appState
|
||||
|
||||
installedVersions <- runEnv $ listVersions (Just tool) criteria
|
||||
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
||||
|
||||
|
||||
toolDlCompleter :: Tool -> Completer
|
||||
toolDlCompleter tool = mkCompleter $ \case
|
||||
"" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
|
||||
word
|
||||
| "file://" `isPrefixOf` word -> fileUri' [] word
|
||||
-- downloads.haskell.org
|
||||
| "https://downloads.haskell.org/" `isPrefixOf` word ->
|
||||
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
|
||||
|
||||
-- github releases
|
||||
| "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
|
||||
fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "haskell" "haskell-language-server"
|
||||
| "https://github.com/commercialhaskell/stack/releases/download/" == word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
|
||||
fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "commercialhaskell" "stack"
|
||||
|
||||
-- github release assets
|
||||
| "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 7 && last word == '/') || length xs == 8
|
||||
, let rel = xs !! 6
|
||||
, length rel > 1 -> do
|
||||
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "haskell" "haskell-language-server" (init rel)
|
||||
| "https://github.com/commercialhaskell/stack/releases/download/" `isPrefixOf` word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 7 && last word == '/') || length xs == 8
|
||||
, let rel = xs !! 6
|
||||
, length rel > 1 -> do
|
||||
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "commercialhaskell" "stack" (init rel)
|
||||
|
||||
-- github
|
||||
| "https://github.com/c" `isPrefixOf` word -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
|
||||
| "https://github.com/h" `isPrefixOf` word -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
|
||||
| "https://g" `isPrefixOf` word
|
||||
, tool == Stack -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
|
||||
| "https://g" `isPrefixOf` word
|
||||
, tool == HLS -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
|
||||
|
||||
| "https://d" `isPrefixOf` word -> pure $ filter ("https://downloads.haskell.org/" `isPrefixOf`) $ initUrl tool
|
||||
|
||||
| "h" `isPrefixOf` word -> pure $ initUrl tool
|
||||
|
||||
| word `isPrefixOf` "file:///" -> pure ["file:///"]
|
||||
| word `isPrefixOf` "https://" -> pure ["https://"]
|
||||
| word `isPrefixOf` "http://" -> pure ["http://"]
|
||||
|
||||
| otherwise -> pure []
|
||||
where
|
||||
initUrl :: Tool -> [String]
|
||||
initUrl GHC = [ "https://downloads.haskell.org/~ghc/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/"
|
||||
]
|
||||
initUrl Cabal = [ "https://downloads.haskell.org/~cabal/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/"
|
||||
]
|
||||
initUrl GHCup = [ "https://downloads.haskell.org/~ghcup/" ]
|
||||
initUrl HLS = [ "https://github.com/haskell/haskell-language-server/releases/download/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/haskell-language-server/"
|
||||
]
|
||||
initUrl Stack = [ "https://github.com/commercialhaskell/stack/releases/download/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/stack/"
|
||||
]
|
||||
|
||||
completePrefix :: String -- ^ url, e.g. 'https://github.com/haskell/haskell-languag'
|
||||
-> String -- ^ match, e.g. 'haskell-language-server'
|
||||
-> String -- ^ result, e.g. 'https://github.com/haskell/haskell-language-server'
|
||||
completePrefix url match =
|
||||
let base = FP.takeDirectory url
|
||||
fn = FP.takeFileName url
|
||||
in if fn `isPrefixOf` match then base <> "/" <> match else url
|
||||
|
||||
prefixMatch :: String -> [String] -> [String]
|
||||
prefixMatch pref = filter (pref `isPrefixOf`)
|
||||
|
||||
fromHRef :: String -> IO [String]
|
||||
fromHRef url = withCurl (FP.takeDirectory url) 2_000_000 $ \stdout ->
|
||||
pure
|
||||
. fmap (T.unpack . decUTF8Safe' . fromAttrib "href")
|
||||
. filter isTagOpen
|
||||
. filter (~== ("<a href>" :: String))
|
||||
. parseTags
|
||||
$ stdout
|
||||
|
||||
withCurl :: String -- ^ url
|
||||
-> Int -- ^ delay
|
||||
-> (ByteString -> IO [String]) -- ^ callback
|
||||
-> IO [String]
|
||||
withCurl url delay cb = do
|
||||
let limit = threadDelay delay
|
||||
race limit (executeOut "curl" ["-fL", url] Nothing) >>= \case
|
||||
Right (CapturedProcess {_exitCode, _stdOut}) -> do
|
||||
case _exitCode of
|
||||
ExitSuccess ->
|
||||
(try @_ @SomeException . cb $ _stdOut) >>= \case
|
||||
Left _ -> pure []
|
||||
Right r' -> do
|
||||
r <- try @_ @SomeException
|
||||
. evaluate
|
||||
. force
|
||||
$ r'
|
||||
either (\_ -> pure []) pure r
|
||||
ExitFailure _ -> pure []
|
||||
Left _ -> pure []
|
||||
|
||||
getGithubReleases :: String
|
||||
-> String
|
||||
-> IO [String]
|
||||
getGithubReleases owner repo = withCurl url 3_000_000 $ \stdout -> do
|
||||
Just xs <- pure $ decode' @Array stdout
|
||||
fmap V.toList $ forM xs $ \x -> do
|
||||
(Object r) <- pure x
|
||||
Just (String name) <- pure $ KM.lookup (mkval "tag_name") r
|
||||
pure $ T.unpack name
|
||||
where
|
||||
url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases"
|
||||
|
||||
getGithubAssets :: String
|
||||
-> String
|
||||
-> String
|
||||
-> IO [String]
|
||||
getGithubAssets owner repo tag = withCurl url 3_000_000 $ \stdout -> do
|
||||
Just xs <- pure $ decode' @Object stdout
|
||||
Just (Array assets) <- pure $ KM.lookup (mkval "assets") xs
|
||||
as <- fmap V.toList $ forM assets $ \val -> do
|
||||
(Object asset) <- pure val
|
||||
Just (String name) <- pure $ KM.lookup (mkval "name") asset
|
||||
pure $ T.unpack name
|
||||
pure as
|
||||
where
|
||||
url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases/tags/" <> tag
|
||||
|
||||
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
mkval = KM.fromString
|
||||
#else
|
||||
mkval = id
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
--[ Utilities ]--
|
||||
-----------------
|
||||
|
||||
|
||||
fromVersion :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Maybe ToolVersion
|
||||
-> Tool
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion tv = fromVersion' (toSetToolVer tv)
|
||||
|
||||
fromVersion' :: ( HasLog env
|
||||
, MonadFail m
|
||||
, MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> SetToolVersion
|
||||
-> Tool
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] m (GHCTargetVersion, Maybe VersionInfo)
|
||||
fromVersion' SetRecommended tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getRecommended dls tool
|
||||
?? TagNotFound Recommended tool
|
||||
fromVersion' (SetToolVersion v) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion v) tool dls
|
||||
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
|
||||
Left _ -> pure (v, vi)
|
||||
Right pvpIn ->
|
||||
lift (getLatestToolFor tool pvpIn dls) >>= \case
|
||||
Just (pvp_, vi') -> do
|
||||
v' <- lift $ pvpToVersion pvp_ ""
|
||||
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
|
||||
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
|
||||
Nothing -> pure (v, vi)
|
||||
fromVersion' (SetToolTag Latest) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
|
||||
fromVersion' (SetToolTag Recommended) tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
|
||||
fromVersion' (SetToolTag (Base pvp'')) GHC = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
|
||||
fromVersion' SetNext tool = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
next <- case tool of
|
||||
GHC -> do
|
||||
set <- fmap _tvVersion $ ghcSet Nothing !? NoToolVersionSet tool
|
||||
ghcs <- rights <$> lift getInstalledGHCs
|
||||
(headMay
|
||||
. tail
|
||||
. dropWhile (\GHCTargetVersion {..} -> _tvVersion /= set)
|
||||
. cycle
|
||||
. sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
|
||||
. filter (\GHCTargetVersion {..} -> isNothing _tvTarget)
|
||||
$ ghcs) ?? NoToolVersionSet tool
|
||||
Cabal -> do
|
||||
set <- cabalSet !? NoToolVersionSet tool
|
||||
cabals <- rights <$> lift getInstalledCabals
|
||||
(fmap (GHCTargetVersion Nothing)
|
||||
. headMay
|
||||
. tail
|
||||
. dropWhile (/= set)
|
||||
. cycle
|
||||
. sort
|
||||
$ cabals) ?? NoToolVersionSet tool
|
||||
HLS -> do
|
||||
set <- hlsSet !? NoToolVersionSet tool
|
||||
hlses <- rights <$> lift getInstalledHLSs
|
||||
(fmap (GHCTargetVersion Nothing)
|
||||
. headMay
|
||||
. tail
|
||||
. dropWhile (/= set)
|
||||
. cycle
|
||||
. sort
|
||||
$ hlses) ?? NoToolVersionSet tool
|
||||
Stack -> do
|
||||
set <- stackSet !? NoToolVersionSet tool
|
||||
stacks <- rights <$> lift getInstalledStacks
|
||||
(fmap (GHCTargetVersion Nothing)
|
||||
. headMay
|
||||
. tail
|
||||
. dropWhile (/= set)
|
||||
. cycle
|
||||
. sort
|
||||
$ stacks) ?? NoToolVersionSet tool
|
||||
GHCup -> fail "GHCup cannot be set"
|
||||
let vi = getVersionInfo (_tvVersion next) tool dls
|
||||
pure (next, vi)
|
||||
fromVersion' (SetToolTag t') tool =
|
||||
throwE $ TagNotFound t' tool
|
||||
|
||||
|
||||
checkForUpdates :: ( MonadReader env m
|
||||
, HasGHCupInfo env
|
||||
, HasDirs env
|
||||
, HasPlatformReq env
|
||||
, MonadCatch m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> m [(Tool, Version)]
|
||||
checkForUpdates = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||
lInstalled <- listVersions Nothing (Just ListInstalled)
|
||||
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
|
||||
|
||||
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
|
||||
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
|
||||
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
|
||||
|
||||
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
|
||||
forMM (getLatest dls t) $ \(l, _) -> do
|
||||
let mver = latestInstalled t
|
||||
forMM mver $ \ver ->
|
||||
if (l > ver) then pure $ Just (t, l) else pure Nothing
|
||||
|
||||
pure $ catMaybes (ghcup:otherTools)
|
||||
where
|
||||
forMM a f = fmap join $ forM a f
|
||||
560
app/ghcup/GHCup/OptParse/Compile.hs
Normal file
560
app/ghcup/GHCup/OptParse/Compile.hs
Normal file
@@ -0,0 +1,560 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Compile where
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Codec.Archive ( ArchiveResult )
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Bifunctor
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions ( Version, prettyVer, version )
|
||||
import Data.Text ( Text )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import System.FilePath (isPathSeparator)
|
||||
import Text.Read (readEither)
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data CompileCommand = CompileGHC GHCCompileOptions
|
||||
| CompileHLS HLSCompileOptions
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data GHCCompileOptions = GHCCompileOptions
|
||||
{ targetGhc :: Either Version GitBranch
|
||||
, bootstrapGhc :: Either Version FilePath
|
||||
, jobs :: Maybe Int
|
||||
, buildConfig :: Maybe FilePath
|
||||
, patches :: Maybe (Either FilePath [URI])
|
||||
, crossTarget :: Maybe Text
|
||||
, addConfArgs :: [Text]
|
||||
, setCompile :: Bool
|
||||
, ovewrwiteVer :: Maybe Version
|
||||
, buildFlavour :: Maybe String
|
||||
, hadrian :: Bool
|
||||
, isolateDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
data HLSCompileOptions = HLSCompileOptions
|
||||
{ targetHLS :: Either Version GitBranch
|
||||
, jobs :: Maybe Int
|
||||
, setCompile :: Bool
|
||||
, ovewrwiteVer :: Maybe Version
|
||||
, isolateDir :: Maybe FilePath
|
||||
, cabalProject :: Maybe (Either FilePath URI)
|
||||
, cabalProjectLocal :: Maybe URI
|
||||
, patches :: Maybe (Either FilePath [URI])
|
||||
, targetGHCs :: [ToolVersion]
|
||||
, cabalArgs :: [Text]
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
compileP :: Parser CompileCommand
|
||||
compileP = subparser
|
||||
( command
|
||||
"ghc"
|
||||
( CompileGHC
|
||||
<$> info
|
||||
(ghcCompileOpts <**> helper)
|
||||
( progDesc "Compile GHC from source"
|
||||
<> footerDoc (Just $ text compileFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( CompileHLS
|
||||
<$> info
|
||||
(hlsCompileOpts <**> helper)
|
||||
( progDesc "Compile HLS from source"
|
||||
<> footerDoc (Just $ text compileHLSFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
where
|
||||
compileFooter = [s|Discussion:
|
||||
Compiles and installs the specified GHC version into
|
||||
a self-contained "~/.ghcup/ghc/<ghcver>" directory
|
||||
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
|
||||
|
||||
This also allows building a cross-compiler. Consult the documentation
|
||||
first: <https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#configuring-the-build>
|
||||
|
||||
ENV variables:
|
||||
Various toolchain variables will be passed onto the ghc build system,
|
||||
such as: CC, LD, OBJDUMP, NM, AR, RANLIB.
|
||||
|
||||
Examples:
|
||||
# compile from known version
|
||||
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2
|
||||
# compile from git commit/reference
|
||||
ghcup compile ghc -j 4 -g master -b 8.2.2
|
||||
# specify path to bootstrap ghc
|
||||
ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2
|
||||
# build cross compiler
|
||||
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
|
||||
|
||||
compileHLSFooter = [s|Discussion:
|
||||
Compiles and installs the specified HLS version.
|
||||
The last argument is a list of GHC versions to compile for.
|
||||
These need to be available in PATH prior to compilation.
|
||||
|
||||
Examples:
|
||||
# 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 =
|
||||
GHCCompileOptions
|
||||
<$> ((Left <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
str
|
||||
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
||||
"The git commit/branch/ref to build from"
|
||||
) <*>
|
||||
optional (option str (
|
||||
short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
|
||||
<> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
|
||||
))
|
||||
)))
|
||||
<*> option
|
||||
(eitherReader
|
||||
(\x ->
|
||||
(bimap (const "Not a valid version") Left . version . T.pack $ x) <|> (if isPathSeparator (head x) then pure $ Right x else Left "Not an absolute Path")
|
||||
)
|
||||
)
|
||||
( short 'b'
|
||||
<> long "bootstrap-ghc"
|
||||
<> metavar "BOOTSTRAP_GHC"
|
||||
<> help
|
||||
"The GHC version (or full path) to bootstrap with (must be installed)"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader (readEither @Int))
|
||||
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
|
||||
"How many jobs to use for make"
|
||||
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
str
|
||||
(short 'c' <> long "config" <> metavar "CONFIG" <> help
|
||||
"Absolute path to build config file"
|
||||
<> completer (bashCompleter "file")
|
||||
)
|
||||
)
|
||||
<*> (optional
|
||||
(
|
||||
(fmap Right $ many $ option
|
||||
(eitherReader uriParser)
|
||||
(long "patch" <> metavar "PATCH_URI" <> help
|
||||
"URI to a patch (https/http/file)"
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<|>
|
||||
(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)"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
str
|
||||
(short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
|
||||
"Build cross-compiler for this platform"
|
||||
)
|
||||
)
|
||||
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
|
||||
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
str
|
||||
(short 'f' <> long "flavour" <> metavar "BUILD_FLAVOUR" <> help
|
||||
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
|
||||
hlsCompileOpts :: Parser HLSCompileOptions
|
||||
hlsCompileOpts =
|
||||
HLSCompileOptions
|
||||
<$> ((Left <$> option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
str
|
||||
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
||||
"The git commit/branch/ref to build from"
|
||||
) <*>
|
||||
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
|
||||
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
|
||||
))
|
||||
)))
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader (readEither @Int))
|
||||
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
|
||||
"How many jobs to use for make"
|
||||
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
|
||||
)
|
||||
)
|
||||
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader
|
||||
(first (const "Not a valid version") . version . T.pack)
|
||||
)
|
||||
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
|
||||
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
|
||||
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
|
||||
"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."
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader uriParser)
|
||||
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
|
||||
"URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<*> (optional
|
||||
(
|
||||
(fmap Right $ many $ option
|
||||
(eitherReader uriParser)
|
||||
(long "patch" <> metavar "PATCH_URI" <> help
|
||||
"URI to a patch (https/http/file)"
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<|>
|
||||
(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)"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> 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)"))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type GHCEffects = '[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, GHCupSetError
|
||||
, NoDownload
|
||||
, NotFoundInPATH
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, NotInstalled
|
||||
, DirNotEmpty
|
||||
, ArchiveResult
|
||||
, FileDoesNotExistError
|
||||
, HadrianNotFound
|
||||
, InvalidBuildConfig
|
||||
, ProcessError
|
||||
, CopyError
|
||||
, BuildFailed
|
||||
]
|
||||
type HLSEffects = '[ AlreadyInstalled
|
||||
, BuildFailed
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, GHCupSetError
|
||||
, NoDownload
|
||||
, NotFoundInPATH
|
||||
, PatchFailed
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, NotInstalled
|
||||
, DirNotEmpty
|
||||
, ArchiveResult
|
||||
]
|
||||
|
||||
|
||||
|
||||
runCompileGHC :: (MonadUnliftIO m, MonadIO m)
|
||||
=> (ReaderT AppState m (VEither GHCEffects a) -> m (VEither GHCEffects a))
|
||||
-> Excepts GHCEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither GHCEffects a)
|
||||
runCompileGHC runAppState =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@GHCEffects
|
||||
|
||||
runCompileHLS :: (MonadUnliftIO m, MonadIO m)
|
||||
=> (ReaderT AppState m (VEither HLSEffects a) -> m (VEither HLSEffects a))
|
||||
-> Excepts HLSEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither HLSEffects a)
|
||||
runCompileHLS runAppState =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@HLSEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
compile :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> CompileCommand
|
||||
-> Settings
|
||||
-> Dirs
|
||||
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
case compileCommand of
|
||||
(CompileHLS HLSCompileOptions { .. }) -> do
|
||||
runCompileHLS runAppState (do
|
||||
case targetHLS of
|
||||
Left targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
|
||||
targetVer <- liftE $ compileHLS
|
||||
targetHLS
|
||||
ghcs
|
||||
jobs
|
||||
ovewrwiteVer
|
||||
isolateDir
|
||||
cabalProject
|
||||
cabalProjectLocal
|
||||
patches
|
||||
cabalArgs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
when setCompile $ void $ liftE $
|
||||
setHLS targetVer SetHLSOnly Nothing
|
||||
pure (vi, targetVer)
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, tv) -> do
|
||||
runLogger $ logInfo
|
||||
"HLS successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
liftIO $ putStr (T.unpack $ prettyVer tv)
|
||||
pure ExitSuccess
|
||||
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 9
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 9
|
||||
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
|
||||
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
|
||||
pure $ ExitFailure 9
|
||||
(CompileGHC GHCCompileOptions {..}) ->
|
||||
runCompileGHC runAppState (do
|
||||
case targetGhc of
|
||||
Left targetVer -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer GHC dls
|
||||
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
||||
lift $ logInfo msg
|
||||
lift $ logInfo
|
||||
"...waiting for 5 seconds, you can still abort..."
|
||||
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
||||
Right _ -> pure ()
|
||||
targetVer <- liftE $ compileGHC
|
||||
(first (GHCTargetVersion crossTarget) targetGhc)
|
||||
ovewrwiteVer
|
||||
bootstrapGhc
|
||||
jobs
|
||||
buildConfig
|
||||
patches
|
||||
addConfArgs
|
||||
buildFlavour
|
||||
hadrian
|
||||
isolateDir
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||
when setCompile $ void $ liftE $
|
||||
setGHC targetVer SetGHCOnly Nothing
|
||||
pure (vi, targetVer)
|
||||
)
|
||||
>>= \case
|
||||
VRight (vi, tv) -> do
|
||||
runLogger $ logInfo
|
||||
"GHC successfully compiled and installed"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
liftIO $ putStr (T.unpack $ tVerToText tv)
|
||||
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 (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
|
||||
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 9
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 9
|
||||
204
app/ghcup/GHCup/OptParse/Config.hs
Normal file
204
app/ghcup/GHCup/OptParse/Config.hs
Normal file
@@ -0,0 +1,204 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
|
||||
module GHCup.OptParse.Config where
|
||||
|
||||
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Exception ( displayException )
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style, ParseError )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
import qualified Data.Yaml.Aeson as Y
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data ConfigCommand
|
||||
= ShowConfig
|
||||
| SetConfig String (Maybe String)
|
||||
| InitConfig
|
||||
| AddReleaseChannel URI
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
configP :: Parser ConfigCommand
|
||||
configP = subparser
|
||||
( command "init" initP
|
||||
<> command "set" setP -- [set] KEY VALUE at help lhs
|
||||
<> command "show" showP
|
||||
<> command "add-release-channel" addP
|
||||
)
|
||||
<|> argsP -- add show for a single option
|
||||
<|> pure ShowConfig
|
||||
where
|
||||
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
|
||||
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
|
||||
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
|
||||
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
|
||||
addP = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
|
||||
(progDesc "Add a release channel from a URI")
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
configFooter :: String
|
||||
configFooter = [s|Examples:
|
||||
|
||||
# show current config
|
||||
ghcup config
|
||||
|
||||
# initialize config
|
||||
ghcup config init
|
||||
|
||||
# set <key> <value> configuration pair
|
||||
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>"}}'|]
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
--[ Utilities ]--
|
||||
-----------------
|
||||
|
||||
|
||||
formatConfig :: UserSettings -> String
|
||||
formatConfig = UTF8.toString . Y.encode
|
||||
|
||||
|
||||
updateSettings :: UserSettings -> Settings -> Settings
|
||||
updateSettings UserSettings{..} Settings{..} =
|
||||
let cache' = fromMaybe cache uCache
|
||||
metaCache' = fromMaybe metaCache uMetaCache
|
||||
noVerify' = fromMaybe noVerify uNoVerify
|
||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
||||
downloader' = fromMaybe downloader uDownloader
|
||||
verbose' = fromMaybe verbose uVerbose
|
||||
urlSource' = fromMaybe urlSource uUrlSource
|
||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||
in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
config :: forall m. ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> ConfigCommand
|
||||
-> Settings
|
||||
-> KeyBindings
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
config configCommand settings keybindings runLogger = case configCommand of
|
||||
InitConfig -> do
|
||||
path <- getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
|
||||
runLogger $ logDebug $ "config.yaml initialized at " <> T.pack path
|
||||
pure ExitSuccess
|
||||
|
||||
ShowConfig -> do
|
||||
liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
|
||||
pure ExitSuccess
|
||||
|
||||
(SetConfig k mv) -> do
|
||||
r <- runE @'[JSONError, ParseError] $ do
|
||||
case mv of
|
||||
Just "" ->
|
||||
throwE $ ParseError "Empty values are not allowed"
|
||||
Nothing -> do
|
||||
usersettings <- decodeSettings k
|
||||
lift $ doConfig usersettings
|
||||
pure ()
|
||||
Just v -> do
|
||||
usersettings <- decodeSettings (k <> ": " <> v <> "\n")
|
||||
lift $ doConfig usersettings
|
||||
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
|
||||
|
||||
AddReleaseChannel uri -> do
|
||||
case urlSource settings of
|
||||
AddSource xs -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
||||
pure ExitSuccess
|
||||
_ -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||
pure ExitSuccess
|
||||
|
||||
where
|
||||
doConfig :: MonadIO m => UserSettings -> m ()
|
||||
doConfig usersettings = do
|
||||
let settings' = updateSettings usersettings settings
|
||||
path <- liftIO getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||
runLogger $ logDebug $ T.pack $ show settings'
|
||||
pure ()
|
||||
|
||||
decodeSettings = lE' (JSONDecodeError . displayException) . Y.decodeEither' . UTF8.fromString
|
||||
119
app/ghcup/GHCup/OptParse/DInfo.hs
Normal file
119
app/ghcup/GHCup/OptParse/DInfo.hs
Normal file
@@ -0,0 +1,119 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.DInfo where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Version
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Utils.File
|
||||
import Language.Haskell.TH
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
--[ Utilities ]--
|
||||
-----------------
|
||||
|
||||
|
||||
describe_result :: String
|
||||
describe_result = $( LitE . StringL <$>
|
||||
runIO (do
|
||||
CapturedProcess{..} <- do
|
||||
dirs <- liftIO getAllDirs
|
||||
let settings = AppState (defaultSettings { noNetwork = True })
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
flip runReaderT settings $ executeOut "git" ["describe"] Nothing
|
||||
case _exitCode of
|
||||
ExitSuccess -> pure . T.unpack . decUTF8Safe' $ _stdOut
|
||||
ExitFailure _ -> pure numericVer
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
prettyDebugInfo :: DebugInfo -> String
|
||||
prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
|
||||
"==========" <> "\n" <>
|
||||
"GHCup base dir: " <> diBaseDir <> "\n" <>
|
||||
"GHCup bin dir: " <> diBinDir <> "\n" <>
|
||||
"GHCup GHC directory: " <> diGHCDir <> "\n" <>
|
||||
"GHCup cache directory: " <> diCacheDir <> "\n" <>
|
||||
"Architecture: " <> prettyShow diArch <> "\n" <>
|
||||
"Platform: " <> prettyShow diPlatform <> "\n" <>
|
||||
"Version: " <> describe_result
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type DInfoEffects = '[ NoCompatiblePlatform , NoCompatibleArch , DistroNotFound ]
|
||||
|
||||
runDebugInfo :: (ReaderT env m (VEither DInfoEffects a) -> m (VEither DInfoEffects a))
|
||||
-> Excepts DInfoEffects (ReaderT env m) a
|
||||
-> m (VEither DInfoEffects a)
|
||||
runDebugInfo runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@DInfoEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
dinfo :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, Alternative m
|
||||
)
|
||||
=> (ReaderT AppState m (VEither DInfoEffects DebugInfo)
|
||||
-> m (VEither DInfoEffects DebugInfo))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
dinfo runAppState runLogger = do
|
||||
runDebugInfo runAppState (liftE getDebugInfo)
|
||||
>>= \case
|
||||
VRight di -> do
|
||||
liftIO $ putStrLn $ prettyDebugInfo di
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 8
|
||||
143
app/ghcup/GHCup/OptParse/GC.hs
Normal file
143
app/ghcup/GHCup/OptParse/GC.hs
Normal file
@@ -0,0 +1,143 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.GC where
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data GCOptions = GCOptions
|
||||
{ gcOldGHC :: Bool
|
||||
, gcProfilingLibs :: Bool
|
||||
, gcShareDir :: Bool
|
||||
, gcHLSNoGHC :: Bool
|
||||
, gcCache :: Bool
|
||||
, gcTmp :: Bool
|
||||
}
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
gcP :: Parser GCOptions
|
||||
gcP =
|
||||
GCOptions
|
||||
<$>
|
||||
switch
|
||||
(short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'")
|
||||
<*>
|
||||
switch
|
||||
(short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions")
|
||||
<*>
|
||||
switch
|
||||
(short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)")
|
||||
<*>
|
||||
switch
|
||||
(short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version")
|
||||
<*>
|
||||
switch
|
||||
(short 'c' <> long "cache" <> help "GC the GHCup cache")
|
||||
<*>
|
||||
switch
|
||||
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
gcFooter :: String
|
||||
gcFooter = [s|Discussion:
|
||||
Performs garbage collection. If no switches are specified, does nothing.|]
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type GCEffects = '[ NotInstalled ]
|
||||
|
||||
|
||||
runGC :: MonadUnliftIO m
|
||||
=> (ReaderT AppState m (VEither GCEffects a) -> m (VEither GCEffects a))
|
||||
-> Excepts GCEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither GCEffects a)
|
||||
runGC runAppState =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@GCEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
gc :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> GCOptions
|
||||
-> (forall a. ReaderT AppState m (VEither GCEffects a) -> m (VEither GCEffects a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
gc GCOptions{..} runAppState runLogger = runGC runAppState (do
|
||||
when gcOldGHC rmOldGHC
|
||||
lift $ when gcProfilingLibs rmProfilingLibs
|
||||
lift $ when gcShareDir rmShareDir
|
||||
liftE $ when gcHLSNoGHC rmHLSNoGHC
|
||||
lift $ when gcCache rmCache
|
||||
lift $ when gcTmp rmTmp
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 27
|
||||
623
app/ghcup/GHCup/OptParse/Install.hs
Normal file
623
app/ghcup/GHCup/OptParse/Install.hs
Normal file
@@ -0,0 +1,623 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module GHCup.OptParse.Install where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Codec.Archive
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data InstallCommand = InstallGHC InstallOptions
|
||||
| InstallCabal InstallOptions
|
||||
| InstallHLS InstallOptions
|
||||
| InstallStack InstallOptions
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data InstallOptions = InstallOptions
|
||||
{ instVer :: Maybe ToolVersion
|
||||
, instPlatform :: Maybe PlatformRequest
|
||||
, instBindist :: Maybe URI
|
||||
, instSet :: Bool
|
||||
, isolateDir :: Maybe FilePath
|
||||
, forceInstall :: Bool
|
||||
}
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Footers ]--
|
||||
---------------
|
||||
|
||||
installCabalFooter :: String
|
||||
installCabalFooter = [s|Discussion:
|
||||
Installs the specified cabal-install version (or a recommended default one)
|
||||
into "~/.ghcup/bin", so it can be overwritten by later
|
||||
"cabal install cabal-install", which installs into "~/.cabal/bin" by
|
||||
default. Make sure to set up your PATH appropriately, so the cabal
|
||||
installation takes precedence.|]
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
installParser :: Parser (Either InstallCommand InstallOptions)
|
||||
installParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
( InstallGHC
|
||||
<$> info
|
||||
(installOpts (Just GHC) <**> helper)
|
||||
( progDesc "Install GHC"
|
||||
<> footerDoc (Just $ text installGHCFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"cabal"
|
||||
( InstallCabal
|
||||
<$> info
|
||||
(installOpts (Just Cabal) <**> helper)
|
||||
( progDesc "Install Cabal"
|
||||
<> footerDoc (Just $ text installCabalFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( InstallHLS
|
||||
<$> info
|
||||
(installOpts (Just HLS) <**> helper)
|
||||
( progDesc "Install haskell-language-server"
|
||||
<> footerDoc (Just $ text installHLSFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( InstallStack
|
||||
<$> info
|
||||
(installOpts (Just Stack) <**> helper)
|
||||
( progDesc "Install stack"
|
||||
<> footerDoc (Just $ text installStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> installOpts Nothing)
|
||||
where
|
||||
installHLSFooter :: String
|
||||
installHLSFooter = [s|Discussion:
|
||||
Installs haskell-language-server binaries and wrapper
|
||||
into "~/.ghcup/bin"
|
||||
|
||||
Examples:
|
||||
# install recommended HLS
|
||||
ghcup install hls|]
|
||||
|
||||
installStackFooter :: String
|
||||
installStackFooter = [s|Discussion:
|
||||
Installs stack binaries into "~/.ghcup/bin"
|
||||
|
||||
Examples:
|
||||
# install recommended Stack
|
||||
ghcup install stack|]
|
||||
|
||||
installGHCFooter :: String
|
||||
installGHCFooter = [s|Discussion:
|
||||
Installs the specified GHC version (or a recommended default one) into
|
||||
a self-contained "~/.ghcup/ghc/<ghcver>" directory
|
||||
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
|
||||
|
||||
Examples:
|
||||
# install recommended GHC
|
||||
ghcup install ghc
|
||||
|
||||
# install latest GHC
|
||||
ghcup install ghc latest
|
||||
|
||||
# install GHC 8.10.2
|
||||
ghcup install ghc 8.10.2
|
||||
|
||||
# install GHC head fedora bindist
|
||||
ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
|
||||
|
||||
|
||||
installOpts :: Maybe Tool -> Parser InstallOptions
|
||||
installOpts tool =
|
||||
(\p (u, v) b is f -> InstallOptions v p u b is f)
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader platformParser)
|
||||
( short 'p'
|
||||
<> long "platform"
|
||||
<> metavar "PLATFORM"
|
||||
<> help
|
||||
"Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
|
||||
)
|
||||
)
|
||||
<*> ( ( (,)
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader uriParser)
|
||||
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
|
||||
"Install the specified version from this bindist"
|
||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionArgument Nothing tool)
|
||||
)
|
||||
<|> pure (Nothing, Nothing)
|
||||
)
|
||||
<*> fmap (fromMaybe setDefault) (invertableSwitch "set" Nothing setDefault
|
||||
(help $ if not setDefault then "Set as active version after install" else "Don't set as active version after install"))
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'i'
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated dir instead of the default one"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
(short 'f' <> long "force" <> help "Force install")
|
||||
where
|
||||
setDefault = case tool of
|
||||
Nothing -> False
|
||||
Just GHC -> False
|
||||
Just _ -> True
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
installToolFooter :: String
|
||||
installToolFooter = [s|Discussion:
|
||||
Installs GHC or cabal. When no command is given, installs GHC
|
||||
with the specified version/tag.
|
||||
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
type InstallEffects = '[ AlreadyInstalled
|
||||
, UnknownArchive
|
||||
, ArchiveResult
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NotInstalled
|
||||
, DirNotEmpty
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, TarDirDoesNotExist
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
|
||||
, (AlreadyInstalled, ())
|
||||
, (UnknownArchive, ())
|
||||
, (ArchiveResult, ())
|
||||
, (FileDoesNotExistError, ())
|
||||
, (CopyError, ())
|
||||
, (NotInstalled, ())
|
||||
, (DirNotEmpty, ())
|
||||
, (NoDownload, ())
|
||||
, (NotInstalled, ())
|
||||
, (BuildFailed, ())
|
||||
, (TagNotFound, ())
|
||||
, (DigestError, ())
|
||||
, (GPGError, ())
|
||||
, (DownloadFailed, ())
|
||||
, (TarDirDoesNotExist, ())
|
||||
, (NextVerNotFound, ())
|
||||
, (NoToolVersionSet, ())
|
||||
, (FileAlreadyExistsError, ())
|
||||
, (ProcessError, ())
|
||||
|
||||
, (AlreadyInstalled, NotInstalled)
|
||||
, (UnknownArchive, NotInstalled)
|
||||
, (ArchiveResult, NotInstalled)
|
||||
, (FileDoesNotExistError, NotInstalled)
|
||||
, (CopyError, NotInstalled)
|
||||
, (NotInstalled, NotInstalled)
|
||||
, (DirNotEmpty, NotInstalled)
|
||||
, (NoDownload, NotInstalled)
|
||||
, (NotInstalled, NotInstalled)
|
||||
, (BuildFailed, NotInstalled)
|
||||
, (TagNotFound, NotInstalled)
|
||||
, (DigestError, NotInstalled)
|
||||
, (GPGError, NotInstalled)
|
||||
, (DownloadFailed, NotInstalled)
|
||||
, (TarDirDoesNotExist, NotInstalled)
|
||||
, (NextVerNotFound, NotInstalled)
|
||||
, (NoToolVersionSet, NotInstalled)
|
||||
, (FileAlreadyExistsError, NotInstalled)
|
||||
, (ProcessError, NotInstalled)
|
||||
|
||||
, ((), NotInstalled)
|
||||
]
|
||||
|
||||
|
||||
runInstTool :: AppState
|
||||
-> Maybe PlatformRequest
|
||||
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
|
||||
-> IO (VEither InstallEffects a)
|
||||
runInstTool appstate' mInstPlatform =
|
||||
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
|
||||
. runResourceT
|
||||
. runE
|
||||
@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 ]--
|
||||
-------------------
|
||||
|
||||
|
||||
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
|
||||
install installCommand settings getAppState' runLogger = case installCommand of
|
||||
(Right iopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
|
||||
installGHC iopts
|
||||
(Left (InstallGHC iopts)) -> installGHC iopts
|
||||
(Left (InstallCabal iopts)) -> installCabal iopts
|
||||
(Left (InstallHLS iopts)) -> installHLS iopts
|
||||
(Left (InstallStack iopts)) -> installStack iopts
|
||||
where
|
||||
installGHC :: InstallOptions -> IO ExitCode
|
||||
installGHC InstallOptions{..} = do
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstGHC s' instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
void $ liftE $ sequenceE (installGHCBin
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
)
|
||||
$ when instSet $ when (isNothing isolateDir) $ 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 $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "GHC installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
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
|
||||
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 (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 (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
|
||||
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 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
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 3
|
||||
|
||||
|
||||
installCabal :: InstallOptions -> IO ExitCode
|
||||
installCabal InstallOptions{..} = do
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
void $ liftE $ sequenceE (installCabalBin
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
|
||||
pure vi
|
||||
Just uri -> do
|
||||
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
void $ liftE $ sequenceE (installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "Cabal installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
||||
runLogger $ logWarn $
|
||||
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp, ())) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
installHLS :: InstallOptions -> IO ExitCode
|
||||
installHLS InstallOptions{..} = do
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||
void $ liftE $ sequenceE (installHLSBin
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
|
||||
pure vi
|
||||
Just uri -> do
|
||||
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||
-- TODO: support legacy
|
||||
void $ liftE $ sequenceE (installHLSBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "HLS installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"HLS ver "
|
||||
<> prettyVer v
|
||||
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
|
||||
<> prettyVer v
|
||||
<> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
||||
runLogger $ logWarn $
|
||||
"HLS ver "
|
||||
<> prettyVer v
|
||||
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
|
||||
<> prettyVer v
|
||||
<> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp, ())) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
installStack :: InstallOptions -> IO ExitCode
|
||||
installStack InstallOptions{..} = do
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||
void $ liftE $ sequenceE (installStackBin
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
|
||||
pure vi
|
||||
Just uri -> do
|
||||
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||
void $ liftE $ sequenceE (installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
runLogger $ logInfo "Stack installation successful"
|
||||
forM_ (_viPostInstall =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V (AlreadyInstalled _ v)) -> do
|
||||
runLogger $ logWarn $
|
||||
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp)) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
||||
runLogger $ logWarn $
|
||||
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
|
||||
pure ExitSuccess
|
||||
VLeft (V (FileAlreadyExistsError fp, ())) -> do
|
||||
runLogger $ logWarn $
|
||||
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
||||
pure $ ExitFailure 3
|
||||
VLeft e -> do
|
||||
runLogger $ do
|
||||
logError $ T.pack $ prettyShow e
|
||||
logError $ "Also check the logs in " <> T.pack logsDir
|
||||
pure $ ExitFailure 4
|
||||
|
||||
265
app/ghcup/GHCup/OptParse/List.hs
Normal file
265
app/ghcup/GHCup/OptParse/List.hs
Normal file
@@ -0,0 +1,265 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.List where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Types
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Char
|
||||
import Data.List ( intercalate, sort )
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Void
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import System.Console.Pretty hiding ( color )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified System.Console.Pretty as Pretty
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MPC
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data ListOptions = ListOptions
|
||||
{ loTool :: Maybe Tool
|
||||
, lCriteria :: Maybe ListCriteria
|
||||
, lRawFormat :: Bool
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
listOpts :: Parser ListOptions
|
||||
listOpts =
|
||||
ListOptions
|
||||
<$> optional
|
||||
(option
|
||||
(eitherReader toolParser)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||
"Tool to list versions for. Default is all"
|
||||
<> completer (toolCompleter)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader criteriaParser)
|
||||
( short 'c'
|
||||
<> long "show-criteria"
|
||||
<> metavar "<installed|set|available>"
|
||||
<> help "Show only installed/set/available tool versions"
|
||||
<> completer (listCompleter ["installed", "set", "available"])
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
--[ Utilities ]--
|
||||
-----------------
|
||||
|
||||
|
||||
printListResult :: Bool -> Bool -> [ListResult] -> IO ()
|
||||
printListResult no_color raw lr = do
|
||||
|
||||
let
|
||||
color | raw || no_color = (\_ x -> x)
|
||||
| otherwise = Pretty.color
|
||||
|
||||
let
|
||||
printTag Recommended = color Green "recommended"
|
||||
printTag Latest = color Yellow "latest"
|
||||
printTag Prerelease = color Red "prerelease"
|
||||
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
|
||||
printTag (UnknownTag t ) = t
|
||||
printTag Old = ""
|
||||
|
||||
let
|
||||
rows =
|
||||
(\x -> if raw
|
||||
then x
|
||||
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
|
||||
)
|
||||
. fmap
|
||||
(\ListResult {..} ->
|
||||
let marks = if
|
||||
| lSet -> (color Green (if isWindows then "IS" else "✔✔"))
|
||||
| lInstalled -> (color Green (if isWindows then "I " else "✓ "))
|
||||
| otherwise -> (color Red (if isWindows then "X " else "✗ "))
|
||||
in
|
||||
(if raw then [] else [marks])
|
||||
++ [ fmap toLower . show $ lTool
|
||||
, case lCross of
|
||||
Nothing -> T.unpack . prettyVer $ lVer
|
||||
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
||||
, intercalate "," (filter (/= "") . fmap printTag $ sort lTag)
|
||||
, intercalate ","
|
||||
$ (if hlsPowered
|
||||
then [color Green "hls-powered"]
|
||||
else mempty
|
||||
)
|
||||
++ (if fromSrc then [color Blue "compiled"] else mempty)
|
||||
++ (if lStray then [color Yellow "stray"] else mempty)
|
||||
++ (if lNoBindist
|
||||
then [color Red "no-bindist"]
|
||||
else mempty
|
||||
)
|
||||
]
|
||||
)
|
||||
$ lr
|
||||
let cols =
|
||||
foldr (\xs ys -> zipWith (:) xs ys) (repeat []) rows
|
||||
lengths = fmap (maximum . fmap strWidth) cols
|
||||
padded = fmap (\xs -> zipWith padTo xs lengths) rows
|
||||
|
||||
forM_ (if raw then rows else padded) $ \row -> putStrLn $ unwords row
|
||||
where
|
||||
|
||||
padTo str' x =
|
||||
let lstr = strWidth str'
|
||||
add' = x - lstr
|
||||
in if add' < 0 then str' else str' ++ replicate add' ' '
|
||||
|
||||
-- | Calculate the render width of a string, considering
|
||||
-- wide characters (counted as double width), ANSI escape codes
|
||||
-- (not counted), and line breaks (in a multi-line string, the longest
|
||||
-- line determines the width).
|
||||
strWidth :: String -> Int
|
||||
strWidth =
|
||||
maximum
|
||||
. (0 :)
|
||||
. map (foldr (\a b -> charWidth a + b) 0)
|
||||
. lines
|
||||
. stripAnsi
|
||||
|
||||
-- | Strip ANSI escape sequences from a string.
|
||||
--
|
||||
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
|
||||
-- "-1"
|
||||
stripAnsi :: String -> String
|
||||
stripAnsi s' =
|
||||
case
|
||||
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
|
||||
of
|
||||
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
|
||||
Just xs -> concat xs
|
||||
where
|
||||
-- This parses lots of invalid ANSI escape codes, but that should be fine
|
||||
ansi =
|
||||
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
|
||||
Void
|
||||
String
|
||||
Char
|
||||
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
|
||||
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
|
||||
|
||||
-- | Get the designated render width of a character: 0 for a combining
|
||||
-- character, 1 for a regular character, 2 for a wide character.
|
||||
-- (Wide characters are rendered as exactly double width in apps and
|
||||
-- fonts that support it.) (From Pandoc.)
|
||||
charWidth :: Char -> Int
|
||||
charWidth c = case c of
|
||||
_ | c < '\x0300' -> 1
|
||||
| c >= '\x0300' && c <= '\x036F' -> 0
|
||||
| -- combining
|
||||
c >= '\x0370' && c <= '\x10FC' -> 1
|
||||
| c >= '\x1100' && c <= '\x115F' -> 2
|
||||
| c >= '\x1160' && c <= '\x11A2' -> 1
|
||||
| c >= '\x11A3' && c <= '\x11A7' -> 2
|
||||
| c >= '\x11A8' && c <= '\x11F9' -> 1
|
||||
| c >= '\x11FA' && c <= '\x11FF' -> 2
|
||||
| c >= '\x1200' && c <= '\x2328' -> 1
|
||||
| c >= '\x2329' && c <= '\x232A' -> 2
|
||||
| c >= '\x232B' && c <= '\x2E31' -> 1
|
||||
| c >= '\x2E80' && c <= '\x303E' -> 2
|
||||
| c == '\x303F' -> 1
|
||||
| c >= '\x3041' && c <= '\x3247' -> 2
|
||||
| c >= '\x3248' && c <= '\x324F' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\x3250' && c <= '\x4DBF' -> 2
|
||||
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
|
||||
| c >= '\x4E00' && c <= '\xA4C6' -> 2
|
||||
| c >= '\xA4D0' && c <= '\xA95F' -> 1
|
||||
| c >= '\xA960' && c <= '\xA97C' -> 2
|
||||
| c >= '\xA980' && c <= '\xABF9' -> 1
|
||||
| c >= '\xAC00' && c <= '\xD7FB' -> 2
|
||||
| c >= '\xD800' && c <= '\xDFFF' -> 1
|
||||
| c >= '\xE000' && c <= '\xF8FF' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\xF900' && c <= '\xFAFF' -> 2
|
||||
| c >= '\xFB00' && c <= '\xFDFD' -> 1
|
||||
| c >= '\xFE00' && c <= '\xFE0F' -> 1
|
||||
| -- ambiguous
|
||||
c >= '\xFE10' && c <= '\xFE19' -> 2
|
||||
| c >= '\xFE20' && c <= '\xFE26' -> 1
|
||||
| c >= '\xFE30' && c <= '\xFE6B' -> 2
|
||||
| c >= '\xFE70' && c <= '\xFEFF' -> 1
|
||||
| c >= '\xFF01' && c <= '\xFF60' -> 2
|
||||
| c >= '\xFF61' && c <= '\x16A38' -> 1
|
||||
| c >= '\x1B000' && c <= '\x1B001' -> 2
|
||||
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
|
||||
| c >= '\x1F200' && c <= '\x1F251' -> 2
|
||||
| c >= '\x1F300' && c <= '\x1F773' -> 1
|
||||
| c >= '\x20000' && c <= '\x3FFFD' -> 2
|
||||
| otherwise -> 1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
list :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> ListOptions
|
||||
-> Bool
|
||||
-> (ReaderT AppState m ExitCode -> m ExitCode)
|
||||
-> m ExitCode
|
||||
list ListOptions{..} no_color runAppState =
|
||||
runAppState (do
|
||||
l <- listVersions loTool lCriteria
|
||||
liftIO $ printListResult no_color lRawFormat l
|
||||
pure ExitSuccess
|
||||
)
|
||||
99
app/ghcup/GHCup/OptParse/Nuke.hs
Normal file
99
app/ghcup/GHCup/OptParse/Nuke.hs
Normal file
@@ -0,0 +1,99 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Nuke where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import Control.DeepSeq
|
||||
import Control.Exception
|
||||
import Control.Concurrent (threadDelay)
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type NukeEffects = '[ NotInstalled ]
|
||||
|
||||
|
||||
runNuke :: AppState
|
||||
-> Excepts NukeEffects (ReaderT AppState m) a
|
||||
-> m (VEither NukeEffects a)
|
||||
runNuke s' =
|
||||
flip runReaderT s' . runE @NukeEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
nuke :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> IO AppState
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
nuke appState runLogger = do
|
||||
s' <- liftIO appState
|
||||
void $ liftIO $ evaluate $ force s'
|
||||
runNuke s' (do
|
||||
lift $ logWarn "WARNING: This will remove GHCup and all installed components from your system."
|
||||
lift $ logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
|
||||
liftIO $ threadDelay 10000000 -- wait 10s
|
||||
|
||||
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
|
||||
lift $ logInfo "Nuking in 3...2...1"
|
||||
|
||||
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
|
||||
|
||||
forM_ lInstalled (liftE . rmTool)
|
||||
|
||||
lift rmGhcupDirs
|
||||
|
||||
) >>= \case
|
||||
VRight leftOverFiles
|
||||
| null leftOverFiles -> do
|
||||
runLogger $ logInfo "Nuclear Annihilation complete!"
|
||||
pure ExitSuccess
|
||||
| otherwise -> do
|
||||
runLogger $ logError "These Files have survived Nuclear Annihilation, you may remove them manually."
|
||||
liftIO $ forM_ leftOverFiles putStrLn
|
||||
pure ExitSuccess
|
||||
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
219
app/ghcup/GHCup/OptParse/Prefetch.hs
Normal file
219
app/ghcup/GHCup/OptParse/Prefetch.hs
Normal file
@@ -0,0 +1,219 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Prefetch where
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Download (getDownloadsF)
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data PrefetchCommand = PrefetchGHC PrefetchGHCOptions (Maybe ToolVersion)
|
||||
| PrefetchCabal PrefetchOptions (Maybe ToolVersion)
|
||||
| PrefetchHLS PrefetchOptions (Maybe ToolVersion)
|
||||
| PrefetchStack PrefetchOptions (Maybe ToolVersion)
|
||||
| PrefetchMetadata
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data PrefetchOptions = PrefetchOptions {
|
||||
pfCacheDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
data PrefetchGHCOptions = PrefetchGHCOptions {
|
||||
pfGHCSrc :: Bool
|
||||
, pfGHCCacheDir :: Maybe FilePath
|
||||
}
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
prefetchP :: Parser PrefetchCommand
|
||||
prefetchP = subparser
|
||||
( command
|
||||
"ghc"
|
||||
(info
|
||||
(PrefetchGHC
|
||||
<$> (PrefetchGHCOptions
|
||||
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
|
||||
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> optional (toolVersionArgument Nothing (Just GHC)) )
|
||||
( progDesc "Download GHC assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"cabal"
|
||||
(info
|
||||
(PrefetchCabal
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
|
||||
( progDesc "Download cabal assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"hls"
|
||||
(info
|
||||
(PrefetchHLS
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
|
||||
( progDesc "Download HLS assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"stack"
|
||||
(info
|
||||
(PrefetchStack
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
|
||||
( progDesc "Download stack assets for installation")
|
||||
)
|
||||
<>
|
||||
command
|
||||
"metadata"
|
||||
(PrefetchMetadata <$ info
|
||||
helper
|
||||
( progDesc "Download ghcup's metadata, needed for various operations")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
prefetchFooter :: String
|
||||
prefetchFooter = [s|Discussion:
|
||||
Prefetches tools or assets into "~/.ghcup/cache" directory. This can
|
||||
be then combined later with '--offline' flag, ensuring all assets that
|
||||
are required for offline use have been prefetched.
|
||||
|
||||
Examples:
|
||||
ghcup prefetch metadata
|
||||
ghcup prefetch ghc 8.10.5
|
||||
ghcup --offline install ghc 8.10.5|]
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type PrefetchEffects = '[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, NoDownload
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, JSONError
|
||||
, FileDoesNotExistError ]
|
||||
|
||||
|
||||
runPrefetch :: MonadUnliftIO m
|
||||
=> (ReaderT AppState m (VEither PrefetchEffects a) -> m (VEither PrefetchEffects a))
|
||||
-> Excepts PrefetchEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither PrefetchEffects a)
|
||||
runPrefetch runAppState =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@PrefetchEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
prefetch :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> PrefetchCommand
|
||||
-> (forall a. ReaderT AppState m (VEither PrefetchEffects a) -> m (VEither PrefetchEffects a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
prefetch prefetchCommand runAppState runLogger =
|
||||
runPrefetch runAppState (do
|
||||
case prefetchCommand of
|
||||
PrefetchGHC
|
||||
(PrefetchGHCOptions pfGHCSrc pfCacheDir) mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt GHC
|
||||
if pfGHCSrc
|
||||
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
|
||||
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
|
||||
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt Cabal
|
||||
liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
|
||||
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt HLS
|
||||
liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
|
||||
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
|
||||
forM_ pfCacheDir (liftIO . createDirRecursive')
|
||||
(v, _) <- liftE $ fromVersion mt Stack
|
||||
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
|
||||
PrefetchMetadata -> do
|
||||
_ <- liftE getDownloadsF
|
||||
pure ""
|
||||
) >>= \case
|
||||
VRight _ -> do
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
232
app/ghcup/GHCup/OptParse/Rm.hs
Normal file
232
app/ghcup/GHCup/OptParse/Rm.hs
Normal file
@@ -0,0 +1,232 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Rm where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data RmCommand = RmGHC RmOptions
|
||||
| RmCabal Version
|
||||
| RmHLS Version
|
||||
| RmStack Version
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data RmOptions = RmOptions
|
||||
{ ghcVer :: GHCTargetVersion
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
rmParser :: Parser (Either RmCommand RmOptions)
|
||||
rmParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
(RmGHC <$> info (rmOpts (Just GHC) <**> helper) (progDesc "Remove GHC version"))
|
||||
<> command
|
||||
"cabal"
|
||||
( RmCabal
|
||||
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
|
||||
(progDesc "Remove Cabal version")
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( RmHLS
|
||||
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
|
||||
(progDesc "Remove haskell-language-server version")
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( RmStack
|
||||
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
|
||||
(progDesc "Remove stack version")
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> rmOpts Nothing)
|
||||
|
||||
|
||||
|
||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||
rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
rmFooter :: String
|
||||
rmFooter = [s|Discussion:
|
||||
Remove the given GHC or cabal version. When no command is given,
|
||||
defaults to removing GHC with the specified version.
|
||||
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type RmEffects = '[ NotInstalled ]
|
||||
|
||||
|
||||
runRm :: (ReaderT env m (VEither RmEffects a) -> m (VEither RmEffects a))
|
||||
-> Excepts RmEffects (ReaderT env m) a
|
||||
-> m (VEither RmEffects a)
|
||||
runRm runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@RmEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
rm :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Either RmCommand RmOptions
|
||||
-> (ReaderT AppState m (VEither RmEffects (Maybe VersionInfo))
|
||||
-> m (VEither RmEffects (Maybe VersionInfo)))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
rm rmCommand runAppState runLogger = case rmCommand of
|
||||
(Right rmopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
|
||||
rmGHC' rmopts
|
||||
(Left (RmGHC rmopts)) -> rmGHC' rmopts
|
||||
(Left (RmCabal rmopts)) -> rmCabal' rmopts
|
||||
(Left (RmHLS rmopts)) -> rmHLS' rmopts
|
||||
(Left (RmStack rmopts)) -> rmStack' rmopts
|
||||
|
||||
where
|
||||
rmGHC' RmOptions{..} =
|
||||
runRm runAppState (do
|
||||
liftE $
|
||||
rmGHCVer ghcVer
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 7
|
||||
|
||||
rmCabal' tv =
|
||||
runRm runAppState (do
|
||||
liftE $
|
||||
rmCabalVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv Cabal dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
rmHLS' tv =
|
||||
runRm runAppState (do
|
||||
liftE $
|
||||
rmHLSVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv HLS dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
rmStack' tv =
|
||||
runRm runAppState (do
|
||||
liftE $
|
||||
rmStackVer tv
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (getVersionInfo tv Stack dls)
|
||||
)
|
||||
>>= \case
|
||||
VRight vi -> do
|
||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 15
|
||||
|
||||
463
app/ghcup/GHCup/OptParse/Run.hs
Normal file
463
app/ghcup/GHCup/OptParse/Run.hs
Normal file
@@ -0,0 +1,463 @@
|
||||
{-# 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
|
||||
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.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"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
||||
<> completer (tagCompleter Cabal [])
|
||||
<> (completer $ versionCompleter Nothing Cabal)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
||||
<> completer (tagCompleter HLS [])
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
||||
<> completer (tagCompleter Stack [])
|
||||
<> (completer $ versionCompleter Nothing Stack)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'b'
|
||||
<> long "bindir"
|
||||
<> metavar "DIR"
|
||||
<> help "directory where to create the tool symlinks (default: newly created system temp dir)"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
<*> 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
|
||||
=> IO AppState
|
||||
-> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither RunEffects a)
|
||||
runRUN appState action' = do
|
||||
s' <- liftIO appState
|
||||
flip runReaderT s'
|
||||
. runResourceT
|
||||
. runE
|
||||
@RunEffects
|
||||
$ action'
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
run :: forall m.
|
||||
( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> RunOptions
|
||||
-> IO AppState
|
||||
-> LeanAppState
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
r <- if or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool'
|
||||
then runRUN runAppState $ do
|
||||
toolchain <- liftE resolveToolchainFull
|
||||
tmp <- case runBinDir of
|
||||
Just bindir -> do
|
||||
liftIO $ createDirRecursive' bindir
|
||||
liftIO $ canonicalizePath bindir
|
||||
Nothing -> do
|
||||
d <- liftIO $ predictableTmpDir toolchain
|
||||
liftIO $ createDirRecursive' d
|
||||
liftIO $ canonicalizePath d
|
||||
liftE $ installToolChainFull toolchain tmp
|
||||
pure tmp
|
||||
else runLeanRUN leanAppstate $ do
|
||||
toolchain <- resolveToolchain
|
||||
tmp <- case runBinDir of
|
||||
Just bindir -> do
|
||||
liftIO $ createDirRecursive' bindir
|
||||
liftIO $ canonicalizePath bindir
|
||||
Nothing -> do
|
||||
d <- liftIO $ predictableTmpDir toolchain
|
||||
liftIO $ createDirRecursive' d
|
||||
liftIO $ canonicalizePath d
|
||||
liftE $ installToolChain toolchain tmp
|
||||
pure tmp
|
||||
case r of
|
||||
VRight tmp -> 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
|
||||
resolveToolchainFull :: ( MonadFail m
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
] (ResourceT (ReaderT AppState m)) Toolchain
|
||||
resolveToolchainFull = do
|
||||
ghcVer <- forM runGHCVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) GHC
|
||||
pure v
|
||||
cabalVer <- forM runCabalVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) Cabal
|
||||
pure v
|
||||
hlsVer <- forM runHLSVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) HLS
|
||||
pure v
|
||||
stackVer <- forM runStackVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) Stack
|
||||
pure v
|
||||
pure Toolchain{..}
|
||||
|
||||
resolveToolchain = do
|
||||
ghcVer <- case runGHCVer of
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
cabalVer <- case runCabalVer of
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
hlsVer <- case runHLSVer of
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
stackVer <- case runStackVer of
|
||||
Just (ToolVersion v) -> pure $ Just v
|
||||
Nothing -> pure Nothing
|
||||
_ -> fail "Internal error"
|
||||
pure Toolchain{..}
|
||||
|
||||
installToolChainFull :: ( MonadFail m
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Toolchain
|
||||
-> FilePath
|
||||
-> Excepts
|
||||
'[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, UnknownArchive
|
||||
, TarDirDoesNotExist
|
||||
, ProcessError
|
||||
, NotInstalled
|
||||
, NoDownload
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, DirNotEmpty
|
||||
, DigestError
|
||||
, BuildFailed
|
||||
, ArchiveResult
|
||||
, AlreadyInstalled
|
||||
, FileAlreadyExistsError
|
||||
, CopyError
|
||||
] (ResourceT (ReaderT AppState m)) ()
|
||||
installToolChainFull Toolchain{..} tmp = do
|
||||
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
|
||||
isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
|
||||
case mt of
|
||||
Just (GHC, v) -> do
|
||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
setTool GHC v tmp
|
||||
Just (Cabal, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
setTool Cabal v tmp
|
||||
Just (Stack, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
setTool Stack v tmp
|
||||
Just (HLS, v) -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
setTool HLS v tmp
|
||||
_ -> pure ()
|
||||
|
||||
installToolChain :: ( MonadFail m
|
||||
, MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
)
|
||||
=> Toolchain
|
||||
-> FilePath
|
||||
-> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
|
||||
installToolChain Toolchain{..} tmp = do
|
||||
forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
|
||||
case mt of
|
||||
Just (GHC, v) -> setTool GHC v tmp
|
||||
Just (Cabal, v) -> setTool Cabal v tmp
|
||||
Just (Stack, v) -> setTool Stack v tmp
|
||||
Just (HLS, v) -> setTool HLS v tmp
|
||||
_ -> 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
|
||||
hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer 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
|
||||
|
||||
predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
|
||||
liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
|
||||
predictableTmpDir Toolchain{..} = do
|
||||
tmp <- getTemporaryDirectory
|
||||
pure $ tmp
|
||||
</> ("ghcup-" <> intercalate "_"
|
||||
( maybe [] ( (:[]) . ("ghc-" <>) . T.unpack . tVerToText) ghcVer
|
||||
<> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
|
||||
<> maybe [] ( (:[]) . ("hls-" <>) . T.unpack . tVerToText) hlsVer
|
||||
<> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
--[ Other local types ]--
|
||||
-------------------------
|
||||
|
||||
|
||||
|
||||
data Toolchain = Toolchain
|
||||
{ ghcVer :: Maybe GHCTargetVersion
|
||||
, cabalVer :: Maybe GHCTargetVersion
|
||||
, hlsVer :: Maybe GHCTargetVersion
|
||||
, stackVer :: Maybe GHCTargetVersion
|
||||
}
|
||||
349
app/ghcup/GHCup/OptParse/Set.hs
Normal file
349
app/ghcup/GHCup/OptParse/Set.hs
Normal file
@@ -0,0 +1,349 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Set where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Data.Versions hiding ( str )
|
||||
import GHC.Unicode
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Data.Bifunctor (second)
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Types.Optics
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data SetCommand = SetGHC SetOptions
|
||||
| SetCabal SetOptions
|
||||
| SetHLS SetOptions
|
||||
| SetStack SetOptions
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data SetOptions = SetOptions
|
||||
{ sToolVer :: SetToolVersion
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
setParser :: Parser (Either SetCommand SetOptions)
|
||||
setParser =
|
||||
(Left <$> subparser
|
||||
( command
|
||||
"ghc"
|
||||
( SetGHC
|
||||
<$> info
|
||||
(setOpts (Just GHC) <**> helper)
|
||||
( progDesc "Set GHC version"
|
||||
<> footerDoc (Just $ text setGHCFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"cabal"
|
||||
( SetCabal
|
||||
<$> info
|
||||
(setOpts (Just Cabal) <**> helper)
|
||||
( progDesc "Set Cabal version"
|
||||
<> footerDoc (Just $ text setCabalFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( SetHLS
|
||||
<$> info
|
||||
(setOpts (Just HLS) <**> helper)
|
||||
( progDesc "Set haskell-language-server version"
|
||||
<> footerDoc (Just $ text setHLSFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( SetStack
|
||||
<$> info
|
||||
(setOpts (Just Stack) <**> helper)
|
||||
( progDesc "Set stack version"
|
||||
<> footerDoc (Just $ text setStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<|> (Right <$> setOpts Nothing)
|
||||
where
|
||||
setGHCFooter :: String
|
||||
setGHCFooter = [s|Discussion:
|
||||
Sets the the current GHC version by creating non-versioned
|
||||
symlinks for all ghc binaries of the specified version in
|
||||
"~/.ghcup/bin/<binary>".|]
|
||||
|
||||
setCabalFooter :: String
|
||||
setCabalFooter = [s|Discussion:
|
||||
Sets the the current Cabal version.|]
|
||||
|
||||
setStackFooter :: String
|
||||
setStackFooter = [s|Discussion:
|
||||
Sets the the current Stack version.|]
|
||||
|
||||
setHLSFooter :: String
|
||||
setHLSFooter = [s|Discussion:
|
||||
Sets the the current haskell-language-server version.|]
|
||||
|
||||
|
||||
setOpts :: Maybe Tool -> Parser SetOptions
|
||||
setOpts tool = SetOptions <$>
|
||||
(fromMaybe SetRecommended <$>
|
||||
optional (setVersionArgument (Just ListInstalled) tool))
|
||||
|
||||
setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
|
||||
setVersionArgument criteria tool =
|
||||
argument (eitherReader setEither)
|
||||
(metavar "VERSION|TAG|next"
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) ["next"])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
setEither s' =
|
||||
parseSet s'
|
||||
<|> second SetToolTag (tagEither s')
|
||||
<|> second SetToolVersion (tVersionEither s')
|
||||
parseSet s' = case fmap toLower s' of
|
||||
"next" -> Right SetNext
|
||||
other -> Left $ "Unknown tag/version " <> other
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
setFooter :: String
|
||||
setFooter = [s|Discussion:
|
||||
Sets the currently active GHC or cabal version. When no command is given,
|
||||
defaults to setting GHC with the specified version/tag (if no tag
|
||||
is given, sets GHC to 'recommended' version).
|
||||
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type SetGHCEffects = '[ FileDoesNotExistError
|
||||
, NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
runSetGHC :: (ReaderT env m (VEither SetGHCEffects a) -> m (VEither SetGHCEffects a))
|
||||
-> Excepts SetGHCEffects (ReaderT env m) a
|
||||
-> m (VEither SetGHCEffects a)
|
||||
runSetGHC runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@SetGHCEffects
|
||||
|
||||
|
||||
type SetCabalEffects = '[ NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
runSetCabal :: (ReaderT env m (VEither SetCabalEffects a) -> m (VEither SetCabalEffects a))
|
||||
-> Excepts SetCabalEffects (ReaderT env m) a
|
||||
-> m (VEither SetCabalEffects a)
|
||||
runSetCabal runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@SetCabalEffects
|
||||
|
||||
|
||||
type SetHLSEffects = '[ NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
runSetHLS :: (ReaderT env m (VEither SetHLSEffects a) -> m (VEither SetHLSEffects a))
|
||||
-> Excepts SetHLSEffects (ReaderT env m) a
|
||||
-> m (VEither SetHLSEffects a)
|
||||
runSetHLS runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@SetHLSEffects
|
||||
|
||||
|
||||
type SetStackEffects = '[ NotInstalled
|
||||
, TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet]
|
||||
|
||||
runSetStack :: (ReaderT env m (VEither SetStackEffects a) -> m (VEither SetStackEffects a))
|
||||
-> Excepts SetStackEffects (ReaderT env m) a
|
||||
-> m (VEither SetStackEffects a)
|
||||
runSetStack runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@SetStackEffects
|
||||
|
||||
|
||||
|
||||
-------------------
|
||||
--[ Entrypoints ]--
|
||||
-------------------
|
||||
|
||||
|
||||
set :: forall m env.
|
||||
( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
)
|
||||
=> Either SetCommand SetOptions
|
||||
-> (forall eff . ReaderT AppState m (VEither eff GHCTargetVersion)
|
||||
-> m (VEither eff GHCTargetVersion))
|
||||
-> (forall eff. ReaderT env m (VEither eff GHCTargetVersion)
|
||||
-> m (VEither eff GHCTargetVersion))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
(Right sopts) -> do
|
||||
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
|
||||
setGHC' sopts
|
||||
(Left (SetGHC sopts)) -> setGHC' sopts
|
||||
(Left (SetCabal sopts)) -> setCabal' sopts
|
||||
(Left (SetHLS sopts)) -> setHLS' sopts
|
||||
(Left (SetStack sopts)) -> setStack' sopts
|
||||
|
||||
where
|
||||
setGHC' :: SetOptions
|
||||
-> m ExitCode
|
||||
setGHC' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
|
||||
_ -> runSetGHC runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly Nothing
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 5
|
||||
|
||||
|
||||
setCabal' :: SetOptions
|
||||
-> m ExitCode
|
||||
setCabal' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v)
|
||||
_ -> runSetCabal runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
|
||||
liftE $ setCabal (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
setHLS' :: SetOptions
|
||||
-> m ExitCode
|
||||
setHLS' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
|
||||
_ -> runSetHLS runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"HLS " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
|
||||
|
||||
setStack' :: SetOptions
|
||||
-> m ExitCode
|
||||
setStack' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v)
|
||||
_ -> runSetStack runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer Stack
|
||||
liftE $ setStack (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
runLogger
|
||||
$ logInfo $
|
||||
"Stack " <> prettyVer _tvVersion <> " successfully set as default version"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
122
app/ghcup/GHCup/OptParse/ToolRequirements.hs
Normal file
122
app/ghcup/GHCup/OptParse/ToolRequirements.hs
Normal file
@@ -0,0 +1,122 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module GHCup.OptParse.ToolRequirements where
|
||||
|
||||
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Platform
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Requirements
|
||||
import System.IO
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data ToolReqOpts = ToolReqOpts
|
||||
{ tlrRaw :: Bool
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
toolReqP :: Parser ToolReqOpts
|
||||
toolReqP =
|
||||
ToolReqOpts
|
||||
<$> switch (short 'r' <> long "raw-format" <> help "machine-parsable format")
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
toolReqFooter :: String
|
||||
toolReqFooter = [s|Discussion:
|
||||
Print tool requirements on the current platform.
|
||||
If you want to pass this to your package manage, use '--raw-format'.|]
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type ToolRequirementsEffects = '[ NoCompatiblePlatform , DistroNotFound , NoToolRequirements ]
|
||||
|
||||
|
||||
runToolRequirements :: (ReaderT env m (VEither ToolRequirementsEffects a) -> m (VEither ToolRequirementsEffects a))
|
||||
-> Excepts ToolRequirementsEffects (ReaderT env m) a
|
||||
-> m (VEither ToolRequirementsEffects a)
|
||||
runToolRequirements runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@ToolRequirementsEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
toolRequirements :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, Alternative m
|
||||
)
|
||||
=> ToolReqOpts
|
||||
-> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements runAppState (do
|
||||
GHCupInfo { .. } <- lift getGHCupInfo
|
||||
platform' <- liftE getPlatform
|
||||
req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
|
||||
if tlrRaw
|
||||
then liftIO $ T.hPutStr stdout (rawRequirements req)
|
||||
else liftIO $ T.hPutStr stdout (prettyRequirements req)
|
||||
)
|
||||
>>= \case
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 12
|
||||
205
app/ghcup/GHCup/OptParse/UnSet.hs
Normal file
205
app/ghcup/GHCup/OptParse/UnSet.hs
Normal file
@@ -0,0 +1,205 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.UnSet where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import GHCup.Types.Optics
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data UnsetCommand = UnsetGHC UnsetOptions
|
||||
| UnsetCabal UnsetOptions
|
||||
| UnsetHLS UnsetOptions
|
||||
| UnsetStack UnsetOptions
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data UnsetOptions = UnsetOptions
|
||||
{ sToolVer :: Maybe T.Text -- target platform triple
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
unsetParser :: Parser UnsetCommand
|
||||
unsetParser =
|
||||
subparser
|
||||
( command
|
||||
"ghc"
|
||||
( UnsetGHC
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset GHC version"
|
||||
<> footerDoc (Just $ text unsetGHCFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"cabal"
|
||||
( UnsetCabal
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset Cabal version"
|
||||
<> footerDoc (Just $ text unsetCabalFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"hls"
|
||||
( UnsetHLS
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset haskell-language-server version"
|
||||
<> footerDoc (Just $ text unsetHLSFooter)
|
||||
)
|
||||
)
|
||||
<> command
|
||||
"stack"
|
||||
( UnsetStack
|
||||
<$> info
|
||||
(unsetOpts <**> helper)
|
||||
( progDesc "Unset stack version"
|
||||
<> footerDoc (Just $ text unsetStackFooter)
|
||||
)
|
||||
)
|
||||
)
|
||||
where
|
||||
unsetGHCFooter :: String
|
||||
unsetGHCFooter = [s|Discussion:
|
||||
Unsets the the current GHC version. That means there won't
|
||||
be a ~/.ghcup/bin/ghc anymore.|]
|
||||
|
||||
unsetCabalFooter :: String
|
||||
unsetCabalFooter = [s|Discussion:
|
||||
Unsets the the current Cabal version.|]
|
||||
|
||||
unsetStackFooter :: String
|
||||
unsetStackFooter = [s|Discussion:
|
||||
Unsets the the current Stack version.|]
|
||||
|
||||
unsetHLSFooter :: String
|
||||
unsetHLSFooter = [s|Discussion:
|
||||
Unsets the the current haskell-language-server version.|]
|
||||
|
||||
|
||||
unsetOpts :: Parser UnsetOptions
|
||||
unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
unsetFooter :: String
|
||||
unsetFooter = [s|Discussion:
|
||||
Unsets the currently active GHC or cabal version.|]
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type UnsetEffects = '[ NotInstalled ]
|
||||
|
||||
|
||||
runUnsetGHC :: (ReaderT env m (VEither UnsetEffects a) -> m (VEither UnsetEffects a))
|
||||
-> Excepts UnsetEffects (ReaderT env m) a
|
||||
-> m (VEither UnsetEffects a)
|
||||
runUnsetGHC runLeanAppState =
|
||||
runLeanAppState
|
||||
. runE
|
||||
@UnsetEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
unset :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
)
|
||||
=> UnsetCommand
|
||||
-> (ReaderT env m (VEither UnsetEffects ())
|
||||
-> m (VEither UnsetEffects ()))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
unset unsetCommand runLeanAppState runLogger = case unsetCommand of
|
||||
(UnsetGHC (UnsetOptions triple)) -> runUnsetGHC runLeanAppState (unsetGHC triple)
|
||||
>>= \case
|
||||
VRight _ -> do
|
||||
runLogger $ logInfo "GHC successfully unset"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 14
|
||||
(UnsetCabal (UnsetOptions _)) -> do
|
||||
void $ runLeanAppState (VRight <$> unsetCabal)
|
||||
runLogger $ logInfo "Cabal successfully unset"
|
||||
pure ExitSuccess
|
||||
(UnsetHLS (UnsetOptions _)) -> do
|
||||
void $ runLeanAppState (VRight <$> unsetHLS)
|
||||
runLogger $ logInfo "HLS successfully unset"
|
||||
pure ExitSuccess
|
||||
(UnsetStack (UnsetOptions _)) -> do
|
||||
void $ runLeanAppState (VRight <$> unsetStack)
|
||||
runLogger $ logInfo "Stack successfully unset"
|
||||
pure ExitSuccess
|
||||
151
app/ghcup/GHCup/OptParse/Upgrade.hs
Normal file
151
app/ghcup/GHCup/OptParse/Upgrade.hs
Normal file
@@ -0,0 +1,151 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Upgrade where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import System.Environment
|
||||
import GHCup.Utils
|
||||
import System.FilePath
|
||||
import GHCup.Types.Optics
|
||||
import Data.Versions hiding (str)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data UpgradeOpts = UpgradeInplace
|
||||
| UpgradeAt FilePath
|
||||
| UpgradeGHCupDir
|
||||
deriving Show
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
upgradeOptsP :: Parser UpgradeOpts
|
||||
upgradeOptsP =
|
||||
flag'
|
||||
UpgradeInplace
|
||||
(short 'i' <> long "inplace" <> help
|
||||
"Upgrade ghcup in-place (wherever it's at)"
|
||||
)
|
||||
<|> ( UpgradeAt
|
||||
<$> option
|
||||
str
|
||||
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help
|
||||
"Absolute filepath to write ghcup into"
|
||||
<> completer (bashCompleter "file")
|
||||
)
|
||||
)
|
||||
<|> pure UpgradeGHCupDir
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type UpgradeEffects = '[ DigestError
|
||||
, GPGError
|
||||
, NoDownload
|
||||
, NoUpdate
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, DownloadFailed
|
||||
]
|
||||
|
||||
|
||||
runUpgrade :: MonadUnliftIO m
|
||||
=> (ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
|
||||
-> Excepts UpgradeEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither UpgradeEffects a)
|
||||
runUpgrade runAppState =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@UpgradeEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
upgrade :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> UpgradeOpts
|
||||
-> Bool
|
||||
-> Dirs
|
||||
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
upgrade uOpts force' Dirs{..} runAppState runLogger = do
|
||||
target <- case uOpts of
|
||||
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
||||
(UpgradeAt p) -> pure $ Just p
|
||||
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
|
||||
|
||||
runUpgrade runAppState (do
|
||||
v' <- liftE $ upgradeGHCup target force'
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (v', dls)
|
||||
) >>= \case
|
||||
VRight (v', dls) -> do
|
||||
let pretty_v = prettyVer v'
|
||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ logInfo $
|
||||
"Successfully upgraded GHCup to version " <> pretty_v
|
||||
forM_ (_viPostInstall vi) $ \msg ->
|
||||
runLogger $ logInfo msg
|
||||
pure ExitSuccess
|
||||
VLeft (V NoUpdate) -> do
|
||||
runLogger $ logWarn "No GHCup update available"
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 11
|
||||
319
app/ghcup/GHCup/OptParse/Whereis.hs
Normal file
319
app/ghcup/GHCup/OptParse/Whereis.hs
Normal file
@@ -0,0 +1,319 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module GHCup.OptParse.Whereis where
|
||||
|
||||
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Errors
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception.Safe (MonadMask)
|
||||
import System.FilePath (takeDirectory)
|
||||
import GHCup.Types.Optics
|
||||
|
||||
|
||||
|
||||
|
||||
----------------
|
||||
--[ Commands ]--
|
||||
----------------
|
||||
|
||||
|
||||
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
|
||||
| WhereisBaseDir
|
||||
| WhereisBinDir
|
||||
| WhereisCacheDir
|
||||
| WhereisLogsDir
|
||||
| WhereisConfDir
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data WhereisOptions = WhereisOptions {
|
||||
directory :: Bool
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
whereisP :: Parser WhereisCommand
|
||||
whereisP = subparser
|
||||
(commandGroup "Tools locations:" <>
|
||||
command
|
||||
"ghc"
|
||||
(WhereisTool GHC <$> info
|
||||
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
|
||||
( progDesc "Get GHC location"
|
||||
<> footerDoc (Just $ text whereisGHCFooter ))
|
||||
)
|
||||
<>
|
||||
command
|
||||
"cabal"
|
||||
(WhereisTool Cabal <$> info
|
||||
( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
|
||||
( progDesc "Get cabal location"
|
||||
<> footerDoc (Just $ text whereisCabalFooter ))
|
||||
)
|
||||
<>
|
||||
command
|
||||
"hls"
|
||||
(WhereisTool HLS <$> info
|
||||
( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
|
||||
( progDesc "Get HLS location"
|
||||
<> footerDoc (Just $ text whereisHLSFooter ))
|
||||
)
|
||||
<>
|
||||
command
|
||||
"stack"
|
||||
(WhereisTool Stack <$> info
|
||||
( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
|
||||
( progDesc "Get stack location"
|
||||
<> footerDoc (Just $ text whereisStackFooter ))
|
||||
)
|
||||
<>
|
||||
command
|
||||
"ghcup"
|
||||
(WhereisTool GHCup <$> info ( pure Nothing <**> helper ) ( progDesc "Get ghcup location" ))
|
||||
) <|> subparser ( commandGroup "Directory locations:"
|
||||
<>
|
||||
command
|
||||
"basedir"
|
||||
(info (pure WhereisBaseDir <**> helper)
|
||||
( progDesc "Get ghcup base directory location" )
|
||||
)
|
||||
<>
|
||||
command
|
||||
"bindir"
|
||||
(info (pure WhereisBinDir <**> helper)
|
||||
( progDesc "Get ghcup binary directory location" )
|
||||
)
|
||||
<>
|
||||
command
|
||||
"cachedir"
|
||||
(info (pure WhereisCacheDir <**> helper)
|
||||
( progDesc "Get ghcup cache directory location" )
|
||||
)
|
||||
<>
|
||||
command
|
||||
"logsdir"
|
||||
(info (pure WhereisLogsDir <**> helper)
|
||||
( progDesc "Get ghcup logs directory location" )
|
||||
)
|
||||
<>
|
||||
command
|
||||
"confdir"
|
||||
(info (pure WhereisConfDir <**> helper)
|
||||
( progDesc "Get ghcup config directory location" )
|
||||
)
|
||||
)
|
||||
where
|
||||
whereisGHCFooter = [s|Discussion:
|
||||
Finds the location of a GHC executable, which usually resides in
|
||||
a self-contained "~/.ghcup/ghc/<ghcver>" directory.
|
||||
|
||||
Examples:
|
||||
# outputs ~/.ghcup/ghc/8.10.5/bin/ghc.exe
|
||||
ghcup whereis ghc 8.10.5
|
||||
# outputs ~/.ghcup/ghc/8.10.5/bin/
|
||||
ghcup whereis --directory ghc 8.10.5 |]
|
||||
|
||||
whereisCabalFooter = [s|Discussion:
|
||||
Finds the location of a Cabal executable, which usually resides in
|
||||
"~/.ghcup/bin/".
|
||||
|
||||
Examples:
|
||||
# outputs ~/.ghcup/bin/cabal-3.4.0.0
|
||||
ghcup whereis cabal 3.4.0.0
|
||||
# outputs ~/.ghcup/bin
|
||||
ghcup whereis --directory cabal 3.4.0.0|]
|
||||
|
||||
whereisHLSFooter = [s|Discussion:
|
||||
Finds the location of a HLS executable, which usually resides in
|
||||
"~/.ghcup/bin/".
|
||||
|
||||
Examples:
|
||||
# outputs ~/.ghcup/bin/haskell-language-server-wrapper-1.2.0
|
||||
ghcup whereis hls 1.2.0
|
||||
# outputs ~/.ghcup/bin/
|
||||
ghcup whereis --directory hls 1.2.0|]
|
||||
|
||||
whereisStackFooter = [s|Discussion:
|
||||
Finds the location of a stack executable, which usually resides in
|
||||
"~/.ghcup/bin/".
|
||||
|
||||
Examples:
|
||||
# outputs ~/.ghcup/bin/stack-2.7.1
|
||||
ghcup whereis stack 2.7.1
|
||||
# outputs ~/.ghcup/bin/
|
||||
ghcup whereis --directory stack 2.7.1|]
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
whereisFooter :: String
|
||||
whereisFooter = [s|Discussion:
|
||||
Finds the location of a tool. For GHC, this is the ghc binary, that
|
||||
usually resides in a self-contained "~/.ghcup/ghc/<ghcver>" directory.
|
||||
For cabal/stack/hls this the binary usually at "~/.ghcup/bin/<tool>-<ver>".
|
||||
|
||||
Examples:
|
||||
# outputs ~/.ghcup/ghc/8.10.5/bin/ghc.exe
|
||||
ghcup whereis ghc 8.10.5
|
||||
# outputs ~/.ghcup/ghc/8.10.5/bin/
|
||||
ghcup whereis --directory ghc 8.10.5
|
||||
# outputs ~/.ghcup/bin/cabal-3.4.0.0
|
||||
ghcup whereis cabal 3.4.0.0
|
||||
# outputs ~/.ghcup/bin/
|
||||
ghcup whereis --directory cabal 3.4.0.0|]
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type WhereisEffects = '[ NotInstalled
|
||||
, NoToolVersionSet
|
||||
, NextVerNotFound
|
||||
, TagNotFound
|
||||
]
|
||||
|
||||
|
||||
runLeanWhereIs :: (MonadUnliftIO m, MonadIO m)
|
||||
=> LeanAppState
|
||||
-> Excepts WhereisEffects (ReaderT LeanAppState m) a
|
||||
-> m (VEither WhereisEffects a)
|
||||
runLeanWhereIs 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
|
||||
@WhereisEffects
|
||||
|
||||
|
||||
runWhereIs :: (MonadUnliftIO m, MonadIO m)
|
||||
=> (ReaderT AppState m (VEither WhereisEffects a) -> m (VEither WhereisEffects a))
|
||||
-> Excepts WhereisEffects (ReaderT AppState m) a
|
||||
-> m (VEither WhereisEffects a)
|
||||
runWhereIs runAppState =
|
||||
runAppState
|
||||
. runE
|
||||
@WhereisEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
whereis :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> WhereisCommand
|
||||
-> WhereisOptions
|
||||
-> (forall a. ReaderT AppState m (VEither WhereisEffects a) -> m (VEither WhereisEffects a))
|
||||
-> LeanAppState
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
|
||||
Dirs{ .. } <- runReaderT getDirs leanAppstate
|
||||
case (whereisCommand, whereisOptions) of
|
||||
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
|
||||
runLeanWhereIs leanAppstate (do
|
||||
loc <- liftE $ whereIsTool tool v
|
||||
if directory
|
||||
then pure $ takeDirectory loc
|
||||
else pure loc
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> do
|
||||
liftIO $ putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
(WhereisTool tool whereVer, WhereisOptions{..}) -> do
|
||||
runWhereIs runAppState (do
|
||||
(v, _) <- liftE $ fromVersion whereVer tool
|
||||
loc <- liftE $ whereIsTool tool v
|
||||
if directory
|
||||
then pure $ takeDirectory loc
|
||||
else pure loc
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> do
|
||||
liftIO $ putStr r
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 30
|
||||
|
||||
(WhereisBaseDir, _) -> do
|
||||
liftIO $ putStr baseDir
|
||||
pure ExitSuccess
|
||||
|
||||
(WhereisBinDir, _) -> do
|
||||
liftIO $ putStr binDir
|
||||
pure ExitSuccess
|
||||
|
||||
(WhereisCacheDir, _) -> do
|
||||
liftIO $ putStr cacheDir
|
||||
pure ExitSuccess
|
||||
|
||||
(WhereisLogsDir, _) -> do
|
||||
liftIO $ putStr logsDir
|
||||
pure ExitSuccess
|
||||
|
||||
(WhereisConfDir, _) -> do
|
||||
liftIO $ putStr confDir
|
||||
pure ExitSuccess
|
||||
2991
app/ghcup/Main.hs
2991
app/ghcup/Main.hs
File diff suppressed because it is too large
Load Diff
@@ -8,7 +8,14 @@ package ghcup
|
||||
tests: True
|
||||
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
|
||||
flags: -system-libarchive
|
||||
@@ -19,6 +26,9 @@ package aeson-pretty
|
||||
package cabal-plan
|
||||
flags: -exe
|
||||
|
||||
package aeson
|
||||
flags: +ordered-keymap
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-8.10.7
|
||||
|
||||
@@ -1,49 +1,50 @@
|
||||
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,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.HsYAML ==0.2.1.0,
|
||||
HsYAML -exe,
|
||||
any.HsYAML-aeson ==0.2.0.0,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==1.5.6.0,
|
||||
aeson -bytestring-builder -cffi -developer -fast,
|
||||
any.aeson-pretty ==0.8.8,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.3.0,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.9,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
any.alex ==3.2.7.1,
|
||||
any.ansi-terminal ==0.11.1,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
any.array ==0.5.4.0,
|
||||
any.assoc ==1.0.2,
|
||||
any.async ==2.2.3,
|
||||
any.async ==2.2.4,
|
||||
async -bench,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.14.3.0,
|
||||
any.base-compat ==0.12.0,
|
||||
any.base-compat-batteries ==0.12.0,
|
||||
any.base-orphans ==0.8.5,
|
||||
any.base16-bytestring ==1.0.1.0,
|
||||
any.base64-bytestring ==1.1.0.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.blaze-builder ==0.4.2.1,
|
||||
any.brick ==0.64.1,
|
||||
any.blaze-builder ==0.4.2.2,
|
||||
any.brick ==0.64.2,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.0,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.0,
|
||||
any.cabal-plan ==0.7.2.1,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
@@ -51,7 +52,7 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.2,
|
||||
any.clock ==0.8.3,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
@@ -65,10 +66,10 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
any.cryptohash-sha1 ==0.11.100.1,
|
||||
any.cryptohash-sha256 ==0.11.102.0,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha256 ==0.11.102.1,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
any.data-clist ==0.2,
|
||||
any.data-fix ==0.3.2,
|
||||
any.deepseq ==1.4.4.0,
|
||||
any.directory ==1.3.6.0,
|
||||
@@ -80,28 +81,35 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
any.exceptions ==0.10.4,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.7,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.fusion-plugin-types ==0.1.0,
|
||||
any.generic-arbitrary ==0.2.0,
|
||||
any.ghc ==8.10.7,
|
||||
any.ghc-boot ==8.10.7,
|
||||
any.ghc-boot-th ==8.10.7,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-heap ==8.10.7,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.ghci ==8.10.7,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.3.0,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.hsc2hs ==0.68.7,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.heaps ==0.4,
|
||||
any.hpc ==0.6.1.0,
|
||||
any.hsc2hs ==0.68.8,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.7.10,
|
||||
any.hspec-core ==2.7.10,
|
||||
any.hspec-discover ==2.7.10,
|
||||
any.hspec ==2.9.4,
|
||||
any.hspec-core ==2.9.4,
|
||||
any.hspec-discover ==2.9.4,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.6.0,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.1,
|
||||
any.indexed-traversable-instances ==0.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.integer-gmp ==1.0.3.0,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
@@ -109,16 +117,20 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.0.1,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.3.0,
|
||||
libarchive -cross -low-memory -system-libarchive,
|
||||
any.libarchive ==3.0.3.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
any.libyaml-streamly ==0.2.1,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
any.lockfree-queue ==0.2.3.1,
|
||||
any.lzma-static ==5.2.5.4,
|
||||
any.megaparsec ==9.0.1,
|
||||
any.megaparsec ==9.2.0,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.1,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.monad-control ==1.0.3.1,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
@@ -127,9 +139,9 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4,
|
||||
any.optics-th ==0.4,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
any.optparse-applicative ==0.17.0.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2,
|
||||
any.os-release ==1.0.2.1,
|
||||
os-release -devel,
|
||||
any.parallel ==3.2.2.0,
|
||||
any.parsec ==3.1.14.0,
|
||||
@@ -138,47 +150,56 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
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.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1,
|
||||
any.recursion-schemes ==5.2.2.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
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,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.4.3,
|
||||
any.retry ==0.8.1.2,
|
||||
retry -lib-werror,
|
||||
any.rts ==1.0.1,
|
||||
any.safe ==0.3.19,
|
||||
any.safe-exceptions ==0.1.7.2,
|
||||
any.scientific ==0.3.7.0,
|
||||
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,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
any.splitmix ==0.1.0.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.1,
|
||||
any.streamly ==0.8.2,
|
||||
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
|
||||
any.strict ==0.4.0.1,
|
||||
strict +assoc,
|
||||
any.strict-base ==0.4.0.0,
|
||||
any.tagged ==0.8.6.1,
|
||||
tagged +deepseq +transformers,
|
||||
any.tagsoup ==0.14.8,
|
||||
any.template-haskell ==2.16.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.18,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
@@ -187,14 +208,16 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
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,
|
||||
any.unicode-data ==0.3.0,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.3,
|
||||
any.unix-compat ==0.5.3,
|
||||
any.unix-bytestring ==0.3.7.6,
|
||||
any.unix-compat ==0.5.4,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
any.unordered-containers ==0.2.17.0,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
@@ -202,12 +225,15 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.versions ==5.0.0,
|
||||
any.versions ==5.0.3,
|
||||
any.vty ==5.33,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
any.xor ==0.0.1.0,
|
||||
any.xor ==0.0.1.1,
|
||||
any.yaml-streamly ==0.12.1,
|
||||
yaml-streamly +no-examples +no-exe,
|
||||
any.zlib ==0.6.2.3,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-10-01T15:16:26Z
|
||||
index-state: hackage.haskell.org 2022-03-15T16:43:02Z
|
||||
|
||||
@@ -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
34
cabal.ghc902.project
Normal 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
|
||||
@@ -1,49 +1,50 @@
|
||||
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,
|
||||
any.HUnit ==1.6.2.0,
|
||||
any.HsOpenSSL ==0.11.7.2,
|
||||
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
|
||||
any.HsYAML ==0.2.1.0,
|
||||
HsYAML -exe,
|
||||
any.HsYAML-aeson ==0.2.0.0,
|
||||
any.OneTuple ==0.3.1,
|
||||
any.QuickCheck ==2.14.2,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.StateVar ==1.2.2,
|
||||
any.aeson ==1.5.6.0,
|
||||
aeson -bytestring-builder -cffi -developer -fast,
|
||||
any.aeson-pretty ==0.8.8,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.3.0,
|
||||
aeson -cffi +ordered-keymap,
|
||||
any.aeson-pretty ==0.8.9,
|
||||
aeson-pretty +lib-only,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
any.alex ==3.2.7.1,
|
||||
any.ansi-terminal ==0.11.1,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
any.array ==0.5.4.0,
|
||||
any.assoc ==1.0.2,
|
||||
any.async ==2.2.3,
|
||||
any.async ==2.2.4,
|
||||
async -bench,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
any.atomic-primops ==0.8.4,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.14.4,
|
||||
attoparsec -developer,
|
||||
any.base ==4.15.0.0,
|
||||
any.base-compat ==0.12.0,
|
||||
any.base-compat-batteries ==0.12.0,
|
||||
any.base-orphans ==0.8.5,
|
||||
any.base16-bytestring ==1.0.1.0,
|
||||
any.base64-bytestring ==1.1.0.0,
|
||||
any.base ==4.15.1.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base64-bytestring ==1.2.1.0,
|
||||
any.bifunctors ==5.5.11,
|
||||
bifunctors +semigroups +tagged,
|
||||
any.binary ==0.8.8.0,
|
||||
any.blaze-builder ==0.4.2.1,
|
||||
any.brick ==0.64.1,
|
||||
any.blaze-builder ==0.4.2.2,
|
||||
any.brick ==0.64.2,
|
||||
brick -demos,
|
||||
any.bytestring ==0.10.12.1,
|
||||
any.bz2 ==1.0.1.0,
|
||||
bz2 -cross +with-bzlib,
|
||||
any.c2hs ==0.28.8,
|
||||
c2hs +base3 -regression,
|
||||
any.cabal-plan ==0.7.2.0,
|
||||
any.cabal-plan ==0.7.2.1,
|
||||
cabal-plan -_ -exe -license-report,
|
||||
any.call-stack ==0.4.0,
|
||||
any.case-insensitive ==1.2.1.0,
|
||||
@@ -51,7 +52,7 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.2,
|
||||
any.clock ==0.8.3,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
@@ -65,13 +66,13 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
any.cryptohash-sha1 ==0.11.100.1,
|
||||
any.cryptohash-sha256 ==0.11.102.0,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha256 ==0.11.102.1,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
any.data-clist ==0.2,
|
||||
any.data-fix ==0.3.2,
|
||||
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.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
@@ -80,45 +81,56 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
any.exceptions ==0.10.4,
|
||||
any.filepath ==1.4.2.1,
|
||||
any.free ==5.1.7,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.ghc-bignum ==1.0,
|
||||
any.ghc-boot-th ==9.0.1,
|
||||
any.fusion-plugin-types ==0.1.0,
|
||||
any.generic-arbitrary ==0.2.0,
|
||||
any.ghc ==9.0.2,
|
||||
any.ghc-bignum ==1.1,
|
||||
any.ghc-boot ==9.0.2,
|
||||
any.ghc-boot-th ==9.0.2,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-heap ==9.0.2,
|
||||
any.ghc-prim ==0.7.0,
|
||||
any.ghci ==9.0.2,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.3.3.0,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.1,
|
||||
any.hsc2hs ==0.68.7,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
any.heaps ==0.4,
|
||||
any.hpc ==0.6.1.0,
|
||||
any.hsc2hs ==0.68.8,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.7.10,
|
||||
any.hspec-core ==2.7.10,
|
||||
any.hspec-discover ==2.7.10,
|
||||
any.hspec ==2.9.4,
|
||||
any.hspec-core ==2.9.4,
|
||||
any.hspec-discover ==2.9.4,
|
||||
any.hspec-expectations ==0.8.2,
|
||||
any.hspec-golden-aeson ==0.9.0.0,
|
||||
any.http-io-streams ==0.1.6.0,
|
||||
http-io-streams -brotli +fast-xor,
|
||||
any.indexed-profunctors ==0.1.1,
|
||||
any.indexed-traversable ==0.1.1,
|
||||
any.indexed-traversable-instances ==0.1,
|
||||
any.indexed-traversable ==0.1.2,
|
||||
any.indexed-traversable-instances ==0.1.1,
|
||||
any.integer-logarithms ==1.0.3.1,
|
||||
integer-logarithms -check-bounds +integer-gmp,
|
||||
any.io-streams ==1.5.2.1,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.0.1,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.3.0,
|
||||
libarchive -cross -low-memory -system-libarchive,
|
||||
any.libarchive ==3.0.3.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
any.libyaml-streamly ==0.2.1,
|
||||
libyaml-streamly -no-unicode -system-libyaml,
|
||||
any.lockfree-queue ==0.2.3.1,
|
||||
any.lzma-static ==5.2.5.4,
|
||||
any.megaparsec ==9.0.1,
|
||||
any.megaparsec ==9.2.0,
|
||||
megaparsec -dev,
|
||||
any.microlens ==0.4.12.0,
|
||||
any.microlens-mtl ==0.2.0.1,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.monad-control ==1.0.3.1,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
@@ -127,9 +139,9 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
optics-core -explicit-generic-labels,
|
||||
any.optics-extra ==0.4,
|
||||
any.optics-th ==0.4,
|
||||
any.optparse-applicative ==0.16.1.0,
|
||||
any.optparse-applicative ==0.17.0.0,
|
||||
optparse-applicative +process,
|
||||
any.os-release ==1.0.2,
|
||||
any.os-release ==1.0.2.1,
|
||||
os-release -devel,
|
||||
any.parallel ==3.2.2.0,
|
||||
any.parsec ==3.1.14.0,
|
||||
@@ -138,47 +150,56 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
any.polyparse ==1.13,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.2.0,
|
||||
any.process ==1.6.11.0,
|
||||
any.primitive ==0.7.3.0,
|
||||
any.process ==1.6.13.2,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1,
|
||||
any.recursion-schemes ==5.2.2.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
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,
|
||||
regex-posix -_regex-posix-clib,
|
||||
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-exceptions ==0.1.7.2,
|
||||
any.scientific ==0.3.7.0,
|
||||
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,
|
||||
any.setenv ==0.1.1.3,
|
||||
any.split ==0.2.3.4,
|
||||
any.splitmix ==0.1.0.3,
|
||||
any.splitmix ==0.1.0.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.0,
|
||||
any.streamly ==0.8.2,
|
||||
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
|
||||
any.strict ==0.4.0.1,
|
||||
strict +assoc,
|
||||
any.strict-base ==0.4.0.0,
|
||||
any.tagged ==0.8.6.1,
|
||||
tagged +deepseq +transformers,
|
||||
any.tagsoup ==0.14.8,
|
||||
any.template-haskell ==2.17.0.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.terminfo ==0.4.1.5,
|
||||
any.text ==1.2.5.0,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.18,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
@@ -187,14 +208,16 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
any.transformers ==0.5.6.2,
|
||||
any.transformers-base ==0.4.6,
|
||||
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,
|
||||
any.unicode-data ==0.3.0,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.3,
|
||||
any.unix-compat ==0.5.3,
|
||||
any.unix-bytestring ==0.3.7.6,
|
||||
any.unix-compat ==0.5.4,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.14.0,
|
||||
any.unordered-containers ==0.2.17.0,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
@@ -202,12 +225,15 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.versions ==5.0.0,
|
||||
any.versions ==5.0.3,
|
||||
any.vty ==5.33,
|
||||
any.witherable ==0.4.2,
|
||||
any.word-wrap ==0.5,
|
||||
any.word8 ==0.1.3,
|
||||
any.xor ==0.0.1.0,
|
||||
any.xor ==0.0.1.1,
|
||||
any.yaml-streamly ==0.12.1,
|
||||
yaml-streamly +no-examples +no-exe,
|
||||
any.zlib ==0.6.2.3,
|
||||
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
|
||||
any.zlib-bindings ==0.1.1.5
|
||||
index-state: hackage.haskell.org 2021-10-01T15:16:26Z
|
||||
index-state: hackage.haskell.org 2022-03-15T16:43:02Z
|
||||
@@ -8,20 +8,15 @@ 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.4.0.0 || ==3.6.2.0,
|
||||
any.Cabal ==3.6.2.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
|
||||
flags: -system-libarchive
|
||||
|
||||
|
||||
@@ -36,6 +36,10 @@ key-bindings:
|
||||
show-all-tools:
|
||||
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
|
||||
# check the 'URLSource' type in the code.
|
||||
url-source:
|
||||
@@ -44,12 +48,16 @@ url-source:
|
||||
|
||||
## Example 1: Read download info from this location instead
|
||||
## Accepts file/http/https scheme
|
||||
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
|
||||
## which case they are merged right-biased (overwriting duplicate versions).
|
||||
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
|
||||
|
||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
|
||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
|
||||
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
|
||||
# AddSource:
|
||||
# Left:
|
||||
# toolRequirements: {} # this is ignored
|
||||
# globalTools: {}
|
||||
# toolRequirements: {}
|
||||
# ghcupDownloads:
|
||||
# GHC:
|
||||
# 9.10.2:
|
||||
@@ -62,6 +70,8 @@ url-source:
|
||||
# dlSubdir: ghc-7.10.3
|
||||
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
|
||||
|
||||
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
|
||||
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
|
||||
## versions).
|
||||
# AddSource:
|
||||
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
||||
|
||||
1
data/metadata
Submodule
1
data/metadata
Submodule
Submodule data/metadata added at 6fae2f7bc2
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
@@ -1,5 +1,8 @@
|
||||
:root {
|
||||
--theme-purple: #5E5184;
|
||||
--theme-purple-dark: rgba(69, 59, 97, 0.5);
|
||||
--ukraine-top: #0057B8;
|
||||
--ukraine-bottom: #FFD700;
|
||||
--link-pink: #9E358F;
|
||||
}
|
||||
|
||||
@@ -108,12 +111,12 @@ body.homepage>div.container div.col-md-9 {
|
||||
|
||||
.bg-primary {
|
||||
background-image: none;
|
||||
background-color: var(--theme-purple) !important;
|
||||
background-color: var(--ukraine-top) !important;
|
||||
}
|
||||
|
||||
body .bg-primary {
|
||||
background-image: none;
|
||||
background-color: var(--theme-purple);
|
||||
background-color: var(--ukraine-top);
|
||||
border: 0px;
|
||||
}
|
||||
|
||||
@@ -125,8 +128,8 @@ body .btn-primary {
|
||||
|
||||
.navbar.fixed-top {
|
||||
background-image: none;
|
||||
background-color: var(--theme-purple);
|
||||
border-bottom: 5px solid rgba(69, 59, 97, 0.5);
|
||||
background-color: var(--ukraine-top);
|
||||
border-bottom: 40px solid var(--ukraine-bottom);
|
||||
padding: 0px;
|
||||
}
|
||||
|
||||
|
||||
36
docs/dev.md
36
docs/dev.md
@@ -12,8 +12,7 @@ organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
|
||||
Anything dealing with ghcup specific directories is in
|
||||
`GHCup.Utils.Dirs`.
|
||||
|
||||
Download information on where to fetch bindists from is in the appropriate
|
||||
yaml files: `data/metadata/ghcup-<yaml-ver>.yaml`.
|
||||
Download information on where to fetch bindists from is in the [ghcup-metadata](https://github.com/haskell/ghcup-metadata) repository.
|
||||
|
||||
## Design decisions
|
||||
|
||||
@@ -66,18 +65,14 @@ Some light suggestions:
|
||||
|
||||
### Adding a new GHC version
|
||||
|
||||
1. open the latest `data/metadata/ghcup-<yaml-ver>.yaml`
|
||||
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'`
|
||||
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)
|
||||
|
||||
### 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)
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
introducing a non-unix way of handling processes via the `process` library. It also introduced considerable
|
||||
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
|
||||
|
||||
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`.
|
||||
|
||||
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.
|
||||
|
||||
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
|
||||
|
||||
|
||||
163
docs/guide.md
163
docs/guide.md
@@ -32,6 +32,17 @@ ghcup install cabal
|
||||
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
|
||||
|
||||
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
|
||||
(`/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 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
|
||||
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
|
||||
|
||||
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.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/)
|
||||
|
||||
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
|
||||
```
|
||||
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.
|
||||
|
||||
## GPG verification
|
||||
|
||||
@@ -260,48 +259,14 @@ You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
|
||||
|
||||
## 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
|
||||
is the one defined in `cabal.project`. With some simple shell functions, we can start our editor with the appropriate
|
||||
path prepended.
|
||||
|
||||
For bash, in e.g. `~/.bashrc` define:
|
||||
If you don't want to explicitly switch the active GHC all the time and are using
|
||||
tools that rely on the plain `ghc` binary, GHCup provides an easy way to execute
|
||||
commands with a certain toolchain prepended to PATH, e.g.:
|
||||
|
||||
```sh
|
||||
with_ghc() {
|
||||
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
|
||||
}
|
||||
ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- code Setup.hs
|
||||
```
|
||||
|
||||
For fish shell, in e.g. `~/.config/fish/config.fish` define:
|
||||
|
||||
```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.
|
||||
|
||||
This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
|
||||
|
||||
111
docs/install.md
111
docs/install.md
@@ -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.
|
||||
|
||||
### 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
|
||||
|
||||
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
|
||||
2. To properly learn Haskell, run through the [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises
|
||||
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 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)
|
||||
|
||||
## Uninstallation
|
||||
@@ -40,10 +50,90 @@ 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**:
|
||||
|
||||
1. [GHC](https://www.haskell.org/ghc/)
|
||||
2. [cabal-install](https://cabal.readthedocs.io/en/latest/)
|
||||
3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/latest/)
|
||||
4. [stack](https://docs.haskellstack.org/en/latest/README/)
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>
|
||||
|
||||
<table>
|
||||
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
|
||||
<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
|
||||
<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
|
||||
<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
|
||||
<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
|
||||
<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
|
||||
<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
|
||||
<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
|
||||
<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
|
||||
<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
|
||||
<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
|
||||
<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
|
||||
<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
|
||||
<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
|
||||
<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
|
||||
<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
|
||||
<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
|
||||
<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
|
||||
</details>
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
|
||||
<table>
|
||||
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>2.4.1.0</td><td></td></tr>
|
||||
<tr><td>3.0.0.0</td><td></td></tr>
|
||||
<tr><td>3.2.0.0</td><td></td></tr>
|
||||
<tr><td>3.4.0.0</td><td></td></tr>
|
||||
<tr><td>3.4.1.0</td><td></td></tr>
|
||||
<tr><td>3.6.0.0</td><td></td></tr>
|
||||
<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
|
||||
</details>
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
|
||||
<table>
|
||||
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>1.1.0</td><td></td></tr>
|
||||
<tr><td>1.2.0</td><td></td></tr>
|
||||
<tr><td>1.3.0</td><td></td></tr>
|
||||
<tr><td>1.4.0</td><td></td></tr>
|
||||
<tr><td>1.5.0</td><td></td></tr>
|
||||
<tr><td>1.5.1</td><td></td></tr>
|
||||
<tr><td>1.6.0.0</td><td></td></tr>
|
||||
<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
</details>
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
|
||||
<table>
|
||||
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>2.5.1</td><td></td></tr>
|
||||
<tr><td>2.7.1</td><td></td></tr>
|
||||
<tr><td>2.7.3</td><td></td></tr>
|
||||
<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
</details>
|
||||
|
||||
## Supported platforms
|
||||
|
||||
@@ -78,14 +168,15 @@ May or may not work, several issues:
|
||||
|
||||
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.
|
||||
|
||||
### 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
|
||||
|
||||
@@ -94,7 +185,7 @@ HLS bindists are experimental.
|
||||
|
||||
### 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
|
||||
|
||||
|
||||
@@ -4,363 +4,638 @@
|
||||
<!-- Generated by graphviz version 2.44.0 (0)
|
||||
-->
|
||||
<!-- Title: G Pages: 1 -->
|
||||
<svg width="719pt" 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">
|
||||
<g id="graph0" class="graph" transform="scale(0.81 0.81) rotate(0) translate(4 794.2)">
|
||||
<svg width="720pt" height="648pt"
|
||||
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.45 0.45) rotate(0) translate(4 1421.5)">
|
||||
<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">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="439" y="-645.17" font-family="Times-Roman" font-size="14.00">GHCup</text>
|
||||
<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="787.5" y="-1330.86" font-family="Times-Roman" font-size="14.00">GHCup</text>
|
||||
</g>
|
||||
<g id="clust2" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="320" y="-526.52" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
<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="1232" y="-808.02" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
</g>
|
||||
<g id="clust3" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="361.5" y="-340.73" font-family="Times-Roman" font-size="14.00">Types</text>
|
||||
<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="787.5" y="-1280.52" font-family="Times-Roman" font-size="14.00">OptParse</text>
|
||||
</g>
|
||||
<g id="clust4" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="714" y="-561.22" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
<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="1286.5" y="-501.14" font-family="Times-Roman" font-size="14.00">Types</text>
|
||||
</g>
|
||||
<g id="clust5" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="699" y="-433.62" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
<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="834" y="-686.24" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
</g>
|
||||
<g id="clust6" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="618" y="-95.61" font-family="Times-Roman" font-size="14.00">String</text>
|
||||
<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="803" y="-635.91" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
</g>
|
||||
<g id="clust7" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="747" y="-526.52" font-family="Times-Roman" font-size="14.00">Version</text>
|
||||
<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="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>
|
||||
<!-- u1 -->
|
||||
<g id="node1" class="node">
|
||||
<title>u1</title>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="387" cy="-486.95" rx="55.49" ry="18"/>
|
||||
<text text-anchor="middle" x="387" y="-483.25" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1165" cy="-743.99" rx="55.49" ry="18"/>
|
||||
<text text-anchor="middle" x="1165" y="-740.29" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
</g>
|
||||
<!-- u12 -->
|
||||
<g id="node7" class="node">
|
||||
<g id="node24" class="node">
|
||||
<title>u12</title>
|
||||
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="688" cy="-393.95" rx="27" ry="18"/>
|
||||
<text text-anchor="middle" x="688" y="-390.25" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
<ellipse fill="#ffbbff" stroke="black" stroke-width="2" cx="825" cy="-571.99" rx="27" ry="18"/>
|
||||
<text text-anchor="middle" x="825" y="-568.29" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
</g>
|
||||
<!-- u1->u12 -->
|
||||
<g id="edge15" class="edge">
|
||||
<g id="edge13" class="edge">
|
||||
<title>u1->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"/>
|
||||
<polygon fill="black" stroke="black" points="680.34,-422.15 681.79,-411.65 674.11,-418.95 680.34,-422.15"/>
|
||||
<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="832.71,-599.01 827.23,-589.94 825.86,-600.45 832.71,-599.01"/>
|
||||
</g>
|
||||
<!-- u11 -->
|
||||
<g id="node15" class="node">
|
||||
<g id="node32" class="node">
|
||||
<title>u11</title>
|
||||
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="603" cy="-393.95" rx="28.7" ry="18"/>
|
||||
<text text-anchor="middle" x="603" y="-390.25" font-family="Times-Roman" font-size="14.00">Dirs</text>
|
||||
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1045" cy="-571.99" rx="28.7" ry="18"/>
|
||||
<text text-anchor="middle" x="1045" y="-568.29" font-family="Times-Roman" font-size="14.00">Dirs</text>
|
||||
</g>
|
||||
<!-- u1->u11 -->
|
||||
<g id="edge14" class="edge">
|
||||
<g id="edge12" class="edge">
|
||||
<title>u1->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"/>
|
||||
<polygon fill="black" stroke="black" points="571.98,-411.76 579.85,-404.66 569.27,-405.3 571.98,-411.76"/>
|
||||
<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="1063.78,-595.29 1055.36,-588.87 1057.94,-599.14 1063.78,-595.29"/>
|
||||
</g>
|
||||
<!-- u13 -->
|
||||
<g id="node18" class="node">
|
||||
<g id="node35" class="node">
|
||||
<title>u13</title>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-300.95" rx="44.39" ry="18"/>
|
||||
<text text-anchor="middle" x="109" y="-297.25" font-family="Times-Roman" font-size="14.00">Version</text>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1414" cy="-571.99" rx="44.39" ry="18"/>
|
||||
<text text-anchor="middle" x="1414" y="-568.29" font-family="Times-Roman" font-size="14.00">Version</text>
|
||||
</g>
|
||||
<!-- u1->u13 -->
|
||||
<g id="edge13" class="edge">
|
||||
<g id="edge11" class="edge">
|
||||
<title>u1->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"/>
|
||||
<polygon fill="black" stroke="black" points="75.07,-323.61 81.77,-315.4 71.41,-317.64 75.07,-323.61"/>
|
||||
<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="1406.35,-600.37 1407.35,-589.82 1399.99,-597.45 1406.35,-600.37"/>
|
||||
</g>
|
||||
<!-- u17 -->
|
||||
<g id="node2" class="node">
|
||||
<title>u17</title>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="332" cy="-393.95" rx="30.59" ry="18"/>
|
||||
<text text-anchor="middle" x="332" y="-390.25" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1267" cy="-571.99" rx="30.59" ry="18"/>
|
||||
<text text-anchor="middle" x="1267" y="-568.29" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
</g>
|
||||
<!-- u5 -->
|
||||
<g id="node6" class="node">
|
||||
<g id="node23" class="node">
|
||||
<title>u5</title>
|
||||
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="410" cy="-300.95" rx="33.6" ry="18"/>
|
||||
<text text-anchor="middle" x="410" y="-297.25" font-family="Times-Roman" font-size="14.00">JSON</text>
|
||||
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1238" cy="-436.99" rx="33.6" ry="18"/>
|
||||
<text text-anchor="middle" x="1238" y="-433.29" font-family="Times-Roman" font-size="14.00">JSON</text>
|
||||
</g>
|
||||
<!-- u17->u5 -->
|
||||
<g id="edge16" class="edge">
|
||||
<g id="edge14" class="edge">
|
||||
<title>u17->u5</title>
|
||||
<path fill="none" stroke="black" d="M345.23,-377.52C357.37,-363.35 375.54,-342.16 389.55,-325.81"/>
|
||||
<polygon fill="black" stroke="black" points="392.59,-327.64 396.44,-317.77 387.28,-323.09 392.59,-327.64"/>
|
||||
<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="1247.27,-464.06 1241.72,-455.04 1240.43,-465.56 1247.27,-464.06"/>
|
||||
</g>
|
||||
<!-- u19 -->
|
||||
<g id="node3" class="node">
|
||||
<title>u19</title>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="256" cy="-486.95" rx="57.69" ry="18"/>
|
||||
<text text-anchor="middle" x="256" y="-483.25" font-family="Times-Roman" font-size="14.00">IOStreams</text>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1296" cy="-743.99" rx="57.69" ry="18"/>
|
||||
<text text-anchor="middle" x="1296" y="-740.29" font-family="Times-Roman" font-size="14.00">IOStreams</text>
|
||||
</g>
|
||||
<!-- u19->u17 -->
|
||||
<g id="edge17" class="edge">
|
||||
<g id="edge15" class="edge">
|
||||
<title>u19->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"/>
|
||||
<polygon fill="black" stroke="black" points="318.21,-421.09 321.16,-410.91 312.51,-417.03 318.21,-421.09"/>
|
||||
</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->u3 -->
|
||||
<g id="edge18" class="edge">
|
||||
<title>u4->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->u6 -->
|
||||
<g id="edge19" class="edge">
|
||||
<title>u5->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->u7 -->
|
||||
<g id="edge20" class="edge">
|
||||
<title>u5->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->u9 -->
|
||||
<g id="edge30" class="edge">
|
||||
<title>u12->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->u7 -->
|
||||
<g id="edge31" class="edge">
|
||||
<title>u9->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->u12 -->
|
||||
<g id="edge22" class="edge">
|
||||
<title>u15->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->u11 -->
|
||||
<g id="edge21" class="edge">
|
||||
<title>u15->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->u3 -->
|
||||
<g id="edge23" class="edge">
|
||||
<title>u6->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->u8 -->
|
||||
<g id="edge25" class="edge">
|
||||
<title>u7->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->u2 -->
|
||||
<g id="edge24" class="edge">
|
||||
<title>u7->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->u4 -->
|
||||
<g id="edge26" class="edge">
|
||||
<title>u8->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->u9 -->
|
||||
<g id="edge27" class="edge">
|
||||
<title>u8->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->u10 -->
|
||||
<g id="edge28" class="edge">
|
||||
<title>u8->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->u5 -->
|
||||
<g id="edge29" class="edge">
|
||||
<title>u11->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->u1 -->
|
||||
<g id="edge4" class="edge">
|
||||
<title>u0->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->u16 -->
|
||||
<g id="edge6" class="edge">
|
||||
<title>u0->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->u15 -->
|
||||
<g id="edge5" class="edge">
|
||||
<title>u0->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->u14 -->
|
||||
<g id="edge3" class="edge">
|
||||
<title>u0->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->u3 -->
|
||||
<g id="edge7" class="edge">
|
||||
<title>u2->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->u3 -->
|
||||
<g id="edge8" class="edge">
|
||||
<title>u13->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->u5 -->
|
||||
<g id="edge9" class="edge">
|
||||
<title>u14->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->u12 -->
|
||||
<g id="edge10" class="edge">
|
||||
<title>u14->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->u5 -->
|
||||
<g id="edge12" class="edge">
|
||||
<title>u18->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->u13 -->
|
||||
<g id="edge11" class="edge">
|
||||
<title>u18->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>
|
||||
<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="1275.04,-599.29 1269.9,-590.02 1268.14,-600.46 1275.04,-599.29"/>
|
||||
</g>
|
||||
<!-- u21 -->
|
||||
<g id="node22" class="node">
|
||||
<g id="node4" class="node">
|
||||
<title>u21</title>
|
||||
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-689.95" rx="46.29" ry="18"/>
|
||||
<text text-anchor="middle" x="627" y="-686.25" font-family="Times-Roman" font-size="14.00">Validate</text>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="742" cy="-1215.99" rx="51.99" ry="18"/>
|
||||
<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->u23 -->
|
||||
<g id="edge16" class="edge">
|
||||
<title>u21->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->u24 -->
|
||||
<g id="edge17" class="edge">
|
||||
<title>u21->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->u25 -->
|
||||
<g id="edge18" class="edge">
|
||||
<title>u21->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->u26 -->
|
||||
<g id="edge19" class="edge">
|
||||
<title>u21->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->u27 -->
|
||||
<g id="edge20" class="edge">
|
||||
<title>u21->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->u28 -->
|
||||
<g id="edge21" class="edge">
|
||||
<title>u21->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->u29 -->
|
||||
<g id="edge22" class="edge">
|
||||
<title>u21->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->u30 -->
|
||||
<g id="edge23" class="edge">
|
||||
<title>u21->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->u31 -->
|
||||
<g id="edge24" class="edge">
|
||||
<title>u21->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->u32 -->
|
||||
<g id="edge25" class="edge">
|
||||
<title>u21->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->u33 -->
|
||||
<g id="edge26" class="edge">
|
||||
<title>u21->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->u34 -->
|
||||
<g id="edge27" class="edge">
|
||||
<title>u21->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->u35 -->
|
||||
<g id="edge28" class="edge">
|
||||
<title>u21->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->u36 -->
|
||||
<g id="edge29" class="edge">
|
||||
<title>u21->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->u37 -->
|
||||
<g id="edge30" class="edge">
|
||||
<title>u21->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->u0 -->
|
||||
<g id="edge31" class="edge">
|
||||
<title>u22->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->u22 -->
|
||||
<g id="edge32" class="edge">
|
||||
<title>u23->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->u22 -->
|
||||
<g id="edge33" class="edge">
|
||||
<title>u24->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->u0 -->
|
||||
<g id="edge34" class="edge">
|
||||
<title>u25->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->u22 -->
|
||||
<g id="edge35" class="edge">
|
||||
<title>u26->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->u22 -->
|
||||
<g id="edge36" class="edge">
|
||||
<title>u27->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->u15 -->
|
||||
<g id="edge37" class="edge">
|
||||
<title>u28->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->u22 -->
|
||||
<g id="edge38" class="edge">
|
||||
<title>u29->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->u22 -->
|
||||
<g id="edge39" class="edge">
|
||||
<title>u30->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->u0 -->
|
||||
<g id="edge40" class="edge">
|
||||
<title>u31->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->u22 -->
|
||||
<g id="edge41" class="edge">
|
||||
<title>u32->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->u22 -->
|
||||
<g id="edge42" class="edge">
|
||||
<title>u33->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->u0 -->
|
||||
<g id="edge43" class="edge">
|
||||
<title>u34->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->u0 -->
|
||||
<g id="edge44" class="edge">
|
||||
<title>u35->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->u14 -->
|
||||
<g id="edge45" class="edge">
|
||||
<title>u36->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->u18 -->
|
||||
<g id="edge46" class="edge">
|
||||
<title>u36->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->u0 -->
|
||||
<g id="edge47" class="edge">
|
||||
<title>u37->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->u3 -->
|
||||
<g id="edge48" class="edge">
|
||||
<title>u4->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->u6 -->
|
||||
<g id="edge49" class="edge">
|
||||
<title>u5->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->u7 -->
|
||||
<g id="edge50" class="edge">
|
||||
<title>u5->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->u9 -->
|
||||
<g id="edge59" class="edge">
|
||||
<title>u12->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->u7 -->
|
||||
<g id="edge60" class="edge">
|
||||
<title>u9->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->u1 -->
|
||||
<g id="edge51" class="edge">
|
||||
<title>u15->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->u3 -->
|
||||
<g id="edge52" class="edge">
|
||||
<title>u6->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->u8 -->
|
||||
<g id="edge54" class="edge">
|
||||
<title>u7->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->u2 -->
|
||||
<g id="edge53" class="edge">
|
||||
<title>u7->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->u4 -->
|
||||
<g id="edge55" class="edge">
|
||||
<title>u8->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->u9 -->
|
||||
<g id="edge56" class="edge">
|
||||
<title>u8->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->u10 -->
|
||||
<g id="edge57" class="edge">
|
||||
<title>u8->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->u5 -->
|
||||
<g id="edge58" class="edge">
|
||||
<title>u11->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->u16 -->
|
||||
<g id="edge4" class="edge">
|
||||
<title>u0->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->u15 -->
|
||||
<g id="edge3" class="edge">
|
||||
<title>u0->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->u14 -->
|
||||
<g id="edge2" class="edge">
|
||||
<title>u0->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->u3 -->
|
||||
<g id="edge5" class="edge">
|
||||
<title>u2->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->u3 -->
|
||||
<g id="edge6" class="edge">
|
||||
<title>u13->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->u5 -->
|
||||
<g id="edge7" class="edge">
|
||||
<title>u14->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->u12 -->
|
||||
<g id="edge8" class="edge">
|
||||
<title>u14->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->u5 -->
|
||||
<g id="edge10" class="edge">
|
||||
<title>u18->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->u13 -->
|
||||
<g id="edge9" class="edge">
|
||||
<title>u18->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>
|
||||
<!-- u20->u21 -->
|
||||
<g id="edge1" class="edge">
|
||||
<title>u20->u21</title>
|
||||
<path fill="none" stroke="black" d="M627,-751.64C627,-741.85 627,-729.38 627,-718.29"/>
|
||||
<polygon fill="black" stroke="black" points="630.5,-718.22 627,-708.22 623.5,-718.22 630.5,-718.22"/>
|
||||
</g>
|
||||
<!-- u21->u0 -->
|
||||
<g id="edge2" class="edge">
|
||||
<title>u21->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"/>
|
||||
<path fill="none" stroke="black" d="M742,-1369.75C742,-1340.15 742,-1279.42 742,-1244.1"/>
|
||||
<polygon fill="black" stroke="black" points="745.5,-1244.02 742,-1234.02 738.5,-1244.02 745.5,-1244.02"/>
|
||||
</g>
|
||||
</g>
|
||||
</svg>
|
||||
|
||||
|
Before Width: | Height: | Size: 19 KiB After Width: | Height: | Size: 32 KiB |
@@ -4,363 +4,638 @@
|
||||
<!-- Generated by graphviz version 2.44.0 (0)
|
||||
-->
|
||||
<!-- Title: G Pages: 1 -->
|
||||
<svg width="1075pt" 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">
|
||||
<g id="graph0" class="graph" transform="scale(0.91 0.91) rotate(0) translate(4 710)">
|
||||
<svg width="1076pt" height="648pt"
|
||||
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.68 0.68) rotate(0) translate(4 949)">
|
||||
<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">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="588.33" y="-574.8" font-family="Times-Roman" font-size="14.00">GHCup</text>
|
||||
<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="787.5" y="-882.17" font-family="Times-Roman" font-size="14.00">GHCup</text>
|
||||
</g>
|
||||
<g id="clust2" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="428.85" y="-468.8" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
<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="1232" y="-533.61" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
</g>
|
||||
<g id="clust3" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="484.47" y="-302.8" font-family="Times-Roman" font-size="14.00">Types</text>
|
||||
<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="787.5" y="-848.61" font-family="Times-Roman" font-size="14.00">OptParse</text>
|
||||
</g>
|
||||
<g id="clust4" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="956.88" y="-499.8" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
<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="1286.5" y="-329.03" font-family="Times-Roman" font-size="14.00">Types</text>
|
||||
</g>
|
||||
<g id="clust5" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="936.78" y="-385.8" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
<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="834" y="-452.43" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
</g>
|
||||
<g id="clust6" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="828.22" y="-83.8" font-family="Times-Roman" font-size="14.00">String</text>
|
||||
<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="803" y="-418.87" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
</g>
|
||||
<g id="clust7" class="cluster">
|
||||
<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"/>
|
||||
<text text-anchor="middle" x="1001.1" y="-468.8" font-family="Times-Roman" font-size="14.00">Version</text>
|
||||
<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="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>
|
||||
<!-- u1 -->
|
||||
<g id="node1" class="node">
|
||||
<title>u1</title>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="518.39" cy="-435" 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>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1165" cy="-495.66" rx="55.49" ry="18"/>
|
||||
<text text-anchor="middle" x="1165" y="-491.96" font-family="Times-Roman" font-size="14.00">Download</text>
|
||||
</g>
|
||||
<!-- u12 -->
|
||||
<g id="node7" class="node">
|
||||
<g id="node24" class="node">
|
||||
<title>u12</title>
|
||||
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="922.39" cy="-352" rx="27" ry="18"/>
|
||||
<text text-anchor="middle" x="922.39" y="-348.3" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
<ellipse fill="#ffbbff" stroke="black" stroke-width="2" cx="825" cy="-380.66" rx="27" ry="18"/>
|
||||
<text text-anchor="middle" x="825" y="-376.96" font-family="Times-Roman" font-size="14.00">File</text>
|
||||
</g>
|
||||
<!-- u1->u12 -->
|
||||
<g id="edge15" class="edge">
|
||||
<g id="edge13" class="edge">
|
||||
<title>u1->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"/>
|
||||
<polygon fill="black" stroke="black" points="914.92,-380.43 916.31,-369.92 908.67,-377.26 914.92,-380.43"/>
|
||||
<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="831.62,-407.99 826.49,-398.73 824.72,-409.17 831.62,-407.99"/>
|
||||
</g>
|
||||
<!-- u11 -->
|
||||
<g id="node15" class="node">
|
||||
<g id="node32" class="node">
|
||||
<title>u11</title>
|
||||
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="808.39" cy="-352" 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>
|
||||
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1045" cy="-380.66" rx="28.7" ry="18"/>
|
||||
<text text-anchor="middle" x="1045" y="-376.96" font-family="Times-Roman" font-size="14.00">Dirs</text>
|
||||
</g>
|
||||
<!-- u1->u11 -->
|
||||
<g id="edge14" class="edge">
|
||||
<g id="edge12" class="edge">
|
||||
<title>u1->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"/>
|
||||
<polygon fill="black" stroke="black" points="772.99,-365.02 781.91,-359.3 771.37,-358.21 772.99,-365.02"/>
|
||||
<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="1060.73,-405.46 1052.92,-398.3 1054.56,-408.76 1060.73,-405.46"/>
|
||||
</g>
|
||||
<!-- u13 -->
|
||||
<g id="node18" class="node">
|
||||
<g id="node35" class="node">
|
||||
<title>u13</title>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-269" 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>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1414" cy="-380.66" rx="44.39" ry="18"/>
|
||||
<text text-anchor="middle" x="1414" y="-376.96" font-family="Times-Roman" font-size="14.00">Version</text>
|
||||
</g>
|
||||
<!-- u1->u13 -->
|
||||
<g id="edge13" class="edge">
|
||||
<g id="edge11" class="edge">
|
||||
<title>u1->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"/>
|
||||
<polygon fill="black" stroke="black" points="108.39,-289.86 115.62,-282.11 105.14,-283.66 108.39,-289.86"/>
|
||||
<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="1408.27,-409.31 1408.67,-398.72 1401.76,-406.75 1408.27,-409.31"/>
|
||||
</g>
|
||||
<!-- u17 -->
|
||||
<g id="node2" class="node">
|
||||
<title>u17</title>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="445.39" cy="-352" 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>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1267" cy="-380.66" rx="30.59" ry="18"/>
|
||||
<text text-anchor="middle" x="1267" y="-376.96" font-family="Times-Roman" font-size="14.00">Utils</text>
|
||||
</g>
|
||||
<!-- u5 -->
|
||||
<g id="node6" class="node">
|
||||
<g id="node23" class="node">
|
||||
<title>u5</title>
|
||||
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="549.39" cy="-269" 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>
|
||||
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1238" cy="-291.66" rx="33.6" ry="18"/>
|
||||
<text text-anchor="middle" x="1238" y="-287.96" font-family="Times-Roman" font-size="14.00">JSON</text>
|
||||
</g>
|
||||
<!-- u17->u5 -->
|
||||
<g id="edge16" class="edge">
|
||||
<g id="edge14" class="edge">
|
||||
<title>u17->u5</title>
|
||||
<path fill="none" stroke="black" d="M463.03,-337.26C479.49,-324.44 504.26,-305.15 523.05,-290.51"/>
|
||||
<polygon fill="black" stroke="black" points="525.22,-293.26 530.96,-284.35 520.92,-287.74 525.22,-293.26"/>
|
||||
<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="1250.16,-318.06 1243.67,-309.68 1243.52,-320.27 1250.16,-318.06"/>
|
||||
</g>
|
||||
<!-- u19 -->
|
||||
<g id="node3" class="node">
|
||||
<title>u19</title>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="343.39" cy="-435" 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>
|
||||
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1296" cy="-495.66" rx="57.69" ry="18"/>
|
||||
<text text-anchor="middle" x="1296" y="-491.96" font-family="Times-Roman" font-size="14.00">IOStreams</text>
|
||||
</g>
|
||||
<!-- u19->u17 -->
|
||||
<g id="edge17" class="edge">
|
||||
<g id="edge15" class="edge">
|
||||
<title>u19->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"/>
|
||||
<polygon fill="black" stroke="black" points="433.77,-379.54 436.33,-369.25 427.92,-375.7 433.77,-379.54"/>
|
||||
</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->u3 -->
|
||||
<g id="edge18" class="edge">
|
||||
<title>u4->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->u6 -->
|
||||
<g id="edge19" class="edge">
|
||||
<title>u5->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->u7 -->
|
||||
<g id="edge20" class="edge">
|
||||
<title>u5->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->u9 -->
|
||||
<g id="edge30" class="edge">
|
||||
<title>u12->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->u7 -->
|
||||
<g id="edge31" class="edge">
|
||||
<title>u9->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->u12 -->
|
||||
<g id="edge22" class="edge">
|
||||
<title>u15->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->u11 -->
|
||||
<g id="edge21" class="edge">
|
||||
<title>u15->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->u3 -->
|
||||
<g id="edge23" class="edge">
|
||||
<title>u6->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->u8 -->
|
||||
<g id="edge25" class="edge">
|
||||
<title>u7->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->u2 -->
|
||||
<g id="edge24" class="edge">
|
||||
<title>u7->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->u4 -->
|
||||
<g id="edge26" class="edge">
|
||||
<title>u8->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->u9 -->
|
||||
<g id="edge27" class="edge">
|
||||
<title>u8->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->u10 -->
|
||||
<g id="edge28" class="edge">
|
||||
<title>u8->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->u5 -->
|
||||
<g id="edge29" class="edge">
|
||||
<title>u11->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->u1 -->
|
||||
<g id="edge4" class="edge">
|
||||
<title>u0->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->u16 -->
|
||||
<g id="edge6" class="edge">
|
||||
<title>u0->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->u15 -->
|
||||
<g id="edge5" class="edge">
|
||||
<title>u0->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->u14 -->
|
||||
<g id="edge3" class="edge">
|
||||
<title>u0->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->u3 -->
|
||||
<g id="edge7" class="edge">
|
||||
<title>u2->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->u3 -->
|
||||
<g id="edge8" class="edge">
|
||||
<title>u13->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->u5 -->
|
||||
<g id="edge9" class="edge">
|
||||
<title>u14->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->u12 -->
|
||||
<g id="edge10" class="edge">
|
||||
<title>u14->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->u5 -->
|
||||
<g id="edge12" class="edge">
|
||||
<title>u18->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->u13 -->
|
||||
<g id="edge11" class="edge">
|
||||
<title>u18->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>
|
||||
<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="1277.23,-407.43 1271.35,-398.61 1270.45,-409.17 1277.23,-407.43"/>
|
||||
</g>
|
||||
<!-- u21 -->
|
||||
<g id="node22" class="node">
|
||||
<g id="node4" class="node">
|
||||
<title>u21</title>
|
||||
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-616" rx="46.29" ry="18"/>
|
||||
<text text-anchor="middle" x="840.39" y="-612.3" font-family="Times-Roman" font-size="14.00">Validate</text>
|
||||
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="742" cy="-810.66" rx="51.99" ry="18"/>
|
||||
<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->u23 -->
|
||||
<g id="edge16" class="edge">
|
||||
<title>u21->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->u24 -->
|
||||
<g id="edge17" class="edge">
|
||||
<title>u21->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->u25 -->
|
||||
<g id="edge18" class="edge">
|
||||
<title>u21->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->u26 -->
|
||||
<g id="edge19" class="edge">
|
||||
<title>u21->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->u27 -->
|
||||
<g id="edge20" class="edge">
|
||||
<title>u21->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->u28 -->
|
||||
<g id="edge21" class="edge">
|
||||
<title>u21->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->u29 -->
|
||||
<g id="edge22" class="edge">
|
||||
<title>u21->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->u30 -->
|
||||
<g id="edge23" class="edge">
|
||||
<title>u21->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->u31 -->
|
||||
<g id="edge24" class="edge">
|
||||
<title>u21->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->u32 -->
|
||||
<g id="edge25" class="edge">
|
||||
<title>u21->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->u33 -->
|
||||
<g id="edge26" class="edge">
|
||||
<title>u21->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->u34 -->
|
||||
<g id="edge27" class="edge">
|
||||
<title>u21->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->u35 -->
|
||||
<g id="edge28" class="edge">
|
||||
<title>u21->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->u36 -->
|
||||
<g id="edge29" class="edge">
|
||||
<title>u21->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->u37 -->
|
||||
<g id="edge30" class="edge">
|
||||
<title>u21->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->u0 -->
|
||||
<g id="edge31" class="edge">
|
||||
<title>u22->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->u22 -->
|
||||
<g id="edge32" class="edge">
|
||||
<title>u23->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->u22 -->
|
||||
<g id="edge33" class="edge">
|
||||
<title>u24->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->u0 -->
|
||||
<g id="edge34" class="edge">
|
||||
<title>u25->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->u22 -->
|
||||
<g id="edge35" class="edge">
|
||||
<title>u26->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->u22 -->
|
||||
<g id="edge36" class="edge">
|
||||
<title>u27->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->u15 -->
|
||||
<g id="edge37" class="edge">
|
||||
<title>u28->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->u22 -->
|
||||
<g id="edge38" class="edge">
|
||||
<title>u29->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->u22 -->
|
||||
<g id="edge39" class="edge">
|
||||
<title>u30->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->u0 -->
|
||||
<g id="edge40" class="edge">
|
||||
<title>u31->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->u22 -->
|
||||
<g id="edge41" class="edge">
|
||||
<title>u32->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->u22 -->
|
||||
<g id="edge42" class="edge">
|
||||
<title>u33->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->u0 -->
|
||||
<g id="edge43" class="edge">
|
||||
<title>u34->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->u0 -->
|
||||
<g id="edge44" class="edge">
|
||||
<title>u35->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->u14 -->
|
||||
<g id="edge45" class="edge">
|
||||
<title>u36->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->u18 -->
|
||||
<g id="edge46" class="edge">
|
||||
<title>u36->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->u0 -->
|
||||
<g id="edge47" class="edge">
|
||||
<title>u37->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->u3 -->
|
||||
<g id="edge48" class="edge">
|
||||
<title>u4->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->u6 -->
|
||||
<g id="edge49" class="edge">
|
||||
<title>u5->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->u7 -->
|
||||
<g id="edge50" class="edge">
|
||||
<title>u5->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->u9 -->
|
||||
<g id="edge59" class="edge">
|
||||
<title>u12->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->u7 -->
|
||||
<g id="edge60" class="edge">
|
||||
<title>u9->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->u1 -->
|
||||
<g id="edge51" class="edge">
|
||||
<title>u15->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->u3 -->
|
||||
<g id="edge52" class="edge">
|
||||
<title>u6->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->u8 -->
|
||||
<g id="edge54" class="edge">
|
||||
<title>u7->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->u2 -->
|
||||
<g id="edge53" class="edge">
|
||||
<title>u7->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->u4 -->
|
||||
<g id="edge55" class="edge">
|
||||
<title>u8->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->u9 -->
|
||||
<g id="edge56" class="edge">
|
||||
<title>u8->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->u10 -->
|
||||
<g id="edge57" class="edge">
|
||||
<title>u8->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->u5 -->
|
||||
<g id="edge58" class="edge">
|
||||
<title>u11->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->u16 -->
|
||||
<g id="edge4" class="edge">
|
||||
<title>u0->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->u15 -->
|
||||
<g id="edge3" class="edge">
|
||||
<title>u0->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->u14 -->
|
||||
<g id="edge2" class="edge">
|
||||
<title>u0->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->u3 -->
|
||||
<g id="edge5" class="edge">
|
||||
<title>u2->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->u3 -->
|
||||
<g id="edge6" class="edge">
|
||||
<title>u13->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->u5 -->
|
||||
<g id="edge7" class="edge">
|
||||
<title>u14->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->u12 -->
|
||||
<g id="edge8" class="edge">
|
||||
<title>u14->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->u5 -->
|
||||
<g id="edge10" class="edge">
|
||||
<title>u18->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->u13 -->
|
||||
<g id="edge9" class="edge">
|
||||
<title>u18->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>
|
||||
<!-- u20->u21 -->
|
||||
<g id="edge1" class="edge">
|
||||
<title>u20->u21</title>
|
||||
<path fill="none" stroke="black" d="M840.39,-669.7C840.39,-661.98 840.39,-652.71 840.39,-644.11"/>
|
||||
<polygon fill="black" stroke="black" points="843.89,-644.1 840.39,-634.1 836.89,-644.1 843.89,-644.1"/>
|
||||
</g>
|
||||
<!-- u21->u0 -->
|
||||
<g id="edge2" class="edge">
|
||||
<title>u21->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"/>
|
||||
<path fill="none" stroke="black" d="M742,-907.5C742,-889.33 742,-860.38 742,-839.05"/>
|
||||
<polygon fill="black" stroke="black" points="745.5,-838.98 742,-828.98 738.5,-838.98 745.5,-838.98"/>
|
||||
</g>
|
||||
</g>
|
||||
</svg>
|
||||
|
||||
|
Before Width: | Height: | Size: 19 KiB After Width: | Height: | Size: 33 KiB |
135
ghcup.cabal
135
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17.2
|
||||
version: 0.1.17.6
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@@ -16,11 +16,8 @@ description:
|
||||
category: System
|
||||
build-type: Simple
|
||||
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
|
||||
data/config.yaml
|
||||
README.md
|
||||
|
||||
extra-source-files:
|
||||
@@ -46,6 +43,18 @@ flag internal-downloader
|
||||
default: False
|
||||
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
|
||||
exposed-modules:
|
||||
GHCup
|
||||
@@ -56,6 +65,7 @@ library
|
||||
GHCup.Requirements
|
||||
GHCup.Types
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.JSON.Utils
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Dirs
|
||||
@@ -94,7 +104,7 @@ library
|
||||
build-depends:
|
||||
, aeson >=1.4
|
||||
, async >=0.8 && <2.3
|
||||
, base >=4.13 && <5
|
||||
, base >=4.12 && <5
|
||||
, base16-bytestring >=0.1.1.6 && <1.1
|
||||
, binary ^>=0.8.6.0
|
||||
, bytestring ^>=0.10
|
||||
@@ -108,11 +118,10 @@ library
|
||||
, disk-free-space ^>=0.1.0.1
|
||||
, filepath ^>=1.4.2.1
|
||||
, haskus-utils-types ^>=1.5
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, os-release ^>=1.0.0
|
||||
@@ -120,6 +129,7 @@ library
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, regex-posix ^>=0.96
|
||||
, resourcet ^>=1.2.2
|
||||
, retry ^>=0.8.1.2
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, split ^>=0.2.3.4
|
||||
@@ -135,6 +145,7 @@ library
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, word8 ^>=0.1.3
|
||||
, yaml-streamly ^>=0.12.0
|
||||
, zlib ^>=0.6.2.2
|
||||
|
||||
if (flag(internal-downloader) && !os(windows))
|
||||
@@ -148,21 +159,25 @@ library
|
||||
|
||||
if os(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:
|
||||
, bzlib
|
||||
, process ^>=1.6.11.0
|
||||
, retry ^>=0.8.1.2
|
||||
, Win32 ^>=2.10
|
||||
|
||||
else
|
||||
other-modules:
|
||||
GHCup.Utils.File.Posix
|
||||
System.Console.Terminal.Common
|
||||
System.Console.Terminal.Posix
|
||||
GHCup.Utils.Posix
|
||||
GHCup.Utils.Prelude.Posix
|
||||
|
||||
build-depends:
|
||||
, bz2 >=0.5.0.5 && <1.1
|
||||
, terminal-size ^>=0.3.2.1
|
||||
, unix ^>=2.7
|
||||
, unix-bytestring ^>=0.3.7.3
|
||||
|
||||
@@ -172,6 +187,25 @@ library
|
||||
|
||||
executable ghcup
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
GHCup.OptParse
|
||||
GHCup.OptParse.ChangeLog
|
||||
GHCup.OptParse.Common
|
||||
GHCup.OptParse.Compile
|
||||
GHCup.OptParse.Config
|
||||
GHCup.OptParse.DInfo
|
||||
GHCup.OptParse.GC
|
||||
GHCup.OptParse.Install
|
||||
GHCup.OptParse.List
|
||||
GHCup.OptParse.Nuke
|
||||
GHCup.OptParse.Prefetch
|
||||
GHCup.OptParse.Rm
|
||||
GHCup.OptParse.Run
|
||||
GHCup.OptParse.Set
|
||||
GHCup.OptParse.ToolRequirements
|
||||
GHCup.OptParse.UnSet
|
||||
GHCup.OptParse.Whereis
|
||||
|
||||
hs-source-dirs: app/ghcup
|
||||
default-language: Haskell2010
|
||||
default-extensions:
|
||||
@@ -192,29 +226,35 @@ executable ghcup
|
||||
, aeson >=1.4
|
||||
, aeson-pretty ^>=0.8.8
|
||||
, async ^>=2.2.3
|
||||
, base >=4.13 && <5
|
||||
, base >=4.12 && <5
|
||||
, bytestring ^>=0.10
|
||||
, cabal-plan ^>=0.7.2
|
||||
, containers ^>=0.6
|
||||
, deepseq ^>=1.4
|
||||
, directory ^>=1.3.6.0
|
||||
, filepath ^>=1.4.2.1
|
||||
, ghcup
|
||||
, haskus-utils-variant >=3.0 && <3.2
|
||||
, HsYAML-aeson ^>=0.2.0.0
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
, optparse-applicative >=0.15.1.0 && <0.18
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, process ^>=1.6.11.0
|
||||
, resourcet ^>=1.2.2
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, tagsoup ^>=0.14
|
||||
, template-haskell >=2.7 && <2.18
|
||||
, temporary ^>=1.3
|
||||
, text ^>=1.2.4.0
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
@@ -225,56 +265,23 @@ executable ghcup
|
||||
build-depends:
|
||||
, brick ^>=0.64
|
||||
, transformers ^>=0.5
|
||||
, vector ^>=0.12
|
||||
, unix ^>=2.7
|
||||
, vty >=5.28.2 && <5.34
|
||||
|
||||
if os(windows)
|
||||
cpp-options: -DIS_WINDOWS
|
||||
|
||||
executable ghcup-gen
|
||||
main-is: Main.hs
|
||||
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
|
||||
else
|
||||
build-depends: unix ^>=2.7
|
||||
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates -threaded
|
||||
if flag(no-exe)
|
||||
buildable: False
|
||||
|
||||
build-depends:
|
||||
, 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
|
||||
if flag(disable-upgrade)
|
||||
cpp-options: -DDISABLE_UPGRADE
|
||||
|
||||
else
|
||||
other-modules: GHCup.OptParse.Upgrade
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
@@ -300,12 +307,12 @@ test-suite ghcup-test
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
build-depends:
|
||||
, base >=4.13 && <5
|
||||
, base >=4.12 && <5
|
||||
, bytestring ^>=0.10
|
||||
, containers ^>=0.6
|
||||
, generic-arbitrary ^>=0.1.0
|
||||
, generic-arbitrary >=0.1.0 && <0.3
|
||||
, ghcup
|
||||
, hspec ^>=2.7.10
|
||||
, hspec >=2.7.10 && <2.10
|
||||
, hspec-golden-aeson ^>=0.9
|
||||
, QuickCheck ^>=2.14.1
|
||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||
|
||||
2
hie.yaml
2
hie.yaml
@@ -4,7 +4,5 @@ cradle:
|
||||
path: ./lib
|
||||
- component: "ghcup:exe:ghcup"
|
||||
path: ./app/ghcup
|
||||
- component: "ghcup:exe:ghcup-gen"
|
||||
path: "./app/ghcup-gen"
|
||||
- component: "ghcup:test:ghcup-test"
|
||||
path: ./test
|
||||
|
||||
511
lib/GHCup.hs
511
lib/GHCup.hs
@@ -5,8 +5,8 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup
|
||||
@@ -52,9 +52,7 @@ import Control.Monad.Fail ( MonadFail )
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
#if defined(IS_WINDOWS)
|
||||
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||
#endif
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.List
|
||||
@@ -64,7 +62,7 @@ import Data.String ( fromString )
|
||||
import Data.Text ( Text )
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Format.ISO8601
|
||||
import Data.Versions
|
||||
import Data.Versions hiding ( patch )
|
||||
import Distribution.Types.Version hiding ( Version )
|
||||
import Distribution.Types.PackageId
|
||||
import Distribution.Types.PackageDescription
|
||||
@@ -86,6 +84,7 @@ import System.IO.Error
|
||||
import System.IO.Temp
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
import Text.Regex.Posix
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Crypto.Hash.SHA256 as SHA256
|
||||
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.IO as T
|
||||
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 GHCup.Utils.MegaParsec
|
||||
import Control.Concurrent (threadDelay)
|
||||
@@ -305,22 +301,6 @@ installPackedGHC dl msubdir inst ver forceInstall = do
|
||||
liftE $ runBuildAction tmpUnpack
|
||||
(Just inst)
|
||||
(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
|
||||
@@ -339,36 +319,35 @@ installUnpackedGHC :: ( MonadReader env m
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Version -- ^ The GHC version
|
||||
-> Excepts '[ProcessError] m ()
|
||||
installUnpackedGHC path inst ver = do
|
||||
#if defined(IS_WINDOWS)
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
-- Windows bindists are relocatable and don't need
|
||||
-- to run configure.
|
||||
-- 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
|
||||
mtime <- getModificationTime source
|
||||
Win32.moveFile source dest
|
||||
setModificationTime dest mtime
|
||||
#else
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
installUnpackedGHC path inst ver
|
||||
| isWindows = do
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
-- Windows bindists are relocatable and don't need
|
||||
-- to run configure.
|
||||
-- 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
|
||||
mtime <- getModificationTime source
|
||||
moveFilePortable source dest
|
||||
setModificationTime dest mtime
|
||||
| otherwise = do
|
||||
PlatformRequest {..} <- lift getPlatformReq
|
||||
|
||||
let alpineArgs
|
||||
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
|
||||
= ["--disable-ld-override"]
|
||||
| otherwise
|
||||
= []
|
||||
let alpineArgs
|
||||
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
|
||||
= ["--disable-ld-override"]
|
||||
| otherwise
|
||||
= []
|
||||
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
lEM $ execLogged "sh"
|
||||
("./configure" : ("--prefix=" <> inst)
|
||||
: alpineArgs
|
||||
)
|
||||
(Just path)
|
||||
"ghc-configure"
|
||||
Nothing
|
||||
lEM $ make ["install"] (Just path)
|
||||
pure ()
|
||||
#endif
|
||||
lift $ logInfo "Installing GHC (this may take a while)"
|
||||
lEM $ execLogged "sh"
|
||||
("./configure" : ("--prefix=" <> inst)
|
||||
: alpineArgs
|
||||
)
|
||||
(Just path)
|
||||
"ghc-configure"
|
||||
Nothing
|
||||
lEM $ make ["install"] (Just path)
|
||||
pure ()
|
||||
|
||||
|
||||
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
||||
@@ -489,10 +468,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
|
||||
|
||||
-- create symlink if this is the latest version for regular installs
|
||||
cVers <- lift $ fmap rights getInstalledCabals
|
||||
let lInstCabal = headMay . reverse . sort $ cVers
|
||||
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
|
||||
|
||||
-- | Install an unpacked cabal distribution.Symbol
|
||||
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
|
||||
@@ -587,6 +562,8 @@ installHLSBindist :: ( MonadMask m
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, DirNotEmpty
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -622,26 +599,54 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
|
||||
|
||||
-- the subdir of the archive where we do the work
|
||||
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
|
||||
Just isoDir -> do
|
||||
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
|
||||
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
|
||||
|
||||
isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
|
||||
-> IO Bool
|
||||
isLegacyHLSBindist path = do
|
||||
not <$> doesFileExist (path </> "GNUmakefile")
|
||||
|
||||
-- | Install an unpacked hls distribution.
|
||||
installHLSUnpacked :: (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 ()
|
||||
installHLSUnpacked path inst mver' forceInstall = do
|
||||
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 install to
|
||||
-> Version
|
||||
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
|
||||
installHLSUnpacked path inst _ = 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"
|
||||
liftIO $ createDirRecursive' inst
|
||||
|
||||
@@ -686,19 +691,6 @@ installHLSUnpacked path inst mver' forceInstall = do
|
||||
lift $ chmod_755 destWrapperPath
|
||||
|
||||
|
||||
installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
|
||||
=> Maybe FilePath
|
||||
-> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
installHLSPostInst isoFilepath ver =
|
||||
case isoFilepath of
|
||||
Just _ -> pure ()
|
||||
Nothing -> do
|
||||
-- create symlink if this is the latest version in a regular install
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
let lInstHLS = headMay . reverse . sort $ hlsVers
|
||||
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
||||
|
||||
|
||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
|
||||
@@ -730,6 +722,8 @@ installHLSBin :: ( MonadMask m
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, DirNotEmpty
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -756,9 +750,10 @@ compileHLS :: ( MonadMask m
|
||||
-> Maybe Int
|
||||
-> Maybe Version
|
||||
-> Maybe FilePath
|
||||
-> Maybe FilePath
|
||||
-> Maybe FilePath
|
||||
-> Maybe FilePath
|
||||
-> Maybe (Either FilePath URI)
|
||||
-> Maybe URI
|
||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||
-> [Text] -- ^ additional args to cabal install
|
||||
-> Excepts '[ NoDownload
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
@@ -769,11 +764,12 @@ compileHLS :: ( MonadMask m
|
||||
, BuildFailed
|
||||
, NotInstalled
|
||||
] 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
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
Dirs { .. } <- lift getDirs
|
||||
|
||||
|
||||
(workdir, tver) <- case targetHLS of
|
||||
-- unpack from version tarball
|
||||
Left tver -> do
|
||||
@@ -840,48 +836,51 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
liftE $ runBuildAction
|
||||
workdir
|
||||
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"
|
||||
liftIO $ createDirRecursive' installDir
|
||||
|
||||
-- apply patches
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||
liftE $ applyAnyPatch patches workdir
|
||||
|
||||
-- set up project files
|
||||
cp <- case cabalProject of
|
||||
Just cp
|
||||
Just (Left cp)
|
||||
| isAbsolute cp -> do
|
||||
copyFileE cp (workdir </> "cabal.project")
|
||||
pure "cabal.project"
|
||||
| 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"
|
||||
forM_ cabalProjectLocal $ \cpl -> copyFileE cpl (workdir </> cp <.> "local")
|
||||
|
||||
let targets = ["exe:haskell-language-server", "exe:haskell-language-server-wrapper"]
|
||||
|
||||
forM_ cabalProjectLocal $ \uri -> do
|
||||
tmpUnpack <- lift withGHCupTmpDir
|
||||
cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
|
||||
copyFileE cpl (workdir </> cp <.> "local")
|
||||
artifacts <- forM (sort ghcs) $ \ghc -> do
|
||||
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc)
|
||||
liftIO $ createDirRecursive' ghcInstallDir
|
||||
liftIO $ createDirRecursive' installDir
|
||||
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
|
||||
liftE $ lEM @_ @'[ProcessError] $
|
||||
execLogged "cabal" ( [ "v2-build"
|
||||
execLogged "cabal" ( [ "v2-install"
|
||||
, "-w"
|
||||
, "ghc-" <> T.unpack (prettyVer ghc)
|
||||
, "--install-method=copy"
|
||||
] ++
|
||||
maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
|
||||
[ "--project-file=" <> cp
|
||||
] ++ targets
|
||||
[ "--overwrite-policy=always"
|
||||
, "--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
|
||||
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
|
||||
|
||||
forM_ artifacts $ \artifact -> do
|
||||
@@ -894,13 +893,11 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
case isolateDir of
|
||||
Just isoDir -> do
|
||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||
liftE $ installHLSUnpacked installDir isoDir Nothing True
|
||||
liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
|
||||
Nothing -> do
|
||||
liftE $ installHLSUnpacked installDir binDir (Just installVer) True
|
||||
liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
|
||||
)
|
||||
|
||||
liftE $ installHLSPostInst isolateDir installVer
|
||||
|
||||
pure installVer
|
||||
|
||||
|
||||
@@ -1017,11 +1014,6 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
|
||||
Nothing -> do -- regular install
|
||||
liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
|
||||
|
||||
-- create symlink if this is the latest version and a regular install
|
||||
sVers <- lift $ fmap rights getInstalledStacks
|
||||
let lInstStack = headMay . reverse . sort $ sVers
|
||||
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
|
||||
|
||||
|
||||
-- | Install an unpacked stack distribution.
|
||||
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
|
||||
@@ -1075,22 +1067,29 @@ setGHC :: ( MonadReader env m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> 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
|
||||
setGHC ver sghc = do
|
||||
setGHC ver sghc mBinDir = do
|
||||
let verS = T.unpack $ prettyVer (_tvVersion ver)
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
|
||||
whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver))
|
||||
|
||||
-- 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
|
||||
-- with old ghcup)
|
||||
case sghc of
|
||||
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
|
||||
SetGHC_XY -> liftE $ rmMajorSymlinks ver
|
||||
SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
|
||||
when (isNothing mBinDir) $
|
||||
case sghc of
|
||||
SetGHCOnly -> liftE $ rmPlainGHC (_tvTarget ver)
|
||||
SetGHC_XY -> liftE $ rmMajorGHCSymlinks ver
|
||||
SetGHC_XYZ -> liftE $ rmMinorGHCSymlinks ver
|
||||
|
||||
-- for ghc tools (ghc, ghci, haddock, ...)
|
||||
verfiles <- ghcToolFiles ver
|
||||
@@ -1108,16 +1107,18 @@ setGHC ver sghc = do
|
||||
pure $ Just (file <> "-" <> verS)
|
||||
|
||||
-- create symlink
|
||||
forM mTargetFile $ \targetFile -> do
|
||||
forM_ mTargetFile $ \targetFile -> do
|
||||
bindir <- ghcInternalBinDir ver
|
||||
let fullF = binDir </> targetFile <> exeExt
|
||||
fileWithExt = file <> exeExt
|
||||
destL <- lift $ ghcLinkDestination fileWithExt ver
|
||||
fileWithExt = bindir </> file <> exeExt
|
||||
destL <- binarySymLinkDestination binDir fileWithExt
|
||||
lift $ createLink destL fullF
|
||||
|
||||
-- create symlink for share dir
|
||||
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
|
||||
when (isNothing mBinDir) $ do
|
||||
-- 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
|
||||
|
||||
@@ -1147,15 +1148,17 @@ setGHC ver sghc = do
|
||||
logDebug $ "rm -f " <> T.pack fullF
|
||||
hideError doesNotExistErrorType $ rmDirectoryLink fullF
|
||||
logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
|
||||
liftIO
|
||||
#if defined(IS_WINDOWS)
|
||||
-- On windows we need to be more permissive
|
||||
-- in case symlinks can't be created, be just
|
||||
-- give up here. This symlink isn't strictly necessary.
|
||||
$ hideError permissionErrorType
|
||||
$ hideError illegalOperationErrorType
|
||||
#endif
|
||||
$ createDirectoryLink targetF fullF
|
||||
|
||||
if isWindows
|
||||
then liftIO
|
||||
-- On windows we need to be more permissive
|
||||
-- in case symlinks can't be created, be just
|
||||
-- give up here. This symlink isn't strictly necessary.
|
||||
$ hideError permissionErrorType
|
||||
$ hideError illegalOperationErrorType
|
||||
$ createDirectoryLink targetF fullF
|
||||
else liftIO
|
||||
$ createDirectoryLink targetF fullF
|
||||
_ -> pure ()
|
||||
|
||||
unsetGHC :: ( MonadReader env m
|
||||
@@ -1168,7 +1171,7 @@ unsetGHC :: ( MonadReader env m
|
||||
)
|
||||
=> Maybe Text
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
unsetGHC = rmPlain
|
||||
unsetGHC = rmPlainGHC
|
||||
|
||||
|
||||
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
|
||||
@@ -1220,35 +1223,60 @@ setHLS :: ( MonadReader env m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> 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 ()
|
||||
setHLS ver = do
|
||||
Dirs {..} <- lift getDirs
|
||||
setHLS ver shls mBinDir = do
|
||||
whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
|
||||
|
||||
-- Delete old symlinks, since these might have different ghc versions than the
|
||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
lift $ logDebug $ "rm " <> T.pack (binDir </> f)
|
||||
lift $ rmLink (binDir </> f)
|
||||
-- symlink destination
|
||||
binDir <- case mBinDir of
|
||||
Just x -> pure x
|
||||
Nothing -> do
|
||||
Dirs {binDir = f} <- lift getDirs
|
||||
pure f
|
||||
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
bins <- lift $ hlsServerBinaries ver Nothing
|
||||
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
||||
-- first delete the old symlinks
|
||||
when (isNothing mBinDir) $
|
||||
case shls of
|
||||
-- not for legacy
|
||||
SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
|
||||
-- legacy and new
|
||||
SetHLSOnly -> liftE rmPlainHLS
|
||||
|
||||
forM_ bins $ \f -> do
|
||||
let destL = f
|
||||
let target = (<> exeExt) . head . splitOn "~" $ f
|
||||
lift $ createLink destL (binDir </> target)
|
||||
case shls of
|
||||
-- not for legacy
|
||||
SetHLS_XYZ -> do
|
||||
bins <- lift $ hlsInternalServerScripts ver Nothing
|
||||
|
||||
-- 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
|
||||
forM_ bins $ \f -> do
|
||||
let fname = takeFileName f
|
||||
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
|
||||
@@ -1578,7 +1606,7 @@ listVersions lt' criteria = do
|
||||
|
||||
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
|
||||
currentGHCup av =
|
||||
let currentVer = fromJust $ pvpToVersion ghcUpVer
|
||||
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
|
||||
listVer = Map.lookup currentVer av
|
||||
latestVer = fst <$> headOf (getTagged Latest) av
|
||||
recommendedVer = fst <$> headOf (getTagged Latest) av
|
||||
@@ -1718,14 +1746,14 @@ rmGHCVer ver = do
|
||||
-- this isn't atomic, order matters
|
||||
when isSetGHC $ do
|
||||
lift $ logInfo "Removing ghc symlinks"
|
||||
liftE $ rmPlain (_tvTarget ver)
|
||||
liftE $ rmPlainGHC (_tvTarget ver)
|
||||
|
||||
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
||||
liftE $ rmMinorSymlinks ver
|
||||
liftE $ rmMinorGHCSymlinks ver
|
||||
|
||||
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
||||
-- first remove
|
||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorGHCSymlinks ver
|
||||
-- then fix them (e.g. with an earlier version)
|
||||
|
||||
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
|
||||
@@ -1737,7 +1765,7 @@ rmGHCVer ver = do
|
||||
$ fmap Just
|
||||
$ getMajorMinorV (_tvVersion 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
|
||||
|
||||
@@ -1792,24 +1820,19 @@ rmHLSVer :: ( MonadMask m
|
||||
rmHLSVer ver = do
|
||||
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
|
||||
|
||||
isHlsSet <- lift hlsSet
|
||||
isHlsSet <- lift hlsSet
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
bins <- lift $ hlsAllBinaries ver
|
||||
forM_ bins $ \f -> lift $ recycleFile (binDir </> f)
|
||||
liftE $ rmMinorHLSSymlinks ver
|
||||
hlsDir <- ghcupHLSDir ver
|
||||
recyclePathForcibly hlsDir
|
||||
|
||||
when (Just ver == isHlsSet) $ do
|
||||
-- delete all set symlinks
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
let fullF = binDir </> f
|
||||
lift $ logDebug $ "rm " <> T.pack fullF
|
||||
lift $ rmLink fullF
|
||||
rmPlainHLS
|
||||
-- set latest hls
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
case headMay . reverse . sort $ hlsVers of
|
||||
Just latestver -> setHLS latestver
|
||||
Just latestver -> setHLS latestver SetHLSOnly Nothing
|
||||
Nothing -> pure ()
|
||||
|
||||
|
||||
@@ -1876,17 +1899,17 @@ rmGhcup = do
|
||||
|
||||
unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
-- since it doesn't seem possible to delete a running exe on windows
|
||||
-- we move it to temp dir, to be deleted at next reboot
|
||||
tempFilepath <- mkGhcupTmpDir
|
||||
hideError UnsupportedOperation $
|
||||
liftIO $ hideError NoSuchThing $
|
||||
Win32.moveFileEx ghcupFilepath (Just (tempFilepath </> "ghcup")) 0
|
||||
#else
|
||||
-- delete it.
|
||||
hideError doesNotExistErrorType $ rmFile ghcupFilepath
|
||||
#endif
|
||||
if isWindows
|
||||
then do
|
||||
-- since it doesn't seem possible to delete a running exe on windows
|
||||
-- we move it to temp dir, to be deleted at next reboot
|
||||
tempFilepath <- mkGhcupTmpDir
|
||||
hideError UnsupportedOperation $
|
||||
liftIO $ hideError NoSuchThing $
|
||||
moveFile ghcupFilepath (tempFilepath </> "ghcup")
|
||||
else
|
||||
-- delete it.
|
||||
hideError doesNotExistErrorType $ rmFile ghcupFilepath
|
||||
|
||||
where
|
||||
handlePathNotPresent fp _err = do
|
||||
@@ -1946,10 +1969,9 @@ rmGhcupDirs = do
|
||||
|
||||
handleRm $ rmBinDir binDir
|
||||
handleRm $ rmDir recycleDir
|
||||
#if defined(IS_WINDOWS)
|
||||
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||
handleRm $ rmPathForcibly (baseDir </> "msys64")
|
||||
#endif
|
||||
when isWindows $ do
|
||||
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
|
||||
handleRm $ rmPathForcibly (baseDir </> "msys64")
|
||||
|
||||
handleRm $ removeEmptyDirsRecursive baseDir
|
||||
|
||||
@@ -1983,15 +2005,13 @@ rmGhcupDirs = do
|
||||
forM_ contents (deleteFile . (dir </>))
|
||||
|
||||
rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||
rmBinDir binDir = do
|
||||
#if !defined(IS_WINDOWS)
|
||||
isXDGStyle <- liftIO useXDG
|
||||
if not isXDGStyle
|
||||
then removeDirIfEmptyOrIsSymlink binDir
|
||||
else pure ()
|
||||
#else
|
||||
removeDirIfEmptyOrIsSymlink binDir
|
||||
#endif
|
||||
rmBinDir binDir
|
||||
| isWindows = removeDirIfEmptyOrIsSymlink binDir
|
||||
| otherwise = do
|
||||
isXDGStyle <- liftIO useXDG
|
||||
if not isXDGStyle
|
||||
then removeDirIfEmptyOrIsSymlink binDir
|
||||
else pure ()
|
||||
|
||||
reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
|
||||
reportRemainingFiles dir = do
|
||||
@@ -2097,7 +2117,7 @@ compileGHC :: ( MonadMask m
|
||||
-> Either Version FilePath -- ^ version to bootstrap with
|
||||
-> Maybe Int -- ^ jobs
|
||||
-> Maybe FilePath -- ^ build config
|
||||
-> Maybe FilePath -- ^ patch directory
|
||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||
-> [Text] -- ^ additional args to ./configure
|
||||
-> Maybe String -- ^ build flavour
|
||||
-> Bool
|
||||
@@ -2126,7 +2146,7 @@ compileGHC :: ( MonadMask m
|
||||
]
|
||||
m
|
||||
GHCTargetVersion
|
||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
|
||||
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir
|
||||
= do
|
||||
PlatformRequest { .. } <- lift getPlatformReq
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
@@ -2150,7 +2170,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
workdir <- maybe (pure tmpUnpack)
|
||||
(liftE . intoSubdir tmpUnpack)
|
||||
(view dlSubdir dlInfo)
|
||||
forM_ patchdir (\dir -> liftE $ applyPatches dir workdir)
|
||||
liftE $ applyAnyPatch patches workdir
|
||||
|
||||
pure (workdir, tmpUnpack, tver)
|
||||
|
||||
@@ -2158,7 +2178,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
Right GitBranch{..} -> do
|
||||
tmpUnpack <- lift mkGhcupTmpDir
|
||||
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
|
||||
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
|
||||
lEM $ git [ "init" ]
|
||||
@@ -2178,7 +2198,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
|
||||
lEM $ git [ "checkout", "FETCH_HEAD" ]
|
||||
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 "sh" ["./configure"] (Just tmpUnpack) "ghc-bootstrap"
|
||||
CapturedProcess {..} <- lift $ makeOut
|
||||
@@ -2246,7 +2266,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
Nothing -> do
|
||||
reThrowAll GHCupSetError $ postGHCInstall installVer
|
||||
-- restore
|
||||
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly
|
||||
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing
|
||||
|
||||
_ -> pure ()
|
||||
|
||||
@@ -2311,11 +2331,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
m
|
||||
FilePath
|
||||
findHadrianFile workdir = do
|
||||
#if defined(IS_WINDOWS)
|
||||
let possible_files = ((workdir </> "hadrian") </>) <$> ["build.bat"]
|
||||
#else
|
||||
let possible_files = ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
|
||||
#endif
|
||||
let possible_files = if isWindows
|
||||
then ((workdir </> "hadrian") </>) <$> ["build.bat"]
|
||||
else ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
|
||||
exsists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f))
|
||||
case filter fst exsists of
|
||||
[] -> throwE HadrianNotFound
|
||||
@@ -2489,9 +2507,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
#if defined(IS_WINDOWS)
|
||||
++ ["--enable-tarballs-autodownload"]
|
||||
#endif
|
||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||
++ fmap T.unpack aargs
|
||||
)
|
||||
(Just workdir)
|
||||
@@ -2505,9 +2521,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
(\x -> ["--target=" <> T.unpack x])
|
||||
(_tvTarget tver)
|
||||
++ ["--prefix=" <> ghcdir]
|
||||
#if defined(IS_WINDOWS)
|
||||
++ ["--enable-tarballs-autodownload"]
|
||||
#endif
|
||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||
++ fmap T.unpack aargs
|
||||
)
|
||||
(Just workdir)
|
||||
@@ -2518,6 +2532,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
|
||||
execWithGhcEnv :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
=> FilePath -- ^ thing to execute
|
||||
@@ -2589,7 +2604,7 @@ upgradeGHCup mtarget force' = do
|
||||
|
||||
lift $ logInfo "Upgrading 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
|
||||
dli <- liftE $ getDownloadInfo GHCup latestVer
|
||||
tmp <- lift withGHCupTmpDir
|
||||
@@ -2645,7 +2660,7 @@ postGHCInstall :: ( MonadReader env m
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
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
|
||||
-- version, create it regardless.
|
||||
@@ -2654,7 +2669,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
$ fmap Just
|
||||
$ getMajorMinorV _tvVersion
|
||||
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:
|
||||
@@ -2693,7 +2708,11 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
|
||||
HLS -> do
|
||||
whenM (lift $ fmap not $ hlsInstalled _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
|
||||
whenM (lift $ fmap not $ stackInstalled _tvVersion)
|
||||
@@ -2711,13 +2730,21 @@ checkIfToolInstalled :: ( MonadIO m
|
||||
Tool ->
|
||||
Version ->
|
||||
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
|
||||
Cabal -> cabalInstalled ver
|
||||
HLS -> hlsInstalled ver
|
||||
Stack -> stackInstalled ver
|
||||
GHC -> ghcInstalled $ mkTVer ver
|
||||
Cabal -> cabalInstalled (_tvVersion ver)
|
||||
HLS -> hlsInstalled (_tvVersion ver)
|
||||
Stack -> stackInstalled (_tvVersion ver)
|
||||
GHC -> ghcInstalled ver
|
||||
_ -> pure False
|
||||
|
||||
throwIfFileAlreadyExists :: ( MonadIO m ) =>
|
||||
@@ -2806,21 +2833,31 @@ rmHLSNoGHC :: ( MonadReader env m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
, MonadFail m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> m ()
|
||||
=> Excepts '[NotInstalled] m ()
|
||||
rmHLSNoGHC = do
|
||||
Dirs {..} <- getDirs
|
||||
ghcs <- fmap rights getInstalledGHCs
|
||||
hlses <- fmap rights getInstalledHLSs
|
||||
forM_ hlses $ \hls -> do
|
||||
hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
|
||||
forM_ hlsGHCs $ \ghc -> do
|
||||
when (ghc `notElem` ghcs) $ do
|
||||
bins <- hlsServerBinaries hls (Just $ _tvVersion ghc)
|
||||
forM_ bins $ \bin -> do
|
||||
let f = binDir </> bin
|
||||
let candidates = filter (`notElem` ghcs) hlsGHCs
|
||||
if (length hlsGHCs - length candidates) <= 0
|
||||
then rmHLSVer hls
|
||||
else
|
||||
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
|
||||
rmFile f
|
||||
pure ()
|
||||
|
||||
|
||||
rmCache :: ( MonadReader env m
|
||||
@@ -2858,3 +2895,25 @@ rmTmp = do
|
||||
let p = tmpdir </> f
|
||||
logDebug $ "rm -rf " <> T.pack 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
|
||||
|
||||
@@ -49,7 +49,6 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Data.Aeson
|
||||
import Data.Bifunctor
|
||||
import Data.ByteString ( ByteString )
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
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.IO as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.YAML.Aeson as Y
|
||||
import qualified Data.Yaml.Aeson as Y
|
||||
|
||||
|
||||
|
||||
@@ -122,28 +121,25 @@ getDownloadsF = do
|
||||
Settings { urlSource } <- lift getSettings
|
||||
case urlSource of
|
||||
GHCupURL -> liftE $ getBase ghcupURL
|
||||
(OwnSource url) -> liftE $ getBase url
|
||||
(OwnSource exts) -> do
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo ext
|
||||
(OwnSpec av) -> pure av
|
||||
(AddSource (Left ext)) -> do
|
||||
(AddSource exts) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
pure (mergeGhcupInfo base ext)
|
||||
(AddSource (Right uri)) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
ext <- liftE $ getBase uri
|
||||
pure (mergeGhcupInfo base ext)
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo (base:ext)
|
||||
|
||||
where
|
||||
|
||||
mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
|
||||
-> GHCupInfo -- ^ extension overwriting the base
|
||||
-> GHCupInfo
|
||||
mergeGhcupInfo (GHCupInfo tr base base2) (GHCupInfo _ ext ext2) =
|
||||
let newDownloads = M.mapWithKey (\k a -> case M.lookup k ext of
|
||||
Just a' -> M.union a' a
|
||||
Nothing -> a
|
||||
) base
|
||||
newGlobalTools = M.union base2 ext2
|
||||
in GHCupInfo tr newDownloads newGlobalTools
|
||||
where
|
||||
mergeGhcupInfo :: MonadFail m
|
||||
=> [GHCupInfo]
|
||||
-> m GHCupInfo
|
||||
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
|
||||
mergeGhcupInfo xs@(GHCupInfo{}: _) =
|
||||
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
|
||||
newGlobalTools = M.unionsWith (\_ a2 -> a2 ) (_globalTools <$> xs)
|
||||
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
|
||||
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
|
||||
|
||||
|
||||
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
|
||||
@@ -183,15 +179,14 @@ getBase uri = do
|
||||
|
||||
-- if we didn't get a filepath from the download, use the cached yaml
|
||||
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
|
||||
yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
|
||||
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
|
||||
|
||||
liftE
|
||||
. onE_ (onError actualYaml)
|
||||
. lE' @_ @_ @'[JSONError] JSONDecodeError
|
||||
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||
. Y.decode1
|
||||
$ yamlContents
|
||||
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
|
||||
. liftIO
|
||||
. Y.decodeFileEither
|
||||
$ actualYaml
|
||||
where
|
||||
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
|
||||
-- may re-download and succeed.
|
||||
@@ -244,14 +239,18 @@ getBase uri = do
|
||||
e <- liftIO $ doesFileExist json_file
|
||||
currentTime <- liftIO getCurrentTime
|
||||
Dirs { cacheDir } <- lift getDirs
|
||||
Settings { metaCache } <- lift getSettings
|
||||
|
||||
-- for local files, let's short-circuit and ignore access time
|
||||
if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
|
||||
| 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
|
||||
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
|
||||
dlWithMod currentTime json_file
|
||||
| otherwise -> pure json_file
|
||||
|
||||
@@ -1,9 +1,10 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||
|
||||
|
||||
{-|
|
||||
@@ -27,6 +28,9 @@ import GHCup.Utils.Logger
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Applicative
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
|
||||
@@ -67,3 +67,9 @@ prettyRequirements Requirements {..} =
|
||||
else ""
|
||||
n = if not . T.null $ _notes then "\n Note: " <> _notes else ""
|
||||
in "System requirements " <> d <> n
|
||||
|
||||
rawRequirements :: Requirements -> T.Text
|
||||
rawRequirements Requirements {..} =
|
||||
if not . null $ _distroPKGs
|
||||
then T.intercalate " " _distroPKGs
|
||||
else ""
|
||||
|
||||
@@ -6,6 +6,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
{-|
|
||||
@@ -30,12 +31,15 @@ import Data.Map.Strict ( Map )
|
||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||
import Data.Text ( Text )
|
||||
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
|
||||
#if defined(BRICK)
|
||||
import Graphics.Vty ( Key(..) )
|
||||
#endif
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
@@ -282,9 +286,9 @@ instance Pretty TarDir where
|
||||
|
||||
-- | Where to fetch GHCupDownloads from.
|
||||
data URLSource = GHCupURL
|
||||
| OwnSource URI
|
||||
| OwnSource [Either GHCupInfo URI] -- ^ complete source list
|
||||
| OwnSpec GHCupInfo
|
||||
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
|
||||
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
|
||||
deriving (GHC.Generic, Show)
|
||||
|
||||
instance NFData URLSource
|
||||
@@ -294,6 +298,7 @@ instance NFData (URIRef Absolute) where
|
||||
|
||||
data UserSettings = UserSettings
|
||||
{ uCache :: Maybe Bool
|
||||
, uMetaCache :: Maybe Integer
|
||||
, uNoVerify :: Maybe Bool
|
||||
, uVerbose :: Maybe Bool
|
||||
, uKeepDirs :: Maybe KeepDirs
|
||||
@@ -306,12 +311,13 @@ data UserSettings = UserSettings
|
||||
deriving (Show, GHC.Generic)
|
||||
|
||||
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{..} Nothing =
|
||||
UserSettings {
|
||||
uCache = Just cache
|
||||
, uMetaCache = Just metaCache
|
||||
, uNoVerify = Just noVerify
|
||||
, uVerbose = Just verbose
|
||||
, uKeepDirs = Just keepDirs
|
||||
@@ -335,6 +341,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
||||
}
|
||||
in UserSettings {
|
||||
uCache = Just cache
|
||||
, uMetaCache = Just metaCache
|
||||
, uNoVerify = Just noVerify
|
||||
, uVerbose = Just verbose
|
||||
, uKeepDirs = Just keepDirs
|
||||
@@ -410,6 +417,7 @@ instance NFData LeanAppState
|
||||
|
||||
data Settings = Settings
|
||||
{ cache :: Bool
|
||||
, metaCache :: Integer
|
||||
, noVerify :: Bool
|
||||
, keepDirs :: KeepDirs
|
||||
, downloader :: Downloader
|
||||
@@ -421,6 +429,12 @@ data Settings = Settings
|
||||
}
|
||||
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
|
||||
|
||||
data Dirs = Dirs
|
||||
@@ -474,6 +488,10 @@ data SetGHC = SetGHCOnly -- ^ unversioned 'ghc'
|
||||
| SetGHC_XYZ -- ^ ghc-x.y.z
|
||||
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
|
||||
{ _platform :: Platform
|
||||
@@ -586,3 +604,27 @@ data LoggerConfig = LoggerConfig
|
||||
|
||||
instance NFData LoggerConfig where
|
||||
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
|
||||
|
||||
@@ -22,10 +22,8 @@ Portability : portable
|
||||
module GHCup.Types.JSON where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON.Utils
|
||||
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 Data.Aeson hiding (Key)
|
||||
@@ -40,6 +38,7 @@ import Text.Casing
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MPC
|
||||
|
||||
@@ -78,7 +77,39 @@ instance FromJSON Tag where
|
||||
x -> pure (UnknownTag x)
|
||||
|
||||
instance ToJSON URI where
|
||||
toJSON = toJSON . decUTF8Safe . serializeURIRef'
|
||||
toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
|
||||
|
||||
instance FromJSON URLSource where
|
||||
parseJSON v =
|
||||
parseGHCupURL v
|
||||
<|> parseOwnSourceLegacy v
|
||||
<|> parseOwnSourceNew1 v
|
||||
<|> parseOwnSourceNew2 v
|
||||
<|> parseOwnSpec v
|
||||
<|> legacyParseAddSource v
|
||||
<|> newParseAddSource v
|
||||
where
|
||||
parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
|
||||
r :: URI <- o .: "OwnSource"
|
||||
pure (OwnSource [Right r])
|
||||
parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
|
||||
r :: [URI] <- o .: "OwnSource"
|
||||
pure (OwnSource (fmap Right r))
|
||||
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
|
||||
pure (OwnSource r)
|
||||
parseOwnSpec = withObject "URLSource" $ \o -> do
|
||||
r :: GHCupInfo <- o .: "OwnSpec"
|
||||
pure (OwnSpec r)
|
||||
parseGHCupURL = withObject "URLSource" $ \o -> do
|
||||
_ :: [Value] <- o .: "GHCupURL"
|
||||
pure GHCupURL
|
||||
legacyParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: Either GHCupInfo URI <- o .: "AddSource"
|
||||
pure (AddSource [r])
|
||||
newParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "AddSource"
|
||||
pure (AddSource r)
|
||||
|
||||
instance FromJSON URI where
|
||||
parseJSON = withText "URL" $ \t ->
|
||||
@@ -315,7 +346,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||
|
||||
17
lib/GHCup/Types/JSON/Utils.hs
Normal file
17
lib/GHCup/Types/JSON/Utils.hs
Normal 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'
|
||||
@@ -3,7 +3,6 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
@@ -22,13 +21,21 @@ installation and introspection of files/versions etc.
|
||||
module GHCup.Utils
|
||||
( module GHCup.Utils.Dirs
|
||||
, module GHCup.Utils
|
||||
#if defined(IS_WINDOWS)
|
||||
, module GHCup.Utils.Windows
|
||||
#else
|
||||
, module GHCup.Utils.Posix
|
||||
#endif
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Download
|
||||
import GHCup.Utils.Windows
|
||||
#else
|
||||
import GHCup.Utils.Posix
|
||||
#endif
|
||||
import GHCup.Download
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
@@ -51,9 +58,7 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
|
||||
#if defined(IS_WINDOWS)
|
||||
import Data.Bits
|
||||
#endif
|
||||
import Data.Bifunctor ( first )
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.Either
|
||||
import Data.Foldable
|
||||
@@ -61,7 +66,7 @@ import Data.List
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Data.Versions hiding ( patch )
|
||||
import GHC.IO.Exception
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
@@ -69,11 +74,6 @@ import Safe
|
||||
import System.Directory hiding ( findFiles )
|
||||
import System.FilePath
|
||||
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 URI.ByteString
|
||||
|
||||
@@ -110,8 +110,8 @@ import qualified Data.List.NonEmpty as NE
|
||||
-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
|
||||
-- >>> 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 settings = Settings True False Never Curl False GHCupURL True GPGNone False
|
||||
-- >>> 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 0 False Never Curl False GHCupURL True GPGNone False
|
||||
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
|
||||
-- >>> cwd <- getCurrentDirectory
|
||||
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
|
||||
@@ -124,31 +124,32 @@ import qualified Data.List.NonEmpty as NE
|
||||
------------------------
|
||||
|
||||
|
||||
-- | The symlink destination of a ghc tool.
|
||||
ghcLinkDestination :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m, MonadIO m)
|
||||
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
|
||||
-> GHCTargetVersion
|
||||
-> m FilePath
|
||||
ghcLinkDestination tool ver = do
|
||||
Dirs {..} <- getDirs
|
||||
ghcd <- ghcupGHCDir ver
|
||||
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
|
||||
-- | Create a relative symlink destination for the binary directory,
|
||||
-- given a target toolpath.
|
||||
binarySymLinkDestination :: ( MonadThrow m
|
||||
, MonadIO m
|
||||
)
|
||||
=> FilePath -- ^ binary dir
|
||||
-> FilePath -- ^ the full toolpath
|
||||
-> m FilePath
|
||||
binarySymLinkDestination binDir toolPath = do
|
||||
toolPath' <- liftIO $ canonicalizePath toolPath
|
||||
binDir' <- liftIO $ canonicalizePath binDir
|
||||
pure (relativeSymlink binDir' toolPath')
|
||||
|
||||
|
||||
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
|
||||
rmMinorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
rmMinorGHCSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
@@ -160,17 +161,17 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
|
||||
|
||||
-- | Removes the set ghc version for the given target, if any.
|
||||
rmPlain :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Maybe Text -- ^ target
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmPlain target = do
|
||||
rmPlainGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Maybe Text -- ^ target
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmPlainGHC target = do
|
||||
Dirs {..} <- lift getDirs
|
||||
mtv <- lift $ ghcSet target
|
||||
forM_ mtv $ \tv -> do
|
||||
@@ -186,17 +187,17 @@ rmPlain target = do
|
||||
|
||||
|
||||
-- | Remove the major GHC symlink, e.g. ghc-8.6.
|
||||
rmMajorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
rmMajorGHCSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
(mj, mi) <- getMajorMinorV _tvVersion
|
||||
let v' = intToText mj <> "." <> intToText mi
|
||||
@@ -209,6 +210,62 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
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
|
||||
-- @~\/.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)
|
||||
=> m [Either FilePath Version]
|
||||
getInstalledHLSs = do
|
||||
@@ -363,7 +421,7 @@ getInstalledHLSs = do
|
||||
execBlank
|
||||
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
|
||||
)
|
||||
forM bins $ \f ->
|
||||
legacy <- forM bins $ \f ->
|
||||
case
|
||||
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
|
||||
of
|
||||
@@ -371,6 +429,14 @@ getInstalledHLSs = do
|
||||
Just (Left _) -> 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
|
||||
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
||||
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||
@@ -446,6 +512,10 @@ hlsInstalled ver = do
|
||||
vers <- fmap rights getInstalledHLSs
|
||||
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.
|
||||
@@ -517,7 +587,7 @@ hlsGHCVersions' v' = do
|
||||
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)
|
||||
=> 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.
|
||||
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||
@@ -568,22 +676,6 @@ hlsAllBinaries ver = do
|
||||
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
|
||||
-- we're permissive here... failed parse just means we have no match anyway
|
||||
let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
|
||||
pvp_ <- versionToPVP _tvVersion
|
||||
pure (pvp_, _tvTarget)
|
||||
(pvp_, rest) <- versionToPVP _tvVersion
|
||||
pure (pvp_, rest, _tvTarget)
|
||||
|
||||
getGHCForPVP' pvpIn ghcs' mt
|
||||
|
||||
-- | Like 'getGHCForPVP', except with explicit input parameter.
|
||||
--
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
|
||||
-- "Just 8.10.7"
|
||||
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
|
||||
-- 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
|
||||
-- "Just 8.8.4"
|
||||
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
|
||||
-- "Just 8.10.4"
|
||||
getGHCForPVP' :: MonadThrow m
|
||||
=> PVP
|
||||
-> [(PVP, Maybe Text)] -- ^ installed GHCs
|
||||
-> [(PVP, Text, Maybe Text)] -- ^ installed GHCs
|
||||
-> Maybe Text -- ^ the target triple
|
||||
-> m (Maybe GHCTargetVersion)
|
||||
getGHCForPVP' pvpIn ghcs' mt = do
|
||||
let mResult = lastMay
|
||||
. sortBy (\(x, _) (y, _) -> compare x y)
|
||||
. sortBy (\(x, _, _) (y, _, _) -> compare x y)
|
||||
. filter
|
||||
(\(pvp_, target) ->
|
||||
(\(pvp_, _, target) ->
|
||||
target == mt && matchPVPrefix pvp_ pvpIn
|
||||
)
|
||||
$ ghcs'
|
||||
forM mResult $ \(pvp_, target) -> do
|
||||
ver' <- pvpToVersion pvp_
|
||||
forM mResult $ \(pvp_, rest, target) -> do
|
||||
ver' <- pvpToVersion pvp_ rest
|
||||
pure (GHCTargetVersion target ver')
|
||||
|
||||
|
||||
@@ -679,7 +771,7 @@ getLatestToolFor :: MonadThrow m
|
||||
getLatestToolFor tool pvpIn dls = do
|
||||
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
|
||||
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)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompress filecontents
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
liftE $ untar decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (untar . BZip.decompress =<< rf av)
|
||||
@@ -743,7 +835,7 @@ getArchiveFiles av = do
|
||||
(entries . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompress filecontents
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
liftE $ entries decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (entries . BZip.decompress =<< rf av)
|
||||
@@ -808,8 +900,16 @@ getLatestBaseVersion av pvpVer =
|
||||
--[ 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.
|
||||
--
|
||||
-- Returns unversioned relative files without extension, e.g.:
|
||||
@@ -819,11 +919,10 @@ ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, Mona
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m [FilePath]
|
||||
ghcToolFiles ver = do
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
let bindir = ghcdir </> "bin"
|
||||
bindir <- ghcInternalBinDir ver
|
||||
|
||||
-- fail if ghc is not installed
|
||||
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
||||
whenM (fmap not $ ghcInstalled ver)
|
||||
(throwE (NotInstalled GHC ver))
|
||||
|
||||
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||
@@ -855,6 +954,7 @@ make :: ( MonadThrow m
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
)
|
||||
=> [String]
|
||||
@@ -877,28 +977,43 @@ makeOut args workdir = do
|
||||
executeOut mymake args workdir
|
||||
|
||||
|
||||
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
||||
-- on first failure.
|
||||
-- | Try to apply patches in order. The order is determined by
|
||||
-- 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)
|
||||
=> FilePath -- ^ dir containing patches
|
||||
-> FilePath -- ^ dir to apply patches in
|
||||
-> Excepts '[PatchFailed] m ()
|
||||
applyPatches pdir ddir = do
|
||||
patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles
|
||||
pdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|.+\.(patch|diff)$|] :: ByteString)
|
||||
)
|
||||
forM_ (sort patches) $ \patch' -> do
|
||||
lift $ logInfo $ "Applying patch " <> T.pack patch'
|
||||
fmap (either (const Nothing) Just)
|
||||
(exec
|
||||
"patch"
|
||||
["-p1", "-i", patch']
|
||||
(Just ddir)
|
||||
Nothing)
|
||||
!? PatchFailed
|
||||
let lexicographical = (fmap . fmap) (pdir </>) $ sort <$> findFiles
|
||||
pdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|.+\.(patch|diff)$|] :: ByteString)
|
||||
)
|
||||
let quilt = map (pdir </>) . lines <$> readFile (pdir </> "series")
|
||||
|
||||
patches <- liftIO $ quilt `catchIO` (\e ->
|
||||
if isDoesNotExistError e || isPermissionError e then
|
||||
lexicographical
|
||||
else throwIO e)
|
||||
forM_ patches $ \patch' -> applyPatch patch' ddir
|
||||
|
||||
|
||||
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
|
||||
@@ -1000,50 +1115,17 @@ getVersionInfo v' tool =
|
||||
|
||||
-- | The file extension for executables.
|
||||
exeExt :: String
|
||||
#if defined(IS_WINDOWS)
|
||||
exeExt = ".exe"
|
||||
#else
|
||||
exeExt = ""
|
||||
#endif
|
||||
exeExt
|
||||
| isWindows = ".exe"
|
||||
| otherwise = ""
|
||||
|
||||
-- | The file extension for executables.
|
||||
exeExt' :: ByteString
|
||||
#if defined(IS_WINDOWS)
|
||||
exeExt' = ".exe"
|
||||
#else
|
||||
exeExt' = ""
|
||||
#endif
|
||||
exeExt'
|
||||
| isWindows = ".exe"
|
||||
| otherwise = ""
|
||||
|
||||
|
||||
-- | 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
|
||||
@@ -1052,33 +1134,27 @@ enableAnsiSupport = pure (Right True)
|
||||
-- On windows, we have to emulate symlinks via shims,
|
||||
-- see 'createLink'.
|
||||
getLinkTarget :: FilePath -> IO FilePath
|
||||
getLinkTarget fp = do
|
||||
#if defined(IS_WINDOWS)
|
||||
content <- readFile (dropExtension fp <.> "shim")
|
||||
[p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
|
||||
pure $ stripNewline $ dropPrefix "path = " p
|
||||
#else
|
||||
getSymbolicLinkTarget fp
|
||||
#endif
|
||||
getLinkTarget fp
|
||||
| isWindows = do
|
||||
content <- readFile (dropExtension fp <.> "shim")
|
||||
[p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
|
||||
pure $ stripNewline $ dropPrefix "path = " p
|
||||
| otherwise = getSymbolicLinkTarget fp
|
||||
|
||||
|
||||
-- | Checks whether the path is a link.
|
||||
pathIsLink :: FilePath -> IO Bool
|
||||
#if defined(IS_WINDOWS)
|
||||
pathIsLink fp = doesPathExist (dropExtension fp <.> "shim")
|
||||
#else
|
||||
pathIsLink = pathIsSymbolicLink
|
||||
#endif
|
||||
pathIsLink fp
|
||||
| isWindows = doesPathExist (dropExtension fp <.> "shim")
|
||||
| otherwise = pathIsSymbolicLink fp
|
||||
|
||||
|
||||
rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
|
||||
#if defined(IS_WINDOWS)
|
||||
rmLink fp = do
|
||||
hideError doesNotExistErrorType . recycleFile $ fp
|
||||
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
|
||||
#else
|
||||
rmLink = hideError doesNotExistErrorType . recycleFile
|
||||
#endif
|
||||
rmLink fp
|
||||
| isWindows = do
|
||||
hideError doesNotExistErrorType . recycleFile $ fp
|
||||
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
|
||||
| otherwise = hideError doesNotExistErrorType . recycleFile $ fp
|
||||
|
||||
|
||||
-- | 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 be created
|
||||
-> m ()
|
||||
createLink link exe = do
|
||||
#if defined(IS_WINDOWS)
|
||||
dirs <- getDirs
|
||||
let shimGen = cacheDir dirs </> "gs.exe"
|
||||
createLink link exe
|
||||
| isWindows = do
|
||||
dirs <- getDirs
|
||||
let shimGen = cacheDir dirs </> "gs.exe"
|
||||
|
||||
let shim = dropExtension exe <.> "shim"
|
||||
-- For hardlinks, link needs to be absolute.
|
||||
-- If link is relative, it's relative to the target exe.
|
||||
-- Note that (</>) drops lhs when rhs is absolute.
|
||||
fullLink = takeDirectory exe </> link
|
||||
shimContents = "path = " <> fullLink
|
||||
let shim = dropExtension exe <.> "shim"
|
||||
-- For hardlinks, link needs to be absolute.
|
||||
-- If link is relative, it's relative to the target exe.
|
||||
-- Note that (</>) drops lhs when rhs is absolute.
|
||||
fullLink = takeDirectory exe </> link
|
||||
shimContents = "path = " <> fullLink
|
||||
|
||||
logDebug $ "rm -f " <> T.pack exe
|
||||
rmLink exe
|
||||
logDebug $ "rm -f " <> T.pack exe
|
||||
rmLink exe
|
||||
|
||||
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
|
||||
liftIO $ copyFile shimGen exe
|
||||
liftIO $ writeFile shim shimContents
|
||||
#else
|
||||
logDebug $ "rm -f " <> T.pack exe
|
||||
hideError doesNotExistErrorType $ recycleFile exe
|
||||
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
|
||||
liftIO $ copyFile shimGen exe
|
||||
liftIO $ writeFile shim shimContents
|
||||
| otherwise = do
|
||||
logDebug $ "rm -f " <> T.pack exe
|
||||
hideError doesNotExistErrorType $ recycleFile exe
|
||||
|
||||
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
|
||||
liftIO $ createFileLink link exe
|
||||
#endif
|
||||
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
|
||||
liftIO $ createFileLink link exe
|
||||
|
||||
|
||||
ensureGlobalTools :: ( MonadMask m
|
||||
@@ -1141,23 +1216,20 @@ ensureGlobalTools :: ( MonadMask m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
|
||||
ensureGlobalTools = do
|
||||
#if defined(IS_WINDOWS)
|
||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||
dirs <- lift getDirs
|
||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\(DigestError _ _ _) -> do
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
|
||||
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
||||
liftE @'[GPGError, DigestError , DownloadFailed] $ dl
|
||||
) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl)
|
||||
pure ()
|
||||
#else
|
||||
pure ()
|
||||
#endif
|
||||
ensureGlobalTools
|
||||
| isWindows = do
|
||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||
dirs <- lift getDirs
|
||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\DigestError{} -> do
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
|
||||
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
|
||||
liftE @'[GPGError, DigestError , DownloadFailed] $ dl
|
||||
) `catchE` liftE @'[GPGError, DigestError , DownloadFailed] dl
|
||||
| otherwise = pure ()
|
||||
|
||||
|
||||
-- | 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:
|
||||
--
|
||||
-- - ghc-<ver> (e.g. ghc-8.10.4)
|
||||
-- - ghc
|
||||
--
|
||||
-- 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 (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> 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)
|
||||
|
||||
@@ -20,14 +20,15 @@ module GHCup.Utils.Dirs
|
||||
, ghcupCacheDir
|
||||
, ghcupGHCBaseDir
|
||||
, ghcupGHCDir
|
||||
, ghcupHLSBaseDir
|
||||
, ghcupHLSDir
|
||||
, mkGhcupTmpDir
|
||||
, parseGHCupGHCDir
|
||||
, parseGHCupHLSDir
|
||||
, relativeSymlink
|
||||
, withGHCupTmpDir
|
||||
, getConfigFilePath
|
||||
#if !defined(IS_WINDOWS)
|
||||
, useXDG
|
||||
#endif
|
||||
, cleanupTrash
|
||||
)
|
||||
where
|
||||
@@ -48,6 +49,7 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource hiding (throwM)
|
||||
import Data.Bifunctor
|
||||
import Data.Maybe
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
@@ -59,7 +61,7 @@ import System.IO.Temp
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
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 Control.Concurrent (threadDelay)
|
||||
|
||||
@@ -75,26 +77,25 @@ import Control.Concurrent (threadDelay)
|
||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||
-- then uses 'XDG_DATA_HOME/ghcup' as per xdg spec.
|
||||
ghcupBaseDir :: IO FilePath
|
||||
ghcupBaseDir = do
|
||||
#if defined(IS_WINDOWS)
|
||||
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")
|
||||
ghcupBaseDir
|
||||
| isWindows = do
|
||||
bdir <- fromMaybe "C:\\" <$> lookupEnv "GHCUP_INSTALL_BASE_PREFIX"
|
||||
pure (bdir </> "ghcup")
|
||||
else do
|
||||
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> liftIO getHomeDirectory
|
||||
pure (bdir </> ".ghcup")
|
||||
#endif
|
||||
| otherwise = do
|
||||
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")
|
||||
else do
|
||||
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> liftIO getHomeDirectory
|
||||
pure (bdir </> ".ghcup")
|
||||
|
||||
|
||||
-- | ~/.ghcup by default
|
||||
@@ -102,45 +103,41 @@ ghcupBaseDir = do
|
||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||
-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
|
||||
ghcupConfigDir :: IO FilePath
|
||||
ghcupConfigDir = do
|
||||
#if defined(IS_WINDOWS)
|
||||
ghcupBaseDir
|
||||
#else
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".config")
|
||||
pure (bdir </> "ghcup")
|
||||
else do
|
||||
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> liftIO getHomeDirectory
|
||||
pure (bdir </> ".ghcup")
|
||||
#endif
|
||||
ghcupConfigDir
|
||||
| isWindows = ghcupBaseDir
|
||||
| otherwise = do
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".config")
|
||||
pure (bdir </> "ghcup")
|
||||
else do
|
||||
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> liftIO getHomeDirectory
|
||||
pure (bdir </> ".ghcup")
|
||||
|
||||
|
||||
-- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||
-- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
|
||||
-- (which, sadly is not strictly xdg spec).
|
||||
ghcupBinDir :: IO FilePath
|
||||
ghcupBinDir = do
|
||||
#if defined(IS_WINDOWS)
|
||||
ghcupBaseDir <&> (</> "bin")
|
||||
#else
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
lookupEnv "XDG_BIN_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".local" </> "bin")
|
||||
else ghcupBaseDir <&> (</> "bin")
|
||||
#endif
|
||||
ghcupBinDir
|
||||
| isWindows = ghcupBaseDir <&> (</> "bin")
|
||||
| otherwise = do
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
lookupEnv "XDG_BIN_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".local" </> "bin")
|
||||
else ghcupBaseDir <&> (</> "bin")
|
||||
|
||||
|
||||
-- | Defaults to '~/.ghcup/cache'.
|
||||
@@ -148,21 +145,19 @@ ghcupBinDir = do
|
||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||
-- then uses 'XDG_CACHE_HOME/ghcup' as per xdg spec.
|
||||
ghcupCacheDir :: IO FilePath
|
||||
ghcupCacheDir = do
|
||||
#if defined(IS_WINDOWS)
|
||||
ghcupBaseDir <&> (</> "cache")
|
||||
#else
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".cache")
|
||||
pure (bdir </> "ghcup")
|
||||
else ghcupBaseDir <&> (</> "cache")
|
||||
#endif
|
||||
ghcupCacheDir
|
||||
| isWindows = ghcupBaseDir <&> (</> "cache")
|
||||
| otherwise = do
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".cache")
|
||||
pure (bdir </> "ghcup")
|
||||
else ghcupBaseDir <&> (</> "cache")
|
||||
|
||||
|
||||
-- | Defaults to '~/.ghcup/logs'.
|
||||
@@ -170,21 +165,19 @@ ghcupCacheDir = do
|
||||
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
|
||||
-- then uses 'XDG_CACHE_HOME/ghcup/logs' as per xdg spec.
|
||||
ghcupLogsDir :: IO FilePath
|
||||
ghcupLogsDir = do
|
||||
#if defined(IS_WINDOWS)
|
||||
ghcupBaseDir <&> (</> "logs")
|
||||
#else
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".cache")
|
||||
pure (bdir </> "ghcup" </> "logs")
|
||||
else ghcupBaseDir <&> (</> "logs")
|
||||
#endif
|
||||
ghcupLogsDir
|
||||
| isWindows = ghcupBaseDir <&> (</> "logs")
|
||||
| otherwise = do
|
||||
xdg <- useXDG
|
||||
if xdg
|
||||
then do
|
||||
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
|
||||
Just r -> pure r
|
||||
Nothing -> do
|
||||
home <- liftIO getHomeDirectory
|
||||
pure (home </> ".cache")
|
||||
pure (bdir </> "ghcup" </> "logs")
|
||||
else ghcupBaseDir <&> (</> "logs")
|
||||
|
||||
|
||||
-- | '~/.ghcup/trash'.
|
||||
@@ -222,7 +215,7 @@ ghcupConfigFile = do
|
||||
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
|
||||
case contents of
|
||||
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) =
|
||||
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
|
||||
, HasDirs env
|
||||
@@ -320,22 +331,23 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
|
||||
--------------
|
||||
|
||||
|
||||
#if !defined(IS_WINDOWS)
|
||||
useXDG :: IO Bool
|
||||
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
|
||||
-> FilePath -- ^ the symlink destination
|
||||
-> FilePath
|
||||
relativeSymlink p1 p2 =
|
||||
let d1 = splitDirectories p1
|
||||
d2 = splitDirectories p2
|
||||
common = takeWhile (\(x, y) -> x == y) $ zip d1 d2
|
||||
cPrefix = drop (length common) d1
|
||||
in joinPath (replicate (length cPrefix) "..")
|
||||
<> joinPath ([pathSeparator] : drop (length common) d2)
|
||||
relativeSymlink p1 p2
|
||||
| isWindows = p2 -- windows quickly gets into MAX_PATH issues so we don't care about relative symlinks
|
||||
| otherwise =
|
||||
let d1 = splitDirectories p1
|
||||
d2 = splitDirectories p2
|
||||
common = takeWhile (\(x, y) -> x == y) $ zip d1 d2
|
||||
cPrefix = drop (length common) d1
|
||||
in joinPath (replicate (length cPrefix) "..")
|
||||
<> joinPath ([pathSeparator] : drop (length common) d2)
|
||||
|
||||
|
||||
cleanupTrash :: ( MonadIO m
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# 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.Types(ProcessError(..), CapturedProcess(..))
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
@@ -13,7 +16,7 @@ import Data.Text ( Text )
|
||||
import Data.Void
|
||||
import GHC.IO.Exception
|
||||
import Optics hiding ((<|), (|>))
|
||||
import System.Directory
|
||||
import System.Directory hiding (findFiles)
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
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.
|
||||
--
|
||||
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
|
||||
@@ -100,6 +76,21 @@ isInPath p = do
|
||||
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 path regex = do
|
||||
contents <- listDirectory path
|
||||
|
||||
@@ -35,7 +35,7 @@ import Data.Sequence ( Seq, (|>) )
|
||||
import Data.List
|
||||
import Data.Word8
|
||||
import GHC.IO.Exception
|
||||
import System.Console.Terminal.Common
|
||||
import System.IO ( stderr )
|
||||
import System.IO.Error
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
@@ -51,7 +51,7 @@ import qualified Data.Sequence as Sq
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
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.Lazy as BL
|
||||
import qualified "unix-bytestring" System.Posix.IO.ByteString
|
||||
@@ -73,6 +73,7 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
|
||||
|
||||
execLogged :: ( MonadReader env m
|
||||
, HasSettings env
|
||||
, HasLog env
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
@@ -85,6 +86,7 @@ execLogged :: ( MonadReader env m
|
||||
execLogged exe args chdir lfile env = do
|
||||
Settings {..} <- getSettings
|
||||
Dirs {..} <- getDirs
|
||||
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||
let logfile = logsDir </> lfile <> ".log"
|
||||
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
|
||||
closeFd
|
||||
@@ -141,14 +143,14 @@ execLogged exe args chdir lfile env = do
|
||||
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
|
||||
printToRegion fileFd fdIn size pState no_color = do
|
||||
-- init region
|
||||
forM_ [1..size] $ \_ -> BS.putStr "\n"
|
||||
forM_ [1..size] $ \_ -> BS.hPut stderr "\n"
|
||||
|
||||
void $ flip runStateT mempty
|
||||
$ do
|
||||
handle
|
||||
(\(ex :: SomeException) -> do
|
||||
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
|
||||
) $ readTilEOF lineAction fdIn
|
||||
|
||||
@@ -180,10 +182,10 @@ execLogged exe args chdir lfile env = do
|
||||
modify (swapRegs bs')
|
||||
liftIO TP.size >>= \case
|
||||
Nothing -> pure ()
|
||||
Just (Window _ w) -> do
|
||||
Just (TP.Window _ w) -> do
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
|
||||
BS.putStr
|
||||
BS.hPut stderr
|
||||
. overwriteNthLine (size - i)
|
||||
. trim w
|
||||
. blue
|
||||
|
||||
@@ -18,6 +18,7 @@ module GHCup.Utils.File.Windows where
|
||||
import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.File.Common
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
|
||||
@@ -40,6 +41,7 @@ import qualified Control.Exception as EX
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
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
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, HasSettings env
|
||||
, MonadIO m
|
||||
, MonadThrow m)
|
||||
@@ -160,6 +163,7 @@ execLogged :: ( MonadReader env m
|
||||
-> m (Either ProcessError ())
|
||||
execLogged exe args chdir lfile env = do
|
||||
Dirs {..} <- getDirs
|
||||
logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
|
||||
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
|
||||
stderrLogfile = logsDir </> lfile <> ".stderr.log"
|
||||
cp <- createProcessWithMingwPath ((proc exe args)
|
||||
@@ -192,7 +196,8 @@ execLogged exe args chdir lfile env = do
|
||||
then pure ()
|
||||
else do
|
||||
void $ BS.appendFile logFile some
|
||||
void $ BS.hPut stdout some
|
||||
-- subprocess stdout also goes to stderr for logging
|
||||
void $ BS.hPut stderr some
|
||||
go
|
||||
|
||||
|
||||
|
||||
@@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
@@ -18,7 +17,7 @@ module GHCup.Utils.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles)
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Control.Exception.Safe
|
||||
|
||||
@@ -1,7 +1,5 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Utils.Logger where
|
||||
|
||||
|
||||
14
lib/GHCup/Utils/Posix.hs
Normal file
14
lib/GHCup/Utils/Posix.hs
Normal 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)
|
||||
|
||||
@@ -17,14 +17,25 @@ Portability : portable
|
||||
|
||||
GHCup specific prelude. Lots of Excepts functionality.
|
||||
-}
|
||||
module GHCup.Utils.Prelude where
|
||||
|
||||
module GHCup.Utils.Prelude
|
||||
(module GHCup.Utils.Prelude,
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Types
|
||||
module GHCup.Utils.Prelude.Windows
|
||||
#else
|
||||
module GHCup.Utils.Prelude.Posix
|
||||
#endif
|
||||
)
|
||||
where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Errors
|
||||
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.Exception.Safe
|
||||
@@ -33,7 +44,7 @@ import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
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.Foldable
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ))
|
||||
@@ -45,17 +56,13 @@ import Haskus.Utils.Types.List
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
|
||||
import System.IO.Error
|
||||
#if defined(IS_WINDOWS)
|
||||
import System.IO.Temp
|
||||
#endif
|
||||
import System.IO.Unsafe
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
import Control.Retry
|
||||
import GHC.IO.Exception
|
||||
#endif
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
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.Int as B
|
||||
import qualified Data.Text.Lazy.Encoding as TLE
|
||||
#if defined(IS_WINDOWS)
|
||||
import qualified System.Win32.File as Win32
|
||||
#endif
|
||||
|
||||
|
||||
-- $setup
|
||||
@@ -304,23 +308,46 @@ intToText :: Integral a => a -> T.Text
|
||||
intToText = TL.toStrict . B.toLazyText . B.decimal
|
||||
|
||||
|
||||
removeLensFieldLabel :: String -> String
|
||||
removeLensFieldLabel str' =
|
||||
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
|
||||
pvpToVersion :: MonadThrow m => PVP -> Text -> m Version
|
||||
pvpToVersion pvp_ rest =
|
||||
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
|
||||
|
||||
|
||||
pvpToVersion :: MonadThrow m => PVP -> m Version
|
||||
pvpToVersion =
|
||||
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
|
||||
|
||||
versionToPVP :: MonadThrow m => Version -> m PVP
|
||||
versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
|
||||
-- | Convert a version to a PVP and unparsable rest.
|
||||
--
|
||||
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
|
||||
versionToPVP :: MonadThrow m => Version -> m (PVP, Text)
|
||||
versionToPVP (Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
|
||||
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . pvp . prettyVer $ v
|
||||
where
|
||||
alternative :: MonadThrow m => Version -> m PVP
|
||||
alternative v' = case NE.takeWhile isDigit (_vChunks v') of
|
||||
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
|
||||
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 (Digits _ :| []) = True
|
||||
isDigit _ = False
|
||||
@@ -438,19 +465,19 @@ recyclePathForcibly :: ( MonadIO m
|
||||
)
|
||||
=> FilePath
|
||||
-> m ()
|
||||
recyclePathForcibly fp = do
|
||||
#if defined(IS_WINDOWS)
|
||||
Dirs { recycleDir } <- getDirs
|
||||
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
|
||||
let dest = tmp </> takeFileName fp
|
||||
liftIO (Win32.moveFileEx fp (Just dest) 0)
|
||||
`catch`
|
||||
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
|
||||
`finally`
|
||||
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
|
||||
#else
|
||||
liftIO $ removePathForcibly fp
|
||||
#endif
|
||||
recyclePathForcibly fp
|
||||
| isWindows = do
|
||||
Dirs { recycleDir } <- getDirs
|
||||
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
|
||||
let dest = tmp </> takeFileName fp
|
||||
liftIO (moveFile fp dest)
|
||||
`catch`
|
||||
(\e -> if | isDoesNotExistError e -> pure ()
|
||||
| isPermissionError e {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp)
|
||||
| otherwise -> throwIO e)
|
||||
`finally`
|
||||
liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
|
||||
| otherwise = liftIO $ removePathForcibly fp
|
||||
|
||||
|
||||
rmPathForcibly :: ( MonadIO m
|
||||
@@ -458,23 +485,17 @@ rmPathForcibly :: ( MonadIO m
|
||||
)
|
||||
=> FilePath
|
||||
-> m ()
|
||||
rmPathForcibly fp =
|
||||
#if defined(IS_WINDOWS)
|
||||
recover (liftIO $ removePathForcibly fp)
|
||||
#else
|
||||
liftIO $ removePathForcibly fp
|
||||
#endif
|
||||
rmPathForcibly fp
|
||||
| isWindows = recover (liftIO $ removePathForcibly fp)
|
||||
| otherwise = liftIO $ removePathForcibly fp
|
||||
|
||||
|
||||
rmDirectory :: (MonadIO m, MonadMask m)
|
||||
=> FilePath
|
||||
-> m ()
|
||||
rmDirectory fp =
|
||||
#if defined(IS_WINDOWS)
|
||||
recover (liftIO $ removeDirectory fp)
|
||||
#else
|
||||
liftIO $ removeDirectory fp
|
||||
#endif
|
||||
rmDirectory fp
|
||||
| isWindows = recover (liftIO $ removeDirectory fp)
|
||||
| otherwise = liftIO $ removeDirectory fp
|
||||
|
||||
|
||||
-- https://www.sqlite.org/src/info/89f1848d7f
|
||||
@@ -486,20 +507,18 @@ recycleFile :: ( MonadIO m
|
||||
)
|
||||
=> FilePath
|
||||
-> m ()
|
||||
recycleFile fp = do
|
||||
#if defined(IS_WINDOWS)
|
||||
Dirs { recycleDir } <- getDirs
|
||||
liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
|
||||
tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
|
||||
let dest = tmp </> takeFileName fp
|
||||
liftIO (Win32.moveFileEx fp (Just dest) 0)
|
||||
`catch`
|
||||
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
|
||||
`finally`
|
||||
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
|
||||
#else
|
||||
liftIO $ removeFile fp
|
||||
#endif
|
||||
recycleFile fp
|
||||
| isWindows = do
|
||||
Dirs { recycleDir } <- getDirs
|
||||
liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
|
||||
tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
|
||||
let dest = tmp </> takeFileName fp
|
||||
liftIO (moveFile fp dest)
|
||||
`catch`
|
||||
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
|
||||
`finally`
|
||||
liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
|
||||
| otherwise = liftIO $ removeFile fp
|
||||
|
||||
|
||||
rmFile :: ( MonadIO m
|
||||
@@ -507,26 +526,19 @@ rmFile :: ( MonadIO m
|
||||
)
|
||||
=> FilePath
|
||||
-> m ()
|
||||
rmFile fp =
|
||||
#if defined(IS_WINDOWS)
|
||||
recover (liftIO $ removeFile fp)
|
||||
#else
|
||||
liftIO $ removeFile fp
|
||||
#endif
|
||||
rmFile fp
|
||||
| isWindows = recover (liftIO $ removeFile fp)
|
||||
| otherwise = liftIO $ removeFile fp
|
||||
|
||||
|
||||
rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
|
||||
=> FilePath
|
||||
-> m ()
|
||||
rmDirectoryLink fp =
|
||||
#if defined(IS_WINDOWS)
|
||||
recover (liftIO $ removeDirectoryLink fp)
|
||||
#else
|
||||
liftIO $ removeDirectoryLink fp
|
||||
#endif
|
||||
rmDirectoryLink fp
|
||||
| isWindows = recover (liftIO $ removeDirectoryLink fp)
|
||||
| otherwise = liftIO $ removeDirectoryLink fp
|
||||
|
||||
|
||||
#if defined(IS_WINDOWS)
|
||||
recover :: (MonadIO m, MonadMask m) => m a -> m a
|
||||
recover action =
|
||||
recovering (fullJitterBackoff 25000 <> limitRetries 10)
|
||||
@@ -535,7 +547,6 @@ recover action =
|
||||
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
|
||||
]
|
||||
(\_ -> action)
|
||||
#endif
|
||||
|
||||
|
||||
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 needle (x:xs) = first (x:) $ breakOn needle xs
|
||||
|
||||
|
||||
|
||||
|
||||
20
lib/GHCup/Utils/Prelude/Posix.hs
Normal file
20
lib/GHCup/Utils/Prelude/Posix.hs
Normal 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
|
||||
|
||||
17
lib/GHCup/Utils/Prelude/Windows.hs
Normal file
17
lib/GHCup/Utils/Prelude/Windows.hs
Normal 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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.String.QQ
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE DeriveLift #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||
|
||||
|
||||
{-|
|
||||
@@ -53,6 +53,9 @@ deriving instance Data VUnit
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
deriving instance Lift (NonEmpty Word)
|
||||
deriving instance Lift (NonEmpty VChunk)
|
||||
deriving instance Lift (NonEmpty MChunk)
|
||||
deriving instance Lift (NonEmpty VUnit)
|
||||
#endif
|
||||
|
||||
qq :: (Text -> Q Exp) -> QuasiQuoter
|
||||
|
||||
48
lib/GHCup/Utils/Windows.hs
Normal file
48
lib/GHCup/Utils/Windows.hs
Normal 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)
|
||||
|
||||
@@ -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
|
||||
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
|
||||
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.
|
||||
ghcUpVer :: PVP
|
||||
|
||||
@@ -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
|
||||
)
|
||||
@@ -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)
|
||||
@@ -1,6 +1,6 @@
|
||||
site_name: 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_favicon: haskell_logo.png
|
||||
|
||||
|
||||
@@ -25,7 +25,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.17.2"
|
||||
ghver="0.1.17.5"
|
||||
base_url="https://downloads.haskell.org/~ghcup"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -39,7 +39,6 @@ case "${plat}" in
|
||||
;;
|
||||
*)
|
||||
: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
|
||||
export GHCUP_USE_XDG_DIRS
|
||||
|
||||
if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
|
||||
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
|
||||
@@ -201,10 +200,10 @@ download_ghcup() {
|
||||
i*86)
|
||||
_url=${base_url}/${ghver}/i386-linux-ghcup-${ghver}
|
||||
;;
|
||||
armv7*)
|
||||
armv7*|*armv8l*)
|
||||
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
|
||||
;;
|
||||
aarch64|arm64|armv8l)
|
||||
aarch64|arm64)
|
||||
# we could be in a 32bit docker container, in which
|
||||
# case uname doesn't give us what we want
|
||||
if [ "$(getconf LONG_BIT)" = "32" ] ; then
|
||||
@@ -237,7 +236,7 @@ download_ghcup() {
|
||||
*) die "Unknown architecture: ${arch}"
|
||||
;;
|
||||
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")
|
||||
case "${arch}" in
|
||||
@@ -281,7 +280,20 @@ download_ghcup() {
|
||||
|
||||
# we may overwrite this in adjust_bashrc
|
||||
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
|
||||
|
||||
# shellcheck disable=SC1090
|
||||
@@ -369,12 +381,38 @@ adjust_bashrc() {
|
||||
case $1 in
|
||||
1)
|
||||
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
|
||||
;;
|
||||
2)
|
||||
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
|
||||
;;
|
||||
*) ;;
|
||||
@@ -487,7 +525,7 @@ ask_cabal_config_init() {
|
||||
esac
|
||||
done
|
||||
else
|
||||
return 1
|
||||
return 0
|
||||
fi
|
||||
;;
|
||||
esac
|
||||
@@ -505,8 +543,8 @@ do_cabal_config_init() {
|
||||
adjust_cabal_config
|
||||
;;
|
||||
0)
|
||||
echo "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 "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
|
||||
warn "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
|
||||
sleep 5
|
||||
return ;;
|
||||
*) ;;
|
||||
@@ -679,7 +717,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
|
||||
|
||||
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
|
||||
case "${plat}" in
|
||||
MSYS*|MINGW*)
|
||||
|
||||
@@ -29,11 +29,11 @@ param (
|
||||
[switch]$InstallStack,
|
||||
# Whether to install hls as well
|
||||
[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:\')
|
||||
[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,
|
||||
# Specify the cabal root directory (default: '$InstallDir\cabal')
|
||||
[string]$CabalDir
|
||||
@@ -246,6 +246,7 @@ if ($Silent -and !($InstallDir)) {
|
||||
$GhcupBasePrefix = ('{0}\' -f $GhcupBasePrefix)
|
||||
}
|
||||
|
||||
$GhcupBasePrefix = $GhcupBasePrefix.TrimEnd().TrimStart()
|
||||
if (!($GhcupBasePrefix)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Test-Path -LiteralPath ('{0}' -f $GhcupBasePrefix))) {
|
||||
@@ -333,6 +334,7 @@ if ($CabalDir) {
|
||||
$CabalDirPrompt = Read-Host
|
||||
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
|
||||
|
||||
$CabDirEnv = $CabDirEnv.TrimEnd().TrimStart()
|
||||
if (!($CabDirEnv)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
|
||||
@@ -401,16 +403,17 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
# Download the archive
|
||||
Print-Msg -msg 'Downloading Msys2 archive...'
|
||||
$archive = 'msys2-x86_64-latest.sfx.exe'
|
||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||
|
||||
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 {
|
||||
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...'
|
||||
$null = & "$env:TEMP\$archive" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||
Remove-Item -Path ('{0}/{1}' -f $env:TEMP, $archive)
|
||||
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||
Remove-Item -Path "$archivePath"
|
||||
|
||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||
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:'
|
||||
$MsysDir = Read-Host
|
||||
}
|
||||
$MsysDir = $MsysDir.TrimEnd().TrimStart()
|
||||
if (!($MsysDir)) {
|
||||
Print-Msg -color Red -msg "No directory specified!"
|
||||
} elseif (!(Test-Path -LiteralPath ('{0}' -f $MsysDir))) {
|
||||
|
||||
49
scripts/releasing/pull_release_artifacts.sh
Executable file
49
scripts/releasing/pull_release_artifacts.sh
Executable 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
|
||||
|
||||
|
||||
|
||||
39
scripts/releasing/sftp-symlink-artifacts.sh
Executable file
39
scripts/releasing/sftp-symlink-artifacts.sh
Executable 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/
|
||||
47
scripts/releasing/sftp-upload-artifacts.sh
Executable file
47
scripts/releasing/sftp-upload-artifacts.sh
Executable 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}/
|
||||
11
stack.yaml
11
stack.yaml
@@ -1,4 +1,4 @@
|
||||
resolver: lts-18.12
|
||||
resolver: lts-18.27
|
||||
|
||||
packages:
|
||||
- .
|
||||
@@ -16,7 +16,8 @@ extra-deps:
|
||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
|
||||
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
|
||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
|
||||
@@ -25,6 +26,7 @@ extra-deps:
|
||||
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
|
||||
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
|
||||
- libarchive-3.0.3.0
|
||||
- libyaml-streamly-0.2.0
|
||||
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
|
||||
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
|
||||
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
|
||||
@@ -33,11 +35,10 @@ extra-deps:
|
||||
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
|
||||
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
|
||||
- regex-posix-clib-2.7
|
||||
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
|
||||
- streamly-bytestring-0.1.2@sha256:cc828f41d1c714c711d38fb213b4ed186febabba598ab080e13255f69c20b13c,2469
|
||||
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
|
||||
- streamly-0.8.0@sha256:9784c80ee1ada51477520cabc4e92a0c76a6bb265f968a188f2fce818e7398e0,19654
|
||||
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- yaml-streamly-0.12.0
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
|
||||
@@ -3,7 +3,7 @@
|
||||
module GHCup.Types.JSONSpec where
|
||||
|
||||
import GHCup.ArbitraryTypes ()
|
||||
import GHCup.Types
|
||||
import GHCup.Types hiding ( defaultSettings )
|
||||
import GHCup.Types.JSON ()
|
||||
|
||||
import Test.Aeson.GenericSpecs
|
||||
|
||||
Reference in New Issue
Block a user