Compare commits

...

115 Commits

Author SHA1 Message Date
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
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
c439693a8f Fix "display all supported installers" page 2021-07-25 19:10:02 +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
9639e695e2 Unhide stack 2021-07-23 16:13:07 +02:00
d2a2bde321 Merge branch 'mlang-cursor' 2021-07-23 14:46:06 +02:00
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
33 changed files with 24645 additions and 676 deletions

View File

@@ -99,11 +99,12 @@ variables:
script:
- bash ./.gitlab/script/ghcup_version.sh
variables:
JSON_VERSION: "0.0.5"
JSON_VERSION: "0.0.6"
artifacts:
expire_in: 2 week
paths:
- golden
- dist-newstyle/cache/
when: on_failure
# .test_ghcup_scoop:
@@ -202,10 +203,11 @@ variables:
expire_in: 2 week
paths:
- out
- dist-newstyle/cache/
only:
- tags
variables:
JSON_VERSION: "0.0.5"
JSON_VERSION: "0.0.6"
######## 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 "$@"
}
raw_eghcup() {
ghcup -v -c "$@"
}
eghcup() {
if [ "${OS}" = "WINDOWS" ] ; then
ghcup -v -c -s file:/$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
@@ -20,6 +24,12 @@ eghcup() {
fi
}
if [ "${OS}" = "WINDOWS" ] ; then
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
git describe --always
### build
@@ -65,11 +75,7 @@ fi
### cleanup
if [ "${OS}" = "WINDOWS" ] ; then
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
else
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
fi
rm -rf "${GHCUP_DIR}"
### manual cli based testing
@@ -88,6 +94,7 @@ cabal --version
eghcup debug-info
# also test etags
eghcup list
eghcup list -t ghc
eghcup list -t cabal
@@ -109,7 +116,20 @@ else
if [ "${OS}" = "LINUX" ] ; then
eghcup --downloader=wget prefetch 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 --offline install ghc 8.10.3
fi
@@ -155,6 +175,55 @@ if [ "${OS}" = "LINUX" ] ; then
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 -f
@@ -162,8 +231,4 @@ eghcup upgrade -f
# nuke
eghcup nuke
if [ "${OS}" = "WINDOWS" ] ; then
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/ghcup" ]
else
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
fi
[ ! -e "${GHCUP_DIR}" ]

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,23 @@
# Revision history for ghcup
## 0.1.16 -- ????-??-??
## 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 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

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)
* [Env variables](#env-variables)
* [Installing custom bindists](#installing-custom-bindists)
* [Tips and tricks](#tips-and-tricks)
* [Design goals](#design-goals)
* [How](#how)
* [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
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
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)
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
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'}|]
checkUniqueTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)
@@ -164,7 +164,7 @@ validate dls _ = do
-- a tool must have at least one of each mandatory tags
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
False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
@@ -174,7 +174,7 @@ validate dls _ = do
-- all GHC versions must have a base tag
checkGHCHasBaseVersion = do
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
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
addError
@@ -237,7 +237,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
($(logError) $ T.pack $ prettyShow e)
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 <-
runLogger
@@ -256,7 +256,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
case etool of
Right (Just GHCup) -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download dli tmpUnpack Nothing
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
Right _ -> do
p <- liftE $ downloadCached dli Nothing
@@ -266,7 +266,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
$ p
Left ShimGen -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download dli tmpUnpack Nothing
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
case r of
VRight (Just basePath) -> do

View File

@@ -59,7 +59,7 @@ import qualified Data.Vector as V
hiddenTools :: [Tool]
hiddenTools = [Stack]
hiddenTools = []
data BrickData = BrickData
@@ -440,27 +440,29 @@ install' _ (_, ListResult {..}) = do
, TagNotFound
, DigestError
, DownloadFailed
, DirNotEmpty
, NoUpdate
, TarDirDoesNotExist
, FileAlreadyExistsError
]
run (do
case lTool of
GHC -> do
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer $> vi
liftE $ installGHCBin lVer Nothing $> vi
Cabal -> do
let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer $> vi
liftE $ installCabalBin lVer Nothing $> vi
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi
HLS -> do
let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer $> vi
liftE $ installHLSBin lVer Nothing $> vi
Stack -> do
let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer $> vi
liftE $ installStackBin lVer Nothing $> vi
)
>>= \case
VRight vi -> do

View File

@@ -138,6 +138,7 @@ data InstallOptions = InstallOptions
, instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
}
data SetCommand = SetGHC SetOptions
@@ -185,6 +186,7 @@ data GHCCompileOptions = GHCCompileOptions
, ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String
, hadrian :: Bool
, isolateDir :: Maybe FilePath
}
data UpgradeOpts = UpgradeInplace
@@ -574,7 +576,7 @@ Examples:
installOpts :: Maybe Tool -> Parser InstallOptions
installOpts tool =
(\p (u, v) b -> InstallOptions v p u b)
(\p (u, v) b is -> InstallOptions v p u b is)
<$> optional
(option
(eitherReader platformParser)
@@ -603,6 +605,15 @@ installOpts tool =
(long "set" <> help
"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)
@@ -1000,6 +1011,15 @@ ghcCompileOpts =
<*> switch
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
)
)
toolVersionParser :: Parser ToolVersion
@@ -1061,6 +1081,7 @@ tagCompleter tool add = listIOCompleter $ do
VRight ghcupInfo -> do
let allTags = filter (\t -> t /= Old)
$ join
$ fmap _viTags
$ M.elems
$ availableToolVersions (_ghcupDownloads ghcupInfo) tool
pure $ nub $ (add ++) $ fmap tagToString allTags
@@ -1214,6 +1235,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
bindistParser :: String -> Either String URI
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 = do
@@ -1390,9 +1415,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
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|]))
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
Just _ -> pure ()
case optCommand of
Nuke -> 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
(siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case
@@ -1435,6 +1469,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#endif
, FileDoesNotExistError
, CopyError
, NotInstalled
, DirNotEmpty
, NoDownload
, NotInstalled
, BuildFailed
@@ -1444,6 +1480,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TarDirDoesNotExist
, NextVerNotFound
, NoToolVersionSet
, FileAlreadyExistsError
]
let runInstTool mInstPlatform action' = do
@@ -1545,6 +1582,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
, DirNotEmpty
#if !defined(TAR)
, ArchiveResult
#endif
@@ -1607,22 +1645,23 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-----------------------
let installGHC InstallOptions{..} =
(case instBindist of
Nothing -> runInstTool instPlatform $ do
(case instBindist of
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
liftE $ installGHCBin (_tvVersion v)
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_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
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
)
)
>>= \case
VRight vi -> do
runLogger $ $(logInfo) "GHC installation successful"
@@ -1651,7 +1690,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of
Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBin (_tvVersion v)
liftE $ installCabalBin (_tvVersion v) isolateDir
pure vi
Just uri -> do
s' <- appState
@@ -1660,6 +1699,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
liftE $ installCabalBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
isolateDir
pure vi
)
>>= \case
@@ -1679,10 +1719,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 4
let installHLS InstallOptions{..} =
(case instBindist of
(case instBindist of
Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS
liftE $ installHLSBin (_tvVersion v)
liftE $ installHLSBin (_tvVersion v) isolateDir
pure vi
Just uri -> do
s' <- appState
@@ -1691,6 +1731,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
liftE $ installHLSBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
isolateDir
pure vi
)
>>= \case
@@ -1710,19 +1751,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 4
let installStack InstallOptions{..} =
(case instBindist of
Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBin (_tvVersion v)
pure vi
Just uri -> do
s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
pure vi
(case instBindist of
Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBin (_tvVersion v) isolateDir
pure vi
Just uri -> do
s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
isolateDir
pure vi
)
>>= \case
VRight vi -> do
@@ -1951,6 +1993,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
addConfArgs
buildFlavour
hadrian
isolateDir
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $
@@ -2017,22 +2060,25 @@ Make sure to clean up #{tmpdir} afterwards.|])
(UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade (liftE $ upgradeGHCup target force') >>= \case
VRight v' -> do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let pretty_v = prettyVer v'
let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo)
[i|Successfully upgraded GHCup to version #{pretty_v}|]
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) [i|No GHCup update available|]
pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 11
runUpgrade (do
v' <- liftE $ upgradeGHCup target force'
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (v', dls)
) >>= \case
VRight (v', dls) -> do
let pretty_v = prettyVer v'
let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo)
[i|Successfully upgraded GHCup to version #{pretty_v}|]
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logInfo) msg
pure ExitSuccess
VLeft (V NoUpdate) -> do
runLogger $ $(logWarn) [i|No GHCup update available|]
pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 11
ToolRequirements -> do
s' <- appState
@@ -2116,7 +2162,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
runLogger $ $logInfo "Nuclear Annihilation complete!"
pure ExitSuccess
| 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
pure ExitSuccess

View File

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

View File

@@ -276,7 +276,7 @@ if ($CabalDir) {
while ($true) {
$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
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
@@ -371,7 +371,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
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...'
Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'
@@ -383,7 +383,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
while ($true) {
if ($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
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
} else {
@@ -412,11 +412,74 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
}
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")
$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 '-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)
$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)
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

View File

@@ -8,6 +8,11 @@ package ghcup
tests: True
flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package
type: git
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,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.1,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.2.1.0,
any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1,
any.brick ==0.61,
any.brick ==0.63,
brick -demos,
any.bytestring ==0.10.12.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,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.3,
any.contravariant ==1.5.4,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
@@ -111,7 +111,7 @@ constraints: any.Cabal ==3.2.1.0,
hsc2hs -in-ghc-tree,
any.hspec ==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-golden-aeson ==0.9.0.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-mtl ==0.2.0.1,
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,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
@@ -176,7 +176,7 @@ constraints: any.Cabal ==3.2.1.0,
any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell,
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,
any.resourcet ==1.2.4.2,
any.rts ==1.0.1,
@@ -228,7 +228,7 @@ constraints: any.Cabal ==3.2.1.0,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
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,
any.typed-process ==0.2.6.0,
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.zstd ==0.1.2.0,
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
flags: +tui
source-repository-package
type: git
location: https://github.com/jtdaugherty/brick.git
tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
source-repository-package
type: git
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,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.1,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.4.0.0,
any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1,
any.brick ==0.61,
any.brick ==0.63,
brick -demos,
any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0,
@@ -66,7 +66,7 @@ constraints: any.Cabal ==3.4.0.0,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.3,
any.contravariant ==1.5.4,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
@@ -112,7 +112,7 @@ constraints: any.Cabal ==3.4.0.0,
hsc2hs -in-ghc-tree,
any.hspec ==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-golden-aeson ==0.9.0.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-mtl ==0.2.0.1,
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,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
@@ -176,7 +176,7 @@ constraints: any.Cabal ==3.4.0.0,
any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell,
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,
any.resourcet ==1.2.4.2,
any.rts ==1.0,
@@ -228,7 +228,7 @@ constraints: any.Cabal ==3.4.0.0,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
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,
any.typed-process ==0.2.6.0,
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.zstd ==0.1.2.0,
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
dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
GHCup:
0.1.14:
0.1.16.1:
viTags:
- Recommended
- Latest
@@ -1394,22 +1394,22 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14
dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14
dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14
dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14
dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine:
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
dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
GHCup:
0.1.14:
0.1.16.1:
viTags:
- Recommended
- Latest
@@ -1461,23 +1461,23 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14
dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14
dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14
dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14
dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine:
unknown_versioning: *ghcup-32
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
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
GHCup:
0.1.15.2:
0.1.16.1:
viTags:
- Recommended
- Latest
@@ -1878,39 +1878,39 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2
dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2
dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2
dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2
dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine:
unknown_versioning: *ghcup-32
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2
dlHash: d91b7a5416f292f2cf813824eb419f76ad9976d258cee3581123cb6eb01db9a7
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-linux-ghcup-0.1.16.1
dlHash: 31fecbb704e9e2474804f42817ab17bfac28e32e5aeba93ae3f4c77fbc105706
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-apple-darwin-ghcup-0.1.16.1
dlHash: 52eb69a5693abf6c18f95a3b9bf4dac59696299d690c6397bd22a9091e76d40e
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2
dlHash: 03a4af5ed895ada1dd21f4cc3f64dc9078a5bf4268313021d004c04bea7f9c2e
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/armv7-linux-ghcup-0.1.16.1
dlHash: 795dd2032f0f4e4ea9688cd49393aba4c40c9eae84c8dea3477f5f440f750767
HLS:
1.1.0:
viTags:

View File

@@ -96,6 +96,7 @@ toolRequirements:
Linux_Alpine:
unknown_versioning:
distroPKGs:
- binutils-gold
- curl
- gcc
- 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
dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
GHCup:
0.1.15.2:
0.1.16.1:
viTags:
- Recommended
- Latest
@@ -2034,52 +2035,55 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2
dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-linux-ghcup-0.1.16.1
dlHash: c3505d929722e245b22ec7a05267f1ae8e04089e139bbb470783eb9a1b648f83
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2
dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-apple-darwin-ghcup-0.1.16.1
dlHash: 7edde6bb42323232d28495abbe630321d7eb8e3827e200438a9ae4c41e531e71
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2
dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-portbld-freebsd-ghcup-0.1.16.1
dlHash: 6b7fc3a52e859f186d30b04c823fd0c5997179222fe9aa510a33435f41599f5c
Windows:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-mingw64-ghcup-0.1.15.2.exe
dlHash: 4d832052754379531ac472aeef35666e433acfee79d4079826b8ede8ca5de520
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/x86_64-mingw64-ghcup-0.1.16.1.exe
dlHash: 62439b45c7bcbc1395afe948393cb8e10bbe4f3af9b1fc58ac78660c2ad616d5
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2
dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/i386-linux-ghcup-0.1.16.1
dlHash: 93ca5d77247b6ecac01be75e9ef5454adbb503b7957b8e9c59a5abd2046aef3c
Linux_Alpine:
unknown_versioning: *ghcup-32
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2-r1
dlHash: d853372440f3d43babbb868fad399811241760f2233829c92403fcbea8c547ec
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-linux-ghcup-0.1.16.1
dlHash: 31fecbb704e9e2474804f42817ab17bfac28e32e5aeba93ae3f4c77fbc105706
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/aarch64-apple-darwin-ghcup-0.1.16.1
dlHash: 52eb69a5693abf6c18f95a3b9bf4dac59696299d690c6397bd22a9091e76d40e
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2-r1
dlHash: f8add9b39e1f7d0f03904dc69a8683259972a4472432c1ade27d918c39a4a874
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.1/armv7-linux-ghcup-0.1.16.1
dlHash: 795dd2032f0f4e4ea9688cd49393aba4c40c9eae84c8dea3477f5f440f750767
HLS:
1.1.0:
viTags: []
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:
A_64:
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
dlHash: 0f0dadb0e9a08273658f565fd71c636801959b954be2737f38f2a1aac522208f
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
dlHash: a1d3f451e64a041aa527a25da29e4716a2de6ae347cef4ef9312fc7611e168cc
Linux_Alpine:
unknown_versioning: *hls-64
unknown_versioning: *hls-110-64
1.2.0:
viTags:
- Recommended
- Latest
viTags: []
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:
A_64:
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
dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927
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
dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea
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:
2.5.1:
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
name: ghcup
version: 0.1.15.2
version: 0.1.16.1
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
@@ -20,6 +20,7 @@ extra-doc-files:
config.yaml
ghcup-0.0.4.yaml
ghcup-0.0.5.yaml
ghcup-0.0.6.yaml
HACKING.md
README.md
RELEASING.md

View File

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

View File

@@ -55,20 +55,19 @@ import Data.Aeson
import Data.Bifunctor
import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI )
import Data.CaseInsensitive ( mk )
#endif
import Data.List.Extra
import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
import Data.Time.Clock.POSIX
#if defined(INTERNAL_DOWNLOADER)
import Data.Time.Format
#endif
import Data.Versions
import Data.Word8
import GHC.IO.Exception
import Data.Word8 hiding ( isSpace )
import Haskus.Utils.Variant.Excepts
#if defined(INTERNAL_DOWNLOADER)
import Network.Http.Client hiding ( URL )
#endif
import Optics
import Prelude hiding ( abs
, readFile
@@ -76,8 +75,11 @@ import Prelude hiding ( abs
)
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO.Error
import System.IO.Temp
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString
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.Lazy as L
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.IO as T
import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y
@@ -149,19 +149,14 @@ getDownloadsF = do
in GHCupInfo tr newDownloads newGlobalTools
readFromCache :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadCatch m)
=> URI
-> Excepts '[JSONError, FileDoesNotExistError] m L.ByteString
readFromCache uri = do
Dirs{..} <- lift getDirs
let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri)
handleIO' NoSuchThing (\_ -> throwE $ FileDoesNotExistError yaml_file)
. liftIO
. L.readFile
$ yaml_file
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
yamlFromCache uri = do
Dirs{..} <- getDirs
pure (cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri))
etagsFile :: FilePath -> FilePath
etagsFile = (<.> "etags")
getBase :: ( MonadReader env m
@@ -174,33 +169,51 @@ getBase :: ( MonadReader env m
, MonadMask m
)
=> URI
-> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
-> Excepts '[JSONError] m GHCupInfo
getBase uri = do
Settings { noNetwork } <- lift getSettings
bs <- if noNetwork
then readFromCache uri
else handleIO (\_ -> warnCache >> readFromCache uri)
. catchE @_ @'[JSONError, FileDoesNotExistError] (\(DownloadFailed _) -> warnCache >> readFromCache uri)
. reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed
$ smartDl uri
-- try to download yaml... usually this writes it into cache dir,
-- but in some cases not (e.g. when using file://), so we honour
-- the return filepath, if any
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
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
. lE' @_ @_ @'[JSONError] JSONDecodeError
. first show
. Y.decodeEither'
. L.toStrict
$ bs
. onE_ (onError actualYaml)
. lEM' @_ @_ @'[JSONError] JSONDecodeError
. fmap (first (\e -> [i|#{displayException e}
Consider removing "#{actualYaml}" manually.|]))
. liftIO
. Y.decodeFileEither
$ actualYaml
where
warnCache = lift $ $(logWarn)
[i|Could not get download info, trying cached version (this may not be recent!)|]
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- 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
-- and check it's access time. If it has been accessed within the
-- 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.
smartDl :: forall m1 env1
. ( MonadReader env1 m1
@@ -214,92 +227,36 @@ getBase uri = do
)
=> URI
-> Excepts
'[ FileDoesNotExistError
, HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
, ProcessError
, NoNetwork
'[ DownloadFailed
, DigestError
]
m1
L.ByteString
FilePath
smartDl uri' = do
Dirs{..} <- lift getDirs
let path = view pathL' uri'
let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
json_file <- lift $ yamlFromCache uri'
let scheme = view (uriSchemeL' % schemeBSL') uri'
e <- liftIO $ doesFileExist json_file
if e
then do
accessTime <- liftIO $ getAccessTime json_file
currentTime <- liftIO getCurrentTime
currentTime <- liftIO getCurrentTime
Dirs { cacheDir } <- lift getDirs
-- access time won't work on most linuxes, but we can try regardless
if (utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300
then do -- no access in last 5 minutes, re-check upstream mod time
getModTime >>= \case
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
-- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
| e -> do
accessTime <- liftIO $ getAccessTime 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
dlWithMod modTime json_file = do
bs <- liftE $ downloadBS uri'
liftIO $ writeFileWithModTime modTime json_file bs
pure bs
dlWithoutMod json_file = do
bs <- liftE $ downloadBS uri'
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
let (dir, fn) = splitFileName json_file
f <- liftE $ download uri' Nothing dir (Just fn) True
liftIO $ setModificationTime f modTime
liftIO $ setAccessTime f modTime
pure f
getDownloadInfo :: ( MonadReader env m
@@ -359,32 +316,30 @@ download :: ( MonadReader env m
, MonadLogger m
, MonadIO m
)
=> DownloadInfo
-> FilePath -- ^ destination dir
=> URI
-> Maybe T.Text -- ^ expected hash
-> FilePath -- ^ destination dir (ignored for file:// scheme)
-> Maybe FilePath -- ^ optional filename
-> Bool -- ^ whether to read an write etags
-> Excepts '[DigestError , DownloadFailed] m FilePath
download dli dest mfn
download uri eDigest dest mfn etags
| scheme == "https" = 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)
where
scheme = view (dlUri % uriSchemeL' % schemeBSL') dli
cp = do
-- destination dir must exist
liftIO $ createDirRecursive' dest
let destFile = getDestFile
let fromFile = T.unpack . decUTF8Safe $ path
liftIO $ copyFile fromFile destFile
pure destFile
scheme = view (uriSchemeL' % schemeBSL') uri
dl = do
let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli))
lift $ $(logInfo) [i|downloading: #{uri'}|]
destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
lift $ $(logInfo) [i|downloading: #{uri'} as file #{destFile}|]
-- destination dir must exist
liftIO $ createDirRecursive' dest
let destFile = getDestFile
-- download
flip onException
@@ -399,28 +354,140 @@ download dli dest mfn
case downloader of
Curl -> do
o' <- liftIO getCurlOpts
liftE $ lEM @_ @'[ProcessError] $ exec "curl"
(o' ++ ["-fL", "-o", destFile, (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing
if etags
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
o' <- liftIO getWgetOpts
liftE $ lEM @_ @'[ProcessError] $ exec "wget"
(o' ++ ["-O", destFile , (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing
destFileTemp <- liftIO $ emptySystemTempFile "wget-tmp"
flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
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)
Internal -> do
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
liftE $ downloadToFile https host fullPath port destFile
(https, host, fullPath, port) <- liftE $ uriToQuadruple uri
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
liftE $ checkDigest dli destFile
forM_ eDigest (liftE . flip checkDigest 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
@@ -444,7 +511,7 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing
False -> do
tmp <- lift withGHCupTmpDir
liftE $ download dli tmp mfn
liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False
downloadCached' :: ( MonadReader env m
@@ -468,9 +535,9 @@ downloadCached' dli mfn mDestDir = do
fileExists <- liftIO $ doesFileExist cachfile
if
| fileExists -> do
liftE $ checkDigest dli cachfile
liftE $ checkDigest (view dlHash dli) 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
, HasDirs env
, HasSettings env
@@ -555,10 +555,10 @@ checkDigest :: ( MonadReader env m
, MonadThrow m
, MonadLogger m
)
=> DownloadInfo
=> T.Text -- ^ the hash
-> FilePath
-> Excepts '[DigestError] m ()
checkDigest dli file = do
checkDigest eDigest file = do
Settings{ noVerify } <- lift getSettings
let verify = not noVerify
when verify $ do
@@ -566,7 +566,6 @@ checkDigest dli file = do
lift $ $(logInfo) [i|verifying digest of: #{p'}|]
c <- liftIO $ L.readFile file
cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
let eDigest = view dlHash dli
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.Errors
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.File
import GHCup.Utils.Prelude
import Control.Applicative
@@ -20,7 +18,7 @@ import Control.Monad
import Control.Monad.Reader
import Data.ByteString ( ByteString )
import Data.ByteString.Builder
import Data.CaseInsensitive ( CI )
import Data.CaseInsensitive ( CI, original, mk )
import Data.IORef
import Data.Maybe
import Data.Text.Read
@@ -32,7 +30,6 @@ import Prelude hiding ( abs
, writeFile
)
import System.ProgressBar
import System.IO
import URI.ByteString
import qualified Data.ByteString as BS
@@ -67,7 +64,7 @@ downloadBS' :: MonadIO m
downloadBS' https host path port = do
bref <- liftIO $ newIORef (mempty :: Builder)
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)
@@ -77,12 +74,17 @@ downloadToFile :: (MonadMask m, MonadIO m)
-> ByteString -- ^ path (e.g. "/my/file") including query
-> Maybe Int -- ^ optional port (e.g. 3000)
-> FilePath -- ^ destination file to create and write to
-> Excepts '[DownloadFailed] m ()
downloadToFile https host fullPath port destFile = do
fd <- liftIO $ openFile destFile WriteMode
let stepper = BS.hPut fd
flip finally (liftIO $ hClose fd)
$ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper
-> M.Map (CI ByteString) ByteString -- ^ additional headers
-> Excepts '[DownloadFailed, HTTPNotModified] m Response
downloadToFile https host fullPath port destFile addHeaders = do
let stepper = BS.appendFile destFile
setup = BS.writeFile destFile mempty
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
@@ -92,6 +94,8 @@ downloadInternal :: MonadIO m
-> ByteString -- ^ path with query
-> Maybe Int -- ^ optional port
-> (ByteString -> IO a) -- ^ the consuming step function
-> IO a -- ^ setup action
-> M.Map (CI ByteString) ByteString -- ^ additional headers
-> Excepts
'[ HTTPStatusError
, URIParseError
@@ -100,19 +104,21 @@ downloadInternal :: MonadIO m
, TooManyRedirs
]
m
()
Response
downloadInternal = go (5 :: Int)
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
veitherToExcepts r >>= \case
Just r' ->
Right r' ->
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
Nothing -> pure ()
Left res -> pure res
where
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
@@ -121,28 +127,30 @@ downloadInternal = go (5 :: Int)
(\r i' -> runE $ do
let scode = getStatusCode r
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
Just r' -> pure $ Just r'
Just r' -> pure $ Right r'
Nothing -> throwE NoLocationHeader
| otherwise -> throwE $ HTTPStatusError scode
| otherwise -> throwE $ HTTPStatusError scode (getHeaderMap r)
)
followRedirectURL bs = case parseURI strictURIParserOptions bs of
Right uri' -> do
(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
downloadStream r i' = do
void setup
let size = case getHeader r "Content-Length" of
Just x' -> case decimal $ decUTF8Safe x' of
Left _ -> 0
Right (r', _) -> r'
Nothing -> 0
mpb <- if progressBar
then Just <$> liftIO (newProgressBar defStyle 10 (Progress 0 size ()))
(mpb :: Maybe (ProgressBar ())) <- if progressBar
then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
else pure Nothing
outStream <- liftIO $ Streams.makeOutputStream
@@ -155,79 +163,6 @@ downloadInternal = go (5 :: Int)
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
-> ByteString

View File

@@ -27,6 +27,8 @@ import Codec.Archive
import qualified Codec.Archive.Tar as Tar
#endif
import Control.Exception.Safe
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions
@@ -35,6 +37,8 @@ import Text.PrettyPrint hiding ( (<>) )
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString
import qualified Data.Map.Strict as M
------------------------
@@ -130,6 +134,13 @@ instance Pretty AlreadyInstalled where
pPrint (AlreadyInstalled tool ver') =
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
-- to be installed (such as setting the current GHC version).
data NotInstalled = NotInstalled Tool GHCTargetVersion
@@ -164,6 +175,16 @@ instance Pretty FileDoesNotExistError where
pPrint (FileDoesNotExistError file) =
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
deriving Show
@@ -180,13 +201,29 @@ instance Pretty DigestError where
text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
-- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
deriving Show
instance Pretty HTTPStatusError where
pPrint (HTTPStatusError status) =
pPrint (HTTPStatusError 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.
data NoLocationHeader = NoLocationHeader
deriving Show
@@ -307,6 +344,15 @@ instance Pretty UnexpectedListLength where
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

@@ -766,49 +766,22 @@ ghcToolFiles ver = do
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
(throwE (NotInstalled GHC ver))
files <- liftIO $ listDirectory bindir
-- figure out the <ver> suffix, because this might not be `Version` for
-- alpha/rc releases, but x.y.a.somedate.
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
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
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

View File

@@ -209,6 +209,20 @@ exec exe args chdir env = do
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 fp =
let perm = setOwnerWritable True emptyPermissions

View File

@@ -31,7 +31,7 @@ import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Bifunctor
import Data.ByteString ( ByteString )
import Data.List ( nub )
import Data.List ( nub, intercalate )
import Data.Foldable
import Data.String
import Data.Text ( Text )
@@ -55,6 +55,7 @@ import GHC.IO.Exception
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S
import qualified Data.List.Split as Split
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
@@ -410,12 +411,7 @@ rmPathForcibly :: ( MonadIO m
-> m ()
rmPathForcibly fp =
#if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removePathForcibly fp)
recover (liftIO $ removePathForcibly fp)
#else
liftIO $ removePathForcibly fp
#endif
@@ -426,12 +422,7 @@ rmDirectory :: (MonadIO m, MonadMask m)
-> m ()
rmDirectory fp =
#if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
]
(\_ -> liftIO $ removeDirectory fp)
recover (liftIO $ removeDirectory fp)
#else
liftIO $ removeDirectory fp
#endif
@@ -469,12 +460,7 @@ rmFile :: ( MonadIO m
-> m ()
rmFile fp =
#if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removeFile fp)
recover (liftIO $ removeFile fp)
#else
liftIO $ removeFile fp
#endif
@@ -485,12 +471,7 @@ rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
-> m ()
rmDirectoryLink fp =
#if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removeDirectoryLink fp)
recover (liftIO $ removeDirectoryLink fp)
#else
liftIO $ removeDirectoryLink fp
#endif
@@ -525,8 +506,32 @@ stripNewline 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 w
| w == _lf = True
| w == _cr = True
| 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.
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.
ghcUpVer :: PVP

View File

@@ -128,7 +128,10 @@
<div>
<p>
If you are running Windows,<br/>run the following in a powershell session (as a non-admin user).
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
</div>
<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
</div>
</p>
</div>