Compare commits

...

117 Commits

Author SHA1 Message Date
6701093c3b Bump version to 0.1.16.2 2021-08-11 16:30:01 +02:00
e9fdc073c6 Fix --flavor 2021-08-11 16:19:52 +02:00
57c791106b Fixup rest of the PR 2021-08-11 16:19:31 +02:00
fcba151fad Merge remote-tracking branch 'origin/merge-requests/134' 2021-08-11 14:20:04 +02:00
3b24f503d1 Fixup rest of the PR 2021-08-11 13:54:02 +02:00
bd18fd9aa1 Merge remote-tracking branch 'origin/merge-requests/127' 2021-08-11 12:28:48 +02:00
Arjun Kathuria
c2c5625685 implements checking if file already exists for Cabal installs 2021-08-11 10:33:08 +05:30
Arjun Kathuria
ce6fb0bb1e Adds new Error type FileAlreadyExistsError 2021-08-11 10:28:30 +05:30
Arjun Kathuria
dcfb3afdad Revert "implements isolated install sanity-checking for Cabal installs"
This reverts commit 300cfd3ba6.
2021-08-11 09:46:42 +05:30
50c91345e8 Merge branch 'windows-autoconf' 2021-08-10 17:08:43 +02:00
af3ecae792 Install autoconf in msys2 wrt #200 2021-08-10 16:58:37 +02:00
Arjun Kathuria
300cfd3ba6 implements isolated install sanity-checking for Cabal installs 2021-08-10 20:14:46 +05:30
Arjun Kathuria
bb430fa0b7 Adds the sanity check function for isolated installs 2021-08-10 20:12:14 +05:30
Arjun Kathuria
80fa7965a4 Adds new Error type IsolatedDirNotEmpty 2021-08-10 20:11:32 +05:30
9975a2d4ba Merge branch 'fix-install' 2021-08-10 16:39:46 +02:00
Arjun Kathuria
d1735bc446 adds toolchainSanityChecks for isolated installs too in installGHCBindist function. 2021-08-10 19:53:41 +05:30
dbf1d6f420 Fix unneeded dist files being installed along with GHC 2021-08-10 15:58:40 +02:00
0a0fbd0cb6 Merge branch 'fix-metadata-download' 2021-08-07 19:26:26 +02:00
f13f53b910 Merge branch 'throwM' 2021-08-07 19:20:00 +02:00
6dfc04a9f6 Fix metadata file read in --offline mode 2021-08-07 18:31:41 +02:00
72133d0002 Rather skip copying to cache dir if scheme is file:// 2021-08-07 10:24:08 +02:00
6e07e9e56b Skip copying metadata if source and destination match 2021-08-07 09:55:45 +02:00
e903aeb555 Skip cached metadata when url starts with file:// 2021-08-07 09:54:26 +02:00
2792f6f4b6 Fix error handling when we can't find a filename 2021-08-06 19:45:59 +02:00
Arjun Kathuria
80eb72ce49 Merge branch 'smash-1' of gitlab.haskell.org:arjun/ghcup-hs into smash-1 2021-08-04 16:09:48 +05:30
Arjun Kathuria
2c6d0382cf adds isolate install feature to compiled ghc command 2021-08-04 16:08:12 +05:30
Arjun Kathuria
e1bec789b0 updates Bindist functions as per https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/127#note_366702 2021-08-03 18:08:54 +05:30
Arjun Kathuria
5683493cae rename some auxiliary functions to their "unpacked" versions 2021-08-03 18:08:54 +05:30
Arjun Kathuria
ae5e213b59 deletes installStackBinIsolated function 2021-08-03 18:08:54 +05:30
Arjun Kathuria
911089f334 updates usages of new installStackBin across files 2021-08-03 18:08:54 +05:30
Arjun Kathuria
6b89646c1e update installStackBindist to take a "Maybe FilePath" argument for isolated installs 2021-08-03 18:08:54 +05:30
Arjun Kathuria
960d5ce79f deletes installHLSBinIsolated function 2021-08-03 18:08:54 +05:30
Arjun Kathuria
90ed0895d6 updates usages of installHLSBin across files 2021-08-03 18:08:54 +05:30
Arjun Kathuria
7471f4f4dc update installHLSBindist to take a "Maybe FilePath" argument for isolated installs 2021-08-03 18:08:54 +05:30
Arjun Kathuria
781cf8eed5 Delete installCabalBinIsolated function. 2021-08-03 18:08:54 +05:30
Arjun Kathuria
236da31af6 updates usages of new installCabalBindist across files. 2021-08-03 18:08:54 +05:30
Arjun Kathuria
1f760af880 update installCabalBindist to take a "Maybe FilePath" argument for isolated installs 2021-08-03 18:08:54 +05:30
Arjun Kathuria
62d03b776b remove installGHCBinIsolated function. 2021-08-03 18:08:54 +05:30
Arjun Kathuria
37ea18a0d8 updates usages of new installGHCBindist and related installGHCBin 2021-08-03 18:08:54 +05:30
Arjun Kathuria
083dc59a8f update installGhcBindist to take a "Maybe FilePath" to work with isolated installs 2021-08-03 18:08:54 +05:30
Arjun Kathuria
a45d069cad Adds a log to notify where the isolated ghc is being installed by the tool 2021-08-03 18:08:54 +05:30
Arjun Kathuria
fdbcd4fafd Adds isolated installs to Stack install 2021-08-03 18:08:54 +05:30
Arjun Kathuria
f3c1c925ed updates installStack' usage in installStackBindist function 2021-08-03 18:08:54 +05:30
Arjun Kathuria
8f6a7ba39c factor out installStack' function 2021-08-03 18:08:54 +05:30
Arjun Kathuria
f212eb4570 Adds isolated install to HLS installs 2021-08-03 18:08:54 +05:30
Arjun Kathuria
0d118e2fe1 update installHLS' usage in installHLSBindist 2021-08-03 18:08:54 +05:30
Arjun Kathuria
c0f46ef81f Factor out installHLS' 2021-08-03 18:08:54 +05:30
Arjun Kathuria
476513b0a7 Adds isolate install functionality to 'Cabal' tool installs 2021-08-03 18:08:54 +05:30
Arjun Kathuria
9a511669a8 use the new factored out installCabal' in installCabalBindist function 2021-08-03 18:08:54 +05:30
Arjun Kathuria
a16a25a3cd factor out installCabal' from installCabalBindist, to be shared with installCabalBinIsolated function 2021-08-03 18:08:54 +05:30
Arjun Kathuria
8666fcd120 adds rudimentary isolate capability to ghcup install ghc command 2021-08-03 18:08:54 +05:30
Arjun Kathuria
521ab0aedb adds basic --isolate option structure for install commands 2021-08-03 18:08:54 +05:30
vglfr
1cfff674b7 Implement config CLI MVP 2021-08-03 09:09:47 +03:00
88d1d19f55 Merge branch 'bump-bs-ver' 2021-07-31 16:38:12 +02:00
0fb1da5c3a Bump ghc version in bootstrap-haskell 2021-07-31 16:23:01 +02:00
b32f88e9a6 Merge branch 'update-hls-1.3.0' 2021-07-31 14:44:16 +02:00
9d2421fac5 Update to HLS 1.3.0 2021-07-31 13:30:29 +02:00
043e288fbf Add tipps and tricks section 2021-07-30 20:06:19 +02:00
32e34876e2 Update 2021-07-29 22:45:48 +02:00
f12a2b3821 Update README 2021-07-29 22:40:35 +02:00
844b4decab Update FAQ 2021-07-29 22:35:52 +02:00
53ca60596d Fix nuclear order 2021-07-29 11:51:47 +02:00
2d2894b0f4 Bump metadata 2021-07-29 10:50:07 +02:00
21d30cd8ce Fix GHCup showing up twice in list 2021-07-28 22:48:28 +02:00
b38a569124 Bump to 0.1.16.1 2021-07-28 22:36:59 +02:00
810607e84f Update yamls 2021-07-28 22:31:56 +02:00
442ddfd4e4 Bump ghcup metadata, because new GHC versions may have different bin/ layout 2021-07-28 20:08:20 +02:00
096103e65a Refreeze 2021-07-28 18:42:57 +02:00
60a56c337c Merge branch 'travis' 2021-07-28 18:42:35 +02:00
11c1b2cc6c Re-add travis 2021-07-28 18:02:34 +02:00
45db3bd913 Update README 2021-07-28 11:07:53 +02:00
6d76561340 Update CHANGELOG for 0.1.16 2021-07-27 23:34:32 +02:00
00caeba067 Merge branch 'fix-list-tools' 2021-07-27 23:16:18 +02:00
5a34191b88 Fix listTools to always show currently installed GHCup 2021-07-27 22:33:35 +02:00
85003900d7 Improve HLS post-install formatting 2021-07-27 20:58:39 +02:00
0c666a6bbe Fix upgrade subcommand running appstate twice 2021-07-27 20:57:51 +02:00
e4e52ebf6b Bump to 0.1.16 2021-07-27 20:39:12 +02:00
4512468108 Also upload dist-newstyle/cache on failure 2021-07-27 10:39:55 +02:00
d3e3ebd63f Merge branch 'fix-ghcToolFiles' 2021-07-26 21:25:00 +02:00
ce616d3eb3 Improve bootstrap-haskell.ps1 2021-07-26 18:14:07 +02:00
5837e04e6e Cleanup 2021-07-26 18:13:57 +02:00
95ca79f3f8 Turn leftover files into logError 2021-07-26 18:13:41 +02:00
706fe1ffcc Don't do update checks for all commands 2021-07-26 18:13:20 +02:00
2774f026e8 Merge branch 'issue-150' 2021-07-26 17:44:37 +02:00
07604a2eb5 Merge branch 'issue-193' 2021-07-26 17:39:13 +02:00
Arjun Kathuria
03d77f5006 updates Bindist functions as per https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/127#note_366702 2021-07-26 11:49:52 +05:30
fdf45e0fe6 Do etags hashing wrt #193 2021-07-25 23:15:59 +02:00
1dc9ad7a57 Merge branch 'www-false' 2021-07-25 19:56:56 +02:00
cc51d7b454 Merge branch 'add-binutils-gold-for-alpine-pkgs' 2021-07-25 19:56:24 +02:00
af8c097092 Add binutils gold for alpine pkgs 2021-07-25 19:06:22 +02:00
Arjun Kathuria
71e6dbfdca rename some auxiliary functions to their "unpacked" versions 2021-07-25 22:34:53 +05:30
Arjun Kathuria
692cd1616b deletes installStackBinIsolated function 2021-07-25 22:25:25 +05:30
Arjun Kathuria
4e3dbea5d0 updates usages of new installStackBin across files 2021-07-25 22:24:38 +05:30
Arjun Kathuria
fd2add78bd update installStackBindist to take a "Maybe FilePath" argument for isolated installs 2021-07-25 22:23:58 +05:30
Arjun Kathuria
e9da8ab439 deletes installHLSBinIsolated function 2021-07-25 22:10:43 +05:30
Arjun Kathuria
9c22ba9d45 updates usages of installHLSBin across files 2021-07-25 22:10:10 +05:30
Arjun Kathuria
e5d3080b54 update installHLSBindist to take a "Maybe FilePath" argument for isolated installs 2021-07-25 22:09:54 +05:30
Arjun Kathuria
5995a8b592 Delete installCabalBinIsolated function. 2021-07-25 22:09:54 +05:30
Arjun Kathuria
bc6d006c57 updates usages of new installCabalBindist across files. 2021-07-25 22:09:54 +05:30
Arjun Kathuria
b148d8e2e7 update installCabalBindist to take a "Maybe FilePath" argument for isolated installs 2021-07-25 21:20:42 +05:30
Arjun Kathuria
4f7d41a8cc remove installGHCBinIsolated function. 2021-07-25 13:39:44 +05:30
Arjun Kathuria
5efe2e5f7a updates usages of new installGHCBindist and related installGHCBin 2021-07-25 13:38:32 +05:30
Arjun Kathuria
338f5f309d update installGhcBindist to take a "Maybe FilePath" to work with isolated installs 2021-07-25 13:35:41 +05:30
Arjun Kathuria
ba51cbad6f Adds a log to notify where the isolated ghc is being installed by the tool 2021-07-23 16:51:50 +05:30
Arjun Kathuria
511272e86d Adds isolated installs to Stack install 2021-07-23 16:46:11 +05:30
Arjun Kathuria
873f75da9f updates installStack' usage in installStackBindist function 2021-07-23 16:44:40 +05:30
Arjun Kathuria
42d4a66493 factor out installStack' function 2021-07-23 16:43:43 +05:30
Arjun Kathuria
9a79af6fd2 Adds isolated install to HLS installs 2021-07-23 16:25:01 +05:30
Arjun Kathuria
63f10a1871 update installHLS' usage in installHLSBindist 2021-07-23 16:23:52 +05:30
Arjun Kathuria
9686ee9826 Factor out installHLS' 2021-07-23 16:23:03 +05:30
Arjun Kathuria
4729364e99 Adds isolate install functionality to 'Cabal' tool installs 2021-07-23 15:57:42 +05:30
Arjun Kathuria
91d982c7b2 use the new factored out installCabal' in installCabalBindist function 2021-07-23 15:56:03 +05:30
Arjun Kathuria
8b7c22440e factor out installCabal' from installCabalBindist, to be shared with installCabalBinIsolated function 2021-07-23 15:52:28 +05:30
Arjun Kathuria
9b3d55a095 adds rudimentary isolate capability to ghcup install ghc command 2021-07-22 19:32:56 +05:30
Arjun Kathuria
e2daf5381c adds basic --isolate option structure for install commands 2021-07-20 22:05:01 +05:30
928f4a97de Fix ghcToolFiles for upcoming GHC build system changes
Also see: https://gitlab.haskell.org/ghc/ghc/-/issues/20074#note_363720
2021-07-10 21:43:37 +02:00
abbe51614d Improve uninstallation on windows wrt #150 2021-07-07 23:19:50 +02:00
34 changed files with 24775 additions and 675 deletions

View File

@@ -99,11 +99,12 @@ variables:
script: script:
- bash ./.gitlab/script/ghcup_version.sh - bash ./.gitlab/script/ghcup_version.sh
variables: variables:
JSON_VERSION: "0.0.5" JSON_VERSION: "0.0.6"
artifacts: artifacts:
expire_in: 2 week expire_in: 2 week
paths: paths:
- golden - golden
- dist-newstyle/cache/
when: on_failure when: on_failure
# .test_ghcup_scoop: # .test_ghcup_scoop:
@@ -202,10 +203,11 @@ variables:
expire_in: 2 week expire_in: 2 week
paths: paths:
- out - out
- dist-newstyle/cache/
only: only:
- tags - tags
variables: variables:
JSON_VERSION: "0.0.5" JSON_VERSION: "0.0.6"
######## stack test ######## ######## stack test ########

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -12,6 +12,10 @@ ecabal() {
cabal "$@" cabal "$@"
} }
raw_eghcup() {
ghcup -v -c "$@"
}
eghcup() { eghcup() {
if [ "${OS}" = "WINDOWS" ] ; then if [ "${OS}" = "WINDOWS" ] ; then
ghcup -v -c -s file:/$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@" ghcup -v -c -s file:/$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
@@ -20,6 +24,12 @@ eghcup() {
fi fi
} }
if [ "${OS}" = "WINDOWS" ] ; then
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
git describe --always git describe --always
### build ### build
@@ -65,11 +75,7 @@ fi
### cleanup ### cleanup
if [ "${OS}" = "WINDOWS" ] ; then rm -rf "${GHCUP_DIR}"
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
### manual cli based testing ### manual cli based testing
@@ -88,6 +94,7 @@ cabal --version
eghcup debug-info eghcup debug-info
# also test etags
eghcup list eghcup list
eghcup list -t ghc eghcup list -t ghc
eghcup list -t cabal eghcup list -t cabal
@@ -109,7 +116,20 @@ else
if [ "${OS}" = "LINUX" ] ; then if [ "${OS}" = "LINUX" ] ; then
eghcup --downloader=wget prefetch ghc 8.10.3 eghcup --downloader=wget prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3 eghcup --offline install ghc 8.10.3
else # test wget a bit if [ "${ARCH}" = "64" ] ; then
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
[ "${actual}" = "${expected}" ]
unset actual expected
fi
elif [ "${OS}" = "WINDOWS" ] ; then
eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
[ "${actual}" = "${expected}" ]
unset actual expected
else
eghcup prefetch ghc 8.10.3 eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3 eghcup --offline install ghc 8.10.3
fi fi
@@ -155,6 +175,55 @@ if [ "${OS}" = "LINUX" ] ; then
fi fi
fi fi
sha_sum() {
if [ "${OS}" = "FREEBSD" ] ; then
sha256 "$@"
else
sha256sum "$@"
fi
}
# test etags
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
# snapshot yaml and etags file
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# invalidate access time timer, which is 5minutes, so we re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# redownload same file with some newlines added
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
# snapshot new yaml and etags file
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# compare
[ "${etag}" != "${etag2}" ]
[ "${sha}" != "${sha2}" ]
# invalidate access time timer, which is 5minutes, but don't expect a re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# this time, we expect the same hash and etag
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
[ "${etag2}" = "${etag3}" ]
[ "${sha2}" = "${sha3}" ]
# test isolated installs
eghcup install ghc -i "$(pwd)/isolated" 8.10.5
[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
if [ "${ARCH}" = "64" ] ; then
if [ "${OS}" = "LINUX" ] || [ "${OS}" = "WINDOWS" ] ; then
eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
eghcup install stack -i "$(pwd)/isolated" 2.7.3
[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
eghcup install hls -i "$(pwd)/isolated" 1.3.0
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
fi
fi
eghcup upgrade eghcup upgrade
eghcup upgrade -f eghcup upgrade -f
@@ -162,8 +231,4 @@ eghcup upgrade -f
# nuke # nuke
eghcup nuke eghcup nuke
if [ "${OS}" = "WINDOWS" ] ; then [ ! -e "${GHCUP_DIR}" ]
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/ghcup" ]
else
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
fi

25
.travis.yml Normal file
View File

@@ -0,0 +1,25 @@
jobs:
include:
- os: osx
osx_image: xcode10.1
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.13-ghcup
- os: osx
osx_image: xcode11.3
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.14-ghcup
script: ".travis/build.sh"
deploy:
provider: releases
api_key:
secure: "hT2od8Iy04tdFVuonPSWv0NX5hZDmv4al8Q0GbIWmviUetROuM7c6/MCHUcgyiw6H2L3pmH4F24GBYWpKBT3ZMbxrKXhZOZ3KPLXzlnuRlm1qymKqqwsJs3466bMftaiBr16rx1VpAuditN4A32oSmTFcQAJc84Bxn2WZ4t8hk9muS8YPyLhqg3/NxT6ob8dzNp9eS2cA0WODMb/fMzaMruRtepSK8JvuXb/SnTvaDcl9plmPzEa+eW54jwVsDps8ZpQMQlTtGIjYHIwTQ36/iLH4LoAvD7OEnB7qf753LOzmI/bvlB75xYGsLxe1qgpzPMjuG3AK0jb2KGSZCzyAyrbBFSQMIyC1gNKMtab3CohnA9WdQqAT1xrzPzA9zNw516G5Fn/z+t9Ek1f6L2OYO2hJfweNhWh+ChAIsOags2QBpqc0qjkwUS4wqxCWBdyVfgPTUoGelvjCfjQgypgIyLEHFvXt9rlj+kd97FY7nG3vxZrsvWTKKKT551OqUYX5zWTyvGR71jKyNst/p93Pg3DkRy31gHrGnG9zfNgN5tWxJqDd/suR/BAFTp0VtkFb8fR3ct7WMVeJXtE2+bKqxO5Fnocs1VjEm8pKPk7glnp0muu08kaO0h54wiSOCbk1RvO1KZtHue4wKWrHcI18dwW2WtzoBQ4P1lOSkS81UY="
file: $ARTIFACT
on:
repo: hasufell/ghcup-hs
tags: true
skip_cleanup: true
draft: true

28
.travis/build.sh Executable file
View File

@@ -0,0 +1,28 @@
#!/bin/sh
set -ex
mkdir -p ~/.ghcup/bin
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ~/.ghcup/bin/ghcup
chmod +x ~/.ghcup/bin/ghcup
export PATH="$HOME/.ghcup/bin:$PATH"
ghcup install 8.10.4
ghcup install-cabal 3.4.0.0
ghcup set 8.10.4
## install ghcup
cabal update
(
cd /tmp
cabal install --installdir="$HOME"/.ghcup/bin hspec-discover
)
cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui
cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
strip ./ghcup
cp ghcup "./${ARTIFACT}"

View File

@@ -1,8 +1,32 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.16 -- ????-??-?? ## 0.1.16.2 -- 2021-08-12
* Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria
* Implement config cli MVP wrt [#134](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/134) by Oleksii Dorozhkin
* Fix `ghcup compile ghc --flavor`
* Fix minor installation bug causing increased disk space wrt [#139](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/139)
* Improved error handling wrt [#136](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/136)
* Various improvements to metadata download when using `file://` and `--offline` wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/137)
## 0.1.16.1 -- 2021-07-29
* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria * Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
* Add uninstallation powershell script on windows wrt [#150](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/150)
* Improve logging
* Fix building GHC cross compiler wrt [#180](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/180)
* Allow to use hadrian as build system (for git based versions only) wrt [#35](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/35)
* Allow passing `--flavor` to `ghcup compile ghc`
* Support new GHC `bin/` directory format wrt [ghc/ghc#20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074#note_363720)
* Implement `whereis` subcommand wrt [#173](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/173)
* Add `--offline` switch and `prefetch` subcommand wrt [#186](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/186)
* Implement ETAGs hashing for metadata downloads to speed up `ghcup list` wrt [#193](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/193)
* Avoid unnecessary fetching of ghcup metadata in some commands
* Avoid unnecessary update checks for some commands
* Preserve mtimes on unpacked GHC tarballs on windows wrt [#187](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/187), fixing issues with `ghc-pkg`
* Fix lesser bug in `ghcup list` for stray stack versions wrt [#183](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/183)
* Major redo on how file removal on windows works, avoiding partial removals etc, wrt [#165](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/165)
* Improve ghcup tui for screen readers wrt [github/#4](https://github.com/haskell/ghcup-hs/pull/4), thanks to Mario Lang
## 0.1.15.2 -- 2021-06-13 ## 0.1.15.2 -- 2021-06-13

154
README.md
View File

@@ -18,6 +18,7 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
* [XDG support](#xdg-support) * [XDG support](#xdg-support)
* [Env variables](#env-variables) * [Env variables](#env-variables)
* [Installing custom bindists](#installing-custom-bindists) * [Installing custom bindists](#installing-custom-bindists)
* [Tips and tricks](#tips-and-tricks)
* [Design goals](#design-goals) * [Design goals](#design-goals)
* [How](#how) * [How](#how)
* [Known users](#known-users) * [Known users](#known-users)
@@ -154,6 +155,53 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
GHCup always needs to know which version the bindist corresponds to (this is not automatically GHCup always needs to know which version the bindist corresponds to (this is not automatically
detected). detected).
### Tips and tricks
#### with_ghc wrapper (e.g. for HLS)
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:
```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
}
```
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.
## Design goals ## Design goals
1. simplicity 1. simplicity
@@ -230,16 +278,110 @@ to figure out whether you have the correct toolchain and
the correct dependencies. Refer to [the official docs](https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Linux) the correct dependencies. Refer to [the official docs](https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Linux)
on how to prepare your environment for building GHC. on how to prepare your environment for building GHC.
### Stack support
There may be a number of bugs when trying to make ghcup installed GHC versions work with stack,
such as:
- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/188
Further, stack's upgrade procedure may break/confuse ghcup. There are a number of integration
issues discussed here:
- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/153
### Windows support
Windows support is in early stages. Since windows doesn't support symbolic links properly,
ghcup uses a [shimgen wrapper](https://github.com/71/scoop-better-shimexe). It seems to work
well, but there may be unknown issues with that approach.
Windows 7 and Powershell 2.0 aren't well supported at the moment, also see:
- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140
- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197
## FAQ ## FAQ
1. Why reimplement stack? ### Why reimplement stack?
ghcup is not a reimplementation of stack. The only common part is automatic installation of GHC, but even that differs in scope and design. GHCup is not a reimplementation of stack. The only common part is automatic installation of GHC,
but even that differs in scope and design.
2. Why not support windows? ### Why should I use ghcup over stack?
We do. GHCup is not a replacement for stack. Instead, it supports installing and managing stack versions.
It does the same for cabal, GHC and HLS. As such, It doesn't make a workflow choice for you.
3. Why the haskell reimplementation? ### Why should I let ghcup manage stack?
:-) You don't need to. However, some users seem to prefer to have a central tool that manages cabal and stack
at the same time. Additionally, it can allow better sharing of GHC installation across these tools.
Also see:
* https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc
* https://github.com/commercialhaskell/stack/pull/5585
### Why does ghcup not use stack code?
Oddly, this question has been asked a couple of times. For the curious, here are a few reasons:
1. GHCup started as a shell script. At the time of rewriting it in Haskell, the authors didn't even know that stack exposes *some* of its [installation API](https://hackage.haskell.org/package/stack-2.5.1.1/docs/Stack-Setup.html)
2. Even if they did, it doesn't seem it would have satisfied their needs
- it didn't support cabal installation, which was the main motivation behind GHCup back then
- depending on a codebase as big as stack for a central part of one's application without having a short contribution pipeline would likely have caused stagnation or resulted in simply copy-pasting the relevant code in order to adjust it
- it's not clear how GHCup would have been implemented with the provided API. It seems the codebases are fairly different. GHCup does a lot of symlink handling to expose a central `bin/` directory that users can easily put in PATH, without having to worry about anything more. It also provides explicit removal functionality, GHC cross-compilation, a TUI, etc etc.
3. GHCup is built around unix principles and supposed to be simple.
### Why not unify...
#### ...stack and Cabal and do away with standalone installers
GHCup is not involved in such decisions. cabal-install and stack might have a
sufficiently different user experience to warrant having a choice.
#### ...installer implementations and have a common library
This sounds like an interesting goal. However, GHC installation isn't a hard engineering problem
and the shared code wouldn't be too exciting. For such an effort to make sense, all involved
parties would need to collaborate and have a short pipeline to get patches in.
It's true this would solve the integration problem, but following unix principles, we can
do similar via **hooks**. Both cabal and stack can support installation hooks. These hooks
can then call into ghcup or anything else, also see:
* https://github.com/haskell/cabal/issues/7394
* https://github.com/commercialhaskell/stack/pull/5585
#### ...installers (like, all of it)
So far, there hasn't been an **open** discussion about this. Is this even a good idea?
Sometimes projects converge eventually if their overlap is big enough, sometimes they don't.
While unification sounds like a simplification of the ecosystem, it also takes away choice.
Take `curl` and `wget` as an example.
How bad do we need this?
### Why not support windows?
Windows is supported since GHCup version 0.1.15.1.
### Why the haskell reimplementation?
GHCup started as a portable posix shell script of maybe 50 LOC. GHC installation itself can be carried out in
about ~3 lines of shell code (download, unpack , configure+make install). However, much convenient functionality
has been added since, as well as ensuring that all operations are safe and correct. The shell script ended up with
over 2k LOC, which was very hard to maintain.
The main concern when switching from a portable shell script to haskell was platform/architecture support.
However, ghcup now re-uses GHCs CI infrastructure and as such is perfectly in sync with all platforms that
GHC supports.
### Is GHCup affiliated with the Haskell Foundation?
There has been some collaboration: Windows and Stack support were mainly requested by the Haskell Foundation
and those seemed interesting features to add.
Other than that, GHCup is dedicated only to its users and is supported by haskell.org through hosting and CI
infrastructure.

View File

@@ -126,7 +126,7 @@ validate dls _ = do
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|] _ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
checkUniqueTags tool = do checkUniqueTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
let nonUnique = let nonUnique =
fmap fst fmap fst
. filter (\(_, b) -> not b) . filter (\(_, b) -> not b)
@@ -164,7 +164,7 @@ validate dls _ = do
-- a tool must have at least one of each mandatory tags -- a tool must have at least one of each mandatory tags
checkMandatoryTags tool = do checkMandatoryTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
forM_ [Latest, Recommended] $ \t -> case elem t allTags of forM_ [Latest, Recommended] $ \t -> case elem t allTags of
False -> do False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|] lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
@@ -174,7 +174,7 @@ validate dls _ = do
-- all GHC versions must have a base tag -- all GHC versions must have a base tag
checkGHCHasBaseVersion = do checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, tags) -> case any isBase tags of forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
False -> do False -> do
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|] lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
addError addError
@@ -237,7 +237,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
($(logError) $ T.pack $ prettyShow e) ($(logError) $ T.pack $ prettyShow e)
liftIO $ exitWith (ExitFailure 2) liftIO $ exitWith (ExitFailure 2)
let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
r <- r <-
runLogger runLogger
@@ -256,7 +256,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
case etool of case etool of
Right (Just GHCup) -> do Right (Just GHCup) -> do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download dli tmpUnpack Nothing _ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing pure Nothing
Right _ -> do Right _ -> do
p <- liftE $ downloadCached dli Nothing p <- liftE $ downloadCached dli Nothing
@@ -266,7 +266,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
$ p $ p
Left ShimGen -> do Left ShimGen -> do
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download dli tmpUnpack Nothing _ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing pure Nothing
case r of case r of
VRight (Just basePath) -> do VRight (Just basePath) -> do

View File

@@ -440,27 +440,29 @@ install' _ (_, ListResult {..}) = do
, TagNotFound , TagNotFound
, DigestError , DigestError
, DownloadFailed , DownloadFailed
, DirNotEmpty
, NoUpdate , NoUpdate
, TarDirDoesNotExist , TarDirDoesNotExist
, FileAlreadyExistsError
] ]
run (do run (do
case lTool of case lTool of
GHC -> do GHC -> do
let vi = getVersionInfo lVer GHC dls let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer $> vi liftE $ installGHCBin lVer Nothing $> vi
Cabal -> do Cabal -> do
let vi = getVersionInfo lVer Cabal dls let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer $> vi liftE $ installCabalBin lVer Nothing $> vi
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi liftE $ upgradeGHCup Nothing False $> vi
HLS -> do HLS -> do
let vi = getVersionInfo lVer HLS dls let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer $> vi liftE $ installHLSBin lVer Nothing $> vi
Stack -> do Stack -> do
let vi = getVersionInfo lVer Stack dls let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer $> vi liftE $ installStackBin lVer Nothing $> vi
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do

View File

@@ -78,6 +78,8 @@ import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y
import qualified Data.Yaml.Pretty as YP
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC import qualified Text.Megaparsec.Char as MPC
@@ -105,6 +107,7 @@ data Command
| Rm (Either RmCommand RmOptions) | Rm (Either RmCommand RmOptions)
| DInfo | DInfo
| Compile CompileCommand | Compile CompileCommand
| Config ConfigCommand
| Whereis WhereisOptions WhereisCommand | Whereis WhereisOptions WhereisCommand
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool
| ToolRequirements | ToolRequirements
@@ -138,6 +141,7 @@ data InstallOptions = InstallOptions
, instPlatform :: Maybe PlatformRequest , instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI , instBindist :: Maybe URI
, instSet :: Bool , instSet :: Bool
, isolateDir :: Maybe FilePath
} }
data SetCommand = SetGHC SetOptions data SetCommand = SetGHC SetOptions
@@ -173,6 +177,8 @@ data RmOptions = RmOptions
data CompileCommand = CompileGHC GHCCompileOptions data CompileCommand = CompileGHC GHCCompileOptions
data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
data GHCCompileOptions = GHCCompileOptions data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: Either Version GitBranch { targetGhc :: Either Version GitBranch
, bootstrapGhc :: Either Version FilePath , bootstrapGhc :: Either Version FilePath
@@ -185,6 +191,7 @@ data GHCCompileOptions = GHCCompileOptions
, ovewrwiteVer :: Maybe Version , ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String , buildFlavour :: Maybe String
, hadrian :: Bool , hadrian :: Bool
, isolateDir :: Maybe FilePath
} }
data UpgradeOpts = UpgradeInplace data UpgradeOpts = UpgradeInplace
@@ -408,6 +415,12 @@ com =
<> footerDoc (Just $ text changeLogFooter) <> footerDoc (Just $ text changeLogFooter)
) )
) )
<> command
"config"
( Config
<$> info (configP <**> helper)
(progDesc "Show or set config" <> footerDoc (Just $ text configFooter))
)
<> commandGroup "Other commands:" <> commandGroup "Other commands:"
<> hidden <> hidden
) )
@@ -482,6 +495,17 @@ Examples:
ghcup prefetch ghc 8.10.5 ghcup prefetch ghc 8.10.5
ghcup --offline install ghc 8.10.5|] ghcup --offline install ghc 8.10.5|]
configFooter :: String
configFooter = [s|Examples:
# show current config
ghcup config
# initialize config
ghcup config init
# set <key> <value> configuration pair
ghcup config <key> <value>|]
installCabalFooter :: String installCabalFooter :: String
installCabalFooter = [s|Discussion: installCabalFooter = [s|Discussion:
@@ -574,7 +598,7 @@ Examples:
installOpts :: Maybe Tool -> Parser InstallOptions installOpts :: Maybe Tool -> Parser InstallOptions
installOpts tool = installOpts tool =
(\p (u, v) b -> InstallOptions v p u b) (\p (u, v) b is -> InstallOptions v p u b is)
<$> optional <$> optional
(option (option
(eitherReader platformParser) (eitherReader platformParser)
@@ -603,6 +627,15 @@ installOpts tool =
(long "set" <> help (long "set" <> help
"Set as active version after install" "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"
)
)
setParser :: Parser (Either SetCommand SetOptions) setParser :: Parser (Either SetCommand SetOptions)
@@ -786,6 +819,19 @@ Examples:
# build cross compiler # 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|] ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
configP :: Parser ConfigCommand
configP = subparser
( command "init" initP
<> command "set" setP -- [set] KEY VALUE at help lhs
<> command "show" showP
)
<|> 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")
argsP = SetConfig <$> argument str (metavar "KEY") <*> argument str (metavar "VALUE")
whereisP :: Parser WhereisCommand whereisP :: Parser WhereisCommand
whereisP = subparser whereisP = subparser
@@ -1000,6 +1046,15 @@ ghcCompileOpts =
<*> switch <*> switch
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)" (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"
)
)
toolVersionParser :: Parser ToolVersion toolVersionParser :: Parser ToolVersion
@@ -1061,6 +1116,7 @@ tagCompleter tool add = listIOCompleter $ do
VRight ghcupInfo -> do VRight ghcupInfo -> do
let allTags = filter (\t -> t /= Old) let allTags = filter (\t -> t /= Old)
$ join $ join
$ fmap _viTags
$ M.elems $ M.elems
$ availableToolVersions (_ghcupDownloads ghcupInfo) tool $ availableToolVersions (_ghcupDownloads ghcupInfo) tool
pure $ nub $ (add ++) $ fmap tagToString allTags pure $ nub $ (add ++) $ fmap tagToString allTags
@@ -1214,6 +1270,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
bindistParser :: String -> Either String URI bindistParser :: String -> Either String URI
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
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."
toSettings :: Options -> IO (Settings, KeyBindings) toSettings :: Options -> IO (Settings, KeyBindings)
toSettings options = do toSettings options = do
@@ -1257,6 +1317,21 @@ toSettings options = do
, bShowAllTools = fromMaybe bShowAllTools kShowAllTools , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
} }
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
updateSettings config settings = do
settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
pure $ mergeConf settings' settings
where
mergeConf :: UserSettings -> Settings -> Settings
mergeConf UserSettings{..} Settings{..} =
let cache' = fromMaybe cache uCache
noVerify' = fromMaybe noVerify uNoVerify
keepDirs' = fromMaybe keepDirs uKeepDirs
downloader' = fromMaybe downloader uDownloader
verbose' = fromMaybe verbose uVerbose
urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork'
upgradeOptsP :: Parser UpgradeOpts upgradeOptsP :: Parser UpgradeOpts
upgradeOptsP = upgradeOptsP =
@@ -1291,6 +1366,11 @@ describe_result = $( LitE . StringL <$>
) )
) )
formatConfig :: UserSettings -> String
formatConfig settings
= UTF8.toString . YP.encodePretty yamlConfig $ settings
where
yamlConfig = YP.setConfCompare compare YP.defConfig
main :: IO () main :: IO ()
main = do main = do
@@ -1390,9 +1470,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash) race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
(threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|])) (threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case case optCommand of
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates Nuke -> pure ()
Just _ -> pure () Whereis _ _ -> pure ()
DInfo -> pure ()
ToolRequirements -> pure ()
ChangeLog _ -> pure ()
#if defined(BRICK)
Interactive -> pure ()
#endif
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
Just _ -> pure ()
-- TODO: always run for windows -- TODO: always run for windows
(siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case (siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case
@@ -1435,6 +1524,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#endif #endif
, FileDoesNotExistError , FileDoesNotExistError
, CopyError , CopyError
, NotInstalled
, DirNotEmpty
, NoDownload , NoDownload
, NotInstalled , NotInstalled
, BuildFailed , BuildFailed
@@ -1444,6 +1535,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TarDirDoesNotExist , TarDirDoesNotExist
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, FileAlreadyExistsError
] ]
let runInstTool mInstPlatform action' = do let runInstTool mInstPlatform action' = do
@@ -1545,6 +1637,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, NotInstalled , NotInstalled
, DirNotEmpty
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
@@ -1607,22 +1700,23 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
----------------------- -----------------------
let installGHC InstallOptions{..} = let installGHC InstallOptions{..} =
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBin (_tvVersion v) isolateDir
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
Just uri -> do
s' <- liftIO appState
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBin (_tvVersion v) liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
isolateDir
when instSet $ void $ liftE $ setGHC v SetGHCOnly when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi pure vi
Just uri -> do )
s' <- liftIO appState
runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
)
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ $(logInfo) "GHC installation successful" runLogger $ $(logInfo) "GHC installation successful"
@@ -1651,7 +1745,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBin (_tvVersion v) liftE $ installCabalBin (_tvVersion v) isolateDir
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
@@ -1660,6 +1754,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
liftE $ installCabalBindist liftE $ installCabalBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
isolateDir
pure vi pure vi
) )
>>= \case >>= \case
@@ -1679,10 +1774,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 4 pure $ ExitFailure 4
let installHLS InstallOptions{..} = let installHLS InstallOptions{..} =
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS (v, vi) <- liftE $ fromVersion instVer HLS
liftE $ installHLSBin (_tvVersion v) liftE $ installHLSBin (_tvVersion v) isolateDir
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
@@ -1691,6 +1786,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
liftE $ installHLSBindist liftE $ installHLSBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
isolateDir
pure vi pure vi
) )
>>= \case >>= \case
@@ -1710,19 +1806,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 4 pure $ ExitFailure 4
let installStack InstallOptions{..} = let installStack InstallOptions{..} =
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBin (_tvVersion v) liftE $ installStackBin (_tvVersion v) isolateDir
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack (v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBindist liftE $ installStackBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
pure vi isolateDir
pure vi
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
@@ -1951,6 +2048,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
addConfArgs addConfArgs
buildFlavour buildFlavour
hadrian hadrian
isolateDir
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
@@ -1980,6 +2078,37 @@ Make sure to clean up #{tmpdir} afterwards.|])
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 9 pure $ ExitFailure 9
Config InitConfig -> do
path <- getConfigFilePath
writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
runLogger $ $(logDebug) [i|"config.yaml initialized at #{path}|]
pure ExitSuccess
Config ShowConfig -> do
putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
pure ExitSuccess
Config (SetConfig k v) -> do
case v of
"" -> do
runLogger $ $(logError) "Empty values are not allowed"
pure $ ExitFailure 55
_ -> do
r <- runE @'[JSONError] $ do
settings' <- updateSettings [i|#{k}: #{v}\n|] settings
path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
runLogger $ $(logDebug) $ T.pack $ show settings'
pure ()
case r of
VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do
runLogger $ $(logError)
[i|Error decoding config: #{e}|]
pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65
Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) -> Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
runLeanWhereIs (do runLeanWhereIs (do
loc <- liftE $ whereIsTool tool v loc <- liftE $ whereIsTool tool v
@@ -2017,22 +2146,25 @@ Make sure to clean up #{tmpdir} afterwards.|])
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt)) UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade (liftE $ upgradeGHCup target force') >>= \case runUpgrade (do
VRight v' -> do v' <- liftE $ upgradeGHCup target force'
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let pretty_v = prettyVer v' pure (v', dls)
let vi = fromJust $ snd <$> getLatest dls GHCup ) >>= \case
runLogger $ $(logInfo) VRight (v', dls) -> do
[i|Successfully upgraded GHCup to version #{pretty_v}|] let pretty_v = prettyVer v'
forM_ (_viPostInstall vi) $ \msg -> let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo) msg runLogger $ $(logInfo)
pure ExitSuccess [i|Successfully upgraded GHCup to version #{pretty_v}|]
VLeft (V NoUpdate) -> do forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logWarn) [i|No GHCup update available|] runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft (V NoUpdate) -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logWarn) [i|No GHCup update available|]
pure $ ExitFailure 11 pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 11
ToolRequirements -> do ToolRequirements -> do
s' <- appState s' <- appState
@@ -2116,7 +2248,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
runLogger $ $logInfo "Nuclear Annihilation complete!" runLogger $ $logInfo "Nuclear Annihilation complete!"
pure ExitSuccess pure ExitSuccess
| otherwise -> do | otherwise -> do
runLogger $ $logWarn "These Files have survived Nuclear Annihilation, you may remove them manually." runLogger $ $logError "These Files have survived Nuclear Annihilation, you may remove them manually."
forM_ leftOverFiles putStrLn forM_ leftOverFiles putStrLn
pure ExitSuccess pure ExitSuccess

View File

@@ -20,7 +20,7 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.15.2" ghver="0.1.16.1"
base_url="https://downloads.haskell.org/~ghcup" base_url="https://downloads.haskell.org/~ghcup"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes

View File

@@ -276,7 +276,7 @@ if ($CabalDir) {
while ($true) { while ($true) {
$defaultCabalDir = ('{0}\cabal' -f $GhcupBasePrefix) $defaultCabalDir = ('{0}\cabal' -f $GhcupBasePrefix)
Print-Msg -color Magenta -msg ('Specify Cabal directory (this is where haskell packages end up). Press enter to accept the default [{0}]:' -f $defaultCabalDir) Print-Msg -color Magenta -msg ('Specify Cabal directory (this is where haskell packages end up){1}Press enter to accept the default [{0}]:' -f $defaultCabalDir, "`n")
$CabalDirPrompt = Read-Host $CabalDirPrompt = Read-Host
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt] $CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
@@ -371,7 +371,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu' Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
Print-Msg -msg 'Installing Dependencies...' Print-Msg -msg 'Installing Dependencies...'
Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl mingw-w64-x86_64-pkgconf' Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf'
Print-Msg -msg 'Updating SSL root certificate authorities...' Print-Msg -msg 'Updating SSL root certificate authorities...'
Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates' Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'
@@ -383,7 +383,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
while ($true) { while ($true) {
if ($GhcupMsys2) { if ($GhcupMsys2) {
$defaultMsys2Dir = $GhcupMsys2 $defaultMsys2Dir = $GhcupMsys2
Print-Msg -color Magenta -msg ('Input existing MSys2 toolchain directory. Press enter to accept the default [{0}]:' -f $defaultMsys2Dir) Print-Msg -color Magenta -msg ('Input existing MSys2 toolchain directory.{1}Press enter to accept the default [{0}]:' -f $defaultMsys2Dir, "`n")
$MsysDirPrompt = Read-Host $MsysDirPrompt = Read-Host
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt] $MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
} else { } else {
@@ -412,11 +412,74 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
} }
Print-Msg -msg 'Creating shortcuts...' Print-Msg -msg 'Creating shortcuts...'
$uninstallShortCut = @'
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
'&Abort'), 0)
if ($decision -eq 1) {
Exit 0
}
Write-Host 'Removing ghcup toolchain' -ForegroundColor Green
ghcup nuke
Write-Host 'Unsetting GHCUP_INSTALL_BASE_PREFIX' -ForegroundColor Green
[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)
$ghcupMsys2 = [System.Environment]::GetEnvironmentVariable('GHCUP_MSYS2', 'user')
$GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
if ($ghcupMsys2) {
$msys2Dir = [IO.Path]::GetFullPath($ghcupMsys2)
$baseDir = [IO.Path]::GetFullPath('{0}\ghcup' -f $GhcupBasePrefixEnv)
if ($msys2Dir.StartsWith($baseDir)) {
Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
} else {
Write-Host ('GHCUP_MSYS2 env variable is set to a non-standard location {0}. Environment variable not unset. Uninstall manually.' -f $msys2Dir) -ForegroundColor Magenta
}
} else {
Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
}
Write-Host 'Removing ghcup from PATH env var' -ForegroundColor Green
$path = [System.Environment]::GetEnvironmentVariable(
'PATH',
'user'
)
$path = ($path.Split(';') | Where-Object { $_ -ne ('{0}\bin' -f $baseDir) }) -join ';'
[System.Environment]::SetEnvironmentVariable(
'PATH',
$path,
'user'
)
Write-Host 'Removing desktop files' -ForegroundColor Green
$DesktopDir = [Environment]::GetFolderPath("Desktop")
Remove-Item -LiteralPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir) -Force
Remove-Item -LiteralPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir) -Force
Remove-Item -LiteralPath ('{0}\Mingw package management docs.url' -f $DesktopDir) -Force
Write-Host ('CABAL_DIR env variable is still set to {0} and will be used by cabal regardless of ghcup. You may want to uninstall this manually.' -f [System.Environment]::GetEnvironmentVariable('CABAL_DIR', 'user')) -ForegroundColor Magenta
Write-Host 'You may remove this script now.' -ForegroundColor Magenta
if ($Host.Name -eq "ConsoleHost")
{
Write-Host "Press any key to continue..."
$Host.UI.RawUI.ReadKey("NoEcho,IncludeKeyUp") > $null
}
'@
$DesktopDir = [Environment]::GetFolderPath("Desktop") $DesktopDir = [Environment]::GetFolderPath("Desktop")
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"' $GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir) Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir)
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir) Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir)
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Mingw package management docs.url' -f $DesktopDir) Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Mingw package management docs.url' -f $DesktopDir)
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir) Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User' Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

View File

@@ -8,6 +8,11 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package source-repository-package
type: git type: git
location: https://github.com/Bodigrim/tar location: https://github.com/Bodigrim/tar

View File

@@ -5,7 +5,7 @@ constraints: any.Cabal ==3.2.1.0,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.1, any.StateVar ==1.2.2,
any.aeson ==1.5.6.0, any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast, aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8, any.aeson-pretty ==0.8.8,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.2.1.0,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25, any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.1,
any.brick ==0.61, any.brick ==0.63,
brick -demos, brick -demos,
any.bytestring ==0.10.12.0, any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
@@ -66,7 +66,7 @@ constraints: any.Cabal ==3.2.1.0,
any.config-ini ==0.2.4.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.4.1, any.containers ==0.6.4.1,
any.contravariant ==1.5.3, any.contravariant ==1.5.4,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
@@ -111,7 +111,7 @@ constraints: any.Cabal ==3.2.1.0,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10, any.hspec-discover ==2.7.10 || ==2.8.2,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
@@ -137,7 +137,7 @@ constraints: any.Cabal ==3.2.1.0,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.2.3, any.monad-control ==1.0.3,
any.monad-logger ==0.3.36, any.monad-logger ==0.3.36,
monad-logger +template_haskell, monad-logger +template_haskell,
any.monad-loops ==0.4.3, any.monad-loops ==0.4.3,
@@ -176,7 +176,7 @@ constraints: any.Cabal ==3.2.1.0,
any.recursion-schemes ==5.2.2.1, any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.0, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2, any.resourcet ==1.2.4.2,
any.rts ==1.0.1, any.rts ==1.0.1,
@@ -228,7 +228,7 @@ constraints: any.Cabal ==3.2.1.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2, any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.6.6, any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0, any.typed-process ==0.2.6.0,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
@@ -261,4 +261,4 @@ constraints: any.Cabal ==3.2.1.0,
any.zlib-bindings ==0.1.1.5, any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.2.0, any.zstd ==0.1.2.0,
zstd +standalone zstd +standalone
index-state: hackage.haskell.org 2021-07-12T18:00:24Z index-state: hackage.haskell.org 2021-07-27T07:59:57Z

View File

@@ -8,6 +8,11 @@ package ghcup
tests: True tests: True
flags: +tui flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package source-repository-package
type: git type: git
location: https://github.com/Bodigrim/tar location: https://github.com/Bodigrim/tar

View File

@@ -5,7 +5,7 @@ constraints: any.Cabal ==3.4.0.0,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config, HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.QuickCheck ==2.14.2, any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell, QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.1, any.StateVar ==1.2.2,
any.aeson ==1.5.6.0, any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast, aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8, any.aeson-pretty ==0.8.8,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.4.0.0,
any.binary ==0.8.8.0, any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25, any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1, any.blaze-builder ==0.4.2.1,
any.brick ==0.61, any.brick ==0.63,
brick -demos, brick -demos,
any.bytestring ==0.10.12.1, any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0, any.bz2 ==1.0.1.0,
@@ -66,7 +66,7 @@ constraints: any.Cabal ==3.4.0.0,
any.config-ini ==0.2.4.0, any.config-ini ==0.2.4.0,
config-ini -enable-doctests, config-ini -enable-doctests,
any.containers ==0.6.4.1, any.containers ==0.6.4.1,
any.contravariant ==1.5.3, any.contravariant ==1.5.4,
contravariant +semigroups +statevar +tagged, contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1, any.cpphs ==1.20.9.1,
cpphs -old-locale, cpphs -old-locale,
@@ -112,7 +112,7 @@ constraints: any.Cabal ==3.4.0.0,
hsc2hs -in-ghc-tree, hsc2hs -in-ghc-tree,
any.hspec ==2.7.10, any.hspec ==2.7.10,
any.hspec-core ==2.7.10, any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10, any.hspec-discover ==2.7.10 || ==2.8.2,
any.hspec-expectations ==0.8.2, any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0, any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0, any.http-io-streams ==0.1.6.0,
@@ -137,7 +137,7 @@ constraints: any.Cabal ==3.4.0.0,
any.microlens ==0.4.12.0, any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1, any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10, any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.2.3, any.monad-control ==1.0.3,
any.monad-logger ==0.3.36, any.monad-logger ==0.3.36,
monad-logger +template_haskell, monad-logger +template_haskell,
any.monad-loops ==0.4.3, any.monad-loops ==0.4.3,
@@ -176,7 +176,7 @@ constraints: any.Cabal ==3.4.0.0,
any.recursion-schemes ==5.2.2.1, any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell, recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1, any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.0, any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib, regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2, any.resourcet ==1.2.4.2,
any.rts ==1.0, any.rts ==1.0,
@@ -228,7 +228,7 @@ constraints: any.Cabal ==3.4.0.0,
any.transformers ==0.5.6.2, any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2, any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances, transformers-base +orphaninstances,
any.transformers-compat ==0.6.6, any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0, any.typed-process ==0.2.6.0,
any.unix ==2.7.2.2, any.unix ==2.7.2.2,
@@ -261,4 +261,4 @@ constraints: any.Cabal ==3.4.0.0,
any.zlib-bindings ==0.1.1.5, any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.2.0, any.zstd ==0.1.2.0,
zstd +standalone zstd +standalone
index-state: hackage.haskell.org 2021-07-12T18:00:24Z index-state: hackage.haskell.org 2021-07-27T07:59:57Z

2179
ghcup-0.0.1.json Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1384,7 +1384,7 @@ ghcupDownloads:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7 dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
GHCup: GHCup:
0.1.14: 0.1.16.1:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -1394,22 +1394,22 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919 dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9 dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32

View File

@@ -1451,7 +1451,7 @@ ghcupDownloads:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7 dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
GHCup: GHCup:
0.1.14: 0.1.16.1:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -1461,23 +1461,23 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919 dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9 dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32
HLS: HLS:

View File

@@ -1868,7 +1868,7 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
GHCup: GHCup:
0.1.15.2: 0.1.16.1:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -1878,39 +1878,39 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7 dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20 dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2 dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32
A_ARM64: A_ARM64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-linux-ghcup-0.1.16.1
dlHash: d91b7a5416f292f2cf813824eb419f76ad9976d258cee3581123cb6eb01db9a7 dlHash: 31fecbb704e9e2474804f42817ab17bfac28e32e5aeba93ae3f4c77fbc105706
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-apple-darwin-ghcup-0.1.16.1
dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc dlHash: 52eb69a5693abf6c18f95a3b9bf4dac59696299d690c6397bd22a9091e76d40e
A_ARM: A_ARM:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/armv7-linux-ghcup-0.1.16.1
dlHash: 03a4af5ed895ada1dd21f4cc3f64dc9078a5bf4268313021d004c04bea7f9c2e dlHash: 795dd2032f0f4e4ea9688cd49393aba4c40c9eae84c8dea3477f5f440f750767
HLS: HLS:
1.1.0: 1.1.0:
viTags: viTags:

View File

@@ -96,6 +96,7 @@ toolRequirements:
Linux_Alpine: Linux_Alpine:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- binutils-gold
- curl - curl
- gcc - gcc
- g++ - g++
@@ -2024,7 +2025,7 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
GHCup: GHCup:
0.1.15.2: 0.1.16.1:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -2034,52 +2035,55 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7 dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20 dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Windows: Windows:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-mingw64-ghcup-0.1.15.2.exe dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-mingw64-ghcup-0.1.16.1.exe
dlHash: 4d832052754379531ac472aeef35666e433acfee79d4079826b8ede8ca5de520 dlHash: 62439b45c7bcbc1395afe948393cb8e10bbe4f3af9b1fc58ac78660c2ad616d5
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2 dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32
A_ARM64: A_ARM64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2-r1 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-linux-ghcup-0.1.16.1
dlHash: d853372440f3d43babbb868fad399811241760f2233829c92403fcbea8c547ec dlHash: 31fecbb704e9e2474804f42817ab17bfac28e32e5aeba93ae3f4c77fbc105706
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-apple-darwin-ghcup-0.1.16.1
dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc dlHash: 52eb69a5693abf6c18f95a3b9bf4dac59696299d690c6397bd22a9091e76d40e
A_ARM: A_ARM:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2-r1 dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/armv7-linux-ghcup-0.1.16.1
dlHash: f8add9b39e1f7d0f03904dc69a8683259972a4472432c1ade27d918c39a4a874 dlHash: 795dd2032f0f4e4ea9688cd49393aba4c40c9eae84c8dea3477f5f440f750767
HLS: HLS:
1.1.0: 1.1.0:
viTags: [] viTags: []
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md" viPostInstall: &hls-post-install |
This is just the server part of your LSP configuration. Consult the README on how to
configure HLS, your project and your LSP client in your editor:
https://github.com/haskell/haskell-language-server/blob/master/README.md
viArch: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &hls-64 unknown_versioning: &hls-110-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.1.0/haskell-language-server-Linux-1.1.0.tar.gz dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.1.0/haskell-language-server-Linux-1.1.0.tar.gz
dlHash: 0f0dadb0e9a08273658f565fd71c636801959b954be2737f38f2a1aac522208f dlHash: 0f0dadb0e9a08273658f565fd71c636801959b954be2737f38f2a1aac522208f
Darwin: Darwin:
@@ -2091,17 +2095,15 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/hls/1.1.0/haskell-language-server-Windows-1.1.0.tar.gz dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/hls/1.1.0/haskell-language-server-Windows-1.1.0.tar.gz
dlHash: a1d3f451e64a041aa527a25da29e4716a2de6ae347cef4ef9312fc7611e168cc dlHash: a1d3f451e64a041aa527a25da29e4716a2de6ae347cef4ef9312fc7611e168cc
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-64 unknown_versioning: *hls-110-64
1.2.0: 1.2.0:
viTags: viTags: []
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120 viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md" viPostInstall: *hls-post-install
viArch: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &hls-64 unknown_versioning: &hls-120-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Linux-1.2.0.tar.gz dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Linux-1.2.0.tar.gz
dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927 dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927
Darwin: Darwin:
@@ -2113,7 +2115,29 @@ ghcupDownloads:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea
Linux_Alpine: Linux_Alpine:
unknown_versioning: *hls-64 unknown_versioning: *hls-120-64
1.3.0:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
viPostInstall: *hls-post-install
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &hls-130-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.3.0/haskell-language-server-Linux-1.3.0.tar.gz
dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927
Darwin:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.3.0/haskell-language-server-macOS-1.3.0.tar.gz
dlHash: a310d8a3e9c5c4218210f750682c74a0f82ad0f59995adde0dbe775115b1e357
Windows:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.3.0/haskell-language-server-Windows-1.3.0.tar.gz
dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea
Linux_Alpine:
unknown_versioning: *hls-130-64
Stack: Stack:
2.5.1: 2.5.1:
viTags: viTags:

2235
ghcup-0.0.6.yaml Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.15.2 version: 0.1.16.2
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
@@ -20,6 +20,7 @@ extra-doc-files:
config.yaml config.yaml
ghcup-0.0.4.yaml ghcup-0.0.4.yaml
ghcup-0.0.5.yaml ghcup-0.0.5.yaml
ghcup-0.0.6.yaml
HACKING.md HACKING.md
README.md README.md
RELEASING.md RELEASING.md
@@ -225,6 +226,7 @@ executable ghcup
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
, yaml ^>=0.11.4.0
if flag(internal-downloader) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER

View File

@@ -186,6 +186,7 @@ installGHCBindist :: ( MonadFail m
) )
=> DownloadInfo -- ^ where/how to download => DownloadInfo -- ^ where/how to download
-> Version -- ^ the version to install -> Version -- ^ the version to install
-> Maybe FilePath -- ^ isolated filepath if user passed any
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
@@ -195,16 +196,22 @@ installGHCBindist :: ( MonadFail m
, NotInstalled , NotInstalled
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, DirNotEmpty
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
] ]
m m
() ()
installGHCBindist dlinfo ver = do installGHCBindist dlinfo ver isoFilepath = do
let tver = mkTVer ver let tver = mkTVer ver
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
case isoFilepath of
-- we only care for already installed errors in regular (non-isolated) installs
Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
_ -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -214,9 +221,15 @@ installGHCBindist dlinfo ver = do
toolchainSanityChecks toolchainSanityChecks
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver case isoFilepath of
Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|]
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
Nothing -> do -- regular install
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
liftE $ postGHCInstall tver -- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver
where where
toolchainSanityChecks = do toolchainSanityChecks = do
@@ -250,6 +263,7 @@ installPackedGHC :: ( MonadMask m
'[ BuildFailed '[ BuildFailed
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, DirNotEmpty
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
@@ -257,6 +271,8 @@ installPackedGHC :: ( MonadMask m
installPackedGHC dl msubdir inst ver = do installPackedGHC dl msubdir inst ver = do
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
liftE $ installDestSanityCheck inst
-- unpack -- unpack
tmpUnpack <- lift mkGhcupTmpDir tmpUnpack <- lift mkGhcupTmpDir
liftE $ unpackToDir tmpUnpack dl liftE $ unpackToDir tmpUnpack dl
@@ -270,6 +286,22 @@ installPackedGHC dl msubdir inst ver = do
liftE $ runBuildAction tmpUnpack liftE $ runBuildAction tmpUnpack
(Just inst) (Just inst)
(installUnpackedGHC workdir inst ver) (installUnpackedGHC workdir inst ver)
where
-- | Does basic checks for isolated installs
-- Isolated Directory:
-- 1. if it doesn't exist -> proceed
-- 2. if it exists and is empty -> proceed
-- 3. if it exists and is non-empty -> panic and leave the house
installDestSanityCheck :: ( MonadIO m
, MonadCatch m
) =>
FilePath ->
Excepts '[DirNotEmpty] m ()
installDestSanityCheck isoDir = do
hideErrorDef [doesNotExistErrorType] () $ do
contents <- liftIO $ getDirectoryContentsRecursive isoDir
unless (null contents) (throwE $ DirNotEmpty isoDir)
-- | Install an unpacked GHC distribution. This only deals with the GHC -- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -300,10 +332,6 @@ installUnpackedGHC path inst ver = do
setModificationTime dest mtime setModificationTime dest mtime
#else #else
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
liftIO $ copyDirectoryRecursive path inst $ \source dest -> do
mtime <- getModificationTime source
copyFile source dest
setModificationTime dest mtime
let alpineArgs let alpineArgs
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
@@ -343,6 +371,7 @@ installGHCBin :: ( MonadFail m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version -- ^ the version to install => Version -- ^ the version to install
-> Maybe FilePath -- ^ isolated install filepath, if user passed any
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
@@ -352,15 +381,16 @@ installGHCBin :: ( MonadFail m
, NotInstalled , NotInstalled
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, DirNotEmpty
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
] ]
m m
() ()
installGHCBin ver = do installGHCBin ver isoFilepath = do
dlinfo <- liftE $ getDownloadInfo GHC ver dlinfo <- liftE $ getDownloadInfo GHC ver
installGHCBindist dlinfo ver installGHCBindist dlinfo ver isoFilepath
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as -- | Like 'installCabalBin', except takes the 'DownloadInfo' as
@@ -379,6 +409,7 @@ installCabalBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install filepath, if user provides any.
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@@ -391,23 +422,28 @@ installCabalBindist :: ( MonadMask m
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
, FileAlreadyExistsError
] ]
m m
() ()
installCabalBindist dlinfo ver = do installCabalBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
whenM case isoFilepath of
(lift (cabalInstalled ver) >>= \a -> liftIO $ Nothing -> -- for regular install check if any previous versions installed
handleIO (\_ -> pure False) whenM
$ fmap (\x -> a && x) (lift (cabalInstalled ver) >>= \a -> liftIO $
-- ignore when the installation is a legacy cabal (binary, not symlink) handleIO (\_ -> pure False)
$ pathIsLink (binDir </> "cabal" <> exeExt) $ fmap (\x -> a && x)
) -- ignore when the installation is a legacy cabal (binary, not symlink)
(throwE $ AlreadyInstalled Cabal ver) $ pathIsLink (binDir </> "cabal" <> exeExt)
)
(throwE $ AlreadyInstalled Cabal ver)
_ -> pure () -- check isn't required in isolated installs
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -420,30 +456,37 @@ installCabalBindist dlinfo ver = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
liftE $ installCabal' workdir binDir case isoFilepath of
Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|]
liftE $ installCabalUnpacked workdir isoDir Nothing
-- create symlink if this is the latest version Nothing -> do -- regular install
cVers <- lift $ fmap rights getInstalledCabals liftE $ installCabalUnpacked workdir binDir (Just ver)
let lInstCabal = headMay . reverse . sort $ cVers
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
where -- create symlink if this is the latest version for regular installs
-- | Install an unpacked cabal distribution. cVers <- lift $ fmap rights getInstalledCabals
installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) let lInstCabal = headMay . reverse . sort $ cVers
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
-> FilePath -- ^ Path to install to
-> Excepts '[CopyError] m ()
installCabal' path inst = do
lift $ $(logInfo) "Installing cabal"
let cabalFile = "cabal"
liftIO $ createDirRecursive' inst
let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
let destPath = inst </> destFileName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile <> exeExt)
destPath
lift $ chmod_755 destPath
-- | Install an unpacked cabal distribution.
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst mver' = do
lift $ $(logInfo) "Installing cabal"
let cabalFile = "cabal"
liftIO $ createDirRecursive' inst
let destFileName = cabalFile
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
<> exeExt
let destPath = inst </> destFileName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile <> exeExt)
destPath
lift $ chmod_755 destPath
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and -- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for -- creates a default @cabal -> cabal-x.y.z.q@ symlink for
@@ -462,6 +505,7 @@ installCabalBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath -- isolated install Path, if user provided any
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@@ -474,12 +518,13 @@ installCabalBin :: ( MonadMask m
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
, FileAlreadyExistsError
] ]
m m
() ()
installCabalBin ver = do installCabalBin ver isoFilepath = do
dlinfo <- liftE $ getDownloadInfo Cabal ver dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo ver installCabalBindist dlinfo ver isoFilepath
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as -- | Like 'installHLSBin, except takes the 'DownloadInfo' as
@@ -498,6 +543,7 @@ installHLSBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install path, if user passed any
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@@ -513,14 +559,19 @@ installHLSBindist :: ( MonadMask m
] ]
m m
() ()
installHLSBindist dlinfo ver = do installHLSBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) [i|Requested to install hls version #{ver}|] lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
whenM (lift (hlsInstalled ver)) case isoFilepath of
(throwE $ AlreadyInstalled HLS ver) Nothing ->
-- we only check for already installed in regular (non-isolated) installs
whenM (lift (hlsInstalled ver))
(throwE $ AlreadyInstalled HLS ver)
_ -> pure ()
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -533,46 +584,55 @@ installHLSBindist dlinfo ver = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
liftE $ installHLS' workdir binDir case isoFilepath of
Just isoDir -> do
lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|]
liftE $ installHLSUnpacked workdir isoDir Nothing
-- create symlink if this is the latest version Nothing -> do
hlsVers <- lift $ fmap rights getInstalledHLSs liftE $ installHLSUnpacked workdir binDir (Just ver)
let lInstHLS = headMay . reverse . sort $ hlsVers
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
where -- create symlink if this is the latest version in a regular install
-- | Install an unpacked hls distribution. hlsVers <- lift $ fmap rights getInstalledHLSs
installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) let lInstHLS = headMay . reverse . sort $ hlsVers
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
-> FilePath -- ^ Path to install to
-> Excepts '[CopyError] m ()
installHLS' path inst = do
lift $ $(logInfo) "Installing HLS"
liftIO $ createDirRecursive' inst
-- install haskell-language-server-<ghcver>
bins@(_:_) <- liftIO $ findFiles
path
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
)
forM_ bins $ \f -> do
let toF = dropSuffix exeExt f
<> "~" <> T.unpack (prettyVer ver) <> exeExt
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> f)
(inst </> toF)
lift $ chmod_755 (inst </> toF)
-- install haskell-language-server-wrapper -- | Install an unpacked hls distribution.
let wrapper = "haskell-language-server-wrapper" installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install
-> Excepts '[CopyError] m ()
installHLSUnpacked path inst mver' = do
lift $ $(logInfo) "Installing HLS"
liftIO $ createDirRecursive' inst
-- install haskell-language-server-<ghcver>
bins@(_:_) <- liftIO $ findFiles
path
(makeRegexOpts compExtended
execBlank
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
)
forM_ bins $ \f -> do
let toF = dropSuffix exeExt f
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
<> exeExt
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> wrapper <> exeExt) (path </> f)
(inst </> toF) (inst </> toF)
lift $ chmod_755 (inst </> toF) lift $ chmod_755 (inst </> toF)
-- install haskell-language-server-wrapper
let wrapper = "haskell-language-server-wrapper"
toF = wrapper
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
<> exeExt
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> wrapper <> exeExt)
(inst </> toF)
lift $ chmod_755 (inst </> toF)
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@ -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -590,6 +650,7 @@ installHLSBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@@ -605,9 +666,9 @@ installHLSBin :: ( MonadMask m
] ]
m m
() ()
installHLSBin ver = do installHLSBin ver isoFilepath = do
dlinfo <- liftE $ getDownloadInfo HLS ver dlinfo <- liftE $ getDownloadInfo HLS ver
installHLSBindist dlinfo ver installHLSBindist dlinfo ver isoFilepath
-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
@@ -627,6 +688,7 @@ installStackBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@@ -642,9 +704,9 @@ installStackBin :: ( MonadMask m
] ]
m m
() ()
installStackBin ver = do installStackBin ver isoFilepath = do
dlinfo <- liftE $ getDownloadInfo Stack ver dlinfo <- liftE $ getDownloadInfo Stack ver
installStackBindist dlinfo ver installStackBindist dlinfo ver isoFilepath
-- | Like 'installStackBin', except takes the 'DownloadInfo' as -- | Like 'installStackBin', except takes the 'DownloadInfo' as
@@ -663,6 +725,7 @@ installStackBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@@ -678,14 +741,18 @@ installStackBindist :: ( MonadMask m
] ]
m m
() ()
installStackBindist dlinfo ver = do installStackBindist dlinfo ver isoFilepath = do
lift $ $(logDebug) [i|Requested to install stack version #{ver}|] lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
whenM (lift (stackInstalled ver)) case isoFilepath of
(throwE $ AlreadyInstalled Stack ver) Nothing -> -- check previous versions in case of regular installs
whenM (lift (stackInstalled ver))
(throwE $ AlreadyInstalled Stack ver)
_ -> pure () -- don't do shit for isolates
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@@ -698,31 +765,37 @@ installStackBindist dlinfo ver = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
liftE $ installStack' workdir binDir case isoFilepath of
Just isoDir -> do -- isolated install
lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|]
liftE $ installStackUnpacked workdir isoDir Nothing
Nothing -> do -- regular install
liftE $ installStackUnpacked workdir binDir (Just ver)
-- create symlink if this is the latest version -- create symlink if this is the latest version and a regular install
sVers <- lift $ fmap rights getInstalledStacks sVers <- lift $ fmap rights getInstalledStacks
let lInstStack = headMay . reverse . sort $ sVers let lInstStack = headMay . reverse . sort $ sVers
when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
where
-- | Install an unpacked stack distribution.
installStack' :: (MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
-> FilePath -- ^ Path to install to
-> Excepts '[CopyError] m ()
installStack' path inst = do
lift $ $(logInfo) "Installing stack"
let stackFile = "stack"
liftIO $ createDirRecursive' inst
let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
let destPath = inst </> destFileName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> stackFile <> exeExt)
destPath
lift $ chmod_755 destPath
-- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
-> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated installs
-> Excepts '[CopyError] m ()
installStackUnpacked path inst mver' = do
lift $ $(logInfo) "Installing stack"
let stackFile = "stack"
liftIO $ createDirRecursive' inst
let destFileName = stackFile
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
<> exeExt
let destPath = inst </> destFileName
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> stackFile <> exeExt)
destPath
lift $ chmod_755 destPath
--------------------- ---------------------
@@ -965,9 +1038,9 @@ data ListResult = ListResult
-- | Extract all available tool versions and their tags. -- | Extract all available tool versions and their tags.
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag] availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
availableToolVersions av tool = view availableToolVersions av tool = view
(at tool % non Map.empty % to (fmap _viTags)) (at tool % non Map.empty)
av av
@@ -1018,7 +1091,9 @@ listVersions lt' criteria = do
Stack -> do Stack -> do
slr <- strayStacks avTools sSet stacks slr <- strayStacks avTools sSet stacks
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
GHCup -> pure lr GHCup -> do
let cg = maybeToList $ currentGHCup avTools
pure (sort (cg ++ lr))
Nothing -> do Nothing -> do
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks
@@ -1033,7 +1108,7 @@ listVersions lt' criteria = do
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
) )
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> m [ListResult] -> m [ListResult]
strayGHCs avTools = do strayGHCs avTools = do
ghcs <- getInstalledGHCs ghcs <- getInstalledGHCs
@@ -1081,7 +1156,7 @@ listVersions lt' criteria = do
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
) )
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> m [ListResult] -> m [ListResult]
@@ -1115,7 +1190,7 @@ listVersions lt' criteria = do
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m) , MonadIO m)
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> m [ListResult] -> m [ListResult]
@@ -1150,7 +1225,7 @@ listVersions lt' criteria = do
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
) )
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> m [ListResult] -> m [ListResult]
@@ -1178,6 +1253,26 @@ listVersions lt' criteria = do
[i|Could not parse version of stray directory #{e}|] [i|Could not parse version of stray directory #{e}|]
pure Nothing pure Nothing
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
currentGHCup av =
let currentVer = pvpToVersion ghcUpVer
listVer = Map.lookup currentVer av
latestVer = fst <$> headOf (getTagged Latest) av
recommendedVer = fst <$> headOf (getTagged Latest) av
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
in if | Map.member currentVer av -> Nothing
| otherwise -> Just $ ListResult { lVer = currentVer
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
, lCross = Nothing
, lTool = GHCup
, fromSrc = False
, lStray = isNothing listVer
, lSet = True
, lInstalled = True
, lNoBindist = False
, hlsPowered = False
}
-- NOTE: this are not cross ones, because no bindists -- NOTE: this are not cross ones, because no bindists
toListResult :: ( MonadLogger m toListResult :: ( MonadLogger m
, MonadReader env m , MonadReader env m
@@ -1194,9 +1289,9 @@ listVersions lt' criteria = do
-> [Either FilePath Version] -> [Either FilePath Version]
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> (Version, [Tag]) -> (Version, VersionInfo)
-> m ListResult -> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = do toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
case t of case t of
GHC -> do GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
@@ -1520,8 +1615,11 @@ rmGhcupDirs = do
handleRm $ rmEnvFile envFilePath handleRm $ rmEnvFile envFilePath
handleRm $ rmConfFile confFilePath handleRm $ rmConfFile confFilePath
handleRm $ rmDir cacheDir
-- for xdg dirs, the order matters here
handleRm $ rmDir logsDir handleRm $ rmDir logsDir
handleRm $ rmDir cacheDir
handleRm $ rmBinDir binDir handleRm $ rmBinDir binDir
handleRm $ rmDir recycleDir handleRm $ rmDir recycleDir
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
@@ -1537,18 +1635,18 @@ rmGhcupDirs = do
where where
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m () handleRm :: (MonadCatch m, MonadLogger m) => m () -> m ()
handleRm = handleIO (\e -> $logWarn [i|Part of the cleanup action failed with error: #{displayException e} handleRm = handleIO (\e -> $logDebug [i|Part of the cleanup action failed with error: #{displayException e}
continuing regardless...|]) continuing regardless...|])
rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmEnvFile enFilePath = do rmEnvFile enFilePath = do
$logInfo "Removing Ghcup Environment File" $logInfo "Removing Ghcup Environment File"
deleteFile enFilePath hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmConfFile confFilePath = do rmConfFile confFilePath = do
$logInfo "removing Ghcup Config File" $logInfo "removing Ghcup Config File"
deleteFile confFilePath hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmDir dir = rmDir dir =
@@ -1679,6 +1777,7 @@ compileGHC :: ( MonadMask m
-> [Text] -- ^ additional args to ./configure -> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour -> Maybe String -- ^ build flavour
-> Bool -> Bool
-> Maybe FilePath -- ^ isolate dir
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
@@ -1691,13 +1790,14 @@ compileGHC :: ( MonadMask m
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, NotInstalled , NotInstalled
, DirNotEmpty
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
] ]
m m
GHCTargetVersion GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
= do = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -1767,12 +1867,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
alreadyInstalled <- lift $ ghcInstalled installVer alreadyInstalled <- lift $ ghcInstalled installVer
alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver) alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
when alreadyInstalled $ do when alreadyInstalled $ do
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|] case isolateDir of
Just isoDir ->
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Isolate installing to #{isoDir} |]
Nothing ->
lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
lift $ $(logWarn) lift $ $(logWarn)
"...waiting for 10 seconds before continuing, you can still abort..." "...waiting for 10 seconds before continuing, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene liftIO $ threadDelay 10000000 -- give the user a sec to intervene
ghcdir <- lift $ ghcupGHCDir installVer ghcdir <- case isolateDir of
Just isoDir -> pure isoDir
Nothing -> lift $ ghcupGHCDir installVer
bghc <- case bstrap of bghc <- case bstrap of
Right g -> pure $ Right g Right g -> pure $ Right g
@@ -1789,9 +1895,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
pure (b, bmk) pure (b, bmk)
) )
when alreadyInstalled $ do case isolateDir of
lift $ $(logInfo) [i|Deleting existing installation|] Nothing ->
liftE $ rmGHCVer tver -- only remove old ghc in regular installs
when alreadyInstalled $ do
lift $ $(logInfo) [i|Deleting existing installation|]
liftE $ rmGHCVer tver
_ -> pure ()
forM_ mBindist $ \bindist -> do forM_ mBindist $ \bindist -> do
liftE $ installPackedGHC bindist liftE $ installPackedGHC bindist
@@ -1800,11 +1911,15 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(tver ^. tvVersion) (tver ^. tvVersion)
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
reThrowAll GHCupSetError $ postGHCInstall tver case isolateDir of
-- set and make symlinks for regular (non-isolated) installs
-- restore Nothing -> do
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly reThrowAll GHCupSetError $ postGHCInstall tver
-- restore
when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
_ -> pure ()
pure tver pure tver
@@ -2012,7 +2127,7 @@ endif|]
liftIO $ threadDelay 5000000 liftIO $ threadDelay 5000000
addBuildFlavourToConf bc = case buildFlavour of addBuildFlavourToConf bc = case buildFlavour of
Just bf -> [i|BuildFlavour = #{bf}|] <> [s| Just bf -> [i|BuildFlavour = #{bf}
|] <> [i|#{bc}|] |] <> [i|#{bc}|]
Nothing -> bc Nothing -> bc
@@ -2137,7 +2252,7 @@ upgradeGHCup mtarget force' = do
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
let fn = "ghcup" <> exeExt let fn = "ghcup" <> exeExt
p <- liftE $ download dli tmp (Just fn) p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
let destDir = takeDirectory destFile let destDir = takeDirectory destFile
destFile = fromMaybe (binDir </> fn) mtarget destFile = fromMaybe (binDir </> fn) mtarget
lift $ $(logDebug) [i|mkdir -p #{destDir}|] lift $ $(logDebug) [i|mkdir -p #{destDir}|]
@@ -2164,6 +2279,7 @@ upgradeGHCup mtarget force' = do
------------- -------------
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for -- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
-- both installing from source and bindist. -- both installing from source and bindist.
postGHCInstall :: ( MonadReader env m postGHCInstall :: ( MonadReader env m

View File

@@ -55,20 +55,19 @@ import Data.Aeson
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( mk )
#endif #endif
import Data.List.Extra import Data.List.Extra
import Data.Maybe import Data.Maybe
import Data.String.Interpolate import Data.String.Interpolate
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
#if defined(INTERNAL_DOWNLOADER)
import Data.Time.Format
#endif
import Data.Versions import Data.Versions
import Data.Word8 import Data.Word8 hiding ( isSpace )
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
#if defined(INTERNAL_DOWNLOADER)
import Network.Http.Client hiding ( URL )
#endif
import Optics import Optics
import Prelude hiding ( abs import Prelude hiding ( abs
, readFile , readFile
@@ -76,8 +75,11 @@ import Prelude hiding ( abs
) )
import System.Directory import System.Directory
import System.Environment import System.Environment
import System.Exit
import System.FilePath import System.FilePath
import System.IO.Error import System.IO.Error
import System.IO.Temp
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.SHA256 as SHA256
@@ -85,10 +87,8 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
#if defined(INTERNAL_DOWNLOADER)
import qualified Data.CaseInsensitive as CI
#endif
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y import qualified Data.Yaml as Y
@@ -149,19 +149,14 @@ getDownloadsF = do
in GHCupInfo tr newDownloads newGlobalTools in GHCupInfo tr newDownloads newGlobalTools
readFromCache :: ( MonadReader env m yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
, HasDirs env yamlFromCache uri = do
, MonadIO m Dirs{..} <- getDirs
, MonadCatch m) pure (cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri))
=> URI
-> Excepts '[JSONError, FileDoesNotExistError] m L.ByteString
readFromCache uri = do etagsFile :: FilePath -> FilePath
Dirs{..} <- lift getDirs etagsFile = (<.> "etags")
let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri)
handleIO' NoSuchThing (\_ -> throwE $ FileDoesNotExistError yaml_file)
. liftIO
. L.readFile
$ yaml_file
getBase :: ( MonadReader env m getBase :: ( MonadReader env m
@@ -174,33 +169,51 @@ getBase :: ( MonadReader env m
, MonadMask m , MonadMask m
) )
=> URI => URI
-> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo -> Excepts '[JSONError] m GHCupInfo
getBase uri = do getBase uri = do
Settings { noNetwork } <- lift getSettings Settings { noNetwork } <- lift getSettings
bs <- if noNetwork
then readFromCache uri -- try to download yaml... usually this writes it into cache dir,
else handleIO (\_ -> warnCache >> readFromCache uri) -- but in some cases not (e.g. when using file://), so we honour
. catchE @_ @'[JSONError, FileDoesNotExistError] (\(DownloadFailed _) -> warnCache >> readFromCache uri) -- the return filepath, if any
. reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
$ smartDl uri then pure Nothing
else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
. fmap Just
. smartDl
$ uri
-- if we didn't get a filepath from the download, use the cached yaml
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
lift $ $(logDebug) [i|Decoding yaml at: #{actualYaml}|]
liftE liftE
. lE' @_ @_ @'[JSONError] JSONDecodeError . onE_ (onError actualYaml)
. first show . lEM' @_ @_ @'[JSONError] JSONDecodeError
. Y.decodeEither' . fmap (first (\e -> [i|#{displayException e}
. L.toStrict Consider removing "#{actualYaml}" manually.|]))
$ bs . liftIO
. Y.decodeFileEither
$ actualYaml
where where
warnCache = lift $ $(logWarn) -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
[i|Could not get download info, trying cached version (this may not be recent!)|] -- may re-download and succeed.
onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
onError fp = do
let efp = etagsFile fp
handleIO (\e -> $(logWarn) [i|Couldn't remove file #{efp}, error was: #{displayException e}|])
(hideError doesNotExistErrorType $ rmFile efp)
liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
warnCache s = do
lift $ $(logWarn) [i|Could not get download info, trying cached version (this may not be recent!)|]
lift $ $(logDebug) [i|Error was: #{s}|]
-- First check if the json file is in the ~/.ghcup/cache dir -- First check if the json file is in the ~/.ghcup/cache dir
-- and check it's access time. If it has been accessed within the -- and check it's access time. If it has been accessed within the
-- last 5 minutes, just reuse it. -- last 5 minutes, just reuse it.
-- --
-- If not, then send a HEAD request and check for modification time.
-- Only download the file if the modification time is newer
-- than the local file.
--
-- Always save the local file with the mod time of the remote file. -- Always save the local file with the mod time of the remote file.
smartDl :: forall m1 env1 smartDl :: forall m1 env1
. ( MonadReader env1 m1 . ( MonadReader env1 m1
@@ -214,92 +227,36 @@ getBase uri = do
) )
=> URI => URI
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ DownloadFailed
, HTTPStatusError , DigestError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
, ProcessError
, NoNetwork
] ]
m1 m1
L.ByteString FilePath
smartDl uri' = do smartDl uri' = do
Dirs{..} <- lift getDirs json_file <- lift $ yamlFromCache uri'
let path = view pathL' uri' let scheme = view (uriSchemeL' % schemeBSL') uri'
let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
e <- liftIO $ doesFileExist json_file e <- liftIO $ doesFileExist json_file
if e currentTime <- liftIO getCurrentTime
then do Dirs { cacheDir } <- lift getDirs
accessTime <- liftIO $ getAccessTime json_file
currentTime <- liftIO getCurrentTime
-- access time won't work on most linuxes, but we can try regardless -- for local files, let's short-circuit and ignore access time
if (utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300 if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
then do -- no access in last 5 minutes, re-check upstream mod time | e -> do
getModTime >>= \case accessTime <- liftIO $ getAccessTime json_file
Just modTime -> do
fileMod <- liftIO $ getModificationTime json_file
if modTime > fileMod
then dlWithMod modTime json_file
else liftIO $ L.readFile json_file
Nothing -> do
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
dlWithoutMod json_file
else -- access in less than 5 minutes, re-use file
liftIO $ L.readFile json_file
else do
getModTime >>= \case
Just modTime -> dlWithMod modTime json_file
Nothing -> do
-- although we don't know last-modified, we still save
-- it to a file, so we might use it in offline mode
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
dlWithoutMod json_file
-- access time won't work on most linuxes, but we can try regardless
if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) ->
-- no access in last 5 minutes, re-check upstream mod time
dlWithMod currentTime json_file
| otherwise -> pure json_file
| otherwise -> dlWithMod currentTime json_file
where where
dlWithMod modTime json_file = do dlWithMod modTime json_file = do
bs <- liftE $ downloadBS uri' let (dir, fn) = splitFileName json_file
liftIO $ writeFileWithModTime modTime json_file bs f <- liftE $ download uri' Nothing dir (Just fn) True
pure bs liftIO $ setModificationTime f modTime
dlWithoutMod json_file = do liftIO $ setAccessTime f modTime
bs <- liftE $ downloadBS uri' pure f
lift $ hideError doesNotExistErrorType $ recycleFile json_file
liftIO $ L.writeFile json_file bs
liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
pure bs
getModTime = do
#if !defined(INTERNAL_DOWNLOADER)
pure Nothing
#else
headers <-
handleIO (\_ -> pure mempty)
$ liftE
$ ( catchAllE
(\_ ->
pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
)
$ getHead uri'
)
pure $ parseModifiedHeader headers
parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
parseModifiedHeader headers =
(M.lookup (CI.mk "Last-Modified") headers) >>= \h -> parseTimeM
True
defaultTimeLocale
"%a, %d %b %Y %H:%M:%S %Z"
(T.unpack . decUTF8Safe $ h)
#endif
writeFileWithModTime :: UTCTime -> FilePath -> L.ByteString -> IO ()
writeFileWithModTime utctime path content = do
L.writeFile path content
setModificationTime path utctime
getDownloadInfo :: ( MonadReader env m getDownloadInfo :: ( MonadReader env m
@@ -359,32 +316,30 @@ download :: ( MonadReader env m
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
) )
=> DownloadInfo => URI
-> FilePath -- ^ destination dir -> Maybe T.Text -- ^ expected hash
-> FilePath -- ^ destination dir (ignored for file:// scheme)
-> Maybe FilePath -- ^ optional filename -> Maybe FilePath -- ^ optional filename
-> Bool -- ^ whether to read an write etags
-> Excepts '[DigestError , DownloadFailed] m FilePath -> Excepts '[DigestError , DownloadFailed] m FilePath
download dli dest mfn download uri eDigest dest mfn etags
| scheme == "https" = dl | scheme == "https" = dl
| scheme == "http" = dl | scheme == "http" = dl
| scheme == "file" = cp | scheme == "file" = do
let destFile' = T.unpack . decUTF8Safe $ path
lift $ $(logDebug) [i|using local file: #{destFile'}|]
forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
where where
scheme = view (dlUri % uriSchemeL' % schemeBSL') dli scheme = view (uriSchemeL' % schemeBSL') uri
cp = do
-- destination dir must exist
liftIO $ createDirRecursive' dest
let destFile = getDestFile
let fromFile = T.unpack . decUTF8Safe $ path
liftIO $ copyFile fromFile destFile
pure destFile
dl = do dl = do
let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli)) destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
lift $ $(logInfo) [i|downloading: #{uri'}|] lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|]
-- destination dir must exist -- destination dir must exist
liftIO $ createDirRecursive' dest liftIO $ createDirRecursive' dest
let destFile = getDestFile
-- download -- download
flip onException flip onException
@@ -399,28 +354,140 @@ download dli dest mfn
case downloader of case downloader of
Curl -> do Curl -> do
o' <- liftIO getCurlOpts o' <- liftIO getCurlOpts
liftE $ lEM @_ @'[ProcessError] $ exec "curl" if etags
(o' ++ ["-fL", "-o", destFile, (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing then do
dh <- liftIO $ emptySystemTempFile "curl-header"
flip finally (try @_ @SomeException $ rmFile dh) $
flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
metag <- readETag destFile
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ (if etags then ["--dump-header", dh] else [])
++ maybe [] (\t -> ["-H", [i|If-None-Match: #{t}|]]) metag
++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
headers <- liftIO $ T.readFile dh
-- this nonsense is necessary, because some older versions of curl would overwrite
-- the destination file when 304 is returned
case fmap T.words . listToMaybe . fmap T.strip . T.lines $ headers of
Just (http':sc:_)
| sc == "304"
, T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug [i|Status code was 304, not overwriting|]
| T.pack "HTTP" `T.isPrefixOf` http' -> do
$logDebug [i|Status code was #{sc}, overwriting|]
liftIO $ copyFile (destFile <.> "tmp") destFile
_ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
:: V '[MalformedHeaders]))
writeEtags destFile (parseEtags headers)
else
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
Wget -> do Wget -> do
o' <- liftIO getWgetOpts destFileTemp <- liftIO $ emptySystemTempFile "wget-tmp"
liftE $ lEM @_ @'[ProcessError] $ exec "wget" flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
(o' ++ ["-O", destFile , (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing o' <- liftIO getWgetOpts
if etags
then do
metag <- readETag destFile
let opts = o' ++ maybe [] (\t -> ["--header", [i|If-None-Match: #{t}|]]) metag
++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
case _exitCode of
ExitSuccess -> do
liftIO $ copyFile destFileTemp destFile
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
ExitFailure i'
| i' == 8
, Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
-> do
$logDebug "Not modified, skipping download"
writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
| otherwise -> throwE (NonZeroExit i' "wget" opts)
else do
let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
liftIO $ copyFile destFileTemp destFile
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
Internal -> do Internal -> do
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli) (https, host, fullPath, port) <- liftE $ uriToQuadruple uri
liftE $ downloadToFile https host fullPath port destFile if etags
then do
metag <- readETag destFile
let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
, E.encodeUtf8 etag)]) metag
liftE
$ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
$ do
r <- downloadToFile https host fullPath port destFile addHeaders
writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
else void $ liftE $ catchE @HTTPNotModified
@'[DownloadFailed]
(\e@(HTTPNotModified _) ->
throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
$ downloadToFile https host fullPath port destFile mempty
#endif #endif
liftE $ checkDigest dli destFile forM_ eDigest (liftE . flip checkDigest destFile)
pure destFile pure destFile
-- Manage to find a file we can write the body into.
getDestFile :: FilePath
getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
(dest </>)
mfn
path = view (dlUri % pathL') dli -- Manage to find a file we can write the body into.
getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
getDestFile =
case mfn of
Just fn -> pure (dest </> fn)
Nothing
| let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
, not (null urlBase) -> pure (dest </> urlBase)
-- TODO: remove this once we use hpath again
| otherwise -> throwE $ NoUrlBase uri'
path = view pathL' uri
uri' = decUTF8Safe (serializeURIRef' uri)
parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
parseEtags stderr = do
let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines $ stderr
case T.words <$> mEtag of
(Just []) -> do
$logDebug "Couldn't parse etags, no input: "
pure Nothing
(Just [_, etag']) -> do
$logDebug [i|Parsed etag: #{etag'}|]
pure (Just etag')
(Just xs) -> do
$logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
pure Nothing
Nothing -> do
$logDebug "No etags header found"
pure Nothing
writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
writeEtags destFile getTags = do
getTags >>= \case
Just t -> do
$logDebug [i|Writing etagsFile #{(etagsFile destFile)}|]
liftIO $ T.writeFile (etagsFile destFile) t
Nothing ->
$logDebug [i|No etags files written|]
readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
readETag fp = do
e <- liftIO $ doesFileExist fp
if e
then do
rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
case rE of
(Right et) -> do
$logDebug [i|Read etag: #{et}|]
pure (Just et)
(Left _) -> do
$logDebug [i|Etag file doesn't exist (yet)|]
pure Nothing
else do
$logDebug [i|Skipping and deleting etags file because destination file #{fp} doesn't exist|]
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
pure Nothing
-- | Download into tmpdir or use cached version, if it exists. If filename -- | Download into tmpdir or use cached version, if it exists. If filename
@@ -444,7 +511,7 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing True -> downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download dli tmp mfn liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False
downloadCached' :: ( MonadReader env m downloadCached' :: ( MonadReader env m
@@ -468,9 +535,9 @@ downloadCached' dli mfn mDestDir = do
fileExists <- liftIO $ doesFileExist cachfile fileExists <- liftIO $ doesFileExist cachfile
if if
| fileExists -> do | fileExists -> do
liftE $ checkDigest dli cachfile liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile pure cachfile
| otherwise -> liftE $ download dli destDir mfn | otherwise -> liftE $ download (_dlUri dli) (Just (_dlHash dli)) destDir mfn False
@@ -481,73 +548,6 @@ downloadCached' dli mfn mDestDir = do
-- | This is used for downloading the JSON.
downloadBS :: ( MonadReader env m
, HasSettings env
, MonadCatch m
, MonadIO m
, MonadLogger m
)
=> URI
-> Excepts
'[ FileDoesNotExistError
, HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
, ProcessError
, NoNetwork
]
m
L.ByteString
downloadBS uri'
| scheme == "https"
= dl True
| scheme == "http"
= dl False
| scheme == "file"
= liftIOException doesNotExistErrorType (FileDoesNotExistError $ T.unpack $ decUTF8Safe path)
(liftIO $ L.readFile (T.unpack $ decUTF8Safe path))
| otherwise
= throwE UnsupportedScheme
where
scheme = view (uriSchemeL' % schemeBSL') uri'
path = view pathL' uri'
#if defined(INTERNAL_DOWNLOADER)
dl https = do
#else
dl _ = do
#endif
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
Settings{ downloader, noNetwork } <- lift getSettings
when noNetwork $ throwE NoNetwork
case downloader of
Curl -> do
o' <- liftIO getCurlOpts
let exe = "curl"
args = o' ++ ["-sSfL", T.unpack $ decUTF8Safe $ serializeURIRef' uri']
lift (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' exe args
Wget -> do
o' <- liftIO getWgetOpts
let exe = "wget"
args = o' ++ ["-qO-", T.unpack $ decUTF8Safe $ serializeURIRef' uri']
lift (executeOut exe args Nothing) >>= \case
CapturedProcess ExitSuccess stdout _ -> do
pure stdout
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' exe args
#if defined(INTERNAL_DOWNLOADER)
Internal -> do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
liftE $ downloadBS' https host' fullPath' port'
#endif
checkDigest :: ( MonadReader env m checkDigest :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasSettings env , HasSettings env
@@ -555,10 +555,10 @@ checkDigest :: ( MonadReader env m
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
) )
=> DownloadInfo => T.Text -- ^ the hash
-> FilePath -> FilePath
-> Excepts '[DigestError] m () -> Excepts '[DigestError] m ()
checkDigest dli file = do checkDigest eDigest file = do
Settings{ noVerify } <- lift getSettings Settings{ noVerify } <- lift getSettings
let verify = not noVerify let verify = not noVerify
when verify $ do when verify $ do
@@ -566,7 +566,6 @@ checkDigest dli file = do
lift $ $(logInfo) [i|verifying digest of: #{p'}|] lift $ $(logInfo) [i|verifying digest of: #{p'}|]
c <- liftIO $ L.readFile file c <- liftIO $ L.readFile file
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
let eDigest = view dlHash dli
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)

View File

@@ -9,9 +9,7 @@ module GHCup.Download.IOStreams where
import GHCup.Download.Utils import GHCup.Download.Utils
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.File
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.Applicative import Control.Applicative
@@ -20,7 +18,7 @@ import Control.Monad
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.ByteString.Builder import Data.ByteString.Builder
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( CI, original, mk )
import Data.IORef import Data.IORef
import Data.Maybe import Data.Maybe
import Data.Text.Read import Data.Text.Read
@@ -32,7 +30,6 @@ import Prelude hiding ( abs
, writeFile , writeFile
) )
import System.ProgressBar import System.ProgressBar
import System.IO
import URI.ByteString import URI.ByteString
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
@@ -67,7 +64,7 @@ downloadBS' :: MonadIO m
downloadBS' https host path port = do downloadBS' https host path port = do
bref <- liftIO $ newIORef (mempty :: Builder) bref <- liftIO $ newIORef (mempty :: Builder)
let stepper bs = modifyIORef bref (<> byteString bs) let stepper bs = modifyIORef bref (<> byteString bs)
downloadInternal False https host path port stepper void $ downloadInternal False https host path port stepper (pure ()) mempty
liftIO (readIORef bref <&> toLazyByteString) liftIO (readIORef bref <&> toLazyByteString)
@@ -77,12 +74,17 @@ downloadToFile :: (MonadMask m, MonadIO m)
-> ByteString -- ^ path (e.g. "/my/file") including query -> ByteString -- ^ path (e.g. "/my/file") including query
-> Maybe Int -- ^ optional port (e.g. 3000) -> Maybe Int -- ^ optional port (e.g. 3000)
-> FilePath -- ^ destination file to create and write to -> FilePath -- ^ destination file to create and write to
-> Excepts '[DownloadFailed] m () -> M.Map (CI ByteString) ByteString -- ^ additional headers
downloadToFile https host fullPath port destFile = do -> Excepts '[DownloadFailed, HTTPNotModified] m Response
fd <- liftIO $ openFile destFile WriteMode downloadToFile https host fullPath port destFile addHeaders = do
let stepper = BS.hPut fd let stepper = BS.appendFile destFile
flip finally (liftIO $ hClose fd) setup = BS.writeFile destFile mempty
$ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper catchAllE (\case
(V (HTTPStatusError i headers))
| i == 304
, Just e <- M.lookup (mk "etag") headers -> throwE $ HTTPNotModified (decUTF8Safe e)
v -> throwE $ DownloadFailed v
) $ downloadInternal True https host fullPath port stepper setup addHeaders
downloadInternal :: MonadIO m downloadInternal :: MonadIO m
@@ -92,6 +94,8 @@ downloadInternal :: MonadIO m
-> ByteString -- ^ path with query -> ByteString -- ^ path with query
-> Maybe Int -- ^ optional port -> Maybe Int -- ^ optional port
-> (ByteString -> IO a) -- ^ the consuming step function -> (ByteString -> IO a) -- ^ the consuming step function
-> IO a -- ^ setup action
-> M.Map (CI ByteString) ByteString -- ^ additional headers
-> Excepts -> Excepts
'[ HTTPStatusError '[ HTTPStatusError
, URIParseError , URIParseError
@@ -100,19 +104,21 @@ downloadInternal :: MonadIO m
, TooManyRedirs , TooManyRedirs
] ]
m m
() Response
downloadInternal = go (5 :: Int) downloadInternal = go (5 :: Int)
where where
go redirs progressBar https host path port consumer = do go redirs progressBar https host path port consumer setup addHeaders = do
r <- liftIO $ withConnection' https host port action r <- liftIO $ withConnection' https host port action
veitherToExcepts r >>= \case veitherToExcepts r >>= \case
Just r' -> Right r' ->
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
Nothing -> pure () Left res -> pure res
where where
action c = do action c = do
let q = buildRequest1 $ http GET path let q = buildRequest1 $ do
http GET path
flip M.traverseWithKey addHeaders $ \key val -> setHeader (original key) val
sendRequest c q emptyBody sendRequest c q emptyBody
@@ -121,28 +127,30 @@ downloadInternal = go (5 :: Int)
(\r i' -> runE $ do (\r i' -> runE $ do
let scode = getStatusCode r let scode = getStatusCode r
if if
| scode >= 200 && scode < 300 -> downloadStream r i' >> pure Nothing | scode >= 200 && scode < 300 -> liftIO $ downloadStream r i' >> pure (Left r)
| scode == 304 -> throwE $ HTTPStatusError scode (getHeaderMap r)
| scode >= 300 && scode < 400 -> case getHeader r "Location" of | scode >= 300 && scode < 400 -> case getHeader r "Location" of
Just r' -> pure $ Just r' Just r' -> pure $ Right r'
Nothing -> throwE NoLocationHeader Nothing -> throwE NoLocationHeader
| otherwise -> throwE $ HTTPStatusError scode | otherwise -> throwE $ HTTPStatusError scode (getHeaderMap r)
) )
followRedirectURL bs = case parseURI strictURIParserOptions bs of followRedirectURL bs = case parseURI strictURIParserOptions bs of
Right uri' -> do Right uri' -> do
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri' (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
go (redirs - 1) progressBar https' host' fullPath' port' consumer go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders
Left e -> throwE e Left e -> throwE e
downloadStream r i' = do downloadStream r i' = do
void setup
let size = case getHeader r "Content-Length" of let size = case getHeader r "Content-Length" of
Just x' -> case decimal $ decUTF8Safe x' of Just x' -> case decimal $ decUTF8Safe x' of
Left _ -> 0 Left _ -> 0
Right (r', _) -> r' Right (r', _) -> r'
Nothing -> 0 Nothing -> 0
mpb <- if progressBar (mpb :: Maybe (ProgressBar ())) <- if progressBar
then Just <$> liftIO (newProgressBar defStyle 10 (Progress 0 size ())) then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
else pure Nothing else pure Nothing
outStream <- liftIO $ Streams.makeOutputStream outStream <- liftIO $ Streams.makeOutputStream
@@ -155,79 +163,6 @@ downloadInternal = go (5 :: Int)
liftIO $ Streams.connect i' outStream liftIO $ Streams.connect i' outStream
getHead :: (MonadCatch m, MonadIO m)
=> URI
-> Excepts
'[ HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
, ProcessError
]
m
(M.Map (CI ByteString) ByteString)
getHead uri' | scheme == "https" = head' True
| scheme == "http" = head' False
| otherwise = throwE UnsupportedScheme
where
scheme = view (uriSchemeL' % schemeBSL') uri'
head' https = do
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
liftE $ headInternal https host' fullPath' port'
headInternal :: MonadIO m
=> Bool -- ^ https?
-> ByteString -- ^ host
-> ByteString -- ^ path with query
-> Maybe Int -- ^ optional port
-> Excepts
'[ HTTPStatusError
, URIParseError
, UnsupportedScheme
, TooManyRedirs
, NoLocationHeader
]
m
(M.Map (CI ByteString) ByteString)
headInternal = go (5 :: Int)
where
go redirs https host path port = do
r <- liftIO $ withConnection' https host port action
veitherToExcepts r >>= \case
Left r' ->
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
Right hs -> pure hs
where
action c = do
let q = buildRequest1 $ http HEAD path
sendRequest c q emptyBody
unsafeReceiveResponse
c
(\r _ -> runE $ do
let scode = getStatusCode r
if
| scode >= 200 && scode < 300 -> do
let headers = getHeaderMap r
pure $ Right headers
| scode >= 300 && scode < 400 -> case getHeader r "Location" of
Just r' -> pure $ Left r'
Nothing -> throwE NoLocationHeader
| otherwise -> throwE $ HTTPStatusError scode
)
followRedirectURL bs = case parseURI strictURIParserOptions bs of
Right uri' -> do
(https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
go (redirs - 1) https' host' fullPath' port'
Left e -> throwE e
withConnection' :: Bool withConnection' :: Bool
-> ByteString -> ByteString

View File

@@ -27,6 +27,8 @@ import Codec.Archive
import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar as Tar
#endif #endif
import Control.Exception.Safe import Control.Exception.Safe
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
import Data.String.Interpolate import Data.String.Interpolate
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
@@ -35,6 +37,8 @@ import Text.PrettyPrint hiding ( (<>) )
import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString import URI.ByteString
import qualified Data.Map.Strict as M
------------------------ ------------------------
@@ -130,6 +134,13 @@ instance Pretty AlreadyInstalled where
pPrint (AlreadyInstalled tool ver') = pPrint (AlreadyInstalled tool ver') =
text [i|#{tool}-#{prettyShow ver'} is already installed|] text [i|#{tool}-#{prettyShow ver'} is already installed|]
-- | The Directory is supposed to be empty, but wasn't.
data DirNotEmpty = DirNotEmpty {path :: FilePath}
instance Pretty DirNotEmpty where
pPrint (DirNotEmpty path) = do
text [i|The directory was expected to be empty, but isn't: #{path}|]
-- | The tool is not installed. Some operations rely on a tool -- | The tool is not installed. Some operations rely on a tool
-- to be installed (such as setting the current GHC version). -- to be installed (such as setting the current GHC version).
data NotInstalled = NotInstalled Tool GHCTargetVersion data NotInstalled = NotInstalled Tool GHCTargetVersion
@@ -164,6 +175,16 @@ instance Pretty FileDoesNotExistError where
pPrint (FileDoesNotExistError file) = pPrint (FileDoesNotExistError file) =
text [i|File "#{file}" does not exist.|] text [i|File "#{file}" does not exist.|]
-- | The file already exists
-- (e.g. when we use isolated installs with the same path).
-- (e.g. This is done to prevent any overwriting)
data FileAlreadyExistsError = FileAlreadyExistsError FilePath
deriving Show
instance Pretty FileAlreadyExistsError where
pPrint (FileAlreadyExistsError file) =
text [i|File "#{file}" Already exists.|]
data TarDirDoesNotExist = TarDirDoesNotExist TarDir data TarDirDoesNotExist = TarDirDoesNotExist TarDir
deriving Show deriving Show
@@ -180,13 +201,29 @@ instance Pretty DigestError where
text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|] text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
deriving Show deriving Show
instance Pretty HTTPStatusError where instance Pretty HTTPStatusError where
pPrint (HTTPStatusError status) = pPrint (HTTPStatusError status _) =
text [i|Unexpected HTTP status: #{status}|] text [i|Unexpected HTTP status: #{status}|]
-- | Malformed headers.
data MalformedHeaders = MalformedHeaders Text
deriving Show
instance Pretty MalformedHeaders where
pPrint (MalformedHeaders h) =
text [i|Headers are malformed: #{h}|]
-- | Unexpected HTTP status.
data HTTPNotModified = HTTPNotModified Text
deriving Show
instance Pretty HTTPNotModified where
pPrint (HTTPNotModified etag) =
text [i|Remote resource not modifed, etag was: #{etag}|]
-- | The 'Location' header was expected during a 3xx redirect, but not found. -- | The 'Location' header was expected during a 3xx redirect, but not found.
data NoLocationHeader = NoLocationHeader data NoLocationHeader = NoLocationHeader
deriving Show deriving Show
@@ -307,6 +344,15 @@ instance Pretty UnexpectedListLength where
instance Exception UnexpectedListLength instance Exception UnexpectedListLength
data NoUrlBase = NoUrlBase Text
deriving Show
instance Pretty NoUrlBase where
pPrint (NoUrlBase url) =
text [i|Couldn't get a base filename from url #{url}|]
instance Exception NoUrlBase
------------------------ ------------------------

View File

@@ -304,6 +304,41 @@ data UserSettings = UserSettings
defaultUserSettings :: UserSettings defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
UserSettings {
uCache = Just cache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Nothing
, uUrlSource = Just urlSource
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
{ kUp = Just bUp
, kDown = Just bDown
, kQuit = Just bQuit
, kInstall = Just bInstall
, kUninstall = Just bUninstall
, kSet = Just bSet
, kChangelog = Just bChangelog
, kShowAll = Just bShowAllVersions
, kShowAllTools = Just bShowAllTools
}
in UserSettings {
uCache = Just cache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Just ukb
, uUrlSource = Just urlSource
}
data UserKeyBindings = UserKeyBindings data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Key { kUp :: Maybe Key
, kDown :: Maybe Key , kDown :: Maybe Key

View File

@@ -316,3 +316,6 @@ deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key 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 "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key

View File

@@ -766,49 +766,22 @@ ghcToolFiles ver = do
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
(throwE (NotInstalled GHC ver)) (throwE (NotInstalled GHC ver))
files <- liftIO $ listDirectory bindir files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
-- figure out the <ver> suffix, because this might not be `Version` for pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
-- alpha/rc releases, but x.y.a.somedate.
ghcIsHadrian <- liftIO $ isHadrian bindir
onlyUnversioned <- case ghcIsHadrian of
Right () -> pure id
Left (fmap (dropSuffix exeExt) -> [ghc, ghc_ver])
| (Just symver) <- stripPrefix (ghc <> "-") ghc_ver
, not (null symver) -> pure $ filter (\x -> not $ symver `isInfixOf` x)
_ -> fail "Fatal: Could not find internal GHC version"
pure $ onlyUnversioned $ fmap (dropSuffix exeExt) files
where where
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
-- GHC is moving some builds to Hadrian for bindists,
-- which doesn't create versioned binaries.
-- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
isHadrian :: FilePath -- ^ ghcbin path
-> IO (Either [String] ()) -- ^ Right for Hadrian
isHadrian dir = do
-- Non-hadrian has e.g. ["ghc", "ghc-8.10.4"]
-- which also requires us to discover the internal version
-- to filter the correct tool files.
-- We can't use the symlink on windows, so we fall back to some
-- more complicated logic.
fs <- fmap
-- regex over-matches
(filter (isNotAnyInfix ["haddock", "ghc-pkg", "ghci"]))
$ liftIO $ findFiles
dir
(makeRegexOpts compExtended
execBlank
-- for cross, this won't be "ghc", but e.g.
-- "armv7-unknown-linux-gnueabihf-ghc"
([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc.*$|] :: ByteString)
)
if | length fs == 1 -> pure $ Right () -- hadrian
| length fs == 2 -> pure $ Left
(sortOn length fs) -- legacy make, result should
-- be ["ghc", "ghc-8.10.4"]
| otherwise -> fail "isHadrian failed!"
groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
getUniqueTools :: [[(FilePath, String)]] -> [String]
getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
blackListedTools :: [String]
blackListedTools = ["haddock-ghc"]
isNotAnyInfix :: [String] -> String -> Bool
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that -- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that

View File

@@ -209,6 +209,20 @@ exec exe args chdir env = do
pure $ toProcessError exe args exit_code pure $ toProcessError exe args exit_code
-- | Thin wrapper around `executeFile`.
execShell :: MonadIO m
=> FilePath -- ^ thing to execute
-> [FilePath] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execShell exe args chdir env = do
let cmd = exe <> " " <> concatMap (' ':) args
cp <- createProcessWithMingwPath ((shell cmd) { cwd = chdir, env = env })
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError cmd [] exit_code
chmod_755 :: MonadIO m => FilePath -> m () chmod_755 :: MonadIO m => FilePath -> m ()
chmod_755 fp = chmod_755 fp =
let perm = setOwnerWritable True emptyPermissions let perm = setOwnerWritable True emptyPermissions

View File

@@ -31,7 +31,7 @@ import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.List ( nub ) import Data.List ( nub, intercalate )
import Data.Foldable import Data.Foldable
import Data.String import Data.String
import Data.Text ( Text ) import Data.Text ( Text )
@@ -55,6 +55,7 @@ import GHC.IO.Exception
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S import qualified Data.Strict.Maybe as S
import qualified Data.List.Split as Split
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Encoding.Error as E
@@ -410,12 +411,7 @@ rmPathForcibly :: ( MonadIO m
-> m () -> m ()
rmPathForcibly fp = rmPathForcibly fp =
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10) recover (liftIO $ removePathForcibly fp)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removePathForcibly fp)
#else #else
liftIO $ removePathForcibly fp liftIO $ removePathForcibly fp
#endif #endif
@@ -426,12 +422,7 @@ rmDirectory :: (MonadIO m, MonadMask m)
-> m () -> m ()
rmDirectory fp = rmDirectory fp =
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10) recover (liftIO $ removeDirectory fp)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
]
(\_ -> liftIO $ removeDirectory fp)
#else #else
liftIO $ removeDirectory fp liftIO $ removeDirectory fp
#endif #endif
@@ -469,12 +460,7 @@ rmFile :: ( MonadIO m
-> m () -> m ()
rmFile fp = rmFile fp =
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10) recover (liftIO $ removeFile fp)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removeFile fp)
#else #else
liftIO $ removeFile fp liftIO $ removeFile fp
#endif #endif
@@ -485,12 +471,7 @@ rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
-> m () -> m ()
rmDirectoryLink fp = rmDirectoryLink fp =
#if defined(IS_WINDOWS) #if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10) recover (liftIO $ removeDirectoryLink fp)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removeDirectoryLink fp)
#else #else
liftIO $ removeDirectoryLink fp liftIO $ removeDirectoryLink fp
#endif #endif
@@ -525,8 +506,32 @@ stripNewline s
| otherwise = head s : stripNewline (tail s) | otherwise = head s : stripNewline (tail s)
-- | Strip @\\r@ and @\\n@ from 'ByteString's
stripNewline' :: T.Text -> T.Text
stripNewline' s
| T.null s = mempty
| T.head s `elem` "\n\r" = stripNewline' (T.tail s)
| otherwise = T.singleton (T.head s) <> stripNewline' (T.tail s)
isNewLine :: Word8 -> Bool isNewLine :: Word8 -> Bool
isNewLine w isNewLine w
| w == _lf = True | w == _lf = True
| w == _cr = True | w == _cr = True
| otherwise = False | otherwise = False
-- | Split on a PVP suffix.
--
-- >>> splitOnPVP "-" "ghc-iserv-dyn-9.3.20210706" == ("ghc-iserv-dyn", "9.3.20210706")
-- >>> splitOnPVP "-" "ghc-iserv-dyn" == ("ghc-iserv-dyn", "")
splitOnPVP :: String -> String -> (String, String)
splitOnPVP c s = case Split.splitOn c s of
[] -> def
[_] -> def
xs
| let l = last xs
, (Right _) <- pvp (T.pack l) -> (intercalate c (init xs), l)
| otherwise -> def
where
def = (s, "")

View File

@@ -25,7 +25,7 @@ import qualified Data.Text as T
-- | This reflects the API version of the YAML. -- | This reflects the API version of the YAML.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.5.yaml|] ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: PVP ghcUpVer :: PVP