Compare commits

...

32 Commits

Author SHA1 Message Date
b1cde06bd0 Fix CI 2023-10-23 21:42:29 +08:00
0adb602a96 Improve distro code 2023-10-23 21:42:29 +08:00
f9a2b21cb0 Update system requirements, fixes #902 2023-10-21 19:43:53 +08:00
e73cf4033e Merge remote-tracking branch 'origin/pr/899' 2023-10-21 19:35:51 +08:00
5f0c6f60b8 Update data/metadata 2023-10-21 19:31:06 +08:00
29c9611152 Update system requirements in docs 2023-10-21 19:28:20 +08:00
e90ca97441 Fix property tests 2023-10-21 19:23:25 +08:00
1fb0387101 Add temp git ref to versions to fix CI 2023-10-21 19:23:25 +08:00
Colin Woodbury
1981a12e67 refactor: use upstream TH constructors 2023-10-21 19:23:25 +08:00
Colin Woodbury
eae197ccb3 chore: bump versions upper bound and squash warnings 2023-10-21 19:23:25 +08:00
Colin Woodbury
15c6ed2b8d refactor: upgrade versions library usage 2023-10-21 19:23:25 +08:00
fbb648d984 Improve logging on broken symlinks wrt #880 2023-10-21 19:23:25 +08:00
Romain Ruetschi
c914a284de Use absolute path to /usr/bin/xattr instead of pulling whatever is in PATH
On macOS systems with Homebrew installed, the latter will install its
own copy of `xattr` in `/opt/homebrew/bin/xattr` which will often
take precedence over the system `xattr` at `/usr/bin/xattr`, and does
not support the `-r` flag to act recursively over a directory.

This commit changes the invocation of `xattr` to use the absolute path
to the system version of `xattr` at `/usr/bin/xattr`.
2023-10-21 19:23:25 +08:00
9a17eaa32a Bump metadata version since we added new distros 2023-10-21 19:23:24 +08:00
480d6be02f Add explicit support for Void Linux, fixes #378 2023-10-21 19:23:24 +08:00
3e907bd890 Add explicit support for Rocky Linux 2023-10-21 19:23:24 +08:00
wz1000
d999c3dfbf Update supported HLS versions 2023-10-21 19:23:24 +08:00
41d44b037d Validate gpg sig even if using file:// yaml url 2023-10-21 19:23:24 +08:00
9d8d6e3293 Improve Github CI documentation 2023-10-14 11:58:09 +08:00
Adam Bergmark
8696a1c710 doc: change order of stack integration recommendations 2023-10-11 14:15:30 +02:00
2f107197d4 Merge branch 'issue-887' 2023-10-10 16:57:58 +08:00
486a1bac25 Fix segfault in TUI when hitting enter early
Fixes #887
2023-10-10 10:26:35 +08:00
a73ce186b5 Remove documentation of nightlies
GHC nightlies have been broken for a while and unless
they are not only fixed, but GHC upstream demonstrates that
they can make them work reliably, GHCup will not promote them.
2023-10-07 16:54:54 +08:00
76204aa366 Re-enable threaded runtime
Needed for vty.
2023-10-01 17:17:13 +08:00
502f0ea62f Avoid module recompilation 2023-10-01 17:10:50 +08:00
e7e6663017 Update stackage to 20.26 2023-10-01 14:53:37 +08:00
e27fed09f3 Fix sdist 2023-10-01 14:45:41 +08:00
9eeac00714 Further improvement to tag documentation 2023-10-01 14:38:40 +08:00
c0ffb22d6a Improve documentation around tags 2023-10-01 14:35:31 +08:00
f0b145d8dd Merge remote-tracking branch 'origin/pr/890' 2023-09-30 15:20:42 +08:00
bb700281a3 Update gpg docs 2023-09-30 00:02:36 +08:00
openingnow
fcdec4ba2c Add another cabal store path 2023-09-29 16:58:51 +09:00
46 changed files with 1341 additions and 1462 deletions

View File

@@ -30,32 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
### Haskell test suite ### Haskell test suite
./ghcup-test${ext} ./"ghcup-test${ext}"
./ghcup-test-optparse${ext} ./"ghcup-test-optparse${ext}"
rm ghcup-test${ext} ghcup-test-optparse${ext} rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
### manual cli based testing ### manual cli based testing
eghcup --numeric-version eghcup --numeric-version
eghcup install ghc ${GHC_VER} eghcup install ghc "${GHC_VER}"
eghcup unset ghc ${GHC_VER} eghcup unset ghc "${GHC_VER}"
ls -lah "$(eghcup whereis -d ghc ${GHC_VER})" ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ] [ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ] [ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ] [ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
eghcup set ghc ${GHC_VER} eghcup set ghc "${GHC_VER}"
eghcup install cabal ${CABAL_VER} eghcup install cabal "${CABAL_VER}"
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ] [ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
eghcup unset cabal eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes "$GHCUP_BIN"/cabal --version && exit 1 || echo yes
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly # make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ] [ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
eghcup set cabal ${CABAL_VER} eghcup set cabal "${CABAL_VER}"
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ] [ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
if [ "${OS}" != "FreeBSD" ] ; then if [ "${OS}" != "FreeBSD" ] ; then
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
@@ -85,10 +85,10 @@ eghcup list -t cabal
ghc_ver=$(ghc --numeric-version) ghc_ver=$(ghc --numeric-version)
ghc --version ghc --version
ghc-${ghc_ver} --version "ghc-${ghc_ver}" --version
if [ "${OS}" != "Windows" ] ; then if [ "${OS}" != "Windows" ] ; then
ghci --version ghci --version
ghci-${ghc_ver} --version "ghci-${ghc_ver}" --version
fi fi
@@ -132,11 +132,11 @@ else
eghcup --offline set 8.10.3 eghcup --offline set 8.10.3
eghcup set 8.10.3 eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.10.3" ] [ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set ${GHC_VER} eghcup set "${GHC_VER}"
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup unset ghc eghcup unset ghc
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes "$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
eghcup set ${GHC_VER} eghcup set "${GHC_VER}"
eghcup --offline rm 8.10.3 eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
@@ -169,10 +169,10 @@ fi
# check that lazy loading works for 'whereis' # 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" 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" echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc $(ghc --numeric-version) 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" 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) eghcup rm "$(ghc --numeric-version)"
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
if [ "${OS}" = "Linux" ] ; then if [ "${OS}" = "Linux" ] ; then
@@ -186,7 +186,7 @@ eghcup gc -c
# test etags # test etags
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml" rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
# snapshot yaml and etags file # snapshot yaml and etags file
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags") etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml") sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")

2
.gitmodules vendored
View File

@@ -1,4 +1,4 @@
[submodule "data/metadata"] [submodule "data/metadata"]
path = data/metadata path = data/metadata
url = https://github.com/haskell/ghcup-metadata.git url = https://github.com/haskell/ghcup-metadata.git
branch = master branch = develop

View File

@@ -45,7 +45,7 @@ import Data.IORef
import Data.Vector ( Vector import Data.Vector ( Vector
, (!?) , (!?)
) )
import Data.Versions hiding ( str ) import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.FilePath import System.FilePath

View File

@@ -8,6 +8,11 @@ package ghcup
constraints: http-io-streams -brotli, constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0 any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive
@@ -24,4 +29,4 @@ package streamly
flags: +use-unliftio flags: +use-unliftio
package * package *
test-show-details: direct test-show-details: direct

View File

@@ -4,6 +4,11 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2 optimization: 2
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
if os(linux) if os(linux)
package ghcup package ghcup
flags: +tui flags: +tui

View File

@@ -43,6 +43,12 @@ All of the following are valid arguments to `ghcup install ghc`:
If the argument is omitted, the default is `recommended`. If the argument is omitted, the default is `recommended`.
Other tags include:
- `prerelease`: a prerelease version
- `latest-prerelease`: the latest prerelease version
## Manpages ## 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. 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.
@@ -203,50 +209,12 @@ url-source:
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml" - "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
``` ```
### Nightlies
Nightlies are just another release channel. Currently, only GHC supports nightlies, which are binary releases
that are built every night from `master`.
To add the nightly channel, run:
```sh
ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
```
To list all nightlies from 2023, run:
```sh
ghcup list --show-nightly --tool=ghc --since=2023-01-01
```
Ways to install a nightly:
```sh
# by date
ghcup install ghc 2023-06-20
# by version
ghcup install ghc 9.7.20230619
# by tag
ghcup install ghc latest-nightly
```
## Stack integration ## Stack integration
Stack manages GHC versions internally by default. In order to make it use ghcup installed Stack manages GHC versions internally by default. In order to make it use ghcup installed
GHC versions there are two strategies. GHC versions there are two strategies.
### Strategy 1: System GHC (works on all stack versions) ### Strategy 1: Stack hooks (new, recommended)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
stack config set system-ghc true --global
```
### Strategy 2: Stack hooks (new, recommended)
Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation). Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
@@ -268,6 +236,16 @@ stack config set system-ghc false --global
By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
this, run `stack config set install-ghc false --global`. this, run `stack config set install-ghc false --global`.
### Strategy 2: System GHC (works on all stack versions)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
stack config set system-ghc true --global
```
### Windows ### Windows
On windows, you may find the following config options useful too: On windows, you may find the following config options useful too:
@@ -478,8 +456,48 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
### github workflows ### github workflows
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/). On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations. Here's an example workflow with a GHC matrix:
```yaml
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: true
matrix:
os: [ubuntu-22.04, macOS-latest]
ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
steps:
- uses: actions/checkout@v3
- name: Setup toolchain
run: |
ghcup install cabal --set recommended
ghcup install ghc --set ${{ matrix.ghc }}
- name: Build
run: |
cabal update
cabal test all --test-show-details=direct
i386:
runs-on: ubuntu-latest
container:
image: i386/ubuntu:bionic
steps:
- name: Install GHCup in container
run: |
apt-get update -y
apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
# we just go with recommended versions of cabal and GHC
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
- uses: actions/checkout@v1
- name: Test
run: |
# in containers we need to fix PATH
source ~/.ghcup/env
cabal update
cabal test all --test-show-details=direct
```
## GPG verification ## GPG verification
@@ -489,9 +507,10 @@ this is cryptographically secure.
First, obtain the gpg keys: First, obtain the gpg keys:
```sh ```sh
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01 gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4 gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
``` ```
Then verify the gpg key in one of these ways: Then verify the gpg key in one of these ways:

View File

@@ -42,10 +42,14 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 11 #### Version >= 11 && <= 12
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 12
The following distro packages are required: `build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Ubuntu ### Linux Ubuntu
#### Generic #### Generic
@@ -56,10 +60,13 @@ The following distro packages are required: `build-essential curl libffi-dev lib
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.10 #### Version >= 20.10 && < 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
### Linux Fedora ### Linux Fedora
@@ -200,7 +207,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table> <table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead> <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr> <tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.3.0.0</td><td></td></tr>
<tr><td>2.2.0.0</td><td></td></tr>
<tr><td>2.1.0.0</td><td></td></tr> <tr><td>2.1.0.0</td><td></td></tr>
<tr><td>2.0.0.1</td><td></td></tr> <tr><td>2.0.0.1</td><td></td></tr>
<tr><td>2.0.0.0</td><td></td></tr> <tr><td>2.0.0.0</td><td></td></tr>
@@ -296,7 +305,14 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/) Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere. and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following keys first: `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`. If you want to GPG verify the binaries, import the following keys first:
```sh
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so: Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:

View File

@@ -25,10 +25,10 @@ extra-source-files:
cbits/dirutils.h cbits/dirutils.h
data/build_mk/cross data/build_mk/cross
data/build_mk/default data/build_mk/default
test/data/dir/.keep test/ghcup-test/data/dir/.keep
test/data/file test/ghcup-test/data/file
test/golden/unix/GHCupInfo.json test/ghcup-test/golden/unix/GHCupInfo.json
test/golden/windows/GHCupInfo.json test/ghcup-test/golden/windows/GHCupInfo.json
source-repository head source-repository head
type: git type: git
@@ -87,7 +87,7 @@ common app-common-depends
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, vector ^>=0.12 , vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
library library
@@ -189,7 +189,7 @@ library
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, vector ^>=0.12 , vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=6.0.3 && <6.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2 , zlib ^>=0.6.2.2
@@ -236,7 +236,7 @@ library
if (flag(tui) && !os(windows)) if (flag(tui) && !os(windows))
cpp-options: -DBRICK cpp-options: -DBRICK
build-depends: vty ^>=5.37 build-depends: vty ^>=5.39
library ghcup-optparse library ghcup-optparse
import: app-common-depends import: app-common-depends
@@ -261,7 +261,7 @@ library ghcup-optparse
GHCup.OptParse.Upgrade GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup hs-source-dirs: lib-opt
default-language: Haskell2010 default-language: Haskell2010
default-extensions: default-extensions:
LambdaCase LambdaCase
@@ -284,12 +284,6 @@ library ghcup-optparse
if (flag(tui) && !os(windows)) if (flag(tui) && !os(windows))
cpp-options: -DBRICK cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick ^>=1.5
, transformers ^>=0.5
, unix ^>=2.7
, vty ^>=5.37
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
@@ -300,26 +294,6 @@ library ghcup-optparse
executable ghcup executable ghcup
import: app-common-depends import: app-common-depends
main-is: Main.hs main-is: Main.hs
other-modules:
GHCup.OptParse
GHCup.OptParse.ChangeLog
GHCup.OptParse.Common
GHCup.OptParse.Compile
GHCup.OptParse.Config
GHCup.OptParse.DInfo
GHCup.OptParse.GC
GHCup.OptParse.Install
GHCup.OptParse.List
GHCup.OptParse.Nuke
GHCup.OptParse.Prefetch
GHCup.OptParse.Rm
GHCup.OptParse.Run
GHCup.OptParse.Set
GHCup.OptParse.Test
GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup hs-source-dirs: app/ghcup
default-language: Haskell2010 default-language: Haskell2010
@@ -351,7 +325,7 @@ executable ghcup
, brick ^>=1.5 , brick ^>=1.5
, transformers ^>=0.5 , transformers ^>=0.5
, unix ^>=2.7 , unix ^>=2.7
, vty ^>=5.37 , vty ^>=5.39
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
@@ -403,7 +377,7 @@ test-suite ghcup-test
, text ^>=2.0 , text ^>=2.0
, time >=1.9.3 && <1.12 , time >=1.9.3 && <1.12
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1 , versions >=6.0.3 && <6.1
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
@@ -443,6 +417,7 @@ test-suite ghcup-optparse-test
, optparse-applicative , optparse-applicative
, tasty , tasty
, tasty-hunit , tasty-hunit
, template-haskell
, text , text
, uri-bytestring , uri-bytestring
, versions , versions

View File

@@ -48,7 +48,7 @@ import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Calendar ( Day ) import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale ) import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions hiding ( str ) import Data.Versions
import Data.Void import Data.Void
import qualified Data.Vector as V import qualified Data.Vector as V
import GHC.IO.Exception import GHC.IO.Exception
@@ -209,19 +209,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
) )
] ]
distroP :: MP.Parsec Void Text LinuxDistro distroP :: MP.Parsec Void Text LinuxDistro
distroP = choice' distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
[ MP.chunk "debian" $> Debian
, MP.chunk "deb" $> Debian
, MP.chunk "ubuntu" $> Ubuntu
, MP.chunk "mint" $> Mint
, MP.chunk "fedora" $> Fedora
, MP.chunk "centos" $> CentOS
, MP.chunk "redhat" $> RedHat
, MP.chunk "alpine" $> Alpine
, MP.chunk "gentoo" $> Gentoo
, MP.chunk "exherbo" $> Exherbo
, MP.chunk "unknown" $> UnknownLinux
]
uriParser :: String -> Either String URI uriParser :: String -> Either String URI
@@ -367,7 +355,7 @@ fileUri' add = \case
-- We need to do this so bash doesn't expand out any ~ or other -- We need to do this so bash doesn't expand out any ~ or other
-- chars we want to complete on, or emit an end of line error -- chars we want to complete on, or emit an end of line error
-- when seeking the close to the quote. -- when seeking the close to the quote.
-- --
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
requote :: String -> String requote :: String -> String
requote s = requote s =
@@ -824,7 +812,7 @@ checkForUpdates = do
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m () logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
logGHCPostRm ghcVer = do logGHCPostRm ghcVer = do
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store") cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
(runIdentity . CC.cfgStoreDir <$> CC.readConfig) (runIdentity . CC.cfgStoreDir <$> CC.readConfig)
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer)) let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir

View File

@@ -27,7 +27,7 @@ import Data.List ( intercalate, sort )
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Time.Calendar ( Day ) import Data.Time.Calendar ( Day )
import Data.Versions hiding ( str ) import Data.Versions
import Data.Void import Data.Void
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )

View File

@@ -29,7 +29,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( str ) import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )

View File

@@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( str ) import Data.Versions
import GHC.Unicode import GHC.Unicode
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )

View File

@@ -35,7 +35,7 @@ import System.Environment
import GHCup.Utils import GHCup.Utils
import System.FilePath import System.FilePath
import GHCup.Types.Optics import GHCup.Types.Optics
import Data.Versions hiding (str) import Data.Versions

View File

@@ -246,7 +246,7 @@ getBase uri = do
Settings { metaCache } <- lift getSettings Settings { metaCache } <- lift getSettings
-- for local files, let's short-circuit and ignore access time -- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing Nothing Nothing (fromGHCupPath cacheDir) Nothing True if | scheme == "file" -> liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing (fromGHCupPath cacheDir) Nothing True
| e -> do | e -> do
accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -352,15 +352,20 @@ download :: ( MonadReader env m
download rawUri gpgUri eDigest eCSize dest mfn etags download rawUri gpgUri eDigest eCSize dest mfn etags
| scheme == "https" = liftE dl | scheme == "https" = liftE dl
| scheme == "http" = liftE dl | scheme == "http" = liftE dl
| scheme == "file"
, Just s <- gpgScheme
, s /= "file" = throwIO $ userError $ "gpg scheme does not match base file scheme: " <> (T.unpack . decUTF8Safe $ s)
| scheme == "file" = do | scheme == "file" = do
Settings{ gpgSetting } <- lift getSettings
let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
lift $ logDebug $ "using local file: " <> T.pack destFile' lift $ logDebug $ "using local file: " <> T.pack destFile'
forM_ eDigest (liftE . flip checkDigest destFile') liftE $ verify gpgSetting destFile' (pure . T.unpack . decUTF8Safe . view pathL')
pure destFile' pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
where where
scheme = view (uriSchemeL' % schemeBSL') rawUri scheme = view (uriSchemeL' % schemeBSL') rawUri
gpgScheme = view (uriSchemeL' % schemeBSL') <$> gpgUri
dl = do dl = do
Settings{ mirrors } <- lift getSettings Settings{ mirrors } <- lift getSettings
let uri = applyMirrors mirrors rawUri let uri = applyMirrors mirrors rawUri
@@ -402,30 +407,14 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
else pure (\fp -> liftE . internalDL fp) else pure (\fp -> liftE . internalDL fp)
#endif #endif
liftE $ downloadAction baseDestFile uri liftE $ downloadAction baseDestFile uri
case (gpgUri, gpgSetting) of liftE $ verify gpgSetting baseDestFile
(_, GPGNone) -> pure () (\uri' -> do
(Just gpgUri', _) -> do gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri' Nothing
gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri' <> " as file " <> T.pack gpgDestFile
liftE $ flip onException flip onException (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile)) $
(lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile)) downloadAction gpgDestFile uri'
$ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError] pure gpgDestFile
(\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e)) )
) $ do
o' <- liftIO getGpgOpts
lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
liftE $ downloadAction gpgDestFile gpgUri'
lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
cp <- lift $ executeOut "gpg" args Nothing
case cp of
CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
lift $ logDebug $ decUTF8Safe' _stdErr
throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
_ -> pure ()
forM_ eCSize (liftE . flip checkCSize baseDestFile)
forM_ eDigest (liftE . flip checkDigest baseDestFile)
pure baseDestFile pure baseDestFile
curlDL :: ( MonadCatch m curlDL :: ( MonadCatch m
@@ -623,6 +612,41 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp) liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
pure Nothing pure Nothing
verify :: ( MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadCatch m
, MonadMask m
, MonadIO m
)
=> GPGSetting
-> FilePath
-> (URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath)
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
verify gpgSetting destFile' downloadAction' = do
case (gpgUri, gpgSetting) of
(_, GPGNone) -> pure ()
(Just gpgUri', _) -> do
liftE $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
(\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
) $ do
o' <- liftIO getGpgOpts
gpgDestFile <- liftE $ downloadAction' gpgUri'
lift $ logInfo $ "verifying signature of: " <> T.pack destFile'
let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, destFile']
cp <- lift $ executeOut "gpg" args Nothing
case cp of
CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
lift $ logDebug $ decUTF8Safe' _stdErr
throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
_ -> pure ()
forM_ eCSize (liftE . flip checkCSize destFile')
forM_ eDigest (liftE . flip checkDigest destFile')
-- | Download into tmpdir or use cached version, if it exists. If filename -- | Download into tmpdir or use cached version, if it exists. If filename
-- is omitted, infers the filename from the url. -- is omitted, infers the filename from the url.
@@ -642,7 +666,7 @@ downloadCached :: ( MonadReader env m
downloadCached dli mfn = do downloadCached dli mfn = do
Settings{ cache } <- lift getSettings Settings{ cache } <- lift getSettings
case cache of case cache of
True -> downloadCached' dli mfn Nothing True -> liftE $ downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False

View File

@@ -717,8 +717,10 @@ getCabalVersion fp = do
gpd <- case parseGenericPackageDescriptionMaybe contents of gpd <- case parseGenericPackageDescriptionMaybe contents of
Nothing -> fail $ "could not parse cabal file: " <> fp Nothing -> fail $ "could not parse cabal file: " <> fp
Just r -> pure r Just r -> pure r
let tver = (\c -> Version Nothing c [] Nothing) let tver = (\c -> Version Nothing c Nothing Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral) . Chunks
. NE.fromList
. fmap (Numeric . fromIntegral)
. versionNumbers . versionNumbers
. pkgVersion . pkgVersion
. package . package

View File

@@ -91,18 +91,16 @@ ghcTargetVerP =
verP' :: MP.Parsec Void Text Text verP' :: MP.Parsec Void Text Text
verP' = do verP' = do
v <- version' v <- version'
let startsWithDigists = let startsWithDigits =
and and
. take 3 . take 3
. concatMap . map (\case
(map Numeric _ -> True
(\case Alphanum _ -> False)
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList . NE.toList
. (\(Chunks nec) -> nec)
$ _vChunks v $ _vChunks v
if startsWithDigists && isNothing (_vEpoch v) if startsWithDigits && isNothing (_vEpoch v)
then pure $ prettyVer v then pure $ prettyVer v
else fail "Oh" else fail "Oh"

View File

@@ -26,36 +26,14 @@ import GHC.Base
#endif #endif
import Language.Haskell.TH import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( Lift import Language.Haskell.TH.Syntax ( dataToExpQ )
, dataToExpQ
)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH import qualified Language.Haskell.TH.Syntax as TH
deriving instance Data Versioning
deriving instance Lift Versioning
deriving instance Data Version
deriving instance Lift Version
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 VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word) deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk) deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif #endif
qq :: (Text -> Q Exp) -> QuasiQuoter qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@@ -157,13 +157,17 @@ instance NFData VersionInfo
-- | A tag. These are currently attached to a version of a tool. -- | A tag. These are currently attached to a version of a tool.
data Tag = Latest data Tag = Latest -- ^ the latest version of a tool (unique per tool)
| Recommended | Recommended -- ^ the recommended version of a tool (unique per tool)
| Prerelease | Prerelease -- ^ denotes a prerelease version
| LatestPrerelease -- (a version should either be 'Prerelease' or
| Nightly -- 'LatestPrerelease', but not both)
| LatestNightly | LatestPrerelease -- ^ the latest prerelease (unique per tool)
| Base PVP | Nightly -- ^ denotes a nightly version
-- (a version should either be 'Nightly' or
-- 'LatestNightly', but not both)
| LatestNightly -- ^ the latest nightly (unique per tool)
| Base PVP -- ^ the base version shipped with GHC
| Old -- ^ old versions are hidden by default in TUI | Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -245,13 +249,18 @@ data LinuxDistro = Debian
| RedHat | RedHat
| Alpine | Alpine
| AmazonLinux | AmazonLinux
| Rocky
| Void
-- rolling -- rolling
| Gentoo | Gentoo
| Exherbo | Exherbo
-- not known -- not known
| UnknownLinux | UnknownLinux
-- ^ must exit -- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show) deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
allDistros :: [LinuxDistro]
allDistros = enumFromTo minBound maxBound
instance NFData LinuxDistro instance NFData LinuxDistro
@@ -264,6 +273,8 @@ distroToString CentOS = "centos"
distroToString RedHat = "redhat" distroToString RedHat = "redhat"
distroToString Alpine = "alpine" distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon" distroToString AmazonLinux = "amazon"
distroToString Rocky = "rocky"
distroToString Void = "void"
distroToString Gentoo = "gentoo" distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo" distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown" distroToString UnknownLinux = "unknown"

View File

@@ -48,10 +48,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool

View File

@@ -119,11 +119,11 @@ import Data.Time (Day(..), diffDays, addDays)
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False } -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs -- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ] -- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False -- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc -- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory -- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL) -- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref -- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
@@ -369,7 +369,9 @@ cabalSet = do
handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink cabalbin broken <- liftIO $ isBrokenSymlink cabalbin
if broken if broken
then pure Nothing then do
logWarn $ "Broken symlink at " <> T.pack cabalbin
pure Nothing
else do else do
link <- liftIO link <- liftIO
$ handleIO' InvalidArgument $ handleIO' InvalidArgument
@@ -466,7 +468,9 @@ stackSet = do
handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink stackBin broken <- liftIO $ isBrokenSymlink stackBin
if broken if broken
then pure Nothing then do
logWarn $ "Broken symlink at " <> T.pack stackBin
pure Nothing
else do else do
link <- liftIO link <- liftIO
$ handleIO' InvalidArgument $ handleIO' InvalidArgument
@@ -520,15 +524,17 @@ isLegacyHLS ver = do
-- Return the currently set hls version, if any. -- Return the currently set hls version, if any.
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) hlsSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do hlsSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- isBrokenSymlink hlsBin broken <- liftIO $ isBrokenSymlink hlsBin
if broken if broken
then pure Nothing then do
logWarn $ "Broken symlink at " <> T.pack hlsBin
pure Nothing
else do else do
link <- liftIO $ getLinkTarget hlsBin link <- liftIO $ getLinkTarget hlsBin
Just <$> linkVersion link Just <$> linkVersion link
@@ -556,6 +562,7 @@ hlsSet = do
-- | Return the GHC versions the currently selected HLS supports. -- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader env m hlsGHCVersions :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, MonadIO m , MonadIO m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
@@ -687,10 +694,8 @@ hlsAllBinaries ver = do
-- | Extract (major, minor) from any version. -- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int) getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version {..} = case _vChunks of getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y) getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
_ -> throwM $ ParseError "Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of matchMajor v' major' minor' = case getMajorMinorV v' of
@@ -732,7 +737,7 @@ getGHCForPVP pvpIn mt = do
-- | Like 'getGHCForPVP', except with explicit input parameter. -- | Like 'getGHCForPVP', except with explicit input parameter.
-- --
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing -- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}}) -- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "debug" :| [])), _vMeta = Just "lol"}})
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4" -- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
@@ -758,11 +763,11 @@ getGHCForPVP' pvpIn ghcs' mt = do
-- | Get the latest available ghc for the given PVP version, which -- | Get the latest available ghc for the given PVP version, which
-- may only contain parts. -- may only contain parts.
-- --
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r -- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
-- Just (PVP {_pComponents = 8 :| [10,7]}) -- Just (PVP {_pComponents = 8 :| [10,7]})
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r -- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
-- Just (PVP {_pComponents = 8 :| [8,4]}) -- Just (PVP {_pComponents = 8 :| [8,4]})
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r -- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
-- Just (PVP {_pComponents = 8 :| [8,4]}) -- Just (PVP {_pComponents = 8 :| [8,4]})
getLatestToolFor :: MonadThrow m getLatestToolFor :: MonadThrow m
=> Tool => Tool
@@ -1033,7 +1038,7 @@ applyPatches pdir ddir = do
patches <- liftIO $ quilt `catchIO` (\e -> patches <- liftIO $ quilt `catchIO` (\e ->
if isDoesNotExistError e || isPermissionError e then if isDoesNotExistError e || isPermissionError e then
lexicographical lexicographical
else throwIO e) else throwIO e)
forM_ patches $ \patch' -> applyPatch patch' ddir forM_ patches $ \patch' -> applyPatch patch' ddir
@@ -1081,7 +1086,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
-> FilePath -> FilePath
-> m (Either ProcessError ()) -> m (Either ProcessError ())
darwinNotarization Darwin path = exec darwinNotarization Darwin path = exec
"xattr" "/usr/bin/xattr"
["-r", "-d", "com.apple.quarantine", path] ["-r", "-d", "com.apple.quarantine", path]
Nothing Nothing
Nothing Nothing

View File

@@ -24,17 +24,17 @@ import qualified Data.Text as T
import qualified Data.Versions as V import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow) import Control.Exception.Safe (MonadThrow)
import Data.Text (Text) import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (intersperse)
import Control.Monad.Catch (throwM) import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..)) import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)
-- | This reflects the API version of the YAML. -- | 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 -- 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. -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|] ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: V.PVP ghcUpVer :: V.PVP
@@ -53,7 +53,7 @@ versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: V.Versioning -> VersionRange -> Bool versionRange :: V.Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) = versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range versionRange ver' (SimpleRange cmps) || versionRange ver' range
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
@@ -65,44 +65,15 @@ pvpToVersion pvp_ rest =
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v -- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text) versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch" versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
Right r -> pure r
where where
alternative :: MonadThrow m => V.Version -> m V.PVP pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of pvp'' = do
[] -> throwM $ ParseError "Couldn't convert Version to PVP" p <- V.pvp'
xs -> pure $ pvpFromList (unsafeDigit <$> xs) s <- getParserState
pure (p, stateInput s)
rest :: V.Version -> Text
rest (V.Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t V.VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: V.VUnit -> Text
f (V.Digits i) = T.pack $ show i
f (V.Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: V.VChunk -> Bool
isDigit (V.Digits _ :| []) = True
isDigit _ = False
unsafeDigit :: V.VChunk -> Int
unsafeDigit (V.Digits x :| []) = fromIntegral x
unsafeDigit _ = error "unsafeDigit: wrong input"
pvpFromList :: [Int] -> V.PVP pvpFromList :: [Int] -> V.PVP
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral pvpFromList = V.PVP . NE.fromList . fmap fromIntegral

View File

@@ -1,4 +1,4 @@
resolver: lts-20.20 resolver: lts-20.26
packages: packages:
- . - .
@@ -24,6 +24,8 @@ extra-deps:
- strict-base-0.4.0.0 - strict-base-0.4.0.0
- text-2.0.2 - text-2.0.2
- yaml-streamly-0.12.2 - yaml-streamly-0.12.2
- github: fosskers/versions
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
flags: flags:
http-io-streams: http-io-streams:

File diff suppressed because it is too large Load Diff

View File

@@ -1,3 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module ChangeLogTest where module ChangeLogTest where
import Test.Tasty import Test.Tasty
@@ -6,8 +9,7 @@ import Utils
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Control.Monad.IO.Class import Control.Monad.IO.Class
import GHCup.Types import GHCup.Types
import Data.Versions import Data.Versions (versionQ)
import Data.List.NonEmpty (NonEmpty ((:|)))
changeLogTests :: TestTree changeLogTests :: TestTree
changeLogTests = testGroup "changelog" $ map (uncurry check) checkList changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
@@ -30,7 +32,7 @@ checkList =
(Just $ GHCVersion (Just $ GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])) $(versionQ "9.2"))
) )
, ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended)) , ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
, ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended)) , ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
@@ -38,7 +40,7 @@ checkList =
(Just $ GHCVersion (Just $ GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []])) $(versionQ "3.10.1.0"))
) )
, ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22")))) , ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
] ]

View File

@@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module CompileTest where module CompileTest where
@@ -59,12 +60,12 @@ compileGhcCheckList = mapSecond CompileGHC
[ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions) [ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions)
, ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions , ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" Nothing) (GHC.GitDist $ GitBranch "a32db0b" Nothing)
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
) )
, ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git", , ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
mkDefaultGHCCompileOptions mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git")) (GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
) )
, ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2", , ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
mkDefaultGHCCompileOptions mkDefaultGHCCompileOptions
@@ -73,7 +74,7 @@ compileGhcCheckList = mapSecond CompileGHC
) )
, ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions , ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|]) (GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|])
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
) )
, (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20}) , (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10}) , (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
@@ -86,8 +87,8 @@ compileGhcCheckList = mapSecond CompileGHC
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"}) , (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]}) , (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True}) , (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"}) , (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"}) , (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"}) , (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"}) , (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian}) , (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
@@ -107,8 +108,8 @@ compileGhcCheckList = mapSecond CompileGHC
baseOptions :: GHCCompileOptions baseOptions :: GHCCompileOptions
baseOptions = baseOptions =
mkDefaultGHCCompileOptions mkDefaultGHCCompileOptions
(GHC.SourceDist $ mkVersion' "9.4.5") (GHC.SourceDist $(versionQ "9.4.5"))
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
compileHlsCheckList :: [(String, CompileCommand)] compileHlsCheckList :: [(String, CompileCommand)]
compileHlsCheckList = mapSecond CompileHLS compileHlsCheckList = mapSecond CompileHLS
@@ -136,7 +137,7 @@ compileHlsCheckList = mapSecond CompileHLS
) )
, ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8", , ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8",
mkDefaultHLSCompileOptions mkDefaultHLSCompileOptions
(HLS.SourceDist $ mkVersion' "2.0.0.0") (HLS.SourceDist $(versionQ "2.0.0.0"))
[ghc928] [ghc928]
) )
, ("compile hls --remote-source-dist https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz --ghc 9.2.8", , ("compile hls --remote-source-dist https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz --ghc 9.2.8",
@@ -146,15 +147,15 @@ compileHlsCheckList = mapSecond CompileHLS
) )
, ("compile hls -v 2.0.0.0 --ghc latest", , ("compile hls -v 2.0.0.0 --ghc latest",
mkDefaultHLSCompileOptions mkDefaultHLSCompileOptions
(HLS.HackageDist $ mkVersion' "2.0.0.0") (HLS.HackageDist $(versionQ "2.0.0.0"))
[ToolTag Latest] [ToolTag Latest]
) )
, (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20}) , (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10}) , (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False}) , (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True}) , (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"}) , (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"}) , (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True}) , (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
#ifdef IS_WINDOWS #ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"}) , (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
@@ -178,11 +179,11 @@ compileHlsCheckList = mapSecond CompileHLS
baseOptions :: HLSCompileOptions baseOptions :: HLSCompileOptions
baseOptions = baseOptions =
mkDefaultHLSCompileOptions mkDefaultHLSCompileOptions
(HLS.HackageDist $ mkVersion' "2.0.0.0") (HLS.HackageDist $(versionQ "2.0.0.0"))
[ghc928] [ghc928]
ghc928 :: ToolVersion ghc928 :: ToolVersion
ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8") ghc928 = GHCVersion $ GHCTargetVersion Nothing $(versionQ "9.2.8")
compileParseWith :: [String] -> IO CompileCommand compileParseWith :: [String] -> IO CompileCommand
compileParseWith args = do compileParseWith args = do

View File

@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module InstallTest where module InstallTest where
@@ -54,7 +55,7 @@ oldStyleCheckList =
: ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head" : ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
, Right defaultOptions , Right defaultOptions
{ instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|] { instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|]
, instVer = Just $ GHCVersion $ GHCTargetVersion Nothing (mkVersion $ (Str "head" :| []) :| []) , instVer = Just $ GHCVersion $ GHCTargetVersion Nothing $(versionQ "head")
} }
) )
: mapSecond : mapSecond
@@ -62,48 +63,48 @@ oldStyleCheckList =
[ ("install ghc-9.2", GHCVersion [ ("install ghc-9.2", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
-- invalid -- invalid
, ("install next", GHCVersion , ("install next", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "next" :| []) :| []) $(versionQ "next")
) )
, ("install latest", ToolTag Latest) , ("install latest", ToolTag Latest)
, ("install nightly", GHCVersion , ("install nightly", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
, ("install recommended", ToolTag Recommended) , ("install recommended", ToolTag Recommended)
, ("install prerelease", GHCVersion , ("install prerelease", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("install latest-prerelease", ToolTag LatestPrerelease) , ("install latest-prerelease", ToolTag LatestPrerelease)
, ("install latest-nightly", ToolTag LatestNightly) , ("install latest-nightly", ToolTag LatestNightly)
, ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion , ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs") (Just "ghc-javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal-3.10", GHCVersion , ("install cabal-3.10", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "cabal") (Just "cabal")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) $(versionQ "3.10")
) )
, ("install hls-2.0.0.0", GHCVersion , ("install hls-2.0.0.0", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "hls") (Just "hls")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []]) $(versionQ "2.0.0.0")
) )
, ("install stack-2.9.3", GHCVersion , ("install stack-2.9.3", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "stack") (Just "stack")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []]) $(versionQ "2.9.3")
) )
] ]
@@ -114,37 +115,37 @@ installGhcCheckList =
[ ("install ghc 9.2", GHCVersion [ ("install ghc 9.2", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
, ("install ghc next", GHCVersion , ("install ghc next", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "next" :| []) :| []) $(versionQ "next")
) )
, ("install ghc latest", ToolTag Latest) , ("install ghc latest", ToolTag Latest)
, ("install ghc nightly", GHCVersion , ("install ghc nightly", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
, ("install ghc recommended", ToolTag Recommended) , ("install ghc recommended", ToolTag Recommended)
, ("install ghc prerelease", GHCVersion , ("install ghc prerelease", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("install ghc latest-prerelease", ToolTag LatestPrerelease) , ("install ghc latest-prerelease", ToolTag LatestPrerelease)
, ("install ghc latest-nightly", ToolTag LatestNightly) , ("install ghc latest-nightly", ToolTag LatestNightly)
, ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion , ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "javascript-unknown-ghcjs") (Just "javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install ghc ghc-9.2", GHCVersion , ("install ghc ghc-9.2", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
] ]
@@ -152,69 +153,48 @@ installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
installCabalCheckList = installCabalCheckList =
("install cabal", Left $ InstallCabal defaultOptions{instSet = True}) ("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
: mapSecond (Left . InstallCabal . mkInstallOptions') : mapSecond (Left . InstallCabal . mkInstallOptions')
[ ("install cabal 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) [ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
, ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install cabal next", ToolVersion $(versionQ "next"))
, ("install cabal latest", ToolTag Latest) , ("install cabal latest", ToolTag Latest)
, ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("install cabal nightly", ToolVersion $(versionQ "nightly"))
, ("install cabal recommended", ToolTag Recommended) , ("install cabal recommended", ToolTag Recommended)
, ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("install cabal prerelease", ToolVersion $(versionQ "prerelease"))
, ("install cabal latest-prerelease", ToolTag LatestPrerelease) , ("install cabal latest-prerelease", ToolTag LatestPrerelease)
, ("install cabal latest-nightly", ToolTag LatestNightly) , ("install cabal latest-nightly", ToolTag LatestNightly)
, ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal cabal-3.10", ToolVersion , ("install cabal cabal-3.10", ToolVersion $(versionQ "cabal-3.10"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
] ]
installHlsCheckList :: [(String, Either InstallCommand InstallOptions)] installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
installHlsCheckList = installHlsCheckList =
("install hls", Left $ InstallHLS defaultOptions{instSet = True}) ("install hls", Left $ InstallHLS defaultOptions{instSet = True})
: mapSecond (Left . InstallHLS . mkInstallOptions') : mapSecond (Left . InstallHLS . mkInstallOptions')
[ ("install hls 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) [ ("install hls 3.10", ToolVersion $(versionQ "3.10"))
, ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install hls next", ToolVersion $(versionQ "next"))
, ("install hls latest", ToolTag Latest) , ("install hls latest", ToolTag Latest)
, ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("install hls nightly", ToolVersion $(versionQ "nightly"))
, ("install hls recommended", ToolTag Recommended) , ("install hls recommended", ToolTag Recommended)
, ("install hls prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("install hls prerelease", ToolVersion $(versionQ "prerelease"))
, ("install hls latest-prerelease", ToolTag LatestPrerelease) , ("install hls latest-prerelease", ToolTag LatestPrerelease)
, ("install hls latest-nightly", ToolTag LatestNightly) , ("install hls latest-nightly", ToolTag LatestNightly)
, ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install hls hls-2.0", ToolVersion , ("install hls hls-2.0", ToolVersion $(versionQ "hls-2.0"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
] ]
installStackCheckList :: [(String, Either InstallCommand InstallOptions)] installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
installStackCheckList = installStackCheckList =
("install stack", Left $ InstallStack defaultOptions{instSet = True}) ("install stack", Left $ InstallStack defaultOptions{instSet = True})
: mapSecond (Left . InstallStack . mkInstallOptions') : mapSecond (Left . InstallStack . mkInstallOptions')
[ ("install stack 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) [ ("install stack 3.10", ToolVersion $(versionQ "3.10"))
, ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install stack next", ToolVersion $(versionQ "next"))
, ("install stack latest", ToolTag Latest) , ("install stack latest", ToolTag Latest)
, ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("install stack nightly", ToolVersion $(versionQ "nightly"))
, ("install stack recommended", ToolTag Recommended) , ("install stack recommended", ToolTag Recommended)
, ("install stack prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("install stack prerelease", ToolVersion $(versionQ "prerelease"))
, ("install stack latest-prerelease", ToolTag LatestPrerelease) , ("install stack latest-prerelease", ToolTag LatestPrerelease)
, ("install stack latest-nightly", ToolTag LatestNightly) , ("install stack latest-nightly", ToolTag LatestNightly)
, ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install stack stack-2.9", ToolVersion , ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
] ]
installParseWith :: [String] -> IO (Either InstallCommand InstallOptions) installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)

View File

@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module RmTest where module RmTest where
@@ -6,7 +7,6 @@ import Test.Tasty
import GHCup.OptParse import GHCup.OptParse
import Utils import Utils
import GHCup.Types import GHCup.Types
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Versions import Data.Versions
@@ -24,54 +24,36 @@ rmTests =
oldStyleCheckList :: [(String, Either RmCommand RmOptions)] oldStyleCheckList :: [(String, Either RmCommand RmOptions)]
oldStyleCheckList = mapSecond (Right . RmOptions) oldStyleCheckList = mapSecond (Right . RmOptions)
[ -- failed with ("rm", xxx) [ -- failed with ("rm", xxx)
("rm 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) ("rm 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) , ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
] ]
rmGhcCheckList :: [(String, Either RmCommand RmOptions)] rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions) rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
[ -- failed with ("rm ghc", xxx) [ -- failed with ("rm ghc", xxx)
("rm ghc 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) ("rm ghc 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) , ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
] ]
rmCabalCheckList :: [(String, Either RmCommand RmOptions)] rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
rmCabalCheckList = mapSecond (Left . RmCabal) rmCabalCheckList = mapSecond (Left . RmCabal)
[ -- failed with ("rm cabal", xxx) [ -- failed with ("rm cabal", xxx)
("rm cabal 3.10", mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) ("rm cabal 3.10", $(versionQ "3.10"))
, ("rm cabal cabal-3.10", Version , ("rm cabal cabal-3.10", $(versionQ "cabal-3.10"))
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
] ]
rmHlsCheckList :: [(String, Either RmCommand RmOptions)] rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
rmHlsCheckList = mapSecond (Left . RmHLS) rmHlsCheckList = mapSecond (Left . RmHLS)
[ -- failed with ("rm hls", xxx) [ -- failed with ("rm hls", xxx)
("rm hls 2.0", mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []]) ("rm hls 2.0", $(versionQ "2.0"))
, ("rm hls hls-2.0", Version , ("rm hls hls-2.0", $(versionQ "hls-2.0"))
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
] ]
rmStackCheckList :: [(String, Either RmCommand RmOptions)] rmStackCheckList :: [(String, Either RmCommand RmOptions)]
rmStackCheckList = mapSecond (Left . RmStack) rmStackCheckList = mapSecond (Left . RmStack)
[ -- failed with ("rm stack", xxx) [ -- failed with ("rm stack", xxx)
("rm stack 2.9.1", mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 1 :| []]) ("rm stack 2.9.1", $(versionQ "2.9.1"))
, ("rm stack stack-2.9.1", Version , ("rm stack stack-2.9.1", $(versionQ "stack-2.9.1"))
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| [], Digits 1 :| []]
, _vMeta = Nothing
}
)
] ]
rmParseWith :: [String] -> IO (Either RmCommand RmOptions) rmParseWith :: [String] -> IO (Either RmCommand RmOptions)

View File

@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module RunTest where module RunTest where
@@ -7,6 +8,7 @@ import Test.Tasty
import GHCup.OptParse import GHCup.OptParse
import Utils import Utils
import GHCup.Types import GHCup.Types
import Data.Versions (versionQ)
runTests :: TestTree runTests :: TestTree
@@ -35,11 +37,11 @@ runCheckList =
, ("run --install", defaultOptions{runInstTool' = True}) , ("run --install", defaultOptions{runInstTool' = True})
, ("run -m", defaultOptions{runMinGWPath = True}) , ("run -m", defaultOptions{runMinGWPath = True})
, ("run --mingw-path", defaultOptions{runMinGWPath = True}) , ("run --mingw-path", defaultOptions{runMinGWPath = True})
, ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"}) , ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")})
, ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest}) , ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"}) , ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $(versionQ "3.10")})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"}) , ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(versionQ "2.0")})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "2.9"}) , ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(versionQ "2.9") })
#ifdef IS_WINDOWS #ifdef IS_WINDOWS
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"}) , ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"}) , ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
@@ -52,9 +54,9 @@ runCheckList =
, ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install", , ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install",
defaultOptions defaultOptions
{ runGHCVer = Just $ ToolTag Latest { runGHCVer = Just $ ToolTag Latest
, runCabalVer = Just $ ToolVersion $ mkVersion' "3.10" , runCabalVer = Just $ ToolVersion $(versionQ "3.10")
, runHLSVer = Just $ ToolVersion $ mkVersion' "2.0" , runHLSVer = Just $ ToolVersion $(versionQ "2.0")
, runStackVer = Just $ ToolVersion $ mkVersion' "2.9" , runStackVer = Just $ ToolVersion $(versionQ "2.9")
, runInstTool' = True , runInstTool' = True
} }
) )

View File

@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module SetTest where module SetTest where
@@ -27,44 +28,44 @@ oldStyleCheckList = mapSecond (Right . SetOptions)
, ("set ghc-9.2", SetGHCVersion , ("set ghc-9.2", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
, ("set next", SetNext) , ("set next", SetNext)
, ("set latest", SetToolTag Latest) , ("set latest", SetToolTag Latest)
, ("set nightly", SetGHCVersion , ("set nightly", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
-- different from `set` -- different from `set`
, ("set recommended", SetToolTag Recommended) , ("set recommended", SetToolTag Recommended)
, ("set prerelease", SetGHCVersion , ("set prerelease", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("set latest-prerelease", SetToolTag LatestPrerelease) , ("set latest-prerelease", SetToolTag LatestPrerelease)
, ("set latest-nightly", SetToolTag LatestNightly) , ("set latest-nightly", SetToolTag LatestNightly)
, ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion , ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs") (Just "ghc-javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal-3.10", SetGHCVersion , ("set cabal-3.10", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "cabal") (Just "cabal")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) $(versionQ "3.10")
) )
, ("set hls-2.0.0.0", SetGHCVersion , ("set hls-2.0.0.0", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "hls") (Just "hls")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []]) $(versionQ "2.0.0.0")
) )
, ("set stack-2.9.3", SetGHCVersion , ("set stack-2.9.3", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "stack") (Just "stack")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []]) $(versionQ "2.9.3")
) )
] ]
@@ -74,100 +75,79 @@ setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
, ("set ghc 9.2", SetGHCVersion , ("set ghc 9.2", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
, ("set ghc next", SetNext) , ("set ghc next", SetNext)
, ("set ghc latest", SetToolTag Latest) , ("set ghc latest", SetToolTag Latest)
, ("set ghc nightly", SetGHCVersion , ("set ghc nightly", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
, ("set ghc recommended", SetToolTag Recommended) , ("set ghc recommended", SetToolTag Recommended)
, ("set ghc prerelease", SetGHCVersion , ("set ghc prerelease", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("set ghc latest-prerelease", SetToolTag LatestPrerelease) , ("set ghc latest-prerelease", SetToolTag LatestPrerelease)
, ("set ghc latest-nightly", SetToolTag LatestNightly) , ("set ghc latest-nightly", SetToolTag LatestNightly)
, ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion , ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "javascript-unknown-ghcjs") (Just "javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set ghc ghc-9.2", SetGHCVersion , ("set ghc ghc-9.2", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
] ]
setCabalCheckList :: [(String, Either SetCommand SetOptions)] setCabalCheckList :: [(String, Either SetCommand SetOptions)]
setCabalCheckList = mapSecond (Left . SetCabal . SetOptions) setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
[ ("set cabal", SetRecommended) [ ("set cabal", SetRecommended)
, ("set cabal 3.10", SetToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) , ("set cabal 3.10", SetToolVersion $(versionQ "3.10"))
, ("set cabal next", SetNext) , ("set cabal next", SetNext)
, ("set cabal latest", SetToolTag Latest) , ("set cabal latest", SetToolTag Latest)
, ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("set cabal nightly", SetToolVersion $(versionQ "nightly"))
, ("set cabal recommended", SetToolTag Recommended) , ("set cabal recommended", SetToolTag Recommended)
, ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("set cabal prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set cabal latest-prerelease", SetToolTag LatestPrerelease) , ("set cabal latest-prerelease", SetToolTag LatestPrerelease)
, ("set cabal latest-nightly", SetToolTag LatestNightly) , ("set cabal latest-nightly", SetToolTag LatestNightly)
, ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal cabal-3.10", SetToolVersion , ("set cabal cabal-3.10", SetToolVersion $(versionQ "cabal-3.10"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
] ]
setHlsCheckList :: [(String, Either SetCommand SetOptions)] setHlsCheckList :: [(String, Either SetCommand SetOptions)]
setHlsCheckList = mapSecond (Left . SetHLS . SetOptions) setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
[ ("set hls", SetRecommended) [ ("set hls", SetRecommended)
, ("set hls 2.0", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []]) , ("set hls 2.0", SetToolVersion $(versionQ "2.0"))
, ("set hls next", SetNext) , ("set hls next", SetNext)
, ("set hls latest", SetToolTag Latest) , ("set hls latest", SetToolTag Latest)
, ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("set hls nightly", SetToolVersion $(versionQ "nightly"))
, ("set hls recommended", SetToolTag Recommended) , ("set hls recommended", SetToolTag Recommended)
, ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("set hls prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set hls latest-prerelease", SetToolTag LatestPrerelease) , ("set hls latest-prerelease", SetToolTag LatestPrerelease)
, ("set hls latest-nightly", SetToolTag LatestNightly) , ("set hls latest-nightly", SetToolTag LatestNightly)
, ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set hls hls-2.0", SetToolVersion , ("set hls hls-2.0", SetToolVersion $(versionQ "hls-2.0"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
] ]
setStackCheckList :: [(String, Either SetCommand SetOptions)] setStackCheckList :: [(String, Either SetCommand SetOptions)]
setStackCheckList = mapSecond (Left . SetStack . SetOptions) setStackCheckList = mapSecond (Left . SetStack . SetOptions)
[ ("set stack", SetRecommended) [ ("set stack", SetRecommended)
, ("set stack 2.9", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 9 :| []]) , ("set stack 2.9", SetToolVersion $(versionQ "2.9"))
, ("set stack next", SetNext) , ("set stack next", SetNext)
, ("set stack latest", SetToolTag Latest) , ("set stack latest", SetToolTag Latest)
, ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("set stack nightly", SetToolVersion $(versionQ "nightly"))
, ("set stack recommended", SetToolTag Recommended) , ("set stack recommended", SetToolTag Recommended)
, ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("set stack prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set stack latest-prerelease", SetToolTag LatestPrerelease) , ("set stack latest-prerelease", SetToolTag LatestPrerelease)
, ("set stack latest-nightly", SetToolTag LatestNightly) , ("set stack latest-nightly", SetToolTag LatestNightly)
, ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set stack stack-2.9", SetToolVersion , ("set stack stack-2.9", SetToolVersion $(versionQ "stack-2.9"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
] ]
setParseWith :: [String] -> IO (Either SetCommand SetOptions) setParseWith :: [String] -> IO (Either SetCommand SetOptions)

View File

@@ -4,12 +4,9 @@ module Utils where
import GHCup.OptParse as GHCup import GHCup.OptParse as GHCup
import Options.Applicative import Options.Applicative
import Data.Bifunctor import Data.Bifunctor
import Data.Versions
import Data.List.NonEmpty (NonEmpty)
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Control.Monad.IO.Class import Control.Monad.IO.Class
import qualified Data.Text as T
parseWith :: [String] -> IO Command parseWith :: [String] -> IO Command
parseWith args = parseWith args =
@@ -23,14 +20,6 @@ padLeft desiredLength s = padding ++ s
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)] mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSecond = map . second mapSecond = map . second
mkVersion :: NonEmpty VChunk -> Version
mkVersion chunks = Version Nothing chunks [] Nothing
mkVersion' :: T.Text -> Version
mkVersion' txt =
let Right ver = version txt
in ver
buildTestTree buildTestTree
:: (Eq a, Show a) :: (Eq a, Show a)
=> ([String] -> IO a) -- ^ The parse function => ([String] -> IO a) -- ^ The parse function

View File

@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module WhereisTest where module WhereisTest where
@@ -6,6 +7,7 @@ import Test.Tasty
import GHCup.OptParse import GHCup.OptParse
import Utils import Utils
import GHCup.Types import GHCup.Types
import Data.Versions (versionQ)
whereisTests :: TestTree whereisTests :: TestTree
whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList) whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
@@ -13,8 +15,8 @@ whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))] whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))]
whereisCheckList = concatMap mk whereisCheckList = concatMap mk
[ ("whereis ghc", WhereisTool GHC Nothing) [ ("whereis ghc", WhereisTool GHC Nothing)
, ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8")) , ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")))
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") (mkVersion' "9.2.8"))) , ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") $(versionQ "9.2.8")))
, ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest)) , ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest))
, ("whereis cabal", WhereisTool Cabal Nothing) , ("whereis cabal", WhereisTool Cabal Nothing)
, ("whereis hls", WhereisTool HLS Nothing) , ("whereis hls", WhereisTool HLS Nothing)