Compare commits

..

88 Commits

Author SHA1 Message Date
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
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
9639e695e2 Unhide stack 2021-07-23 16:13:07 +02:00
d2a2bde321 Merge branch 'mlang-cursor' 2021-07-23 14:46:06 +02:00
c85ff686b6 Fix cabal.project 2021-07-23 14:45:50 +02:00
48d3b3bc3e Merge branch 'cursor' of https://github.com/mlang/ghcup-hs into mlang-cursor 2021-07-23 14:38:49 +02:00
94bd01aaca Merge branch 'issue-165' 2021-07-23 14:35:07 +02:00
Mario Lang
761b8cc750 Place an (invisible) cursor at the beginning of the active list item
This change is to support screen readers which use the cursor location
to indicate the focus to the user.

Brick.putCursor is unreleased, so grab the latest version from git via extra-deps.
2021-07-23 11:53:28 +02:00
3bdc82c99b Redo file handling wrt #165 and #187 2021-07-22 17:44:03 +02:00
db4e9fa432 Merge branch 'issue-192' 2021-07-22 11:39:31 +02:00
530c25c6a1 Fix bootstrap haskell bashrc stuff 2021-07-22 11:21:45 +02:00
1c2cf98850 Fix file/dir removal on windows, fixes #165 2021-07-21 20:50:58 +02:00
b35dbca22e Merge branch 'issue-183' 2021-07-20 23:54:37 +02:00
a4a7f73fb7 Allow to use Hadrian as build system, fixes #35 2021-07-20 23:51:31 +02:00
fd0ea3d858 Merge branch 'stack-2.7.3' 2021-07-20 23:11:21 +02:00
bbbe52f453 Bump stack to 2.7.3 2021-07-20 22:30:50 +02:00
9e181b8820 Allow passing "flavor" to 'ghcup compile ghc'
Fixes #183
2021-07-20 13:39:39 +02:00
a6108f8319 Fix listVersion wrt #183 2021-07-20 11:54:14 +02:00
7a2570019a Return the version during 'ghcup compile ghc -g <commit>'
Fixes #181
2021-07-20 11:42:36 +02:00
c5b4e82b48 Merge branch 'issue-187' 2021-07-20 00:57:08 +02:00
4ed72fb517 Preserve mtimes on unpacked GHC tarballs on windows wrt #187 2021-07-19 23:33:01 +02:00
5217aa0a1d Merge branch 'issue-180' 2021-07-19 20:55:17 +02:00
3caf91c640 Fix ensureGlobalTools 2021-07-19 19:08:43 +02:00
eb26a5133f Merge branch 'www-fix-true' 2021-07-19 17:01:03 +02:00
9e9402a3a2 Fix www 2021-07-19 16:58:42 +02:00
bc13a4555d Fix runLeanWhereIs on windows 2021-07-19 16:56:28 +02:00
eaad2caf25 Add prefetch command 2021-07-19 16:51:40 +02:00
6143cdf2e0 Add --offline switch wrt #186 2021-07-19 13:49:24 +02:00
2c7176d998 Use LabelOptic and add LeanAppState
Wrt #186
2021-07-18 14:39:49 +02:00
327b80cf56 Add cross compilation to CI test 2021-07-15 23:26:48 +02:00
005c9fbb83 Modernize CI scripts 2021-07-15 22:44:54 +02:00
42134fd2a5 Fix whereIsTool for cross 2021-07-15 22:38:42 +02:00
bc85a7d9c3 Fix cross installation
See https://gitlab.haskell.org/ghc/ghc/-/issues/14297
2021-07-15 20:32:09 +02:00
7e14fd4a08 Only run unsafeInterleaveIO when necessary 2021-07-15 20:30:14 +02:00
bf74d1e828 Merge branch 'issue-179' 2021-07-15 20:01:25 +02:00
f04708e8ae Speed up 'whereis' subcommand wrt #179 2021-07-15 20:01:00 +02:00
80e1924e5f Merge branch 'scoop' 2021-07-13 20:27:15 +02:00
c7393bd7c5 Fork shimgen into main repo, fixes #161 2021-07-13 20:25:29 +02:00
664713bb13 Fix darwin:aarch64 release 2021-07-13 19:41:12 +02:00
01715fdefc Merge branch 'github-actions' 2021-07-13 17:26:03 +02:00
ab9b24e109 Switch to github actions wrt #178 and #159 2021-07-13 17:25:42 +02:00
34ecb1a56e Add build-tool-depends: hspec-discover:hspec-discover 2021-07-13 17:25:13 +02:00
e3aef38f75 Merge branch 'update-stack-yaml' 2021-07-13 15:51:54 +02:00
ead2b76050 Switch to github actions wrt #178 and #159 2021-07-13 15:42:20 +02:00
2f35513f6e Update stack.yaml 2021-07-13 15:26:43 +02:00
8573c99088 Update freeze stuff 2021-07-13 15:18:34 +02:00
dfe63332b2 Improve messages in bootstrap-haskell.ps1 2021-07-13 14:50:22 +02:00
767ae48c7b Merge branch 'fix-install-stack' 2021-07-12 23:17:32 +02:00
f4160464c0 Merge branch 'www-update-win' 2021-07-12 23:15:46 +02:00
a572b1d5f0 Merge branch 'issue-177' 2021-07-12 23:15:06 +02:00
ec98826e6d Fix installStackBindist 2021-07-12 22:15:45 +02:00
b4fcd05e8f Ask all questions at the beginning wrt #177 2021-07-12 22:14:56 +02:00
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
53 changed files with 8397 additions and 1616 deletions

109
.github/release.yaml vendored Normal file
View File

@@ -0,0 +1,109 @@
name: Create Release
on:
push:
tags:
- 'v*'
jobs:
draft_release:
name: Create Release
runs-on: ubuntu-latest
outputs:
upload_url: ${{ steps.create_release.outputs.upload_url }}
steps:
- name: Create Release
id: create_release
uses: actions/create-release@v1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
tag_name: ${{ github.ref }}
release_name: Release ${{ github.ref }}
body: |
Changes in this Release
- First Change
- Second Change
draft: true
prerelease: false
release-mac:
name: Create Release for macOS
needs: draft_release
runs-on: ${{ matrix.os }}
env:
MACOSX_DEPLOYMENT_TARGET: 10.13
strategy:
matrix:
os:
- macOS-10.15
steps:
- name: Checkout code
uses: actions/checkout@v2
- uses: haskell/actions/setup@v1.2
with:
ghc-version: 8.10.4
cabal-version: 3.4.0.0
- name: create ~/.local/bin
run: mkdir -p "$HOME/.local/bin"
shell: bash
- name: Add ~/.local/bin to PATH
run: echo "$HOME/.local/bin" >> $GITHUB_PATH
shell: bash
- name: Update cabal cache
run: cabal update
shell: bash
- name: Install cabal dependencies
run: cabal build --only-dependencies
shell: bash
- name: Build
run: cabal build -w ghc-${GHC_VERSION} --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
shell: bash
- name: Install
run: cp "$(cabal list-bin exe:ghcup)" ~/.local/bin/ghcup
shell: bash
- name: Strip
run: strip ~/.local/bin/ghcup
shell: bash
- name: Run tests
run: cabal test --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" all
shell: bash
- name: Install git
run: brew install git
- name: set HOME
run: echo "HOME=$HOME" >> $GITHUB_ENV
shell: bash
- name: Set ASSET_PATH
run: echo "ASSET_PATH=$HOME/.local/bin/ghcup" >> $GITHUB_ENV
shell: bash
- name: Upload Release Asset
id: upload-release-asset
uses: actions/upload-release-asset@v1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
upload_url: ${{ needs.draft_release.outputs.upload_url }}
asset_path: ${{ env.ASSET_PATH }}
asset_name: ghcup-${{ matrix.os }}
asset_content_type: application/octet-stream
- if: always()
uses: actions/upload-artifact@v2
with:
name: plan.json
path: ./dist-newstyle/cache/plan.json

109
.github/workflows/release.yaml vendored Normal file
View File

@@ -0,0 +1,109 @@
name: Create Release
on:
push:
tags:
- 'v*'
jobs:
draft_release:
name: Draft Release
runs-on: ubuntu-latest
outputs:
upload_url: ${{ steps.create_release.outputs.upload_url }}
steps:
- name: Create Release
id: create_release
uses: actions/create-release@v1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
tag_name: ${{ github.ref }}
release_name: Release ${{ github.ref }}
body: |
Changes in this Release
- First Change
- Second Change
draft: true
prerelease: false
release-mac:
name: Create Release
needs: draft_release
runs-on: ${{ matrix.os }}
env:
MACOSX_DEPLOYMENT_TARGET: 10.13
strategy:
matrix:
os:
- macOS-10.15
steps:
- name: Checkout code
uses: actions/checkout@v2
- uses: haskell/actions/setup@v1.2
with:
ghc-version: 8.10.4
cabal-version: 3.4.0.0
- name: create ~/.local/bin
run: mkdir -p "$HOME/.local/bin"
shell: bash
- name: Add ~/.local/bin to PATH
run: echo "$HOME/.local/bin" >> $GITHUB_PATH
shell: bash
- name: Update cabal cache
run: cabal update
shell: bash
- name: Install cabal dependencies
run: cabal build --only-dependencies --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
shell: bash
- name: Build
run: cabal build --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
shell: bash
- name: Install
run: cp "$(cabal list-bin exe:ghcup)" ~/.local/bin/ghcup
shell: bash
- name: Strip
run: strip ~/.local/bin/ghcup
shell: bash
- name: Run tests
run: cabal test --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" all
shell: bash
- name: Install git
run: brew install git
- name: set HOME
run: echo "HOME=$HOME" >> $GITHUB_ENV
shell: bash
- name: Set ASSET_PATH
run: echo "ASSET_PATH=$HOME/.local/bin/ghcup" >> $GITHUB_ENV
shell: bash
- name: Upload Release Asset
id: upload-release-asset
uses: actions/upload-release-asset@v1
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
with:
upload_url: ${{ needs.draft_release.outputs.upload_url }}
asset_path: ${{ env.ASSET_PATH }}
asset_name: ghcup-${{ matrix.os }}
asset_content_type: application/octet-stream
- if: always()
uses: actions/upload-artifact@v2
with:
name: plan.json
path: ./dist-newstyle/cache/plan.json

29
.github/workflows/shimgen.yaml vendored Normal file
View File

@@ -0,0 +1,29 @@
name: Shimgen CI
on:
push:
branches: [ master ]
pull_request:
branches: [ master ]
jobs:
build-shimgen:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [windows-latest]
steps:
- uses: actions/checkout@v2
- uses: ilammy/msvc-dev-cmd@v1
- name: compile
run: cl /O1 scoop-better-shimexe/shim.c
- uses: actions/upload-artifact@v2
with:
name: shim.exe
path: shim.exe

View File

@@ -21,6 +21,7 @@ variables:
OS: "LINUX"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
CROSS: ""
.alpine:64bit:
image: "alpine:3.12"
@@ -98,13 +99,18 @@ 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:
# script:
# - cl /O1 scoop-better-shimexe/shim.c
.test_ghcup_version:linux:
extends:
- .test_ghcup_version
@@ -184,6 +190,12 @@ variables:
- set CABAL_DIR="$CI_PROJECT_DIR/cabal"
- bash ./.gitlab/before_script/windows/install_deps.sh
# .test_ghcup_scoop:windows:
# extends:
# - .windows
# - .test_ghcup_scoop
# - .root_cleanup
.release_ghcup:
script:
- bash ./.gitlab/script/ghcup_release.sh
@@ -191,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 ########
@@ -258,6 +271,44 @@ test:linux:latest:
CABAL_VERSION: "3.4.0.0"
needs: []
test:linux:cross-armv7:
stage: test
extends:
- .test_ghcup_version
- .debian
variables:
GHC_VERSION: "8.10.4"
GHC_TARGET_VERSION: "8.10.5"
CABAL_VERSION: "3.4.0.0"
CROSS: "arm-linux-gnueabihf"
needs: []
when: manual
allow_failure: true
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
script:
- ./.gitlab/script/ghcup_cross.sh
test:linux:git:hadrian:
stage: test
extends:
- .test_ghcup_version
- .debian
variables:
GHC_VERSION: "8.10.5"
GHC_GIT_TAG: "ghc-9.0.1-release"
GHC_GIT_VERSION: "9.0.1"
CABAL_VERSION: "3.4.0.0"
CROSS: ""
needs: []
when: manual
allow_failure: true
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
script:
- ./.gitlab/script/ghcup_git.sh
######## linux 32bit test ########
test:linux:recommended:32bit:
@@ -276,6 +327,7 @@ test:linux:recommended:armv7:
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
CROSS: ""
when: manual
needs: []
@@ -285,6 +337,7 @@ test:linux:recommended:aarch64:
variables:
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
CROSS: ""
when: manual
needs: []
@@ -338,6 +391,11 @@ test:windows:recommended:
CABAL_VERSION: "3.4.0.0"
needs: []
# test:windows:scoop:
# stage: test
# extends: .test_ghcup_scoop:windows
# needs: []
######## linux release ########
release:linux:64bit:
@@ -379,6 +437,7 @@ release:linux:armv7:
ARTIFACT: "armv7-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
CROSS: ""
release:linux:aarch64:
stage: release
@@ -392,6 +451,7 @@ release:linux:aarch64:
ARTIFACT: "aarch64-linux-ghcup"
GHC_VERSION: "8.10.4"
CABAL_VERSION: "3.4.0.0"
CROSS: ""
######## darwin release ########
@@ -420,13 +480,19 @@ release:darwin:aarch64:
script: |
set -Eeuo pipefail
function runInNixShell() {
time nix-shell .gitlab/shell.nix \
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
--argstr system "aarch64-darwin" \
--pure \
--keep CI_PROJECT_DIR --keep MAKE_ARGS --keep HADRIAN_ARGS --keep CABAL_CACHE \
--keep CI_PROJECT_DIR \
--keep MACOSX_DEPLOYMENT_TARGET \
--keep JSON_VERSION --keep ARTIFACT \
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1

View File

@@ -9,6 +9,13 @@ mkdir -p "${TMPDIR}"
sudo apt-get update -y
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https
if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
sudo apt-get install -y autoconf build-essential gcc-arm-linux-gnueabihf
sudo dpkg --add-architecture armhf
sudo apt-get update -y
sudo apt-get install -y libncurses-dev:armhf
fi
case "${ARCH}" in
ARM*)
case "${ARCH}" in
@@ -57,9 +64,9 @@ case "${ARCH}" in
chmod +x ghcup-bin
./ghcup-bin upgrade -i -f
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
./ghcup-bin install ghc ${GHC_VERSION}
./ghcup-bin set ghc ${GHC_VERSION}
./ghcup-bin install cabal ${CABAL_VERSION}
;;
esac

52
.gitlab/script/ghcup_cross.sh Executable file
View File

@@ -0,0 +1,52 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
CI_PROJECT_DIR=$(pwd)
ecabal() {
cabal "$@"
}
eghcup() {
ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always
### build
ecabal update
ecabal build -w ghc-${GHC_VERSION}
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
### cleanup
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
### manual cli based testing
eghcup --numeric-version
eghcup install ghc ${GHC_VERSION}
eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION}
cabal --version
eghcup debug-info
eghcup compile ghc -j $(nproc) -v ${GHC_TARGET_VERSION} -b ${GHC_VERSION} -x ${CROSS} -- --enable-unregisterised
eghcup set ghc ${CROSS}-${GHC_TARGET_VERSION}
[ `$(eghcup whereis ghc ${CROSS}-${GHC_TARGET_VERSION}) --numeric-version` = "${GHC_TARGET_VERSION}" ]
# nuke
eghcup nuke
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]

52
.gitlab/script/ghcup_git.sh Executable file
View File

@@ -0,0 +1,52 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
CI_PROJECT_DIR=$(pwd)
ecabal() {
cabal "$@"
}
eghcup() {
ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always
### build
ecabal update
ecabal build -w ghc-${GHC_VERSION}
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup
### cleanup
rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
### manual cli based testing
eghcup --numeric-version
eghcup install ghc ${GHC_VERSION}
eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION}
cabal --version
eghcup debug-info
eghcup compile ghc -j $(nproc) -g ${GHC_GIT_TAG} -b ${GHC_VERSION} -- --enable-unregisterised
eghcup set ghc ${GHC_GIT_VERSION}
[ `$(eghcup whereis ghc ${GHC_GIT_VERSION}) --numeric-version` = "${GHC_GIT_VERSION}" ]
# nuke
eghcup nuke
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]

View File

@@ -15,10 +15,6 @@ git describe
# build
ecabal update
(
cd /tmp
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
)
if [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "32" ] ; then

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,17 +24,18 @@ 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
ecabal update
(
cd /tmp
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hspec-discover
)
if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION} -ftui
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
@@ -70,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
@@ -83,16 +84,17 @@ ghcup-gen check -f ghcup-${JSON_VERSION}.yaml
eghcup --numeric-version
eghcup install ${GHC_VERSION}
eghcup install ghc ${GHC_VERSION}
[ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
eghcup set ${GHC_VERSION}
eghcup install-cabal ${CABAL_VERSION}
eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION}
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
cabal --version
eghcup debug-info
# also test etags
eghcup list
eghcup list -t ghc
eghcup list -t cabal
@@ -112,17 +114,19 @@ else
# test installing new ghc doesn't mess with currently set GHC
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
if [ "${OS}" = "LINUX" ] ; then
eghcup --downloader=wget install 8.10.3
eghcup --downloader=wget prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
else # test wget a bit
eghcup install 8.10.3
eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
fi
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup set 8.10.3
eghcup --offline set 8.10.3
eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set ${GHC_VERSION}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup rm 8.10.3
eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
if [ "${OS}" = "DARWIN" ] ; then
@@ -142,6 +146,11 @@ else
fi
fi
# check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc $(ghc --numeric-version)
mv -f "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml"
eghcup rm $(ghc --numeric-version)
@@ -153,14 +162,45 @@ 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}" ]
eghcup upgrade
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}" ]

View File

@@ -1,10 +1,5 @@
jobs:
include:
- os: osx
osx_image: xcode8
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.11-ghcup
- os: osx
osx_image: xcode10.1
language: generic
@@ -15,23 +10,16 @@ jobs:
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.14-ghcup
allow_failures:
- os: osx
osx_image: xcode8
language: generic
env: ARTIFACT=x86_64-apple-darwin-10.11-ghcup
script: ".travis/build.sh"
deploy:
provider: releases
api_key:
secure: GQESg4TcYf3PQJRRaZV/kWS0hsF+OFnH2+EcwpgnIcfx4+aogMyprdh745KtBXe1FlFN1luKHksFjqceqhcg/xcNyeCJiSnLWMn4D/i4WUperEHseRBi5yZZCB1AvOjIlHrE4DS3a8pyEm1GV3G7CKY5Fu8jBjof2SnyENfd7fofhjtNHWmeFS+jBn8HRDf1YaSRYxzTw6uHLrPLsybfgQZVl7babMu/38Ghin0f5pz5OlNokzDxaubIYQHOZ7st7YndHJtBWWql/KualBWbMILy88dUVQBnbqQLP2P8d1ME8ILUjJVqz33HiRU0JzlEJyWfbvEjcJ6iD8M6n4nXTaxfu3i2UhhGsQ6SSBNKssMP4tji8nkNpMqG59wLQ/zhcetEm71fKkgJNrIMNllkqlWSo5K74IqqP9kiLg/qm8ipOJjui0gPk8tZXKcV+ztX1d1OVCapoLfiDM5l/0LLQXaTOXOV1x3e5LLQ/w2doNiH3eh5CV4II9dRu7owpaiiMBHMssmT0pH99jEeF6giHLKtt3y7l2GWoRLPdhsZZ54gxsaBxZt9GuypmkbNcr97CEnAVaWij5v0CF3w4rAWqy/tAxQpIDJOIOQBgmwG5WrBAKyKrFvEpBL5a8BPcRWJDvqKC83QeWpvPrEVdgJevC6ZN1MKzrb2SiPOwC2Kerc=
secure: "hT2od8Iy04tdFVuonPSWv0NX5hZDmv4al8Q0GbIWmviUetROuM7c6/MCHUcgyiw6H2L3pmH4F24GBYWpKBT3ZMbxrKXhZOZ3KPLXzlnuRlm1qymKqqwsJs3466bMftaiBr16rx1VpAuditN4A32oSmTFcQAJc84Bxn2WZ4t8hk9muS8YPyLhqg3/NxT6ob8dzNp9eS2cA0WODMb/fMzaMruRtepSK8JvuXb/SnTvaDcl9plmPzEa+eW54jwVsDps8ZpQMQlTtGIjYHIwTQ36/iLH4LoAvD7OEnB7qf753LOzmI/bvlB75xYGsLxe1qgpzPMjuG3AK0jb2KGSZCzyAyrbBFSQMIyC1gNKMtab3CohnA9WdQqAT1xrzPzA9zNw516G5Fn/z+t9Ek1f6L2OYO2hJfweNhWh+ChAIsOags2QBpqc0qjkwUS4wqxCWBdyVfgPTUoGelvjCfjQgypgIyLEHFvXt9rlj+kd97FY7nG3vxZrsvWTKKKT551OqUYX5zWTyvGR71jKyNst/p93Pg3DkRy31gHrGnG9zfNgN5tWxJqDd/suR/BAFTp0VtkFb8fR3ct7WMVeJXtE2+bKqxO5Fnocs1VjEm8pKPk7glnp0muu08kaO0h54wiSOCbk1RvO1KZtHue4wKWrHcI18dwW2WtzoBQ4P1lOSkS81UY="
file: $ARTIFACT
on:
repo: haskell/ghcup-hs
repo: hasufell/ghcup-hs
tags: true
skip_cleanup: true
draft: true

View File

@@ -18,8 +18,8 @@ ghcup set 8.10.4
cabal update
(
cd /tmp
cabal install --installdir="$HOME"/.ghcup/bin hspec-discover
cd /tmp
cabal install --installdir="$HOME"/.ghcup/bin hspec-discover
)
cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui

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

@@ -12,7 +12,7 @@ import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Platform
import GHCup.Types
import GHCup.Types hiding ( LeanAppState (..) )
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
@@ -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
@@ -226,7 +226,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
, rawOutter = \_ -> pure ()
}
downloadAll dli = do
dirs <- liftIO getDirs
dirs <- liftIO getAllDirs
pfreq <- (
runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
@@ -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) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
r <-
runLogger
@@ -256,17 +256,17 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
case etool of
Right (Just GHCup) -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
Right _ -> do
p <- liftE $ downloadCached (settings appstate) dirs dli Nothing
p <- liftE $ downloadCached dli Nothing
fmap (Just . head . splitDirectories . head)
. liftE
. getArchiveFiles
$ p
Left ShimGen -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (settings appstate) dli tmpUnpack Nothing
_ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
case r of
VRight (Just basePath) -> do

View File

@@ -13,7 +13,7 @@ module BrickMain where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils
import GHCup.Utils.Prelude ( decUTF8Safe )
import GHCup.Utils.File
@@ -53,15 +53,13 @@ import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString
import qualified GHCup.Types as GT
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
hiddenTools :: [Tool]
hiddenTools = [Stack]
hiddenTools = []
data BrickData = BrickData
@@ -171,7 +169,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
| elem Latest lTag && not lInstalled =
withAttr "hooray"
| otherwise = id
active = if b then forceAttr "active" else id
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id
in hooray $ active $ dim
( marks
<+> padLeft (Pad 2)
@@ -259,7 +257,7 @@ app attrs dimAttrs =
, appHandleEvent = eventHandler
, appStartEvent = return
, appAttrMap = const attrs
, appChooseCursor = neverShowCursor
, appChooseCursor = showFirstCursor
}
defaultAttributes :: Bool -> AttrMap
@@ -550,13 +548,14 @@ changelog' _ (_, ListResult {..}) = do
settings' :: IORef AppState
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
dirs <- getDirs
dirs <- getAllDirs
newIORef $ AppState (Settings { cache = True
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, noNetwork = False
, ..
})
dirs
@@ -578,9 +577,8 @@ logger' = unsafePerformIO
brickMain :: AppState
-> LoggerConfig
-> GHCupInfo
-> IO ()
brickMain s l gi = do
brickMain s l = do
writeIORef settings' s
-- logger interpreter
writeIORef logger' l
@@ -588,7 +586,7 @@ brickMain s l gi = do
no_color <- isJust <$> lookupEnv "NO_COLOR"
eAppData <- getAppData (Just gi)
eAppData <- getAppData (Just $ ghcupInfo s)
case eAppData of
Right ad ->
defaultMain
@@ -596,7 +594,7 @@ brickMain s l gi = do
(BrickState ad
defaultAppSettings
(constructList ad defaultAppSettings Nothing)
(keyBindings s)
(keyBindings (s :: AppState))
)
$> ()
@@ -620,7 +618,7 @@ getGHCupInfo = do
. flip runReaderT settings
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
$ liftE
$ getDownloadsF (GT.settings settings) (GT.dirs settings)
$ getDownloadsF
case r of
VRight a -> pure $ Right a

File diff suppressed because it is too large Load Diff

View File

@@ -5,8 +5,12 @@
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
# * BOOTSTRAP_HASKELL_GHC_VERSION
# * BOOTSTRAP_HASKELL_CABAL_VERSION
# * BOOTSTRAP_HASKELL_GHC_VERSION - the ghc version to install
# * BOOTSTRAP_HASKELL_CABAL_VERSION - the cabal version to install
# * BOOTSTRAP_HASKELL_INSTALL_STACK - whether to install latest stack
# * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls
# * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend)
# * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows
# License: LGPL-3.0
@@ -16,9 +20,11 @@
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
case "${plat}" in
MSYS*|MINGW*)
: "${GHCUP_INSTALL_BASE_PREFIX:=/c}"
@@ -60,6 +66,28 @@ warn() {
esac
}
yellow() {
case "${plat}" in
MSYS*|MINGW*)
echo -e "\\033[0;33m$1\\033[0m"
;;
*)
printf "\\033[0;33m%s\\033[0m\\n" "$1"
;;
esac
}
green() {
case "${plat}" in
MSYS*|MINGW*)
echo -e "\\033[0;32m$1\\033[0m"
;;
*)
printf "\\033[0;32m%s\\033[0m\\n" "$1"
;;
esac
}
edo() {
"$@" || die "\"$*\" failed!"
}
@@ -80,40 +108,42 @@ _eghcup() {
}
_done() {
echo
echo "==============================================================================="
case "${plat}" in
MSYS*|MINGW*)
echo
echo "All done!"
echo
echo "In a new powershell or cmd.exe session, now you can..."
echo
echo "Start a simple repl via:"
echo " ghci"
echo
echo "Start a new haskell project in the current directory via:"
echo " cabal init --interactive"
echo
echo "Install other GHC versions and tools via:"
echo " ghcup list"
echo " ghcup install <tool> <version>"
echo
echo "To install system libraries and update msys2/mingw64,"
echo "open the \"Mingw haskell shell\""
echo "and the \"Mingw package management docs\""
echo "desktop shortcuts."
green
green "All done!"
green
green "In a new powershell or cmd.exe session, now you can..."
green
green "Start a simple repl via:"
green " ghci"
green
green "Start a new haskell project in the current directory via:"
green " cabal init --interactive"
green
green "Install other GHC versions and tools via:"
green " ghcup list"
green " ghcup install <tool> <version>"
green
green "To install system libraries and update msys2/mingw64,"
green "open the \"Mingw haskell shell\""
green "and the \"Mingw package management docs\""
green "desktop shortcuts."
;;
*)
echo
echo "All done!"
echo
echo "To start a simple repl, run:"
echo " ghci"
echo
echo "To start a new haskell project in the current directory, run:"
echo " cabal init --interactive"
echo
echo "To install other GHC versions and tools, run:"
echo " ghcup tui"
green
green "All done!"
green
green "To start a simple repl, run:"
green " ghci"
green
green "To start a new haskell project in the current directory, run:"
green " cabal init --interactive"
green
green "To install other GHC versions and tools, run:"
green " ghcup tui"
;;
esac
@@ -213,7 +243,9 @@ download_ghcup() {
eghcup upgrade
}
adjust_bashrc() {
# Figures out the users login shell and sets
# GHCUP_PROFILE_FILE and MY_SHELL variables.
find_shell() {
case $SHELL in
*/zsh) # login shell is zsh
GHCUP_PROFILE_FILE="$HOME/.zshrc"
@@ -237,75 +269,47 @@ adjust_bashrc() {
MY_SHELL="fish" ;;
*) return ;;
esac
}
warn ""
warn "Detected ${MY_SHELL} shell on your system..."
warn "Do you want ghcup to automatically add the required PATH variable to \"${GHCUP_PROFILE_FILE}\"?"
warn ""
warn "[P] Yes, prepend [A] Yes, append [N] No [?] Help (default is \"P\")."
warn ""
# Ask user if they want to adjust the bashrc.
ask_bashrc() {
if [ -n "${BOOTSTRAP_HASKELL_ADJUST_BASHRC}" ] ; then
return 1
fi
while true; do
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
read -r next_answer </dev/tty
else
next_answer="prepend"
fi
echo "-------------------------------------------------------------------------------"
case $next_answer in
warn ""
warn "Detected ${MY_SHELL} shell on your system..."
warn "Do you want ghcup to automatically add the required PATH variable to \"${GHCUP_PROFILE_FILE}\"?"
warn ""
warn "[P] Yes, prepend [A] Yes, append [N] No [?] Help (default is \"P\")."
warn ""
read -r bashrc_answer </dev/tty
else
# On windows .bashrc isn't an important user config, so we adjust it
# always. On other platforms, let's be a bit more conservative.
case "${plat}" in
MSYS*|MINGW*)
return 1
;;
*)
return 0
;;
esac
fi
case $bashrc_answer in
[Pp]* | "")
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
EOF
return 1
;;
[Aa]*)
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:\$PATH:${GHCUP_BIN}"
EOF
return 2
;;
*) ;;
esac
case $next_answer in
[Nn]*)
return ;;
[Pp]* | [Aa]* | "")
case $MY_SHELL in
"") break ;;
fish)
mkdir -p "${GHCUP_PROFILE_FILE%/*}"
sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
case $next_answer in
[Pp]* | "")
echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
;;
[Aa]*)
echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin \$PATH $GHCUP_BIN # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
;;
esac
break ;;
bash)
sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
case "${plat}" in
"Darwin"|"darwin")
if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
fi
;;
esac
break ;;
zsh)
sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
break ;;
esac
warn "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
warn "or type \"source ${GHCUP_DIR}/env\" to apply them in your current terminal session."
return
;;
return 0;;
*)
echo "Possible choices are:"
echo
@@ -317,8 +321,234 @@ adjust_bashrc() {
;;
esac
done
unset bashrc_answer
}
# Needs 'find_shell' to be called beforehand.
adjust_bashrc() {
case $1 in
1)
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
EOF
;;
2)
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$PATH:\$HOME/.cabal/bin:${GHCUP_BIN}"
EOF
;;
*) ;;
esac
case $1 in
1 | 2)
case $MY_SHELL in
"")
warn_path "Couldn't figure out login shell!"
return
;;
fish)
mkdir -p "${GHCUP_PROFILE_FILE%/*}"
sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
case $1 in
1)
echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin $GHCUP_BIN \$PATH # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
;;
2)
echo "set -q GHCUP_INSTALL_BASE_PREFIX[1]; or set GHCUP_INSTALL_BASE_PREFIX \$HOME ; set -gx PATH \$HOME/.cabal/bin \$PATH $GHCUP_BIN # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
;;
esac
break ;;
bash)
sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
case "${plat}" in
"Darwin"|"darwin")
if ! grep -q "ghcup-env" "${HOME}/.bash_profile" ; then
echo "[[ -f ~/.bashrc ]] && source ~/.bashrc # ghcup-env" >> "${HOME}/.bash_profile"
fi
;;
esac
break ;;
zsh)
sed -i -e '/# ghcup-env$/ s/^#*/#/' "${GHCUP_PROFILE_FILE}"
echo "[ -f \"${GHCUP_DIR}/env\" ] && source \"${GHCUP_DIR}/env\" # ghcup-env" >> "${GHCUP_PROFILE_FILE}"
break ;;
esac
echo
echo "==============================================================================="
echo
warn "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
warn "or type \"source ${GHCUP_DIR}/env\" to apply them in your current terminal session."
return
;;
*)
warn_path
;;
esac
}
warn_path() {
echo
echo "==============================================================================="
echo
[ -n "$1" ] && warn "$1"
yellow "In order to run ghc and cabal, you need to adjust your PATH variable."
yellow "To do so, you may want run 'source $GHCUP_DIR/env' in your current terminal"
yellow "session as well as your shell configuration (e.g. ~/.bashrc)."
}
adjust_cabal_config() {
edo cabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$HOME"/AppData/Roaming/cabal/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
}
ask_cabal_config_init() {
case "${plat}" in
MSYS*|MINGW*)
if [ -n "${BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG}" ] ; then
return 1
fi
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
echo "-------------------------------------------------------------------------------"
warn "Create an initial cabal.config including relevant msys2 paths (recommended)?"
warn "[Y] Yes [N] No [?] Help (default is \"Y\")."
echo
while true; do
read -r mingw_answer </dev/tty
case $mingw_answer in
[Yy]* | "")
return 1 ;;
[Nn]*)
return 0 ;;
*)
echo "Possible choices are:"
echo
echo "Y - Yes, create a cabal.config with pre-set paths to msys2/mingw64 (default)"
echo "N - No, leave the current/default cabal config untouched"
echo
echo "Please make your choice and press ENTER."
;;
esac
done
else
return 1
fi
;;
esac
unset mingw_answer
return 0
}
do_cabal_config_init() {
case "${plat}" in
MSYS*|MINGW*)
case $1 in
1)
adjust_cabal_config
;;
0)
echo "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
echo "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
sleep 5
return ;;
*) ;;
esac
esac
}
ask_hls() {
if [ -n "${BOOTSTRAP_HASKELL_INSTALL_HLS}" ] ; then
return 1
fi
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
echo "-------------------------------------------------------------------------------"
warn "Do you want to install haskell-language-server (HLS)?"
warn "HLS is a language-server that provides IDE-like functionality"
warn "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
warn "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
warn ""
warn "[Y] Yes [N] No [?] Help (default is \"N\")."
warn ""
while true; do
read -r hls_answer </dev/tty
case $hls_answer in
[Yy]*)
return 1
;;
[Nn]* | "")
return 0
;;
*)
echo "Possible choices are:"
echo
echo "Y - Yes, install the haskell-langauge-server"
echo "N - No, don't install anything more (default)"
echo
echo "Please make your choice and press ENTER."
;;
esac
done
else
return 0
fi
unset hls_answer
}
ask_stack() {
if [ -n "${BOOTSTRAP_HASKELL_INSTALL_STACK}" ] ; then
return 1
fi
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
echo "-------------------------------------------------------------------------------"
warn "Do you want to install stack?"
warn "Stack is a haskell build tool similar to cabal that is used by some projects."
warn "Also see https://docs.haskellstack.org/"
warn ""
warn "[Y] Yes [N] No [?] Help (default is \"N\")."
warn ""
while true; do
read -r stack_answer </dev/tty
case $stack_answer in
[Yy]*)
return 1 ;;
[Nn]* | "")
return 0 ;;
*)
echo "Possible choices are:"
echo
echo "Y - Yes, install stack"
echo "N - No, don't install anything more (default)"
echo
echo "Please make your choice and press ENTER."
;;
esac
done
else
return 0
fi
unset stack_answer
}
find_shell
echo
echo "Welcome to Haskell!"
@@ -350,12 +580,20 @@ echo
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
warn "Press ENTER to proceed or ctrl-c to abort."
warn "Note that this script can be re-run at any given time."
echo
# Wait for user input to continue.
# shellcheck disable=SC2034
read -r answer </dev/tty
fi
ask_bashrc
ask_bashrc_answer=$?
ask_cabal_config_init
ask_cabal_config_init_answer=$?
ask_hls
ask_hls_answer=$?
ask_stack
ask_stack_answer=$?
edo mkdir -p "${GHCUP_BIN}"
if command -V "ghcup" >/dev/null 2>&1 ; then
@@ -385,122 +623,28 @@ eghcup --cache install ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
eghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
eghcup --cache install cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
adjust_cabal_config() {
edo cabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$HOME"/AppData/Roaming/cabal/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
}
case "${plat}" in
MSYS*|MINGW*)
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
warn "Create an initial cabal.config including relevant msys2 paths (recommended)?"
warn "[Y] Yes [N] No [?] Help (default is \"Y\")."
echo
while true; do
read -r mingw_answer </dev/tty
case $mingw_answer in
[Yy]* | "")
adjust_cabal_config
break ;;
[Nn]*)
echo "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
echo "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
sleep 5
break ;;
*)
echo "Possible choices are:"
echo
echo "Y - Yes, create a cabal.config with pre-set paths to msys2/mingw64 (default)"
echo "N - No, leave the current/default cabal config untouched"
echo
echo "Please make your choice and press ENTER."
;;
esac
done
else
adjust_cabal_config
fi
;;
esac
do_cabal_config_init $ask_cabal_config_init_answer
edo cabal new-update
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
warn "Do you want to install haskell-language-server (HLS) now?"
warn "HLS is a language-server that provides IDE-like functionality"
warn "and can integrate with different editors, such as Vim, Emacs, VS Code, Atom, ..."
warn "Also see https://github.com/haskell/haskell-language-server/blob/master/README.md"
warn ""
warn "[Y] Yes [N] No [?] Help (default is \"N\")."
warn ""
while true; do
read -r hls_answer </dev/tty
case $hls_answer in
[Yy]*)
_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
break ;;
[Nn]* | "")
break ;;
*)
echo "Possible choices are:"
echo
echo "Y - Yes, install the haskell-langauge-server"
echo "N - No, don't install anything more (default)"
echo
echo "Please make your choice and press ENTER."
;;
esac
done
warn "Do you want to install stack now?"
warn "Stack is a haskell build tool similar to cabal that is used by some projects."
warn "Also see https://docs.haskellstack.org/"
warn ""
warn "[Y] Yes [N] No [?] Help (default is \"N\")."
warn ""
while true; do
read -r stack_answer </dev/tty
case $stack_answer in
[Yy]*)
_eghcup --cache install stack || warn "Stack installation failed, continuing anyway"
break ;;
[Nn]* | "")
break ;;
*)
echo "Possible choices are:"
echo
echo "Y - Yes, install stack"
echo "N - No, don't install anything more (default)"
echo
echo "Please make your choice and press ENTER."
;;
esac
done
fi
# short-circuit script based on platform
case "${plat}" in
MSYS*|MINGW*)
# For windows we always adjust bashrc, since it's inside msys2
adjust_bashrc
;;
*)
if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
echo "In order to run ghc and cabal, you need to adjust your PATH variable."
echo "You may want to source '$GHCUP_DIR/env' in your shell"
echo "configuration to do so (e.g. ~/.bashrc)."
adjust_bashrc
fi
;;
case $ask_hls_answer in
1)
_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
;;
*) ;;
esac
case $ask_stack_answer in
1)
_eghcup --cache install stack || warn "Stack installation failed, continuing anyway"
;;
*) ;;
esac
adjust_bashrc $ask_bashrc_answer
_done
)

View File

@@ -26,7 +26,13 @@ param (
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
[string]$BootstrapUrl,
# Run the final bootstrap script via 'bash' instead of a full newly spawned msys2 shell
[switch]$InBash
[switch]$InBash,
# Whether to install stack as well
[switch]$InstallStack,
# Whether to install hls as well
[switch]$InstallHLS,
# Skip adjusting cabal.config with mingw paths
[switch]$NoAdjustCabalConfig
)
$Silent = !$Interactive
@@ -150,15 +156,6 @@ function Exec
$ErrorActionPreference = 'Stop'
$elevated = ([Security.Principal.WindowsPrincipal] `
[Security.Principal.WindowsIdentity]::GetCurrent()
).IsInRole([Security.Principal.WindowsBuiltInRole]::Administrator)
if ($elevated) {
Print-Msg -color Yellow -msg ('This script should not be run as administrator/elevated. Waiting 10s before continuing anyway...')
Start-Sleep -s 10
}
$GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
if ($GhcupBasePrefixEnv) {
@@ -187,6 +184,7 @@ if ($GhcupBasePrefixEnv) {
}
}
# ask for base install prefix
if ($Silent -and !($InstallDir)) {
$GhcupBasePrefix = $defaultGhcupBasePrefix
} elseif ($InstallDir) {
@@ -234,6 +232,7 @@ $GhcupMsys2 = [System.Environment]::GetEnvironmentVariable('GHCUP_MSYS2', 'user'
Print-Msg -msg 'Preparing for GHCup installation...'
# ask what to do in case ghcup is already installed
if (Test-Path -LiteralPath ('{0}' -f $GhcupDir)) {
Print-Msg -msg ('GHCup already installed at ''{0}''...' -f $GhcupDir)
if ($Overwrite) {
@@ -263,8 +262,73 @@ if (Test-Path -LiteralPath ('{0}' -f $GhcupDir)) {
$null = New-Item -Path ('{0}' -f $GhcupDir) -ItemType 'directory' -ErrorAction SilentlyContinue
$null = New-Item -Path ('{0}' -f $GhcupDir) -Name 'bin' -ItemType 'directory' -ErrorAction SilentlyContinue
Print-Msg -msg 'First checking for Msys2...'
# ask for cabal dir destination
if ($CabalDir) {
$CabDirEnv = $CabalDir
if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!"
Exit 1
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
Exit 1
}
} elseif (!($Silent)) {
while ($true) {
$defaultCabalDir = ('{0}\cabal' -f $GhcupBasePrefix)
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]
if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
} else {
Break
}
}
} else {
$CabDirEnv = ('{0}\cabal' -f $GhcupBasePrefix)
}
# ask whether to install HLS
if (!($InstallHLS)) {
if (!($Silent)) {
$HLSdecision = $Host.UI.PromptForChoice('Install HLS'
, 'Do you want to install the haskell-language-server (HLS) for development purposes as well?'
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
'&No'
'&Abort'), 1)
if ($HLSdecision -eq 0) {
$InstallHLS = $true
} elseif ($HLSdecision -eq 2) {
Exit 0
}
}
}
# ask whether to install stack
if (!($InstallStack)) {
if (!($Silent)) {
$StackDecision = $Host.UI.PromptForChoice('Install stack'
, 'Do you want to install stack as well?'
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Yes'
'&No'
'&Abort'), 1)
if ($StackDecision -eq 0) {
$InstallStack = $true
} elseif ($StackDecision -eq 2) {
Exit 0
}
}
}
# mingw foo
Print-Msg -msg 'First checking for Msys2...'
if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
if ($Silent) {
$msys2Decision = 0
@@ -276,7 +340,10 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
}
if ($msys2Decision -eq 0) {
Print-Msg -msg ('...Msys2 doesn''t exist, installing into {0} ...this may take a while' -f $MsysDir)
Print-Msg -msg ('...Msys2 doesn''t exist, installing into {0}' -f $MsysDir)
Print-Msg -msg 'Starting installation in 5 seconds, this may take a while...'
Start-Sleep -s 5
# Download the archive
Print-Msg -msg 'Downloading Msys2 archive...'
@@ -316,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 {
@@ -339,46 +406,85 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
}
} else {
Print-Msg -msg ('...Msys2 found in {0} ...skipping Msys2 installation.' -f $MsysDir)
Print-Msg -msg 'Starting installation in 5 seconds, this may take a while...'
Start-Sleep -s 5
}
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'
if ($CabalDir) {
$CabDirEnv = $CabalDir
if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!"
Exit 1
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
Exit 1
}
} elseif (!($Silent)) {
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)
$CabalDirPrompt = Read-Host
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
if (!($CabDirEnv)) {
Print-Msg -color Red -msg "No directory specified!"
} elseif (!(Split-Path -IsAbsolute -Path "$CabDirEnv")) {
Print-Msg -color Red -msg "Invalid/Non-absolute Path specified"
} else {
Break
}
}
} else {
$CabDirEnv = ('{0}\cabal' -f $GhcupBasePrefix)
}
$CabalDirFull = [System.IO.Path]::GetFullPath("$CabDirEnv")
Print-Msg -msg ('Setting CABAL_DIR to ''{0}''' -f $CabalDirFull)
@@ -388,16 +494,25 @@ Print-Msg -msg 'Starting GHCup installer...'
$Msys2Shell = ('{0}\msys2_shell.cmd' -f $MsysDir)
if ($Silent) {
$SilentExport = 'export BOOTSTRAP_HASKELL_NONINTERACTIVE=1 ;'
} else {
$SilentExport = ''
# The bootstrap script is always silent, since we ask relevant questions here
$SilentExport = 'export BOOTSTRAP_HASKELL_NONINTERACTIVE=1 ;'
if ($InstallStack) {
$StackInstallExport = 'export BOOTSTRAP_HASKELL_INSTALL_STACK=1 ;'
}
if ($InstallHLS) {
$HLSInstallExport = 'export BOOTSTRAP_HASKELL_INSTALL_HLS=1 ;'
}
if (!($NoAdjustCabalConfig)) {
$AdjustCabalConfigExport = 'export BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG=1 ;'
}
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
Exec "$Bash" '-lc' ('{4} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull)
Exec "$Bash" '-lc' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport)
} else {
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull)
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && curl --proto ''=https'' --tlsv1.2 -sSf {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport)
}
@@ -429,3 +544,5 @@ if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBa

View File

@@ -1,20 +0,0 @@
packages: ./ghcup.cabal
with-compiler: ghc-8.10.4
optional-packages: ./3rdparty/*/*.cabal
optimization: 2
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell

33
cabal.ghc8105.project Normal file
View File

@@ -0,0 +1,33 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
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
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-8.10.5

View File

@@ -1,12 +1,11 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0,
any.HUnit ==1.6.2.0,
any.IfElse ==0.85,
any.HsOpenSSL ==0.11.7,
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.abstract-deque ==0.3,
abstract-deque -usecas,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
@@ -18,31 +17,32 @@ constraints: any.Cabal ==3.2.1.0,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.ascii-string ==1.0.1.4,
any.assoc ==1.0.2,
any.async ==2.2.3,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.5,
attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.14.1.0,
any.base ==4.14.2.0,
any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2,
any.base-orphans ==0.8.4,
any.base16-bytestring ==1.0.1.0,
any.base64-bytestring ==1.2.0.1,
any.bifunctors ==5.5.10,
any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1,
any.brick ==0.63,
brick -demos,
any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.7,
any.bzlib-conduit ==0.3.0.2,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.call-stack ==0.3.0,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.1,
@@ -54,7 +54,7 @@ constraints: any.Cabal ==3.2.1.0,
clock -llvm,
any.cmdargs ==0.10.21,
cmdargs +quotation -testprog,
any.colour ==2.3.5,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
@@ -62,16 +62,25 @@ constraints: any.Cabal ==3.2.1.0,
any.concurrent-output ==1.10.12,
any.conduit ==1.3.4.1,
any.conduit-extra ==1.3.5,
any.containers ==0.6.2.1,
any.contravariant ==1.5.3,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.4,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha1 ==0.11.100.1,
any.cryptohash-sha256 ==0.11.102.0,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.1,
any.deepseq ==1.4.4.0,
any.deferred-folds ==0.9.17,
any.digest ==0.0.1.3,
digest -bytestring-in-base,
any.directory ==1.3.6.0,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
@@ -79,74 +88,68 @@ constraints: any.Cabal ==3.2.1.0,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4,
any.fast-logger ==3.0.3,
any.extra ==1.7.9,
any.fast-logger ==3.0.5,
any.filepath ==1.4.2.1,
any.focus ==1.0.2,
any.foldl ==1.4.11,
any.free ==5.1.6,
any.fusion-plugin-types ==0.1.0,
any.free ==5.1.7,
any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.1,
any.ghc-boot-th ==8.10.4,
any.ghc-boot-th ==8.10.5,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1,
ghcup -internal-downloader -tar -tui,
any.happy ==1.20.0,
any.hashable ==1.3.1.0,
hashable +integer-gmp,
any.hashable ==1.3.2.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.7,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1,
any.heaps ==0.3.6.1,
any.hpath ==0.11.0,
any.hpath-directory ==0.14.1,
any.hpath-filepath ==0.10.4,
any.hpath-io ==0.14.1,
any.hpath-posix ==0.13.2,
any.hpath-posix ==0.13.3,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.8,
any.hspec-core ==2.7.8,
any.hspec-discover ==2.7.8,
any.hspec ==2.7.10,
any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10 || ==2.8.2,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.7.0.0,
any.indexed-profunctors ==0.1,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1,
any.indexed-traversable-instances ==0.1,
any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.8.3,
language-c -allwarnings +iecfpextension +separatesyb +usebytestrings,
any.libarchive ==3.0.2.1,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.2.2,
libarchive -cross -low-memory -system-libarchive,
any.libyaml ==0.1.2,
libyaml -no-unicode -system-libyaml,
any.lifted-base ==0.2.3.12,
any.list-t ==1.0.4,
any.lockfree-queue ==0.2.3.1,
lzma -static,
any.math-functions ==0.3.4.1,
math-functions +system-erf +system-expm1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.9,
any.mmorph ==1.1.5,
any.monad-control ==1.0.2.3,
any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3,
any.monad-logger ==0.3.36,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2,
any.mwc-random ==0.15.0.1,
any.network ==3.1.2.1,
any.network ==3.1.2.2,
network -devel,
any.network-uri ==2.6.4.1,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4,
any.optics-core ==0.4,
optics-core -explicit-generic-labels,
@@ -161,25 +164,25 @@ constraints: any.Cabal ==3.2.1.0,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.1.0,
any.primitive-extras ==0.8.2,
any.primitive-unlifted ==0.1.3.0,
any.process ==1.6.9.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.0,
any.recursion-schemes ==5.2.2,
any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell,
any.regex-posix ==0.96.0.0,
any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2,
any.rts ==1.0,
any.rts ==1.0.1,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.1,
any.scientific ==0.3.6.2,
any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
@@ -188,36 +191,31 @@ constraints: any.Cabal ==3.2.1.0,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.3,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.stm ==2.5.0.1,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.2.1,
streaming-commons -use-bytestring-builder,
any.streamly ==0.7.3,
streamly -debug -dev -examples -examples-sdl -fusion-plugin -has-llvm -inspection -no-fusion -streamk,
any.streamly-bytestring ==0.1.2,
any.streamly-posix ==0.1.0.1,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.1.0,
any.string-interpolate ==0.3.1.1,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tasty ==1.3.1,
tasty +clock,
any.tasty-hunit ==0.10.0.3,
any.tasty-quickcheck ==0.10.1.2,
any.tar ==0.6.0.0,
any.template-haskell ==2.16.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4,
any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-short ==0.1.3,
text-short -asserts,
any.text-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1.1,
any.th-compat ==0.1.2,
any.th-expand-syns ==0.4.8.0,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
@@ -225,37 +223,42 @@ constraints: any.Cabal ==3.2.1.0,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.5,
any.time-compat ==1.9.6,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances,
any.transformers-compat ==0.6.6,
any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unbounded-delays ==0.1.1.1,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.13.0,
any.unordered-containers ==0.2.14.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.0,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.4,
any.vector ==0.12.2.0,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.4,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.versions ==4.0.3,
any.versions ==5.0.0,
any.vty ==5.33,
any.wcwidth ==0.0.2,
wcwidth -cli +split-base,
any.word-wrap ==0.4.1,
any.word8 ==0.1.3,
any.xor ==0.0.1.0,
any.yaml ==0.11.5.0,
yaml +no-examples +no-exe,
zlib -non-blocking-ffi -pkg-config -static
index-state: hackage.haskell.org 2021-03-07T18:36:25Z
any.zip ==1.7.1,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.2.0,
zstd +standalone
index-state: hackage.haskell.org 2021-07-27T07:59:57Z

View File

@@ -1,20 +0,0 @@
packages: ./ghcup.cabal
with-compiler: ghc-8.8.4
optional-packages: ./3rdparty/*/*.cabal
optimization: 2
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package ghcup
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell

33
cabal.ghc901.project Normal file
View File

@@ -0,0 +1,33 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
optimization: 2
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
tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
source-repository-package
type: git
location: https://github.com/bgamari/terminal-size
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.1

View File

@@ -1,12 +1,11 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.0.1.0,
constraints: any.Cabal ==3.4.0.0,
any.HUnit ==1.6.2.0,
any.IfElse ==0.85,
any.HsOpenSSL ==0.11.7,
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.abstract-deque ==0.3,
abstract-deque -usecas,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
@@ -18,31 +17,32 @@ constraints: any.Cabal ==3.0.1.0,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.ascii-string ==1.0.1.4,
any.assoc ==1.0.2,
any.async ==2.2.3,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.5,
attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.13.0.0,
any.base ==4.15.0.0,
any.base-compat ==0.11.2,
any.base-compat-batteries ==0.11.2,
any.base-orphans ==0.8.4,
any.base16-bytestring ==1.0.1.0,
any.base64-bytestring ==1.2.0.1,
any.bifunctors ==5.5.10,
any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged,
any.binary ==0.8.7.0,
any.binary ==0.8.8.0,
any.bindings-DSL ==1.0.25,
any.blaze-builder ==0.4.2.1,
any.bytestring ==0.10.10.1,
any.brick ==0.63,
brick -demos,
any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.7,
any.bzlib-conduit ==0.3.0.2,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.call-stack ==0.3.0,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.cereal ==0.5.8.1,
@@ -54,7 +54,7 @@ constraints: any.Cabal ==3.0.1.0,
clock -llvm,
any.cmdargs ==0.10.21,
cmdargs +quotation -testprog,
any.colour ==2.3.5,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
@@ -62,16 +62,25 @@ constraints: any.Cabal ==3.0.1.0,
any.concurrent-output ==1.10.12,
any.conduit ==1.3.4.1,
any.conduit-extra ==1.3.5,
any.containers ==0.6.2.1,
any.contravariant ==1.5.3,
any.conduit-zstd ==0.0.2.0,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.4,
contravariant +semigroups +statevar +tagged,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha1 ==0.11.100.1,
any.cryptohash-sha256 ==0.11.102.0,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3,
any.data-default-class ==0.1.2.0,
any.data-fix ==0.3.1,
any.deepseq ==1.4.4.0,
any.deferred-folds ==0.9.17,
any.directory ==1.3.6.0,
any.deepseq ==1.4.5.0,
any.digest ==0.0.1.3,
digest -bytestring-in-base,
any.directory ==1.3.6.1,
any.disk-free-space ==0.1.0.1,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
@@ -79,75 +88,68 @@ constraints: any.Cabal ==3.0.1.0,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4,
exceptions +transformers-0-4,
any.fast-logger ==3.0.3,
any.extra ==1.7.9,
any.fast-logger ==3.0.5,
any.filepath ==1.4.2.1,
any.focus ==1.0.2,
any.foldl ==1.4.11,
any.free ==5.1.6,
any.fusion-plugin-types ==0.1.0,
any.free ==5.1.7,
any.generic-arbitrary ==0.1.0,
any.generics-sop ==0.5.1.1,
any.ghc-boot-th ==8.8.4,
any.ghc-prim ==0.5.3,
ghcup -internal-downloader -tar -tui,
any.ghc-bignum ==1.0,
any.ghc-boot-th ==9.0.1,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0,
any.happy ==1.20.0,
any.hashable ==1.3.1.0,
hashable +integer-gmp,
any.hashable ==1.3.2.0,
hashable +integer-gmp -random-initial-seed,
any.haskell-src-exts ==1.23.1,
any.haskell-src-meta ==0.8.7,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1,
any.heaps ==0.3.6.1,
any.hpath ==0.11.0,
any.hpath-directory ==0.14.1,
any.hpath-filepath ==0.10.4,
any.hpath-io ==0.14.1,
any.hpath-posix ==0.13.2,
any.hpath-posix ==0.13.3,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.8,
any.hspec-core ==2.7.8,
any.hspec-discover ==2.7.8,
any.hspec ==2.7.10,
any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10 || ==2.8.2,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.7.0.0,
any.indexed-profunctors ==0.1,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1,
any.indexed-traversable-instances ==0.1,
any.integer-gmp ==1.0.2.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.language-c ==0.8.3,
language-c -allwarnings +iecfpextension +separatesyb +usebytestrings,
any.libarchive ==3.0.2.1,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.2.2,
libarchive -cross -low-memory -system-libarchive,
any.libyaml ==0.1.2,
libyaml -no-unicode -system-libyaml,
any.lifted-base ==0.2.3.12,
any.list-t ==1.0.4,
any.lockfree-queue ==0.2.3.1,
lzma -static,
any.math-functions ==0.3.4.1,
math-functions +system-erf +system-expm1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.9,
any.mmorph ==1.1.5,
any.monad-control ==1.0.2.3,
any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3,
any.monad-logger ==0.3.36,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2,
any.mwc-random ==0.15.0.1,
any.network ==3.1.2.1,
any.network ==3.1.2.2,
network -devel,
any.network-uri ==2.6.4.1,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4,
any.optics-core ==0.4,
optics-core -explicit-generic-labels,
@@ -162,25 +164,25 @@ constraints: any.Cabal ==3.0.1.0,
any.parsec ==3.1.14.0,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.polyparse ==1.13,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.primitive ==0.7.1.0,
any.primitive-extras ==0.8.2,
any.primitive-unlifted ==0.1.3.0,
any.process ==1.6.9.0,
any.process ==1.6.11.0,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.0,
any.recursion-schemes ==5.2.2,
any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell,
any.regex-posix ==0.96.0.0,
any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.2,
any.rts ==1.0,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.1,
any.scientific ==0.3.6.2,
any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
@@ -193,32 +195,27 @@ constraints: any.Cabal ==3.0.1.0,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.2.1,
streaming-commons -use-bytestring-builder,
any.streamly ==0.7.3,
streamly -debug -dev -examples -examples-sdl -fusion-plugin -has-llvm -inspection -no-fusion -streamk,
any.streamly-bytestring ==0.1.2,
any.streamly-posix ==0.1.0.1,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.string-interpolate ==0.3.1.0,
any.string-interpolate ==0.3.1.1,
string-interpolate -bytestring-builder -extended-benchmarks -text-builder,
any.syb ==0.7.2.1,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.tasty ==1.3.1,
tasty +clock,
any.tasty-hunit ==0.10.0.3,
any.tasty-quickcheck ==0.10.1.2,
any.template-haskell ==2.15.0.0,
any.tar ==0.6.0.0,
any.template-haskell ==2.17.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4,
any.text ==1.2.4.0,
any.text ==1.2.4.1,
any.text-conversions ==0.3.1,
any.text-short ==0.1.3,
text-short -asserts,
any.text-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.2.0,
any.th-compat ==0.1.1,
any.th-compat ==0.1.2,
any.th-expand-syns ==0.4.8.0,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18,
any.th-orphans ==0.13.11,
@@ -226,37 +223,42 @@ constraints: any.Cabal ==3.0.1.0,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.5,
any.time-compat ==1.9.6,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.5.2,
transformers-base +orphaninstances,
any.transformers-compat ==0.6.6,
any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unbounded-delays ==0.1.1.1,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.13.0,
any.unordered-containers ==0.2.14.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.0,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.4,
any.vector ==0.12.2.0,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.4,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.versions ==4.0.3,
any.versions ==5.0.0,
any.vty ==5.33,
any.wcwidth ==0.0.2,
wcwidth -cli +split-base,
any.word-wrap ==0.4.1,
any.word8 ==0.1.3,
any.xor ==0.0.1.0,
any.yaml ==0.11.5.0,
yaml +no-examples +no-exe,
zlib -non-blocking-ffi -pkg-config -static
index-state: hackage.haskell.org 2021-03-07T18:36:25Z
any.zip ==1.7.1,
zip -dev -disable-bzip2 -disable-zstd,
any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5,
any.zstd ==0.1.2.0,
zstd +standalone
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

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:
@@ -2155,14 +2179,13 @@ ghcupDownloads:
unknown_versioning: *stack-251-64
2.7.1:
viTags:
- Recommended
- Latest
- old
viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v271
viPostInstall: *stack-post
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &stack-64
unknown_versioning: &stack-271-64
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-linux-x86_64.tar.gz
dlHash: 2bc47749ee4be5eccb52a2d4a6a00b0f3b28b92517742b40c675836d7db2777d
dlSubdir:
@@ -2180,5 +2203,33 @@ ghcupDownloads:
dlSubdir:
RegexDir: "stack-.*"
Linux_Alpine:
unknown_versioning: *stack-64
unknown_versioning: *stack-271-64
2.7.3:
viTags:
- Latest
- Recommended
viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v273
viPostInstall: *stack-post
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &stack-273-64
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.3/stack-2.7.3-linux-x86_64.tar.gz
dlHash: a6c090555fa1c64aa61c29aa4449765a51d79e870cf759cde192937cd614e72b
dlSubdir:
RegexDir: "stack-.*"
Darwin:
unknown_versioning:
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.3/stack-2.7.3-osx-x86_64.tar.gz
dlHash: 42e5000a00af44a7b26852421ac63ce75f510ad1a97742cb131107088ee9fe30
dlSubdir:
RegexDir: "stack-.*"
Windows:
unknown_versioning:
dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.3/stack-2.7.3-windows-x86_64.tar.gz
dlHash: e6ba12e0ecabf0df2567d88a0d247da238bc114bcccfca4195f5e86472c9330c
dlSubdir:
RegexDir: "stack-.*"
Linux_Alpine:
unknown_versioning: *stack-273-64

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
@@ -82,7 +83,6 @@ library
QuasiQuotes
RecordWildCards
ScopedTypeVariables
Strict
StrictData
TupleSections
TypeApplications
@@ -117,7 +117,7 @@ library
, megaparsec >=8.0.0 && <9.1
, monad-logger ^>=0.3.31
, mtl ^>=2.2
, optics >=0.2 && <0.5
, optics ^>=0.4
, optics-vl ^>=0.2
, os-release ^>=1.0.0
, parsec ^>=3.1
@@ -195,7 +195,6 @@ executable ghcup
PackageImports
RecordWildCards
ScopedTypeVariables
Strict
StrictData
TupleSections
@@ -204,9 +203,11 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded
build-depends:
, async ^>=2.2.3
, base >=4.13 && <5
, bytestring ^>=0.10
, containers ^>=0.6
, deepseq ^>=1.4
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-variant >=3.0 && <3.2
@@ -233,7 +234,7 @@ executable ghcup
cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick >=0.5 && <0.62
, brick >=0.5 && <0.64
, transformers ^>=0.5
, vector ^>=0.12
, vty >=5.28.2 && <5.34
@@ -261,7 +262,6 @@ executable ghcup-gen
QuasiQuotes
RecordWildCards
ScopedTypeVariables
Strict
StrictData
TupleSections
TypeApplications
@@ -281,7 +281,7 @@ executable ghcup-gen
, haskus-utils-variant >=3.0 && <3.2
, monad-logger ^>=0.3.31
, mtl ^>=2.2
, optics >=0.2 && <0.5
, optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
@@ -305,6 +305,7 @@ executable ghcup-gen
test-suite ghcup-test
type: exitcode-stdio-1.0
main-is: Main.hs
build-tool-depends: hspec-discover:hspec-discover -any
hs-source-dirs: test
other-modules:
GHCup.ArbitraryTypes

File diff suppressed because it is too large Load Diff

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
@@ -107,32 +107,32 @@ import qualified Data.Yaml as Y
getDownloadsF :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
, MonadReader env m
, HasSettings env
, HasDirs env
, MonadIO m
, MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> Settings
-> Dirs
-> Excepts
=> Excepts
'[JSONError , DownloadFailed , FileDoesNotExistError]
m
GHCupInfo
getDownloadsF settings@Settings{ urlSource } dirs = do
getDownloadsF = do
Settings { urlSource } <- lift getSettings
case urlSource of
GHCupURL -> liftE $ getBase dirs settings
(OwnSource url) -> do
bs <- reThrowAll DownloadFailed $ downloadBS (downloader settings) url
lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
GHCupURL -> liftE $ getBase ghcupURL
(OwnSource url) -> liftE $ getBase url
(OwnSpec av) -> pure av
(AddSource (Left ext)) -> do
base <- liftE $ getBase dirs settings
base <- liftE $ getBase ghcupURL
pure (mergeGhcupInfo base ext)
(AddSource (Right uri)) -> do
base <- liftE $ getBase dirs settings
bsExt <- reThrowAll DownloadFailed $ downloadBS (downloader settings) uri
ext <- lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bsExt)
base <- liftE $ getBase ghcupURL
ext <- liftE $ getBase uri
pure (mergeGhcupInfo base ext)
where
@@ -149,169 +149,142 @@ getDownloadsF settings@Settings{ urlSource } dirs = do
in GHCupInfo tr newDownloads newGlobalTools
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m)
=> Dirs
-> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache Dirs {..} = do
lift $ $(logWarn)
[i|Could not get download info, trying cached version (this may not be recent!)|]
let path = view pathL' ghcupURL
let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
bs <-
handleIO' NoSuchThing
(\_ -> throwE $ FileDoesNotExistError yaml_file)
$ liftIO
$ L.readFile yaml_file
lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
yamlFromCache uri = do
Dirs{..} <- getDirs
pure (cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri))
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m)
=> Dirs
-> Settings
-> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
getBase dirs@Dirs{..} Settings{ downloader } =
handleIO (\_ -> readFromCache dirs)
$ catchE @_ @'[JSONError, FileDoesNotExistError]
(\(DownloadFailed _) -> readFromCache dirs)
(reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed (smartDl ghcupURL)
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . first show . Y.decodeEither' . L.toStrict))
where
etagsFile :: FilePath -> FilePath
etagsFile = (<.> "etags")
getBase :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadFail m
, MonadIO m
, MonadCatch m
, MonadLogger m
, MonadMask m
)
=> URI
-> Excepts '[JSONError] m GHCupInfo
getBase uri = do
Settings { noNetwork } <- lift getSettings
yaml <- lift $ yamlFromCache uri
unless noNetwork $
handleIO (\e -> warnCache (displayException e))
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e))
. reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
. smartDl
$ uri
liftE
. onE_ (onError yaml)
. lEM' @_ @_ @'[JSONError] JSONDecodeError
. fmap (first (\e -> [i|#{displayException e}
Consider removing "#{yaml}" manually.|]))
. liftIO
. Y.decodeFileEither
$ yaml
where
-- 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
. ( MonadCatch m1
smartDl :: forall m1 env1
. ( MonadReader env1 m1
, HasDirs env1
, HasSettings env1
, MonadCatch m1
, MonadIO m1
, MonadFail m1
, MonadLogger m1
, MonadMask m1
)
=> URI
-> Excepts
'[ FileDoesNotExistError
, HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
, ProcessError
'[ DownloadFailed
, DigestError
]
m1
L.ByteString
()
smartDl uri' = do
let path = view pathL' uri'
let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
e <- liftIO $ doesFileExist json_file
json_file <- lift $ yamlFromCache uri'
e <- liftIO $ doesFileExist json_file
currentTime <- liftIO getCurrentTime
if e
then do
accessTime <- liftIO $ getAccessTime json_file
currentTime <- liftIO getCurrentTime
-- 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
when ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) $
-- no access in last 5 minutes, re-check upstream mod time
dlWithMod currentTime json_file
else
dlWithMod currentTime json_file
where
dlWithMod modTime json_file = do
bs <- liftE $ downloadBS downloader uri'
liftIO $ writeFileWithModTime modTime json_file bs
pure bs
dlWithoutMod json_file = do
bs <- liftE $ downloadBS downloader uri'
liftIO $ hideError doesNotExistErrorType $ rmFile json_file
liftIO $ L.writeFile json_file bs
liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
pure bs
let (dir, fn) = splitFileName json_file
f <- liftE $ download uri' Nothing dir (Just fn) True
liftIO $ setModificationTime f modTime
liftIO $ setAccessTime f modTime
getModTime = do
#if !defined(INTERNAL_DOWNLOADER)
pure Nothing
#else
headers <-
handleIO (\_ -> pure mempty)
$ liftE
$ ( catchAllE
(\_ ->
pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
)
$ getHead uri'
)
pure $ parseModifiedHeader headers
parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
parseModifiedHeader headers =
(M.lookup (CI.mk "Last-Modified") headers) >>= \h -> parseTimeM
True
defaultTimeLocale
"%a, %d %b %Y %H:%M:%S %Z"
(T.unpack . decUTF8Safe $ h)
#endif
writeFileWithModTime :: UTCTime -> FilePath -> L.ByteString -> IO ()
writeFileWithModTime utctime path content = do
L.writeFile path content
setModificationTime path utctime
getDownloadInfo :: Tool
getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
)
=> Tool
-> Version
-- ^ tool version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
(Left NoDownload)
Right
(case p of
-- non-musl won't work on alpine
Linux Alpine -> with_distro <|> without_distro_ver
_ -> with_distro <|> without_distro_ver <|> without_distro
)
-> Excepts
'[NoDownload]
m
DownloadInfo
getDownloadInfo t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
where
with_distro = distro_preview id id
without_distro_ver = distro_preview id (const Nothing)
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
let distro_preview f g =
let platformVersionSpec =
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
mv' = g mv
in fmap snd
. find
(\(mverRange, _) -> maybe
(isNothing mv')
(\range -> maybe False (`versionRange` range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
with_distro = distro_preview id id
without_distro_ver = distro_preview id (const Nothing)
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
distro_preview f g =
let platformVersionSpec =
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
mv' = g mv
in fmap snd
. find
(\(mverRange, _) -> maybe
(isNothing mv')
(\range -> maybe False (`versionRange` range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
maybe
(throwE NoDownload)
pure
(case p of
-- non-musl won't work on alpine
Linux Alpine -> with_distro <|> without_distro_ver
_ -> with_distro <|> without_distro_ver <|> without_distro
)
-- | Tries to download from the given http or https url
@@ -321,114 +294,232 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
-- 2. otherwise create a random file
--
-- The file must not exist.
download :: ( MonadMask m
download :: ( MonadReader env m
, HasSettings env
, HasDirs env
, MonadMask m
, MonadThrow m
, MonadLogger m
, MonadIO m
)
=> Settings
-> DownloadInfo
=> URI
-> Maybe T.Text -- ^ expected hash
-> FilePath -- ^ destination dir
-> Maybe FilePath -- ^ optional filename
-> Bool -- ^ whether to read an write etags
-> Excepts '[DigestError , DownloadFailed] m FilePath
download settings@Settings{ downloader } dli dest mfn
download uri eDigest dest mfn etags
| scheme == "https" = dl
| scheme == "http" = dl
| scheme == "file" = cp
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
where
scheme = view (dlUri % uriSchemeL' % schemeBSL') dli
scheme = view (uriSchemeL' % schemeBSL') uri
cp = do
-- destination dir must exist
liftIO $ createDirRecursive' dest
let destFile = getDestFile
let fromFile = T.unpack . decUTF8Safe $ path
liftIO $ copyFile fromFile destFile
pure destFile
dl = do
let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli))
let uri' = decUTF8Safe (serializeURIRef' uri)
lift $ $(logInfo) [i|downloading: #{uri'}|]
-- destination dir must exist
liftIO $ createDirRecursive' dest
let destFile = getDestFile
-- download
flip onException
(liftIO $ hideError doesNotExistErrorType $ rmFile destFile)
(lift $ hideError doesNotExistErrorType $ recycleFile destFile)
$ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
(\e ->
liftIO (hideError doesNotExistErrorType $ rmFile destFile)
lift (hideError doesNotExistErrorType $ recycleFile destFile)
>> (throwE . DownloadFailed $ e)
) $ do
Settings{ downloader, noNetwork } <- lift getSettings
when noNetwork $ throwE (DownloadFailed (V NoNetwork :: V '[NoNetwork]))
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 (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 (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 (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 (pure $ Just etag))
$ do
r <- downloadToFile https host fullPath port destFile addHeaders
writeEtags (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 settings 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.
destFile :: FilePath
destFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
(dest </>)
mfn
path = view pathL' 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) => m (Maybe T.Text) -> m ()
writeEtags 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
-- is omitted, infers the filename from the url.
downloadCached :: ( MonadMask m
downloadCached :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadMask m
, MonadResource m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadUnliftIO m
)
=> Settings
-> Dirs
-> DownloadInfo
=> DownloadInfo
-> Maybe FilePath -- ^ optional filename
-> Excepts '[DigestError , DownloadFailed] m FilePath
downloadCached settings@Settings{ cache } dirs dli mfn = do
downloadCached dli mfn = do
Settings{ cache } <- lift getSettings
case cache of
True -> downloadCached' settings dirs dli mfn
True -> downloadCached' dli mfn Nothing
False -> do
tmp <- lift withGHCupTmpDir
liftE $ download settings dli tmp mfn
liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False
downloadCached' :: ( MonadMask m
downloadCached' :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadMask m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadUnliftIO m
)
=> Settings
-> Dirs
-> DownloadInfo
=> DownloadInfo
-> Maybe FilePath -- ^ optional filename
-> Maybe FilePath -- ^ optional destination dir (default: cacheDir)
-> Excepts '[DigestError , DownloadFailed] m FilePath
downloadCached' settings Dirs{..} dli mfn = do
downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe cacheDir mDestDir
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
let cachfile = cacheDir </> fn
let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile
if
| fileExists -> do
liftE $ checkDigest settings dli cachfile
liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile
| otherwise -> liftE $ download settings dli cacheDir mfn
| otherwise -> liftE $ download (_dlUri dli) (Just (_dlHash dli)) destDir mfn False
@@ -439,79 +530,24 @@ downloadCached' settings Dirs{..} dli mfn = do
-- | This is used for downloading the JSON.
downloadBS :: (MonadCatch m, MonadIO m, MonadLogger m)
=> Downloader
-> URI
-> Excepts
'[ FileDoesNotExistError
, HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
, ProcessError
]
m
L.ByteString
downloadBS downloader 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'}|]
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 :: (MonadIO m, MonadThrow m, MonadLogger m)
=> Settings
-> DownloadInfo
checkDigest :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadThrow m
, MonadLogger m
)
=> T.Text -- ^ the hash
-> FilePath
-> Excepts '[DigestError] m ()
checkDigest Settings{ noVerify } dli file = do
checkDigest eDigest file = do
Settings{ noVerify } <- lift getSettings
let verify = not noVerify
when verify $ do
let p' = takeFileName file
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,14 +27,18 @@ 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
import Haskus.Utils.Variant
import Text.PrettyPrint
import Text.PrettyPrint.HughesPJClass
import Text.PrettyPrint hiding ( (<>) )
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString
import qualified Data.Map.Strict as M
------------------------
@@ -180,13 +184,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
@@ -233,6 +253,20 @@ instance Pretty NoToolVersionSet where
pPrint (NoToolVersionSet tool) =
text [i|No version is set for tool "#{tool}".|]
data NoNetwork = NoNetwork
deriving Show
instance Pretty NoNetwork where
pPrint NoNetwork =
text [i|A download was required or requested, but '--offline' was specified.|]
data HadrianNotFound = HadrianNotFound
deriving Show
instance Pretty HadrianNotFound where
pPrint HadrianNotFound =
text [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|]
-------------------------
--[ High-level errors ]--
@@ -249,11 +283,11 @@ deriving instance Show DownloadFailed
-- | A build failed.
data BuildFailed = forall es . Show (V es) => BuildFailed FilePath (V es)
data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
instance Pretty BuildFailed where
pPrint (BuildFailed path reason) =
text [i|BuildFailed failed in dir "#{path}": #{reason}|]
text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason
deriving instance Show BuildFailed

View File

@@ -1,7 +1,12 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-|
Module : GHCup.Types
@@ -21,6 +26,7 @@ module GHCup.Types
where
import Control.Applicative
import Control.DeepSeq ( NFData, rnf )
import Control.Monad.Logger
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
@@ -60,6 +66,8 @@ data GHCupInfo = GHCupInfo
}
deriving (Show, GHC.Generic)
instance NFData GHCupInfo
-------------------------
@@ -79,6 +87,8 @@ data Requirements = Requirements
}
deriving (Show, GHC.Generic)
instance NFData Requirements
@@ -105,9 +115,13 @@ data Tool = GHC
| Stack
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
instance NFData Tool
data GlobalTool = ShimGen
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
instance NFData GlobalTool
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
@@ -123,6 +137,8 @@ data VersionInfo = VersionInfo
}
deriving (Eq, GHC.Generic, Show)
instance NFData VersionInfo
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest
@@ -133,6 +149,8 @@ data Tag = Latest
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
instance NFData Tag
tagToString :: Tag -> String
tagToString Recommended = "recommended"
tagToString Latest = "latest"
@@ -159,6 +177,8 @@ data Architecture = A_64
| A_ARM64
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData Architecture
archToString :: Architecture -> String
archToString A_64 = "x86_64"
archToString A_32 = "i386"
@@ -181,6 +201,8 @@ data Platform = Linux LinuxDistro
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData Platform
platformToString :: Platform -> String
platformToString (Linux distro) = "linux-" ++ distroToString distro
platformToString Darwin = "darwin"
@@ -206,6 +228,8 @@ data LinuxDistro = Debian
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData LinuxDistro
distroToString :: LinuxDistro -> String
distroToString Debian = "debian"
distroToString Ubuntu = "ubuntu"
@@ -232,6 +256,7 @@ data DownloadInfo = DownloadInfo
}
deriving (Eq, Ord, GHC.Generic, Show)
instance NFData DownloadInfo
@@ -245,6 +270,8 @@ data TarDir = RealDir FilePath
| RegexDir String -- ^ will be compiled to regex, the first match will "win"
deriving (Eq, Ord, GHC.Generic, Show)
instance NFData TarDir
instance Pretty TarDir where
pPrint (RealDir path) = text path
pPrint (RegexDir regex) = text regex
@@ -257,6 +284,10 @@ data URLSource = GHCupURL
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
deriving (GHC.Generic, Show)
instance NFData URLSource
instance NFData (URIRef Absolute) where
rnf (URI !_ !_ !_ !_ !_) = ()
data UserSettings = UserSettings
{ uCache :: Maybe Bool
@@ -266,11 +297,12 @@ data UserSettings = UserSettings
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Key
@@ -298,6 +330,9 @@ data KeyBindings = KeyBindings
}
deriving (Show, GHC.Generic)
instance NFData KeyBindings
instance NFData Key
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
{ bUp = KUp
@@ -317,7 +352,18 @@ data AppState = AppState
, keyBindings :: KeyBindings
, ghcupInfo :: GHCupInfo
, pfreq :: PlatformRequest
} deriving (Show)
} deriving (Show, GHC.Generic)
instance NFData AppState
data LeanAppState = LeanAppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
} deriving (Show, GHC.Generic)
instance NFData LeanAppState
data Settings = Settings
{ cache :: Bool
@@ -326,29 +372,39 @@ data Settings = Settings
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
, noNetwork :: Bool
}
deriving (Show, GHC.Generic)
instance NFData Settings
data Dirs = Dirs
{ baseDir :: FilePath
, binDir :: FilePath
, cacheDir :: FilePath
, logsDir :: FilePath
, confDir :: FilePath
, recycleDir :: FilePath -- mainly used on windows
}
deriving Show
deriving (Show, GHC.Generic)
instance NFData Dirs
data KeepDirs = Always
| Errors
| Never
deriving (Eq, Show, Ord)
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData KeepDirs
data Downloader = Curl
| Wget
#if defined(INTERNAL_DOWNLOADER)
| Internal
#endif
deriving (Eq, Show, Ord)
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData Downloader
data DebugInfo = DebugInfo
{ diBaseDir :: FilePath
@@ -371,7 +427,9 @@ data PlatformResult = PlatformResult
{ _platform :: Platform
, _distroVersion :: Maybe Versioning
}
deriving (Eq, Show)
deriving (Eq, Show, GHC.Generic)
instance NFData PlatformResult
platResToString :: PlatformResult -> String
platResToString PlatformResult { _platform = plat, _distroVersion = Just v' }
@@ -387,7 +445,9 @@ data PlatformRequest = PlatformRequest
, _rPlatform :: Platform
, _rVersion :: Maybe Versioning
}
deriving (Eq, Show)
deriving (Eq, Show, GHC.Generic)
instance NFData PlatformRequest
pfReqToString :: PlatformRequest -> String
pfReqToString (PlatformRequest arch plat ver) =
@@ -434,6 +494,8 @@ data VersionCmp = VR_gt Versioning
| VR_eq Versioning
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData VersionCmp
-- | A version range. Supports && and ||, but not arbitrary
-- combinations. This is a little simplified.
@@ -441,6 +503,7 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
| OrRange (NonEmpty VersionCmp) VersionRange
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData VersionRange
instance Pretty Versioning where
pPrint = text . T.unpack . prettyV
@@ -459,4 +522,3 @@ instance (Monad m, Alternative m) => Alternative (LoggingT m) where
instance MonadLogger m => MonadLogger (Excepts e m) where
monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d

View File

@@ -1,4 +1,11 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-|
Module : GHCup.Types.Optics
@@ -13,6 +20,7 @@ module GHCup.Types.Optics where
import GHCup.Types
import Control.Monad.Reader
import Data.ByteString ( ByteString )
import Optics
import URI.ByteString
@@ -58,3 +66,85 @@ pathL' = lensVL pathL
queryL' :: Lens' (URIRef a) Query
queryL' = lensVL queryL
----------------------
--[ Lens utilities ]--
----------------------
gets :: forall f a env m . (MonadReader env m, LabelOptic' f A_Lens env a)
=> m a
gets = asks (^. labelOptic @f)
getAppState :: MonadReader AppState m => m AppState
getAppState = ask
getLeanAppState :: ( MonadReader env m
, LabelOptic' "settings" A_Lens env Settings
, LabelOptic' "dirs" A_Lens env Dirs
, LabelOptic' "keyBindings" A_Lens env KeyBindings
)
=> m LeanAppState
getLeanAppState = do
s <- gets @"settings"
d <- gets @"dirs"
k <- gets @"keyBindings"
pure (LeanAppState s d k)
getSettings :: ( MonadReader env m
, LabelOptic' "settings" A_Lens env Settings
)
=> m Settings
getSettings = gets @"settings"
getDirs :: ( MonadReader env m
, LabelOptic' "dirs" A_Lens env Dirs
)
=> m Dirs
getDirs = gets @"dirs"
getKeyBindings :: ( MonadReader env m
, LabelOptic' "keyBindings" A_Lens env KeyBindings
)
=> m KeyBindings
getKeyBindings = gets @"keyBindings"
getGHCupInfo :: ( MonadReader env m
, LabelOptic' "ghcupInfo" A_Lens env GHCupInfo
)
=> m GHCupInfo
getGHCupInfo = gets @"ghcupInfo"
getPlatformReq :: ( MonadReader env m
, LabelOptic' "pfreq" A_Lens env PlatformRequest
)
=> m PlatformRequest
getPlatformReq = gets @"pfreq"
type HasSettings env = (LabelOptic' "settings" A_Lens env Settings)
type HasDirs env = (LabelOptic' "dirs" A_Lens env Dirs)
type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
getCache :: (MonadReader env m, HasSettings env) => m Bool
getCache = getSettings <&> cache
getDownloader :: (MonadReader env m, HasSettings env) => m Downloader
getDownloader = getSettings <&> downloader
instance LabelOptic "dirs" A_Lens Dirs Dirs Dirs Dirs where
labelOptic = lens id (\_ d -> d)

View File

@@ -53,6 +53,7 @@ import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
#if defined(IS_WINDOWS)
import Data.Bits
#endif
@@ -78,6 +79,7 @@ import System.Win32.Console
import System.Win32.File hiding ( copyFile )
import System.Win32.Types
#endif
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import Text.Regex.Posix
import URI.ByteString
@@ -103,73 +105,79 @@ import qualified Text.Megaparsec as MP
-- | The symlink destination of a ghc tool.
ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
ghcLinkDestination :: ( MonadReader env m
, HasDirs env
, MonadThrow m, MonadIO m)
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
-> GHCTargetVersion
-> m FilePath
ghcLinkDestination tool ver = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
ghcd <- ghcupGHCDir ver
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: ( MonadReader AppState m
rmMinorSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorSymlinks tv@GHCTargetVersion{..} = do
AppState { dirs = Dirs {..} } <- lift ask
Dirs {..} <- lift getDirs
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
let fullF = binDir </> f_xyz
lift $ $(logDebug) [i|rm -f #{fullF}|]
liftIO $ hideError doesNotExistErrorType $ rmLink fullF
lift $ hideError doesNotExistErrorType $ rmLink fullF
-- | Removes the set ghc version for the given target, if any.
rmPlain :: ( MonadReader AppState m
rmPlain :: ( MonadReader env m
, HasDirs env
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m ()
rmPlain target = do
AppState { dirs = Dirs {..} } <- lift ask
Dirs {..} <- lift getDirs
mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let fullF = binDir </> f <> exeExt
lift $ $(logDebug) [i|rm -f #{fullF}|]
liftIO $ hideError doesNotExistErrorType $ rmLink fullF
lift $ hideError doesNotExistErrorType $ rmLink fullF
-- old ghcup
let hdc_file = binDir </> "haddock-ghc" <> exeExt
lift $ $(logDebug) [i|rm -f #{hdc_file}|]
liftIO $ hideError doesNotExistErrorType $ rmLink hdc_file
lift $ hideError doesNotExistErrorType $ rmLink hdc_file
-- | Remove the major GHC symlink, e.g. ghc-8.6.
rmMajorSymlinks :: ( MonadReader AppState m
rmMajorSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks tv@GHCTargetVersion{..} = do
AppState { dirs = Dirs {..} } <- lift ask
Dirs {..} <- lift getDirs
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
@@ -178,7 +186,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
let f_xy = f <> "-" <> T.unpack v' <> exeExt
let fullF = binDir </> f_xy
lift $ $(logDebug) [i|rm -f #{fullF}|]
liftIO $ hideError doesNotExistErrorType $ rmLink fullF
lift $ hideError doesNotExistErrorType $ rmLink fullF
@@ -189,26 +197,26 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
-- | Whether the given GHC versin is installed.
ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesDirectoryExist ghcdir
-- | Whether the given GHC version is installed from source.
ghcSrcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
-- | Whether the given GHC version is set as the current.
ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m)
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
-- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersion)
ghcSet mtarget = do
AppState {dirs = Dirs {..}} <- ask
Dirs {..} <- getDirs
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
let ghcBin = binDir </> ghc <> exeExt
@@ -239,7 +247,7 @@ ghcSet mtarget = do
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
-- If a dir cannot be parsed, returns left.
getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either FilePath GHCTargetVersion]
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
getInstalledGHCs = do
ghcdir <- ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
@@ -249,10 +257,15 @@ getInstalledGHCs = do
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
getInstalledCabals :: ( MonadLogger m
, MonadReader env m
, HasDirs env
, MonadIO m
, MonadCatch m
)
=> m [Either FilePath Version]
getInstalledCabals = do
AppState {dirs = Dirs {..}} <- ask
Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
@@ -264,16 +277,16 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed.
cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
cabalInstalled ver = do
vers <- fmap rights getInstalledCabals
pure $ elem ver vers
-- Return the currently set cabal version, if any.
cabalSet :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet :: (MonadLogger m, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet = do
AppState {dirs = Dirs {..}} <- ask
Dirs {..} <- getDirs
let cabalbin = binDir </> "cabal" <> exeExt
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -317,10 +330,10 @@ cabalSet = do
-- | Get all installed hls, by matching on
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version]
getInstalledHLSs = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
@@ -337,10 +350,10 @@ getInstalledHLSs = do
-- | Get all installed stacks, by matching on
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
getInstalledStacks :: (MonadReader AppState m, MonadIO m, MonadCatch m)
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version]
getInstalledStacks = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
@@ -355,9 +368,9 @@ getInstalledStacks = do
-- Return the currently set stack version, if any.
-- TODO: there's a lot of code duplication here :>
stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
stackSet = do
AppState {dirs = Dirs {..}} <- ask
Dirs {..} <- getDirs
let stackBin = binDir </> "stack" <> exeExt
handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -395,13 +408,13 @@ stackSet = do
stripRelativePath = MP.many (MP.try stripPathComponet)
-- | Whether the given Stack version is installed.
stackInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
stackInstalled ver = do
vers <- fmap rights getInstalledStacks
pure $ elem ver vers
-- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
hlsInstalled ver = do
vers <- fmap rights getInstalledHLSs
pure $ elem ver vers
@@ -409,9 +422,9 @@ hlsInstalled ver = do
-- Return the currently set hls version, if any.
hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do
AppState {dirs = Dirs {..}} <- ask
Dirs {..} <- getDirs
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -443,7 +456,8 @@ hlsSet = do
-- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader AppState m
hlsGHCVersions :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadThrow m
, MonadCatch m
@@ -466,11 +480,11 @@ hlsGHCVersions = do
-- | Get all server binaries for an hls version, if any.
hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
=> Version
-> m [FilePath]
hlsServerBinaries ver = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
@@ -482,12 +496,12 @@ hlsServerBinaries ver = do
-- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Version
-> m (Maybe FilePath)
hlsWrapperBinary ver = do
AppState { dirs = Dirs {..} } <- ask
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
Dirs {..} <- getDirs
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
compExtended
@@ -503,7 +517,7 @@ hlsWrapperBinary ver = do
-- | Get all binaries for an hls version, if any.
hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [FilePath]
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
hlsAllBinaries ver = do
hls <- hlsServerBinaries ver
wrapper <- hlsWrapperBinary ver
@@ -511,9 +525,9 @@ hlsAllBinaries ver = do
-- | Get the active symlinks for hls.
hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [FilePath]
hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
hlsSymlinks = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended
@@ -549,7 +563,7 @@ matchMajor v' major' minor' = case getMajorMinorV v' of
-- | Get the latest installed full GHC version that satisfies X.Y.
-- This reads `ghcupGHCBaseDir`.
getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m)
getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
=> Int -- ^ major version component
-> Int -- ^ minor version component
-> Maybe Text -- ^ the target triple
@@ -729,19 +743,6 @@ getLatestBaseVersion av pvpVer =
-----------------------
--[ AppState Getter ]--
-----------------------
getCache :: MonadReader AppState m => m Bool
getCache = ask <&> cache . settings
getDownloader :: MonadReader AppState m => m Downloader
getDownloader = ask <&> downloader . settings
-------------
--[ Other ]--
@@ -754,7 +755,7 @@ getDownloader = ask <&> downloader . settings
-- Returns unversioned relative files without extension, e.g.:
--
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles ver = do
@@ -765,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
@@ -817,7 +791,12 @@ ghcUpSrcBuiltFile = ".ghcup_src_built"
-- | Calls gmake if it exists in PATH, otherwise make.
make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
make :: ( MonadThrow m
, MonadIO m
, MonadReader env m
, HasDirs env
, HasSettings env
)
=> [String]
-> Maybe FilePath
-> m (Either ProcessError ())
@@ -827,7 +806,7 @@ make args workdir = do
let mymake = if has_gmake then "gmake" else "make"
execLogged mymake args workdir "ghc-make" Nothing
makeOut :: (MonadReader AppState m, MonadIO m)
makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
=> [String]
-> Maybe FilePath
-> m CapturedProcess
@@ -840,7 +819,7 @@ makeOut args workdir = do
-- | Try to apply patches in order. Fails with 'PatchFailed'
-- on first failure.
applyPatches :: (MonadReader AppState m, MonadLogger m, MonadIO m)
applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
=> FilePath -- ^ dir containing patches
-> FilePath -- ^ dir to apply patches in
-> Excepts '[PatchFailed] m ()
@@ -858,7 +837,7 @@ applyPatches pdir ddir = do
-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
darwinNotarization :: (MonadReader AppState m, MonadIO m)
darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
=> Platform
-> FilePath
-> m (Either ProcessError ())
@@ -881,20 +860,27 @@ getChangeLog dls tool (Right tag) =
--
-- 1. the build directory, depending on the KeepDirs setting
-- 2. the install destination, depending on whether the build failed
runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
=> FilePath -- ^ build directory (cleaned up depending on Settings)
runBuildAction :: ( Pretty (V e)
, Show (V e)
, MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadMask m
, MonadLogger m
, MonadUnliftIO m
)
=> FilePath -- ^ build directory (cleaned up depending on Settings)
-> Maybe FilePath -- ^ dir to *always* clean up on exception
-> Excepts e m a
-> Excepts '[BuildFailed] m a
runBuildAction bdir instdir action = do
AppState { settings = Settings {..} } <- lift ask
Settings {..} <- lift getSettings
let exAction = do
forM_ instdir $ \dir ->
liftIO $ hideError doesNotExistErrorType $ rmPath dir
lift $ hideError doesNotExistErrorType $ recyclePathForcibly dir
when (keepDirs == Never)
$ liftIO
$ hideError doesNotExistErrorType
$ rmPath bdir
$ lift $ rmBDir bdir
v <-
flip onException exAction
$ catchAllE
@@ -903,10 +889,20 @@ runBuildAction bdir instdir action = do
throwE (BuildFailed bdir es)
) action
when (keepDirs == Never || keepDirs == Errors) $ liftIO $ rmPath bdir
when (keepDirs == Never || keepDirs == Errors) $ lift $ rmBDir bdir
pure v
-- | Remove a build directory, ignoring if it doesn't exist and gracefully
-- printing other errors without crashing.
rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
rmBDir dir = withRunInIO (\run -> run $
liftIO $ handleIO (\e -> run $ $(logWarn)
[i|Couldn't remove build dir #{dir}, error was: #{displayException e}|])
$ hideError doesNotExistErrorType
$ rmPathForcibly dir)
getVersionInfo :: Version
-> Tool
-> GHCupDownloads
@@ -993,13 +989,13 @@ pathIsLink = pathIsSymbolicLink
#endif
rmLink :: FilePath -> IO ()
rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
#if defined(IS_WINDOWS)
rmLink fp = do
hideError doesNotExistErrorType . liftIO . rmFile $ fp
hideError doesNotExistErrorType . liftIO . rmFile $ (dropExtension fp <.> "shim")
hideError doesNotExistErrorType . recycleFile $ fp
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
#else
rmLink = hideError doesNotExistErrorType . liftIO . rmFile
rmLink = hideError doesNotExistErrorType . recycleFile
#endif
@@ -1016,7 +1012,8 @@ createLink :: ( MonadMask m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadReader AppState m
, MonadReader env m
, HasDirs env
, MonadUnliftIO m
, MonadFail m
)
@@ -1025,7 +1022,7 @@ createLink :: ( MonadMask m
-> m ()
createLink link exe = do
#if defined(IS_WINDOWS)
AppState { dirs } <- ask
dirs <- getDirs
let shimGen = cacheDir dirs </> "gs.exe"
let shim = dropExtension exe <.> "shim"
@@ -1036,14 +1033,14 @@ createLink link exe = do
shimContents = "path = " <> fullLink
$(logDebug) [i|rm -f #{exe}|]
liftIO $ rmLink exe
rmLink exe
$(logDebug) [i|ln -s #{fullLink} #{exe}|]
liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents
#else
$(logDebug) [i|rm -f #{exe}|]
liftIO $ hideError doesNotExistErrorType $ rmFile exe
hideError doesNotExistErrorType $ recycleFile exe
$(logDebug) [i|ln -s #{link} #{exe}|]
liftIO $ createFileLink link exe
@@ -1054,21 +1051,25 @@ ensureGlobalTools :: ( MonadMask m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadReader AppState m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasGHCupInfo env
, MonadUnliftIO m
, MonadFail m
)
=> Excepts '[DigestError , DownloadFailed, NoDownload] m ()
ensureGlobalTools = do
#if defined(IS_WINDOWS)
AppState { ghcupInfo = GHCupInfo _ _ gTools, settings, dirs } <- lift ask
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' settings dirs shimDownload (Just "gs.exe")
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _) -> do
lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
lift $ $(logDebug) [i|rm -f #{shimDownload}|]
liftIO $ hideError doesNotExistErrorType $ rmFile (cacheDir dirs </> "gs.exe")
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[DigestError , DownloadFailed] dl)
pure ()
@@ -1079,17 +1080,24 @@ ensureGlobalTools = do
-- | Ensure ghcup directory structure exists.
ensureDirectories :: Dirs -> IO ()
ensureDirectories dirs = do
let Dirs
{ baseDir
, binDir
, cacheDir
, logsDir
, confDir
} = dirs
ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
createDirRecursive' baseDir
createDirRecursive' (baseDir </> "ghc")
createDirRecursive' binDir
createDirRecursive' cacheDir
createDirRecursive' logsDir
createDirRecursive' confDir
createDirRecursive' trashDir
pure ()
-- | For ghc without arch triple, this is:
--
-- - ghc-<ver> (e.g. ghc-8.10.4)
--
-- For ghc with arch triple:
--
-- - <triple>-ghc-<ver> (e.g. arm-linux-gnueabihf-ghc-8.10.4)
ghcBinaryName :: GHCTargetVersion -> String
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)

View File

@@ -16,7 +16,7 @@ Stability : experimental
Portability : portable
-}
module GHCup.Utils.Dirs
( getDirs
( getAllDirs
, ghcupBaseDir
, ghcupConfigFile
, ghcupCacheDir
@@ -30,6 +30,7 @@ module GHCup.Utils.Dirs
#if !defined(IS_WINDOWS)
, useXDG
#endif
, cleanupTrash
)
where
@@ -37,6 +38,7 @@ where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
@@ -52,9 +54,7 @@ import Data.String.Interpolate
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts
import Optics
#if !defined(IS_WINDOWS)
import System.Directory
#endif
import System.DiskSpace
import System.Environment
import System.FilePath
@@ -190,13 +190,21 @@ ghcupLogsDir = do
#endif
getDirs :: IO Dirs
getDirs = do
baseDir <- ghcupBaseDir
binDir <- ghcupBinDir
cacheDir <- ghcupCacheDir
logsDir <- ghcupLogsDir
confDir <- ghcupConfigDir
-- | '~/.ghcup/trash'.
-- Mainly used on windows to improve file removal operations
ghcupRecycleDir :: IO FilePath
ghcupRecycleDir = ghcupBaseDir <&> (</> "trash")
getAllDirs :: IO Dirs
getAllDirs = do
baseDir <- ghcupBaseDir
binDir <- ghcupBinDir
cacheDir <- ghcupCacheDir
logsDir <- ghcupLogsDir
confDir <- ghcupConfigDir
recycleDir <- ghcupRecycleDir
pure Dirs { .. }
@@ -226,9 +234,9 @@ ghcupConfigFile = do
-- | ~/.ghcup/ghc by default.
ghcupGHCBaseDir :: (MonadReader AppState m) => m FilePath
ghcupGHCBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
ghcupGHCBaseDir = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
pure (baseDir </> "ghc")
@@ -236,7 +244,7 @@ ghcupGHCBaseDir = do
-- The dir may be of the form
-- * armv7-unknown-linux-gnueabihf-8.8.3
-- * 8.8.4
ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
ghcupGHCDir :: (MonadReader env m, HasDirs env, MonadThrow m)
=> GHCTargetVersion
-> m FilePath
ghcupGHCDir ver = do
@@ -251,7 +259,15 @@ parseGHCupGHCDir (T.pack -> fp) =
throwEither $ MP.parse ghcTargetVerP "" fp
mkGhcupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m) => m FilePath
mkGhcupTmpDir :: ( MonadReader env m
, HasDirs env
, MonadUnliftIO m
, MonadLogger m
, MonadCatch m
, MonadThrow m
, MonadMask m
, MonadIO m)
=> m FilePath
mkGhcupTmpDir = do
tmpdir <- liftIO getCanonicalTemporaryDirectory
@@ -272,8 +288,25 @@ mkGhcupTmpDir = do
where t = 10^n
withGHCupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadResource m, MonadThrow m, MonadIO m) => m FilePath
withGHCupTmpDir = snd <$> withRunInIO (\run -> run $ allocate (run mkGhcupTmpDir) rmPath)
withGHCupTmpDir :: ( MonadReader env m
, HasDirs env
, MonadUnliftIO m
, MonadLogger m
, MonadCatch m
, MonadResource m
, MonadThrow m
, MonadMask m
, MonadIO m)
=> m FilePath
withGHCupTmpDir = snd <$> withRunInIO (\run ->
run
$ allocate
(run mkGhcupTmpDir)
(\fp ->
handleIO (\e -> run
$ $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|])
. rmPathForcibly
$ fp))
@@ -301,3 +334,21 @@ relativeSymlink p1 p2 =
<> joinPath ([pathSeparator] : drop (length common) d2)
cleanupTrash :: ( MonadIO m
, MonadMask m
, MonadLogger m
, MonadReader env m
, HasDirs env
)
=> m ()
cleanupTrash = do
Dirs { recycleDir } <- getDirs
contents <- liftIO $ listDirectory recycleDir
if null contents
then pure ()
else do
$(logWarn) [i|Removing leftover files in #{recycleDir}|]
forM_ contents (\fp -> handleIO (\e ->
$(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|]
) $ liftIO $ removePathForcibly (recycleDir </> fp))

View File

@@ -21,6 +21,7 @@ module GHCup.Utils.File.Posix where
import GHCup.Utils.File.Common
import GHCup.Utils.Prelude
import GHCup.Types
import GHCup.Types.Optics
import Control.Concurrent
import Control.Concurrent.Async
@@ -74,7 +75,11 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
SPP.executeFile path True args Nothing
execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
execLogged :: ( MonadReader env m
, HasSettings env
, HasDirs env
, MonadIO m
, MonadThrow m)
=> FilePath -- ^ thing to execute
-> [String] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
@@ -82,7 +87,8 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execLogged exe args chdir lfile env = do
AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
Settings {..} <- getSettings
Dirs {..} <- getDirs
let logfile = logsDir </> lfile <> ".log"
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
closeFd

View File

@@ -19,6 +19,7 @@ import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
import GHCup.Utils.Dirs
import GHCup.Utils.File.Common
import GHCup.Types
import GHCup.Types.Optics
import Control.Concurrent
import Control.DeepSeq
@@ -146,7 +147,11 @@ executeOut path args chdir = do
pure $ CapturedProcess exit out err
execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
execLogged :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadThrow m)
=> FilePath -- ^ thing to execute
-> [String] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
@@ -154,7 +159,7 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execLogged exe args chdir lfile env = do
AppState { dirs = Dirs {..} } <- ask
Dirs {..} <- getDirs
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
stderrLogfile = logsDir </> lfile <> ".stderr.log"
cp <- createProcessWithMingwPath ((proc exe args)
@@ -204,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

@@ -14,12 +14,16 @@ Here we define our main logger.
-}
module GHCup.Utils.Logger where
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils.File
import GHCup.Utils.String.QQ
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Char ( ord )
import Prelude hiding ( appendFile )
import System.Console.Pretty
@@ -79,17 +83,21 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
rawOutter outr
initGHCupFileLogging :: (MonadIO m) => FilePath -> m FilePath
initGHCupFileLogging logsDir = do
initGHCupFileLogging :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadMask m
) => m FilePath
initGHCupFileLogging = do
Dirs { logsDir } <- getDirs
let logfile = logsDir </> "ghcup.log"
liftIO $ do
logFiles <- findFiles
logsDir
(makeRegexOpts compExtended
execBlank
([s|^.*\.log$|] :: B.ByteString)
)
forM_ logFiles $ hideError doesNotExistErrorType . rmFile . (logsDir </>)
logFiles <- liftIO $ findFiles
logsDir
(makeRegexOpts compExtended
execBlank
([s|^.*\.log$|] :: B.ByteString)
)
forM_ logFiles $ hideError doesNotExistErrorType . recycleFile . (logsDir </>)
writeFile logfile ""
pure logfile
liftIO $ writeFile logfile ""
pure logfile

View File

@@ -19,14 +19,19 @@ GHCup specific prelude. Lots of Excepts functionality.
-}
module GHCup.Utils.Prelude where
#if defined(IS_WINDOWS)
import GHCup.Types
#endif
import GHCup.Types.Optics
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class ( lift )
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 )
@@ -35,6 +40,9 @@ import Data.Word8
import Haskus.Utils.Types.List
import Haskus.Utils.Variant.Excepts
import System.IO.Error
#if defined(IS_WINDOWS)
import System.IO.Temp
#endif
import System.IO.Unsafe
import System.Directory
import System.FilePath
@@ -47,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
@@ -54,6 +63,9 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B
import qualified Data.Text.Lazy.Encoding as TLE
#if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32
#endif
@@ -312,17 +324,16 @@ createDirRecursive' p =
-- | Recursively copy the contents of one directory to another path.
--
-- This is a rip-off of Cabal library.
copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
copyDirectoryRecursive srcDir destDir = do
copyDirectoryRecursive :: FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
copyDirectoryRecursive srcDir destDir doCopy = do
srcFiles <- getDirectoryContentsRecursive srcDir
copyFilesWith copyFile destDir [ (srcDir, f)
| f <- srcFiles ]
copyFilesWith destDir [ (srcDir, f)
| f <- srcFiles ]
where
-- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
-- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
copyFilesWith :: (FilePath -> FilePath -> IO ())
-> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith doCopy targetDir srcFiles = do
copyFilesWith :: FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith targetDir srcFiles = do
-- Create parent directories for everything
let dirs = map (targetDir </>) . nub . map (takeDirectory . snd) $ srcFiles
@@ -367,42 +378,117 @@ getDirectoryContentsRecursive topdir = recurseDirectories [""]
ignore ['.', '.'] = True
ignore _ = False
-- https://github.com/haskell/directory/issues/110
-- https://github.com/haskell/directory/issues/96
-- https://www.sqlite.org/src/info/89f1848d7f
rmPath :: (MonadIO m, MonadMask m)
=> FilePath
-> m ()
rmPath fp =
recyclePathForcibly :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadMask m
)
=> FilePath
-> m ()
recyclePathForcibly fp = do
#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 $ removePathForcibly fp)
Dirs { recycleDir } <- getDirs
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#else
liftIO $ removeDirectoryRecursive fp
liftIO $ removePathForcibly fp
#endif
rmPathForcibly :: ( MonadIO m
, MonadMask m
)
=> FilePath
-> m ()
rmPathForcibly fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removePathForcibly fp)
#else
liftIO $ removePathForcibly fp
#endif
rmDirectory :: (MonadIO m, MonadMask m)
=> FilePath
-> m ()
rmDirectory fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removeDirectory fp)
#else
liftIO $ removeDirectory fp
#endif
-- https://www.sqlite.org/src/info/89f1848d7f
-- https://github.com/haskell/directory/issues/96
rmFile :: (MonadIO m, MonadMask m)
recycleFile :: ( MonadIO m
, MonadMask m
, MonadReader env m
, HasDirs env
)
=> FilePath
-> m ()
recycleFile fp = do
#if defined(IS_WINDOWS)
Dirs { recycleDir } <- getDirs
liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#else
liftIO $ removeFile fp
#endif
rmFile :: ( MonadIO m
, MonadMask m
)
=> FilePath
-> m ()
rmFile fp =
#if defined(IS_WINDOWS)
recovering (fullJitterBackoff 25000 <> limitRetries 10)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> liftIO $ removeFile fp)
recover (liftIO $ removeFile fp)
#else
liftIO $ removeFile fp
#endif
rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
=> FilePath
-> m ()
rmDirectoryLink fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removeDirectoryLink fp)
#else
liftIO $ removeDirectoryLink fp
#endif
#if defined(IS_WINDOWS)
recover :: (MonadIO m, MonadMask m) => m a -> m a
recover action =
recovering (fullJitterBackoff 25000 <> limitRetries 10)
[\_ -> Handler (\e -> pure $ isPermissionError e)
,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> action)
#endif
-- Gathering monoidal values
traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
@@ -420,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

27
refreeze.sh Executable file
View File

@@ -0,0 +1,27 @@
#!/bin/sh
set -xue
rm -f cabal.*.project
rm -f cabal.*.project.freeze
for ghc_ver in "$@" ; do
# shellcheck disable=SC3060
project_file=cabal.ghc${ghc_ver//./}.project
cp cabal.project "${project_file}"
case "$(uname -s)" in
MSYS*|MINGW*)
cabal freeze --project-file="${project_file}" -w "ghc-${ghc_ver}"
;;
*)
cabal freeze --project-file="${project_file}" -w "ghc-${ghc_ver}" -ftui -finternal-downloader
;;
esac
echo "" >> "${project_file}"
echo "with-compiler: ghc-${ghc_ver}" >> "${project_file}"
sed -i -e '/ghcup/d' "${project_file}".freeze
done

View File

@@ -0,0 +1,9 @@
MIT License
Copyright (c) 2019 Grégoire Geis
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice (including the next paragraph) shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

View File

@@ -0,0 +1,10 @@
This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means.
In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to <http://unlicense.org/>

View File

@@ -0,0 +1,71 @@
# `shim.c`
[`shim.c`](./shim.c) is a simple Windows program that, when started:
1. Looks for a file with the exact same name as the running program, but with
the extension `shim` (e.g. `C:\bin\foo.exe` will read the file `C:\bin\foo.shim`).
2. Reads and [parses](#shim-format) the files into a
[Scoop](https://github.com/lukesampson/scoop) shim format.
3. Executes the target executable with the given arguments.
`shim.c` was originally made to replace [Scoop](https://github.com/lukesampson/scoop)'s
[`shim.cs`](https://github.com/lukesampson/scoop/blob/96de9c14bb483f9278e4b0a9e22b1923ee752901/supporting/shimexe/shim.cs)
since it had several important flaws:
1. [It was made in C#](https://github.com/lukesampson/scoop/tree/96de9c14bb483f9278e4b0a9e22b1923ee752901/supporting/shimexe),
and thus required an instantiation of a .NET command line app everytime it was started,
which can make a command run much slower than if it had been ran directly;
2. [It](https://github.com/lukesampson/scoop/issues/2339) [did](https://github.com/lukesampson/scoop/issues/1896)
[not](https://github.com/felixse/FluentTerminal/issues/221) handle Ctrl+C and other
signals correctly, which could be quite infuriating (and essentially killing REPLs and long-running apps).
[`shim.c`](./shim.c) is:
- **Faster**, because it does not use the .NET Framework, and parses the `.shim` file in a simpler way.
- **More efficient**, because by the time the target of the shim is started, all allocated memory will have been freed.
- And more importantly, it **works better**:
- Signals originating from pressing `Ctrl+C` are ignored, and therefore handled directly by the spawned child.
Your processes and REPLs will no longer close when pressing `Ctrl+C`.
- Children are automatically killed when the shim process is killed. No more orphaned processes and weird behaviors.
> **Note**: This project is not affiliated with [Scoop](https://github.com/lukesampson/scoop).
## Installation for Scoop
- In a Visual Studio command prompt, run `cl /O1 shim.c`.
- Replace any `.exe` in `scoop\shims` by `shim.exe`.
An additional script, `repshims.bat`, is provided. It will replace all `.exe`s in the user's Scoop directory
by `shim.exe`.
## Example
Given the following shim `gs.shim`:
```
path = C:\Program Files\Git\git.exe
args = status -u
```
In this directory, where `gs.exe` is the compiled `shim.c`:
```
C:\Bin\
gs.exe
gs.shim
```
Then calling `gs -s` will run the program `C:\Program Files\Git\git.exe status -u -s`.
## Shim format
Shims follow the same format as Scoop's shims: line-separated `key = value` pairs.
```
path = C:\Program Files\Git\git.exe
args = status -uno
```
`path` is a required value, but `args` can be omitted. Also, do note that lines **must** end with a line feed.
## License
`SPDX-License-Identifier: MIT OR Unlicense`

View File

@@ -0,0 +1,15 @@
@echo off
if not defined SCOOP set SCOOP=%USERPROFILE%\scoop
for %%x in ("%SCOOP%\shims\*.exe") do (
echo Replacing %%x by new shim.
copy /B /Y shim.exe "%%~x" >NUL
)
if not defined SCOOP_GLOBAL set SCOOP_GLOBAL=%ProgramData%\scoop
for %%x in ("%SCOOP_GLOBAL%\shims\*.exe") do (
echo Replacing %%x by new shim.
copy /B /Y shim.exe "%%~x" >NUL
)

256
scoop-better-shimexe/shim.c Normal file
View File

@@ -0,0 +1,256 @@
#pragma comment(lib, "SHELL32.LIB")
#include <stdio.h>
#include <stdlib.h>
#include <wchar.h>
#include <Windows.h>
#ifndef ERROR_ELEVATION_REQUIRED
# define ERROR_ELEVATION_REQUIRED 740
#endif
#define MAX_FILENAME_SIZE 512
BOOL WINAPI ctrlhandler(DWORD fdwCtrlType)
{
switch (fdwCtrlType) {
// Ignore all events, and let the child process
// handle them.
case CTRL_C_EVENT:
case CTRL_CLOSE_EVENT:
case CTRL_LOGOFF_EVENT:
case CTRL_BREAK_EVENT:
case CTRL_SHUTDOWN_EVENT:
return TRUE;
default:
return FALSE;
}
}
int compute_program_length(const wchar_t* commandline)
{
int i = 0;
if (commandline[0] == L'"') {
// Wait till end of string
i++;
for (;;) {
wchar_t c = commandline[i++];
if (c == 0)
return i - 1;
else if (c == L'\\')
i++;
else if (c == L'"')
return i;
}
} else {
for (;;) {
wchar_t c = commandline[i++];
if (c == 0)
return i - 1;
else if (c == L'\\')
i++;
else if (c == L' ')
return i;
}
}
}
int main()
{
DWORD exit_code = 0;
wchar_t* path = NULL;
wchar_t* args = NULL;
wchar_t* cmd = NULL;
// Find filename of current executable.
wchar_t filename[MAX_FILENAME_SIZE + 2];
const unsigned int filename_size = GetModuleFileNameW(NULL, filename, MAX_FILENAME_SIZE);
if (filename_size >= MAX_FILENAME_SIZE) {
fprintf(stderr, "The filename of the program is too long to handle.\n");
exit_code = 1;
goto cleanup;
}
// Use filename of current executable to find .shim
filename[filename_size - 3] = L's';
filename[filename_size - 2] = L'h';
filename[filename_size - 1] = L'i';
filename[filename_size - 0] = L'm';
filename[filename_size + 1] = 0 ;
FILE* shim_file;
if ((shim_file = _wfsopen(filename, L"r,ccs=UTF-8", _SH_DENYNO)) == NULL) {
fprintf(stderr, "Cannot open shim file for read.\n");
exit_code = 1;
goto cleanup;
}
size_t command_length = 256;
size_t path_length;
size_t args_length;
// Read shim
wchar_t linebuf[8192];
for (;;) {
const wchar_t* line = fgetws(linebuf, 8192, shim_file);
if (line == NULL)
break;
if (line[4] != L' ' || line[5] != L'=' || line[6] != L' ')
continue;
const int linelen = wcslen(line);
const int len = linelen - 8 + (line[linelen - 1] != '\n');
if (line[0] == L'p' && line[1] == L'a' && line[2] == L't' && line[3] == L'h') {
// Reading path
path = calloc(len + 1, sizeof(wchar_t));
wmemcpy(path, line + 7, len);
command_length += len;
path_length = len;
continue;
}
if (line[0] == L'a' && line[1] == L'r' && line[2] == L'g' && line[3] == L's') {
// Reading args
args = calloc(len + 1, sizeof(wchar_t));
wmemcpy(args, line + 7, len);
command_length += len + 1;
args_length = len;
continue;
}
continue;
}
fclose(shim_file);
if (path == NULL) {
fprintf(stderr, "Could not read shim file.\n");
exit_code = 1;
goto cleanup;
}
// Find length of command to run
wchar_t* given_cmd = GetCommandLineW();
const int program_length = compute_program_length(given_cmd);
given_cmd += program_length;
const int given_length = wcslen(given_cmd);
command_length += given_length;
// Start building command to run, using '[path] [args]', as given by shim.
cmd = calloc(command_length, sizeof(wchar_t));
int cmd_i = 0;
wmemcpy(cmd, path, path_length);
cmd[path_length] = ' ';
cmd_i += path_length + 1;
if (args != NULL) {
wmemcpy(cmd + path_length + 1, args, args_length);
cmd[path_length + args_length + 1] = ' ';
cmd_i += args_length + 1;
}
// Copy all given arguments to command
wmemcpy(cmd + cmd_i, given_cmd, given_length);
// Find out if the target program is a console app
SHFILEINFOW sfi = {0};
const BOOL is_windows_app = HIWORD(SHGetFileInfoW(path, -1, &sfi, sizeof(sfi), SHGFI_EXETYPE));
if (is_windows_app)
// Unfortunately, this technique will still show a window for a fraction of time,
// but there's just no workaround.
FreeConsole();
// Create job object, which can be attached to child processes
// to make sure they terminate when the parent terminates as well.
JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli = {0};
HANDLE jobHandle = CreateJobObject(NULL, NULL);
jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE | JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK;
SetInformationJobObject(jobHandle, JobObjectExtendedLimitInformation, &jeli, sizeof(jeli));
// Start subprocess
STARTUPINFOW si = {0};
PROCESS_INFORMATION pi = {0};
if (CreateProcessW(NULL, cmd, NULL, NULL, TRUE, CREATE_SUSPENDED, NULL, NULL, &si, &pi)) {
AssignProcessToJobObject(jobHandle, pi.hProcess);
ResumeThread(pi.hThread);
} else {
if (GetLastError() == ERROR_ELEVATION_REQUIRED) {
// We must elevate the process, which is (basically) impossible with
// CreateProcess, and therefore we fallback to ShellExecuteEx,
// which CAN create elevated processes, at the cost of opening a new separate
// window.
// Theorically, this could be fixed (or rather, worked around) using pipes
// and IPC, but... this is a question for another day.
SHELLEXECUTEINFOW sei = {0};
sei.cbSize = sizeof(SHELLEXECUTEINFOW);
sei.fMask = SEE_MASK_NOCLOSEPROCESS;
sei.lpFile = path;
sei.lpParameters = cmd + path_length + 1;
sei.nShow = SW_SHOW;
if (!ShellExecuteExW(&sei)) {
fprintf(stderr, "Unable to create elevated process: error %li.", GetLastError());
exit_code = 1;
goto cleanup;
}
pi.hProcess = sei.hProcess;
} else {
fprintf(stderr, "Could not create process with command '%ls'.\n", cmd);
exit_code = 1;
goto cleanup;
}
}
// Ignore Ctrl-C and other signals
if (!SetConsoleCtrlHandler(ctrlhandler, TRUE))
fprintf(stderr, "Could not set control handler; Ctrl-C behavior may be invalid.\n");
// Wait till end of process
WaitForSingleObject(pi.hProcess, INFINITE);
GetExitCodeProcess(pi.hProcess, &exit_code);
// Dispose of everything
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(jobHandle);
cleanup:
// Free obsolete buffers
free(path);
free(args);
free(cmd);
return (int)exit_code;
}

View File

@@ -1,4 +1,4 @@
resolver: lts-17.11
resolver: lts-18.2
packages:
- .
@@ -10,8 +10,12 @@ extra-deps:
- git: https://github.com/Bodigrim/tar
commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
- git: https://github.com/jtdaugherty/brick.git
commit: b3b96cfe66dfd398d338e3feb2b6855e66a35190
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- chs-cabal-0.1.1.0@sha256:20ec6a9fb5ab6991f1a4adf157c537bd5d3b98d08d3c09c387c954c7c50bd011,1153
@@ -20,17 +24,21 @@ extra-deps:
- haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.0.1@sha256:a381571c36edc7dca28b77fe8159b43c14c640087ec5946adacf949feec64231,3433
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
- streamly-bytestring-0.1.2@sha256:cc828f41d1c714c711d38fb213b4ed186febabba598ab080e13255f69c20b13c,2469

View File

@@ -67,7 +67,7 @@
<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 an interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
<p class="other-help">If you want to run an non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
</div>
</p>
<p>If you're a Windows Subsystem 2 for Linux user run the following in your terminal, then follow the onscreen instructions to install Haskell.
@@ -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>