Compare commits

..

1 Commits

Author SHA1 Message Date
1810bb27a8 Experimental nice thing 2020-03-24 18:05:12 +01:00
140 changed files with 4883 additions and 70026 deletions

109
.github/release.yaml vendored
View File

@@ -1,109 +0,0 @@
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

View File

@@ -1,109 +0,0 @@
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

View File

@@ -1,29 +0,0 @@
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

13
.gitignore vendored
View File

@@ -1,15 +1,2 @@
.ghci
.vim
codex.tags
dist-newstyle/
cabal.project.local
.stack-work/
bin/
/*.prof
/*.ps
/*.hp
tags
TAGS
/tmp/
.entangled
release/

View File

@@ -1,626 +0,0 @@
stages:
- checks
- quick-test
- test
- expensive-test
- release
variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11
############################################################
# CI Step
############################################################
.debian:
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
tags:
- x86_64-linux
variables:
OS: "LINUX"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
CROSS: ""
.alpine:64bit:
image: "alpine:3.12"
tags:
- x86_64-linux
variables:
OS: "LINUX"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.alpine:32bit:
image: "i386/alpine:3.12"
tags:
- x86_64-linux
variables:
OS: "LINUX"
ARCH: "32"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.linux:armv7:
image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV"
tags:
- armv7-linux
variables:
OS: "LINUX"
ARCH: "ARM"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
retry: 2
.linux:aarch64:
image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV"
tags:
- aarch64-linux
variables:
OS: "LINUX"
ARCH: "ARM64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.darwin:
tags:
- x86_64-darwin
variables:
OS: "DARWIN"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.darwin:aarch64:
tags:
- aarch64-darwin-m1
variables:
OS: "DARWIN"
ARCH: "ARM64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.freebsd13:
tags:
- x86_64-freebsd13
variables:
OS: "FREEBSD"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.freebsd12:
tags:
- x86_64-freebsd12
variables:
OS: "FREEBSD"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
.windows:
tags:
- new-x86_64-windows
variables:
OS: "WINDOWS"
ARCH: "64"
CABAL_DIR: "$CI_PROJECT_DIR/cabal"
retry: 2
.root_cleanup:
after_script:
- bash ./.gitlab/after_script.sh
.test_ghcup_version:
script:
- bash ./.gitlab/script/ghcup_version.sh
variables:
JSON_VERSION: "0.0.6"
artifacts:
expire_in: 2 week
paths:
- test/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
- .debian
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
.test_ghcup_version:linux32:
extends:
- .test_ghcup_version
- .alpine:32bit
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
.test_ghcup_version:armv7:
extends:
- .test_ghcup_version
- .linux:armv7
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
.test_ghcup_version:aarch64:
extends:
- .test_ghcup_version
- .linux:aarch64
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
.test_ghcup_version:darwin:
extends:
- .test_ghcup_version
- .darwin
- .root_cleanup
before_script:
- ./.gitlab/before_script/darwin/install_deps.sh
.test_ghcup_version:darwin:aarch64:
extends:
- .test_ghcup_version
- .darwin:aarch64
- .root_cleanup
script: |
set -Eeuo pipefail
function runInNixShell() {
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
--argstr system "aarch64-darwin" \
--pure \
--keep CI_PROJECT_DIR \
--keep MACOSX_DEPLOYMENT_TARGET \
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
.test_ghcup_version:freebsd12:
extends:
- .test_ghcup_version
- .freebsd12
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
.test_ghcup_version:freebsd13:
extends:
- .test_ghcup_version
- .freebsd13
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
.test_ghcup_version:windows:
extends:
- .test_ghcup_version
- .windows
- .root_cleanup
before_script:
- 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
artifacts:
expire_in: 2 week
paths:
- out
- dist-newstyle/cache/
only:
- tags
variables:
JSON_VERSION: "0.0.6"
######## stack test ########
test:linux:stack:
stage: test
before_script:
- ./.gitlab/before_script/linux/install_deps_minimal.sh
script:
- ./.gitlab/script/ghcup_stack.sh
extends:
- .debian
needs: []
######## bootstrap test ########
test:linux:bootstrap_script:
stage: quick-test
before_script:
- ./.gitlab/before_script/linux/install_deps_minimal.sh
script:
- ./.gitlab/script/ghcup_bootstrap.sh
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
extends:
- .debian
- .root_cleanup
needs: []
test:windows:bootstrap_powershell_script:
stage: quick-test
script:
- ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir $CI_PROJECT_DIR -BootstrapUrl $CI_PROJECT_DIR/bootstrap-haskell -InBash
after_script:
- "[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)"
- "[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)"
- "[Environment]::SetEnvironmentVariable('CABAL_DIR', $null, [System.EnvironmentVariableTarget]::User)"
- bash ./.gitlab/after_script.sh
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
extends:
- .windows
needs: []
######## linux test ########
test:linux:
stage: test
extends: .test_ghcup_version:linux
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
needs: []
test:linux:hls:
stage: expensive-test
extends:
- .test_ghcup_version
- .debian
variables:
GHC_VERSION: "8.10.7"
HLS_TARGET_VERSION: "1.4.0"
CABAL_VERSION: "3.6.2.0"
needs: []
when: manual
allow_failure: true
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
script:
- ./.gitlab/script/ghcup_hls.sh
test:linux:cross-armv7:
stage: expensive-test
extends:
- .test_ghcup_version
- .debian
variables:
GHC_VERSION: "8.10.6"
GHC_TARGET_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.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: expensive-test
extends:
- .test_ghcup_version
- .debian
variables:
GHC_VERSION: "8.10.7"
GHC_GIT_TAG: "ghc-9.0.1-release"
GHC_GIT_VERSION: "9.0.1"
CABAL_VERSION: "3.6.2.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:32bit:
stage: test
extends: .test_ghcup_version:linux32
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
needs: []
######## arm tests ########
test:linux:armv7:
stage: test
extends: .test_ghcup_version:armv7
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
CROSS: ""
when: manual
needs: []
test:linux:aarch64:
stage: test
extends: .test_ghcup_version:aarch64
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
CROSS: ""
when: manual
needs: []
######## darwin test ########
test:mac:
stage: test
extends: .test_ghcup_version:darwin
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
needs: []
test:mac:aarch64:
stage: test
extends: .test_ghcup_version:darwin:aarch64
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
needs: []
allow_failure: true
######## freebsd test ########
test:freebsd12:
stage: test
extends: .test_ghcup_version:freebsd12
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
allow_failure: true # freebsd runners are unreliable
when: manual
needs: []
test:freebsd13:
stage: test
extends: .test_ghcup_version:freebsd13
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
allow_failure: true # freebsd runners are unreliable
when: manual
needs: []
######## windows test ########
test:windows:
stage: test
extends: .test_ghcup_version:windows
variables:
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
needs: []
# test:windows:scoop:
# stage: test
# extends: .test_ghcup_scoop:windows
# needs: []
######## linux release ########
release:linux:64bit:
stage: release
needs: ["test:linux"]
extends:
- .alpine:64bit
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "x86_64-linux-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
release:linux:32bit:
stage: release
needs: ["test:linux:32bit"]
extends:
- .alpine:32bit
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/alpine/install_deps.sh
variables:
ARTIFACT: "i386-linux-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
release:linux:armv7:
stage: release
needs: ["test:linux:armv7"]
extends:
- .linux:armv7
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
variables:
ARTIFACT: "armv7-linux-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
CROSS: ""
release:linux:aarch64:
stage: release
needs: ["test:linux:aarch64"]
extends:
- .linux:aarch64
- .release_ghcup
before_script:
- ./.gitlab/before_script/linux/install_deps.sh
variables:
ARTIFACT: "aarch64-linux-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
CROSS: ""
######## darwin release ########
release:darwin:
stage: release
needs: ["test:mac"]
extends:
- .darwin
- .release_ghcup
- .root_cleanup
before_script:
- ./.gitlab/before_script/darwin/install_deps.sh
variables:
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
MACOSX_DEPLOYMENT_TARGET: "10.7"
release:darwin:aarch64:
stage: release
needs: ["test:mac:aarch64"]
extends:
- .darwin:aarch64
- .release_ghcup
- .root_cleanup
script: |
set -Eeuo pipefail
function runInNixShell() {
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
--argstr system "aarch64-darwin" \
--pure \
--keep CI_PROJECT_DIR \
--keep MACOSX_DEPLOYMENT_TARGET \
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_release.sh 2>&1
variables:
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
MACOSX_DEPLOYMENT_TARGET: "10.7"
allow_failure: true
######## freebsd release ########
release:freebsd12:
stage: release
needs: ["test:freebsd12"]
extends:
- .freebsd12
- .release_ghcup
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
allow_failure: true
release:freebsd13:
stage: release
needs: ["test:freebsd13"]
extends:
- .freebsd13
- .release_ghcup
- .root_cleanup
before_script:
- ./.gitlab/before_script/freebsd/install_deps.sh
variables:
ARTIFACT: "x86_64-portbld-freebsd-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
allow_failure: true
######## windows release ########
release:windows:
stage: release
needs: ["test:windows"]
extends:
- .windows
- .release_ghcup
- .root_cleanup
before_script:
- bash ./.gitlab/before_script/windows/install_deps.sh
variables:
ARTIFACT: "x86_64-mingw64-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
######## hlint ########
hlint:
stage: checks
extends:
- .debian
script:
- curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s -- -r lib/ test/
allow_failure: true
artifacts:
expire_in: 2 week
paths:
- report.html
when: on_failure
######## mkdocs ########
mkdocs:
stage: checks
extends:
- .debian
before_script:
- sudo apt-get update -y
- sudo apt-get install -y python3-pip
- pip3 install mkdocs
script:
- ~/.local/bin/mkdocs build
allow_failure: true
######## shellcheck ########
shellcheck:
image: "koalaman/shellcheck-alpine"
tags:
- x86_64-linux
stage: checks
script:
- shellcheck scripts/bootstrap/bootstrap-haskell
allow_failure: true

View File

@@ -1,15 +0,0 @@
#!/bin/sh
set -eux
BUILD_DIR=$CI_PROJECT_DIR
echo "Cleaning $BUILD_DIR"
cd $HOME
test -n "$BUILD_DIR"
shopt -s extglob
rm -Rf "$BUILD_DIR"/!(out)
if [ "${OS}" = "WINDOWS" ] ; then
rm -Rf /c/ghcup
fi
exit 0

View File

@@ -1,32 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}"
if [ $ARCH = 'ARM64' ] ; then
curl -sSfL https://downloads.haskell.org/~ghcup/aarch64-apple-darwin-ghcup > ./ghcup-bin
chmod +x ghcup-bin
else
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin
chmod +x ghcup-bin
./ghcup-bin upgrade -i -f
fi
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin set ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
if [ $ARCH = 'ARM64' ] ; then
cabal update
mkdir vendored
cd vendored
cabal unpack network-3.1.2.1
cd network*
autoreconf -fi
cd ../..
fi
exit 0

View File

@@ -1,19 +0,0 @@
#!/bin/sh
set -eux
# pkg install --force --yes --no-repo-update curl gcc gmp gmake ncurses perl5 libffi libiconv
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}"
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
chmod +x ghcup-bin
./ghcup-bin -v upgrade -i -f
./ghcup-bin -v install ${GHC_VERSION}
./ghcup-bin -v set ${GHC_VERSION}
./ghcup-bin -v install-cabal ${CABAL_VERSION}
exit 0

View File

@@ -1,58 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../../ghcup_env"
mkdir -p "${TMPDIR}"
apk add --no-cache \
curl \
gcc \
g++ \
binutils \
binutils-gold \
bsd-compat-headers \
gmp-dev \
ncurses-dev \
libffi-dev \
make \
xz \
tar \
perl
if [ "${ARCH}" = "32" ] ; then
curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin
else
curl -sSfL https://downloads.haskell.org/ghcup/x86_64-linux-ghcup > ./ghcup-bin
fi
chmod +x ghcup-bin
./ghcup-bin upgrade -i -f
./ghcup-bin install ${GHC_VERSION}
./ghcup-bin install-cabal ${CABAL_VERSION}
# utils
apk add --no-cache \
bash \
git
## Package specific
apk add --no-cache \
zlib \
zlib-dev \
zlib-static \
bzip2 \
bzip2-dev \
bzip2-static \
gmp \
gmp-dev \
openssl-dev \
openssl-libs-static \
xz \
xz-dev \
ncurses-static
if [ "${ARCH}" = "32" ] ; then
apk add --no-cache \
bsd-compat-headers
fi

View File

@@ -1,27 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
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 gcc autoconf automake build-essential
if [ "${CROSS}" = "arm-linux-gnueabihf" ] ; then
sudo apt-get install -y gcc-arm-linux-gnueabihf
sudo dpkg --add-architecture armhf
sudo apt-get update -y
sudo apt-get install -y libncurses-dev:armhf
fi
export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
export BOOTSTRAP_HASKELL_VERBOSE=1
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
rm "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup

View File

@@ -1,10 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
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

View File

@@ -1,21 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
mkdir -p "${TMPDIR}" "${CABAL_DIR}"
mkdir -p "$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
CI_PROJECT_DIR=$(pwd)
curl -o ghcup.exe https://downloads.haskell.org/~ghcup/x86_64-mingw64-ghcup.exe
chmod +x ghcup.exe
./ghcup.exe install ${GHC_VERSION}
./ghcup.exe set ${GHC_VERSION}
./ghcup.exe install-cabal ${CABAL_VERSION}
rm ./ghcup.exe
exit 0

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

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

View File

@@ -1,30 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal "$@"
}
eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
}
git describe --always
### build
ecabal update
export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION
./scripts/bootstrap/bootstrap-haskell
[ "$(ghc --numeric-version)" = "${GHC_VERSION}" ]

View File

@@ -1,52 +0,0 @@
#!/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/data/metadata/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" ]

View File

@@ -1,52 +0,0 @@
#!/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/data/metadata/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

@@ -1,51 +0,0 @@
#!/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/data/metadata/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 hls -j $(nproc) -v ${HLS_TARGET_VERSION} ${GHC_VERSION}
[ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version` = "${HLS_TARGET_VERSION}" ] || [ `$(eghcup whereis hls ${HLS_TARGET_VERSION}) --numeric-version | sed 's/.0$//'` = "${HLS_TARGET_VERSION}" ]
# nuke
eghcup nuke
[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]

View File

@@ -1,44 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal "$@"
}
git describe
# build
ecabal update
if [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
elif [ "${ARCH}" = "64" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
else
ecabal build -w ghc-${GHC_VERSION} -ftui
fi
elif [ "${OS}" = "FREEBSD" ] ; then
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui
elif [ "${OS}" = "WINDOWS" ] ; then
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib +bundled-c-zlib" --constraint="lzma +static"
else
ecabal build -w ghc-${GHC_VERSION} --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui
fi
mkdir out
binary=$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')
ver=$("${binary}" --numeric-version)
if [ "${OS}" = "DARWIN" ] ; then
strip "${binary}"
else
strip -s "${binary}"
fi
cp "${binary}" out/${ARTIFACT}-${ver}

View File

@@ -1,21 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
git describe --always
### build
curl -L -O https://get.haskellstack.org/stable/linux-x86_64.tar.gz
tar xf linux-x86_64.tar.gz
cp stack-*-linux-*/stack "$CI_PROJECT_DIR"/.local/bin/stack
chmod +x "$CI_PROJECT_DIR"/.local/bin/stack
mkdir -p "$CI_PROJECT_DIR"/.stack_root
export TAR_OPTIONS=--no-same-owner
stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root build
stack --allow-different-user --stack-root "$CI_PROJECT_DIR"/.stack_root test

View File

@@ -1,258 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
CI_PROJECT_DIR=$(pwd)
ecabal() {
cabal "$@"
}
raw_eghcup() {
ghcup -v -c "$@"
}
eghcup() {
if [ "${OS}" = "WINDOWS" ] ; then
ghcup -v -c -s file:/$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
else
ghcup -v -c -s file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml "$@"
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
if [ "${OS}" = "DARWIN" ] ; then
ecabal build -w ghc-${GHC_VERSION} -ftui
ecabal test -w ghc-${GHC_VERSION} -ftui ghcup-test
ecabal haddock -w ghc-${GHC_VERSION} -ftui
elif [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "32" ] ; then
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
if [ "${ARCH}" = "64" ] ; then
# doctest
curl -sL https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-docspec/cabal-docspec-0.0.0.20210228_p1.tar.bz2 > cabal-docspec.tar.bz2
echo '3a10f6fec16dbd18efdd331b1cef5d2d342082da42f5b520726d1fa6a3990d12 cabal-docspec.tar.bz2' | sha256sum -c -
tar -xjf cabal-docspec.tar.bz2 cabal-docspec
mv cabal-docspec "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
rm -f cabal-docspec.tar.bz2
chmod a+x "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
cabal-docspec -XCPP -XTypeSynonymInstances -XOverloadedStrings -XPackageImports --check-properties
fi
fi
elif [ "${OS}" = "FREEBSD" ] ; then
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd" ghcup-test
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
elif [ "${OS}" = "WINDOWS" ] ; then
ecabal build -w ghc-${GHC_VERSION}
ecabal test -w ghc-${GHC_VERSION} ghcup-test
ecabal haddock -w ghc-${GHC_VERSION}
else
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
fi
if [ "${OS}" = "WINDOWS" ] ; then
ext=".exe"
else
ext=''
fi
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext}
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" "$CI_PROJECT_DIR"/.local/bin/ghcup-gen${ext}
### cleanup
rm -rf "${GHCUP_DIR}"
### manual cli based testing
ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
eghcup --numeric-version
eghcup install ghc ${GHC_VERSION}
[ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
eghcup set ghc ${GHC_VERSION}
eghcup install cabal ${CABAL_VERSION}
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit || echo yes
eghcup set 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
ghc_ver=$(ghc --numeric-version)
ghc --version
ghc-${ghc_ver} --version
if [ "${OS}" != "WINDOWS" ] ; then
ghci --version
ghci-${ghc_ver} --version
fi
if [ "${OS}" = "DARWIN" ] && [ "${ARCH}" = "ARM64" ] ; then
echo
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 prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
if [ "${ARCH}" = "64" ] ; then
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
[ "${actual}" = "${expected}" ]
unset actual expected
fi
elif [ "${OS}" = "WINDOWS" ] ; then
eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
[ "${actual}" = "${expected}" ]
unset actual expected
else
eghcup prefetch ghc 8.10.3
eghcup --offline install ghc 8.10.3
fi
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
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 unset ghc
"$GHCUP_BIN"/ghc --numeric-version && exit || echo yes
eghcup set ${GHC_VERSION}
eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls
$(eghcup whereis hls) --version
eghcup install stack
$(eghcup whereis stack) --version
elif [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "64" ] ; then
eghcup install hls
haskell-language-server-wrapper --version
eghcup unset hls
"$GHCUP_BIN"/haskell-language-server-wrapper --version && exit || echo yes
eghcup install stack
stack --version
eghcup unset hls
"$GHCUP_BIN"/stack --version && exit || echo yes
fi
fi
fi
# check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc $(ghc --numeric-version)
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup rm $(ghc --numeric-version)
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
if [ "${OS}" = "LINUX" ] ; then
if [ "${ARCH}" = "64" ] ; then
eghcup install cabal -u https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz 3.4.0.0-rc4
eghcup rm cabal 3.4.0.0-rc4
fi
fi
sha_sum() {
if [ "${OS}" = "FREEBSD" ] ; then
sha256 "$@"
else
sha256sum "$@"
fi
}
# test etags
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
# snapshot yaml and etags file
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# invalidate access time timer, which is 5minutes, so we re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# redownload same file with some newlines added
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
# snapshot new yaml and etags file
etag2=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
# compare
[ "${etag}" != "${etag2}" ]
[ "${sha}" != "${sha2}" ]
# invalidate access time timer, which is 5minutes, but don't expect a re-download
touch -a -m -t '199901010101' "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
# this time, we expect the same hash and etag
raw_eghcup -s https://www.haskell.org/ghcup/exp/ghcup-${JSON_VERSION}.yaml list
etag3=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha3=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
[ "${etag2}" = "${etag3}" ]
[ "${sha2}" = "${sha3}" ]
# test isolated installs
eghcup install ghc -i "$(pwd)/isolated" 8.10.5
[ "$(isolated/bin/ghc --numeric-version)" = "8.10.5" ]
! eghcup install ghc -i "$(pwd)/isolated" 8.10.5
if [ "${ARCH}" = "64" ] ; then
if [ "${OS}" = "LINUX" ] || [ "${OS}" = "WINDOWS" ] ; then
eghcup install cabal -i "$(pwd)/isolated" 3.4.0.0
[ "$(isolated/cabal --numeric-version)" = "3.4.0.0" ]
eghcup install stack -i "$(pwd)/isolated" 2.7.3
[ "$(isolated/stack --numeric-version)" = "2.7.3" ]
eghcup install hls -i "$(pwd)/isolated" 1.3.0
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0" ] ||
[ "$(isolated/haskell-language-server-wrapper --numeric-version)" = "1.3.0.0" ]
fi
fi
eghcup upgrade
eghcup upgrade -f
# nuke
eghcup nuke
[ ! -e "${GHCUP_DIR}" ]

View File

@@ -1,19 +0,0 @@
#!/bin/sh
set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
ecabal() {
cabal --store-dir="$(pwd)"/.store "$@"
}
git describe
ecabal update
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hlint
hlint -r lib/ test/

View File

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

View File

@@ -1,83 +0,0 @@
# HLint configuration file
# https://github.com/ndmitchell/hlint
##########################
# This file contains a template configuration file, which is typically
# placed as .hlint.yaml in the root of your project
# Warnings currently triggered by your code
- ignore: {name: "Redundant bang pattern"}
- ignore: {name: "Use camelCase"}
- ignore: {name: "Use if"}
- ignore: {name: "Use newtype instead of data"}
- ignore: {name: "Use <$>"}
- ignore: {name: "Use mapMaybe"}
- ignore: {name: "Use const"}
- ignore: {name: "Use list comprehension"}
- ignore: {name: "Redundant multi-way if"}
- ignore: {name: "Redundant lambda"}
- ignore: {name: "Avoid lambda"}
- ignore: {name: "Use uncurry"}
- ignore: {name: "Use replicateM"}
- ignore: {name: "Redundant irrefutable pattern"}
# Specify additional command line arguments
#
# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
# Control which extensions/flags/modules/functions can be used
#
# - extensions:
# - default: false # all extension are banned by default
# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
#
# - flags:
# - {name: -w, within: []} # -w is allowed nowhere
#
# - modules:
# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
#
# - functions:
# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
# Add custom hints for this project
#
# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
# The hints are named by the string they display in warning messages.
# For example, if you see a warning starting like
#
# Main.hs:116:51: Warning: Redundant ==
#
# You can refer to that hint with `{name: Redundant ==}` (see below).
# Turn on hints that are off by default
#
# Ban "module X(module X) where", to require a real export list
# - warn: {name: Use explicit module export list}
#
# Replace a $ b $ c with a . b $ c
# - group: {name: dollar, enabled: true}
#
# Generalise map to fmap, ++ to <>
# - group: {name: generalise, enabled: true}
# Ignore some builtin hints
# - ignore: {name: Use let}
# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
# Define some custom infix operators
# - fixity: infixr 3 ~^#^~
# To generate a suitable file for HLint do:
# $ hlint --default > .hlint.yaml

View File

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

View File

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

View File

@@ -1,210 +1,5 @@
# Revision history for ghcup
## 0.1.17.2 -- 2021-09-30
* Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250)
* Speed up `unset` command
* Fix `--overwrite-version` for `ghcup compile ghc` wrt [#253](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/253)
* Apply patches before bootstrap
## 0.1.17.1 -- 2021-09-26
* Fix `NO_COLOR`
* Fix `ghcup list -t` for hls/stack, wrt [#244](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/244)
* Get rid of concurrent-output
* Improve cli interface with partial versions (e.g. `ghcup install ghc 8`)
* Fix HLS compilation builds
* Implement `ghcup gc` (garbage collection) command
## 0.1.17 -- 2021-09-20
* Add `--force` option to install/compile wrt [#210](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/210) by Arjun Kathuria
* Implement compiling HLS from source wrt [#201](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/201)
* Implement experimental GPG verification of the metadata file (see README) wrt [#263](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/236)
* Add `ghcup unset` command wrt [#145](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/145)
* Add `ghcup whereis bindir` etc wrt [#221](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/221)
* Greatly reduce dependency footprint wrt [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/212)
* Add `ghcup --plan-json`
* Improve `--patchdir` option for GHC compilation wrt [#226](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/226)
* Try to improve logging and failure modes, especially during downloads
* Add descriptive warnings when HLS and GHC versions are incompatible
* Improve curl header parsing wrt [#213](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/213)
## 0.1.16.2 -- 2021-08-12
* Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria
* Implement config cli MVP wrt [#134](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/134) by Oleksii Dorozhkin
* Fix `ghcup compile ghc --flavor`
* Fix minor installation bug causing increased disk space wrt [#139](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/139)
* Improved error handling wrt [#136](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/136)
* Various improvements to metadata download when using `file://` and `--offline` wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/137)
## 0.1.16.1 -- 2021-07-29
* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
* Add 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
* Remove legacy handling of cabal binary and be more graceful about binaries not installed by ghcup (e.g. stack)
* Fix GHC compilation from git
* Fix 'ghcup upgrade' on windows
* Allow to skip update checks via `GHCUP_SKIP_UPDATE_CHECK`
* Use libarchive on windows as well, fixing unpack errors wrt [#147](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/147)
## 0.1.15.1 -- 2021-06-11
* Add Apple Silicon support
* Add windows support wrt [#130](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/130)
* Add stack support
* Warn when /tmp doesn't have 5GB or more of disk space
* Allow to compile GHC from git repo wrt [#126](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/126)
* Allow to set custom ghc version when running 'ghcup compile ghc' wrt [#136](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/136)
* Add date to GHC bindist names created by ghcup
## 0.1.14.2 -- 2021-05-12
* Remove dead dependency on ascii-string
## 0.1.14.1 -- 2021-04-11
* Make internal symlink target parser more lax, fixes [#119](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119)
* Prepare for hackage release
## 0.1.14 -- 2021-03-07
* Major bugfix: fix handling of stray versions wrt [#116](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116)
* Fix error messages and overhaul pretty printing wrt [#115](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/115)
## 0.1.13 -- 2021-02-26
* Support ARMv7/AARCH64
* Add command line completions for installed and available versions wrt [MR #70](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/70)
* Allow to cycle through set tools wrt [#114](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/114)
* Fix item selection with unavailable versions wrt [#107](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/107)
* Allow for dynamic post-install, post-remove and pre-compile msgs wrt [MR #68](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/68)
* Alert user if upgraded ghcup is shadowed by old ghcup wrt [#111](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/111)
* Fix to `ghcup` directory creation and placement for the XDG install mode ([MR #49](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/49))
* Do 755 permissions on executables, wrt #97
* Add [NO_COLOR](https://no-color.org/) support wrt [MR #47](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/47)
## 0.1.12 -- 2020-11-21
* Fix disappearing HLS symlinks wrt #91
* improve TUI:
- separators between tools sections
- reverse list order so latest is on top
- expand the blues selected bar
- show new latest versions in bright white
* allow configuration file and setting TUI hotkeys wrt #41
- see https://gitlab.haskell.org/haskell/ghcup-hs#configuration for a more in-depth explanation
* add a `--set` switch to `ghcup install ghc` to automatically set as default after install
* emit warnings when CC/LD is set wrt #82
* add support for version ranges in distro specifiers wrt #84
- e.g. `"(>= 19 && <= 20) || ==0.2.2"` is a valid version key for distro
## 0.1.11 -- 2020-09-23
* Add support for installing haskell-language-server, wrt #65
* When compiling GHC from source create a bindist first, store that bindist in `~/.ghcup/cache` and install it, wrt #51
* Allow to compile over existing version (`ghcup compile ghc -v 8.6.5 -b 8.6.5`) and replace it wrt #59
* simplify installing from custom bindist wrt #60
- `ghcup install ghc -u <url> <version>`
* fix bug when cabal isn't marked executable in bindist
* fix bug when `~/.ghcup` is a valid symlink wrt #49
* Drop support for compiling cabal from source (the old bootstrap script is discontinued)
## 0.1.10 -- 2020-08-14
* Show stray Cabals (useful for pre-releases or compiled ones)
## 0.1.9 -- 2020-08-14
* Fix bug when uninstalling all cabal versions
* Fix bug when setting a non-installed ghc version as current default
* Use yaml instead of generated json for download info for ease of adding new GHC versions #44
* Allow pre-release versions of GHC/cabal
* Add XDG dirs support (set `GHCUP_USE_XDG_DIRS`) wrt #39
* Allow to specify regex for tarball subdir (e.g. `ghc-.*`)
* Allow installing arbitrary bindists more seamlessly:
- e.g. installing GHC HEAD: `ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": { "RegexDir": "ghc-.*"}, "dlUri": "https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27" }' head`
* Avoid duplicate edits to .bashrc/.zshrc wrt #43
## 0.1.8 -- 2020-07-21
* Fix bug in logging thread dying on newlines
* Allow to install from arbitrary bindists: `ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": "ghc-8.10.1", "dlUri": "https://github.com/commercialhaskell/ghc/releases/download/ghc-8.10.1-release/ghc-8.10.1-x86_64-deb9-linux.tar.xz"}' 8.10.1`
## 0.1.7 -- 2020-07-20
* Fix a bug in libarchive not unpacking some uncleanly packed bindists
* Improved fish support in bootstrap-haskell
* Only check for upgrades when not upgrading
* Fix platform detection for i386 docker images
* Improve alpine support
- more/proper bindists
- don't fall back to glibc based bindists
- install bindists with `--disable-ld-override` to avoid ld.gold bugs
## 0.1.6 -- 2020-07-13
* Create a new curses (brick) based TUI, accessible via `ghcup tui` #24
* Support multiple installed versions of cabal #23
* Improvements to `ghcup list` (show unavailable bindists for platform)
* Fix redhat downloads #29
* Support for hadrian bindists (fixes alpine-8.10.1) #31
* Add FreeBSD bindists 8.6.5 and 8.8.3
* Fix memory leak during unpack
## 0.1.5 -- 2020-04-30
* Fix errors when PATH variable contains path components that are actually files
* Add `--version` and `--numeric-version` options
* Add `changelog` command
* Also check for available GHC and Cabal updates on start
* Add base versions as tags for every GHC version (these are "installable" tags and the latest GHC version matching the tag will be picked)
* Added `--format-raw` to list subcommand
* Allow to install X.Y versions (e.g.: ghcup install 8.8)
* Implement `--keep=<always|errors|never>` to control temporary build directories cleanup
* Add proper shell completions to the repo
* Fix building of documentation
* Allow to work in offline mode and use cached files if possible
* Allow to set the downloader via `--downloader=<curl|wget>`
* Support for compiling and installing a cross GHC (see README). This is experimental.
## 0.1.4 -- 2020-04-16
* build on all platforms with curl (as a binary), wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/6
* Fix unlinking of ghc symlinks after new installation, wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
## 0.1.3 -- 2020-04-15
* Fix lesser bug when skipping ghcup update
## 0.1.2 -- 2020-04-15
* Fix bug when removing the set GHC version
* Fix use of undocumented `GHCUP_INSTALL_BASE_PREFIX` variable
* skip upgrade if ghcup is already latest version
## 0.1.1 -- 2020-04-15
* fix awful fdopendir bug on mac bug by updating hpath-posix
## 0.1.0
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

149
README.md
View File

@@ -1,11 +1,144 @@
## The GHCup Haskell installer
`ghcup` makes it easy to install specific versions of `ghc` on GNU/Linux,
macOS (aka Darwin) and FreeBSD and can also bootstrap a fresh Haskell developer environment from scratch.
It follows the unix UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well).
[![Join the chat at Libera.chat](https://img.shields.io/badge/chat-on%20libera%20IRC-brightgreen.svg)](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
[![Join the chat at Matrix.org](https://img.shields.io/matrix/haskell-tooling:matrix.org?label=chat%20on%20matrix.org)](https://app.element.io/#/room/#haskell-tooling:matrix.org)
[![Join the chat at Discord](https://img.shields.io/discord/280033776820813825?label=chat%20on%20discord)](https://discord.gg/pKYf3zDQU7)
[![Join the chat at https://gitter.im/haskell/ghcup](https://badges.gitter.im/haskell/ghcup.svg)](https://gitter.im/haskell/ghcup?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
<a href="https://opencollective.com/ghcup#category-CONTRIBUTE"><img src="https://opencollective.com/webpack/donate/button@2x.png?color=blue" alt="Donate" width="150"></a>
Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/).
*Ubuntu users may prefer [hvr's ppa](https://launchpad.net/~hvr/+archive/ubuntu/ghc).*
## Table of Contents
* [Installation](#installation)
* [Usage](#usage)
* [Manpages](#manpages)
* [Design goals](#design-goals)
* [How](#how)
* [Known users](#known-users)
* [Known problems](#known-problems)
* [FAQ](#faq)
## Installation
### Simple bootstrap
Follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/)
### Manual install
Download the binary for your platform at [https://github.com/hasufell/ghcup-hs/releases](https://github.com/hasufell/ghcup-hs/releases)
and place it into your `PATH` anywhere.
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
```sh
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
```
## Usage
See `ghcup --help`.
Common use cases are:
```sh
# list available ghc/cabal versions
ghcup list
# install the recommended GHC version
ghcup install ghc
# install a specific GHC version
ghcup install ghc -v 8.2.2
# set the currently "active" GHC version
ghcup set -v 8.4.4
# install cabal-install
ghcup install cabal
# update ghcup itself
ghcup upgrade
```
Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler) of `ghc` is available, which `ghcup` can do.
### Manpages
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
`MANPATH` may be required to be unset.
## Design goals
1. simplicity
2. non-interactive
3. portable (eh)
4. do one thing and do it well (UNIX philosophy)
### Non-goals
1. invoking `sudo`, `apt-get` or *any* package manager
2. handling system packages
3. handling cabal projects
4. being a stack alternative
## How
Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.
Optionally, an unversioned `ghc` link can point to a default version of your choice.
This uses precompiled GHC binaries that have been compiled on fedora/debian by [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries).
Alternatively, you can also tell it to compile from source (note that this might fail due to missing requirements).
In addition this script can also install `cabal-install`.
## Known users
* [vabal](https://github.com/Franciman/vabal)
## Known problems
### Limited distributions supported
Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.
### Precompiled binaries
Since this uses precompiled binaries you may run into
several problems.
#### Missing libtinfo (ncurses)
You may run into problems with *ncurses* and **missing libtinfo**, in case
your distribution doesn't use the legacy way of building
ncurses and has no compatibility symlinks in place.
Ask your distributor on how to solve this or
try to compile from source via `ghcup compile <version>`.
#### Libnuma required
This was a [bug](https://ghc.haskell.org/trac/ghc/ticket/15688) in the build system of some GHC versions that lead to
unconditionally enabled libnuma support. To mitigate this you might have to install the libnuma
package of your distribution. See [here](https://gitlab.haskell.org/haskell/ghcup/issues/58) for a discussion.
### Compilation
Although this script can compile GHC for you, it's just a very thin
wrapper around the build system. It makes no effort in trying
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.
## FAQ
1. 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.
2. Why not support windows?
Consider using [Chocolatey](https://chocolatey.org/search?q=ghc) or [ghcups](https://github.com/kakkun61/ghcups).
Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions.

File diff suppressed because it is too large Load Diff

View File

@@ -1,51 +1,66 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Main where
import GHCup.Types
import GHCup.Errors
import GHCup.Platform
import GHCup.Utils.Dirs
import GHCup.Utils.Logger
import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import GHCupDownloads
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.IO.Class
import Data.Char ( toLower )
import Data.Maybe
#if !MIN_VERSION_base(4,13,0)
import Data.Aeson ( eitherDecode )
import Data.Aeson.Encode.Pretty
import Data.Semigroup ( (<>) )
#endif
import Options.Applicative hiding ( style )
import Haskus.Utils.Variant.Excepts
import System.Console.Pretty
import System.Environment
import System.Exit
import System.IO ( stderr )
import Text.Regex.Posix
import System.IO ( stdout )
import Validate
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.YAML.Aeson as Y
import qualified Data.ByteString.Lazy as L
data Options = Options
{ optCommand :: Command
}
data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts TarballFilter
data Command = GenJSON GenJSONOpts
| ValidateJSON ValidateJSONOpts
| ValidateTarballs ValidateJSONOpts
data Output
= FileOutput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
| StdOutput
fileOutput :: Parser Output
fileOutput =
FileOutput
<$> (strOption
(long "file" <> short 'f' <> metavar "FILENAME" <> help
"Output to a file"
)
)
stdOutput :: Parser Output
stdOutput = flag'
StdOutput
(short 'o' <> long "stdout" <> help "Print to stdout (default)")
outputP :: Parser Output
outputP = fileOutput <|> stdOutput
data GenJSONOpts = GenJSONOpts
{ output :: Maybe Output
}
genJSONOpts :: Parser GenJSONOpts
genJSONOpts = GenJSONOpts <$> optional outputP
data Input
@@ -55,10 +70,11 @@ data Input
fileInput :: Parser Input
fileInput =
FileInput
<$> strOption
<$> (strOption
(long "file" <> short 'f' <> metavar "FILENAME" <> help
"Input file to validate"
)
)
stdInput :: Parser Input
stdInput = flag'
@@ -68,90 +84,81 @@ stdInput = flag'
inputP :: Parser Input
inputP = fileInput <|> stdInput
data ValidateYAMLOpts = ValidateYAMLOpts
{ vInput :: Maybe Input
data ValidateJSONOpts = ValidateJSONOpts
{ input :: Maybe Input
}
validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
tarballFilterP :: Parser TarballFilter
tarballFilterP = option readm $
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
<> help "Only check certain tarballs (format: <tool>-<version>)"
where
def = TarballFilter (Right Nothing) (makeRegex ("" :: String))
readm = do
s <- str
case span (/= '-') s of
(_, []) -> fail "invalid format, missing '-' after the tool name"
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
_ -> fail "invalid tool"
low = fmap toLower
validateJSONOpts :: Parser ValidateJSONOpts
validateJSONOpts = ValidateJSONOpts <$> optional inputP
opts :: Parser Options
opts = Options <$> com
com :: Parser Command
com = subparser
( command
( (command
"gen"
( GenJSON
<$> (info (genJSONOpts <**> helper)
(progDesc "Generate the json downloads file")
)
)
)
<> (command
"check"
( ValidateYAML
<$> info (validateYAMLOpts <**> helper)
(progDesc "Validate the YAML")
( ValidateJSON
<$> (info (validateJSONOpts <**> helper)
(progDesc "Validate the JSON")
)
)
<> command
)
<> (command
"check-tarballs"
(info
((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
( ValidateTarballs
<$> (info
(validateJSONOpts <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
)
)
)
)
main :: IO ()
main = do
no_color <- isJust <$> lookupEnv "NO_COLOR"
let loggerConfig = LoggerConfig { lcPrintDebug = True
, consoleOutter = T.hPutStr stderr
, fileOutter = \_ -> pure ()
, fancyColors = not no_color
}
dirs <- liftIO getAllDirs
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig
pfreq <- (
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
) >>= \case
VRight r -> pure r
VLeft e -> do
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
liftIO $ exitWith (ExitFailure 2)
let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of
ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
GenJSON gopts -> do
let
bs = encodePretty' (defConfig { confIndent = Spaces 2 })
ghcupDownloads
case gopts of
GenJSONOpts { output = Nothing } -> L.hPutStr stdout bs
GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs
GenJSONOpts { output = Just (FileOutput file) } ->
L.writeFile file bs
ValidateJSON vopts -> case vopts of
ValidateJSONOpts { input = Nothing } ->
L.getContents >>= valAndExit validate
ValidateJSONOpts { input = Just StdInput } ->
L.getContents >>= valAndExit validate
ValidateJSONOpts { input = Just (FileInput file) } ->
L.readFile file >>= valAndExit validate
ValidateTarballs vopts -> case vopts of
ValidateJSONOpts { input = Nothing } ->
L.getContents >>= valAndExit validateTarballs
ValidateJSONOpts { input = Just StdInput } ->
L.getContents >>= valAndExit validateTarballs
ValidateJSONOpts { input = Just (FileInput file) } ->
L.readFile file >>= valAndExit validateTarballs
pure ()
where
withValidateYamlOpts vopts f = case vopts of
ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit f
ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit f
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit f
valAndExit f contents = do
(GHCupInfo _ av gt) <- case Y.decode1Strict contents of
av <- case eitherDecode contents of
Right r -> pure r
Left (_, e) -> die (color Red $ show e)
f av gt
Left e -> die (color Red $ show e)
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)
>>= exitWith

View File

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

View File

@@ -1,615 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
module BrickMain where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Prelude ( decUTF8Safe )
import GHCup.Utils.File
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Center
import Brick.Widgets.List ( listSelectedFocusedAttr
, listSelectedAttr
, listAttr
)
import Codec.Archive
import Control.Exception.Safe
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource
import Data.Bool
import Data.Functor
import Data.List
import Data.Maybe
import Data.IORef
import Data.Vector ( Vector
, (!?)
)
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.Exit
import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
hiddenTools :: [Tool]
hiddenTools = []
data BrickData = BrickData
{ lr :: [ListResult]
}
deriving Show
data BrickSettings = BrickSettings
{ showAllVersions :: Bool
, showAllTools :: Bool
}
deriving Show
data BrickInternalState = BrickInternalState
{ clr :: Vector ListResult
, ix :: Int
}
deriving Show
data BrickState = BrickState
{ appData :: BrickData
, appSettings :: BrickSettings
, appState :: BrickInternalState
, appKeys :: KeyBindings
}
deriving Show
keyHandlers :: KeyBindings
-> [ ( Vty.Key
, BrickSettings -> String
, BrickState -> EventM n (Next BrickState)
)
]
keyHandlers KeyBindings {..} =
[ (bQuit, const "Quit" , halt)
, (bInstall, const "Install" , withIOAction install')
, (bUninstall, const "Uninstall", withIOAction del')
, (bSet, const "Set" , withIOAction ((liftIO .) . set'))
, (bChangelog, const "ChangeLog", withIOAction changelog')
, ( bShowAllVersions
, \BrickSettings {..} ->
if showAllVersions then "Don't show all versions" else "Show all versions"
, hideShowHandler (not . showAllVersions) showAllTools
)
, ( bShowAllTools
, \BrickSettings {..} ->
if showAllTools then "Don't show all tools" else "Show all tools"
, hideShowHandler showAllVersions (not . showAllTools)
)
, (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. })
, (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
]
where
hideShowHandler f p BrickState{..} =
let newAppSettings = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
newInternalState = constructList appData newAppSettings (Just appState)
in continue (BrickState appData newAppSettings newInternalState appKeys)
showKey :: Vty.Key -> String
showKey (Vty.KChar c) = [c]
showKey Vty.KUp = ""
showKey Vty.KDown = ""
showKey key = tail (show key)
ui :: AttrMap -> BrickState -> Widget String
ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
= padBottom Max
( withBorderStyle unicode
$ borderWithLabel (str "GHCup")
(center (header <=> hBorder <=> renderList' appState))
)
<=> footer
where
footer =
withAttr "help"
. txtWrap
. T.pack
. foldr1 (\x y -> x <> " " <> y)
. fmap (\(key, s, _) -> showKey key <> ":" <> s as)
$ keyHandlers appKeys
header =
minHSize 2 emptyWidget
<+> padLeft (Pad 2) (minHSize 6 $ str "Tool")
<+> minHSize 15 (str "Version")
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
<+> padLeft (Pad 5) (str "Notes")
renderList' = withDefAttr listAttr . drawListElements renderItem True
renderItem _ b listResult@ListResult{..} =
let marks = if
| lSet -> (withAttr "set" $ str "✔✔")
| lInstalled -> (withAttr "installed" $ str "")
| otherwise -> (withAttr "not-installed" $ str "")
ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
dim
| lNoBindist && not lInstalled
&& not b -- TODO: overloading dim and active ignores active
-- so we hack around it here
= updateAttrMap (const dimAttrs) . withAttr "no-bindist"
| otherwise = id
hooray
| elem Latest lTag && not lInstalled =
withAttr "hooray"
| otherwise = id
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id
in hooray $ active $ dim
( marks
<+> padLeft (Pad 2)
( minHSize 6
(printTool lTool)
)
<+> minHSize 15 (str ver)
<+> (let l = catMaybes . fmap printTag $ sort lTag
in padLeft (Pad 1) $ minHSize 25 $ if null l
then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) l
)
<+> padLeft (Pad 5)
( let notes = printNotes listResult
in if null notes
then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) notes
)
<+> vLimit 1 (fill ' ')
)
printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
printTag Latest = Just $ withAttr "latest" $ str "latest"
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing
printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
printTool GHC = str "GHC"
printTool GHCup = str "GHCup"
printTool HLS = str "HLS"
printTool Stack = str "Stack"
printNotes ListResult {..} =
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
)
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
-- | Draws the list elements.
--
-- Evaluates the underlying container up to, and a bit beyond, the
-- selected element. The exact amount depends on available height
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
-- available height.
drawListElements :: (Int -> Bool -> ListResult -> Widget String)
-> Bool
-> BrickInternalState
-> Widget String
drawListElements drawElem foc is@(BrickInternalState clr _) =
Widget Greedy Greedy $
let
es = clr
listSelected = fmap fst $ listSelectedElement' is
drawnElements = flip V.imap es $ \i' e ->
let addSeparator w = case es !? (i' - 1) of
Just e' | lTool e' /= lTool e ->
hBorder <=> w
_ -> w
isSelected = Just i' == listSelected
elemWidget = drawElem i' isSelected e
selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr
makeVisible = if isSelected then visible . selItemAttr else id
in addSeparator $ makeVisible elemWidget
in render
$ viewport "GHCup" Vertical
$ vBox
$ V.toList drawnElements
minHSize :: Int -> Widget n -> Widget n
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
app :: AttrMap -> AttrMap -> App BrickState e String
app attrs dimAttrs =
App { appDraw = \st -> [ui dimAttrs st]
, appHandleEvent = eventHandler
, appStartEvent = return
, appAttrMap = const attrs
, appChooseCursor = showFirstCursor
}
defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap
Vty.defAttr
[ ("active" , Vty.defAttr `withBackColor` Vty.blue)
, ("not-installed", Vty.defAttr `withForeColor` Vty.red)
, ("set" , Vty.defAttr `withForeColor` Vty.green)
, ("installed" , Vty.defAttr `withForeColor` Vty.green)
, ("recommended" , Vty.defAttr `withForeColor` Vty.green)
, ("hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, ("latest" , Vty.defAttr `withForeColor` Vty.yellow)
, ("prerelease" , Vty.defAttr `withForeColor` Vty.red)
, ("compiled" , Vty.defAttr `withForeColor` Vty.blue)
, ("stray" , Vty.defAttr `withForeColor` Vty.blue)
, ("help" , Vty.defAttr `withStyle` Vty.italic)
, ("hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
]
where
withForeColor | no_color = const
| otherwise = Vty.withForeColor
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
withStyle = Vty.withStyle
dimAttributes :: Bool -> AttrMap
dimAttributes no_color = attrMap
(Vty.defAttr `Vty.withStyle` Vty.dim)
[ ("active" , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
, ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
]
where
withBackColor | no_color = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
| otherwise = Vty.withBackColor
eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState)
eventHandler st@BrickState{..} ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef settings'
case ev of
(MouseDown _ Vty.BScrollUp _ _) ->
continue (BrickState { appState = moveCursor 1 appState Up, .. })
(MouseDown _ Vty.BScrollDown _ _) ->
continue (BrickState { appState = moveCursor 1 appState Down, .. })
(VtyEvent (Vty.EvResize _ _)) -> continue st
(VtyEvent (Vty.EvKey Vty.KUp _)) ->
continue BrickState{ appState = moveCursor 1 appState Up, .. }
(VtyEvent (Vty.EvKey Vty.KDown _)) ->
continue BrickState{ appState = moveCursor 1 appState Down, .. }
(VtyEvent (Vty.EvKey key _)) ->
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
Nothing -> continue st
Just (_, _, handler) -> handler st
_ -> continue st
moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
moveCursor steps ais@BrickInternalState{..} direction =
let newIx = if direction == Down then ix + steps else ix - steps
in case clr !? newIx of
Just _ -> BrickInternalState { ix = newIx, .. }
Nothing -> ais
-- | Suspend the current UI and run an IO action in terminal. If the
-- IO action returns a Left value, then it's thrown as userError.
withIOAction :: (BrickState
-> (Int, ListResult)
-> ReaderT AppState IO (Either String a))
-> BrickState
-> EventM n (Next BrickState)
withIOAction action as = case listSelectedElement' (appState as) of
Nothing -> continue as
Just (ix, e) -> do
suspendAndResume $ do
settings <- readIORef settings'
flip runReaderT settings $ action as (ix, e) >>= \case
Left err -> liftIO $ putStrLn ("Error: " <> err)
Right _ -> liftIO $ putStrLn "Success"
getAppData Nothing >>= \case
Right data' -> do
putStrLn "Press enter to continue"
_ <- getLine
pure (updateList data' as)
Left err -> throwIO $ userError err
-- | Update app data and list internal state based on new evidence.
-- This synchronises @BrickInternalState@ with @BrickData@
-- and @BrickSettings@.
updateList :: BrickData -> BrickState -> BrickState
updateList appD BrickState{..} =
let newInternalState = constructList appD appSettings (Just appState)
in BrickState { appState = newInternalState
, appData = appD
, appSettings = appSettings
, appKeys = appKeys
}
constructList :: BrickData
-> BrickSettings
-> Maybe BrickInternalState
-> BrickInternalState
constructList appD appSettings =
replaceLR (filterVisible (showAllVersions appSettings)
(showAllTools appSettings))
(lr appD)
listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
selectLatest :: Vector ListResult -> Int
selectLatest v =
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
Just ix -> ix
Nothing -> 0
-- | Replace the @appState@ or construct it based on a filter function
-- and a new @[ListResult]@ evidence.
-- When passed an existing @appState@, tries to keep the selected element.
replaceLR :: (ListResult -> Bool)
-> [ListResult]
-> Maybe BrickInternalState
-> BrickInternalState
replaceLR filterF lr s =
let oldElem = s >>= listSelectedElement'
newVec = V.fromList . filter filterF $ lr
newSelected =
case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
Just ix -> ix
Nothing -> selectLatest newVec
in BrickInternalState newVec newSelected
where
toolEqual e1 e2 =
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
filterVisible :: Bool -> Bool -> ListResult -> Bool
filterVisible v t e | lInstalled e = True
| v
, not t
, not (elem (lTool e) hiddenTools) = True
| not v
, t
, not (elem Old (lTag e)) = True
| v
, t = True
| otherwise = not (elem Old (lTag e)) &&
not (elem (lTool e) hiddenTools)
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
install' _ (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let run =
runResourceT
. runE
@'[ AlreadyInstalled
, ArchiveResult
, UnknownArchive
, FileDoesNotExistError
, CopyError
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, GPGError
, DownloadFailed
, DirNotEmpty
, NoUpdate
, TarDirDoesNotExist
, FileAlreadyExistsError
, ProcessError
]
run (do
case lTool of
GHC -> do
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer Nothing False $> vi
Cabal -> do
let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer Nothing False $> vi
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi
HLS -> do
let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer Nothing False $> vi
Stack -> do
let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer Nothing False $> vi
)
>>= \case
VRight vi -> do
forM_ (_viPostInstall =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right ()
VLeft e -> pure $ Left $ prettyShow e <> "\n"
<> "Also check the logs in ~/.ghcup/logs"
set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
set' _ (_, ListResult {..}) = do
settings <- readIORef settings'
let run =
flip runReaderT settings
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
run (do
case lTool of
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
Cabal -> liftE $ setCabal lVer $> ()
HLS -> liftE $ setHLS lVer $> ()
Stack -> liftE $ setStack lVer $> ()
GHCup -> pure ()
)
>>= \case
VRight _ -> pure $ Right ()
VLeft e -> pure $ Left (prettyShow e)
del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
del' _ (_, ListResult {..}) = do
AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
let run = runE @'[NotInstalled]
run (do
let vi = getVersionInfo lVer lTool dls
case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi
HLS -> liftE $ rmHLSVer lVer $> vi
Stack -> liftE $ rmStackVer lVer $> vi
GHCup -> pure Nothing
)
>>= \case
VRight vi -> do
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
logInfo msg
pure $ Right ()
VLeft e -> pure $ Left (prettyShow e)
changelog' :: (MonadReader AppState m, MonadIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (Left lVer) of
Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do
let cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
Right _ -> pure $ Right ()
Left e -> pure $ Left $ prettyShow e
settings' :: IORef AppState
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
dirs <- getAllDirs
let loggerConfig = LoggerConfig { lcPrintDebug = False
, consoleOutter = \_ -> pure ()
, fileOutter = \_ -> pure ()
, fancyColors = True
}
newIORef $ AppState (Settings { cache = True
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, noNetwork = False
, gpgSetting = GPGNone
, noColor = False
, ..
})
dirs
defaultKeyBindings
(GHCupInfo mempty mempty mempty)
(PlatformRequest A_64 Darwin Nothing)
loggerConfig
brickMain :: AppState
-> IO ()
brickMain s = do
writeIORef settings' s
eAppData <- getAppData (Just $ ghcupInfo s)
case eAppData of
Right ad ->
defaultMain
(app (defaultAttributes (noColor $ settings s)) (dimAttributes (noColor $ settings s)))
(BrickState ad
defaultAppSettings
(constructList ad defaultAppSettings Nothing)
(keyBindings (s :: AppState))
)
$> ()
Left e -> do
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
exitWith $ ExitFailure 2
defaultAppSettings :: BrickSettings
defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = False }
getGHCupInfo :: IO (Either String GHCupInfo)
getGHCupInfo = do
settings <- readIORef settings'
r <-
flip runReaderT settings
. runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
$ liftE
$ getDownloadsF
case r of
VRight a -> pure $ Right a
VLeft e -> pure $ Left (prettyShow e)
getAppData :: Maybe GHCupInfo
-> IO (Either String BrickData)
getAppData mgi = runExceptT $ do
r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi
liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })
settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do
lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV)

File diff suppressed because it is too large Load Diff

View File

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

View File

@@ -1,213 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
aeson-pretty +lib-only,
any.alex ==3.2.6,
alex +small_base,
any.ansi-terminal ==0.11,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.3,
async -bench,
any.attoparsec ==0.13.2.5,
attoparsec -developer,
any.base ==4.14.3.0,
any.base-compat ==0.12.0,
any.base-compat-batteries ==0.12.0,
any.base-orphans ==0.8.5,
any.base16-bytestring ==1.0.1.0,
any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1,
any.brick ==0.64.1,
brick -demos,
any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.clock ==0.8.2,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.5.1,
any.contravariant ==1.5.5,
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-fix ==0.3.2,
any.deepseq ==1.4.4.0,
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,
dlist -werror,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.7,
any.generic-arbitrary ==0.1.0,
any.ghc-boot-th ==8.10.7,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1,
any.happy ==1.20.0,
any.hashable ==1.3.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.10,
any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1,
any.indexed-traversable-instances ==0.1,
any.integer-gmp ==1.0.3.0,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.0,
libarchive -cross -low-memory -system-libarchive,
any.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.10,
any.mtl ==2.2.2,
any.network ==3.1.2.2,
network -devel,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4,
any.optics-core ==0.4,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4,
any.optics-th ==0.4,
any.optparse-applicative ==0.16.1.0,
optparse-applicative +process,
any.os-release ==1.0.2,
os-release -devel,
any.parallel ==3.2.2.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.2.0,
any.process ==1.6.13.2,
any.profunctors ==5.6.2,
any.quickcheck-arbitrary-adt ==0.3.1.0,
any.quickcheck-io ==0.2.0,
any.random ==1.2.1,
any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.3,
any.rts ==1.0.1,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.3,
splitmix -optimised-mixer,
any.stm ==2.5.0.1,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.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-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.0,
any.vty ==5.33,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.0,
any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-01T15:16:26Z

View File

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

View File

@@ -1,213 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
aeson-pretty +lib-only,
any.alex ==3.2.6,
alex +small_base,
any.ansi-terminal ==0.11,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.3,
async -bench,
any.attoparsec ==0.13.2.5,
attoparsec -developer,
any.base ==4.15.0.0,
any.base-compat ==0.12.0,
any.base-compat-batteries ==0.12.0,
any.base-orphans ==0.8.5,
any.base16-bytestring ==1.0.1.0,
any.base64-bytestring ==1.1.0.0,
any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1,
any.brick ==0.64.1,
brick -demos,
any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.casing ==0.1.4.1,
any.chs-cabal ==0.1.1.1,
any.chs-deps ==0.1.0.0,
chs-deps -cross,
any.clock ==0.8.2,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.composition-prelude ==3.0.0.2,
composition-prelude -development,
any.config-ini ==0.2.4.0,
config-ini -enable-doctests,
any.containers ==0.6.4.1,
any.contravariant ==1.5.5,
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-fix ==0.3.2,
any.deepseq ==1.4.5.0,
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,
dlist -werror,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.7,
any.generic-arbitrary ==0.1.0,
any.ghc-bignum ==1.0,
any.ghc-boot-th ==9.0.1,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0,
any.happy ==1.20.0,
any.hashable ==1.3.3.0,
hashable +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.10,
any.hspec-core ==2.7.10,
any.hspec-discover ==2.7.10,
any.hspec-expectations ==0.8.2,
any.hspec-golden-aeson ==0.9.0.0,
any.http-io-streams ==0.1.6.0,
http-io-streams -brotli +fast-xor,
any.indexed-profunctors ==0.1.1,
any.indexed-traversable ==0.1.1,
any.indexed-traversable-instances ==0.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.2.1,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.0,
libarchive -cross -low-memory -system-libarchive,
any.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.10,
any.mtl ==2.2.2,
any.network ==3.1.2.2,
network -devel,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
any.optics ==0.4,
any.optics-core ==0.4,
optics-core -explicit-generic-labels,
any.optics-extra ==0.4,
any.optics-th ==0.4,
any.optparse-applicative ==0.16.1.0,
optparse-applicative +process,
any.os-release ==1.0.2,
os-release -devel,
any.parallel ==3.2.2.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.2.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.1,
any.recursion-schemes ==5.2.2.1,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.1,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.3,
any.rts ==1.0,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.3,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
any.tagged ==0.8.6.1,
tagged +deepseq +transformers,
any.template-haskell ==2.17.0.0,
any.temporary ==1.3,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.terminfo ==0.4.1.4,
any.text ==1.2.4.1,
any.text-zipper ==0.11,
any.tf-random ==0.5,
any.th-abstraction ==0.4.3.0,
any.th-compat ==0.1.3,
any.th-lift ==0.8.2,
any.th-lift-instances ==0.1.18,
any.these ==1.1.1.1,
these +assoc,
any.time ==1.9.3,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.transformers ==0.5.6.2,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.14.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.3.1,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5,
any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.0,
any.vty ==5.33,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.0,
any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-01T15:16:26Z

View File

@@ -1,24 +1,18 @@
packages: ./ghcup.cabal
optional-packages: ./vendored/*/*.cabal
with-compiler: ghc-8.6.5
optimization: 2
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
package ghcup
tests: True
flags: +tui
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
constraints: http-io-streams -brotli,
any.Cabal ==3.4.0.0 || ==3.6.2.0
package tar-bytestring
ghc-options: -O2
constraints: http-io-streams -brotli
package libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only
package cabal-plan
flags: -exe
allow-newer: base, ghc-prim, template-haskell, language-c
index-state: 2020-03-09T18:53:34Z

View File

@@ -1,2 +1,258 @@
-- windows picks weird version
constraints: any.hsc2hs ==0.68.7
constraints: any.Cabal ==2.4.0.1,
any.Glob ==0.10.0,
any.HsOpenSSL ==0.11.4.17,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -old-locale,
any.IfElse ==0.85,
any.Only ==0.1,
any.QuickCheck ==2.13.2,
QuickCheck +templatehaskell,
any.StateVar ==1.2,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.abstract-par ==0.3.3,
any.aeson ==1.4.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
aeson-pretty -lib-only,
any.ansi-terminal ==0.10.3,
ansi-terminal -example,
any.ansi-wl-pprint ==0.6.9,
ansi-wl-pprint -example,
any.array ==0.5.3.0,
any.ascii-string ==1.0.1.4,
any.assoc ==1.0.1,
any.async ==2.2.2,
async -bench,
any.atomic-primops ==0.8.3,
atomic-primops -debug,
any.attoparsec ==0.13.2.3,
attoparsec -developer,
any.auto-update ==0.1.6,
any.base ==4.12.0.0,
any.base-compat ==0.11.1,
any.base-compat-batteries ==0.11.1,
any.base-orphans ==0.8.2,
any.base-prelude ==1.3,
any.base16-bytestring ==0.1.1.6,
any.base64-bytestring ==1.0.0.3,
any.bifunctors ==5.5.7,
bifunctors +semigroups +tagged,
any.binary ==0.8.6.0,
any.binary-orphans ==1.0.1,
any.blaze-builder ==0.4.1.0,
any.bytestring ==0.10.8.2,
any.bytestring-builder ==0.10.8.2.0,
bytestring-builder +bytestring_has_builder,
any.bytestring-handle ==0.1.0.6,
any.bzlib ==0.5.0.5,
any.cabal-doctest ==1.0.8,
any.case-insensitive ==1.2.1.0,
any.cassava ==0.5.2.0,
cassava -bytestring--lt-0_10_4,
any.cereal ==0.5.8.1,
cereal -bytestring-builder,
any.clock ==0.8,
clock -llvm,
any.cmdargs ==0.10.20,
cmdargs +quotation -testprog,
any.code-page ==0.2,
any.colour ==2.3.5,
any.comonad ==5.0.6,
comonad +containers +distributive +test-doctests,
any.conduit ==1.3.1.2,
any.conduit-extra ==1.3.4,
any.containers ==0.6.0.1,
any.contravariant ==1.5.2,
contravariant +semigroups +statevar +tagged,
any.criterion ==1.5.6.2,
criterion -embed-data-files -fast,
any.criterion-measurement ==0.1.2.0,
criterion-measurement -fast,
any.data-default-class ==0.1.2.0,
any.data-default-instances-base ==0.1.0.1,
any.deepseq ==1.4.4.0,
any.deferred-folds ==0.9.10.1,
any.dense-linear-algebra ==0.1.0.0,
any.directory ==1.3.3.0 || ==1.3.6.0,
any.distributive ==0.6.1,
distributive +semigroups +tagged,
any.dlist ==0.8.0.7,
any.easy-file ==0.2.2,
any.errors ==2.3.0,
any.exceptions ==0.10.4,
exceptions +transformers-0-4,
any.extra ==1.7,
any.fast-logger ==3.0.1,
any.filepath ==1.4.2.1,
any.focus ==1.0.1.3,
any.foldl ==1.4.6,
any.free ==5.1.3,
any.fusion-plugin-types ==0.1.0,
any.generics-sop ==0.5.0.0,
any.ghc-boot-th ==8.6.5,
any.ghc-prim ==0.5.3,
any.happy ==1.19.12,
happy +small_base,
any.hashable ==1.3.0.0,
hashable -examples +integer-gmp +sse2 -sse41,
any.haskell-src-exts ==1.23.0,
any.haskell-src-meta ==0.8.5,
any.haskus-utils-data ==1.2,
any.haskus-utils-types ==1.5,
any.haskus-utils-variant ==3.0,
any.heaps ==0.3.6.1,
any.hopenssl ==2.2.4,
hopenssl -link-libz,
any.hpath ==0.11.0,
any.hpath-directory ==0.13.2,
any.hpath-filepath ==0.10.4,
any.hpath-io ==0.13.1,
any.hpath-posix ==0.13.1,
any.hsc2hs ==0.68.6,
hsc2hs -in-ghc-tree,
any.http-io-streams ==0.1.2.0,
http-io-streams -brotli,
any.indexed-profunctors ==0.1,
any.integer-gmp ==1.0.2.0,
any.integer-logarithms ==1.0.3,
integer-logarithms -check-bounds +integer-gmp,
any.io-streams ==1.5.1.0,
io-streams -nointeractivetests,
any.js-flot ==0.8.3,
any.js-jquery ==3.3.1,
any.language-bash ==0.9.0,
any.lifted-base ==0.2.3.12,
any.list-t ==1.0.4,
any.lockfree-queue ==0.2.3.1,
any.lzma ==0.0.0.3,
any.math-functions ==0.3.3.0,
math-functions +system-erf +system-expm1,
any.megaparsec ==8.0.0,
megaparsec -dev,
any.microstache ==1.0.1.1,
any.mmorph ==1.1.3,
any.monad-control ==1.0.2.3,
any.monad-logger ==0.3.32,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.monad-par ==0.3.5,
monad-par -chaselev -newgeneric,
any.monad-par-extras ==0.3.3,
any.mono-traversable ==1.0.15.1,
any.mtl ==2.2.2,
any.mwc-random ==0.14.0.0,
any.network ==3.1.1.1,
any.network-uri ==2.6.3.0,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.3,
any.openssl-streams ==1.2.2.0,
any.optics ==0.2,
any.optics-core ==0.2,
any.optics-extra ==0.2,
any.optics-th ==0.2,
any.optics-vl ==0.2,
any.optparse-applicative ==0.15.1.0,
any.parallel ==3.2.2.0,
any.parsec ==3.1.13.0,
any.parser-combinators ==1.2.1,
parser-combinators -dev,
any.pretty ==1.1.3.6,
any.pretty-terminal ==0.1.0.0,
any.prettyprinter ==1.6.1,
prettyprinter -buildreadme,
any.primitive ==0.7.0.1,
any.primitive-extras ==0.8,
any.primitive-unlifted ==0.1.3.0,
any.process ==1.6.5.0 || ==1.6.8.0,
any.profunctors ==5.5.2,
any.random ==1.1,
any.recursion-schemes ==5.1.3,
recursion-schemes +template-haskell,
any.regex-base ==0.94.0.0,
any.regex-posix ==0.96.0.0,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.3,
any.rts ==1.0,
any.safe ==0.3.18,
any.safe-exceptions ==0.1.7.0,
any.scientific ==0.3.6.2,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.4,
semigroupoids +comonad +containers +contravariant +distributive +doctests +tagged +unordered-containers,
any.semigroups ==0.19.1,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
any.sop-core ==0.5.0.0,
any.split ==0.2.3.4,
any.splitmix ==0.0.4,
splitmix -optimised-mixer +random,
any.statistics ==0.15.2.0,
any.stm ==2.5.0.0,
any.stm-chans ==3.0.0.4,
any.streaming-commons ==0.2.1.2,
streaming-commons -use-bytestring-builder,
any.streamly ==0.7.1,
streamly -debug -dev -examples -examples-sdl -fusion-plugin -has-llvm -inspection -no-charts -no-fusion -streamk,
any.streamly-bytestring ==0.1.2,
any.streamly-posix ==0.1.0.0,
any.strict-base ==0.4.0.0,
any.string-interpolate ==0.2.0.0,
any.syb ==0.7.1,
any.table-layout ==0.8.0.5,
any.tagged ==0.8.6,
tagged +deepseq +transformers,
any.tar-bytestring ==0.6.3.1,
any.tasty ==1.2.3,
tasty +clock,
any.tasty-quickcheck ==0.10.1.1,
any.template-haskell ==2.14.0.0,
any.terminal-progress-bar ==0.4.1,
any.terminal-size ==0.3.2.1,
any.text ==1.2.3.1,
any.text-conversions ==0.3.0,
any.text-short ==0.1.3,
text-short -asserts,
any.th-abstraction ==0.3.2.0,
any.th-expand-syns ==0.4.5.0,
any.th-lift ==0.8.1,
any.th-lift-instances ==0.1.14,
any.th-orphans ==0.13.9,
any.th-reify-many ==0.1.9,
any.these ==1.0.1,
these +aeson +assoc +quickcheck +semigroupoids,
any.time ==1.8.0.2 || ==1.9.3,
any.time-compat ==1.9.2.2,
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.5,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.6.0,
any.unbounded-delays ==0.1.1.0,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-compat ==0.5.2,
unix-compat -old-time,
any.unix-time ==0.4.7,
any.unliftio-core ==0.2.0.1,
any.unordered-containers ==0.2.10.0,
unordered-containers -debug,
any.uri-bytestring ==0.3.2.2,
uri-bytestring -lib-werror,
any.utf8-string ==1.0.1.1,
any.uuid-types ==1.0.3,
any.vector ==0.12.1.2,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.8.0.3,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-binary-instances ==0.2.5.1,
any.vector-builder ==0.3.8,
any.vector-th-unbox ==0.2.1.7,
any.versions ==3.5.3,
any.wcwidth ==0.0.2,
wcwidth -cli +split-base,
any.word8 ==0.1.3,
any.zlib ==0.6.2.1,
zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5

View File

@@ -1,9 +0,0 @@
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO
ifneq "$(BuildFlavour)" ""
include mk/flavours/$(BuildFlavour).mk
endif
Stage1Only = YES

View File

@@ -1,8 +0,0 @@
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES
ifneq "$(BuildFlavour)" ""
include mk/flavours/$(BuildFlavour).mk
endif

View File

@@ -1,67 +0,0 @@
# Cache downloads in ~/.ghcup/cache
cache: False
# Skip tarball checksum verification
no-verify: False
# enable verbosity
verbose: False
# When to keep build directories
keep-dirs: Errors # Always | Never | Errors
# Which downloader to use
downloader: Curl # Curl | Wget | Internal
# whether to run in offline mode
no-network: False
# whether/how to do gpg verification
gpg-setting: GPGNone # GPGStrict | GPGLax | GPGNone
# TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values.
key-bindings:
up:
KUp: []
down:
KDown: []
quit:
KChar: 'q'
install:
KChar: 'i'
uninstall:
KChar: 'u'
set:
KChar: 's'
changelog:
KChar: 'c'
show-all:
KChar: 'a'
show-all-tools:
KChar: 't'
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
url-source:
## Use the internal download uri, this is the default
GHCupURL: []
## Example 1: Read download info from this location instead
## Accepts file/http/https scheme
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
# AddSource:
# Left:
# toolRequirements: {} # this is ignored
# ghcupDownloads:
# GHC:
# 9.10.2:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
# dlSubdir: ghc-7.10.3
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
# AddSource:
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1 +0,0 @@
# Known BUGS

View File

@@ -1,10 +0,0 @@
<svg width="71" height="55" viewBox="0 0 71 55" fill="none" xmlns="http://www.w3.org/2000/svg">
<g clip-path="url(#clip0)">
<path d="M60.1045 4.8978C55.5792 2.8214 50.7265 1.2916 45.6527 0.41542C45.5603 0.39851 45.468 0.440769 45.4204 0.525289C44.7963 1.6353 44.105 3.0834 43.6209 4.2216C38.1637 3.4046 32.7345 3.4046 27.3892 4.2216C26.905 3.0581 26.1886 1.6353 25.5617 0.525289C25.5141 0.443589 25.4218 0.40133 25.3294 0.41542C20.2584 1.2888 15.4057 2.8186 10.8776 4.8978C10.8384 4.9147 10.8048 4.9429 10.7825 4.9795C1.57795 18.7309 -0.943561 32.1443 0.293408 45.3914C0.299005 45.4562 0.335386 45.5182 0.385761 45.5576C6.45866 50.0174 12.3413 52.7249 18.1147 54.5195C18.2071 54.5477 18.305 54.5139 18.3638 54.4378C19.7295 52.5728 20.9469 50.6063 21.9907 48.5383C22.0523 48.4172 21.9935 48.2735 21.8676 48.2256C19.9366 47.4931 18.0979 46.6 16.3292 45.5858C16.1893 45.5041 16.1781 45.304 16.3068 45.2082C16.679 44.9293 17.0513 44.6391 17.4067 44.3461C17.471 44.2926 17.5606 44.2813 17.6362 44.3151C29.2558 49.6202 41.8354 49.6202 53.3179 44.3151C53.3935 44.2785 53.4831 44.2898 53.5502 44.3433C53.9057 44.6363 54.2779 44.9293 54.6529 45.2082C54.7816 45.304 54.7732 45.5041 54.6333 45.5858C52.8646 46.6197 51.0259 47.4931 49.0921 48.2228C48.9662 48.2707 48.9102 48.4172 48.9718 48.5383C50.038 50.6034 51.2554 52.5699 52.5959 54.435C52.6519 54.5139 52.7526 54.5477 52.845 54.5195C58.6464 52.7249 64.529 50.0174 70.6019 45.5576C70.6551 45.5182 70.6887 45.459 70.6943 45.3942C72.1747 30.0791 68.2147 16.7757 60.1968 4.9823C60.1772 4.9429 60.1437 4.9147 60.1045 4.8978ZM23.7259 37.3253C20.2276 37.3253 17.3451 34.1136 17.3451 30.1693C17.3451 26.225 20.1717 23.0133 23.7259 23.0133C27.308 23.0133 30.1626 26.2532 30.1066 30.1693C30.1066 34.1136 27.28 37.3253 23.7259 37.3253ZM47.3178 37.3253C43.8196 37.3253 40.9371 34.1136 40.9371 30.1693C40.9371 26.225 43.7636 23.0133 47.3178 23.0133C50.9 23.0133 53.7545 26.2532 53.6986 30.1693C53.6986 34.1136 50.9 37.3253 47.3178 37.3253Z" fill="#23272A"/>
</g>
<defs>
<clipPath id="clip0">
<rect width="71" height="55" fill="white"/>
</clipPath>
</defs>
</svg>

Before

Width:  |  Height:  |  Size: 2.0 KiB

View File

@@ -1,7 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<svg version="1.1" viewBox="0 0 75 32" xmlns="http://www.w3.org/2000/svg" xmlns:cc="http://creativecommons.org/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
<title>Matrix (protocol) logo</title>
<g fill="#040404">
<path d="m0.936 0.732v30.52h2.194v0.732h-3.035v-31.98h3.034v0.732zm8.45 9.675v1.544h0.044a4.461 4.461 0 0 1 1.487-1.368c0.58-0.323 1.245-0.485 1.993-0.485 0.72 0 1.377 0.14 1.972 0.42 0.595 0.279 1.047 0.771 1.355 1.477 0.338-0.5 0.796-0.941 1.377-1.323 0.58-0.383 1.266-0.574 2.06-0.574 0.602 0 1.16 0.074 1.674 0.22 0.514 0.148 0.954 0.383 1.322 0.707 0.366 0.323 0.653 0.746 0.859 1.268 0.205 0.522 0.308 1.15 0.308 1.887v7.633h-3.127v-6.464c0-0.383-0.015-0.743-0.044-1.082a2.305 2.305 0 0 0-0.242-0.882 1.473 1.473 0 0 0-0.584-0.596c-0.257-0.146-0.606-0.22-1.047-0.22-0.44 0-0.796 0.085-1.068 0.253-0.272 0.17-0.485 0.39-0.639 0.662a2.654 2.654 0 0 0-0.308 0.927 7.074 7.074 0 0 0-0.078 1.048v6.354h-3.128v-6.398c0-0.338-7e-3 -0.673-0.021-1.004a2.825 2.825 0 0 0-0.188-0.916 1.411 1.411 0 0 0-0.55-0.673c-0.258-0.168-0.636-0.253-1.135-0.253a2.33 2.33 0 0 0-0.584 0.1 1.94 1.94 0 0 0-0.705 0.374c-0.228 0.184-0.422 0.449-0.584 0.794-0.161 0.346-0.242 0.798-0.242 1.357v6.619h-3.129v-11.41zm16.46 1.677a3.751 3.751 0 0 1 1.233-1.17 5.37 5.37 0 0 1 1.685-0.629 9.579 9.579 0 0 1 1.884-0.187c0.573 0 1.153 0.04 1.74 0.121 0.588 0.081 1.124 0.24 1.609 0.475 0.484 0.235 0.88 0.562 1.19 0.981 0.308 0.42 0.462 0.975 0.462 1.666v5.934c0 0.516 0.03 1.008 0.088 1.478 0.058 0.471 0.161 0.824 0.308 1.06h-3.171a4.435 4.435 0 0 1-0.22-1.104c-0.5 0.515-1.087 0.876-1.762 1.081a7.084 7.084 0 0 1-2.071 0.31c-0.544 0-1.05-0.067-1.52-0.2a3.472 3.472 0 0 1-1.234-0.617 2.87 2.87 0 0 1-0.826-1.059c-0.199-0.426-0.298-0.934-0.298-1.522 0-0.647 0.114-1.18 0.342-1.6 0.227-0.419 0.52-0.753 0.881-1.004 0.36-0.25 0.771-0.437 1.234-0.562 0.462-0.125 0.929-0.224 1.399-0.298 0.47-0.073 0.932-0.132 1.387-0.176 0.456-0.044 0.86-0.11 1.212-0.199 0.353-0.088 0.631-0.217 0.837-0.386s0.301-0.415 0.287-0.74c0-0.337-0.055-0.606-0.166-0.804a1.217 1.217 0 0 0-0.44-0.464 1.737 1.737 0 0 0-0.639-0.22 5.292 5.292 0 0 0-0.782-0.055c-0.617 0-1.101 0.132-1.454 0.397-0.352 0.264-0.558 0.706-0.617 1.323h-3.128c0.044-0.735 0.227-1.345 0.55-1.83zm6.179 4.423a5.095 5.095 0 0 1-0.639 0.165 9.68 9.68 0 0 1-0.716 0.11c-0.25 0.03-0.5 0.067-0.749 0.11a5.616 5.616 0 0 0-0.694 0.177 2.057 2.057 0 0 0-0.594 0.298c-0.17 0.125-0.305 0.284-0.408 0.474-0.103 0.192-0.154 0.434-0.154 0.728 0 0.28 0.051 0.515 0.154 0.706 0.103 0.192 0.242 0.342 0.419 0.453 0.176 0.11 0.381 0.187 0.617 0.231 0.234 0.044 0.477 0.066 0.726 0.066 0.617 0 1.094-0.102 1.432-0.309 0.338-0.205 0.587-0.452 0.75-0.739 0.16-0.286 0.26-0.576 0.297-0.87 0.036-0.295 0.055-0.53 0.055-0.707v-1.17a1.4 1.4 0 0 1-0.496 0.277zm11.86-6.1v2.096h-2.291v5.647c0 0.53 0.088 0.883 0.264 1.059 0.176 0.177 0.529 0.265 1.057 0.265 0.177 0 0.345-7e-3 0.507-0.022 0.161-0.015 0.316-0.037 0.463-0.066v2.426a7.49 7.49 0 0 1-0.882 0.089 21.67 21.67 0 0 1-0.947 0.022c-0.484 0-0.944-0.034-1.377-0.1a3.233 3.233 0 0 1-1.145-0.386 2.04 2.04 0 0 1-0.782-0.816c-0.191-0.353-0.287-0.816-0.287-1.39v-6.728h-1.894v-2.096h1.894v-3.42h3.129v3.42h2.29zm4.471 0v2.118h0.044a3.907 3.907 0 0 1 1.454-1.754 4.213 4.213 0 0 1 1.036-0.497 3.734 3.734 0 0 1 1.145-0.176c0.206 0 0.433 0.037 0.683 0.11v2.912a5.862 5.862 0 0 0-0.528-0.077 5.566 5.566 0 0 0-0.595-0.033c-0.573 0-1.058 0.096-1.454 0.287a2.52 2.52 0 0 0-0.958 0.783 3.143 3.143 0 0 0-0.518 1.158 6.32 6.32 0 0 0-0.154 1.434v5.14h-3.128v-11.4zm5.684-1.765v-2.582h3.128v2.582h-3.127zm3.128 1.765v11.4h-3.127v-11.4h3.128zm1.63 0h3.569l2.005 2.978 1.982-2.978h3.459l-3.745 5.339 4.208 6.067h-3.57l-2.378-3.596-2.38 3.596h-3.502l4.097-6.001zm15.3 20.84v-30.52h-2.194v-0.732h3.035v31.98h-3.035v-0.732z"/>
</g>
</svg>

Before

Width:  |  Height:  |  Size: 3.8 KiB

View File

@@ -1,36 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg
height="800.3468"
width="733.88495"
version="1.1"
id="svg4"
sodipodi:docname="Octicons-bug.svg"
inkscape:version="1.1 (c68e22c387, 2021-05-23)"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg">
<defs
id="defs8" />
<sodipodi:namedview
id="namedview6"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageshadow="2"
inkscape:pageopacity="0.0"
inkscape:pagecheckerboard="0"
showgrid="false"
inkscape:zoom="0.85253906"
inkscape:cx="367.1386"
inkscape:cy="432.23826"
inkscape:window-width="3828"
inkscape:window-height="2081"
inkscape:window-x="0"
inkscape:window-y="46"
inkscape:window-maximized="1"
inkscape:current-layer="svg4" />
<path
d="m 243.6206,76.877783 c -52.874,56.780997 -38.281,147.468997 -38.281,147.468997 0,0 53.968,64 160,64 106.031,0 160.031,-64 160.031,-64 0,0 14.375,-89.469 -37.375,-146.311997 32.375,-18.031 51.438,-44.094 43.562,-61.812 -8.938,-19.9689999 -48.375,-21.7499999 -88.25,-3.969 -14.812,6.594 -27.438,14.969 -37.25,23.875 -12.438,-2.25 -25.625,-3.781 -40.72,-3.781 -14.061,0 -26.561,1.344 -38.344,3.25 -9.656,-8.75 -22.062,-16.875 -36.531,-23.344 -39.875,-17.7189999 -79.375,-15.9379999 -88.25,3.969 -7.748,17.343 10.284,42.686 41.408,60.655 z m 401.125,413.218997 c -8.25,-1.75 -16.125,-2.75 -23.75,-3.5 0,-2.125 0.375,-4.125 0.375,-6.312 0,-33.594 -4.75,-65.654 -12.438,-96.125 16.438,1.406 37.375,-2.375 58.562,-11.779 39.875,-17.781 65,-48.375 56.125,-68.219 -8.875,-19.969 -48.375,-21.75 -88.25,-3.969 -18.625,8.312 -33.812,19.469 -44,30.906 -7.75,-18.25 -16.5,-35.781 -26.812,-51.719 -30.188,25.156 -87.312,62.719 -167.062,71.062 v 321.781 c 0,0 -0.25,32 -32.031,32 -31.75,0 -32,-32 -32,-32 v -321.657 c -79.811,-8.344 -136.968,-45.969 -167.093,-71.062 -9.875,15.312 -18.375,32 -25.938,49.344 -10.281,-10.625 -24.625,-20.844 -41.969,-28.594 -39.875,-17.719 -79.375,-15.938 -88.25,3.969 -8.9060001,19.906 16.25,50.438 56.125,68.219 19.844,8.846 39.531,12.812 55.469,12.096 -7.656,30.404 -12.469,62.344 -12.469,95.812 0,2.188 0.375,4.25 0.438,6.5 -6.719,0.75 -13.688,1.75 -20.781,3.25 -51.969,10.75 -91.7810001,37.625 -88.84400014,59.812 2.93800004,22.312 47.50000014,31.5 99.59400014,20.688 6.781,-1.375 13.438,-3.125 19.781,-5.062 9.156,40.809 23.812,78.684 44.094,111.309 -12.031,6.062 -24.531,15 -36.031,26.625 -31.876,31.875 -44.812,70.625 -28.876,86.563 15.938,15.937 54.656,3 86.531,-28.812 9.344,-9.375 16.844,-19.25 22.656,-29 43.532,42.624 98.063,68.124 157.563,68.124 60.343,0 115.781,-26.25 159.531,-69.938 5.875,10.312 13.75,20.812 23.625,30.688 31.812,31.875 70.625,44.812 86.562,28.875 15.937,-15.937 3,-54.625 -28.875,-86.5 -12.312,-12.375 -25.688,-21.75 -38.438,-27.938 20.125,-32.5 34.625,-70.375 43.688,-111.062 7.188,2.25 14.688,4.375 22.562,6.062 52.061,10.812 96.625,1.562 99.625,-20.688 2.813,-22.124 -36.999,-48.999 -88.999,-59.749 z"
id="path2" />
</svg>

Before

Width:  |  Height:  |  Size: 3.1 KiB

View File

@@ -1,39 +0,0 @@
# TODOs and Remarks
## Now
* ghcup init?
* merge two download files
* fetch/unpack functionality
* installing multiple versions of the same
* post-install
* proper test suite
* !! update of 0.1.5 must go in ghcup-0.0.1.json !!
* try to run exe before upgrade (backup to ~/.ghcup/bin/ghcup.old)
* stdout flushing?
* resume support (for make-install only)
## Maybe
* version ranges in json
* sign the JSON? (Or check gpg keys?)
* testing (especially distro detection -> unit tests)
## Later
* add support for RC/alpha/HEAD versions
## Cleanups
* avoid alternative for IO
* use plucky or oops instead of Excepts
## Questions
* move out GHCup.Version module, bc it's not library-ish?
* mirror support
* interactive handling when distro doesn't exist and we know the tarball is incompatible?
* ghcup-with wrapper to execute a command with a given ghc in PATH?

View File

@@ -1,221 +0,0 @@
# About
All you wanted to know about GHCup.
## Team
### Author and Maintainer
* [Julian Ospald](https://github.com/hasufell) (aka: maerwald, hasufell)
### Collaborators
* [Arjun Kathuria](https://github.com/arjunkathuria)
* [Ben Gamari](https://github.com/bgamari)
* [Javier Neira](https://github.com/jneira)
### Contributors
* amesgen
* Chris Smith
* Anton-Latukha
* Brian McKenna
* Huw campbell
* Tom Ellis
* Sigmund Vestergaard
* Ron Toland
* Paolo Martini
* Mario Lang
* Jan Hrček
* vglfr
* Fendor
* Enrico Maria De Angelis
* Emily Pillmore
* Colin Barrett
* Artur Gajowy
### Sponsors
* All [opencollective](https://opencollective.com/ghcup#category-CONTRIBUTE) contributors
* [haskell.org](https://www.haskell.org/haskell-org-committee/) via CI and infrastructure
* [Haskell Foundation](https://haskell.foundation/affiliates/) via affiliation
## How to help
* if you are a developer, check out the [issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues) and the [Development guide](./dev.md)
* if you want to donate to the project, visit our [opencollective](https://opencollective.com/ghcup#category-CONTRIBUTE) page
## Design goals
1. simplicity
2. non-interactive CLI interface
3. portable
4. do one thing and do it well (UNIX philosophy)
## Non-goals
1. invoking `sudo`, `apt-get` or *any* package manager
2. handling system packages
3. handling cabal projects
4. being a stack alternative
## How
Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.
Optionally, an unversioned `ghc` link can point to a default version of your choice.
This uses precompiled GHC binaries that have been compiled on fedora/debian by [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries).
Alternatively, you can also tell it to compile from source (note that this might fail due to missing requirements).
cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have unversioned symlinks to the latest version by default (`~/.ghcup/bin/<tool>-<ver>`).
## Known users
* Github actions:
- [actions/virtual-environments](https://github.com/actions/virtual-environments)
- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
* mirrors:
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
* tools:
- [vabal](https://github.com/Franciman/vabal)
## Known problems
### Custom ghc version names
When installing ghc bindists with custom version names as outlined in
[installing custom bindists](#installing-custom-bindists), then cabal might
be unable to find the correct `ghc-pkg` (also see [#73](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/73))
if you use `cabal build --with-compiler=ghc-foo`. Instead, point it to the full path, such as:
`cabal build --with-compiler=$HOME/.ghcup/ghc/<version-name>/bin/ghc` or set that GHC version
as the current one via: `ghcup set ghc <version-name>`.
This problem doesn't exist for regularly installed GHC versions.
### Limited distributions supported
Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.
### Precompiled binaries
Since this uses precompiled binaries you may run into
several problems.
#### Missing libtinfo (ncurses)
You may run into problems with *ncurses* and **missing libtinfo**, in case
your distribution doesn't use the legacy way of building
ncurses and has no compatibility symlinks in place.
Ask your distributor on how to solve this or
try to compile from source via `ghcup compile <version>`.
#### Libnuma required
This was a [bug](https://ghc.haskell.org/trac/ghc/ticket/15688) in the build system of some GHC versions that lead to
unconditionally enabled libnuma support. To mitigate this you might have to install the libnuma
package of your distribution. See [here](https://gitlab.haskell.org/haskell/ghcup/issues/58) for a discussion.
### Compilation
Although this script can compile GHC for you, it's just a very thin
wrapper around the build system. It makes no effort in trying
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
### 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.
### Why should I use ghcup over stack?
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.
### 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?
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. it doesn't support cabal installation, which was the main motivation behind GHCup back then
3. 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
4. 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.
### 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.
### 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.

View File

@@ -1,336 +0,0 @@
h2
{
border-bottom:1px solid #CCC;
padding-bottom:5px;
padding-top:15px;
}
h1 {
text-align: center;
font-size: 60px;
font-weight: 300;
padding-top:15px;
}
h3 {
font-size: 30px;
padding-top:10px;
}
h4 {
font-size: 25px;
padding-top:10px;
}
.index-ghcup-hero {
display: flex;
flex-direction: row;
justify-content: center;
align-items: center;
}
.index-ghcup-hero img {
width: 10%;
min-width: 110px;
max-width: 120px;
border: none;
margin: 0;
}
.index-ghcup-hero h1 {
}
div.col-md-9 h1:first-of-type {
text-align: center;
font-size: 60px;
font-weight: 300;
}
div.col-md-9>p:first-of-type {
text-align: center;
}
div.col-md-9 p.admonition-title:first-of-type {
text-align: left;
}
div.col-md-9 h1:first-of-type .headerlink {
display: none;
}
code.no-highlight {
color: black;
}
div.gh-badge img {
margin: 0;
padding: 0;
height: 25px;
}
/* Definition List styles */
dd {
padding-left: 20px;
}
/* Homepage */
body.homepage div.jumbotron {
margin-top: 1.5rem;
padding-top: 1rem;
padding-bottom: 0;
}
body.homepage div.jumbotron div.card {
margin-bottom: 2rem;
}
body.homepage>div.container div.col-md-3 {
display: none;
}
body.homepage>div.container div.col-md-9 {
/* margin-left: 0; */
/* padding-left: 0; */
flex: 0 0 100%;
max-width: 100%;
}
.center {
display: block !important;
}
.bg-primary {
background-image: -webkit-gradient(linear, left top, left bottom, from(#996FC2), color-stop(60%, #6A478D), to(#5E5086)) !important;
background-image: linear-gradient(#996FC2, #6A478D 60%, #5E5086) !important;
background-repeat: no-repeat !important;
}
.btn-primary {
background-image: -webkit-gradient(linear, left top, left bottom, from(#996FC2), color-stop(60%, #6A478D), to(#5E5086)) !important;
background-image: linear-gradient(#996FC2, #6A478D 60%, #5E5086) !important;
background-repeat: no-repeat !important;
color: #fff;
background-color: #996FC1;
border-color: #996FC1;
border-bottom: 1px solid #453A62;
}
.navbar {
background-image: -webkit-gradient(linear, left top, left bottom, from(#996FC2), color-stop(60%, #6A478D), to(#5E5086)) !important;
background-image: linear-gradient(#996FC2, #6A478D 60%, #5E5086) !important;
background-repeat: no-repeat !important;
color: #fff;
background-color: #996FC1;
border-color: #996FC1;
border-bottom: 1px solid #453A62;
}
a {
color: #996FC2;
}
a:hover {
color: #674489;
}
.col-md-9 img.main-logo {
border: 0px;
padding: 0px;
margin: 0px;
}
.navbar-default .navbar-nav>.active>a, .navbar-default .navbar-nav>.active>a:hover, .navbar-default .navbar-nav>.active>a:focus {
color: #fff;
background-color: #453A62;
border-color: #996FC1;
}
.navbar-default .navbar-nav>li>a:hover, .navbar-default .navbar-nav>li>a:focus {
color: #fff;
background-color: #453A62;
}
.ghcup-intro {
text-align: center;
}
.main-buttons {
display: flex;
align-items: center;
flex-wrap: wrap;
justify-content: center;
}
.main-buttons a {
margin-right: 5px;
margin-bottom: 5px;
}
.command-button {
display: flex;
align-items: center;
}
.command-button > pre {
flex: 0 1 80%;
margin: 0;
padding: 10px;
text-align: center;
background-color: #515151;
color: white;
border-radius: 3px;
box-shadow: inset 0px 0px 20px 0px #333333;
font-size: 1em;
white-space: nowrap;
overflow: auto;
}
.ghcup-command:before {
color: #999;
content: " $ ";
margin-left: 15px;
}
div.command-button {
display: flex;
align-items: center;
justify-content: center;
}
.command-button pre {
}
div.command-button button {
color: #515151;
background: rgb(230, 230, 230);
border: 1px solid grey;
margin: 0 0 0 10px;
padding: 10px;
flex-basis: 0 0 20%;
}
div.command-button button .fa {
font-size: x-large;
}
div.command-button button:hover {
background: rgb(220, 220, 220);
color: black;
border: 1px solid black;
}
div.command-button button:focus {
background-color: #04aa6d;
}
footer > hr {
border-top: 0.5px solid #CCC;
}
.qi-container {
display: flex;
flex-direction: column;
align-items: center;
box-sizing: border-box;
padding: 0.75rem;
background-color: rgb(250, 250, 250);
margin-top: 2rem;
margin-bottom: 2rem;
margin-left: auto;
margin-right: auto;
border-radius: 3px;
border: 1px solid rgb(204, 204, 204);
box-shadow:
4px 8px 10px -6px rgb(204, 204, 204),
4px 8px 10px -6px rgb(153, 111, 194);
}
@media only screen and (max-width:1000px) {
.qi-container {
box-shadow:
4px 10px 10px -6px rgb(204, 204, 204),
4px 10px 10px -9px rgb(153, 111, 194);
}
}
.index-cta-donate .donate-button a {
position: absolute;
top:0;
left: 0;
width: 100%;
height: 100%;
}
.index-cta-donate .donate-button {
margin: 10px auto;
position: relative;
display: block;
background: none;
padding: none;
border: none;
background: url("https://opencollective.com/webpack/donate/button@2x.png?color=blue");
width: 35%;
min-width: 240px;
max-width: 280px;
height: 40px;
background-size: contain;
background-repeat: no-repeat;
}
.ghcup-os-container {
width: 100%;
margin: 10px 0;
}
.ghcup-os-container > * {
text-align: center;
}
/* fix list overflows (esp about page) */
ul > li {
overflow-wrap: anywhere;
}
.footer {
color: grey;
font-size: 0.7em;
margin-top: 1rem;
margin-bottom: 1rem;
}
.footer div.show-all-platforms {
display: inline-block;
}
#help, #collective {
margin-bottom: 0px;
display: block;
margin-left: auto;
margin-right: auto;
margin-top: 15px;
text-align: center;
}
#help img {
border: none;
margin: 0px;
height: 24px;
}
#collective img {
border: none;
margin: 0px;
}
#collective {
margin-top: 10px;
}

View File

@@ -1,120 +0,0 @@
# Development
All you wanted to know about GHCup development.
## Module graph
[![Module graph](./modules_small.svg){: .center style="width:900px"}](./modules_wide.svg)
Main functionality is in `GHCup` module. Utility functions are
organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
Anything dealing with ghcup specific directories is in
`GHCup.Utils.Dirs`.
Download information on where to fetch bindists from is in the appropriate
yaml files: `data/metadata/ghcup-<yaml-ver>.yaml`.
## Design decisions
### Using [Excepts](https://hackage.haskell.org/package/haskus-utils-variant-3.0/docs/Haskus-Utils-Variant-Excepts.html) as a beefed up ExceptT
This is an open variant, similar to [plucky](https://hackage.haskell.org/package/plucky) or [oops](https://github.com/i-am-tom/oops) and allows us to combine different error types. Maybe it is too much and it's a little bit [unergonomic](https://github.com/haskus/packages/issues/32) at times. If it really hurts maintenance, it will be removed. It was more of an experiment.
### No use of haskell-TLS
I consider haskell-TLS an interesting experiment, but not a battle-tested and peer-reviewed crypto implementation. There is little to no research about what the intricacies of using haskell for low-level crypto are and how vulnerable such binaries are. Instead, we use either curl the binary or wget. There's also an implementation based on OpenSSL bindings, but it isn't enabled by default, since it would complicate shipping static binaries.
### Optics instead of lens
They're a little safer (less Monoid weirdness with view) and have better error messages. Consider the following with [lens](https://hackage.haskell.org/package/lens):
```
> view (_Just . to (++ "abc")) Nothing
""
```
vs [optics](https://hackage.haskell.org/package/optics):
```
> view (_Just % to (++ "abc")) Nothing
<interactive>:2:1: error:
• An_AffineFold cannot be used as A_Getter
• In the expression: view (_Just % to (++ "abc")) Nothing
In an equation for it: it = view (_Just % to (++ "abc")) Nothing
```
### StrictData on by default
Kazu Yamamoto [explained it in his PR](https://github.com/yesodweb/wai/pull/752#issuecomment-501531386) very well. I like to agree with him. The instances where we need non-strict behavior, we annotate it.
`Strict` is a little more odd as a default, since it depends on how you define your functions as well.
## Code style and formatting
Unfortunately, code formatters are semi-broken on this codebase, due to TH and CPP.
Some light suggestions:
1. mtl-style preferred
2. no overly pointfree style
3. use `where` a lot, so the main function body reads like prose
4. documentation is part of the code
## Common Tasks
### Adding a new GHC version
1. open the latest `data/metadata/ghcup-<yaml-ver>.yaml`
2. find the latest ghc version (in yaml tree e.g. `ghcupDownloads -> GHC -> 8.10.7`)
3. copy-paste it
4. adjust the version, tags, changelog, source url
5. adjust the various bindist urls (make sure to also change the yaml anchors)
6. run `cabal run exe:ghcup-gen -- check -f data/metadata/ghcup-<yaml-ver>.yaml`
7. run `cabal run exe:ghcup-gen -- check-tarballs -f data/metadata/ghcup-<yaml-ver>.yaml -u 'ghc-8\.10\.8'`
### Adding a new CLI command
An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
## Major refactors
1. First major refactor included adding cross support. This added
`GHCTargetVersion`, which includes the target in addition to the version.
Most of the `Version` parameters to functions had to be replaced with
that and ensured the logic is consistent for cross and non-cross
installs.
2. This refactor added windows support wrt [#130](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/130).
The major changes here were switching `hpath` library out for `filepath`/`directory` (sadly) and
introducing a non-unix way of handling processes via the `process` library. It also introduced considerable
amounts of CPP wrt file handling, installation etc.
# Releasing
1. Update version in `ghcup.cabal` and `boostrap-haskell` (`ghver` variable at the top of the script)
2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`.
3. Add ChangeLog entry
4. Add/fix downloads in `ghcup-<ver>.yaml` (under `data/metadata`), then verify with `ghcup-gen check -f data/metadata/ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f data/metadata/ghcup-<ver>.yaml -u 'ghc-8.10.7'`. Generally, new GHC/cabal/stack/hls versions are only added to the latest yaml file. New GHCup versions are added to all (great care must be taken here to not break the parser... e.g. ARM platforms don't parse in all older formats).
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
6. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`)
7. Add ghcup release artifacts to ALL yaml files (see point 4.)
8. Upload the final `data/metadata/ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/`.
9. Update `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
10. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup`
11. Post on reddit/discourse/etc. and collect rewards
# Documentation
This documentation page is built via [mkdocs](https://www.mkdocs.org/), see `mkdocs.yml` and `docs/` subfolder.
The module graph needs [graphmod](https://github.com/yav/graphmod) and is generated via `scripts/dev/modgraph.sh`.

View File

@@ -1,65 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
width="158.21451"
height="33.036404"
id="svg2997"
version="1.1"
inkscape:version="0.48.5 r10040"
sodipodi:docname="expand-piece.svg">
<defs
id="defs2999" />
<sodipodi:namedview
id="base"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageopacity="0.0"
inkscape:pageshadow="2"
inkscape:zoom="11.2"
inkscape:cx="74.534935"
inkscape:cy="-6.6497355"
inkscape:document-units="px"
inkscape:current-layer="layer1"
showgrid="false"
fit-margin-top="0"
fit-margin-left="0"
fit-margin-right="0"
fit-margin-bottom="0"
inkscape:window-width="2560"
inkscape:window-height="1374"
inkscape:window-x="0"
inkscape:window-y="27"
inkscape:window-maximized="1" />
<metadata
id="metadata3002">
<rdf:RDF>
<cc:Work
rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
<dc:title />
</cc:Work>
</rdf:RDF>
</metadata>
<g
inkscape:label="Layer 1"
inkscape:groupmode="layer"
id="layer1"
transform="translate(-218.01937,-324.40519)">
<path
style="fill:none;stroke:#524a67;stroke-width:13;stroke-linecap:round;stroke-linejoin:bevel;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
d="m 224.64286,330.93361 74.64102,20 70.35898,-18.85263"
id="path2994"
inkscape:connector-curvature="0" />
</g>
</svg>

Before

Width:  |  Height:  |  Size: 2.0 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 198 KiB

View File

@@ -1,307 +0,0 @@
# User Guide
`ghcup --help` is your friend.
## Basic usage
For the simple interactive TUI (not available on windows), run:
```sh
ghcup tui
```
For the full functionality via cli:
```sh
# list available ghc/cabal versions
ghcup list
# install the recommended GHC version
ghcup install ghc
# install a specific GHC version
ghcup install ghc 8.2.2
# set the currently "active" GHC version
ghcup set ghc 8.4.4
# install cabal-install
ghcup install cabal
# update ghcup itself
ghcup upgrade
```
## Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
explaining all possible configurations can be found in this repo: [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml).
Partial configuration is fine. Command line options always override the config file settings.
## Manpages
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
`MANPATH` may be required to be unset.
## Shell-completion
Shell completions are in [scripts/shell-completions](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/shell-completions) directory of this repository.
For bash: install `shell-completions/bash`
as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros).
## Compiling GHC from source
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`
for a list of all available options.
If you need to overwrite the existing `build.mk`, check the default files
in [data/build_mk](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/data/build_mk), copy them somewhere, adjust them and
pass `--config path/to/build.mk` to `ghcup compile ghc`.
Common `build.mk` options are explained [here](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/using#build-configuration).
Make sure your system meets all the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparation).
### Cross support
ghcup can compile and install a cross GHC for any target. However, this
requires that the build host has a complete cross toolchain and various
libraries installed for the target platform.
Consult the GHC documentation on the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#tools-to-install).
For distributions with non-standard locations of cross toolchain and
libraries, this may need some tweaking of `build.mk` or configure args.
See `ghcup compile ghc --help` for further information.
## XDG support
To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIRS` to anything.
Then you can control the locations via XDG environment variables as such:
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir (default: `~/.local/share`)
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir (default: `~/.cache`)
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
* `XDG_CONFIG_HOME`: the config file is stored in `ghcup` subdir as `config.yaml` (default: `~/.config`)
**Note that `ghcup` makes some assumptions about structure of files in `XDG_BIN_HOME`. So if you have other tools
installing e.g. stack/cabal/ghc into it, this will likely clash. In that case consider disabling XDG support.**
## Env variables
This is the complete list of env variables that change GHCup behavior:
* `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
* `TMPDIR`: where ghcup does the work (unpacking, building, ...)
* `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
* `GHCUP_CURL_OPTS`: additional options that can be passed to curl
* `GHCUP_WGET_OPTS`: additional options that can be passed to wget
* `GHCUP_GPG_OPTS`: additional options that can be passed to gpg
* `GHCUP_SKIP_UPDATE_CHECK`: Skip the (possibly annoying) update check when you run a command
* `CC`/`LD` etc.: full environment is passed to the build system when compiling GHC via GHCup
## Installing custom bindists
There are a couple of good use cases to install custom bindists:
1. manually built bindists (e.g. with patches)
- example: `ghcup install ghc -u 'file:///home/mearwald/tmp/ghc-eff-patches/ghc-8.10.2-x86_64-deb10-linux.tar.xz' 8.10.2-eff`
2. GHC head CI bindists
- example: `ghcup install ghc -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
3. DWARF bindists
- example: `ghcup install ghc -u 'https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux-dwarf.tar.xz' 8.10.2-dwarf`
Since the version parser is pretty lax, `8.10.2-eff` and `head` are both valid versions
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).
## Isolated installs
Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.
These installs, as the name suggests, are separate from your main installs and DO NOT conflict with them.
- No symlinks are made to these isolated installed tools, you'd have to manually point to them wherever you intend to use them.
- These installs, can also NOT be deleted from ghcup, you'd have to go and manually delete these.
You need to use the `--isolate` or `-i` flag followed by the directory path.
Examples:
1. install an isolated GHC version at location /home/user/isolated_dir/ghc/
- `ghcup install ghc 8.10.5 --isolate /home/user/isolated_dir/ghc`
2. isolated install Cabal at a location you desire
- `ghcup install cabal --isolate /home/username/my_isolated_dir/`
3. do an isolated install with a custom bindist
- `ghcup install ghc --isolate /home/username/my_isolated_dir/ -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
4. isolated install HLS
- `ghcup install hls --isolate /home/username/dir/hls/`
5. you can even compile ghc to an isolated location.
- `ghcup compile ghc -j 4 -v 9.0.1 -b 8.10.5 -i /home/username/my/dir/ghc`
## Continuous integration
On windows, ghcup can be installed automatically on a CI runner non-interactively like so:
```ps
Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
```
On linux/darwin/freebsd, run the following on your runner:
```sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
```
This will just install `ghcup` and on windows additionally `msys2`.
For the full list of env variables and parameters to tweak the script behavior, see:
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
### Example github workflow
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/)
If you want to install ghcup manually though, here's an example config:
```yml
name: Haskell CI
on:
push:
branches: [ master ]
pull_request:
branches: [ master ]
jobs:
build-cabal:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-latest, macOS-latest, windows-latest]
ghc: ['8.10.7', '9.0.1']
cabal: ['3.4.0.0']
steps:
- uses: actions/checkout@v2
- if: matrix.os == 'windows-latest'
name: Install ghcup on windows
run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
- if: matrix.os == 'windows-latest'
name: Add ghcup to PATH
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
shell: bash
- if: matrix.os != 'windows-latest'
name: Install ghcup on non-windows
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
- name: Install ghc/cabal
run: |
ghcup install ghc ${{ matrix.ghc }}
ghcup install cabal ${{ matrix.cabal }}
shell: bash
- name: Update cabal index
run: cabal update
shell: bash
- name: Build
run: cabal build --enable-tests --enable-benchmarks
shell: bash
- name: Run tests
run: cabal test
shell: bash
```
## GPG verification
GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so
this is cryptographically secure.
First, obtain the gpg key:
```sh
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
```
Then verify the gpg key in one of these ways:
1. find out where I live and visit me to do offline key signing
2. figure out my mobile phone number and call me to verify the fingerprint
3. more boring: contact me on Libera IRC (`maerwald`) and verify the fingerprint
Once you've verified the key, you have to figure out if you trust me.
If you trust me, then you can configure gpg in `~/.ghcup/config.yaml`:
```yml
gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
```
In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
## 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.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 93 KiB

View File

@@ -1,77 +0,0 @@
---
hide:
- navigation
- toc
---
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
<script src="javascripts/extra.js"></script>
<section class="index-ghcup-hero">
<img alt="haskell logo" src="./haskell_logo.png" />
<h1>GHCup</h1>
</section>
<p class="ghcup-intro">GHCup is an installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p>
<div class="text-center main-buttons">
<a href="install/" class="btn btn-primary" role="button">Getting Started</a>
<a href="guide/" class="btn btn-primary" role="button">User Guide</a>
<a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/issues" class="btn btn-primary" role="button">Issue tracker</a>
</div>
<section class="qi-container">
<div class="ghcup-os-container" id="ghcup-instructions-unix">
<h3>To install on Linux, macOS, FreeBSD or <a href="https://docs.microsoft.com/en-us/windows/wsl/"> WSL2</a></h3>
<p>run the following in a terminal (as a non-root user):<p>
<div class="command-button">
<pre>
<span class="ghcup-command" id="ghcup-command-linux">curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh</span>
</pre>
<button class="btn" onclick="copyToClipboardNux()" id="ghcup-linux-button"><i class="fa fa-copy"></i></button>
</div>
<span>
</span>
<div class="footer">
<a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
</div>
</div>
<div class="ghcup-os-container" id="ghcup-instructions-win">
<h3>To install on Windows</h3>
<p>run the following in a PowerShell session (as a non-admin user):<p>
<div class="command-button">
<pre>
<span class="ghcup-command" id="ghcup-command-windows">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>
</pre>
<button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
</div>
<div class="footer">
<a href="https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
</div>
</div>
</section>
<section class="index-cta-donate">
<button class="donate-button">
<a href="https://opencollective.com/ghcup#category-CONTRIBUTE" class="donate-badge" />
</a>
</button>
</section>
----
![GHCup](./ghcup.gif){: .center style="width:700px"}
<p id="help">
Need help? Ask on
<a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup">
<img src="irc.svg" alt="" />IRC</a>,
<a href="https://discord.gg/pKYf3zDQU7"><img src="Discord-Logo-Black.svg" alt="" />Discord</a>, <a href="https://app.element.io/#/room/#haskell-tooling:matrix.org"><img src="Matrix_logo.svg" alt=""/></a> or <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">report a bug <img src="Octicons-bug.svg" alt="" /></a>
</p>
<script type="text/javascript" src="javascripts/ghcup.js"></script>

View File

@@ -1,122 +0,0 @@
# Getting started
GHCup makes it easy to install specific versions of GHC on GNU/Linux,
macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
It follows the unix UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
## Installation
The following commands will download the `ghcup` binary into `~/.ghcup/bin` (or `C:\ghcup\bin` on windows) and then
run it to interactively install the [Haskell Toolchain](#supported-tools). These commands should be run as **non-root/non-admin
user**.
For Linux, macOS, FreeBSD or Windows Subsystem 2 for Linux, run this in a terminal:
```sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
```
For Windows, run this in a PowerShell session:
```psh
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
```
If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
## First steps
1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/latest/getting-started.html) guide
2. To properly learn Haskell, run through the [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises
3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
## Uninstallation
On linux, just run `ghcup nuke`, then make sure any ghcup added lines in your `~/.bashrc` (or similar) are removed.
On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on your Desktop.
## Supported tools
GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
1. [GHC](https://www.haskell.org/ghc/)
2. [cabal-install](https://cabal.readthedocs.io/en/latest/)
3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/latest/)
4. [stack](https://docs.haskellstack.org/en/latest/README/)
## Supported platforms
This list may not be exhaustive and specifies support for bindists only.
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| ------ | ------ | ------ | ------ | ------ | ------ | ------ |
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2016 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2019 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows Server 2022 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Windows WSL1 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
| Windows WSL2 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| MacOS >=10.13 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| MacOS <10.13 | amd64 | ❌ | ❔ | ❔ | ❔ | ❔ |
| MacOS | aarch64 | ✅ | ✅ | ✅ | ⚠️ | ❌ |
| FreeBSD | amd64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
| Linux generic | x86 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Linux generic | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |
| Linux generic | aarch64 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
| Linux generic | armv7 | ✅ | ⚠️ | ✅ | ⚠️ | ❌ |
### Windows 7
May or may not work, several issues:
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140)
* [https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197)
### WSL1
Unsupported. GHC may or may not work. Upgrade to WSL2.
### MacOS <13
Not supported. Would require separate binaries, since >=13 binaries are incompatible.
Please upgrade.
### MacOS aarch64
HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
### FreeBSD
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
HLS bindists are experimental.
### Linux ARMv7/AARCH64
Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
## Manual install
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following key first: `7784930957807690A66EBDBE3786C5262ECB4A3F`.
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
```sh
export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
```
## Vim integration
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
## Get help
* [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
* [GHCup issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/issues)
* [Matrix](https://app.element.io/#/room/#haskell-tooling:matrix.org)
* [Discord](https://discord.gg/pKYf3zDQU7)

View File

@@ -1,38 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg
height="18.043058"
viewBox="0 0 18 18.043058"
width="18"
version="1.1"
id="svg4"
sodipodi:docname="irc.svg"
inkscape:version="1.1 (c68e22c387, 2021-05-23)"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg">
<defs
id="defs8" />
<sodipodi:namedview
id="namedview6"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageshadow="2"
inkscape:pageopacity="0.0"
inkscape:pagecheckerboard="0"
showgrid="false"
inkscape:zoom="36.375"
inkscape:cx="3.3814433"
inkscape:cy="9.0309278"
inkscape:window-width="3828"
inkscape:window-height="2081"
inkscape:window-x="0"
inkscape:window-y="46"
inkscape:window-maximized="1"
inkscape:current-layer="svg4" />
<path
class="heroicon-ui"
d="m 8.03,5.0375961 h 3.94 l 1.06,-4.23999995 a 1,1 0 1 1 1.94,0.47999995 l -0.94,3.76 H 17 a 1,1 0 0 1 0,2 h -3.47 l -1,3.9999999 H 15 a 1,1 0 1 1 0,2 h -2.97 l -1.06,4.25 a 1.0004624,1.0004624 0 1 1 -1.94,-0.49 l 0.94,-3.76 H 6.03 l -1.06,4.25 a 1.0004624,1.0004624 0 1 1 -1.94,-0.49 l 0.94,-3.76 H 1 a 1,1 0 0 1 0,-2 h 3.47 l 1,-3.9999999 H 3 a 1,1 0 0 1 0,-2 H 5.97 L 7.03,0.79759615 A 1,1 0 1 1 8.97,1.2775961 Z m -0.5,2 -1,3.9999999 h 3.94 l 1,-3.9999999 z"
id="path2" />
</svg>

Before

Width:  |  Height:  |  Size: 1.5 KiB

View File

@@ -1,119 +0,0 @@
var platforms = ["win", "unix"];
var platform_override = null;
function detect_platform() {
"use strict";
if (platform_override !== null) {
return "unknown";
}
var os = "unknown";
if (navigator.platform == "Linux x86_64") {os = "unix";}
if (navigator.platform == "Linux i686") {os = "unix";}
if (navigator.platform == "Linux i686 on x86_64") {os = "unix";}
if (navigator.platform == "Linux aarch64") {os = "unix";}
if (navigator.platform == "Linux armv6l") {os = "unix";}
if (navigator.platform == "Linux armv7l") {os = "unix";}
if (navigator.platform == "Linux armv8l") {os = "unix";}
if (navigator.platform == "Linux ppc64") {os = "unix";}
if (navigator.platform == "Linux mips") {os = "unix";}
if (navigator.platform == "Linux mips64") {os = "unix";}
if (navigator.platform == "Mac") {os = "unix";}
if (navigator.platform == "Win32") {os = "win";}
if (navigator.platform == "Win64" ||
navigator.userAgent.indexOf("WOW64") != -1 ||
navigator.userAgent.indexOf("Win64") != -1) {os = "win";}
if (navigator.platform == "FreeBSD x86_64") {os = "unix";}
if (navigator.platform == "FreeBSD amd64") {os = "unix";}
// if (navigator.platform == "NetBSD x86_64") {os = "unix";}
// if (navigator.platform == "NetBSD amd64") {os = "unix";}
// I wish I knew by now, but I don't. Try harder.
if (os == "unknown") {
if (navigator.appVersion.indexOf("Win")!=-1) {os = "win";}
if (navigator.appVersion.indexOf("Mac")!=-1) {os = "unix";}
if (navigator.appVersion.indexOf("FreeBSD")!=-1) {os = "unix";}
}
// Firefox Quantum likes to hide platform and appVersion but oscpu works
if (navigator.oscpu) {
if (navigator.oscpu.indexOf("Win32")!=-1) {os = "win";}
if (navigator.oscpu.indexOf("Win64")!=-1) {os = "win";}
if (navigator.oscpu.indexOf("Mac")!=-1) {os = "unix";}
if (navigator.oscpu.indexOf("Linux")!=-1) {os = "unix";}
if (navigator.oscpu.indexOf("FreeBSD")!=-1) {os = "unix";}
// if (navigator.oscpu.indexOf("NetBSD")!=-1) {os = "unix";}
}
return os;
}
function adjust_for_platform() {
"use strict";
var platform = detect_platform();
if (platforms.includes(platform)) {
platforms.forEach(function (platform_elem) {
var platform_div = document.getElementById("ghcup-instructions-" + platform_elem);
platform_div.style.display = "none";
if (platform == platform_elem) {
platform_div.style.display = "block";
}
});
}
}
function show_all_platforms() {
platforms.forEach(function (platform_elem) {
var platform_div = document.getElementById("ghcup-instructions-" + platform_elem);
platform_div.style.display = "block";
});
var buttons = document.getElementsByClassName("show-all-platforms");
console.log(buttons);
Array.from(buttons).forEach(function (button) {
button.style.display = "none";
});
}
function set_up_default_platform_buttons() {
var defaults_buttons = document.getElementsByClassName('show-all-platforms-button');
for (var i = 0; i < defaults_buttons.length; i++) {
defaults_buttons[i].onclick = show_all_platforms;
}
}
function copyToClipboardNux() {
const text = document.getElementById("ghcup-command-linux").innerText;
const el = document.createElement('textarea');
el.value = text;
document.body.appendChild(el);
el.select();
document.execCommand('copy');
document.body.removeChild(el);
const button = document.getElementById("ghcup-linux-button");
button.focus();
}
function copyToClipboardWin() {
const text = document.getElementById("ghcup-command-windows").innerText;
const el = document.createElement('textarea');
el.value = text;
document.body.appendChild(el);
el.select();
document.execCommand('copy');
document.body.removeChild(el);
const button = document.getElementById("ghcup-windows-button");
button.focus();
}
(function () {
adjust_for_platform();
set_up_default_platform_buttons();
}());

View File

@@ -1,366 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<!-- Generated by graphviz version 2.44.0 (0)
-->
<!-- Title: G Pages: 1 -->
<svg width="719pt" height="648pt"
viewBox="0.00 0.00 719.28 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.81 0.81) rotate(0) translate(4 794.2)">
<title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-794.2 882,-794.2 882,4 -4,4"/>
<g id="clust1" class="cluster">
<title>cluster_0</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-8.95 8,-660.37 870,-660.37 870,-8.95 8,-8.95"/>
<text text-anchor="middle" x="439" y="-645.17" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<g id="clust2" class="cluster">
<title>cluster_1</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="190,-364.88 190,-541.72 450,-541.72 450,-364.88 190,-364.88"/>
<text text-anchor="middle" x="320" y="-526.52" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<g id="clust3" class="cluster">
<title>cluster_2</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="271,-191.39 271,-355.93 452,-355.93 452,-191.39 271,-191.39"/>
<text text-anchor="middle" x="361.5" y="-340.73" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<g id="clust4" class="cluster">
<title>cluster_3</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="566,-17.91 566,-576.42 862,-576.42 862,-17.91 566,-17.91"/>
<text text-anchor="middle" x="714" y="-561.22" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<g id="clust5" class="cluster">
<title>cluster_4</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="640,-271.98 640,-448.82 758,-448.82 758,-271.98 640,-271.98"/>
<text text-anchor="middle" x="699" y="-433.62" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<g id="clust6" class="cluster">
<title>cluster_5</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="583,-26.86 583,-110.81 653,-110.81 653,-26.86 583,-26.86"/>
<text text-anchor="middle" x="618" y="-95.61" font-family="Times-Roman" font-size="14.00">String</text>
</g>
<g id="clust7" class="cluster">
<title>cluster_6</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="712,-457.78 712,-541.72 782,-541.72 782,-457.78 712,-457.78"/>
<text text-anchor="middle" x="747" y="-526.52" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1 -->
<g id="node1" class="node">
<title>u1</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="387" cy="-486.95" rx="55.49" ry="18"/>
<text text-anchor="middle" x="387" y="-483.25" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<!-- u12 -->
<g id="node7" class="node">
<title>u12</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="688" cy="-393.95" rx="27" ry="18"/>
<text text-anchor="middle" x="688" y="-390.25" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<!-- u1&#45;&gt;u12 -->
<g id="edge15" class="edge">
<title>u1&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M416.08,-471.48C425.43,-467.42 435.96,-463.44 446,-460.95 491.68,-449.63 616.67,-467.2 657,-442.95 665.62,-437.77 672.27,-429.17 677.16,-420.67"/>
<polygon fill="black" stroke="black" points="680.34,-422.15 681.79,-411.65 674.11,-418.95 680.34,-422.15"/>
</g>
<!-- u11 -->
<g id="node15" class="node">
<title>u11</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="603" cy="-393.95" rx="28.7" ry="18"/>
<text text-anchor="middle" x="603" y="-390.25" font-family="Times-Roman" font-size="14.00">Dirs</text>
</g>
<!-- u1&#45;&gt;u11 -->
<g id="edge14" class="edge">
<title>u1&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M419.14,-472.31C427.86,-468.62 437.29,-464.63 446,-460.95 489.08,-442.77 538.85,-421.87 570.6,-408.54"/>
<polygon fill="black" stroke="black" points="571.98,-411.76 579.85,-404.66 569.27,-405.3 571.98,-411.76"/>
</g>
<!-- u13 -->
<g id="node18" class="node">
<title>u13</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-300.95" rx="44.39" ry="18"/>
<text text-anchor="middle" x="109" y="-297.25" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1&#45;&gt;u13 -->
<g id="edge13" class="edge">
<title>u1&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M356.68,-471.88C346.23,-467.63 334.3,-463.44 323,-460.95 290.82,-453.87 49.58,-466.95 27,-442.95 4.16,-418.68 12.6,-398.02 27,-367.95 36.61,-347.88 55.63,-331.97 72.94,-320.81"/>
<polygon fill="black" stroke="black" points="75.07,-323.61 81.77,-315.4 71.41,-317.64 75.07,-323.61"/>
</g>
<!-- u17 -->
<g id="node2" class="node">
<title>u17</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="332" cy="-393.95" rx="30.59" ry="18"/>
<text text-anchor="middle" x="332" y="-390.25" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u5 -->
<g id="node6" class="node">
<title>u5</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="410" cy="-300.95" rx="33.6" ry="18"/>
<text text-anchor="middle" x="410" y="-297.25" font-family="Times-Roman" font-size="14.00">JSON</text>
</g>
<!-- u17&#45;&gt;u5 -->
<g id="edge16" class="edge">
<title>u17&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M345.23,-377.52C357.37,-363.35 375.54,-342.16 389.55,-325.81"/>
<polygon fill="black" stroke="black" points="392.59,-327.64 396.44,-317.77 387.28,-323.09 392.59,-327.64"/>
</g>
<!-- u19 -->
<g id="node3" class="node">
<title>u19</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="256" cy="-486.95" rx="57.69" ry="18"/>
<text text-anchor="middle" x="256" y="-483.25" font-family="Times-Roman" font-size="14.00">IOStreams</text>
</g>
<!-- u19&#45;&gt;u17 -->
<g id="edge17" class="edge">
<title>u19&#45;&gt;u17</title>
<path fill="none" stroke="black" d="M272.49,-469.68C280.19,-461.83 289.33,-452.14 297,-442.95 303.18,-435.56 309.51,-427.17 315.06,-419.49"/>
<polygon fill="black" stroke="black" points="318.21,-421.09 321.16,-410.91 312.51,-417.03 318.21,-421.09"/>
</g>
<!-- u3 -->
<g id="node4" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="399" cy="-220.95" rx="36.29" ry="18"/>
<text text-anchor="middle" x="399" y="-217.25" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node5" class="node">
<title>u4</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="319" cy="-300.95" rx="39.79" ry="18"/>
<text text-anchor="middle" x="319" y="-297.25" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge18" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M335.19,-284.17C346.87,-272.78 362.8,-257.24 375.83,-244.55"/>
<polygon fill="black" stroke="black" points="378.39,-246.94 383.11,-237.45 373.5,-241.92 378.39,-246.94"/>
</g>
<!-- u6 -->
<g id="node12" class="node">
<title>u6</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="638" cy="-486.95" rx="64.19" ry="18"/>
<text text-anchor="middle" x="638" y="-483.25" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge19" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M425.28,-317.32C443.67,-335.87 472.3,-364.95 474,-367.95 491,-397.97 469.27,-418.9 494,-442.95 518.89,-467.15 536.76,-450.95 570,-460.95 577.45,-463.2 585.27,-465.82 592.85,-468.5"/>
<polygon fill="black" stroke="black" points="591.68,-471.8 602.27,-471.91 594.06,-465.22 591.68,-471.8"/>
</g>
<!-- u7 -->
<g id="node13" class="node">
<title>u7</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="618" cy="-220.95" rx="44.39" ry="18"/>
<text text-anchor="middle" x="618" y="-217.25" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge20" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M429.11,-285.89C434.97,-281.99 441.58,-277.99 448,-274.95 487.67,-256.18 535.63,-241.92 570.48,-232.95"/>
<polygon fill="black" stroke="black" points="571.56,-236.29 580.4,-230.45 569.85,-229.51 571.56,-236.29"/>
</g>
<!-- u9 -->
<g id="node8" class="node">
<title>u9</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="699" cy="-300.95" rx="51.19" ry="18"/>
<text text-anchor="middle" x="699" y="-297.25" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge30" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M690.07,-375.84C691.65,-362.75 693.87,-344.43 695.69,-329.32"/>
<polygon fill="black" stroke="black" points="699.21,-329.34 696.94,-318.99 692.27,-328.5 699.21,-329.34"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge31" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M682.22,-283.79C670.52,-272.53 654.74,-257.34 641.76,-244.83"/>
<polygon fill="black" stroke="black" points="644.12,-242.24 634.48,-237.83 639.26,-247.29 644.12,-242.24"/>
</g>
<!-- u10 -->
<g id="node9" class="node">
<title>u10</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="618" cy="-55.95" rx="27" ry="18"/>
<text text-anchor="middle" x="618" y="-52.25" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node10" class="node">
<title>u16</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="747" cy="-486.95" rx="27" ry="18"/>
<text text-anchor="middle" x="747" y="-483.25" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15 -->
<g id="node11" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="823" cy="-486.95" rx="30.59" ry="18"/>
<text text-anchor="middle" x="823" y="-483.25" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u15&#45;&gt;u12 -->
<g id="edge22" class="edge">
<title>u15&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M803.42,-472.71C797.8,-468.92 791.66,-464.77 786,-460.95 761.96,-444.74 734.59,-426.31 714.9,-413.05"/>
<polygon fill="black" stroke="black" points="716.68,-410.03 706.43,-407.35 712.77,-415.84 716.68,-410.03"/>
</g>
<!-- u15&#45;&gt;u11 -->
<g id="edge21" class="edge">
<title>u15&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M805.88,-471.91C799.92,-467.72 792.97,-463.55 786,-460.95 723.08,-437.5 693.45,-477.7 636,-442.95 627.23,-437.65 620.23,-429.02 614.98,-420.54"/>
<polygon fill="black" stroke="black" points="617.89,-418.57 609.96,-411.54 611.78,-421.98 617.89,-418.57"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge23" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M608.52,-470.77C594.78,-463.16 578.53,-453.36 565,-442.95 527.38,-414.03 523.93,-400.08 489,-367.95 479.95,-359.63 474.21,-360.56 468,-349.95 450.82,-320.62 469.18,-304.85 453,-274.95 446.44,-262.83 436.18,-251.74 426.36,-242.87"/>
<polygon fill="black" stroke="black" points="428.53,-240.12 418.66,-236.26 423.97,-245.43 428.53,-240.12"/>
</g>
<!-- u8 -->
<g id="node14" class="node">
<title>u8</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="618" cy="-139.95" rx="42.49" ry="18"/>
<text text-anchor="middle" x="618" y="-136.25" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge25" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M618,-202.81C618,-192.67 618,-179.59 618,-168.07"/>
<polygon fill="black" stroke="black" points="621.5,-168.06 618,-158.06 614.5,-168.06 621.5,-168.06"/>
</g>
<!-- u2 -->
<g id="node17" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="520" cy="-300.95" rx="37.89" ry="18"/>
<text text-anchor="middle" x="520" y="-297.25" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge24" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M598.83,-237.21C584.07,-248.96 563.49,-265.34 547.06,-278.42"/>
<polygon fill="black" stroke="black" points="544.54,-275.95 538.9,-284.91 548.9,-281.43 544.54,-275.95"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge26" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M576.88,-144.38C511.17,-150.66 386.55,-166.09 354,-194.95 331.93,-214.52 323.74,-248.37 320.73,-272.34"/>
<polygon fill="black" stroke="black" points="317.22,-272.27 319.67,-282.57 324.18,-272.99 317.22,-272.27"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge27" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M637.21,-156.09C648.59,-166.01 662.41,-179.89 671,-194.95 684.9,-219.32 692.1,-250.8 695.69,-272.91"/>
<polygon fill="black" stroke="black" points="692.25,-273.56 697.18,-282.94 699.17,-272.53 692.25,-273.56"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge28" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M618,-121.56C618,-110.73 618,-96.56 618,-84.25"/>
<polygon fill="black" stroke="black" points="621.5,-84.04 618,-74.04 614.5,-84.04 621.5,-84.04"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge29" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M575.99,-387.58C537.44,-379.55 469,-363.89 448,-349.95 439.06,-344.02 431.26,-335.31 425.1,-326.92"/>
<polygon fill="black" stroke="black" points="427.82,-324.71 419.28,-318.44 422.05,-328.67 427.82,-324.71"/>
</g>
<!-- u0 -->
<g id="node16" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="627" cy="-605.95" rx="42.49" ry="18"/>
<text text-anchor="middle" x="627" y="-602.25" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u0&#45;&gt;u1 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M584.67,-604.4C545.83,-602.07 488.09,-593.82 446,-566.95 425.91,-554.13 410.22,-531.89 400.09,-514.27"/>
<polygon fill="black" stroke="black" points="402.91,-512.13 395.04,-505.04 396.77,-515.5 402.91,-512.13"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge6" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M663.33,-596.57C681.18,-590.83 701.84,-581.54 716,-566.95 729.77,-552.77 737.62,-531.76 741.97,-514.97"/>
<polygon fill="black" stroke="black" points="745.4,-515.69 744.26,-505.16 738.58,-514.11 745.4,-515.69"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge5" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M669.23,-604.64C704.08,-602.27 753,-593.85 786,-566.95 801.95,-553.96 811.39,-532.52 816.74,-515.25"/>
<polygon fill="black" stroke="black" points="820.24,-515.72 819.56,-505.15 813.5,-513.84 820.24,-515.72"/>
</g>
<!-- u14 -->
<g id="node19" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="508" cy="-486.95" rx="48.19" ry="18"/>
<text text-anchor="middle" x="508" y="-483.25" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M599.25,-592.23C586.98,-585.76 572.9,-577.11 562,-566.95 545.64,-551.71 531.56,-530.66 521.88,-514.12"/>
<polygon fill="black" stroke="black" points="524.68,-511.96 516.71,-504.98 518.59,-515.41 524.68,-511.96"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge7" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M498.37,-286.01C479.01,-273.53 450.45,-255.12 428.91,-241.23"/>
<polygon fill="black" stroke="black" points="430.75,-238.25 420.45,-235.78 426.95,-244.14 430.75,-238.25"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge8" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M144.85,-290.31C198.89,-275.78 300.93,-248.33 357.9,-233.01"/>
<polygon fill="black" stroke="black" points="358.91,-236.36 367.66,-230.38 357.09,-229.6 358.91,-236.36"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge9" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M492.36,-469.49C485.88,-461.9 478.78,-452.48 474,-442.95 458.54,-412.12 468.2,-399.39 454,-367.95 447.34,-353.21 437.53,-338.1 428.85,-326.06"/>
<polygon fill="black" stroke="black" points="431.57,-323.84 422.81,-317.89 425.94,-328.01 431.57,-323.84"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge10" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M534.95,-471.89C543.43,-467.9 552.95,-463.86 562,-460.95 602.92,-447.83 621.35,-466.95 657,-442.95 665.13,-437.48 671.61,-429.08 676.49,-420.83"/>
<polygon fill="black" stroke="black" points="679.72,-422.21 681.33,-411.74 673.54,-418.92 679.72,-422.21"/>
</g>
<!-- u18 -->
<g id="node20" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-393.95" rx="73.39" ry="18"/>
<text text-anchor="middle" x="109" y="-390.25" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge12" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M147.73,-378.58C159.84,-374.58 173.34,-370.6 186,-367.95 265.56,-351.31 295.73,-387.15 368,-349.95 378.45,-344.58 387.45,-335.41 394.41,-326.53"/>
<polygon fill="black" stroke="black" points="397.39,-328.37 400.44,-318.22 391.73,-324.26 397.39,-328.37"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge11" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M109,-375.84C109,-362.75 109,-344.43 109,-329.32"/>
<polygon fill="black" stroke="black" points="112.5,-328.99 109,-318.99 105.5,-328.99 112.5,-328.99"/>
</g>
<!-- u20 -->
<g id="node21" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-769.95" rx="32.49" ry="18"/>
<text text-anchor="middle" x="627" y="-766.25" font-family="Times-Roman" font-size="14.00">Main</text>
</g>
<!-- u21 -->
<g id="node22" class="node">
<title>u21</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-689.95" rx="46.29" ry="18"/>
<text text-anchor="middle" x="627" y="-686.25" font-family="Times-Roman" font-size="14.00">Validate</text>
</g>
<!-- u20&#45;&gt;u21 -->
<g id="edge1" class="edge">
<title>u20&#45;&gt;u21</title>
<path fill="none" stroke="black" d="M627,-751.64C627,-741.85 627,-729.38 627,-718.29"/>
<polygon fill="black" stroke="black" points="630.5,-718.22 627,-708.22 623.5,-718.22 630.5,-718.22"/>
</g>
<!-- u21&#45;&gt;u0 -->
<g id="edge2" class="edge">
<title>u21&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M627,-671.56C627,-660.73 627,-646.56 627,-634.25"/>
<polygon fill="black" stroke="black" points="630.5,-634.04 627,-624.04 623.5,-634.04 630.5,-634.04"/>
</g>
</g>
</svg>

Before

Width:  |  Height:  |  Size: 19 KiB

View File

@@ -1,366 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<!-- Generated by graphviz version 2.44.0 (0)
-->
<!-- Title: G Pages: 1 -->
<svg width="1075pt" height="648pt"
viewBox="0.00 0.00 1075.16 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.91 0.91) rotate(0) translate(4 710)">
<title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-710 1180.67,-710 1180.67,4 -4,4"/>
<g id="clust1" class="cluster">
<title>cluster_0</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="10.72,-8 10.72,-590 1165.95,-590 1165.95,-8 10.72,-8"/>
<text text-anchor="middle" x="588.33" y="-574.8" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<g id="clust2" class="cluster">
<title>cluster_1</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="254.63,-326 254.63,-484 603.08,-484 603.08,-326 254.63,-326"/>
<text text-anchor="middle" x="428.85" y="-468.8" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<g id="clust3" class="cluster">
<title>cluster_2</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="363.19,-171 363.19,-318 605.76,-318 605.76,-171 363.19,-171"/>
<text text-anchor="middle" x="484.47" y="-302.8" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<g id="clust4" class="cluster">
<title>cluster_3</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="758.53,-16 758.53,-515 1155.22,-515 1155.22,-16 758.53,-16"/>
<text text-anchor="middle" x="956.88" y="-499.8" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<g id="clust5" class="cluster">
<title>cluster_4</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="857.71,-243 857.71,-401 1015.85,-401 1015.85,-243 857.71,-243"/>
<text text-anchor="middle" x="936.78" y="-385.8" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<g id="clust6" class="cluster">
<title>cluster_5</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="781.32,-24 781.32,-99 875.13,-99 875.13,-24 781.32,-24"/>
<text text-anchor="middle" x="828.22" y="-83.8" font-family="Times-Roman" font-size="14.00">String</text>
</g>
<g id="clust7" class="cluster">
<title>cluster_6</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="954.2,-409 954.2,-484 1048.01,-484 1048.01,-409 954.2,-409"/>
<text text-anchor="middle" x="1001.1" y="-468.8" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1 -->
<g id="node1" class="node">
<title>u1</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="518.39" cy="-435" rx="55.49" ry="18"/>
<text text-anchor="middle" x="518.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<!-- u12 -->
<g id="node7" class="node">
<title>u12</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="922.39" cy="-352" rx="27" ry="18"/>
<text text-anchor="middle" x="922.39" y="-348.3" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<!-- u1&#45;&gt;u12 -->
<g id="edge15" class="edge">
<title>u1&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M546.79,-419.43C556.27,-415.25 567.06,-411.24 577.39,-409 594.44,-405.31 876.17,-409.54 891.39,-401 900.16,-396.08 906.84,-387.53 911.72,-379"/>
<polygon fill="black" stroke="black" points="914.92,-380.43 916.31,-369.92 908.67,-377.26 914.92,-380.43"/>
</g>
<!-- u11 -->
<g id="node15" class="node">
<title>u11</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="808.39" cy="-352" rx="28.7" ry="18"/>
<text text-anchor="middle" x="808.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Dirs</text>
</g>
<!-- u1&#45;&gt;u11 -->
<g id="edge14" class="edge">
<title>u1&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M548.95,-419.93C557.99,-416.08 567.99,-412.11 577.39,-409 586.69,-405.92 709.34,-376.59 772.03,-361.65"/>
<polygon fill="black" stroke="black" points="772.99,-365.02 781.91,-359.3 771.37,-358.21 772.99,-365.02"/>
</g>
<!-- u13 -->
<g id="node18" class="node">
<title>u13</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-269" rx="44.39" ry="18"/>
<text text-anchor="middle" x="146.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1&#45;&gt;u13 -->
<g id="edge13" class="edge">
<title>u1&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M477.97,-422.58C457.84,-417.42 433.02,-411.85 410.39,-409 400.85,-407.8 71.11,-407.88 64.39,-401 41.09,-377.16 48.83,-355.48 64.39,-326 73.49,-308.76 90.55,-295.83 106.76,-286.76"/>
<polygon fill="black" stroke="black" points="108.39,-289.86 115.62,-282.11 105.14,-283.66 108.39,-289.86"/>
</g>
<!-- u17 -->
<g id="node2" class="node">
<title>u17</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="445.39" cy="-352" rx="30.59" ry="18"/>
<text text-anchor="middle" x="445.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u5 -->
<g id="node6" class="node">
<title>u5</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="549.39" cy="-269" rx="33.6" ry="18"/>
<text text-anchor="middle" x="549.39" y="-265.3" font-family="Times-Roman" font-size="14.00">JSON</text>
</g>
<!-- u17&#45;&gt;u5 -->
<g id="edge16" class="edge">
<title>u17&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M463.03,-337.26C479.49,-324.44 504.26,-305.15 523.05,-290.51"/>
<polygon fill="black" stroke="black" points="525.22,-293.26 530.96,-284.35 520.92,-287.74 525.22,-293.26"/>
</g>
<!-- u19 -->
<g id="node3" class="node">
<title>u19</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="343.39" cy="-435" rx="57.69" ry="18"/>
<text text-anchor="middle" x="343.39" y="-431.3" font-family="Times-Roman" font-size="14.00">IOStreams</text>
</g>
<!-- u19&#45;&gt;u17 -->
<g id="edge17" class="edge">
<title>u19&#45;&gt;u17</title>
<path fill="none" stroke="black" d="M378.72,-420.5C389.55,-415.38 401.06,-408.84 410.39,-401 418.16,-394.47 425.12,-385.87 430.76,-377.75"/>
<polygon fill="black" stroke="black" points="433.77,-379.54 436.33,-369.25 427.92,-375.7 433.77,-379.54"/>
</g>
<!-- u3 -->
<g id="node4" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="534.39" cy="-197" rx="36.29" ry="18"/>
<text text-anchor="middle" x="534.39" y="-193.3" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node5" class="node">
<title>u4</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="427.39" cy="-269" rx="39.79" ry="18"/>
<text text-anchor="middle" x="427.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge18" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M449.04,-253.83C464.95,-243.42 486.78,-229.15 504.37,-217.64"/>
<polygon fill="black" stroke="black" points="506.68,-220.31 513.13,-211.91 502.85,-214.45 506.68,-220.31"/>
</g>
<!-- u6 -->
<g id="node12" class="node">
<title>u6</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="855.39" cy="-435" rx="64.19" ry="18"/>
<text text-anchor="middle" x="855.39" y="-431.3" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge19" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M566.7,-284.68C579.52,-295.01 597.75,-308.62 615.39,-318 624.58,-322.89 630.09,-318.59 637.39,-326 662.15,-351.13 635.32,-379.63 663.39,-401 674.37,-409.36 773.88,-406.14 787.39,-409 795.7,-410.76 804.37,-413.33 812.61,-416.16"/>
<polygon fill="black" stroke="black" points="811.46,-419.47 822.06,-419.57 813.84,-412.88 811.46,-419.47"/>
</g>
<!-- u7 -->
<g id="node13" class="node">
<title>u7</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="828.39" cy="-197" rx="44.39" ry="18"/>
<text text-anchor="middle" x="828.39" y="-193.3" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge20" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M567.9,-253.71C573.85,-249.71 580.65,-245.72 587.39,-243 648.94,-218.19 724.91,-206.91 774.9,-201.88"/>
<polygon fill="black" stroke="black" points="775.54,-205.33 785.16,-200.9 774.87,-198.36 775.54,-205.33"/>
</g>
<!-- u9 -->
<g id="node8" class="node">
<title>u9</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="936.39" cy="-269" rx="51.19" ry="18"/>
<text text-anchor="middle" x="936.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge30" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M925.36,-333.82C927.2,-323.19 929.6,-309.31 931.69,-297.2"/>
<polygon fill="black" stroke="black" points="935.17,-297.6 933.42,-287.15 928.27,-296.41 935.17,-297.6"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge31" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M912.96,-252.81C897.32,-242.68 876.58,-229.24 859.56,-218.2"/>
<polygon fill="black" stroke="black" points="861.33,-215.18 851.04,-212.68 857.53,-221.06 861.33,-215.18"/>
</g>
<!-- u10 -->
<g id="node9" class="node">
<title>u10</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="828.39" cy="-50" rx="27" ry="18"/>
<text text-anchor="middle" x="828.39" y="-46.3" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node10" class="node">
<title>u16</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1001.39" cy="-435" rx="27" ry="18"/>
<text text-anchor="middle" x="1001.39" y="-431.3" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15 -->
<g id="node11" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1103.39" cy="-435" rx="30.59" ry="18"/>
<text text-anchor="middle" x="1103.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u15&#45;&gt;u12 -->
<g id="edge22" class="edge">
<title>u15&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M1080.91,-422.68C1072.07,-418.31 1061.8,-413.33 1052.39,-409 1019.33,-393.79 981.02,-377.44 954.59,-366.35"/>
<polygon fill="black" stroke="black" points="955.66,-363.01 945.08,-362.38 952.96,-369.47 955.66,-363.01"/>
</g>
<!-- u15&#45;&gt;u11 -->
<g id="edge21" class="edge">
<title>u15&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M1082.81,-421.48C1073.8,-416.65 1062.9,-411.66 1052.39,-409 1009.49,-398.14 893.64,-419.41 853.39,-401 842.1,-395.84 832.28,-386.4 824.72,-377.25"/>
<polygon fill="black" stroke="black" points="827.3,-374.87 818.44,-369.07 821.75,-379.13 827.3,-374.87"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge23" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M817.86,-420.3C799.34,-413.36 779.12,-405.48 770.39,-401 716.1,-373.14 711.12,-350.84 655.39,-326 642.79,-320.38 635.87,-326.98 625.39,-318 597.74,-294.3 614.8,-271.71 592.39,-243 584.81,-233.29 574.68,-224.49 565.01,-217.31"/>
<polygon fill="black" stroke="black" points="566.89,-214.35 556.71,-211.43 562.85,-220.06 566.89,-214.35"/>
</g>
<!-- u8 -->
<g id="node14" class="node">
<title>u8</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="828.39" cy="-125" rx="42.49" ry="18"/>
<text text-anchor="middle" x="828.39" y="-121.3" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge25" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M828.39,-178.7C828.39,-170.98 828.39,-161.71 828.39,-153.11"/>
<polygon fill="black" stroke="black" points="831.89,-153.1 828.39,-143.1 824.89,-153.1 831.89,-153.1"/>
</g>
<!-- u2 -->
<g id="node17" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="696.39" cy="-269" rx="37.89" ry="18"/>
<text text-anchor="middle" x="696.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge24" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M802.53,-211.71C781.65,-222.79 752.12,-238.45 729.51,-250.44"/>
<polygon fill="black" stroke="black" points="727.8,-247.38 720.6,-255.16 731.07,-253.57 727.8,-247.38"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge26" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M786.3,-127.22C706.73,-130.23 537.84,-140.15 489.39,-171 463.54,-187.46 446.42,-218.99 436.84,-241.64"/>
<polygon fill="black" stroke="black" points="433.54,-240.45 433.08,-251.04 440.04,-243.06 433.54,-240.45"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge27" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M849.03,-140.76C859.52,-148.9 872,-159.65 881.39,-171 899.5,-192.89 914.92,-221.56 924.79,-242.04"/>
<polygon fill="black" stroke="black" points="921.62,-243.54 929.04,-251.1 927.96,-240.56 921.62,-243.54"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge28" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M828.39,-106.7C828.39,-98.25 828.39,-87.87 828.39,-78.37"/>
<polygon fill="black" stroke="black" points="831.89,-78.18 828.39,-68.18 824.89,-78.18 831.89,-78.18"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge29" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M781.07,-346.57C749.06,-341.43 694.42,-332.79 647.39,-326 620.76,-322.16 610.78,-331.29 587.39,-318 577.83,-312.56 569.78,-303.68 563.6,-295.02"/>
<polygon fill="black" stroke="black" points="566.46,-293 558.04,-286.57 560.61,-296.85 566.46,-293"/>
</g>
<!-- u0 -->
<g id="node16" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="840.39" cy="-541" rx="42.49" ry="18"/>
<text text-anchor="middle" x="840.39" y="-537.3" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u0&#45;&gt;u1 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M798.15,-540.08C733.62,-539.53 614.12,-535.65 577.39,-515 556.17,-503.07 540.32,-480.02 530.42,-461.88"/>
<polygon fill="black" stroke="black" points="533.49,-460.2 525.79,-452.93 527.27,-463.42 533.49,-460.2"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge6" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M881.32,-536.43C914.21,-532.8 957.04,-526.09 970.39,-515 985.87,-502.13 993.66,-480.49 997.55,-463.11"/>
<polygon fill="black" stroke="black" points="1001.06,-463.44 999.51,-452.96 994.18,-462.12 1001.06,-463.44"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge5" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M882.83,-539.21C936.42,-537.51 1024.95,-532.11 1052.39,-515 1071.91,-502.83 1085.39,-480.12 1093.57,-462.17"/>
<polygon fill="black" stroke="black" points="1096.87,-463.35 1097.57,-452.78 1090.43,-460.6 1096.87,-463.35"/>
</g>
<!-- u14 -->
<g id="node19" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="680.39" cy="-435" rx="48.19" ry="18"/>
<text text-anchor="middle" x="680.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M801.74,-533.4C786.24,-529.61 768.7,-523.78 754.39,-515 731.68,-501.06 711.42,-478.33 697.87,-460.82"/>
<polygon fill="black" stroke="black" points="700.58,-458.59 691.78,-452.7 694.98,-462.8 700.58,-458.59"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge7" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M669.27,-256.28C642.05,-244.52 599.95,-226.33 570.04,-213.4"/>
<polygon fill="black" stroke="black" points="571.35,-210.16 560.79,-209.41 568.58,-216.59 571.35,-210.16"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge8" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M186.09,-260.84C259.14,-247.66 414.32,-219.66 490.43,-205.93"/>
<polygon fill="black" stroke="black" points="491.41,-209.31 500.63,-204.09 490.17,-202.42 491.41,-209.31"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge9" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M656.5,-419.22C649.64,-414.1 642.62,-407.9 637.39,-401 615.71,-372.38 627.41,-355.8 607.39,-326 598.66,-313.01 586.48,-300.68 575.54,-290.91"/>
<polygon fill="black" stroke="black" points="577.72,-288.16 567.86,-284.28 573.14,-293.46 577.72,-288.16"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge10" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M711.94,-421.27C724.88,-416.59 740.15,-411.77 754.39,-409 784.33,-403.18 865.04,-416.36 891.39,-401 900.07,-395.94 906.74,-387.36 911.63,-378.84"/>
<polygon fill="black" stroke="black" points="914.82,-380.3 916.24,-369.8 908.58,-377.12 914.82,-380.3"/>
</g>
<!-- u18 -->
<g id="node20" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-352" rx="73.39" ry="18"/>
<text text-anchor="middle" x="146.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge12" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M192.35,-337.85C210.3,-333.27 231.16,-328.62 250.39,-326 300.18,-319.2 428.51,-333.26 476.39,-318 493.93,-312.41 511.26,-301.32 524.62,-291.22"/>
<polygon fill="black" stroke="black" points="527.1,-293.72 532.79,-284.78 522.77,-288.22 527.1,-293.72"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge11" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M146.39,-333.82C146.39,-323.19 146.39,-309.31 146.39,-297.2"/>
<polygon fill="black" stroke="black" points="149.89,-297.15 146.39,-287.15 142.89,-297.15 149.89,-297.15"/>
</g>
<!-- u20 -->
<g id="node21" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-688" rx="32.49" ry="18"/>
<text text-anchor="middle" x="840.39" y="-684.3" font-family="Times-Roman" font-size="14.00">Main</text>
</g>
<!-- u21 -->
<g id="node22" class="node">
<title>u21</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-616" rx="46.29" ry="18"/>
<text text-anchor="middle" x="840.39" y="-612.3" font-family="Times-Roman" font-size="14.00">Validate</text>
</g>
<!-- u20&#45;&gt;u21 -->
<g id="edge1" class="edge">
<title>u20&#45;&gt;u21</title>
<path fill="none" stroke="black" d="M840.39,-669.7C840.39,-661.98 840.39,-652.71 840.39,-644.11"/>
<polygon fill="black" stroke="black" points="843.89,-644.1 840.39,-634.1 836.89,-644.1 843.89,-644.1"/>
</g>
<!-- u21&#45;&gt;u0 -->
<g id="edge2" class="edge">
<title>u21&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M840.39,-597.7C840.39,-589.25 840.39,-578.87 840.39,-569.37"/>
<polygon fill="black" stroke="black" points="843.89,-569.18 840.39,-559.18 836.89,-569.18 843.89,-569.18"/>
</g>
</g>
</svg>

Before

Width:  |  Height:  |  Size: 19 KiB

View File

@@ -1,7 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<!-- Svg Vector Icons : http://www.onlinewebfonts.com/icon -->
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" x="0px" y="0px" viewBox="0 0 1000 1000" enable-background="new 0 0 1000 1000" xml:space="preserve">
<metadata> Svg Vector Icons : http://www.onlinewebfonts.com/icon </metadata>
<g><path d="M81.5,647.7C11,409.2,148.6,158.9,388.6,88.9c106.5-31.1,215.5-21.4,309.8,19.8c-4.9,6.9-9.5,14-13.7,21c-46.1-10.7-81.4,3.8-90.2,43.3c-13.9,62.1,42.9,162.8,126.6,224.7c83.7,61.9,162.9,61.7,176.8-0.4c3.5-15.9,2.5-34.4-2.5-54.1c9.7-5.8,19.2-12.3,28.6-19.3c10.9,22.2,20,45.6,27.3,70.1c70.5,238.4-67.1,488.8-307.1,558.8C403.9,1022.8,151.9,886.1,81.5,647.7L81.5,647.7z M667.1,204.7c0.4-0.4,0.7-0.7,1-1.1C776.9,92.3,912.3,26.4,970.4,56.4c58.1,30.1-25.5,176.7-91.7,256.3c-20.1,20.6-41.2,39.7-62.5,56.8C742.2,343.2,686.1,282.8,667.1,204.7L667.1,204.7z M11,108.5C0.7,28.8,68.9,4.9,163.2,55.2c22.4,11.9,44.3,27,64.7,44.1c-56.2,38.6-104.5,90.4-139.5,154C46.4,206.7,16.9,153.5,11,108.5L11,108.5z"/></g>
</svg>

Before

Width:  |  Height:  |  Size: 1.2 KiB

File diff suppressed because one or more lines are too long

Before

Width:  |  Height:  |  Size: 14 KiB

View File

@@ -1,143 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
version="1.0"
width="800"
height="950"
id="svg2">
<defs
id="defs4">
<linearGradient
id="linearGradient3784">
<stop
id="stop3786"
style="stop-color:#ffffff;stop-opacity:1"
offset="0" />
<stop
id="stop3788"
style="stop-color:#888888;stop-opacity:1"
offset="1" />
</linearGradient>
<linearGradient
id="linearGradient3776">
<stop
id="stop3778"
style="stop-color:#ffffff;stop-opacity:1"
offset="0" />
<stop
id="stop3780"
style="stop-color:#ffffff;stop-opacity:0"
offset="1" />
</linearGradient>
<linearGradient
id="linearGradient3754">
<stop
id="stop3756"
style="stop-color:#ffffff;stop-opacity:1"
offset="0" />
<stop
id="stop3758"
style="stop-color:#ffffff;stop-opacity:0"
offset="1" />
</linearGradient>
<linearGradient
id="linearGradient3734">
<stop
id="stop3736"
style="stop-color:#6c6d6f;stop-opacity:1"
offset="0" />
<stop
id="stop3738"
style="stop-color:#010101;stop-opacity:1"
offset="1" />
</linearGradient>
<linearGradient
x1="581.96649"
y1="409.16061"
x2="544.40381"
y2="311.21347"
id="linearGradient3760"
xlink:href="#linearGradient3754"
gradientUnits="userSpaceOnUse" />
<linearGradient
x1="591.31964"
y1="593.75946"
x2="587.03571"
y2="434.31064"
id="linearGradient3764"
xlink:href="#linearGradient3734"
gradientUnits="userSpaceOnUse" />
<linearGradient
x1="591.31964"
y1="593.75946"
x2="587.03571"
y2="434.31064"
id="linearGradient3773"
xlink:href="#linearGradient3734"
gradientUnits="userSpaceOnUse"
gradientTransform="translate(-2.7999999e-6,-5.0000001e-6)" />
<linearGradient
x1="592.88464"
y1="409.21036"
x2="572.06653"
y2="317.52728"
id="linearGradient3782"
xlink:href="#linearGradient3776"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4.1074798,0,0,4.1074798,-2012.1445,-1474.6712)" />
<linearGradient
x1="621.8504"
y1="527.79108"
x2="575.15466"
y2="358.30902"
id="linearGradient3790"
xlink:href="#linearGradient3784"
gradientUnits="userSpaceOnUse" />
<linearGradient
x1="591.31964"
y1="593.75946"
x2="587.03571"
y2="434.31064"
id="linearGradient3796"
xlink:href="#linearGradient3734"
gradientUnits="userSpaceOnUse" />
<linearGradient
x1="591.31964"
y1="593.75946"
x2="587.03571"
y2="434.31064"
id="linearGradient3813"
xlink:href="#linearGradient3734"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4.1074798,0,0,4.1074798,-2012.1445,-1474.6712)" />
<linearGradient
x1="621.8504"
y1="527.79108"
x2="575.15466"
y2="358.30902"
id="linearGradient3815"
xlink:href="#linearGradient3784"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4.1074798,0,0,4.1074798,-2012.1445,-1474.6712)" />
</defs>
<path
d="M -1763.2143,1058.9693 L -1763.2143,950.04075 L -1724.2857,1040.5765 L -1685.3571,950.04075 L -1685.3571,1058.9693"
id="path3199"
style="fill:none;fill-rule:evenodd;stroke:#000000;stroke-width:0;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
<path
d="M 9.2490229,7.8722656 C 9.0747426,10.220019 9.5551534,12.587324 10.789328,14.675279 L 283.03823,474.32796 L 15.153526,926.66418 C 13.0537,930.26743 13.090092,934.72063 15.153526,938.34483 C 17.216918,941.9691 20.995183,944.21594 25.165508,944.24933 L 230.41114,944.24933 C 234.53312,944.22267 238.33677,942.02829 240.42312,938.47319 L 399.07452,670.58848 L 557.72593,938.47319 C 559.81228,942.02829 563.61593,944.22267 567.73791,944.24933 L 773.1119,944.24933 C 777.28223,944.21594 781.06049,941.96906 783.12389,938.34483 C 785.18744,934.72067 785.22371,930.26743 783.12389,926.66418 L 515.23918,474.32796 L 787.35972,14.675279 C 788.58462,12.5734 788.96226,10.218047 788.77167,7.8722656 L 559.13787,7.8722656 L 399.07452,278.19578 L 239.01118,7.8722656 L 9.2490229,7.8722656 z"
id="path3762"
style="fill:url(#linearGradient3815);fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:2;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1" />
<path
d="M 20.80131,8.7707768 L 296.51589,474.32796 L 25.165508,932.56868 L 230.41114,932.56868 L 399.07452,647.74063 L 567.73791,932.56868 L 773.1119,932.56868 L 501.76152,474.32796 L 777.34774,8.7707768 L 572.10211,8.7707768 L 399.07452,301.04364 L 226.04694,8.7707768 L 20.80131,8.7707768 z"
id="path3705"
style="fill:url(#linearGradient3813);fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:2;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
<path
d="M 20.80131,8.7707768 L 201.9155,314.64967 C 251.61658,285.27827 303.41256,257.12462 357.61466,230.95977 L 226.04694,8.7707768 L 20.80131,8.7707768 z M 572.10211,8.7707768 L 470.05691,181.15657 C 548.90117,149.37671 632.73447,122.22713 722.53856,101.31743 L 777.34774,8.7707768 L 572.10211,8.7707768 z"
id="path3771"
style="opacity:0.47619048;fill:url(#linearGradient3782);fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:2;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
</svg>

Before

Width:  |  Height:  |  Size: 6.0 KiB

View File

@@ -1,18 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<!-- Created with Inkscape (http://www.inkscape.org/) by Marsupilami -->
<svg
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
version="1.1"
width="766"
height="768"
viewBox="-2.61977004 -2.61977004 92.56520808 92.83416708"
id="svg8375">
<defs
id="defs8377" />
<path
d="M 0,12.40183 35.68737,7.5416 35.70297,41.96435 0.03321,42.16748 z m 35.67037,33.52906 0.0277,34.45332 -35.66989,-4.9041 -0.002,-29.77972 z M 39.99644,6.90595 87.31462,0 l 0,41.527 -47.31818,0.37565 z M 87.32567,46.25471 87.31457,87.59463 39.9964,80.91625 39.9301,46.17767 z"
id="path13" />
</svg>
<!-- version: 20110311, original size: 87.325668 87.594627, border: 3% -->

Before

Width:  |  Height:  |  Size: 861 B

View File

@@ -1,314 +1,371 @@
cabal-version: 3.0
name: ghcup
version: 0.1.17.2
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
maintainer: hasufell@posteo.de
author: Julian Ospald
homepage: https://gitlab.haskell.org/haskell/ghcup-hs
bug-reports: https://gitlab.haskell.org/haskell/ghcup-hs/issues
synopsis: ghc toolchain installer
version: 0.1.0.0
synopsis: ghc toolchain installer as an exe/library
description:
A rewrite of the shell script ghcup, for providing
a more stable user experience and exposing an API.
homepage: https://github.com/hasufell/ghcup-hs
bug-reports: https://github.com/hasufell/ghcup-hs/issues
license: LGPL-3.0-only
license-file: LICENSE
author: Julian Ospald
maintainer: hasufell@posteo.de
copyright: Julian Ospald 2020
category: System
build-type: Simple
extra-doc-files:
data/config.yaml
data/metadata/ghcup-0.0.4.yaml
data/metadata/ghcup-0.0.5.yaml
data/metadata/ghcup-0.0.6.yaml
CHANGELOG.md
README.md
extra-source-files:
data/build_mk/cross
data/build_mk/default
test/golden/GHCupInfo.json
extra-source-files: CHANGELOG.md
source-repository head
type: git
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
location: https://github.com/hasufell/ghcup-hs
flag tui
description:
Build the brick powered tui (ghcup tui). This is disabled on windows.
common HsOpenSSL
build-depends: HsOpenSSL >=0.11
default: False
manual: True
common aeson
build-depends: aeson >=1.4
flag internal-downloader
description:
Compile the internal downloader, which links against OpenSSL. This is disabled on windows.
common aeson-pretty
build-depends: aeson-pretty >=0.8.8
default: False
manual: True
common ascii-string
build-depends: ascii-string >=1.0
common async
build-depends: async >=0.8
common attoparsec
build-depends: attoparsec >=0.13
common base
build-depends: base >=4.12 && <5
common binary
build-depends: binary >=0.8.6.0
common bytestring
build-depends: bytestring >=0.10
common bzlib
build-depends: bzlib >=0.5.0.5
common case-insensitive
build-depends: case-insensitive >=1.2.1.0
common concurrent-output
build-depends: concurrent-output >=1.10.11
common containers
build-depends: containers >=0.6
common generics-sop
build-depends: generics-sop >=0.5
common haskus-utils-types
build-depends: haskus-utils-types >=1.5
common haskus-utils-variant
build-depends: haskus-utils-variant >=3.0
common hopenssl
build-depends: hopenssl >=2.2.4
common hpath
build-depends: hpath >=0.11
common hpath-directory
build-depends: hpath-directory >=0.13.2
common hpath-filepath
build-depends: hpath-filepath >=0.10.3
common hpath-io
build-depends: hpath-io >=0.13.1
common hpath-posix
build-depends: hpath-posix >=0.11.1
common http-io-streams
build-depends: http-io-streams >=0.1.2.0
common io-streams
build-depends: io-streams >=1.5
common language-bash
build-depends: language-bash >=0.9
common lzma
build-depends: lzma >=0.0.0.3
common megaparsec
build-depends: megaparsec >=8.0.0
common monad-logger
build-depends: monad-logger >=0.3.31
common mtl
build-depends: mtl >=2.2
common optics
build-depends: optics >=0.2
common optics-vl
build-depends: optics-vl >=0.2
common optparse-applicative
build-depends: optparse-applicative >=0.15.1.0
common parsec
build-depends: parsec >=3.1
common pretty-terminal
build-depends: pretty-terminal >=0.1.0.0
common regex-posix
build-depends: regex-posix >=0.96
common resourcet
build-depends: resourcet >=1.2.2
common safe
build-depends: safe >=0.3.18
common safe-exceptions
build-depends: safe-exceptions >=0.1
common streamly
build-depends: streamly >=0.7.1
common streamly-posix
build-depends: streamly-posix >=0.1.0.0
common streamly-bytestring
build-depends: streamly-bytestring >=0.1.2
common strict-base
build-depends: strict-base >=0.4
common string-interpolate
build-depends: string-interpolate >=0.2.0.0
common table-layout
build-depends: table-layout >=0.8
common tar-bytestring
build-depends: tar-bytestring >=0.6.3.1
common template-haskell
build-depends: template-haskell >=2.7
common terminal-progress-bar
build-depends: terminal-progress-bar >=0.4.1
common text
build-depends: text >=1.2
common time
build-depends: time >=1.9.3
common transformers
build-depends: transformers >=0.5
common unix
build-depends: unix >=2.7
common unix-bytestring
build-depends: unix-bytestring >=0.3
common uri-bytestring
build-depends: uri-bytestring >=0.3.2.2
common utf8-string
build-depends: utf8-string >=1.0
common vector
build-depends: vector >=0.12
common versions
build-depends: versions >=3.5
common waargonaut
build-depends: waargonaut >=0.8
common word8
build-depends: word8 >=0.1.3
common zlib
build-depends: zlib >=0.6.2.1
common config
default-language: Haskell2010
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates -threaded
default-extensions:
LambdaCase
MultiWayIf
PackageImports
RecordWildCards
ScopedTypeVariables
Strict
StrictData
TupleSections
library
import:
config
, base
, HsOpenSSL
, aeson
, ascii-string
, async
, attoparsec
, binary
, bytestring
, bzlib
, case-insensitive
, concurrent-output
, containers
, generics-sop
, haskus-utils-types
, haskus-utils-variant
, hopenssl
, hpath
, hpath-directory
, hpath-filepath
, hpath-io
, hpath-posix
, http-io-streams
, io-streams
, language-bash
, lzma
, monad-logger
, mtl
, optics
, optics-vl
, parsec
, pretty-terminal
, regex-posix
, resourcet
, safe
, safe-exceptions
, streamly
, streamly-posix
, streamly-bytestring
, strict-base
, string-interpolate
, tar-bytestring
, template-haskell
, terminal-progress-bar
, text
, time
, transformers
, unix
, unix-bytestring
, uri-bytestring
, utf8-string
, vector
, versions
, word8
, zlib
-- deps
-- cabal-fmt: expand lib
exposed-modules:
GHCup
GHCup.Download
GHCup.Download.Utils
GHCup.Errors
GHCup.Platform
GHCup.Requirements
GHCup.Types
GHCup.Types.JSON
GHCup.Types.Optics
GHCup.Utils
GHCup.Utils.Bash
GHCup.Utils.Dirs
GHCup.Utils.File
GHCup.Utils.File.Common
GHCup.Utils.Logger
GHCup.Utils.MegaParsec
GHCup.Utils.Prelude
GHCup.Utils.String.QQ
GHCup.Utils.Version.QQ
GHCup.Version
hs-source-dirs: lib
other-modules: Paths_ghcup
autogen-modules: Paths_ghcup
default-language: Haskell2010
default-extensions:
DeriveGeneric
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
QuasiQuotes
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
TypeApplications
TypeFamilies
ViewPatterns
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
build-depends:
, aeson >=1.4 && <1.6
, async >=0.8 && <2.3
, base >=4.13 && <5
, base16-bytestring >=0.1.1.6 && <1.1
, binary ^>=0.8.6.0
, bytestring ^>=0.10
, Cabal ^>=3.6.2.0
, case-insensitive ^>=1.2.1.0
, casing ^>=0.1.4.1
, containers ^>=0.6
, cryptohash-sha256 ^>=0.11.101.0
, deepseq ^>=1.4.4.0
, directory ^>=1.3.6.0
, disk-free-space ^>=0.1.0.1
, filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5
, haskus-utils-variant >=3.0 && <3.2
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0
, lzma-static ^>=5.2.5.3
, megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2
, optics ^>=0.4
, os-release ^>=1.0.0
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, split ^>=0.2.3.4
, strict-base ^>=0.4
, template-haskell >=2.7 && <2.18
, temporary ^>=1.3
, text ^>=1.2.4.0
, time ^>=1.9.3
, transformers ^>=0.5
, unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, word8 ^>=0.1.3
, zlib ^>=0.6.2.2
if (flag(internal-downloader) && !os(windows))
exposed-modules: GHCup.Download.IOStreams
cpp-options: -DINTERNAL_DOWNLOADER
build-depends:
, HsOpenSSL >=0.11.4.18
, http-io-streams >=0.1.2.0
, io-streams >=1.5.2.1
, terminal-progress-bar >=0.4.1
if os(windows)
cpp-options: -DIS_WINDOWS
other-modules: GHCup.Utils.File.Windows
build-depends:
, bzlib
, process ^>=1.6.11.0
, retry ^>=0.8.1.2
, Win32 ^>=2.10
else
other-modules:
GHCup.Utils.File.Posix
System.Console.Terminal.Common
System.Console.Terminal.Posix
build-depends:
, bz2 >=0.5.0.5 && <1.1
, unix ^>=2.7
, unix-bytestring ^>=0.3.7.3
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
build-depends: vty >=5.28.2 && <5.34
-- other-modules:
-- other-extensions:
hs-source-dirs: lib
executable ghcup
main-is: Main.hs
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
import:
config
, base
, bytestring
, containers
, haskus-utils-variant
, monad-logger
, megaparsec
, mtl
, optparse-applicative
, text
, versions
, hpath
, hpath-io
, pretty-terminal
, resourcet
, string-interpolate
, table-layout
, uri-bytestring
, utf8-string
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates -threaded
--
main-is: Main.hs
build-depends:
, aeson >=1.4 && <1.6
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.13 && <5
, bytestring ^>=0.10
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-variant >=3.0 && <3.2
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, template-haskell >=2.7 && <2.18
, text ^>=1.2.4.0
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, versions >=4.0.1 && <5.1
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick ^>=0.64
, transformers ^>=0.5
, vector ^>=0.12
, vty >=5.28.2 && <5.34
if os(windows)
cpp-options: -DIS_WINDOWS
-- other-modules:
-- other-extensions:
build-depends: ghcup
hs-source-dirs: app/ghcup
default-language: Haskell2010
executable ghcup-gen
main-is: Main.hs
hs-source-dirs: app/ghcup-gen
other-modules: Validate
default-language: Haskell2010
default-extensions:
DeriveGeneric
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
QuasiQuotes
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
TypeApplications
TypeFamilies
ViewPatterns
import:
config
, base
, aeson
, aeson-pretty
, bytestring
, containers
, safe-exceptions
, haskus-utils-variant
, monad-logger
, mtl
, optics
, optparse-applicative
, text
, versions
, hpath
, pretty-terminal
, resourcet
, string-interpolate
, table-layout
, transformers
, uri-bytestring
, utf8-string
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates -threaded
--
main-is: Main.hs
other-modules:
GHCupDownloads
Validate
build-depends:
, base >=4.13 && <5
, bytestring ^>=0.10
, containers ^>=0.6
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-variant >=3.0 && <3.2
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0
, mtl ^>=2.2
, optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, safe-exceptions ^>=0.1
, text ^>=1.2.4.0
, transformers ^>=0.5
, versions >=4.0.1 && <5.1
-- other-extensions:
build-depends: ghcup
hs-source-dirs: app/ghcup-gen
default-language: Haskell2010
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
GHCup.Types.JSONSpec
Spec
default-language: Haskell2010
default-extensions:
LambdaCase
MultiWayIf
PackageImports
RecordWildCards
ScopedTypeVariables
TupleSections
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
build-depends:
, base >=4.13 && <5
, bytestring ^>=0.10
, containers ^>=0.6
, generic-arbitrary ^>=0.1.0
, ghcup
, hspec ^>=2.7.10
, hspec-golden-aeson ^>=0.9
, QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0
, text ^>=1.2.4.0
, uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1
default-language: Haskell2010
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: MyLibTest.hs
build-depends: base >=4.12.0.0

View File

@@ -1,10 +0,0 @@
cradle:
cabal:
- component: "ghcup:lib:ghcup"
path: ./lib
- component: "ghcup:exe:ghcup"
path: ./app/ghcup
- component: "ghcup:exe:ghcup-gen"
path: "./app/ghcup-gen"
- component: "ghcup:test:ghcup-test"
path: ./test

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,179 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module GHCup.Download.IOStreams where
import GHCup.Download.Utils
import GHCup.Errors
import GHCup.Types.JSON ( )
import GHCup.Utils.Prelude
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Reader
import Data.ByteString ( ByteString )
import Data.ByteString.Builder
import Data.CaseInsensitive ( CI, original, mk )
import Data.IORef
import Data.Maybe
import Data.Text.Read
import Haskus.Utils.Variant.Excepts
import Network.Http.Client hiding ( URL )
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import System.ProgressBar
import URI.ByteString
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M
import qualified System.IO.Streams as Streams
----------------------------
--[ Low-level (non-curl) ]--
----------------------------
-- | Load the result of this download into memory at once.
downloadBS' :: MonadIO m
=> Bool -- ^ https?
-> ByteString -- ^ host (e.g. "www.example.com")
-> ByteString -- ^ path (e.g. "/my/file") including query
-> Maybe Int -- ^ optional port (e.g. 3000)
-> Excepts
'[ HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
]
m
L.ByteString
downloadBS' https host path port = do
bref <- liftIO $ newIORef (mempty :: Builder)
let stepper bs = modifyIORef bref (<> byteString bs)
void $ downloadInternal False https host path port stepper (pure ()) mempty
liftIO (readIORef bref <&> toLazyByteString)
downloadToFile :: (MonadMask m, MonadIO m)
=> Bool -- ^ https?
-> ByteString -- ^ host (e.g. "www.example.com")
-> ByteString -- ^ path (e.g. "/my/file") including query
-> Maybe Int -- ^ optional port (e.g. 3000)
-> FilePath -- ^ destination file to create and write to
-> 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
=> Bool -- ^ whether to show a progress bar
-> Bool -- ^ https?
-> ByteString -- ^ host
-> 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
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
]
m
Response
downloadInternal = go (5 :: Int)
where
go redirs progressBar https host path port consumer setup addHeaders = do
r <- liftIO $ withConnection' https host port action
veitherToExcepts r >>= \case
Right r' ->
if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
Left res -> pure res
where
action c = do
let q = buildRequest1 $ do
http GET path
flip M.traverseWithKey addHeaders $ \key val -> setHeader (original key) val
sendRequest c q emptyBody
receiveResponse
c
(\r i' -> runE $ do
let scode = getStatusCode r
if
| 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 $ Right r'
Nothing -> throwE NoLocationHeader
| 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 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 :: Maybe (ProgressBar ())) <- if progressBar
then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
else pure Nothing
outStream <- liftIO $ Streams.makeOutputStream
(\case
Just bs -> do
forM_ mpb $ \pb -> incProgress pb (BS.length bs)
void $ consumer bs
Nothing -> pure ()
)
liftIO $ Streams.connect i' outStream
withConnection' :: Bool
-> ByteString
-> Maybe Int
-> (Connection -> IO a)
-> IO a
withConnection' https host port = bracket acquire closeConnection
where
acquire = case https of
True -> do
ctx <- baselineContextSSL
openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
False -> openConnection host (fromIntegral $ fromMaybe 80 port)

View File

@@ -1,60 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module GHCup.Download.Utils where
import GHCup.Errors
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Prelude
import Control.Applicative
import Control.Monad
import Data.ByteString ( ByteString )
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import URI.ByteString
import qualified Data.Binary.Builder as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
-- | Extracts from a URI type: (https?, host, path+query, port)
uriToQuadruple :: Monad m
=> URI
-> Excepts
'[UnsupportedScheme]
m
(Bool, ByteString, ByteString, Maybe Int)
uriToQuadruple URI {..} = do
let scheme = view schemeBSL' uriScheme
host <-
preview (_Just % authorityHostL' % hostBSL') uriAuthority
?? UnsupportedScheme
https <- if
| scheme == "https" -> pure True
| scheme == "http" -> pure False
| otherwise -> throwE UnsupportedScheme
let queryBS =
BS.intercalate "&"
. fmap (\(x, y) -> encodeQuery x <> "=" <> encodeQuery y)
$ queryPairs uriQuery
port =
preview (_Just % authorityPortL' % _Just % portNumberL') uriAuthority
fullpath = if BS.null queryBS then uriPath else uriPath <> "?" <> queryBS
pure (https, host, fullpath, port)
where encodeQuery = L.toStrict . B.toLazyByteString . urlEncodeQuery

View File

@@ -1,38 +1,18 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-|
Module : GHCup.Errors
Description : GHCup error types
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Errors where
import GHCup.Types
import Codec.Archive
import Control.Exception.Safe
import Data.ByteString ( ByteString )
import Data.CaseInsensitive ( CI )
import Data.Text ( Text )
import Data.Versions
import Haskus.Utils.Variant
import Text.PrettyPrint hiding ( (<>) )
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import HPath
@@ -46,250 +26,68 @@ import qualified Data.Text as T
data NoCompatiblePlatform = NoCompatiblePlatform String -- the platform we got
deriving Show
instance Pretty NoCompatiblePlatform where
pPrint (NoCompatiblePlatform str') =
text ("Could not find a compatible platform. Got: " ++ str')
-- | Unable to find a download for the requested version/distro.
-- | Unable to find a download for the requested versio/distro.
data NoDownload = NoDownload
deriving Show
instance Pretty NoDownload where
pPrint NoDownload =
text "Unable to find a download for the requested version/distro."
-- | No update available or necessary.
data NoUpdate = NoUpdate
deriving Show
instance Pretty NoUpdate where
pPrint NoUpdate = text "No update available or necessary."
-- | The Architecture is unknown and unsupported.
data NoCompatibleArch = NoCompatibleArch String
deriving Show
instance Pretty NoCompatibleArch where
pPrint (NoCompatibleArch arch) =
text ("The Architecture is unknown or unsupported. Got: " ++ arch)
-- | Unable to figure out the distribution of the host.
data DistroNotFound = DistroNotFound
deriving Show
instance Pretty DistroNotFound where
pPrint DistroNotFound =
text "Unable to figure out the distribution of the host."
-- | The archive format is unknown. We don't know how to extract it.
data UnknownArchive = UnknownArchive FilePath
data UnknownArchive = UnknownArchive ByteString
deriving Show
instance Pretty UnknownArchive where
pPrint (UnknownArchive file) =
text $ "The archive format is unknown. We don't know how to extract the file " <> file
-- | The scheme is not supported (such as ftp).
data UnsupportedScheme = UnsupportedScheme
deriving Show
instance Pretty UnsupportedScheme where
pPrint UnsupportedScheme = text "The scheme is not supported (such as ftp)."
-- | Unable to copy a file.
data CopyError = CopyError String
deriving Show
instance Pretty CopyError where
pPrint (CopyError reason) =
text ("Unable to copy a file. Reason was: " ++ reason)
-- | Unable to find a tag of a tool.
data TagNotFound = TagNotFound Tag Tool
deriving Show
instance Pretty TagNotFound where
pPrint (TagNotFound tag tool) =
text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
-- | Unable to find the next version of a tool (the one after the currently
-- set one).
data NextVerNotFound = NextVerNotFound Tool
deriving Show
instance Pretty NextVerNotFound where
pPrint (NextVerNotFound tool) =
text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
-- | The tool (such as GHC) is already installed with that version.
data AlreadyInstalled = AlreadyInstalled Tool Version
deriving Show
instance Pretty AlreadyInstalled where
pPrint (AlreadyInstalled tool ver') =
pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
-- | The Directory is supposed to be empty, but wasn't.
data DirNotEmpty = DirNotEmpty {path :: FilePath}
instance Pretty DirNotEmpty where
pPrint (DirNotEmpty path) = do
text $ "The directory was expected to be empty, but isn't: " <> path
-- | The tool is not installed. Some operations rely on a tool
-- to be installed (such as setting the current GHC version).
data NotInstalled = NotInstalled Tool GHCTargetVersion
data NotInstalled = NotInstalled Tool Version
deriving Show
instance Pretty NotInstalled where
pPrint (NotInstalled tool ver) =
text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
-- | An executable was expected to be in PATH, but was not found.
data NotFoundInPATH = NotFoundInPATH FilePath
deriving Show
instance Exception NotFoundInPATH
instance Pretty NotFoundInPATH where
pPrint (NotFoundInPATH exe) =
text $ "The exe " <> exe <> " was not found in PATH."
-- | JSON decoding failed.
data JSONError = JSONDecodeError String
deriving Show
instance Pretty JSONError where
pPrint (JSONDecodeError err) =
text $ "JSON decoding failed with: " <> err
-- | A file that is supposed to exist does not exist
-- (e.g. when we use file scheme to "download" something).
data FileDoesNotExistError = FileDoesNotExistError FilePath
data FileDoesNotExistError = FileDoesNotExistError ByteString
deriving Show
instance Pretty FileDoesNotExistError where
pPrint (FileDoesNotExistError file) =
text $ "File " <> file <> " does not exist."
-- | The file already exists
-- (e.g. when we use isolated installs with the same path).
-- (e.g. This is done to prevent any overwriting)
data FileAlreadyExistsError = FileAlreadyExistsError FilePath
deriving Show
instance Pretty FileAlreadyExistsError where
pPrint (FileAlreadyExistsError file) =
text $ "File " <> file <> " Already exists."
data TarDirDoesNotExist = TarDirDoesNotExist TarDir
deriving Show
instance Pretty TarDirDoesNotExist where
pPrint (TarDirDoesNotExist dir) =
text "Tar directory does not exist:" <+> pPrint dir
-- | File digest verification failed.
data DigestError = DigestError FilePath Text Text
data DigestError = DigestError Text Text
deriving Show
instance Pretty DigestError where
pPrint (DigestError fp currentDigest expectedDigest) =
text "Digest error for" <+> text (fp <> ": expected")
<+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest <+> text
"\nConsider removing the file in case it's cached and try again."
-- | File digest verification failed.
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
deriving instance Show GPGError
instance Pretty GPGError where
pPrint (GPGError reason) = text "GPG verify failed:" <+> pPrint reason
-- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
data HTTPStatusError = HTTPStatusError Int
deriving Show
instance Pretty HTTPStatusError where
pPrint (HTTPStatusError status _) =
text "Unexpected HTTP status:" <+> pPrint status
-- | Malformed headers.
data MalformedHeaders = MalformedHeaders Text
deriving Show
instance Pretty MalformedHeaders where
pPrint (MalformedHeaders h) =
text "Headers are malformed: " <+> pPrint h
-- | Unexpected HTTP status.
data HTTPNotModified = HTTPNotModified Text
deriving Show
instance Pretty HTTPNotModified where
pPrint (HTTPNotModified etag) =
text "Remote resource not modifed, etag was:" <+> pPrint etag
-- | The 'Location' header was expected during a 3xx redirect, but not found.
data NoLocationHeader = NoLocationHeader
deriving Show
instance Pretty NoLocationHeader where
pPrint NoLocationHeader =
text "The 'Location' header was expected during a 3xx redirect, but not found."
-- | Too many redirects.
data TooManyRedirs = TooManyRedirs
deriving Show
instance Pretty TooManyRedirs where
pPrint TooManyRedirs =
text "Too many redirections."
-- | A patch could not be applied.
data PatchFailed = PatchFailed
deriving Show
instance Pretty PatchFailed where
pPrint PatchFailed =
text "A patch could not be applied."
-- | The tool requirements could not be found.
data NoToolRequirements = NoToolRequirements
deriving Show
instance Pretty NoToolRequirements where
pPrint NoToolRequirements =
text "The Tool requirements could not be found."
data InvalidBuildConfig = InvalidBuildConfig Text
deriving Show
instance Pretty InvalidBuildConfig where
pPrint (InvalidBuildConfig reason) =
text "The build config is invalid. Reason was:" <+> pPrint reason
data NoToolVersionSet = NoToolVersionSet Tool
deriving Show
instance Pretty NoToolVersionSet where
pPrint (NoToolVersionSet tool) =
text "No version is set for tool" <+> pPrint tool <+> text "."
data NoNetwork = NoNetwork
deriving Show
instance Pretty NoNetwork where
pPrint NoNetwork =
text "A download was required or requested, but '--offline' was specified."
data HadrianNotFound = HadrianNotFound
deriving Show
instance Pretty HadrianNotFound where
pPrint HadrianNotFound =
text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
-------------------------
@@ -297,37 +95,19 @@ instance Pretty HadrianNotFound where
-------------------------
-- | A download failed. The underlying error is encapsulated.
data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
instance Pretty DownloadFailed where
pPrint (DownloadFailed reason) =
case reason of
VMaybe (_ :: DownloadFailed) -> pPrint reason
_ -> text "Download failed:" <+> pPrint reason
data DownloadFailed = forall es . Show (V es) => DownloadFailed (V es)
deriving instance Show DownloadFailed
-- | A build failed.
data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
instance Pretty BuildFailed where
pPrint (BuildFailed path reason) =
case reason of
VMaybe (_ :: BuildFailed) -> pPrint reason
_ -> text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
data BuildFailed = forall es . Show (V es) => BuildFailed (Path Abs) (V es)
deriving instance Show BuildFailed
-- | Setting the current GHC version failed.
data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
instance Pretty GHCupSetError where
pPrint (GHCupSetError reason) =
case reason of
VMaybe (_ :: GHCupSetError) -> pPrint reason
_ -> text "Setting the current GHC version failed:" <+> pPrint reason
data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es)
deriving instance Show GHCupSetError
@@ -341,75 +121,4 @@ deriving instance Show GHCupSetError
data ParseError = ParseError String
deriving Show
instance Pretty ParseError where
pPrint (ParseError reason) =
text "Parsing failed:" <+> pPrint reason
instance Exception ParseError
data UnexpectedListLength = UnexpectedListLength String
deriving Show
instance Pretty UnexpectedListLength where
pPrint (UnexpectedListLength reason) =
text "List length unexpected:" <+> pPrint reason
instance Exception UnexpectedListLength
data NoUrlBase = NoUrlBase Text
deriving Show
instance Pretty NoUrlBase where
pPrint (NoUrlBase url) =
text "Couldn't get a base filename from url" <+> pPrint url
instance Exception NoUrlBase
------------------------
--[ orphan instances ]--
------------------------
instance Pretty (V '[]) where
{-# INLINABLE pPrint #-}
pPrint _ = undefined
instance
( Pretty x
, Pretty (V xs)
) => Pretty (V (x ': xs))
where
pPrint v = case popVariantHead v of
Right x -> pPrint x
Left xs -> pPrint xs
instance Pretty URIParseError where
pPrint (MalformedScheme reason) =
text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
pPrint MalformedUserInfo =
text "Failed to parse URI. Malformed user info."
pPrint MalformedQuery =
text "Failed to parse URI. Malformed query."
pPrint MalformedFragment =
text "Failed to parse URI. Malformed fragment."
pPrint MalformedHost =
text "Failed to parse URI. Malformed host."
pPrint MalformedPort =
text "Failed to parse URI. Malformed port."
pPrint MalformedPath =
text "Failed to parse URI. Malformed path."
pPrint (OtherError err) =
text "Failed to parse URI:" <+> pPrint err
instance Pretty ArchiveResult where
pPrint ArchiveFatal = text "Archive result: fatal"
pPrint ArchiveFailed = text "Archive result: failed"
pPrint ArchiveWarn = text "Archive result: warning"
pPrint ArchiveRetry = text "Archive result: retry"
pPrint ArchiveOk = text "Archive result: Ok"
pPrint ArchiveEOF = text "Archive result: EOF"
instance Pretty T.Text where
pPrint = text . T.unpack

View File

@@ -6,86 +6,58 @@
{-# LANGUAGE TemplateHaskell #-}
{-|
Module : GHCup.Plaform
Description : Retrieving platform information
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Platform where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Bash
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Class ( lift )
import Data.ByteString ( ByteString )
import Data.Foldable
import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions
import HPath
import HPath.IO
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( abs
, readFile
, writeFile
)
import System.Info
import System.Directory
import System.OsRelease
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
--------------------------
--[ Platform detection ]--
--------------------------
-- | Get the full platform request, consisting of architecture, distro, ...
platformRequest :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformRequest
platformRequest = do
(PlatformResult rp rv) <- liftE getPlatform
ar <- lE getArchitecture
pure $ PlatformRequest ar rp rv
getArchitecture :: Either NoCompatibleArch Architecture
getArchitecture = case arch of
"x86_64" -> Right A_64
"i386" -> Right A_32
"powerpc" -> Right A_PowerPC
"powerpc64" -> Right A_PowerPC64
"powerpc64le" -> Right A_PowerPC64
"sparc" -> Right A_Sparc
"sparc64" -> Right A_Sparc64
"arm" -> Right A_ARM
"aarch64" -> Right A_ARM64
what -> Left (NoCompatibleArch what)
"x86_64" -> Right A_64
"i386" -> Right A_32
what -> Left (NoCompatibleArch what)
getPlatform :: (Alternative m, MonadReader env m, HasLog env, MonadCatch m, MonadIO m, MonadFail m)
getPlatform :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Excepts
'[NoCompatiblePlatform, DistroNotFound]
'[NoCompatiblePlatform , DistroNotFound]
m
PlatformResult
getPlatform = do
@@ -93,39 +65,28 @@ getPlatform = do
"linux" -> do
(distro, ver) <- liftE getLinuxDistro
pure $ PlatformResult { _platform = Linux distro, _distroVersion = ver }
"darwin" -> do
ver <-
either (const Nothing) Just
. versioning
-- TODO: maybe do this somewhere else
. decUTF8Safe'
<$> getDarwinVersion
pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
-- TODO: these are not verified
"darwin" ->
pure $ PlatformResult { _platform = Darwin, _distroVersion = Nothing }
"freebsd" -> do
ver <-
either (const Nothing) Just . versioning . decUTF8Safe'
<$> getFreeBSDVersion
ver <- getFreeBSDVersion
pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
"mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
what -> throwE $ NoCompatiblePlatform what
lift $ logDebug $ "Identified Platform as: " <> T.pack (prettyShow pfr)
lift $ $(logDebug) [i|Identified Platform as: #{pfr}|]
pure pfr
where
getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
getDarwinVersion = lift $ fmap _stdOut $ executeOut "sw_vers"
["-productVersion"]
Nothing
where getFreeBSDVersion = pure Nothing
getLinuxDistro :: (Alternative m, MonadCatch m, MonadIO m, MonadFail m)
getLinuxDistro :: (MonadCatch m, MonadIO m)
=> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
getLinuxDistro = do
-- TODO: don't do alternative on IO, because it hides bugs
(name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ lift $ asum
[ liftIO try_os_release
(name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ liftIO $ asum
[ try_os_release
, try_lsb_release_cmd
, liftIO try_redhat_release
, liftIO try_debian_version
, try_lsb_release
, try_redhat_release
, try_debian_version
]
let parsedVer = ver >>= either (const Nothing) Just . versioning
distro = if
@@ -142,38 +103,49 @@ getLinuxDistro = do
| otherwise -> UnknownLinux
pure (distro, parsedVer)
where
hasWord t = any (\x -> match (regex x) (T.unpack t))
hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y)
False
matches
where
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
lsb_release_cmd :: FilePath
lsb_release_cmd = "lsb-release"
redhat_release :: FilePath
redhat_release = "/etc/redhat-release"
debian_version :: FilePath
debian_version = "/etc/debian_version"
os_release :: Path Abs
os_release = [abs|/etc/os-release|]
lsb_release :: Path Abs
lsb_release = [abs|/etc/lsb-release|]
lsb_release_cmd :: Path Rel
lsb_release_cmd = [rel|lsb-release|]
redhat_release :: Path Abs
redhat_release = [abs|/etc/redhat-release|]
debian_version :: Path Abs
debian_version = [abs|/etc/debian_version|]
try_os_release :: IO (Text, Maybe Text)
try_os_release = do
Just OsRelease{ name = name, version_id = version_id } <-
fmap osRelease <$> parseOsRelease
pure (T.pack name, fmap T.pack version_id)
(Just name) <- getAssignmentValueFor os_release "NAME"
ver <- getAssignmentValueFor os_release "VERSION_ID"
pure (T.pack name, fmap T.pack ver)
try_lsb_release_cmd :: (MonadFail m, MonadIO m)
=> m (Text, Maybe Text)
try_lsb_release_cmd :: IO (Text, Maybe Text)
try_lsb_release_cmd = do
(Just _) <- liftIO $ findExecutable lsb_release_cmd
(Just _) <- findExecutable lsb_release_cmd
name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing
ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing
pure (decUTF8Safe' name, Just $ decUTF8Safe' ver)
pure (E.decodeUtf8 name, Just $ E.decodeUtf8 ver)
try_lsb_release :: IO (Text, Maybe Text)
try_lsb_release = do
(Just name) <- getAssignmentValueFor lsb_release "DISTRIB_ID"
ver <- getAssignmentValueFor lsb_release "DISTRIB_RELEASE"
pure (T.pack name, fmap T.pack ver)
try_redhat_release :: IO (Text, Maybe Text)
try_redhat_release = do
t <- T.readFile redhat_release
t <- fmap lBS2sT $ readFile redhat_release
let nameRegex n =
makeRegexOpts compIgnoreCase
execBlank
([s|\<|] <> fS n <> [s|\>|] :: ByteString) :: Regex
(([s|\<|] <> fS n <> [s|\>|] :: ByteString)) :: Regex
let verRegex =
makeRegexOpts compIgnoreCase
execBlank
@@ -191,5 +163,5 @@ getLinuxDistro = do
try_debian_version :: IO (Text, Maybe Text)
try_debian_version = do
ver <- T.readFile debian_version
pure (T.pack "debian", Just ver)
ver <- readFile debian_version
pure (T.pack "debian", Just $ lBS2sT ver)

View File

@@ -1,69 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Requirements
Description : Requirements utilities
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Requirements where
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Version
import Control.Applicative
import Data.List ( find )
import Data.Maybe
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
-- | Get the requirements. Right now this combines GHC and cabal
-- and doesn't do fine-grained distinction. However, the 'ToolRequirements'
-- type allows it.
getCommonRequirements :: PlatformResult
-> ToolRequirements
-> Maybe Requirements
getCommonRequirements pr tr =
with_distro <|> without_distro_ver <|> without_distro
where
with_distro = distro_preview _platform _distroVersion
without_distro_ver = distro_preview _platform (const Nothing)
without_distro = distro_preview (set _Linux UnknownLinux . _platform) (const Nothing)
distro_preview f g =
let platformVersionSpec =
preview (ix GHC % ix Nothing % ix (f pr)) tr
mv' = g pr
in fmap snd
. find
(\(mverRange, _) -> maybe
(isNothing mv')
(\range -> maybe False (`versionRange` range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
prettyRequirements :: Requirements -> T.Text
prettyRequirements Requirements {..} =
let d = if not . null $ _distroPKGs
then "\n Please ensure the following distro packages "
<> "are installed before continuing (you can exit ghcup "
<> "and return at any time): "
<> T.intercalate " " _distroPKGs
else ""
n = if not . T.null $ _notes then "\n Note: " <> _notes else ""
in "System requirements " <> d <> n

View File

@@ -1,92 +1,16 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-|
Module : GHCup.Types
Description : GHCup types
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Types
( module GHCup.Types
#if defined(BRICK)
, Key(..)
#endif
)
where
module GHCup.Types where
import Control.DeepSeq ( NFData, rnf )
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Text ( Text )
import Data.Versions
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
import HPath
import URI.ByteString
#if defined(BRICK)
import Graphics.Vty ( Key(..) )
#endif
import qualified Data.Text as T
import qualified GHC.Generics as GHC
#if !defined(BRICK)
data Key = KEsc | KChar Char | KBS | KEnter
| KLeft | KRight | KUp | KDown
| KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
| KFun Int | KBackTab | KPrtScr | KPause | KIns
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
deriving (Eq,Show,Read,Ord,GHC.Generic)
#endif
--------------------
--[ GHCInfo Tree ]--
--------------------
data GHCupInfo = GHCupInfo
{ _toolRequirements :: ToolRequirements
, _ghcupDownloads :: GHCupDownloads
, _globalTools :: Map GlobalTool DownloadInfo
}
deriving (Show, GHC.Generic)
instance NFData GHCupInfo
-------------------------
--[ Requirements Tree ]--
-------------------------
type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe VersionRange) Requirements
data Requirements = Requirements
{ _distroPKGs :: [Text]
, _notes :: Text
}
deriving (Show, GHC.Generic)
instance NFData Requirements
---------------------
@@ -100,121 +24,44 @@ type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map Version VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
-- | An installable tool.
data Tool = GHC
| Cabal
| GHCup
| HLS
| Stack
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
instance Pretty Tool where
pPrint GHC = text "ghc"
pPrint Cabal = text "cabal"
pPrint GHCup = text "ghcup"
pPrint HLS = text "hls"
pPrint Stack = text "stack"
instance NFData Tool
data GlobalTool = ShimGen
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
instance NFData GlobalTool
deriving (Eq, GHC.Generic, Ord, Show)
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
-- informative messages
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
{ _viTags :: [Tag] -- ^ version specific tag
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
}
deriving (Eq, GHC.Generic, Show)
instance NFData VersionInfo
deriving (Eq, Show)
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest
| Recommended
| Prerelease
| Base PVP
| Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
deriving (Ord, Eq, Show)
instance NFData Tag
tagToString :: Tag -> String
tagToString Recommended = "recommended"
tagToString Latest = "latest"
tagToString Prerelease = "prerelease"
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
tagToString (UnknownTag t ) = t
tagToString Old = ""
instance Pretty Tag where
pPrint Recommended = text "recommended"
pPrint Latest = text "latest"
pPrint Prerelease = text "prerelease"
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t
pPrint Old = mempty
data Architecture = A_64
| A_32
| A_PowerPC
| A_PowerPC64
| A_Sparc
| A_Sparc64
| A_ARM
| A_ARM64
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData Architecture
archToString :: Architecture -> String
archToString A_64 = "x86_64"
archToString A_32 = "i386"
archToString A_PowerPC = "powerpc"
archToString A_PowerPC64 = "powerpc64"
archToString A_Sparc = "sparc"
archToString A_Sparc64 = "sparc64"
archToString A_ARM = "arm"
archToString A_ARM64 = "aarch64"
instance Pretty Architecture where
pPrint = text . archToString
data Platform = Linux LinuxDistro
-- ^ must exit
| Darwin
-- ^ must exit
| FreeBSD
| Windows
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData Platform
platformToString :: Platform -> String
platformToString (Linux distro) = "linux-" ++ distroToString distro
platformToString Darwin = "darwin"
platformToString FreeBSD = "freebsd"
platformToString Windows = "windows"
instance Pretty Platform where
pPrint = text . platformToString
data LinuxDistro = Debian
| Ubuntu
| Mint
@@ -231,35 +78,16 @@ data LinuxDistro = Debian
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData LinuxDistro
distroToString :: LinuxDistro -> String
distroToString Debian = "debian"
distroToString Ubuntu = "ubuntu"
distroToString Mint = "mint"
distroToString Fedora = "fedora"
distroToString CentOS = "centos"
distroToString RedHat = "redhat"
distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon"
distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown"
instance Pretty LinuxDistro where
pPrint = text . distroToString
-- | An encapsulation of a download. This can be used
-- to download, extract and install a tool.
data DownloadInfo = DownloadInfo
{ _dlUri :: URI
, _dlSubdir :: Maybe TarDir
, _dlSubdir :: Maybe (Path Rel)
, _dlHash :: Text
}
deriving (Eq, Ord, GHC.Generic, Show)
deriving (Eq, Show)
instance NFData DownloadInfo
@@ -268,201 +96,25 @@ instance NFData DownloadInfo
--------------
-- | How to descend into a tar archive.
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
-- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL
| OwnSource URI
| OwnSpec GHCupInfo
| 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
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool
, uGPGSetting :: Maybe GPGSetting
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
UserSettings {
uCache = Just cache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Nothing
, uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
{ kUp = Just bUp
, kDown = Just bDown
, kQuit = Just bQuit
, kInstall = Just bInstall
, kUninstall = Just bUninstall
, kSet = Just bSet
, kChangelog = Just bChangelog
, kShowAll = Just bShowAllVersions
, kShowAllTools = Just bShowAllTools
}
in UserSettings {
uCache = Just cache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Just ukb
, uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
}
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Key
, kDown :: Maybe Key
, kQuit :: Maybe Key
, kInstall :: Maybe Key
, kUninstall :: Maybe Key
, kSet :: Maybe Key
, kChangelog :: Maybe Key
, kShowAll :: Maybe Key
, kShowAllTools :: Maybe Key
}
deriving (Show, GHC.Generic)
data KeyBindings = KeyBindings
{ bUp :: Key
, bDown :: Key
, bQuit :: Key
, bInstall :: Key
, bUninstall :: Key
, bSet :: Key
, bChangelog :: Key
, bShowAllVersions :: Key
, bShowAllTools :: Key
}
deriving (Show, GHC.Generic)
instance NFData KeyBindings
instance NFData Key
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
{ bUp = KUp
, bDown = KDown
, bQuit = KChar 'q'
, bInstall = KChar 'i'
, bUninstall = KChar 'u'
, bSet = KChar 's'
, bChangelog = KChar 'c'
, bShowAllVersions = KChar 'a'
, bShowAllTools = KChar 't'
}
data AppState = AppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
, ghcupInfo :: GHCupInfo
, pfreq :: PlatformRequest
, loggerConfig :: LoggerConfig
} deriving (Show, GHC.Generic)
instance NFData AppState
data LeanAppState = LeanAppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
, loggerConfig :: LoggerConfig
} deriving (Show, GHC.Generic)
instance NFData LeanAppState
| OwnSpec GHCupDownloads
deriving Show
data Settings = Settings
{ cache :: Bool
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
, noNetwork :: Bool
, gpgSetting :: GPGSetting
, noColor :: Bool -- this also exists in LoggerConfig
{ cache :: Bool
, noVerify :: Bool
}
deriving (Show, GHC.Generic)
deriving Show
instance NFData Settings
data Dirs = Dirs
{ baseDir :: FilePath
, binDir :: FilePath
, cacheDir :: FilePath
, logsDir :: FilePath
, confDir :: FilePath
, recycleDir :: FilePath -- mainly used on windows
}
deriving (Show, GHC.Generic)
instance NFData Dirs
data KeepDirs = Always
| Errors
| Never
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData KeepDirs
data Downloader = Curl
| Wget
#if defined(INTERNAL_DOWNLOADER)
| Internal
#endif
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData Downloader
data GPGSetting = GPGStrict
| GPGLax
| GPGNone
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData GPGSetting
data DebugInfo = DebugInfo
{ diBaseDir :: FilePath
, diBinDir :: FilePath
, diGHCDir :: FilePath
, diCacheDir :: FilePath
{ diBaseDir :: Path Abs
, diBinDir :: Path Abs
, diGHCDir :: Path Abs
, diCacheDir :: Path Abs
, diArch :: Architecture
, diPlatform :: PlatformResult
}
@@ -479,110 +131,11 @@ data PlatformResult = PlatformResult
{ _platform :: Platform
, _distroVersion :: Maybe Versioning
}
deriving (Eq, Show, GHC.Generic)
instance NFData PlatformResult
platResToString :: PlatformResult -> String
platResToString PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> T.unpack (prettyV v')
platResToString PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat
instance Pretty PlatformResult where
pPrint = text . platResToString
deriving (Eq, Show)
data PlatformRequest = PlatformRequest
{ _rArch :: Architecture
, _rPlatform :: Platform
, _rVersion :: Maybe Versioning
}
deriving (Eq, Show, GHC.Generic)
instance NFData PlatformRequest
pfReqToString :: PlatformRequest -> String
pfReqToString (PlatformRequest arch plat ver) =
archToString arch ++ "-" ++ platformToString plat ++ pver
where
pver = case ver of
Just v' -> "-" ++ T.unpack (prettyV v')
Nothing -> ""
instance Pretty PlatformRequest where
pPrint = text . pfReqToString
-- | A GHC identified by the target platform triple
-- and the version.
data GHCTargetVersion = GHCTargetVersion
{ _tvTarget :: Maybe Text
, _tvVersion :: Version
}
deriving (Ord, Eq, Show)
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
mkTVer :: Version -> GHCTargetVersion
mkTVer = GHCTargetVersion Nothing
tVerToText :: GHCTargetVersion -> Text
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
-- | Assembles a path of the form: <target-triple>-<version>
instance Pretty GHCTargetVersion where
pPrint = text . T.unpack . tVerToText
-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
| VR_gteq Versioning
| VR_lt Versioning
| VR_lteq 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.
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
instance Pretty Version where
pPrint = text . T.unpack . prettyVer
instance Show (a -> b) where
show _ = "<function>"
instance Show (IO ()) where
show _ = "<io>"
data LogLevel = Warn
| Info
| Debug
| Error
deriving (Eq, Ord, Show)
data LoggerConfig = LoggerConfig
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
, consoleOutter :: T.Text -> IO () -- ^ how to write the console output
, fileOutter :: T.Text -> IO () -- ^ how to write the file output
, fancyColors :: Bool
}
deriving Show
instance NFData LoggerConfig where
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
deriving (Eq, Show)

View File

@@ -10,75 +10,40 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-|
Module : GHCup.Types.JSON
Description : GHCup JSON types/instances
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Types.JSON where
import GHCup.Types
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
-- This is due to the boot file.
import Control.Applicative ( (<|>) )
import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Text.Encoding ( decodeUtf8 )
import Data.Text.Encoding as E
import Data.Versions
import Data.Void
import Data.Word8
import HPath
import URI.ByteString
import Text.Casing
import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where
parseJSON = withText "Tag" $ \t -> case T.unpack t of
"Latest" -> pure Latest
"Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
Left e -> fail . show $ e
x -> pure (UnknownTag x)
instance ToJSON URI where
toJSON = toJSON . decUTF8Safe . serializeURIRef'
toJSON = toJSON . decodeUtf8 . serializeURIRef'
instance FromJSON URI where
parseJSON = withText "URL" $ \t ->
@@ -105,14 +70,14 @@ instance FromJSONKey Versioning where
instance ToJSONKey (Maybe Versioning) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyV x
Nothing -> T.pack "unknown_versioning"
Nothing -> T.pack "unknown_version"
instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
if t == T.pack "unknown_version" then pure Nothing else pure $ just t
where
just t = case versioning t of
Right x -> pure $ Just x
Right x -> pure x
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
instance ToJSONKey Platform where
@@ -120,13 +85,11 @@ instance ToJSONKey Platform where
Darwin -> T.pack "Darwin"
FreeBSD -> T.pack "FreeBSD"
Linux d -> T.pack ("Linux_" <> show d)
Windows -> T.pack "Windows"
instance FromJSONKey Platform where
fromJSONKey = FromJSONKeyTextParser $ \t -> if
| T.pack "Darwin" == t -> pure Darwin
| T.pack "FreeBSD" == t -> pure FreeBSD
| T.pack "Windows" == t -> pure Windows
| T.pack "Linux_" `T.isPrefixOf` t -> case
T.stripPrefix (T.pack "Linux_") t
of
@@ -142,7 +105,7 @@ instance FromJSONKey Platform where
$ "Unexpected failure in decoding LinuxDistro: "
<> show dstr
Nothing -> fail "Unexpected failure in Platform stripPrefix"
| otherwise -> fail "Failure in Platform (FromJSONKey)"
| otherwise -> fail $ "Failure in Platform (FromJSONKey)"
instance ToJSONKey Architecture where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
@@ -150,19 +113,6 @@ instance ToJSONKey Architecture where
instance FromJSONKey Architecture where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey (Maybe Version) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyVer x
Nothing -> T.pack "unknown_version"
instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else just t
where
just t = case version t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where
toJSON = toJSON . prettyVer
@@ -179,146 +129,21 @@ instance FromJSONKey Version where
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
instance ToJSON PVP where
toJSON = toJSON . prettyPVP
instance FromJSON PVP where
parseJSON = withText "PVP" $ \t -> case pvp t of
Right x -> pure x
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
instance ToJSONKey Tool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
instance FromJSONKey Tool where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey GlobalTool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
instance ToJSON (Path Rel) where
toJSON p = case and . fmap isAscii . BS.unpack $ fp of
True -> toJSON . E.decodeUtf8 $ fp
False -> String "/not/a/valid/path"
where fp = toFilePath p
instance FromJSONKey GlobalTool where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSON TarDir where
toJSON (RealDir p) = toJSON p
toJSON (RegexDir r) = object ["RegexDir" .= r]
instance FromJSON TarDir where
parseJSON v = realDir v <|> regexDir v
where
realDir = withText "TarDir" $ \t -> do
fp <- parseJSON (String t)
pure (RealDir fp)
regexDir = withObject "TarDir" $ \o -> do
r <- o .: "RegexDir"
pure $ RegexDir r
instance ToJSON VersionCmp where
toJSON = String . versionCmpToText
instance FromJSON VersionCmp where
parseJSON = withText "VersionCmp" $ \t -> do
case MP.parse versionCmpP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionCmpToText :: VersionCmp -> T.Text
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
versionCmpToText (VR_lt ver') = "< " <> prettyV ver'
versionCmpToText (VR_lteq ver') = "<= " <> prettyV ver'
versionCmpToText (VR_eq ver') = "== " <> prettyV ver'
versionCmpP :: MP.Parsec Void T.Text VersionCmp
versionCmpP =
fmap VR_gt (MP.try $ MPC.space *> MP.chunk ">" *> MPC.space *> versioningEnd)
<|> fmap
VR_gteq
(MP.try $ MPC.space *> MP.chunk ">=" *> MPC.space *> versioningEnd)
<|> fmap
VR_lt
(MP.try $ MPC.space *> MP.chunk "<" *> MPC.space *> versioningEnd)
<|> fmap
VR_lteq
(MP.try $ MPC.space *> MP.chunk "<=" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> MP.chunk "==" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> versioningEnd)
instance ToJSON VersionRange where
toJSON = String . verRangeToText
verRangeToText :: VersionRange -> T.Text
verRangeToText (SimpleRange cmps) =
let inner = foldr1 (\x y -> x <> " && " <> y)
(versionCmpToText <$> NE.toList cmps)
in "( " <> inner <> " )"
verRangeToText (OrRange cmps range) =
let left = verRangeToText (SimpleRange cmps)
right = verRangeToText range
in left <> " || " <> right
instance FromJSON VersionRange where
parseJSON = withText "VersionRange" $ \t -> do
case MP.parse versionRangeP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionRangeP :: MP.Parsec Void T.Text VersionRange
versionRangeP = go <* MP.eof
where
go =
MP.try orParse
<|> MP.try (fmap SimpleRange andParse)
<|> fmap (SimpleRange . pure) versionCmpP
orParse :: MP.Parsec Void T.Text VersionRange
orParse =
(\a o -> OrRange a o)
<$> (MP.try andParse <|> fmap pure versionCmpP)
<*> (MPC.space *> MP.chunk "||" *> MPC.space *> go)
andParse :: MP.Parsec Void T.Text (NonEmpty VersionCmp)
andParse =
fmap (\h t -> h :| t)
(MPC.space *> MP.chunk "(" *> MPC.space *> versionCmpP)
<*> MP.try (MP.many (MPC.space *> MP.chunk "&&" *> MPC.space *> versionCmpP))
<* MPC.space
<* MP.chunk ")"
<* MPC.space
versioningEnd :: MP.Parsec Void T.Text Versioning
versioningEnd =
MP.try (verP (MP.chunk " " <|> MP.chunk ")" <|> MP.chunk "&&") <* MPC.space)
<|> versioning'
instance ToJSONKey (Maybe VersionRange) where
toJSONKey = toJSONKeyText $ \case
Just x -> verRangeToText x
Nothing -> "unknown_versioning"
instance FromJSONKey (Maybe VersionRange) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case MP.parse versionRangeP "" t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
instance FromJSON (Path Rel) where
parseJSON = withText "HPath Rel" $ \t -> do
let d = encodeUtf8 t
case parseRel d of
Right x -> pure x
Left e -> fail $ "Failure in HPath Rel (FromJSON)" <> show e

View File

@@ -1,32 +1,13 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module : GHCup.Types.Optics
Description : GHCup optics
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Types.Optics where
import GHCup.Types
import Control.Monad.Reader
import Data.ByteString ( ByteString )
import Data.ByteString ( ByteString )
import Optics
import URI.ByteString
makePrisms ''Tool
makePrisms ''Architecture
makePrisms ''LinuxDistro
@@ -38,9 +19,6 @@ makeLenses ''DownloadInfo
makeLenses ''Tag
makeLenses ''VersionInfo
makeLenses ''GHCTargetVersion
makeLenses ''GHCupInfo
uriSchemeL' :: Lens' (URIRef Absolute) Scheme
uriSchemeL' = lensVL uriSchemeL
@@ -68,95 +46,3 @@ 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
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
)
=> m LeanAppState
getLeanAppState = do
s <- gets @"settings"
d <- gets @"dirs"
k <- gets @"keyBindings"
l <- gets @"loggerConfig"
pure (LeanAppState s d k l)
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"
getLogCleanup :: ( MonadReader env m
, LabelOptic' "logCleanup" A_Lens env (IO ())
)
=> m (IO ())
getLogCleanup = gets @"logCleanup"
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)
type HasLog env = (LabelOptic' "loggerConfig" A_Lens env LoggerConfig)
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)

File diff suppressed because it is too large Load Diff

View File

@@ -1,4 +0,0 @@
module GHCup.Utils where
getLinkTarget :: FilePath -> IO FilePath
pathIsLink :: FilePath -> IO Bool

69
lib/GHCup/Utils/Bash.hs Normal file
View File

@@ -0,0 +1,69 @@
module GHCup.Utils.Bash
( findAssignment
, equalsAssignmentWith
, getRValue
, getAssignmentValueFor
)
where
import Control.Monad
import Data.ByteString.UTF8 ( toString )
import Data.List
import Data.Maybe
import HPath
import HPath.IO
import Language.Bash.Parse
import Language.Bash.Syntax
import Language.Bash.Word
import Prelude hiding ( readFile )
import qualified Data.ByteString.Lazy.UTF8 as UTF8
extractAssignments :: List -> [Assign]
extractAssignments (List stms) = join $ fmap getAssign $ getCommands stms
where
getCommands :: [Statement] -> [Command]
getCommands = join . fmap commands . catMaybes . fmap findPipes
where
findPipes (Statement (Last p@(Pipeline{})) Sequential) = Just p
findPipes _ = Nothing
getAssign :: Command -> [Assign]
getAssign (Command (SimpleCommand ass _) _) = ass
getAssign _ = []
-- | Find an assignment matching the predicate in the given file.
findAssignment :: Path b -> (Assign -> Bool) -> IO (Maybe Assign)
findAssignment p predicate = do
fileContents <- readFile p
-- TODO: this should accept bytestring:
-- https://github.com/knrafto/language-bash/issues/37
case parse (toString . toFilePath $ p) (UTF8.toString fileContents) of
Left e -> fail $ show e
Right l -> pure $ find predicate (extractAssignments $ l)
-- | Check that the assignment is of the form Foo= ignoring the
-- right hand-side.
equalsAssignmentWith :: String -> Assign -> Bool
equalsAssignmentWith n ass = case ass of
(Assign (Parameter name' Nothing) Equals _) -> n == name'
_ -> False
-- | This pretty-prints the right hand of an Equals assignment, removing
-- quotations. No evaluation is performed.
getRValue :: Assign -> Maybe String
getRValue ass = case ass of
(Assign (Parameter _ _) Equals (RValue w)) -> Just $ unquote w
_ -> Nothing
-- | Given a bash assignment such as Foo="Bar" in the given file,
-- will return "Bar" (without quotations).
getAssignmentValueFor :: Path b -> String -> IO (Maybe String)
getAssignmentValueFor p n = do
mass <- findAssignment p (equalsAssignmentWith n)
pure (mass >>= getRValue)

View File

@@ -1,318 +1,79 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : GHCup.Utils.Dirs
Description : Definition of GHCup directories
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.Dirs
( getAllDirs
, ghcupBaseDir
, ghcupConfigFile
, ghcupCacheDir
, ghcupGHCBaseDir
, ghcupGHCDir
, mkGhcupTmpDir
, parseGHCupGHCDir
, relativeSymlink
, withGHCupTmpDir
, getConfigFilePath
#if !defined(IS_WINDOWS)
, useXDG
#endif
, cleanupTrash
)
where
module GHCup.Utils.Dirs where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils.MegaParsec
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Control.Monad.Trans.Resource hiding (throwM)
import Data.Bifunctor
import Control.Monad.Trans.Resource
import Data.Maybe
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts
import Data.Versions
import HPath
import HPath.IO
import Optics
import System.Directory
import System.DiskSpace
import System.Environment
import System.FilePath
import System.IO.Temp
import Prelude hiding ( abs
, readFile
, writeFile
)
import System.Posix.Env.ByteString ( getEnv
, getEnvDefault
)
import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.YAML.Aeson as Y
import qualified Text.Megaparsec as MP
import Control.Concurrent (threadDelay)
import qualified Data.ByteString.UTF8 as UTF8
import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU
------------------------------
--[ GHCup base directories ]--
------------------------------
-- | ~/.ghcup by default
--
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_DATA_HOME/ghcup' as per xdg spec.
ghcupBaseDir :: IO FilePath
ghcupBaseDir = do
#if defined(IS_WINDOWS)
bdir <- fromMaybe "C:\\" <$> lookupEnv "GHCUP_INSTALL_BASE_PREFIX"
pure (bdir </> "ghcup")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_DATA_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "share")
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
#endif
-- | ~/.ghcup by default
--
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
ghcupConfigDir :: IO FilePath
ghcupConfigDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".config")
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
#endif
-- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
-- (which, sadly is not strictly xdg spec).
ghcupBinDir :: IO FilePath
ghcupBinDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir <&> (</> "bin")
#else
xdg <- useXDG
if xdg
then do
lookupEnv "XDG_BIN_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "bin")
else ghcupBaseDir <&> (</> "bin")
#endif
-- | Defaults to '~/.ghcup/cache'.
--
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup' as per xdg spec.
ghcupCacheDir :: IO FilePath
ghcupCacheDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir <&> (</> "cache")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (bdir </> "ghcup")
else ghcupBaseDir <&> (</> "cache")
#endif
-- | Defaults to '~/.ghcup/logs'.
--
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/logs' as per xdg spec.
ghcupLogsDir :: IO FilePath
ghcupLogsDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir <&> (</> "logs")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (bdir </> "ghcup" </> "logs")
else ghcupBaseDir <&> (</> "logs")
#endif
-- | '~/.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 { .. }
-------------------
--[ GHCup files ]--
-------------------
getConfigFilePath :: (MonadIO m) => m FilePath
getConfigFilePath = do
confDir <- liftIO ghcupConfigDir
pure $ confDir </> "config.yaml"
ghcupConfigFile :: (MonadIO m)
=> Excepts '[JSONError] m UserSettings
ghcupConfigFile = do
filepath <- getConfigFilePath
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
case contents of
Nothing -> pure defaultUserSettings
Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
-------------------------
--[ GHCup directories ]--
-------------------------
-- | ~/.ghcup/ghc by default.
ghcupGHCBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
ghcupGHCBaseDir = do
Dirs {..} <- getDirs
pure (baseDir </> "ghc")
ghcupBaseDir :: IO (Path Abs)
ghcupBaseDir = do
getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> parseAbs r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> [rel|.ghcup|])
ghcupGHCBaseDir :: IO (Path Abs)
ghcupGHCBaseDir = ghcupBaseDir <&> (</> [rel|ghc|])
-- | Gets '~/.ghcup/ghc/<ghcupGHCDir>'.
-- The dir may be of the form
-- * armv7-unknown-linux-gnueabihf-8.8.3
-- * 8.8.4
ghcupGHCDir :: (MonadReader env m, HasDirs env, MonadThrow m)
=> GHCTargetVersion
-> m FilePath
ghcupGHCDir :: Version -> IO (Path Abs)
ghcupGHCDir ver = do
ghcbasedir <- ghcupGHCBaseDir
let verdir = T.unpack $ tVerToText ver
verdir <- parseRel (verToBS ver)
pure (ghcbasedir </> verdir)
-- | See 'ghcupToolParser'.
parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
parseGHCupGHCDir (T.pack -> fp) =
throwEither $ MP.parse ghcTargetVerP "" fp
ghcupBinDir :: IO (Path Abs)
ghcupBinDir = ghcupBaseDir <&> (</> [rel|bin|])
ghcupCacheDir :: IO (Path Abs)
ghcupCacheDir = ghcupBaseDir <&> (</> [rel|cache|])
ghcupLogsDir :: IO (Path Abs)
ghcupLogsDir = ghcupBaseDir <&> (</> [rel|logs|])
mkGhcupTmpDir :: ( MonadReader env m
, HasDirs env
, MonadUnliftIO m
, HasLog env
, MonadCatch m
, MonadThrow m
, MonadMask m
, MonadIO m)
=> m FilePath
mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir = do
tmpdir <- liftIO getCanonicalTemporaryDirectory
let minSpace = 5000 -- a rough guess, aight?
space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
when (maybe False (toBytes minSpace >) space) $ do
logWarn ("Possibly insufficient disk space on "
<> T.pack tmpdir
<> ". At least "
<> T.pack (show minSpace)
<> " MB are recommended, but only "
<> toMB (fromJust space)
<> " are free. Consider freeing up disk space or setting TMPDIR env variable.")
logWarn
"...waiting for 10 seconds before continuing anyway, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene
liftIO $ createTempDirectory tmpdir "ghcup"
where
toBytes mb = mb * 1024 * 1024
toMB b = T.pack $ show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
truncate' :: Double -> Int -> Double
truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
where t = 10^n
withGHCupTmpDir :: ( MonadReader env m
, HasDirs env
, HasLog env
, HasSettings env
, MonadUnliftIO 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 ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
. rmPathForcibly
$ fp))
tmpdir <- liftIO $ getEnvDefault "TMPDIR" "/tmp"
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> "ghcup-")
parseAbs tmp
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive
--------------
@@ -320,40 +81,11 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
--------------
#if !defined(IS_WINDOWS)
useXDG :: IO Bool
useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
#endif
relativeSymlink :: FilePath -- ^ the path in which to create the symlink
-> FilePath -- ^ the symlink destination
-> FilePath
relativeSymlink p1 p2 =
let d1 = splitDirectories p1
d2 = splitDirectories p2
common = takeWhile (\(x, y) -> x == y) $ zip d1 d2
cPrefix = drop (length common) d1
in joinPath (replicate (length cPrefix) "..")
<> joinPath ([pathSeparator] : drop (length common) d2)
cleanupTrash :: ( MonadIO m
, MonadMask m
, MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
)
=> m ()
cleanupTrash = do
Dirs { recycleDir } <- getDirs
contents <- liftIO $ listDirectory recycleDir
if null contents
then pure ()
else do
logWarn ("Removing leftover files in " <> T.pack recycleDir)
forM_ contents (\fp -> handleIO (\e ->
logDebug ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
) $ liftIO $ removePathForcibly (recycleDir </> fp))
getHomeDirectory :: IO (Path Abs)
getHomeDirectory = do
e <- getEnv "HOME"
case e of
Just fp -> parseAbs fp
Nothing -> do
h <- PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)
parseAbs $ UTF8.fromString h -- this is a guess

View File

@@ -1,17 +1,347 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module GHCup.Utils.File (
module GHCup.Utils.File.Common,
#if IS_WINDOWS
module GHCup.Utils.File.Windows
#else
module GHCup.Utils.File.Posix
#endif
) where
module GHCup.Utils.File where
import GHCup.Utils.File.Common
#if IS_WINDOWS
import GHCup.Utils.File.Windows
#else
import GHCup.Utils.File.Posix
#endif
import GHCup.Utils.Dirs
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception.Safe
import Control.Monad
import Data.ByteString ( ByteString )
import Data.ByteString.Unsafe ( unsafeUseAsCStringLen )
import Data.Char
import Data.Foldable
import Data.Functor
import Data.IORef
import Data.Maybe
import Data.Word8
import GHC.Conc hiding ( threadWaitRead )
import GHC.Foreign ( peekCStringLen )
import GHC.IO.Encoding ( getLocaleEncoding )
import GHC.IO.Exception
import HPath
import HPath.IO
import Optics
import Streamly
import Streamly.External.ByteString
import Streamly.External.ByteString.Lazy
import System.Console.Concurrent
import System.Console.Pretty
import System.Console.Regions
import System.IO
import System.IO.Error
import System.Posix.Directory.ByteString
import System.Posix.FD as FD
import System.Posix.FilePath hiding ( (</>) )
import System.Posix.Foreign ( oExcl )
import "unix" System.Posix.IO.ByteString
hiding ( openFd )
import System.Posix.Process ( ProcessStatus(..) )
import System.Posix.Types
import qualified Control.Exception as EX
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified System.Posix.Process.ByteString
as SPPB
import Streamly.External.Posix.DirStream
import qualified Streamly.Internal.Memory.ArrayStream
as AS
import qualified Streamly.FileSystem.Handle as FH
import qualified Streamly.Internal.Data.Unfold as SU
import qualified Streamly.Prelude as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
data StopThread = StopThread Bool
deriving Show
instance Exception StopThread
data ProcessError = NonZeroExit Int ByteString [ByteString]
| PTerminated ByteString [ByteString]
| PStopped ByteString [ByteString]
| NoSuchPid ByteString [ByteString]
deriving Show
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: ByteString
, _stdErr :: ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess
readFd :: Fd -> IO L.ByteString
readFd fd = do
handle' <- fdToHandle fd
fromChunksIO $ (S.unfold (SU.finallyIO hClose FH.readChunks) handle')
-- | Read the lines of a file into a stream. The stream holds
-- a file handle as a resource and will close it once the stream
-- terminates (either through exception or because it's drained).
readFileLines :: Path b -> IO (SerialT IO ByteString)
readFileLines p = do
stream <- readFileStream p
pure
. (fmap fromArray)
. AS.splitOn (fromIntegral $ ord '\n')
. (fmap toArray)
$ stream
-- | Find the given executable by searching all *absolute* PATH components.
-- Relative paths in PATH are ignored.
--
-- This shouldn't throw IO exceptions, unless getting the environment variable
-- PATH does.
findExecutable :: Path Rel -> IO (Maybe (Path Abs))
findExecutable ex = do
sPaths <- fmap catMaybes . (fmap . fmap) parseAbs $ getSearchPath
-- We don't want exceptions to mess up our result. If we can't
-- figure out if a file exists, then treat it as a negative result.
asum $ fmap (handleIO (\_ -> pure Nothing)) $ fmap
-- asum for short-circuiting behavior
(\s' -> (isExecutable (s' </> ex) >>= guard) $> (Just (s' </> ex)))
sPaths
-- | Execute the given command and collect the stdout, stderr and the exit code.
-- The command is run in a subprocess.
executeOut :: Path b -- ^ command as filename, e.g. 'ls'
-> [ByteString] -- ^ arguments to the command
-> Maybe (Path Abs) -- ^ chdir to this path
-> IO CapturedProcess
executeOut path args chdir = captureOutStreams $ do
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
SPPB.executeFile (toFilePath path) True args Nothing
execLogged :: ByteString -- ^ thing to execute
-> Bool -- ^ whether to search PATH for the thing
-> [ByteString] -- ^ args for the thing
-> Path Rel -- ^ log filename
-> Maybe (Path Abs) -- ^ optionally chdir into this
-> Maybe [(ByteString, ByteString)] -- ^ optional environment
-> IO (Either ProcessError ())
execLogged exe spath args lfile chdir env = do
ldir <- ghcupLogsDir
logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
bracket (createFile (toFilePath logfile) newFilePerms) closeFd action
where
action fd = do
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
-- start the thread that logs to stdout in a region
done <- newEmptyMVar
tid <-
forkIO
$ EX.handle (\(e :: StopThread) -> pure ())
$ EX.handle (\(e :: IOException) -> pure ())
$ flip finally (putMVar done ())
$ printToRegion fd stdoutRead 6
-- fork our subprocess
pid <- SPPB.forkProcess $ do
void $ dupTo stdoutWrite stdOutput
void $ dupTo stdoutWrite stdError
closeFd stdoutWrite
closeFd stdoutRead
-- execute the action
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
SPPB.executeFile exe spath args env
closeFd stdoutWrite
-- wait for the subprocess to finish
e <- SPPB.getProcessStatus True True pid >>= \case
i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i
i -> pure $ toProcessError exe args i
-- make sure the logging thread stops
case e of
Left _ -> EX.throwTo tid (StopThread False)
Right _ -> EX.throwTo tid (StopThread True)
takeMVar done
closeFd stdoutRead
pure e
-- Reads fdIn and logs the output in a continous scrolling area
-- of 'size' terminal lines. Also writes to a log file.
printToRegion fileFd fdIn size = do
ref <- newIORef ([] :: [ByteString])
displayConsoleRegions $ do
rs <- sequence . replicate size . openConsoleRegion $ Linear
EX.handle
(\(StopThread b) -> do
when b (forM_ rs closeConsoleRegion)
EX.throw (StopThread b)
)
$ readForever
(\bs -> do
modifyIORef' ref (swapRegs bs)
regs <- readIORef ref
forM (zip regs rs) $ \(bs, r) -> do
setConsoleRegion r $ do
w <- consoleWidth
return
. T.pack
. color Blue
. T.unpack
. E.decodeUtf8
. trim w
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
$ bs
SPIB.fdWrite fileFd (bs <> "\n")
)
fdIn
where
swapRegs bs regs | length regs < size = regs ++ [bs]
| otherwise = tail regs ++ [bs]
-- trim output line to terminal width
trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
| otherwise = bs
-- read an entire line from the file descriptor (removes the newline char)
readLine fd' = do
threadWaitRead fd'
bs <- SPIB.fdRead fd' 1
if
| bs == "\n" -> pure ""
| bs == "" -> pure ""
| otherwise -> fmap (bs <>) $ readLine fd'
readForever action' fd' = do
bs <- readLine fd'
if not $ BS.null bs
then action' bs >> readForever action' fd'
else readForever action' fd'
-- | Capture the stdout and stderr of the given action, which
-- is run in a subprocess. Stdin is closed. You might want to
-- 'race' this to make sure it terminates.
captureOutStreams :: IO a
-- ^ the action to execute in a subprocess
-> IO CapturedProcess
captureOutStreams action =
actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
pid <- SPPB.forkProcess $ do
-- dup stdout
void $ dupTo childStdoutWrite stdOutput
closeFd childStdoutWrite
closeFd parentStdoutRead
-- dup stderr
void $ dupTo childStderrWrite stdError
closeFd childStderrWrite
closeFd parentStderrRead
-- execute the action
void $ action
-- close everything we don't need
closeFd childStdoutWrite
closeFd childStderrWrite
SPPB.getProcessStatus True True pid >>= \case
-- readFd will take care of closing the fd
Just (SPPB.Exited es) -> do
stdout' <- L.toStrict <$> readFd parentStdoutRead
stderr' <- L.toStrict <$> readFd parentStderrRead
pure $ CapturedProcess { _exitCode = es
, _stdOut = stdout'
, _stdErr = stderr'
}
_ -> throwIO $ userError $ ("No such PID " ++ show pid)
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
actionWithPipes a =
createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2)
cleanup :: [Fd] -> IO ()
cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd
-- | Create a new regular file in write-only mode. The file must not exist.
createRegularFileFd :: FileMode -> Path b -> IO Fd
createRegularFileFd fm dest =
FD.openFd (toFilePath dest) WriteOnly [oExcl] (Just fm)
-- | Thin wrapper around `executeFile`.
exec :: ByteString -- ^ thing to execute
-> Bool -- ^ whether to search PATH for the thing
-> [ByteString] -- ^ args for the thing
-> Maybe (Path Abs) -- ^ optionally chdir into this
-> Maybe [(ByteString, ByteString)] -- ^ optional environment
-> IO (Either ProcessError ())
exec exe spath args chdir env = do
pid <- SPPB.forkProcess $ do
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
SPPB.executeFile exe spath args env
fmap (toProcessError exe args) $ SPPB.getProcessStatus True True pid
toProcessError :: ByteString
-> [ByteString]
-> Maybe ProcessStatus
-> Either ProcessError ()
toProcessError exe args mps = case mps of
Just (SPPB.Exited (ExitFailure i)) -> Left $ NonZeroExit i exe args
Just (SPPB.Exited ExitSuccess ) -> Right ()
Just (Terminated _ _ ) -> Left $ PTerminated exe args
Just (Stopped _ ) -> Left $ PStopped exe args
Nothing -> Left $ NoSuchPid exe args
-- | Convert the String to a ByteString with the current
-- system encoding.
unsafePathToString :: Path b -> IO FilePath
unsafePathToString p = do
enc <- getLocaleEncoding
unsafeUseAsCStringLen (toFilePath p) (peekCStringLen enc)
-- | Search for a file in the search paths.
--
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
searchPath :: [Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath paths needle = go paths
where
go [] = pure Nothing
go (x : xs) =
hideErrorDefM PermissionDenied (go xs)
$ hideErrorDefM NoSuchThing (go xs)
$ do
dirStream <- openDirStream (toFilePath x)
S.findM (\(_, p) -> isMatch x p) (dirContentsStream dirStream)
>>= \case
Just _ -> pure $ Just (x </> needle)
Nothing -> go xs
isMatch basedir p = do
if p == toFilePath needle
then isExecutable (basedir </> needle)
else pure False

View File

@@ -1,120 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils.File.Common where
import GHCup.Utils.Prelude
import Control.Monad.Reader
import Data.Maybe
import Data.Text ( Text )
import Data.Void
import GHC.IO.Exception
import Optics hiding ((<|), (|>))
import System.Directory
import System.FilePath
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import Text.Regex.Posix
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
import qualified Text.Megaparsec as MP
data ProcessError = NonZeroExit Int FilePath [String]
| PTerminated FilePath [String]
| PStopped FilePath [String]
| NoSuchPid FilePath [String]
deriving Show
instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: BL.ByteString
, _stdErr :: BL.ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess
-- | Search for a file in the search paths.
--
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
searchPath :: [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath paths needle = go paths
where
go [] = pure Nothing
go (x : xs) =
hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs)
$ do
contents <- listDirectory x
findM (isMatch x) contents >>= \case
Just _ -> pure $ Just (x </> needle)
Nothing -> go xs
isMatch basedir p = do
if p == needle
then isExecutable (basedir </> needle)
else pure False
isExecutable :: FilePath -> IO Bool
isExecutable file = executable <$> getPermissions file
-- | Check wether a binary is shadowed by another one that comes before
-- it in PATH. Returns the path to said binary, if any.
isShadowed :: FilePath -> IO (Maybe FilePath)
isShadowed p = do
let dir = takeDirectory p
let fn = takeFileName p
spaths <- liftIO getSearchPath
if dir `elem` spaths
then do
let shadowPaths = takeWhile (/= dir) spaths
searchPath shadowPaths fn
else pure Nothing
-- | Check whether the binary is in PATH. This returns only `True`
-- if the directory containing the binary is part of PATH.
isInPath :: FilePath -> IO Bool
isInPath p = do
let dir = takeDirectory p
let fn = takeFileName p
spaths <- liftIO getSearchPath
if dir `elem` spaths
then isJust <$> searchPath [dir] fn
else pure False
findFiles :: FilePath -> Regex -> IO [FilePath]
findFiles path regex = do
contents <- listDirectory path
pure $ filter (match regex) contents
findFilesDeep :: FilePath -> Regex -> IO [FilePath]
findFilesDeep path regex = do
contents <- getDirectoryContentsRecursive path
pure $ filter (match regex) contents
findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
findFiles' path parser = do
contents <- listDirectory path
pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
checkFileAlreadyExists fp = liftIO $ doesFileExist fp

View File

@@ -1,5 +0,0 @@
module GHCup.Utils.File.Common where
import Text.Regex.Posix
findFiles :: FilePath -> Regex -> IO [FilePath]

View File

@@ -1,399 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-|
Module : GHCup.Utils.File.Posix
Description : File and unix APIs
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : POSIX
This module handles file and executable handling.
Some of these functions use sophisticated logging.
-}
module GHCup.Utils.File.Posix where
import GHCup.Utils.File.Common
import GHCup.Utils.Prelude
import GHCup.Utils.Logger
import GHCup.Types
import GHCup.Types.Optics
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception ( evaluate )
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.State.Strict
import Data.ByteString ( ByteString )
import Data.Foldable
import Data.IORef
import Data.Sequence ( Seq, (|>) )
import Data.List
import Data.Word8
import GHC.IO.Exception
import System.Console.Terminal.Common
import System.IO.Error
import System.FilePath
import System.Directory
import System.Posix.Directory
import System.Posix.Files
import System.Posix.IO
import System.Posix.Process ( ProcessStatus(..) )
import System.Posix.Types
import qualified Control.Exception as EX
import qualified Data.Sequence as Sq
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified System.Posix.Process as SPP
import qualified System.Console.Terminal.Posix as TP
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified "unix-bytestring" System.Posix.IO.ByteString
as SPIB
-- | Execute the given command and collect the stdout, stderr and the exit code.
-- The command is run in a subprocess.
executeOut :: MonadIO m
=> FilePath -- ^ command as filename, e.g. 'ls'
-> [String] -- ^ arguments to the command
-> Maybe FilePath -- ^ chdir to this path
-> m CapturedProcess
executeOut path args chdir = liftIO $ captureOutStreams $ do
maybe (pure ()) changeWorkingDirectory chdir
SPP.executeFile path True args Nothing
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
-> FilePath -- ^ log filename (opened in append mode)
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execLogged exe args chdir lfile env = do
Settings {..} <- getSettings
Dirs {..} <- getDirs
let logfile = logsDir </> lfile <> ".log"
liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
closeFd
(action verbose noColor)
where
action verbose no_color fd = do
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
-- start the thread that logs to stdout
pState <- newEmptyMVar
done <- newEmptyMVar
void
$ forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ EX.finally
(if verbose
then tee fd stdoutRead
else printToRegion fd stdoutRead 6 pState no_color
)
(putMVar done ())
-- fork the subprocess
pid <- SPP.forkProcess $ do
void $ dupTo stdoutWrite stdOutput
void $ dupTo stdoutWrite stdError
closeFd stdoutRead
closeFd stdoutWrite
-- execute the action
maybe (pure ()) changeWorkingDirectory chdir
void $ SPP.executeFile exe (not ("./" `isPrefixOf` exe)) args env
closeFd stdoutWrite
-- wait for the subprocess to finish
e <- toProcessError exe args <$!> SPP.getProcessStatus True True pid
putMVar pState (either (const False) (const True) e)
void $ race (takeMVar done) (threadDelay (1000000 * 3))
closeFd stdoutRead
pure e
tee :: Fd -> Fd -> IO ()
tee fileFd = readTilEOF lineAction
where
lineAction :: ByteString -> IO ()
lineAction bs' = do
void $ SPIB.fdWrite fileFd (bs' <> "\n")
void $ SPIB.fdWrite stdOutput (bs' <> "\n")
-- Reads fdIn and logs the output in a continous scrolling area
-- of 'size' terminal lines. Also writes to a log file.
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
printToRegion fileFd fdIn size pState no_color = do
-- init region
forM_ [1..size] $ \_ -> BS.putStr "\n"
void $ flip runStateT mempty
$ do
handle
(\(ex :: SomeException) -> do
ps <- liftIO $ takeMVar pState
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen))
throw ex
) $ readTilEOF lineAction fdIn
where
clearScreen :: ByteString
clearScreen = "\x1b[0J"
clearLine :: ByteString
clearLine = "\x1b[2K"
moveLineUp :: Int -> ByteString
moveLineUp n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "A"
moveLineDown :: Int -> ByteString
moveLineDown n = "\x1b[" <> E.encodeUtf8 (T.pack (show n)) <> "B"
pos1 :: ByteString
pos1 = "\r"
overwriteNthLine :: Int -> ByteString -> ByteString
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
blue :: ByteString -> ByteString
blue bs
| no_color = bs
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"
-- action to perform line by line
lineAction :: (MonadMask m, MonadIO m)
=> ByteString
-> StateT (Seq ByteString) m ()
lineAction = \bs' -> do
void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
modify (swapRegs bs')
liftIO TP.size >>= \case
Nothing -> pure ()
Just (Window _ w) -> do
regs <- get
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
BS.putStr
. overwriteNthLine (size - i)
. trim w
. blue
. (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
$ bs
swapRegs :: a -> Seq a -> Seq a
swapRegs bs = \regs -> if
| Sq.length regs < size -> regs |> bs
| otherwise -> Sq.drop 1 regs |> bs
-- trim output line to terminal width
trim :: Int -> ByteString -> ByteString
trim w = \bs -> if
| BS.length bs > w && w > 5 -> BS.take (w - 4) bs <> "..."
| otherwise -> bs
-- Consecutively read from Fd in 512 chunks until we hit
-- newline or EOF.
readLine :: MonadIO m
=> Fd -- ^ input file descriptor
-> ByteString -- ^ rest buffer (read across newline)
-> m (ByteString, ByteString, Bool) -- ^ (full line, rest, eof)
readLine fd = go
where
go inBs = do
-- if buffer is not empty, process it first
mbs <- if BS.length inBs == 0
-- otherwise attempt read
then liftIO
$ handleIO (\e -> if isEOFError e then pure Nothing else ioError e)
$ fmap Just
$ SPIB.fdRead fd 512
else pure $ Just inBs
case mbs of
Nothing -> pure ("", "", True)
Just bs -> do
-- split on newline
let (line, rest) = BS.span (/= _lf) bs
if
| BS.length rest /= 0 -> pure (line, BS.tail rest, False)
-- if rest is empty, then there was no newline, process further
| otherwise -> (\(l, r, b) -> (line <> l, r, b)) <$!> go mempty
readTilEOF :: MonadIO m => (ByteString -> m a) -> Fd -> m ()
readTilEOF ~action' fd' = go mempty
where
go bs' = do
(bs, rest, eof) <- readLine fd' bs'
if eof
then liftIO $ ioError (mkIOError eofErrorType "" Nothing Nothing)
else void (action' bs) >> go rest
-- | Capture the stdout and stderr of the given action, which
-- is run in a subprocess. Stdin is closed. You might want to
-- 'race' this to make sure it terminates.
captureOutStreams :: IO a
-- ^ the action to execute in a subprocess
-> IO CapturedProcess
captureOutStreams action = do
actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
pid <- SPP.forkProcess $ do
-- dup stdout
void $ dupTo childStdoutWrite stdOutput
closeFd childStdoutWrite
closeFd parentStdoutRead
-- dup stderr
void $ dupTo childStderrWrite stdError
closeFd childStderrWrite
closeFd parentStderrRead
-- execute the action
a <- action
void $ evaluate a
-- close everything we don't need
closeFd childStdoutWrite
closeFd childStderrWrite
-- start thread that writes the output
refOut <- newIORef BL.empty
refErr <- newIORef BL.empty
done <- newEmptyMVar
_ <-
forkIO
$ EX.handle (\(_ :: IOException) -> pure ())
$ flip EX.finally (putMVar done ())
$ writeStds parentStdoutRead parentStderrRead refOut refErr
status <- SPP.getProcessStatus True True pid
void $ race (takeMVar done) (threadDelay (1000000 * 3))
case status of
-- readFd will take care of closing the fd
Just (SPP.Exited es) -> do
stdout' <- readIORef refOut
stderr' <- readIORef refErr
pure $ CapturedProcess { _exitCode = es
, _stdOut = stdout'
, _stdErr = stderr'
}
_ -> throwIO $ userError ("No such PID " ++ show pid)
where
writeStds :: Fd -> Fd -> IORef BL.ByteString -> IORef BL.ByteString -> IO ()
writeStds pout perr rout rerr = do
doneOut <- newEmptyMVar
void
$ forkIO
$ hideError eofErrorType
$ flip EX.finally (putMVar doneOut ())
$ readTilEOF (\x -> modifyIORef' rout (<> BL.fromStrict x)) pout
doneErr <- newEmptyMVar
void
$ forkIO
$ hideError eofErrorType
$ flip EX.finally (putMVar doneErr ())
$ readTilEOF (\x -> modifyIORef' rerr (<> BL.fromStrict x)) perr
takeMVar doneOut
takeMVar doneErr
readTilEOF ~action' fd' = do
bs <- SPIB.fdRead fd' 512
void $ action' bs
readTilEOF action' fd'
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
actionWithPipes a =
createPipe >>= \(p1, p2) -> flip finally (cleanup [p1, p2]) $ a (p1, p2)
cleanup :: [Fd] -> IO ()
cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd
-- | Create a new regular file in write-only mode. The file must not exist.
createRegularFileFd :: FileMode -> FilePath -> IO Fd
createRegularFileFd fm dest =
openFd dest WriteOnly (Just fm) defaultFileFlags{ exclusive = True }
-- | Thin wrapper around `executeFile`.
exec :: MonadIO m
=> String -- ^ thing to execute
-> [String] -- ^ args for the thing
-> Maybe FilePath -- ^ optionally chdir into this
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
exec exe args chdir env = liftIO $ do
pid <- SPP.forkProcess $ do
maybe (pure ()) changeWorkingDirectory chdir
SPP.executeFile exe (not ("./" `isPrefixOf` exe)) args env
fmap (toProcessError exe args) $ SPP.getProcessStatus True True pid
toProcessError :: FilePath
-> [String]
-> Maybe ProcessStatus
-> Either ProcessError ()
toProcessError exe args mps = case mps of
Just (SPP.Exited (ExitFailure xi)) -> Left $ NonZeroExit xi exe args
Just (SPP.Exited ExitSuccess ) -> Right ()
Just (Terminated _ _ ) -> Left $ PTerminated exe args
Just (Stopped _ ) -> Left $ PStopped exe args
Nothing -> Left $ NoSuchPid exe args
chmod_755 :: (MonadReader env m, HasLog env, MonadIO m) => FilePath -> m ()
chmod_755 fp = do
let exe_mode =
nullFileMode
`unionFileModes` ownerExecuteMode
`unionFileModes` ownerReadMode
`unionFileModes` ownerWriteMode
`unionFileModes` groupExecuteMode
`unionFileModes` groupReadMode
`unionFileModes` otherExecuteMode
`unionFileModes` otherReadMode
logDebug ("chmod 755 " <> T.pack fp)
liftIO $ setFileMode fp exe_mode
-- |Default permissions for a new file.
newFilePerms :: FileMode
newFilePerms =
ownerWriteMode
`unionFileModes` ownerReadMode
`unionFileModes` groupWriteMode
`unionFileModes` groupReadMode
`unionFileModes` otherWriteMode
`unionFileModes` otherReadMode
-- | Checks whether the binary is a broken link.
isBrokenSymlink :: FilePath -> IO Bool
isBrokenSymlink fp = do
try (pathIsSymbolicLink fp) >>= \case
Right True -> do
let symDir = takeDirectory fp
tfp <- getSymbolicLinkTarget fp
not <$> doesPathExist
-- this drops 'symDir' if 'tfp' is absolute
(symDir </> tfp)
Right b -> pure b
Left e | isDoesNotExistError e -> pure False
| otherwise -> throwIO e

View File

@@ -1,266 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-|
Module : GHCup.Utils.File.Windows
Description : File and windows APIs
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : Windows
This module handles file and executable handling.
Some of these functions use sophisticated logging.
-}
module GHCup.Utils.File.Windows where
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
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Reader
import Data.List
import Foreign.C.Error
import GHC.IO.Exception
import GHC.IO.Handle
import System.Directory
import System.Environment
import System.FilePath
import System.IO
import System.Process
import qualified Control.Exception as EX
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
toProcessError :: FilePath
-> [FilePath]
-> ExitCode
-> Either ProcessError ()
toProcessError exe args exitcode = case exitcode of
(ExitFailure xi) -> Left $ NonZeroExit xi exe args
ExitSuccess -> Right ()
-- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it
-- lets you pass 'CreateProcess' giving better flexibility.
--
-- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess
-- record will be ignored.
--
-- @since 1.2.3.0
readCreateProcessWithExitCodeBS
:: CreateProcess
-> BL.ByteString
-> IO (ExitCode, BL.ByteString, BL.ByteString) -- ^ exitcode, stdout, stderr
readCreateProcessWithExitCodeBS cp input = do
let cp_opts = cp {
std_in = CreatePipe,
std_out = CreatePipe,
std_err = CreatePipe
}
withCreateProcess_ "readCreateProcessWithExitCodeBS" cp_opts $
\mb_inh mb_outh mb_errh ph ->
case (mb_inh, mb_outh, mb_errh) of
(Just inh, Just outh, Just errh) -> do
out <- BS.hGetContents outh
err <- BS.hGetContents errh
-- fork off threads to start consuming stdout & stderr
withForkWait (EX.evaluate $ rnf out) $ \waitOut ->
withForkWait (EX.evaluate $ rnf err) $ \waitErr -> do
-- now write any input
unless (BL.null input) $
ignoreSigPipe $ BL.hPut inh input
-- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
ignoreSigPipe $ hClose inh
-- wait on the output
waitOut
waitErr
hClose outh
hClose errh
-- wait on the process
ex <- waitForProcess ph
return (ex, BL.fromStrict out, BL.fromStrict err)
(Nothing,_,_) -> error "readCreateProcessWithExitCodeBS: Failed to get a stdin handle."
(_,Nothing,_) -> error "readCreateProcessWithExitCodeBS: Failed to get a stdout handle."
(_,_,Nothing) -> error "readCreateProcessWithExitCodeBS: Failed to get a stderr handle."
where
ignoreSigPipe :: IO () -> IO ()
ignoreSigPipe = EX.handle $ \e -> case e of
IOError { ioe_type = ResourceVanished
, ioe_errno = Just ioe }
| Errno ioe == ePIPE -> return ()
_ -> throwIO e
-- wrapper so we can get exceptions with the appropriate function name.
withCreateProcess_
:: String
-> CreateProcess
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ fun c action =
EX.bracketOnError (createProcess_ fun c) cleanupProcess
(\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
-- | Fork a thread while doing something else, but kill it if there's an
-- exception.
--
-- This is important in the cases above because we want to kill the thread
-- that is holding the Handle lock, because when we clean up the process we
-- try to close that handle, which could otherwise deadlock.
--
withForkWait :: IO () -> (IO () -> IO a) -> IO a
withForkWait async' body = do
waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
mask $ \restore -> do
tid <- forkIO $ try (restore async') >>= putMVar waitVar
let wait' = takeMVar waitVar >>= either throwIO return
restore (body wait') `EX.onException` killThread tid
-- | Execute the given command and collect the stdout, stderr and the exit code.
-- The command is run in a subprocess.
executeOut :: MonadIO m
=> FilePath -- ^ command as filename, e.g. 'ls'
-> [String] -- ^ arguments to the command
-> Maybe FilePath -- ^ chdir to this path
-> m CapturedProcess
executeOut path args chdir = do
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
(exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
pure $ CapturedProcess exit out err
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
-> FilePath -- ^ log filename (opened in append mode)
-> Maybe [(String, String)] -- ^ optional environment
-> m (Either ProcessError ())
execLogged exe args chdir lfile env = do
Dirs {..} <- getDirs
let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
stderrLogfile = logsDir </> lfile <> ".stderr.log"
cp <- createProcessWithMingwPath ((proc exe args)
{ cwd = chdir
, env = env
, std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
})
fmap (toProcessError exe args)
$ liftIO
$ withCreateProcess cp
$ \_ mout merr ph ->
case (mout, merr) of
(Just cStdout, Just cStderr) -> do
withForkWait (tee stdoutLogfile cStdout) $ \waitOut ->
withForkWait (tee stderrLogfile cStderr) $ \waitErr -> do
waitOut
waitErr
waitForProcess ph
_ -> fail "Could not acquire out/err handle"
where
tee :: FilePath -> Handle -> IO ()
tee logFile handle' = go
where
go = do
some <- BS.hGetSome handle' 512
if BS.null some
then pure ()
else do
void $ BS.appendFile logFile some
void $ BS.hPut stdout some
go
-- | Thin wrapper around `executeFile`.
exec :: 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 ())
exec exe args chdir env = do
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
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
in liftIO $ setPermissions fp perm
createProcessWithMingwPath :: MonadIO m
=> CreateProcess
-> m CreateProcess
createProcessWithMingwPath cp = do
msys2Dir <- liftIO ghcupMsys2Dir
cEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (env cp)
let mingWPaths = [msys2Dir </> "usr" </> "bin"
,msys2Dir </> "mingw64" </> "bin"]
paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] (mingWPaths ++ curPaths)
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
envWithNewPath = Map.insert "Path" newPath envWithoutPath
liftIO $ setEnv "Path" newPath
pure $ cp { env = Just $ Map.toList envWithNewPath }
ghcupMsys2Dir :: IO FilePath
ghcupMsys2Dir =
lookupEnv "GHCUP_MSYS2" >>= \case
Just fp -> pure fp
Nothing -> do
baseDir <- liftIO ghcupBaseDir
pure (baseDir </> "msys64")
-- | Checks whether the binary is a broken link.
isBrokenSymlink :: FilePath -> IO Bool
isBrokenSymlink fp = do
b <- pathIsLink fp
if b
then do
tfp <- getLinkTarget fp
not <$> doesPathExist
-- this drops 'symDir' if 'tfp' is absolute
(takeDirectory fp </> tfp)
else pure False

View File

@@ -1,131 +1,60 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : GHCup.Utils.Logger
Description : logger definition
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
Here we define our main logger.
-}
module GHCup.Utils.Logger where
import GHCup.Types
import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.File.Common
import GHCup.Utils.String.QQ
import GHCup.Utils
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Text ( Text )
import Optics
import Control.Monad.Logger
import HPath
import HPath.IO
import Prelude hiding ( appendFile )
import System.Console.Pretty
import System.FilePath
import System.IO.Error
import Text.Regex.Posix
import qualified Data.ByteString as B
import GHCup.Utils.Prelude
import qualified Data.Text as T
logInfo :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logInfo = logInternal Info
logWarn :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logWarn = logInternal Warn
logDebug :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logDebug = logInternal Debug
logError :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logError = logInternal Error
logInternal :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
) => LogLevel
-> Text
-> m ()
logInternal logLevel msg = do
LoggerConfig {..} <- gets @"loggerConfig"
let color' c = if fancyColors then color c else id
let style' = case logLevel of
Debug -> style Bold . color' Blue
Info -> style Bold . color' Green
Warn -> style Bold . color' Yellow
Error -> style Bold . color' Red
let l = case logLevel of
Debug -> style' "[ Debug ]"
Info -> style' "[ Info ]"
Warn -> style' "[ Warn ]"
Error -> style' "[ Error ]"
let strs = T.split (== '\n') msg
let out = case strs of
[] -> T.empty
(x:xs) ->
foldr (\a b -> a <> "\n" <> b) mempty
. ((l <> " " <> x) :)
. fmap (\line' -> style' "[ ... ] " <> line' )
$ xs
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
$ liftIO $ consoleOutter out
-- raw output
let lr = case logLevel of
Debug -> "Debug:"
Info -> "Info:"
Warn -> "Warn:"
Error -> "Error:"
let outr = lr <> " " <> msg <> "\n"
liftIO $ fileOutter outr
data LoggerConfig = LoggerConfig
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
, colorOutter :: B.ByteString -> IO () -- ^ how to write the color output
, rawOutter :: B.ByteString -> IO () -- ^ how to write the full raw output
}
initGHCupFileLogging :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadMask m
) => m FilePath
initGHCupFileLogging = do
Dirs { logsDir } <- getDirs
let logfile = logsDir </> "ghcup.log"
logFiles <- liftIO $ findFiles
logsDir
(makeRegexOpts compExtended
execBlank
([s|^.*\.log$|] :: B.ByteString)
)
forM_ logFiles $ hideError doesNotExistErrorType . recycleFile . (logsDir </>)
myLoggerT :: LoggerConfig -> LoggingT m a -> m a
myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
where
mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
mylogger _ _ level str' = do
-- color output
let l = case level of
LevelDebug -> toLogStr (style Bold $ color Blue "[ Debug ]")
LevelInfo -> toLogStr (style Bold $ color Green "[ Info ]")
LevelWarn -> toLogStr (style Bold $ color Yellow "[ Warn ]")
LevelError -> toLogStr (style Bold $ color Red "[ Error ]")
LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
let out = fromLogStr (l <> toLogStr " " <> str' <> toLogStr "\n")
liftIO $ writeFile logfile ""
when (lcPrintDebug || (lcPrintDebug == False && not (level == LevelDebug)))
$ colorOutter out
-- raw output
let lr = case level of
LevelDebug -> toLogStr "Debug: "
LevelInfo -> toLogStr "Info:"
LevelWarn -> toLogStr "Warn:"
LevelError -> toLogStr "Error:"
LevelOther t -> toLogStr t <> toLogStr ":"
let outr = fromLogStr (lr <> toLogStr " " <> str' <> toLogStr "\n")
rawOutter outr
initGHCupFileLogging :: Path Rel -> IO (Path Abs)
initGHCupFileLogging context = do
logs <- ghcupLogsDir
let logfile = logs </> context
createDirIfMissing newDirPerms logs
hideError doesNotExistErrorType $ deleteFile logfile
createRegularFile newFilePerms logfile
pure logfile

View File

@@ -1,21 +0,0 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Logger where
import GHCup.Types
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Text ( Text )
import Optics
logWarn :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()

View File

@@ -1,124 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Utils.MegaParsec
Description : MegaParsec utilities
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.MegaParsec where
import GHCup.Types
import Control.Applicative
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Data.Functor
import Data.Maybe
import Data.Text ( Text )
import Data.Versions
import Data.Void
import System.FilePath
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
choice' [] = fail "Empty list"
choice' [x ] = x
choice' (x : xs) = MP.try x <|> choice' xs
parseUntil :: MP.Parsec Void Text a -> MP.Parsec Void Text Text
parseUntil p = do
(MP.try (MP.lookAhead p) $> mempty)
<|> (do
c <- T.singleton <$> MP.anySingle
c2 <- parseUntil p
pure (c `mappend` c2)
)
parseUntil1 :: MP.Parsec Void Text a -> MP.Parsec Void Text Text
parseUntil1 p = do
i1 <- MP.getOffset
t <- parseUntil p
i2 <- MP.getOffset
if i1 == i2 then fail "empty parse" else pure t
-- | Parses e.g.
-- * armv7-unknown-linux-gnueabihf-ghc
-- * armv7-unknown-linux-gnueabihf-ghci
ghcTargetBinP :: Text -> MP.Parsec Void Text (Maybe Text, Text)
ghcTargetBinP t =
(,)
<$> ( MP.try
(Just <$> parseUntil1 (MP.chunk "-" *> MP.chunk t) <* MP.chunk "-"
)
<|> ((\ _ x -> x) Nothing <$> mempty)
)
<*> (MP.chunk t <* MP.eof)
-- | Extracts the version from @ProjectVersion="8.10.5"@.
ghcProjectVersion :: MP.Parsec Void Text Version
ghcProjectVersion = do
_ <- MP.chunk "ProjectVersion=\""
ver <- parseUntil1 $ MP.chunk "\""
MP.setInput ver
version'
-- | Extracts target triple and version from e.g.
-- * armv7-unknown-linux-gnueabihf-8.8.3
-- * armv7-unknown-linux-gnueabihf-8.8.3
ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion
ghcTargetVerP =
(\x y -> GHCTargetVersion x y)
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
<|> ((\ _ x -> x) Nothing <$> mempty)
)
<*> (version' <* MP.eof)
where
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigists =
and
. take 3
. concatMap
(map
(\case
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList
$ _vChunks v
if startsWithDigists && isNothing (_vEpoch v)
then pure $ prettyVer v
else fail "Oh"
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP suffix = do
ver <- parseUntil suffix
if T.null ver
then fail "empty version"
else do
rest <- MP.getInput
MP.setInput ver
v <- versioning'
MP.setInput rest
pure v
pathSep :: MP.Parsec Void Text Char
pathSep = MP.oneOf pathSeparators

View File

@@ -1,88 +1,41 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-|
Module : GHCup.Utils.Prelude
Description : MegaParsec utilities
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
GHCup specific prelude. Lots of Excepts functionality.
-}
module GHCup.Utils.Prelude where
#if defined(IS_WINDOWS)
import GHCup.Types
#endif
import GHCup.Errors
import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.Logger
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Class ( lift )
import Data.Bifunctor
import Data.ByteString ( ByteString )
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
import Data.Maybe
import Data.Foldable
import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.Monoid ( (<>) )
import Data.String
import Data.Text ( Text )
import Data.Versions
import Data.Word8 hiding ( isDigit )
import Haskus.Utils.Types.List
import Haskus.Utils.Variant.Excepts
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
import System.IO.Error
#if defined(IS_WINDOWS)
import System.IO.Temp
#endif
import System.IO.Unsafe
import System.Directory
import System.FilePath
import System.Posix.Env.ByteString ( getEnvironment )
#if defined(IS_WINDOWS)
import Control.Retry
import GHC.IO.Exception
#endif
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S
import qualified Data.List.Split as Split
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B
import qualified Data.Text.Lazy.Encoding as TLE
#if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32
#endif
-- $setup
-- >>> import Data.ByteString.Internal (c2w, w2c)
-- >>> import Test.QuickCheck
-- >>> import Data.Word8
-- >>> import qualified Data.Text as T
-- >>> import qualified Data.Char as C
-- >>> import Data.List
-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
fS :: IsString a => String -> a
fS = fromString
@@ -135,6 +88,10 @@ whileM_ ~action = void . whileM action
guardM :: (Monad m, Alternative m) => m Bool -> m ()
guardM ~f = guard =<< f
lBS2sT :: L.ByteString -> Text
lBS2sT = TL.toStrict . TLE.decodeUtf8
handleIO' :: (MonadIO m, MonadCatch m)
=> IOErrorType
@@ -165,7 +122,7 @@ lE' :: forall e' e es a m
=> (e' -> e)
-> Either e' a
-> Excepts es m a
lE' f = liftE . veitherToExcepts . fromEither . first f
lE' f = liftE . veitherToExcepts . fromEither . bimap f id
lEM :: forall e es a m . (Monad m, e :< es) => m (Either e a) -> Excepts es m a
lEM em = lift em >>= lE
@@ -175,15 +132,7 @@ lEM' :: forall e' e es a m
=> (e' -> e)
-> m (Either e' a)
-> Excepts es m a
lEM' f em = lift em >>= lE . first f
-- for some obscure reason... this won't type-check if we move it to a different module
catchWarn :: forall es m env . ( Pretty (V es)
, MonadReader env m
, HasLog env
, MonadIO m
, Monad m) => Excepts es m () -> Excepts '[] m ()
catchWarn = catchAllE @_ @es (\v -> lift $ logWarn (T.pack . prettyShow $ v))
lEM' f em = lift em >>= lE . bimap f id
fromEither :: Either a b -> VEither '[a] b
fromEither = either (VLeft . V) VRight
@@ -220,19 +169,14 @@ liftIOException errType ex =
. lift
-- | Uses safe-exceptions.
hideError :: (MonadIO m, MonadCatch m) => IOErrorType -> m () -> m ()
hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else liftIO . ioError $ e)
hideErrorDef :: IOErrorType -> a -> IO a -> IO a
hideErrorDef err def =
handleIO (\e -> if err == ioeGetErrorType e then pure def else ioError e)
hideErrorDef :: (MonadIO m, MonadCatch m) => [IOErrorType] -> a -> m a -> m a
hideErrorDef errs def =
handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else liftIO $ ioError e)
hideErrorDefM :: (MonadIO m, MonadCatch m) => [IOErrorType] -> m a -> m a -> m a
hideErrorDefM errs def =
handleIO (\e -> if ioeGetErrorType e `elem` errs then def else liftIO $ ioError e)
hideErrorDefM :: IOErrorType -> IO a -> IO a -> IO a
hideErrorDefM err def =
handleIO (\e -> if err == ioeGetErrorType e then def else ioError e)
-- TODO: does this work?
@@ -242,8 +186,8 @@ hideExcept :: forall e es es' a m
-> a
-> Excepts es m a
-> Excepts es' m a
hideExcept _ a =
catchLiftLeft ((\_ -> pure a) :: (e -> Excepts es' m a))
hideExcept _ a action =
catchLiftLeft ((\_ -> pure a) :: (e -> Excepts es' m a)) action
hideExcept' :: forall e es es' m
@@ -251,8 +195,8 @@ hideExcept' :: forall e es es' m
=> e
-> Excepts es m ()
-> Excepts es' m ()
hideExcept' _ =
catchLiftLeft ((\_ -> pure ()) :: (e -> Excepts es' m ()))
hideExcept' _ action =
catchLiftLeft ((\_ -> pure ()) :: (e -> Excepts es' m ())) action
reThrowAll :: forall e es es' a m
@@ -278,27 +222,9 @@ throwEither a = case a of
Right r -> pure r
throwEither' :: (Exception a, MonadThrow m) => a -> Either x b -> m b
throwEither' e eth = case eth of
Left _ -> throwM e
Right r -> pure r
throwMaybe :: (Exception a, MonadThrow m) => a -> Maybe b -> m b
throwMaybe a m = case m of
Nothing -> throwM a
Just r -> pure r
throwMaybeM :: (Exception a, MonadThrow m) => a -> m (Maybe b) -> m b
throwMaybeM a am = do
m <- am
throwMaybe a m
verToBS :: Version -> ByteString
verToBS = E.encodeUtf8 . prettyVer
verToS :: Version -> String
verToS = T.unpack . prettyVer
intToText :: Integral a => a -> T.Text
intToText = TL.toStrict . B.toLazyText . B.decimal
@@ -309,448 +235,9 @@ removeLensFieldLabel str' =
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
pvpToVersion :: MonadThrow m => PVP -> m Version
pvpToVersion =
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
versionToPVP :: MonadThrow m => Version -> m PVP
versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
where
alternative :: MonadThrow m => Version -> m PVP
alternative v' = case NE.takeWhile isDigit (_vChunks v') of
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
isDigit :: VChunk -> Bool
isDigit (Digits _ :| []) = True
isDigit _ = False
unsafeDigit :: VChunk -> Int
unsafeDigit (Digits x :| []) = fromIntegral x
unsafeDigit _ = error "unsafeDigit: wrong input"
pvpFromList :: [Int] -> PVP
pvpFromList = PVP . NE.fromList . fmap fromIntegral
-- | Safe 'decodeUtf8With'. Replaces an invalid input byte with
-- the Unicode replacement character U+FFFD.
decUTF8Safe :: ByteString -> Text
decUTF8Safe = E.decodeUtf8With E.lenientDecode
decUTF8Safe' :: L.ByteString -> Text
decUTF8Safe' = TL.toStrict . TLE.decodeUtf8With E.lenientDecode
-- | Escape a version for use in regex
escapeVerRex :: Version -> ByteString
escapeVerRex = B.pack . go . B.unpack . verToBS
where
go [] = []
go (x : xs) | x == _period = [_backslash, _period] ++ go xs
| otherwise = x : go xs
-- | More permissive version of 'createDirRecursive'. This doesn't
-- error when the destination is a symlink to a directory.
createDirRecursive' :: FilePath -> IO ()
createDirRecursive' p =
handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e)
. createDirectoryIfMissing True
$ p
where
isSymlinkDir e = do
ft <- pathIsSymbolicLink p
case ft of
True -> do
rp <- canonicalizePath p
rft <- doesDirectoryExist rp
case rft of
True -> pure ()
_ -> throwIO e
_ -> throwIO e
-- | Recursively copy the contents of one directory to another path.
--
-- This is a rip-off of Cabal library.
copyDirectoryRecursive :: FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
copyDirectoryRecursive srcDir destDir doCopy = do
srcFiles <- getDirectoryContentsRecursive srcDir
copyFilesWith destDir [ (srcDir, f)
| f <- srcFiles ]
where
-- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
-- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
copyFilesWith :: FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith targetDir srcFiles = do
-- Create parent directories for everything
let dirs = map (targetDir </>) . nub . map (takeDirectory . snd) $ srcFiles
traverse_ (createDirectoryIfMissing True) dirs
-- Copy all the files
sequence_ [ let src = srcBase </> srcFile
dest = targetDir </> srcFile
in doCopy src dest
| (srcBase, srcFile) <- srcFiles ]
-- | List all the files in a directory and all subdirectories.
--
-- The order places files in sub-directories after all the files in their
-- parent directories. The list is generated lazily so is not well defined if
-- the source directory structure changes before the list is used.
--
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive topdir = recurseDirectories [""]
where
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories [] = return []
recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
(files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
files' <- recurseDirectories (dirs' ++ dirs)
return (files ++ files')
where
collect files dirs' [] = return (reverse files
,reverse dirs')
collect files dirs' (entry:entries) | ignore entry
= collect files dirs' entries
collect files dirs' (entry:entries) = do
let dirEntry = dir </> entry
isDirectory <- doesDirectoryExist (topdir </> dirEntry)
if isDirectory
then collect files (dirEntry:dirs') entries
else collect (dirEntry:files) dirs' entries
ignore ['.'] = True
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
recyclePathForcibly :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadMask m
)
=> FilePath
-> m ()
recyclePathForcibly fp = do
#if defined(IS_WINDOWS)
Dirs { recycleDir } <- getDirs
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#else
liftIO $ removePathForcibly fp
#endif
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
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)
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
copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
copyFileE from = handleIO (throwE . CopyError . show) . liftIO . copyFile from
-- | Gathering monoidal values
--
-- >>> traverseFold (pure . (:["0"])) ["1","2"]
-- ["1","0","2","0"]
-- >>> traverseFold Just ["1","2","3","4","5"]
-- Just "12345"
--
-- prop> \t -> traverseFold Just t === Just (mconcat t)
traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
-- | Gathering monoidal values
forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
forFold = \t -> (`traverseFold` t)
-- | Strip @\\r@ and @\\n@ from 'String's
--
-- >>> stripNewline "foo\n\n\n"
-- "foo"
-- >>> stripNewline "foo\n\n\nfoo"
-- "foofoo"
-- >>> stripNewline "foo\r"
-- "foo"
-- >>> stripNewline "foo"
-- "foo"
--
-- prop> \t -> stripNewline (t <> "\n") === stripNewline t
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
stripNewline :: String -> String
stripNewline = filter (`notElem` "\n\r")
-- | Strip @\\r@ and @\\n@ from end of 'String'.
--
-- >>> stripNewlineEnd "foo\n\n\n"
-- "foo"
-- >>> stripNewlineEnd "foo\n\n\nfoo"
-- "foo\n\n\nfoo"
-- >>> stripNewlineEnd "foo\r"
-- "foo"
-- >>> stripNewlineEnd "foo"
-- "foo"
--
-- prop> \t -> stripNewlineEnd (t <> "\n") === stripNewlineEnd t
-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewlineEnd t == t
stripNewlineEnd :: String -> String
stripNewlineEnd = dropWhileEnd (`elem` "\n\r")
-- | Strip @\\r@ and @\\n@ from 'Text's
--
-- >>> stripNewline' "foo\n\n\n"
-- "foo"
-- >>> stripNewline' "foo\n\n\nfoo"
-- "foofoo"
-- >>> stripNewline' "foo\r"
-- "foo"
-- >>> stripNewline' "foo"
-- "foo"
--
-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
stripNewline' :: T.Text -> T.Text
stripNewline' = T.filter (`notElem` "\n\r")
-- | Is the word8 a newline?
--
-- >>> isNewLine (c2w '\n')
-- True
-- >>> isNewLine (c2w '\r')
-- True
--
-- prop> \w -> w /= _lf && w /= _cr ==> not (isNewLine w)
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, "")
-- | Like 'find', but where the test can be monadic.
--
-- >>> findM (Just . C.isUpper) "teST"
-- Just (Just 'S')
-- >>> findM (Just . C.isUpper) "test"
-- Just Nothing
-- >>> findM (Just . const True) ["x",undefined]
-- Just (Just "x")
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
-- | Drops the given suffix from a list.
-- It returns the original sequence if the sequence doesn't end with the given suffix.
--
-- >>> dropSuffix "!" "Hello World!"
-- "Hello World"
-- >>> dropSuffix "!" "Hello World!!"
-- "Hello World!"
-- >>> dropSuffix "!" "Hello World."
-- "Hello World."
dropSuffix :: Eq a => [a] -> [a] -> [a]
dropSuffix a b = fromMaybe b $ stripSuffix a b
-- | Return the prefix of the second list if its suffix
-- matches the entire first list.
--
-- >>> stripSuffix "bar" "foobar"
-- Just "foo"
-- >>> stripSuffix "" "baz"
-- Just "baz"
-- >>> stripSuffix "foo" "quux"
-- Nothing
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix a b = reverse <$> stripPrefix (reverse a) (reverse b)
-- | Drops the given prefix from a list.
-- It returns the original sequence if the sequence doesn't start with the given prefix.
--
-- >>> dropPrefix "Mr. " "Mr. Men"
-- "Men"
-- >>> dropPrefix "Mr. " "Dr. Men"
-- "Dr. Men"
dropPrefix :: Eq a => [a] -> [a] -> [a]
dropPrefix a b = fromMaybe b $ stripPrefix a b
-- | Break a list into pieces separated by the first
-- list argument, consuming the delimiter. An empty delimiter is
-- invalid, and will cause an error to be raised.
--
-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
-- ["a","b","d","e"]
-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
-- ["","X","X","X",""]
-- >>> splitOn "x" "x"
-- ["",""]
-- >>> splitOn "x" ""
-- [""]
--
-- prop> \s x -> s /= "" ==> intercalate s (splitOn s x) == x
-- prop> \c x -> splitOn [c] x == split (==c) x
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn [] _ = error "splitOn, needle may not be empty"
splitOn _ [] = [[]]
splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
where (a,b) = breakOn needle haystack
-- | Splits a list into components delimited by separators,
-- where the predicate returns True for a separator element. The
-- resulting components do not contain the separators. Two adjacent
-- separators result in an empty component in the output.
--
-- >>> split (== 'a') "aabbaca"
-- ["","","bb","c",""]
-- >>> split (== 'a') ""
-- [""]
-- >>> split (== ':') "::xyz:abc::123::"
-- ["","","xyz","abc","","123","",""]
-- >>> split (== ',') "my,list,here"
-- ["my","list","here"]
split :: (a -> Bool) -> [a] -> [[a]]
split _ [] = [[]]
split f (x:xs)
| f x = [] : split f xs
| y:ys <- split f xs = (x:y) : ys
| otherwise = [[]]
-- | Find the first instance of @needle@ in @haystack@.
-- The first element of the returned tuple
-- is the prefix of @haystack@ before @needle@ is matched. The second
-- is the remainder of @haystack@, starting with the match.
-- If you want the remainder /without/ the match, use 'stripInfix'.
--
-- >>> breakOn "::" "a::b::c"
-- ("a","::b::c")
-- >>> breakOn "/" "foobar"
-- ("foobar","")
--
-- prop> \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn _ [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs
addToCurrentEnv :: MonadIO m
=> [(ByteString, ByteString)]
-> m [(ByteString, ByteString)]
addToCurrentEnv adds = do
cEnv <- liftIO $ getEnvironment
pure (adds ++ cEnv)

View File

@@ -1,35 +1,25 @@
{-# LANGUAGE TemplateHaskell #-}
{-|
Module : GHCup.Utils.String.QQ
Description : String quasi quoters
Copyright : (c) Audrey Tang <audreyt@audreyt.org> 2019, Julian Ospald <hasufell@posteo.de> 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
QuasiQuoter for non-interpolated strings, texts and bytestrings.
The "s" quoter contains a multi-line string with no interpolation at all,
except that the leading newline is trimmed and carriage returns stripped.
@
{-\# LANGUAGE QuasiQuotes #-}
import Data.Text (Text)
import Data.String.QQ
foo :: Text -- "String", "ByteString" etc also works
foo = [s|
Well here is a
multi-line string!
|]
@
Any instance of the IsString type is permitted.
(For GHC versions 6, write "[$s||]" instead of "[s||]".)
-}
-- | QuasiQuoter for non-interpolated strings, texts and bytestrings.
--
-- The "s" quoter contains a multi-line string with no interpolation at all,
-- except that the leading newline is trimmed and carriage returns stripped.
--
-- @
-- {-\# LANGUAGE QuasiQuotes #-}
-- import Data.Text (Text)
-- import Data.String.QQ
-- foo :: Text -- "String", "ByteString" etc also works
-- foo = [s|
-- Well here is a
-- multi-line string!
-- |]
-- @
--
-- Any instance of the IsString type is permitted.
--
-- (For GHC versions 6, write "[$s||]" instead of "[s||]".)
--
module GHCup.Utils.String.QQ
( s
)
@@ -44,14 +34,15 @@ import Language.Haskell.TH.Quote
-- The pattern portion is undefined.
s :: QuasiQuoter
s = QuasiQuoter
(\s' -> case all isAscii s' of
(\s' -> case and $ fmap isAscii s' of
True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s'
False -> fail "Not ascii"
)
(error "Cannot use s as a pattern")
(error "Cannot use s as a type")
(error "Cannot use s as a dec")
(error "Cannot use q as a pattern")
(error "Cannot use q as a type")
(error "Cannot use q as a dec")
where
removeCRs = filter (/= '\r')
trimLeadingNewline ('\n' : xs) = xs
trimLeadingNewline xs = xs

View File

@@ -1,5 +1,4 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -7,26 +6,16 @@
{-# LANGUAGE TemplateHaskell #-}
{-|
Module : GHCup.Utils.Version.QQ
Description : Version quasi-quoters
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.Version.QQ where
import Data.Data
import Data.Text ( Text )
import Data.Versions
#if !MIN_VERSION_base(4,13,0)
import GHC.Base
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( Lift
import Language.Haskell.TH.Syntax ( Exp(..)
, Lift
, dataToExpQ
)
import qualified Data.Text as T
@@ -42,22 +31,18 @@ deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift (NonEmpty Word)
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
#endif
instance Lift Text
qq :: (Text -> Q Exp) -> QuasiQuoter
qq quoteExp' = QuasiQuoter
{ quoteExp = \s -> quoteExp' . T.pack $ s
{ quoteExp = (\s -> quoteExp' . T.pack $ s)
, quotePat = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
, quoteType = \_ ->
@@ -101,4 +86,4 @@ liftText :: T.Text -> Q Exp
liftText txt = AppE (VarE 'T.pack) <$> TH.lift (T.unpack txt)
liftDataWithText :: Data a => a -> Q Exp
liftDataWithText = dataToExpQ (fmap liftText . cast)
liftDataWithText = dataToExpQ (\a -> liftText <$> cast a)

View File

@@ -1,52 +1,11 @@
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : GHCup.Version
Description : Version information and version handling.
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Version where
import GHCup.Types
import Paths_ghcup (version)
import GHCup.Utils.Version.QQ
import Data.Version (Version(versionBranch))
import Data.Versions hiding (version)
import URI.ByteString
import URI.ByteString.QQ
import Data.Versions
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
-- | This reflects the API version of the YAML.
--
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
-- | The current ghcup version.
ghcUpVer :: PVP
ghcUpVer = PVP . NE.fromList . fmap fromIntegral $ versionBranch version
-- | ghcup version as numeric string.
numericVer :: String
numericVer = T.unpack . prettyPVP $ ghcUpVer
versionCmp :: Versioning -> VersionCmp -> Bool
versionCmp ver1 (VR_gt ver2) = ver1 > ver2
versionCmp ver1 (VR_gteq ver2) = ver1 >= ver2
versionCmp ver1 (VR_lt ver2) = ver1 < ver2
versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range
ghcUpVer = [pver|0.0.0|]

Some files were not shown because too many files have changed in this diff Show More