diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,130 @@ +# Revision history for ghcup + +## 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 ` +* 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=` 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=` +* 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 + +* First version. Released on an unsuspecting world. diff --git a/HACKING.md b/HACKING.md new file mode 100644 --- /dev/null +++ b/HACKING.md @@ -0,0 +1,75 @@ +# HACKING + +## 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 filepath or directory + +Filepath and directory have two fundamental problems: 1. they use String as filepath (see [AFPP](https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/abstract-file-path) as to why this is wrong) and 2. they try very hard to be cross-platform at the expense of low-level correctness. Instead, we use the [hpath](https://github.com/hasufell/hpath) libraries for file and filepath related stuff, which also gives us stronger filepath types. + +### 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 (for FreeBSD and mac) or http-io-streams, which works with OpenSSL bindings. + +### Optics instead of lens + +They're a little safer (less Monoid weirdness with view) and have better error messages. Consider the following wit lens + +``` +> view (_Just . to (++ "abc")) Nothing +"" +``` + +vs optics + +``` +> view (_Just % to (++ "abc")) Nothing + +: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 +``` + +### Strict and 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. + +## Code style and formatting + +1. Brittany +2. mtl-style preferred +3. no overly pointfree style + +## Code structure + +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: `ghcup-.yaml`. + +## Common Tasks + +### Adding a new GHC version + +1. open the latest `ghcup-.yaml` +2. find the latest ghc version (in yaml tree e.g. `ghcupDownloads -> GHC -> 8.10.3`) +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-tarballs -f ghcup-.yaml -u 'ghc-8\.10\.4'` + +## 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. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,243 @@ +`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). + +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). + +*Ubuntu users may prefer [hvr's ppa](https://launchpad.net/~hvr/+archive/ubuntu/ghc).* + +## Table of Contents + + * [Installation](#installation) + * [Simple bootstrap](#simple-bootstrap) + * [Manual install](#manual-install) + * [Vim integration](#vim-integration) + * [Usage](#usage) + * [Configuration](#configuration) + * [Manpages](#manpages) + * [Shell-completion](#shell-completion) + * [Cross support](#cross-support) + * [XDG support](#xdg-support) + * [Env variables](#env-variables) + * [Installing custom bindists](#installing-custom-bindists) + * [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://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/) +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" +``` + +### Vim integration + +See [ghcup.vim](https://github.com/hasufell/ghcup.vim). + +## Usage + +See `ghcup --help`. + +For the simple interactive TUI, 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 +``` + +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. + +### 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](./config.yaml). + +Partial configuration is fine. Command line options always overwrite 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 `shell-completions`. + +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). + +### 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`) + +### 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 +* `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). + +## 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/`, and places `ghc-` 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 + +* Github action [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup) +* [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//bin/ghc` or set that GHC version +as the current one via: `ghcup set ghc `. + +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 `. + +#### 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). + +3. Why the haskell reimplementation? + +Why not? diff --git a/RELEASING.md b/RELEASING.md new file mode 100644 --- /dev/null +++ b/RELEASING.md @@ -0,0 +1,19 @@ +# RELEASING + +1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version. + +2. Update version in ghcup.cabal + +3. Add ChangeLog entry + +4. Add/fix downloads in `ghcup-.yaml`, then verify with `ghcup-gen check -f ghcup-.yaml` + +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` + +7. Add release artifacts to yaml file (see point 4.) + +8. Upload the final `ghcup-.yaml` to `webhost.haskell.org/ghcup/data/`. + +9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/ghcup-gen/Main.hs b/app/ghcup-gen/Main.hs new file mode 100644 --- /dev/null +++ b/app/ghcup-gen/Main.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + + +module Main where + +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Utils.Logger + +import Data.Char ( toLower ) +#if !MIN_VERSION_base(4,13,0) +import Data.Semigroup ( (<>) ) +#endif +import Options.Applicative hiding ( style ) +import System.Console.Pretty +import System.Exit +import System.IO ( stdout ) +import Text.Regex.Posix +import Validate + +import qualified Data.ByteString as B +import qualified Data.Yaml as Y + + +data Options = Options + { optCommand :: Command + } + +data Command = ValidateYAML ValidateYAMLOpts + | ValidateTarballs ValidateYAMLOpts TarballFilter + + +data Input + = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway + | StdInput + +fileInput :: Parser Input +fileInput = + FileInput + <$> strOption + (long "file" <> short 'f' <> metavar "FILENAME" <> help + "Input file to validate" + ) + +stdInput :: Parser Input +stdInput = flag' + StdInput + (short 'i' <> long "stdin" <> help "Validate from stdin (default)") + +inputP :: Parser Input +inputP = fileInput <|> stdInput + +data ValidateYAMLOpts = ValidateYAMLOpts + { vInput :: Maybe Input + } + +validateYAMLOpts :: Parser ValidateYAMLOpts +validateYAMLOpts = ValidateYAMLOpts <$> optional inputP + +tarballFilterP :: Parser TarballFilter +tarballFilterP = option readm $ + long "tarball-filter" <> short 'u' <> metavar "-" <> value def + <> help "Only check certain tarballs (format: -)" + where + def = TarballFilter 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 $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v) + _ -> fail "invalid tool" + low = fmap toLower + + +opts :: Parser Options +opts = Options <$> com + +com :: Parser Command +com = subparser + ( command + "check" + ( ValidateYAML + <$> info (validateYAMLOpts <**> helper) + (progDesc "Validate the YAML") + ) + <> command + "check-tarballs" + (info + ((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper) + (progDesc "Validate all tarballs (download and checksum)") + ) + ) + + + +main :: IO () +main = do + _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) + >>= \Options {..} -> case optCommand of + ValidateYAML vopts -> case vopts of + ValidateYAMLOpts { vInput = Nothing } -> + B.getContents >>= valAndExit validate + ValidateYAMLOpts { vInput = Just StdInput } -> + B.getContents >>= valAndExit validate + ValidateYAMLOpts { vInput = Just (FileInput file) } -> + B.readFile file >>= valAndExit validate + ValidateTarballs vopts tarballFilter -> case vopts of + ValidateYAMLOpts { vInput = Nothing } -> + B.getContents >>= valAndExit (validateTarballs tarballFilter) + ValidateYAMLOpts { vInput = Just StdInput } -> + B.getContents >>= valAndExit (validateTarballs tarballFilter) + ValidateYAMLOpts { vInput = Just (FileInput file) } -> + B.readFile file >>= valAndExit (validateTarballs tarballFilter) + pure () + + where + valAndExit f contents = do + (GHCupInfo _ av) <- case Y.decodeEither' contents of + Right r -> pure r + Left e -> die (color Red $ show e) + myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av) + >>= exitWith diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs new file mode 100644 --- /dev/null +++ b/app/ghcup-gen/Validate.hs @@ -0,0 +1,268 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + +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 + +#if defined(TAR) +import qualified Codec.Archive.Tar as Tar +#else +import Codec.Archive +#endif +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 HPath ( toFilePath ) +import Haskus.Utils.Variant.Excepts +import Optics +import System.Exit +import System.IO +import System.Posix.FilePath +import Text.ParserCombinators.ReadP +import Text.PrettyPrint.HughesPJClass ( prettyShow ) +import Text.Regex.Posix + +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 + deriving Show + +instance Exception ValidationError + + +addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m () +addError = do + ref <- ask + liftIO $ modifyIORef ref (+ 1) + + +validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m, MonadUnliftIO m) + => GHCupDownloads + -> m ExitCode +validate dls = do + ref <- liftIO $ newIORef 0 + + -- verify binary downloads -- + flip runReaderT ref $ do + -- unique tags + forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t + + -- required platforms + 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) + + checkGHCVerIsValid + forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t + _ <- checkGHCHasBaseVersion + + -- exit + e <- liftIO $ readIORef ref + if e > 0 + then pure $ ExitFailure e + else do + lift $ $(logInfo) [i|All good|] + pure ExitSuccess + where + checkHasRequiredPlatforms t v tags arch pspecs = do + let v' = prettyVer v + arch' = prettyShow arch + when (notElem (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) [i|Darwin missing for #{t} #{v'} #{arch'}|] + addError + when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn) + [i|FreeBSD missing for #{t} #{v'} #{arch'}|] + + -- 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) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError + Cabal | v > [vver|2.4.1.0|] + , arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError + GHC | Latest `elem` tags || Recommended `elem` tags + , arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) + _ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|] + + checkUniqueTags tool = do + let allTags = join $ M.elems $ availableToolVersions dls tool + let nonUnique = + fmap fst + . filter (\(_, b) -> not b) + <$> ( mapM + (\case + [] -> throwM $ InternalError "empty inner list" + (t : ts) -> + pure $ (t, ) (not (isUniqueTag t) || null ts) + ) + . group + . sort + $ allTags + ) + case join nonUnique of + [] -> pure () + xs -> do + 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 + + checkGHCVerIsValid = 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) [i|GHC version #{v} is not valid |] + addError + + -- a tool must have at least one of each mandatory tags + checkMandatoryTags tool = do + let allTags = join $ M.elems $ availableToolVersions dls tool + forM_ [Latest, Recommended] $ \t -> case elem t allTags of + False -> do + 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, tags) -> case any isBase tags of + False -> do + lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|] + addError + True -> pure () + + isBase (Base _) = True + isBase _ = False + +data TarballFilter = TarballFilter + { tfTool :: Maybe Tool + , tfVersion :: Regex + } + +validateTarballs :: ( Monad m + , MonadLogger m + , MonadThrow m + , MonadIO m + , MonadUnliftIO m + , MonadMask m + ) + => TarballFilter + -> GHCupDownloads + -> m ExitCode +validateTarballs (TarballFilter tool versionRegex) dls = do + ref <- liftIO $ newIORef 0 + + flip runReaderT ref $ do + -- download/verify all tarballs + let dlis = nubOrd $ dls ^.. each + %& indices (maybe (const True) (==) tool) %> each + %& indices (matchTest versionRegex . T.unpack . prettyVer) + % (viSourceDL % _Just `summing` viArch % each % each % each) + when (null dlis) $ $(logError) [i|no tarballs selected by filter|] *> addError + forM_ dlis downloadAll + + -- exit + e <- liftIO $ readIORef ref + if e > 0 + then pure $ ExitFailure e + else do + lift $ $(logInfo) [i|All good|] + pure ExitSuccess + + where + runLogger = myLoggerT LoggerConfig { lcPrintDebug = True + , colorOutter = B.hPut stderr + , rawOutter = \_ -> pure () + } + downloadAll dli = do + dirs <- liftIO getDirs + let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings + + r <- + runLogger + . flip runReaderT settings + . runResourceT + . runE @'[DigestError + , DownloadFailed + , UnknownArchive +#if defined(TAR) + , Tar.FormatError +#else + , ArchiveResult +#endif + ] + $ do + p <- liftE $ downloadCached dli Nothing + fmap (head . splitDirectories . head) + . liftE + . getArchiveFiles + $ p + case r of + VRight basePath -> do + case _dlSubdir dli of + Just (RealDir (toFilePath -> prel)) -> do + lift $ $(logInfo) + [i|verifying subdir: #{prel}|] + when (basePath /= prel) $ do + lift $ $(logError) + [i|Subdir doesn't match: expected "#{prel}", got "#{basePath}"|] + addError + Just (RegexDir regexString) -> do + lift $ $(logInfo) + [i|verifying subdir (regex): #{regexString}|] + let regex = makeRegexOpts + compIgnoreCase + execBlank + regexString + when (not (match regex basePath)) $ do + lift $ $(logError) + [i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|] + addError + Nothing -> pure () + VLeft e -> do + lift $ $(logError) + [i|Could not download (or verify hash) of #{dli}, Error was: #{e}|] + addError diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs new file mode 100644 --- /dev/null +++ b/app/ghcup/BrickMain.hs @@ -0,0 +1,605 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + +module BrickMain where + +import GHCup +import GHCup.Download +import GHCup.Errors +import GHCup.Types +import GHCup.Utils +import GHCup.Utils.File +import GHCup.Utils.Logger + +import Brick +import Brick.Widgets.Border +import Brick.Widgets.Border.Style +import Brick.Widgets.Center +import Brick.Widgets.List ( listSelectedFocusedAttr + , listSelectedAttr + , listAttr + ) +#if !defined(TAR) +import Codec.Archive +#endif +import Control.Exception.Safe +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.Bool +import Data.Functor +import Data.List +import Data.Maybe +import Data.IORef +import Data.String.Interpolate +import Data.Vector ( Vector + , (!?) + ) +import Data.Versions hiding ( str ) +import Haskus.Utils.Variant.Excepts +import Prelude hiding ( appendFile ) +import System.Environment +import System.Exit +import System.IO.Unsafe +import Text.PrettyPrint.HughesPJClass ( prettyShow ) +import URI.ByteString + +import qualified GHCup.Types as GT + +import qualified Data.Text as T +import qualified Graphics.Vty as Vty +import qualified Data.Vector as V + + + +data BrickData = BrickData + { lr :: [ListResult] + , dls :: GHCupDownloads + , pfreq :: PlatformRequest + } + deriving Show + +data BrickSettings = BrickSettings + { showAll :: 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 set') + , (bChangelog, const "ChangeLog", withIOAction changelog') + , ( bShowAll + , \BrickSettings {..} -> + if showAll then "Hide old versions" else "Show all versions" + , hideShowHandler + ) + , (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. }) + , (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. }) + ] + where + hideShowHandler BrickState{..} = + let newAppSettings = appSettings { showAll = not . showAll $ 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 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" + + 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 = neverShowCursor + } + +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) -> IO (Either String a)) + -> BrickState + -> EventM n (Next BrickState) +withIOAction action as = case listSelectedElement' (appState as) of + Nothing -> continue as + Just (ix, e) -> suspendAndResume $ do + action as (ix, e) >>= \case + Left err -> putStrLn ("Error: " <> err) + Right _ -> putStrLn "Success" + getAppData Nothing (pfreq . appData $ as) >>= \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 (showAll 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 -> ListResult -> Bool +filterVisible showAll e | lInstalled e = True + | showAll = True + | otherwise = not (elem Old (lTag e)) + + +install' :: BrickState -> (Int, ListResult) -> IO (Either String ()) +install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do + settings <- readIORef settings' + l <- readIORef logger' + let runLogger = myLoggerT l + + let run = + runLogger + . flip runReaderT settings + . runResourceT + . runE + @'[ AlreadyInstalled +#if !defined(TAR) + , ArchiveResult +#endif + , UnknownArchive + , FileDoesNotExistError + , CopyError + , NoDownload + , NotInstalled + , BuildFailed + , TagNotFound + , DigestError + , DownloadFailed + , NoUpdate + , TarDirDoesNotExist + ] + + run (do + case lTool of + GHC -> do + let vi = getVersionInfo lVer GHC dls + liftE $ installGHCBin dls lVer pfreq $> vi + Cabal -> do + let vi = getVersionInfo lVer Cabal dls + liftE $ installCabalBin dls lVer pfreq $> vi + GHCup -> do + let vi = snd <$> getLatest dls GHCup + liftE $ upgradeGHCup dls Nothing False pfreq $> vi + HLS -> do + let vi = getVersionInfo lVer HLS dls + liftE $ installHLSBin dls lVer pfreq $> vi + ) + >>= \case + VRight vi -> do + forM_ (_viPostInstall =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure $ Right () + VLeft (V (AlreadyInstalled _ _)) -> pure $ Right () + VLeft (V NoUpdate) -> pure $ Right () + VLeft e -> pure $ Left [i|#{prettyShow e} +Also check the logs in ~/.ghcup/logs|] + + +set' :: BrickState -> (Int, ListResult) -> IO (Either String ()) +set' _ (_, ListResult {..}) = do + settings <- readIORef settings' + l <- readIORef logger' + let runLogger = myLoggerT l + + let run = + runLogger + . 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 $> () + GHCup -> pure () + ) + >>= \case + VRight _ -> pure $ Right () + VLeft e -> pure $ Left (prettyShow e) + + +del' :: BrickState -> (Int, ListResult) -> IO (Either String ()) +del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do + settings <- readIORef settings' + l <- readIORef logger' + let runLogger = myLoggerT l + + let run = runLogger . flip runReaderT settings . 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 + GHCup -> pure Nothing + ) + >>= \case + VRight vi -> do + forM_ (join $ fmap _viPostRemove vi) $ \msg -> + runLogger $ $(logInfo) msg + pure $ Right () + VLeft e -> pure $ Left (prettyShow e) + + +changelog' :: BrickState -> (Int, ListResult) -> IO (Either String ()) +changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do + case getChangeLog dls lTool (Left lVer) of + Nothing -> pure $ Left + [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|] + Just uri -> do + let cmd = case _rPlatform pfreq of + Darwin -> "open" + Linux _ -> "xdg-open" + FreeBSD -> "xdg-open" + exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case + Right _ -> pure $ Right () + Left e -> pure $ Left $ prettyShow e + + +settings' :: IORef AppState +{-# NOINLINE settings' #-} +settings' = unsafePerformIO $ do + dirs <- getDirs + newIORef $ AppState (Settings { cache = True + , noVerify = False + , keepDirs = Never + , downloader = Curl + , verbose = False + , urlSource = GHCupURL + , .. + }) + dirs + defaultKeyBindings + + + +logger' :: IORef LoggerConfig +{-# NOINLINE logger' #-} +logger' = unsafePerformIO + (newIORef $ LoggerConfig { lcPrintDebug = False + , colorOutter = \_ -> pure () + , rawOutter = \_ -> pure () + } + ) + + +brickMain :: AppState + -> LoggerConfig + -> GHCupDownloads + -> PlatformRequest + -> IO () +brickMain s l av pfreq' = do + writeIORef settings' s + -- logger interpreter + writeIORef logger' l + let runLogger = myLoggerT l + + no_color <- isJust <$> lookupEnv "NO_COLOR" + + eAppData <- getAppData (Just av) pfreq' + case eAppData of + Right ad -> + defaultMain + (app (defaultAttributes no_color) (dimAttributes no_color)) + (BrickState ad + defaultAppSettings + (constructList ad defaultAppSettings Nothing) + (keyBindings s) + + ) + $> () + Left e -> do + runLogger ($(logError) [i|Error building app state: #{show e}|]) + exitWith $ ExitFailure 2 + + +defaultAppSettings :: BrickSettings +defaultAppSettings = BrickSettings { showAll = False } + + +getDownloads' :: IO (Either String GHCupDownloads) +getDownloads' = do + settings <- readIORef settings' + l <- readIORef logger' + let runLogger = myLoggerT l + + r <- + runLogger + . flip runReaderT settings + . runE @'[JSONError , DownloadFailed , FileDoesNotExistError] + $ fmap _ghcupDownloads + $ liftE + $ getDownloadsF (urlSource . GT.settings $ settings) + + case r of + VRight a -> pure $ Right a + VLeft e -> pure $ Left (prettyShow e) + + +getAppData :: Maybe GHCupDownloads + -> PlatformRequest + -> IO (Either String BrickData) +getAppData mg pfreq' = do + settings <- readIORef settings' + l <- readIORef logger' + let runLogger = myLoggerT l + + r <- maybe getDownloads' (pure . Right) mg + + runLogger . flip runReaderT settings $ do + case r of + Right dls -> do + lV <- listVersions dls Nothing Nothing pfreq' + pure $ Right $ BrickData (reverse lV) dls pfreq' + Left e -> pure $ Left [i|#{e}|] + diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs new file mode 100644 --- /dev/null +++ b/app/ghcup/Main.hs @@ -0,0 +1,1866 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} + + +module Main where + +#if defined(BRICK) +import BrickMain ( brickMain ) +#endif + +import GHCup +import GHCup.Download +import GHCup.Errors +import GHCup.Platform +import GHCup.Requirements +import GHCup.Types +import GHCup.Utils +import GHCup.Utils.File +import GHCup.Utils.Logger +import GHCup.Utils.MegaParsec +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ +import GHCup.Version + +#if !defined(TAR) +import Codec.Archive +#endif +import Control.Concurrent +import Control.Exception.Safe +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail ( MonadFail ) +#endif +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.Bifunctor +import Data.Char +import Data.Either +import Data.Functor +import Data.List ( intercalate, nub, sort, sortBy ) +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Maybe +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Versions hiding ( str ) +import Data.Void +import GHC.IO.Encoding +import Haskus.Utils.Variant.Excepts +import HPath +import HPath.IO +import Language.Haskell.TH +import Options.Applicative hiding ( style ) +import Options.Applicative.Help.Pretty ( text ) +import Prelude hiding ( appendFile ) +import Safe +import System.Console.Pretty hiding ( color ) +import qualified System.Console.Pretty as Pretty +import System.Environment +import System.Exit +import System.IO hiding ( appendFile ) +import Text.Read hiding ( lift ) +import Text.PrettyPrint.HughesPJClass ( prettyShow ) +import URI.ByteString + +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Text.Encoding as E +import qualified Text.Megaparsec as MP +import qualified Text.Megaparsec.Char as MPC + + + + + +data Options = Options + { + -- global options + optVerbose :: Maybe Bool + , optCache :: Maybe Bool + , optUrlSource :: Maybe URI + , optNoVerify :: Maybe Bool + , optKeepDirs :: Maybe KeepDirs + , optsDownloader :: Maybe Downloader + -- commands + , optCommand :: Command + } + +data Command + = Install (Either InstallCommand InstallOptions) + | InstallCabalLegacy InstallOptions + | Set (Either SetCommand SetOptions) + | List ListOptions + | Rm (Either RmCommand RmOptions) + | DInfo + | Compile CompileCommand + | Upgrade UpgradeOpts Bool + | ToolRequirements + | ChangeLog ChangeLogOptions +#if defined(BRICK) + | Interactive +#endif + +data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal + | ToolTag Tag + +prettyToolVer :: ToolVersion -> String +prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v' +prettyToolVer (ToolTag t) = show t + +toSetToolVer :: Maybe ToolVersion -> SetToolVersion +toSetToolVer (Just (ToolVersion v')) = SetToolVersion v' +toSetToolVer (Just (ToolTag t')) = SetToolTag t' +toSetToolVer Nothing = SetRecommended + + +data InstallCommand = InstallGHC InstallOptions + | InstallCabal InstallOptions + | InstallHLS InstallOptions + +data InstallOptions = InstallOptions + { instVer :: Maybe ToolVersion + , instPlatform :: Maybe PlatformRequest + , instBindist :: Maybe URI + , instSet :: Bool + } + +data SetCommand = SetGHC SetOptions + | SetCabal SetOptions + | SetHLS SetOptions + +-- a superset of ToolVersion +data SetToolVersion = SetToolVersion GHCTargetVersion + | SetToolTag Tag + | SetRecommended + | SetNext + +data SetOptions = SetOptions + { sToolVer :: SetToolVersion + } + +data ListOptions = ListOptions + { loTool :: Maybe Tool + , lCriteria :: Maybe ListCriteria + , lRawFormat :: Bool + } + +data RmCommand = RmGHC RmOptions + | RmCabal Version + | RmHLS Version + +data RmOptions = RmOptions + { ghcVer :: GHCTargetVersion + } + + +data CompileCommand = CompileGHC GHCCompileOptions + + +data GHCCompileOptions = GHCCompileOptions + { targetVer :: Version + , bootstrapGhc :: Either Version (Path Abs) + , jobs :: Maybe Int + , buildConfig :: Maybe (Path Abs) + , patchDir :: Maybe (Path Abs) + , crossTarget :: Maybe Text + , addConfArgs :: [Text] + , setCompile :: Bool + } + +data CabalCompileOptions = CabalCompileOptions + { targetVer :: Version + , bootstrapGhc :: Either Version (Path Abs) + , jobs :: Maybe Int + , buildConfig :: Maybe (Path Abs) + , patchDir :: Maybe (Path Abs) + } + +data UpgradeOpts = UpgradeInplace + | UpgradeAt (Path Abs) + | UpgradeGHCupDir + deriving Show + +data ChangeLogOptions = ChangeLogOptions + { clOpen :: Bool + , clTool :: Maybe Tool + , clToolVer :: Maybe ToolVersion + } + + +-- https://github.com/pcapriotti/optparse-applicative/issues/148 + +-- | A switch that can be enabled using --foo and disabled using --no-foo. +-- +-- The option modifier is applied to only the option that is *not* enabled +-- by default. For example: +-- +-- > invertableSwitch "recursive" True (help "do not recurse into directories") +-- +-- This example makes --recursive enabled by default, so +-- the help is shown only for --no-recursive. +invertableSwitch + :: String -- ^ long option + -> Char -- ^ short option for the non-default option + -> Bool -- ^ is switch enabled by default? + -> Mod FlagFields Bool -- ^ option modifier + -> Parser (Maybe Bool) +invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shortopt defv + (if defv then mempty else optmod) + (if defv then optmod else mempty) + +-- | Allows providing option modifiers for both --foo and --no-foo. +invertableSwitch' + :: String -- ^ long option (eg "foo") + -> Char -- ^ short option for the non-default option + -> Bool -- ^ is switch enabled by default? + -> Mod FlagFields Bool -- ^ option modifier for --foo + -> Mod FlagFields Bool -- ^ option modifier for --no-foo + -> Parser (Maybe Bool) +invertableSwitch' longopt shortopt defv enmod dismod = optional + ( flag' True (enmod <> long longopt <> if defv then mempty else short shortopt) + <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty) + ) + where + nolongopt = "no-" ++ longopt + + +opts :: Parser Options +opts = + Options + <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)") + <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)") + <*> (optional + (option + (eitherReader parseUri) + ( short 's' + <> long "url-source" + <> metavar "URL" + <> help "Alternative ghcup download info url" + <> internal + ) + ) + ) + <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)")) + <*> optional (option + (eitherReader keepOnParser) + ( long "keep" + <> metavar "" + <> help + "Keep build directories? (default: errors)" + <> hidden + )) + <*> optional (option + (eitherReader downloaderParser) + ( long "downloader" +#if defined(INTERNAL_DOWNLOADER) + <> metavar "" + <> help + "Downloader to use (default: internal)" +#else + <> metavar "" + <> help + "Downloader to use (default: curl)" +#endif + <> hidden + )) + <*> com + where + parseUri s' = + first show $ parseURI strictURIParserOptions (UTF8.fromString s') + + +com :: Parser Command +com = + subparser +#if defined(BRICK) + ( command + "tui" + ( (\_ -> Interactive) + <$> (info + helper + ( progDesc "Start the interactive GHCup UI" + ) + ) + ) + <> command +#else + ( command +#endif + "install" + ( Install + <$> info + (installParser <**> helper) + ( progDesc "Install or update GHC/cabal" + <> footerDoc (Just $ text installToolFooter) + ) + ) + <> command + "set" + (info + (Set <$> setParser <**> helper) + ( progDesc "Set currently active GHC/cabal version" + <> footerDoc (Just $ text setFooter) + ) + ) + <> command + "rm" + (info + (Rm <$> rmParser <**> helper) + ( progDesc "Remove a GHC/cabal version" + <> footerDoc (Just $ text rmFooter) + ) + ) + + <> command + "list" + (info (List <$> listOpts <**> helper) + (progDesc "Show available GHCs and other tools") + ) + <> command + "upgrade" + (info + ( (Upgrade <$> upgradeOptsP <*> switch + (short 'f' <> long "force" <> help "Force update") + ) + <**> helper + ) + (progDesc "Upgrade ghcup") + ) + <> command + "compile" + ( Compile + <$> info (compileP <**> helper) + (progDesc "Compile a tool from source") + ) + <> commandGroup "Main commands:" + ) + <|> subparser + ( command + "debug-info" + ((\_ -> DInfo) <$> info helper (progDesc "Show debug info")) + <> command + "tool-requirements" + ( (\_ -> ToolRequirements) + <$> info helper + (progDesc "Show the requirements for ghc/cabal") + ) + <> command + "changelog" + (info + (fmap ChangeLog changelogP <**> helper) + ( progDesc "Find/show changelog" + <> footerDoc (Just $ text changeLogFooter) + ) + ) + <> commandGroup "Other commands:" + <> hidden + ) + <|> subparser + ( command + "install-cabal" + (info + ((InstallCabalLegacy <$> installOpts (Just Cabal)) <**> helper) + ( progDesc "Install or update cabal" + <> footerDoc (Just $ text installCabalFooter) + ) + ) + <> internal + ) + where + installToolFooter :: String + installToolFooter = [s|Discussion: + Installs GHC or cabal. When no command is given, installs GHC + with the specified version/tag. + It is recommended to always specify a subcommand (ghc/cabal/hls).|] + + setFooter :: String + setFooter = [s|Discussion: + Sets the currently active GHC or cabal version. When no command is given, + defaults to setting GHC with the specified version/tag (if no tag + is given, sets GHC to 'recommended' version). + It is recommended to always specify a subcommand (ghc/cabal/hls).|] + + rmFooter :: String + rmFooter = [s|Discussion: + Remove the given GHC or cabal version. When no command is given, + defaults to removing GHC with the specified version. + It is recommended to always specify a subcommand (ghc/cabal/hls).|] + + changeLogFooter :: String + changeLogFooter = [s|Discussion: + By default returns the URI of the ChangeLog of the latest GHC release. + Pass '-o' to automatically open via xdg-open.|] + + +installCabalFooter :: String +installCabalFooter = [s|Discussion: + Installs the specified cabal-install version (or a recommended default one) + into "~/.ghcup/bin", so it can be overwritten by later + "cabal install cabal-install", which installs into "~/.cabal/bin" by + default. Make sure to set up your PATH appropriately, so the cabal + installation takes precedence.|] + + +installParser :: Parser (Either InstallCommand InstallOptions) +installParser = + (Left <$> subparser + ( command + "ghc" + ( InstallGHC + <$> info + (installOpts (Just GHC) <**> helper) + ( progDesc "Install GHC" + <> footerDoc (Just $ text installGHCFooter) + ) + ) + <> command + "cabal" + ( InstallCabal + <$> info + (installOpts (Just Cabal) <**> helper) + ( progDesc "Install Cabal" + <> footerDoc (Just $ text installCabalFooter) + ) + ) + <> command + "hls" + ( InstallHLS + <$> info + (installOpts (Just HLS) <**> helper) + ( progDesc "Install haskell-languge-server" + <> footerDoc (Just $ text installHLSFooter) + ) + ) + ) + ) + <|> (Right <$> installOpts Nothing) + where + installHLSFooter :: String + installHLSFooter = [s|Discussion: + Installs haskell-language-server binaries and wrapper + into "~/.ghcup/bin" + +Examples: + # install recommended GHC + ghcup install hls|] + + installGHCFooter :: String + installGHCFooter = [s|Discussion: + Installs the specified GHC version (or a recommended default one) into + a self-contained "~/.ghcup/ghc/" directory + and symlinks the ghc binaries to "~/.ghcup/bin/-". + +Examples: + # install recommended GHC + ghcup install ghc + + # install latest GHC + ghcup install ghc latest + + # install GHC 8.10.2 + ghcup install ghc 8.10.2 + + # install GHC head fedora bindist + 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|] + + +installOpts :: Maybe Tool -> Parser InstallOptions +installOpts tool = + (\p (u, v) b -> InstallOptions v p u b) + <$> optional + (option + (eitherReader platformParser) + ( short 'p' + <> long "platform" + <> metavar "PLATFORM" + <> help + "Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux" + ) + ) + <*> ( ( (,) + <$> optional + (option + (eitherReader bindistParser) + (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help + "Install the specified version from this bindist" + ) + ) + <*> (Just <$> toolVersionArgument Nothing tool) + ) + <|> pure (Nothing, Nothing) + ) + <*> flag + False + True + (long "set" <> help + "Set as active version after install" + ) + + +setParser :: Parser (Either SetCommand SetOptions) +setParser = + (Left <$> subparser + ( command + "ghc" + ( SetGHC + <$> info + (setOpts (Just GHC) <**> helper) + ( progDesc "Set GHC version" + <> footerDoc (Just $ text setGHCFooter) + ) + ) + <> command + "cabal" + ( SetCabal + <$> info + (setOpts (Just Cabal) <**> helper) + ( progDesc "Set Cabal version" + <> footerDoc (Just $ text setCabalFooter) + ) + ) + <> command + "hls" + ( SetHLS + <$> info + (setOpts (Just HLS) <**> helper) + ( progDesc "Set haskell-language-server version" + <> footerDoc (Just $ text setHLSFooter) + ) + ) + ) + ) + <|> (Right <$> setOpts Nothing) + where + setGHCFooter :: String + setGHCFooter = [s|Discussion: + Sets the the current GHC version by creating non-versioned + symlinks for all ghc binaries of the specified version in + "~/.ghcup/bin/".|] + + setCabalFooter :: String + setCabalFooter = [s|Discussion: + Sets the the current Cabal version.|] + + setHLSFooter :: String + setHLSFooter = [s|Discussion: + Sets the the current haskell-language-server version.|] + + +setOpts :: Maybe Tool -> Parser SetOptions +setOpts tool = SetOptions <$> + (fromMaybe SetRecommended <$> + optional (setVersionArgument (Just ListInstalled) tool)) + +listOpts :: Parser ListOptions +listOpts = + ListOptions + <$> optional + (option + (eitherReader toolParser) + (short 't' <> long "tool" <> metavar "" <> help + "Tool to list versions for. Default is all" + ) + ) + <*> optional + (option + (eitherReader criteriaParser) + ( short 'c' + <> long "show-criteria" + <> metavar "" + <> help "Show only installed or set tool versions" + ) + ) + <*> switch + (short 'r' <> long "raw-format" <> help "More machine-parsable format" + ) + + +rmParser :: Parser (Either RmCommand RmOptions) +rmParser = + (Left <$> subparser + ( command + "ghc" + (RmGHC <$> info (rmOpts (Just GHC) <**> helper) (progDesc "Remove GHC version")) + <> command + "cabal" + ( RmCabal + <$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper) + (progDesc "Remove Cabal version") + ) + <> command + "hls" + ( RmHLS + <$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper) + (progDesc "Remove haskell-language-server version") + ) + ) + ) + <|> (Right <$> rmOpts Nothing) + + + +rmOpts :: Maybe Tool -> Parser RmOptions +rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool + + +changelogP :: Parser ChangeLogOptions +changelogP = + (\x y -> ChangeLogOptions x y) + <$> switch (short 'o' <> long "open" <> help "xdg-open the changelog url") + <*> optional + (option + (eitherReader + (\s' -> case fmap toLower s' of + "ghc" -> Right GHC + "cabal" -> Right Cabal + "ghcup" -> Right GHCup + e -> Left e + ) + ) + (short 't' <> long "tool" <> metavar "" <> help + "Open changelog for given tool (default: ghc)" + ) + ) + <*> optional (toolVersionArgument Nothing Nothing) + +compileP :: Parser CompileCommand +compileP = subparser + ( command + "ghc" + ( CompileGHC + <$> info + (ghcCompileOpts <**> helper) + ( progDesc "Compile GHC from source" + <> footerDoc (Just $ text compileFooter) + ) + ) + ) + where + compileFooter = [s|Discussion: + Compiles and installs the specified GHC version into + a self-contained "~/.ghcup/ghc/" directory + and symlinks the ghc binaries to "~/.ghcup/bin/-". + + This also allows building a cross-compiler. Consult the documentation + first: + +ENV variables: + Various toolchain variables will be passed onto the ghc build system, + such as: CC, LD, OBJDUMP, NM, AR, RANLIB. + +Examples: + ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 + # specify path to bootstrap ghc + ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2 + # build cross compiler + ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|] + + +ghcCompileOpts :: Parser GHCCompileOptions +ghcCompileOpts = + (\CabalCompileOptions {..} crossTarget addConfArgs setCompile -> GHCCompileOptions { .. } + ) + <$> cabalCompileOpts + <*> optional + (option + str + (short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help + "Build cross-compiler for this platform" + ) + ) + <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)")) + <*> flag + False + True + (long "set" <> help + "Set as active version after install" + ) + +cabalCompileOpts :: Parser CabalCompileOptions +cabalCompileOpts = + CabalCompileOptions + <$> option + (eitherReader + (first (const "Not a valid version") . version . T.pack) + ) + (short 'v' <> long "version" <> metavar "VERSION" <> help + "The tool version to compile" + ) + <*> option + (eitherReader + (\x -> + (bimap (const "Not a valid version") Left . version . T.pack $ x) + <|> (bimap show Right . parseAbs . E.encodeUtf8 . T.pack $ x) + ) + ) + ( short 'b' + <> long "bootstrap-ghc" + <> metavar "BOOTSTRAP_GHC" + <> help + "The GHC version (or full path) to bootstrap with (must be installed)" + ) + <*> optional + (option + (eitherReader (readEither @Int)) + (short 'j' <> long "jobs" <> metavar "JOBS" <> help + "How many jobs to use for make" + ) + ) + <*> optional + (option + (eitherReader + (\x -> + first show . parseAbs . E.encodeUtf8 . T.pack $ x :: Either + String + (Path Abs) + ) + ) + (short 'c' <> long "config" <> metavar "CONFIG" <> help + "Absolute path to build config file" + ) + ) + <*> optional + (option + (eitherReader + (\x -> + first show . parseAbs . E.encodeUtf8 . T.pack $ x :: Either + String + (Path Abs) + ) + ) + (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help + "Absolute path to patch directory (applied in order, uses -p1)" + ) + ) + + +toolVersionParser :: Parser ToolVersion +toolVersionParser = verP' <|> toolP + where + verP' = ToolVersion <$> versionParser + toolP = + ToolTag + <$> option + (eitherReader tagEither) + (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag") + +-- | same as toolVersionParser, except as an argument. +toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion +toolVersionArgument criteria tool = + argument (eitherReader toolVersionEither) + (metavar "VERSION|TAG" + <> completer (tagCompleter (fromMaybe GHC tool) []) + <> foldMap (completer . versionCompleter criteria) tool) + + +setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion +setVersionArgument criteria tool = + argument (eitherReader setEither) + (metavar "VERSION|TAG|next" + <> completer (tagCompleter (fromMaybe GHC tool) ["next"]) + <> foldMap (completer . versionCompleter criteria) tool) + where + setEither s' = + parseSet s' + <|> second SetToolTag (tagEither s') + <|> second SetToolVersion (tVersionEither s') + parseSet s' = case fmap toLower s' of + "next" -> Right SetNext + other -> Left [i|Unknown tag/version #{other}|] + + +versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion +versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) + + +tagCompleter :: Tool -> [String] -> Completer +tagCompleter tool add = listIOCompleter $ do + let loggerConfig = LoggerConfig + { lcPrintDebug = False + , colorOutter = mempty + , rawOutter = mempty + } + + runLogger = myLoggerT loggerConfig + + dirs <- getDirs + let simpleSettings = Settings False False Never Curl False GHCupURL + simpleAppState = AppState simpleSettings dirs defaultKeyBindings + runEnv = runLogger . flip runReaderT simpleAppState + + mGhcUpInfo <- runEnv . runE $ readFromCache + + case mGhcUpInfo of + VRight dls -> do + let allTags = filter (\t -> t /= Old) + $ join + $ M.elems + $ availableToolVersions (_ghcupDownloads dls) tool + pure $ nub $ (add ++) $ fmap tagToString allTags + VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add) + + +versionCompleter :: Maybe ListCriteria -> Tool -> Completer +versionCompleter criteria tool = listIOCompleter $ do + let loggerConfig = LoggerConfig + { lcPrintDebug = False + , colorOutter = mempty + , rawOutter = mempty + } + + runLogger = myLoggerT loggerConfig + + mpFreq <- runLogger . runE $ platformRequest + + forFold mpFreq $ \pfreq -> do + dirs <- getDirs + let simpleSettings = Settings False False Never Curl False GHCupURL + simpleAppState = AppState simpleSettings dirs defaultKeyBindings + runEnv = runLogger . flip runReaderT simpleAppState + + mGhcUpInfo <- runEnv . runE $ readFromCache + + forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do + installedVersions <- runEnv $ listVersions dls (Just tool) criteria pfreq + return $ T.unpack . prettyVer . lVer <$> installedVersions + + +versionParser :: Parser GHCTargetVersion +versionParser = option + (eitherReader tVersionEither) + (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version" + ) + +versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version +versionParser' criteria tool = argument + (eitherReader (first show . version . T.pack)) + (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) + + +tagEither :: String -> Either String Tag +tagEither s' = case fmap toLower s' of + "recommended" -> Right Recommended + "latest" -> Right Latest + ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of + Right x -> Right (Base x) + Left _ -> Left [i|Invalid PVP version for base #{ver'}|] + other -> Left [i|Unknown tag #{other}|] + + +tVersionEither :: String -> Either String GHCTargetVersion +tVersionEither = + first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack + + +toolVersionEither :: String -> Either String ToolVersion +toolVersionEither s' = + second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s') + + +toolParser :: String -> Either String Tool +toolParser s' | t == T.pack "ghc" = Right GHC + | t == T.pack "cabal" = Right Cabal + | otherwise = Left ("Unknown tool: " <> s') + where t = T.toLower (T.pack s') + + +criteriaParser :: String -> Either String ListCriteria +criteriaParser s' | t == T.pack "installed" = Right ListInstalled + | t == T.pack "set" = Right ListSet + | otherwise = Left ("Unknown criteria: " <> s') + where t = T.toLower (T.pack s') + + +keepOnParser :: String -> Either String KeepDirs +keepOnParser s' | t == T.pack "always" = Right Always + | t == T.pack "errors" = Right Errors + | t == T.pack "never" = Right Never + | otherwise = Left ("Unknown keep value: " <> s') + where t = T.toLower (T.pack s') + + +downloaderParser :: String -> Either String Downloader +downloaderParser s' | t == T.pack "curl" = Right Curl + | t == T.pack "wget" = Right Wget +#if defined(INTERNAL_DOWNLOADER) + | t == T.pack "internal" = Right Internal +#endif + | otherwise = Left ("Unknown downloader value: " <> s') + where t = T.toLower (T.pack s') + + +platformParser :: String -> Either String PlatformRequest +platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of + Right r -> pure r + Left e -> Left $ errorBundlePretty e + where + archP :: MP.Parsec Void Text Architecture + archP = MP.try (MP.chunk "x86_64" $> A_64) <|> (MP.chunk "i386" $> A_32) + platformP :: MP.Parsec Void Text PlatformRequest + platformP = choice' + [ (\a mv -> PlatformRequest a FreeBSD mv) + <$> (archP <* MP.chunk "-") + <*> ( MP.chunk "portbld" + *> ( MP.try (Just <$> verP (MP.chunk "-freebsd" <* MP.eof)) + <|> pure Nothing + ) + <* MP.chunk "-freebsd" + ) + , (\a mv -> PlatformRequest a Darwin mv) + <$> (archP <* MP.chunk "-") + <*> ( MP.chunk "apple" + *> ( MP.try (Just <$> verP (MP.chunk "-darwin" <* MP.eof)) + <|> pure Nothing + ) + <* MP.chunk "-darwin" + ) + , (\a d mv -> PlatformRequest a (Linux d) mv) + <$> (archP <* MP.chunk "-") + <*> distroP + <*> ((MP.try (Just <$> verP (MP.chunk "-linux" <* MP.eof)) <|> pure Nothing + ) + <* MP.chunk "-linux" + ) + ] + distroP :: MP.Parsec Void Text LinuxDistro + distroP = choice' + [ 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 + ] + + +bindistParser :: String -> Either String URI +bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString + + +toSettings :: Options -> IO AppState +toSettings options = do + dirs <- getDirs + userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case + VRight r -> pure r + VLeft (V (JSONDecodeError e)) -> do + B.hPut stderr ("Error decoding config file: " <> (E.encodeUtf8 . T.pack . show $ e)) + pure defaultUserSettings + _ -> do + die "Unexpected error!" + pure $ mergeConf options dirs userConf + where + mergeConf :: Options -> Dirs -> UserSettings -> AppState + mergeConf Options{..} dirs UserSettings{..} = + let cache = fromMaybe (fromMaybe False uCache) optCache + noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify + verbose = fromMaybe (fromMaybe False uVerbose) optVerbose + keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs + downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader + keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings + urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource + in AppState (Settings {..}) dirs keyBindings +#if defined(INTERNAL_DOWNLOADER) + defaultDownloader = Internal +#else + defaultDownloader = Curl +#endif + mergeKeys :: UserKeyBindings -> KeyBindings + mergeKeys UserKeyBindings {..} = + let KeyBindings {..} = defaultKeyBindings + in KeyBindings { + bUp = fromMaybe bUp kUp + , bDown = fromMaybe bDown kDown + , bQuit = fromMaybe bQuit kQuit + , bInstall = fromMaybe bInstall kInstall + , bUninstall = fromMaybe bUninstall kUninstall + , bSet = fromMaybe bSet kSet + , bChangelog = fromMaybe bChangelog kChangelog + , bShowAll = fromMaybe bShowAll kShowAll + } + + +upgradeOptsP :: Parser UpgradeOpts +upgradeOptsP = + flag' + UpgradeInplace + (short 'i' <> long "inplace" <> help + "Upgrade ghcup in-place (wherever it's at)" + ) + <|> ( UpgradeAt + <$> option + (eitherReader + (\x -> + first show . parseAbs . E.encodeUtf8 . T.pack $ x :: Either + String + (Path Abs) + ) + ) + (short 't' <> long "target" <> metavar "TARGET_DIR" <> help + "Absolute filepath to write ghcup into" + ) + ) + <|> pure UpgradeGHCupDir + + + +describe_result :: String +describe_result = $( LitE . StringL <$> + runIO (do + CapturedProcess{..} <- executeOut [rel|git|] ["describe"] Nothing + case _exitCode of + ExitSuccess -> pure . T.unpack . decUTF8Safe $ _stdOut + ExitFailure _ -> pure numericVer + ) + ) + + +main :: IO () +main = do + let versionHelp = infoOption + ( ("The GHCup Haskell installer, version " <>) + (head . lines $ describe_result) + ) + (long "version" <> help "Show version" <> hidden) + let numericVersionHelp = infoOption + numericVer + ( long "numeric-version" + <> help "Show the numeric version (for use in scripts)" + <> hidden + ) + let listCommands = infoOption + "install set rm install-cabal list upgrade compile debug-info tool-requirements changelog" + ( long "list-commands" + <> help "List available commands for shell completion" + <> internal + ) + + let main_footer = [s|Discussion: + ghcup installs the Glasgow Haskell Compiler from the official + release channels, enabling you to easily switch between different + versions. It maintains a self-contained ~/.ghcup directory. + +ENV variables: + * TMPDIR: where ghcup does the work (unpacking, building, ...) + * GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME) + * GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories + +Report bugs at |] + + customExecParser + (prefs showHelpOnError) + (info (opts <**> helper <**> versionHelp <**> numericVersionHelp <**> listCommands) + (footerDoc (Just $ text main_footer)) + ) + >>= \opt@Options {..} -> do + appstate@AppState{dirs = Dirs{..}, ..} <- toSettings opt + + -- create ~/.ghcup dir + createDirRecursive' baseDir + + -- logger interpreter + logfile <- flip runReaderT appstate $ initGHCupFileLogging [rel|ghcup.log|] + let loggerConfig = LoggerConfig + { lcPrintDebug = verbose settings + , colorOutter = B.hPut stderr + , rawOutter = appendFile logfile + } + let runLogger = myLoggerT loggerConfig + + + ------------------------- + -- Effect interpreters -- + ------------------------- + + let runInstTool' appstate' = + runLogger + . flip runReaderT appstate' + . runResourceT + . runE + @'[ AlreadyInstalled + , UnknownArchive +#if !defined(TAR) + , ArchiveResult +#endif + , FileDoesNotExistError + , CopyError + , NoDownload + , NotInstalled + , BuildFailed + , TagNotFound + , DigestError + , DownloadFailed + , TarDirDoesNotExist + , NextVerNotFound + , NoToolVersionSet + ] + + let runInstTool = runInstTool' appstate + + let + runSetGHC = + runLogger + . flip runReaderT appstate + . runE + @'[ FileDoesNotExistError + , NotInstalled + , TagNotFound + , NextVerNotFound + , NoToolVersionSet + ] + + let + runSetCabal = + runLogger + . flip runReaderT appstate + . runE + @'[ NotInstalled + , TagNotFound + , NextVerNotFound + , NoToolVersionSet + ] + + let + runSetHLS = + runLogger + . flip runReaderT appstate + . runE + @'[ NotInstalled + , TagNotFound + , NextVerNotFound + , NoToolVersionSet + ] + + let runListGHC = runLogger . flip runReaderT appstate + + let runRm = + runLogger . flip runReaderT appstate . runE @'[NotInstalled] + + let runDebugInfo = + runLogger + . flip runReaderT appstate + . runE + @'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] + + let runCompileGHC = + runLogger + . flip runReaderT appstate + . runResourceT + . runE + @'[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , GHCupSetError + , NoDownload + , NotFoundInPATH + , PatchFailed + , UnknownArchive + , TarDirDoesNotExist + , NotInstalled +#if !defined(TAR) + , ArchiveResult +#endif + ] + + let runUpgrade = + runLogger + . flip runReaderT appstate + . runResourceT + . runE + @'[ DigestError + , NoDownload + , NoUpdate + , FileDoesNotExistError + , CopyError + , DownloadFailed + ] + + + ---------------------------------------- + -- Getting download and platform info -- + ---------------------------------------- + + pfreq <- ( + runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest + ) >>= \case + VRight r -> pure r + VLeft e -> do + runLogger + ($(logError) $ T.pack $ prettyShow e) + exitWith (ExitFailure 2) + + + (GHCupInfo treq dls) <- + ( runLogger + . flip runReaderT appstate + . runE @'[JSONError , DownloadFailed, FileDoesNotExistError] + $ liftE + $ getDownloadsF (urlSource settings) + ) + >>= \case + VRight r -> pure r + VLeft e -> do + runLogger + ($(logError) $ T.pack $ prettyShow e) + exitWith (ExitFailure 2) + + case optCommand of + Upgrade _ _ -> pure () + _ -> runLogger $ flip runReaderT appstate $ checkForUpdates dls pfreq + + + + ----------------------- + -- Command functions -- + ----------------------- + + let installGHC InstallOptions{..} = + (case instBindist of + Nothing -> runInstTool $ do + (v, vi) <- liftE $ fromVersion dls instVer GHC + liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) + when instSet $ void $ liftE $ setGHC v SetGHCOnly + pure vi + Just uri -> runInstTool' appstate{ settings = settings {noVerify = True}} $ do + (v, vi) <- liftE $ fromVersion dls instVer GHC + liftE $ installGHCBindist + (DownloadInfo uri (Just $ RegexDir "ghc-.*") "") + (_tvVersion v) + (fromMaybe pfreq instPlatform) + when instSet $ void $ liftE $ setGHC v SetGHCOnly + pure vi + ) + >>= \case + VRight vi -> do + runLogger $ $(logInfo) "GHC installation successful" + forM_ (_viPostInstall =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft (V (AlreadyInstalled _ v)) -> do + runLogger $ $(logWarn) + [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|] + pure ExitSuccess + VLeft err@(V (BuildFailed tmpdir _)) -> do + case keepDirs settings of + Never -> runLogger ($(logError) $ T.pack $ prettyShow err) + _ -> runLogger ($(logError) [i|#{prettyShow err} + Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues. + Make sure to clean up #{tmpdir} afterwards.|]) + pure $ ExitFailure 3 + VLeft e -> do + runLogger $ do + $(logError) $ T.pack $ prettyShow e + $(logError) [i|Also check the logs in #{logsDir}|] + pure $ ExitFailure 3 + + + let installCabal InstallOptions{..} = + (case instBindist of + Nothing -> runInstTool $ do + (v, vi) <- liftE $ fromVersion dls instVer Cabal + liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) + pure vi + Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} $ do + (v, vi) <- liftE $ fromVersion dls instVer Cabal + liftE $ installCabalBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + (fromMaybe pfreq instPlatform) + pure vi + ) + >>= \case + VRight vi -> do + runLogger $ $(logInfo) "Cabal installation successful" + forM_ (_viPostInstall =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft (V (AlreadyInstalled _ v)) -> do + runLogger $ $(logWarn) + [i|Cabal ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal #{prettyVer v}' first|] + pure ExitSuccess + VLeft e -> do + runLogger $ do + $(logError) $ T.pack $ prettyShow e + $(logError) [i|Also check the logs in #{logsDir}|] + pure $ ExitFailure 4 + + let installHLS InstallOptions{..} = + (case instBindist of + Nothing -> runInstTool $ do + (v, vi) <- liftE $ fromVersion dls instVer HLS + liftE $ installHLSBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) + pure vi + Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} $ do + (v, vi) <- liftE $ fromVersion dls instVer HLS + liftE $ installHLSBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + (fromMaybe pfreq instPlatform) + pure vi + ) + >>= \case + VRight vi -> do + runLogger $ $(logInfo) "HLS installation successful" + forM_ (_viPostInstall =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft (V (AlreadyInstalled _ v)) -> do + runLogger $ $(logWarn) + [i|HLS ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls #{prettyVer v}' first|] + pure ExitSuccess + VLeft e -> do + runLogger $ do + $(logError) $ T.pack $ prettyShow e + $(logError) [i|Also check the logs in #{logsDir}|] + pure $ ExitFailure 4 + + + let setGHC' SetOptions{..} = + runSetGHC (do + v <- liftE $ fst <$> fromVersion' dls sToolVer GHC + liftE $ setGHC v SetGHCOnly + ) + >>= \case + VRight GHCTargetVersion{..} -> do + runLogger + $ $(logInfo) + [i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|] + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 5 + + let setCabal' SetOptions{..} = + runSetCabal (do + v <- liftE $ fst <$> fromVersion' dls sToolVer Cabal + liftE $ setCabal (_tvVersion v) + pure v + ) + >>= \case + VRight GHCTargetVersion{..} -> do + runLogger + $ $(logInfo) + [i|Cabal #{prettyVer _tvVersion} successfully set as default version|] + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 14 + + let setHLS' SetOptions{..} = + runSetHLS (do + v <- liftE $ fst <$> fromVersion' dls sToolVer HLS + liftE $ setHLS (_tvVersion v) + pure v + ) + >>= \case + VRight GHCTargetVersion{..} -> do + runLogger + $ $(logInfo) + [i|HLS #{prettyVer _tvVersion} successfully set as default version|] + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 14 + + let rmGHC' RmOptions{..} = + runRm (do + liftE $ + rmGHCVer ghcVer + pure (getVersionInfo (_tvVersion ghcVer) GHC dls) + ) + >>= \case + VRight vi -> do + forM_ (_viPostRemove =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 7 + + let rmCabal' tv = + runRm (do + liftE $ + rmCabalVer tv + pure (getVersionInfo tv Cabal dls) + ) + >>= \case + VRight vi -> do + forM_ (_viPostRemove =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 15 + + let rmHLS' tv = + runRm (do + liftE $ + rmHLSVer tv + pure (getVersionInfo tv HLS dls) + ) + >>= \case + VRight vi -> do + forM_ (_viPostRemove =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 15 + + + res <- case optCommand of +#if defined(BRICK) + Interactive -> liftIO $ brickMain appstate loggerConfig dls pfreq >> pure ExitSuccess +#endif + Install (Right iopts) -> do + runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|]) + installGHC iopts + Install (Left (InstallGHC iopts)) -> installGHC iopts + Install (Left (InstallCabal iopts)) -> installCabal iopts + Install (Left (InstallHLS iopts)) -> installHLS iopts + InstallCabalLegacy iopts -> do + runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|]) + installCabal iopts + + Set (Right sopts) -> do + runLogger ($(logWarn) [i|This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.|]) + setGHC' sopts + Set (Left (SetGHC sopts)) -> setGHC' sopts + Set (Left (SetCabal sopts)) -> setCabal' sopts + Set (Left (SetHLS sopts)) -> setHLS' sopts + + List ListOptions {..} -> + runListGHC (do + l <- listVersions dls loTool lCriteria pfreq + liftIO $ printListResult lRawFormat l + pure ExitSuccess + ) + + Rm (Right rmopts) -> do + runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|]) + rmGHC' rmopts + Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts + Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts + Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts + + DInfo -> + do runDebugInfo $ liftE getDebugInfo + >>= \case + VRight dinfo -> do + putStrLn $ prettyDebugInfo dinfo + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 8 + + Compile (CompileGHC GHCCompileOptions {..}) -> + runCompileGHC (do + let vi = getVersionInfo targetVer GHC dls + forM_ (_viPreCompile =<< vi) $ \msg -> do + lift $ $(logInfo) msg + lift $ $(logInfo) + "...waiting for 5 seconds, you can still abort..." + liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene + liftE $ compileGHC dls + (GHCTargetVersion crossTarget targetVer) + bootstrapGhc + jobs + buildConfig + patchDir + addConfArgs + pfreq + when setCompile $ void $ liftE $ + setGHC (GHCTargetVersion crossTarget targetVer) SetGHCOnly + pure vi + ) + >>= \case + VRight vi -> do + runLogger $ $(logInfo) + "GHC successfully compiled and installed" + forM_ (_viPostInstall =<< vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft (V (AlreadyInstalled _ v)) -> do + runLogger $ $(logWarn) + [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|] + pure ExitSuccess + VLeft err@(V (BuildFailed tmpdir _)) -> do + case keepDirs settings of + Never -> runLogger $ $(logError) $ T.pack $ prettyShow err + _ -> runLogger ($(logError) [i|#{prettyShow err} +Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues. +Make sure to clean up #{tmpdir} afterwards.|]) + pure $ ExitFailure 9 + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 9 + + Upgrade uOpts force -> do + target <- case uOpts of + UpgradeInplace -> do + efp <- liftIO getExecutablePath + p <- parseAbs . E.encodeUtf8 . T.pack $ efp + pure $ Just p + (UpgradeAt p) -> pure $ Just p + UpgradeGHCupDir -> pure (Just (binDir [rel|ghcup|])) + + runUpgrade (liftE $ upgradeGHCup dls target force pfreq) >>= \case + VRight v' -> do + let pretty_v = prettyVer v' + let vi = fromJust $ snd <$> getLatest dls GHCup + runLogger $ $(logInfo) + [i|Successfully upgraded GHCup to version #{pretty_v}|] + forM_ (_viPostInstall vi) $ \msg -> + runLogger $ $(logInfo) msg + pure ExitSuccess + VLeft (V NoUpdate) -> do + runLogger $ $(logWarn) [i|No GHCup update available|] + pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 11 + + ToolRequirements -> + runLogger + (runE + @'[NoCompatiblePlatform , DistroNotFound , NoToolRequirements] + $ do + platform <- liftE getPlatform + req <- getCommonRequirements platform treq ?? NoToolRequirements + liftIO $ T.hPutStr stdout (prettyRequirements req) + ) + >>= \case + VRight _ -> pure ExitSuccess + VLeft e -> do + runLogger $ $(logError) $ T.pack $ prettyShow e + pure $ ExitFailure 12 + + ChangeLog ChangeLogOptions{..} -> do + let tool = fromMaybe GHC clTool + ver' = maybe + (Right Latest) + (\case + ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion + ToolTag t -> Right t + ) + clToolVer + muri = getChangeLog dls tool ver' + case muri of + Nothing -> do + runLogger + ($(logWarn) + [i|Could not find ChangeLog for #{tool}, version #{either (T.unpack . prettyVer) show ver'}|] + ) + pure ExitSuccess + Just uri -> do + let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri + cmd = case _rPlatform pfreq of + Darwin -> "open" + Linux _ -> "xdg-open" + FreeBSD -> "xdg-open" + + if clOpen + then + exec cmd + True + [serializeURIRef' uri] + Nothing + Nothing + >>= \case + Right _ -> pure ExitSuccess + Left e -> runLogger ($(logError) [i|#{e}|]) + >> pure (ExitFailure 13) + else putStrLn uri' >> pure ExitSuccess + + case res of + ExitSuccess -> pure () + ef@(ExitFailure _) -> exitWith ef + pure () + +fromVersion :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m) + => GHCupDownloads + -> Maybe ToolVersion + -> Tool + -> Excepts '[TagNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo) +fromVersion av tv = fromVersion' av (toSetToolVer tv) + +fromVersion' :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m) + => GHCupDownloads + -> SetToolVersion + -> Tool + -> Excepts '[TagNotFound, NextVerNotFound, NoToolVersionSet] m (GHCTargetVersion, Maybe VersionInfo) +fromVersion' av SetRecommended tool = + (\(x, y) -> (mkTVer x, Just y)) <$> getRecommended av tool + ?? TagNotFound Recommended tool +fromVersion' av (SetToolVersion v) tool = do + let vi = getVersionInfo (_tvVersion v) tool av + case pvp $ prettyVer (_tvVersion v) of + Left _ -> pure (v, vi) + Right (PVP (major' :|[minor'])) -> + case getLatestGHCFor (fromIntegral major') (fromIntegral minor') av of + Just (v', vi') -> pure (GHCTargetVersion (_tvTarget v) v', Just vi') + Nothing -> pure (v, vi) + Right _ -> pure (v, vi) +fromVersion' av (SetToolTag Latest) tool = + (\(x, y) -> (mkTVer x, Just y)) <$> getLatest av tool ?? TagNotFound Latest tool +fromVersion' av (SetToolTag Recommended) tool = + (\(x, y) -> (mkTVer x, Just y)) <$> getRecommended av tool ?? TagNotFound Recommended tool +fromVersion' av (SetToolTag (Base pvp'')) GHC = + (\(x, y) -> (mkTVer x, Just y)) <$> getLatestBaseVersion av pvp'' ?? TagNotFound (Base pvp'') GHC +fromVersion' av SetNext tool = do + next <- case tool of + GHC -> do + set <- fmap _tvVersion $ ghcSet Nothing !? NoToolVersionSet tool + ghcs <- rights <$> lift getInstalledGHCs + (headMay + . tail + . dropWhile (\GHCTargetVersion {..} -> _tvVersion /= set) + . cycle + . sortBy (\x y -> compare (_tvVersion x) (_tvVersion y)) + . filter (\GHCTargetVersion {..} -> _tvTarget == Nothing) + $ ghcs) ?? NoToolVersionSet tool + Cabal -> do + set <- cabalSet !? NoToolVersionSet tool + cabals <- rights <$> lift getInstalledCabals + (fmap (GHCTargetVersion Nothing) + . headMay + . tail + . dropWhile (/= set) + . cycle + . sort + $ cabals) ?? NoToolVersionSet tool + HLS -> do + set <- hlsSet !? NoToolVersionSet tool + hlses <- rights <$> lift getInstalledHLSs + (fmap (GHCTargetVersion Nothing) + . headMay + . tail + . dropWhile (/= set) + . cycle + . sort + $ hlses) ?? NoToolVersionSet tool + GHCup -> fail "GHCup cannot be set" + let vi = getVersionInfo (_tvVersion next) tool av + pure (next, vi) +fromVersion' _ (SetToolTag t') tool = + throwE $ TagNotFound t' tool + + +printListResult :: Bool -> [ListResult] -> IO () +printListResult raw lr = do + -- https://gitlab.haskell.org/ghc/ghc/issues/8118 + setLocaleEncoding utf8 + + no_color <- isJust <$> lookupEnv "NO_COLOR" + + let + color | raw || no_color = flip const + | otherwise = Pretty.color + + let + printTag Recommended = color Green "recommended" + printTag Latest = color Yellow "latest" + printTag Prerelease = color Red "prerelease" + printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') + printTag (UnknownTag t ) = t + printTag Old = "" + + let + rows = + (\x -> if raw + then x + else [color Green "", "Tool", "Version", "Tags", "Notes"] : x + ) + . fmap + (\ListResult {..} -> + let marks = if + | lSet -> (color Green "✔✔") + | lInstalled -> (color Green "✓ ") + | otherwise -> (color Red "✗ ") + in + (if raw then [] else [marks]) + ++ [ fmap toLower . show $ lTool + , case lCross of + Nothing -> T.unpack . prettyVer $ lVer + Just c -> T.unpack (c <> "-" <> prettyVer lVer) + , intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag) + , intercalate "," + $ (if hlsPowered + then [color Green "hls-powered"] + else mempty + ) + ++ (if fromSrc then [color Blue "compiled"] else mempty) + ++ (if lStray then [color Yellow "stray"] else mempty) + ++ (if lNoBindist + then [color Red "no-bindist"] + else mempty + ) + ] + ) + $ lr + let cols = + foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows + lengths = fmap maximum . (fmap . fmap) strWidth $ cols + padded = fmap (\xs -> zipWith padTo xs lengths) rows + + forM_ padded $ \row -> putStrLn $ intercalate " " row + where + + padTo str' x = + let lstr = strWidth str' + add' = x - lstr + in if add' < 0 then str' else str' ++ replicate add' ' ' + + -- | Calculate the render width of a string, considering + -- wide characters (counted as double width), ANSI escape codes + -- (not counted), and line breaks (in a multi-line string, the longest + -- line determines the width). + strWidth :: String -> Int + strWidth = + maximum + . (0 :) + . map (foldr (\a b -> charWidth a + b) 0) + . lines + . stripAnsi + + -- | Strip ANSI escape sequences from a string. + -- + -- >>> stripAnsi "\ESC[31m-1\ESC[m" + -- "-1" + stripAnsi :: String -> String + stripAnsi s' = + case + MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s' + of + Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen + Just xs -> concat xs + where + -- This parses lots of invalid ANSI escape codes, but that should be fine + ansi = + MPC.string "\ESC[" *> digitSemicolons *> suffix MP. "ansi" :: MP.Parsec + Void + String + Char + digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';') + suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u'] + + -- | Get the designated render width of a character: 0 for a combining + -- character, 1 for a regular character, 2 for a wide character. + -- (Wide characters are rendered as exactly double width in apps and + -- fonts that support it.) (From Pandoc.) + charWidth :: Char -> Int + charWidth c = case c of + _ | c < '\x0300' -> 1 + | c >= '\x0300' && c <= '\x036F' -> 0 + | -- combining + c >= '\x0370' && c <= '\x10FC' -> 1 + | c >= '\x1100' && c <= '\x115F' -> 2 + | c >= '\x1160' && c <= '\x11A2' -> 1 + | c >= '\x11A3' && c <= '\x11A7' -> 2 + | c >= '\x11A8' && c <= '\x11F9' -> 1 + | c >= '\x11FA' && c <= '\x11FF' -> 2 + | c >= '\x1200' && c <= '\x2328' -> 1 + | c >= '\x2329' && c <= '\x232A' -> 2 + | c >= '\x232B' && c <= '\x2E31' -> 1 + | c >= '\x2E80' && c <= '\x303E' -> 2 + | c == '\x303F' -> 1 + | c >= '\x3041' && c <= '\x3247' -> 2 + | c >= '\x3248' && c <= '\x324F' -> 1 + | -- ambiguous + c >= '\x3250' && c <= '\x4DBF' -> 2 + | c >= '\x4DC0' && c <= '\x4DFF' -> 1 + | c >= '\x4E00' && c <= '\xA4C6' -> 2 + | c >= '\xA4D0' && c <= '\xA95F' -> 1 + | c >= '\xA960' && c <= '\xA97C' -> 2 + | c >= '\xA980' && c <= '\xABF9' -> 1 + | c >= '\xAC00' && c <= '\xD7FB' -> 2 + | c >= '\xD800' && c <= '\xDFFF' -> 1 + | c >= '\xE000' && c <= '\xF8FF' -> 1 + | -- ambiguous + c >= '\xF900' && c <= '\xFAFF' -> 2 + | c >= '\xFB00' && c <= '\xFDFD' -> 1 + | c >= '\xFE00' && c <= '\xFE0F' -> 1 + | -- ambiguous + c >= '\xFE10' && c <= '\xFE19' -> 2 + | c >= '\xFE20' && c <= '\xFE26' -> 1 + | c >= '\xFE30' && c <= '\xFE6B' -> 2 + | c >= '\xFE70' && c <= '\xFEFF' -> 1 + | c >= '\xFF01' && c <= '\xFF60' -> 2 + | c >= '\xFF61' && c <= '\x16A38' -> 1 + | c >= '\x1B000' && c <= '\x1B001' -> 2 + | c >= '\x1D000' && c <= '\x1F1FF' -> 1 + | c >= '\x1F200' && c <= '\x1F251' -> 2 + | c >= '\x1F300' && c <= '\x1F773' -> 1 + | c >= '\x20000' && c <= '\x3FFFD' -> 2 + | otherwise -> 1 + + +checkForUpdates :: ( MonadReader AppState m + , MonadCatch m + , MonadLogger m + , MonadThrow m + , MonadIO m + , MonadFail m + , MonadLogger m + ) + => GHCupDownloads + -> PlatformRequest + -> m () +checkForUpdates dls pfreq = do + lInstalled <- listVersions dls Nothing (Just ListInstalled) pfreq + let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled + + forM_ (getLatest dls GHCup) $ \(l, _) -> do + (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer + when (l > ghc_ver) + $ $(logWarn) + [i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|] + + forM_ (getLatest dls GHC) $ \(l, _) -> do + let mghc_ver = latestInstalled GHC + forM mghc_ver $ \ghc_ver -> + when (l > ghc_ver) + $ $(logWarn) + [i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|] + + forM_ (getLatest dls Cabal) $ \(l, _) -> do + let mcabal_ver = latestInstalled Cabal + forM mcabal_ver $ \cabal_ver -> + when (l > cabal_ver) + $ $(logWarn) + [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|] + + forM_ (getLatest dls HLS) $ \(l, _) -> do + let mhls_ver = latestInstalled HLS + forM mhls_ver $ \hls_ver -> + when (l > hls_ver) + $ $(logWarn) + [i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|] + + +prettyDebugInfo :: DebugInfo -> String +prettyDebugInfo DebugInfo {..} = [i|Debug Info +========== +GHCup base dir: #{toFilePath diBaseDir} +GHCup bin dir: #{toFilePath diBinDir} +GHCup GHC directory: #{toFilePath diGHCDir} +GHCup cache directory: #{toFilePath diCacheDir} +Architecture: #{prettyShow diArch} +Platform: #{prettyShow diPlatform} +Version: #{describe_result}|] + diff --git a/config.yaml b/config.yaml new file mode 100644 --- /dev/null +++ b/config.yaml @@ -0,0 +1,61 @@ +# 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 + +# 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' + +# 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" diff --git a/ghcup-0.0.4.yaml b/ghcup-0.0.4.yaml new file mode 100644 --- /dev/null +++ b/ghcup-0.0.4.yaml @@ -0,0 +1,1833 @@ +--- +toolRequirements: + GHC: + unknown_version: + Linux_Debian: + unknown_versioning: + distroPKGs: + - build-essential + - curl + - libffi-dev + - libffi6 + - libgmp-dev + - libgmp10 + - libncurses-dev + - libncurses5 + - libtinfo5 + notes: '' + Linux_Ubuntu: + unknown_versioning: + distroPKGs: + - build-essential + - curl + - libffi-dev + - libffi6 + - libgmp-dev + - libgmp10 + - libncurses-dev + - libncurses5 + - libtinfo5 + notes: '' + "( >= 20.04 && < 20.10 )": + distroPKGs: + - build-essential + - curl + - libffi-dev + - libffi7 + - libgmp-dev + - libgmp10 + - libncurses-dev + - libncurses5 + - libtinfo5 + notes: '' + "( >= 20.10 )": + distroPKGs: + - build-essential + - curl + - libffi-dev + - libffi8ubuntu1 + - libgmp-dev + - libgmp10 + - libncurses-dev + - libncurses5 + - libtinfo5 + notes: '' + Linux_CentOS: + '( >= 7 && < 8 )': + distroPKGs: + - gcc + - gcc-c++ + - gmp + - gmp-devel + - make + - ncurses + - xz + - perl + notes: '' + unknown_versioning: + distroPKGs: + - gcc + - gcc-c++ + - gmp + - gmp-devel + - make + - ncurses + - ncurses-compat-libs + - xz + - perl + notes: '' + Linux_Fedora: + unknown_versioning: + distroPKGs: + - gcc + - gcc-c++ + - gmp + - gmp-devel + - make + - ncurses + - ncurses-compat-libs + - xz + - perl + notes: '' + Linux_Alpine: + unknown_versioning: + distroPKGs: + - curl + - gcc + - g++ + - gmp-dev + - ncurses-dev + - libffi-dev + - make + - xz + - tar + - perl + notes: '' + Linux_UnknownLinux: + unknown_versioning: + distroPKGs: [] + notes: 'You need the following packages: curl g++ gcc gmp make ncurses realpath + xz-utils. Consult your distro documentation on the exact names of those + packages.' + Darwin: + unknown_versioning: + distroPKGs: [] + notes: On OS X, in the course of running ghcup you will be given a dialog + box to install the command line tools. Accept and the requirements will + be installed for you. You will then need to run the command again. + FreeBSD: + unknown_versioning: + distroPKGs: + - curl + - gcc + - gmp + - gmake + - ncurses + - perl5 + - libffi + - libiconv + notes: '' +ghcupDownloads: + GHC: + 7.10.3: + viTags: + - base-4.8.2.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz + dlSubdir: ghc-7.10.3 + dlHash: cf90cedce1c28fd0e2b9e72fe8a938756668d18ea1fcc884a19f698658ac4fef + viPostRemove: &ghc-post-remove "After removing GHC you might also want to clean up your cabal store at: ~/.cabal/store/ghc-" + viArch: + A_64: + Linux_Debian: + unknown_versioning: &ghc-7103-64-deb8 + 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 + Linux_Ubuntu: + unknown_versioning: *ghc-7103-64-deb8 + Linux_Mint: + unknown_versioning: *ghc-7103-64-deb8 + Linux_CentOS: + unknown_versioning: &ghc-7103-64-centos + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-centos67-linux.tar.bz2 + dlSubdir: ghc-7.10.3 + dlHash: a8957f7a2fd81720c5d3dc403571d77d31115ff5f42edb2917c36d8e714220d4 + Linux_AmazonLinux: + unknown_versioning: *ghc-7103-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-7103-64-deb8 + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-apple-darwin.tar.bz2 + dlSubdir: ghc-7.10.3 + dlHash: 80893e367e8318105f7db2064adf202e3d96b1f014e792b73e92f2cacf0b757a + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-portbld-freebsd.tar.bz2 + dlSubdir: ghc-7.10.3 + dlHash: 2aa396edd2bb651f4bc7eef7a396913ea24923de5aafdc76df6295333e487e48 + A_32: + Linux_Debian: + unknown_versioning: &ghc-7103-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-i386-deb8-linux.tar.bz2 + dlSubdir: ghc-7.10.3 + dlHash: d2ccf072457fb100503f6f5430a1e3589ca525a97424263d036b0550bc277f0c + Linux_Ubuntu: + unknown_versioning: *ghc-7103-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-7103-32-deb8 + Linux_CentOS: + unknown_versioning: &ghc-7103-32-centos + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-i386-centos67-linux.tar.bz2 + dlSubdir: ghc-7.10.3 + dlHash: c50aa20275e8d1ba9148f380eb7598bc148143281fc17c9acd38ea7b325852bd + Linux_AmazonLinux: + unknown_versioning: *ghc-7103-32-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-7103-32-deb8 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-i386-portbld-freebsd.tar.bz2 + dlSubdir: ghc-7.10.3 + dlHash: 3dde05577c6f94dcb0ba201ebd53ab88553bbc9a3aa8e72237162ed7a9d588a3 + 8.0.2: + viTags: + - base-4.9.1.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: 11625453e1d0686b3fa6739988f70ecac836cadc30b9f0c8b49ef9091d6118b1 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 7 && < 8 )': + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-deb7-linux.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: b2f5c304b57ac5840a0d2ef763a3c6fa858c70840f749cfad12ed227da973c0a + unknown_versioning: &ghc-802-64-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: 5ee68290db00ca0b79d57bc3a5bdce470de9ce9da0b098a7ce6c504605856c8f + Linux_Ubuntu: + unknown_versioning: *ghc-802-64-deb8 + Linux_Mint: + unknown_versioning: *ghc-802-64-deb8 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.0.2/ghc-8.0.2-x86_64-alpine-linux.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: 517783b660a27ebf95b2568d47292fd633d5f9a4de4c80ad1ccf05e1b9d7313f + Linux_UnknownLinux: + unknown_versioning: *ghc-802-64-deb8 + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: ff50a2df9f002f33b9f09717ebf5ec5a47906b9b65cc57b1f9849f8b2e06788d + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: b36a20e5cae24d70bbb6116ae486f21811e9384f15d3892d260f02fba3e3bb8c + A_32: + Linux_Debian: + '( >= 7 && < 8 )': + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-i386-deb7-linux.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: 07ead3a49f8c9df4b429e7a2f96f6f31bcab8d3ff8277a9aed0201d13ddad448 + unknown_versioning: &ghc-802-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: 818621342a2161b8afcc995a0765816bb40aefbfa1db2c8a7d59c04d8b18228a + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.0.2/ghc-8.0.2-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.0.2 + dlHash: b4cd12a1048b2fff2f23c9eec0dd3a1174d54d017f8d79ec79af4534118e6881 + Linux_UnknownLinux: + unknown_versioning: *ghc-802-32-deb8 + 8.2.2: + viTags: + - base-4.10.1.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: bb8ec3634aa132d09faa270bbd604b82dfa61f04855655af6f9d14a9eedc05fc + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 7 && < 8 )': &ghc-822-64-deb7 + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-deb7-linux.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: cd7afbca54edf9890da9f432c63366556246c85c1198e40c99df5af01c555834 + unknown_versioning: &ghc-822-64-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: 48e205c62b9dc1ccf6739a4bc15a71e56dde2f891a9d786a1b115f0286111b2a + Linux_Ubuntu: + unknown_versioning: *ghc-822-64-deb8 + Linux_Mint: + unknown_versioning: *ghc-822-64-deb8 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.2.2/ghc-8.2.2-x86_64-alpine-linux.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: adcf3a320a3c402aba07ae9586990dc3c0b550e96aeffb1b9e194313d3ba716d + Linux_UnknownLinux: + unknown_versioning: *ghc-822-64-deb7 + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: f90fcf62f7e0936a6dfc3601cf663729bfe9bbf85097d2d75f0a16f8c2e95c27 + FreeBSD: + '( >= 10 && < 11 )': + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-portbld10_3-freebsd.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: 9e99aaeaec4b2c6d660d80246c0d4dbd41fda88f1eb7a908b29dc8fa8d663949 + '( >= 11 && < 12 )': &ghc-822-64-fbsd11 + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-portbld11-freebsd.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: cd351c704b92b9af23994024df07de8ca7090ea7675d5c8b14b2be857a46d804 + unknown_versioning: *ghc-822-64-fbsd11 + A_32: + Linux_Debian: + '( >= 7 && < 8 )': + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-i386-deb7-linux.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: cd18766b1a9b74fc6c90003a719ecab158f281f9a755d8b1bd3fd764ba6947b5 + unknown_versioning: &ghc-822-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: 9e67d72d76482e0ba91c718e727b00386a1a12a32ed719714976dc56ca8c8223 + Linux_Ubuntu: + unknown_versioning: *ghc-822-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-822-32-deb8 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.2.2/ghc-8.2.2-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.2.2 + dlHash: 467534c32552cfd318753112dbc70af003693aad4b0081f2a07e61f5b5ea2c22 + Linux_UnknownLinux: + unknown_versioning: *ghc-822-32-deb8 + 8.4.1: + viTags: + - base-4.11.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz + dlSubdir: ghc-8.4.1 + dlHash: 39ae2f25192408f355693e5a3c8b6ff613ddb7c4da998fdf26210143a61839d2 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.4.1 + dlHash: 427c77a934b30c3f1de992c38c072afb4323fe6fb30dbac919ca8cb6ae98fbd9 + Linux_Ubuntu: + unknown_versioning: &ghc-841-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.4.1 + dlHash: 89328a013e64b9b56825a9071fea5616ddd623d37fd41e8fb913dfebc609e7ea + Linux_Mint: + unknown_versioning: *ghc-841-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-841-64-fedora + Linux_UnknownLinux: + unknown_versioning: *ghc-841-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.4.1 + dlHash: d774e39f3a0105843efd06709b214ee332c30203e6c5902dd6ed45e36285f9b7 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-portbld11-freebsd.tar.xz + dlSubdir: ghc-8.4.1 + dlHash: e748daec098445c6190090fe32bb2817a1140553be5acd2188e1af05ad24e5aa + A_32: + Linux_Debian: + unknown_versioning: &ghc-841-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.4.1 + dlHash: c56c589c76c7ddcb77cdbef885a811761e669d3e76868b723d5be56dedcd4f69 + Linux_Ubuntu: + unknown_versioning: *ghc-841-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-841-32-deb8 + Linux_UnknownLinux: + unknown_versioning: *ghc-841-32-deb8 + 8.4.2: + viTags: + - base-4.11.1.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: 01cc32f24a06bf3b2428351b6d7fec791e82d042426d29ad9e5a245b35f0047b + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: 246f66eb56f4ad0f1c7755502cfc8f9972f2d067dede17e151f6f479c1f76fbd + unknown_versioning: &ghc-842-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: 3f4f5bbd2cdab4e7015ada9196d8d9b3a1ad274293cef011f85c46854596cb57 + Linux_Ubuntu: + unknown_versioning: &ghc-842-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: d057b5c833596dbe4ae5d0dc2994f6cc5d0f4c2a21ea1d7900821d165fd4e846 + '( >= 16 && < 19 )': *ghc-842-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-842-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-842-64-fedora + Linux_UnknownLinux: + unknown_versioning: *ghc-842-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: 87469222042b9ac23f9db216a8d4e5107297bdbbb99df71eb4d9e7208455def2 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: e9ed417fdf94c2ff2c6e344ed16f332bf6b591511f6442c0d9ea94854882b66c + A_32: + Linux_Debian: + unknown_versioning: &ghc-842-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.4.2 + dlHash: 2d849c30b4c1eac25dc74333501920921e22fa483153f404993808bbda93df05 + Linux_Ubuntu: + unknown_versioning: *ghc-842-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-842-32-deb8 + Linux_UnknownLinux: + unknown_versioning: *ghc-842-32-deb8 + 8.4.3: + viTags: + - base-4.11.1.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz + dlSubdir: ghc-8.4.3 + dlHash: ae47afda985830de8811243255aa3744dfb9207cb980af74393298b2b62160d6 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.4.3 + dlHash: 30a402c6d4754a6c020e0547f19ae3ac42e907e35349aa932d347f73e421a8e2 + unknown_versioning: &ghc-843-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.4.3 + dlHash: 2e4f53afb872ad9c640f31aea283b3ff4c5028b65808a1920739900aef7d15c9 + Linux_Ubuntu: + unknown_versioning: &ghc-843-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.4.3 + dlHash: 269e7a4d3f336491b88409a020998122b30a3a729af78d33be86d3b3f8000c3e + '( >= 16 && < 19 )': *ghc-843-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-843-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-843-64-fedora + Linux_UnknownLinux: + unknown_versioning: *ghc-843-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.4.3 + dlHash: af0b455f6c46b9802b4b48dad996619cfa27cc6e2bf2ce5532387b4a8c00aa64 + A_32: + Linux_Debian: + unknown_versioning: &ghc-843-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.4.3 + dlHash: f5763983a26dedd88b65a0b17267359a3981b83a642569b26334423f684f8b8c + Linux_Ubuntu: + unknown_versioning: *ghc-843-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-843-32-deb8 + Linux_UnknownLinux: + unknown_versioning: *ghc-843-32-deb8 + 8.4.4: + viTags: + - base-4.11.1.0 + viChangeLog: https://downloads.haskell.org/~ghc/8.4.4/docs/html/users_guide/8.4.4-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-src.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 11117735a58e507c481c09f3f39ae5a314e9fbf49fc3109528f99ea7959004b2 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 4c2a8857f76b7f3e34ecba0b51015d5cb8b767fe5377a7ec477abde10705ab1a + unknown_versioning: &ghc-844-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 47c80a32d8f02838a2401414c94ba260d1fe82b7d090479994522242c767cc83 + Linux_Ubuntu: + unknown_versioning: &ghc-844-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 8ab2befddc14d1434d0aad0c5d3c7e0c2b78ff84caa3429fa62527bfc6b86095 + '( >= 16 && < 19 )': *ghc-844-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-844-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-844-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-844-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-centos70-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 83a96650f5a92b1e4d7651d256d6438624342d40e780e68125033435a54cd674 + Linux_RedHat: + unknown_versioning: *ghc-844-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.4.4/ghc-8.4.4-x86_64-alpine-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 336affff8314d3dc5e85d9c09015ae2ba8a7658b459c8c8ae77ecaa551a56ae7 + Linux_AmazonLinux: + unknown_versioning: *ghc-844-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-844-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 28dc89ebd231335337c656f4c5ead2ae2a1acc166aafe74a14f084393c5ef03a + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-portbld-freebsd11.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 44fbd142d1c355d6110595c59c760e2c73866ff9259ec85ebf814edb244d1940 + A_32: + Linux_Debian: + unknown_versioning: &ghc-844-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 678bafaabea6af70ba71ccf0210bb437f9f5591ec28ac1cbbbd5f7aa6894e450 + Linux_Ubuntu: + unknown_versioning: *ghc-844-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-844-32-deb8 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.4.4/ghc-8.4.4-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.4.4 + dlHash: 892888d388ef5c9cadf5cfba1146d62237c25b9b066fb62fee940b2b285fd308 + Linux_UnknownLinux: + unknown_versioning: *ghc-844-32-deb8 + 8.6.1: + viTags: + - base-4.12.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: 2c25c26d1e5c47c7cbb2a1d8e6456524033e7a71409184dd3125e3fc5a3c7036 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: 6d8784401b7dd80c90fa17306ec0539920e3987399a2c7ef247989e53197dc42 + unknown_versioning: &ghc-861-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: 97d44f303868d74e4d13a2e99c82ffce3d25fd54c704675e5a1939e0d824dbf0 + Linux_Ubuntu: + unknown_versioning: &ghc-861-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: da903fbcf11ee6c977a8b7dac3f04dbc098d674def587880b6624b8f32588beb + '( >= 16 && < 19 )': *ghc-861-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-861-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-861-64-fedora + Linux_UnknownLinux: + unknown_versioning: *ghc-861-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: 9692cdfd202b0e039ea0c3dde5dbf653736c836ca1df46504b179b572100808c + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: 51403b054a3a649039ac988e1d1112561f96750bfced63df864091a3fab36f08 + A_32: + Linux_Debian: + unknown_versioning: &ghc-861-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.6.1 + dlHash: 83573af96e3dec8f67c1a844512f92cbf7d51ae7ceca53d948fc2a3300abd05c + Linux_Ubuntu: + unknown_versioning: *ghc-861-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-861-32-deb8 + Linux_UnknownLinux: + unknown_versioning: *ghc-861-32-deb8 + 8.6.2: + viTags: + - base-4.12.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz + dlSubdir: ghc-8.6.2 + dlHash: caaa819d21280ecde90a4773143dee188711e9ff175a27cfbaee56eb851d76d5 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + unknown_versioning: &ghc-862-64-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.6.2 + dlHash: 13f96e8b83bb5bb60f955786ff9085744c24927a33be8a17773f84c7c248533a + Linux_Ubuntu: + unknown_versioning: &ghc-862-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.6.2 + dlHash: 702aa5dfa1639c37953ceb7571a5057d9fb0562aecb197b277953a037d78047d + '( >= 16 && < 19 )': *ghc-862-64-deb8 + Linux_Mint: + unknown_versioning: *ghc-862-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-862-64-fedora + Linux_UnknownLinux: + unknown_versioning: *ghc-862-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.6.2 + dlHash: 8ec46a25872226dd7e5cf7271e3f3450c05f32144b96e6b9cb44cc4079db50dc + A_32: + Linux_Debian: + unknown_versioning: &ghc-862-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.6.2 + dlHash: a288026d9ef22f7ac387edab6b29ef7dcb3b28945c8ea532a15c1fa35d4733ed + Linux_Ubuntu: + unknown_versioning: *ghc-862-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-862-32-deb8 + Linux_UnknownLinux: + unknown_versioning: *ghc-862-32-deb8 + 8.6.3: + viTags: + - base-4.12.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: 9f9e37b7971935d88ba80426c36af14b1e0b3ec1d9c860f44a4391771bc07f23 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: 291ca565374f4d51cc311488581f3279d3167a064fabfd4a6722fe2bd4532fd5 + unknown_versioning: &ghc-863-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: e7954c8ed9b422a09c6ab737e4a0865a2725d034ba0e272bd5c70db910797f99 + Linux_Ubuntu: + unknown_versioning: &ghc-863-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: 52ae92f4e8bb2ac0b7847287ea3da37081f5f7bf8bbb7c78ac35fde537d1a89f + '( >= 16 && < 19 )': *ghc-863-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-863-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-863-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-863-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: 355bd85c69933c31bbe99b4269ce719acfd0aad0b45e359ac39b9bb13996acc6 + Linux_RedHat: + unknown_versioning: *ghc-863-64-centos + Linux_AmazonLinux: + unknown_versioning: *ghc-863-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-863-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: 79d069a1a7d74cfdd7ac2a2711c45d3ddc6265b988a0cefa342714b24f997fc1 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: bc2419fa180f8a7808c49775987866435995df9bdd9ce08bcd38352d63ba6031 + A_32: + Linux_Debian: + unknown_versioning: &ghc-863-32-deb8 + dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-i386-deb8-linux.tar.xz + dlSubdir: ghc-8.6.3 + dlHash: b57070ba8c70b1333a3e47ce124baf791be39c20a592954772532fd6dd51882f + Linux_Ubuntu: + unknown_versioning: *ghc-863-32-deb8 + Linux_Mint: + unknown_versioning: *ghc-863-32-deb8 + Linux_UnknownLinux: + unknown_versioning: *ghc-863-32-deb8 + 8.6.4: + viTags: + - base-4.12.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz + dlSubdir: ghc-8.6.4 + dlHash: 5b5d07e4463203a433c3ed3df461ba6cce11b6d2b9b264db31f3429075d0303a + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.6.4 + dlHash: 34ef5fc8ddf2fc32a027180bea5b1c8a81ea840c87faace2977a572188d4b42d + unknown_versioning: &ghc-864-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.6.4 + dlHash: ef74222ef3c01c3fc5b926f67e8b4ef612fe8efa40ac937317cff9b0eed8d863 + Linux_Ubuntu: + unknown_versioning: &ghc-864-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.6.4 + dlHash: e0b1ada7a679d6c35f9d7a1192ed35fde054f3650bb0bd2570d103729ad3b846 + '( >= 16 && < 19 )': *ghc-864-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-864-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-864-64-fedora + Linux_UnknownLinux: + unknown_versioning: *ghc-864-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.6.4 + dlHash: cccb58f142fe41b601d73690809f6089f7715b6a50a09aa3d0104176ab4db09e + A_32: + Linux_Debian: + unknown_versioning: &ghc-864-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.6.4 + dlHash: 5e2ce88f4d13d23ac37e278e0c7b51c801008931359b9fa8a631d804d2da552c + Linux_Ubuntu: + unknown_versioning: *ghc-864-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-864-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-864-32-deb9 + 8.6.5: + viTags: + - base-4.12.0.0 + viChangeLog: https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/8.6.5-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-src.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: 4d4aa1e96f4001b934ac6193ab09af5d6172f41f5a5d39d8e43393b9aafee361 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: c419fd0aa9065fe4d2eb9a248e323860c696ddf3859749ca96a84938aee49107 + unknown_versioning: &ghc-865-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: bc75f5601a9f41d58b2ba161b9e28fad52143a7229060f1e084168d9b2e914df + Linux_Ubuntu: + unknown_versioning: &ghc-865-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: cf78b53eaf336083e7a05f4a3000afbae4abe5bbc77ef80cc40e09d04ac5b4a1 + '( >= 16 && < 19 )': *ghc-865-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-865-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-865-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-865-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: 80ab566f4411299f9e5922d60749ca80f989d697db19e03ed875619d699f0edf + Linux_RedHat: + unknown_versioning: *ghc-865-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.6.5/ghc-8.6.5-x86_64-alpine-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: b9d3ed7f7aa24ef2d58bb579252289caa0b8877adee3685e3af2fb73d440afdc + Linux_AmazonLinux: + unknown_versioning: *ghc-865-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-865-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: dfc1bdb1d303a87a8552aa17f5b080e61351f2823c2b99071ec23d0837422169 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.6.5/ghc-8.6.5-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: 83a3059a630d40a98e26cb5b520354e12094a96e36ba2f5ab002dad94cf2fb37 + A_32: + Linux_Debian: + unknown_versioning: &ghc-865-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: 1cddb907393a669342b1a922dd16d505d9d93d50bd9433a54a8162f8701250dc + Linux_Ubuntu: + unknown_versioning: *ghc-865-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-865-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.6.5/ghc-8.6.5-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: 3737837550d9b177acfe150e3a3cd4545427ded020487c2ed5194d7b8f116349 + Linux_UnknownLinux: + unknown_versioning: *ghc-865-32-deb9 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-aarch64-ubuntu18.04-linux.tar.xz + dlSubdir: ghc-8.6.5 + dlHash: 1852589037e4b2805ab517bc430e25a3125c4a118a1674ffefbb443394a0c786 + 8.8.1: + viTags: + - base-4.13.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: 908a83d9b814da74585de9d39687189e6260ec3848131f9d9236cab8a123721a + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: fd96eb851971fbc3332bf2fa7821732cfa8b37e5a076a69f6a06f83f0ea7ccc5 + unknown_versioning: &ghc-881-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: 620fd560535b63cac5f8c97354ccddf93fa940cca78e2d19f6f98b7e67c6a723 + Linux_Ubuntu: + unknown_versioning: &ghc-881-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: 851a78df620bc056c34b252c97040d5755e294993fa8afa5429708b5229204d6 + '( >= 16 && < 19 )': *ghc-881-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-881-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-881-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-881-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: 6cdd34e4dbaeb801e805811f91cf43a2d5f64b22f884718ffbd3542a2f4dd14f + Linux_RedHat: + unknown_versioning: *ghc-881-64-centos + Linux_AmazonLinux: + unknown_versioning: *ghc-881-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-881-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: 38c8917b47c31bedf58c9305dfca3abe198d8d35570366f0773c4e2948bd8abe + A_32: + Linux_Debian: + unknown_versioning: &ghc-881-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.8.1 + dlHash: 3d3bb75aff2dd79ec87ace10483368681fbc328ff00ebf15edad33420f00f7f5 + Linux_Ubuntu: + unknown_versioning: *ghc-881-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-881-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-881-32-deb9 + 8.8.2: + viTags: + - base-4.13.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: 01cea54d90686b97bcc9960b108beaffccd4336dee930dcf9beaf52b1f370a0b + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: fbe69652eba75dadb758d00292247d17fb018c29cac5acd79843e56311256c9f + unknown_versioning: &ghc-882-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: 7b2d66c2d5d8c15750da5833d3018634a5eb792a5662282e3abfeb112c2a1cc3 + Linux_Ubuntu: + unknown_versioning: &ghc-882-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: dbe2db717b33460f790e155e487d2a31c9b21a9d245f0c9490ad65844c3ea21f + '( >= 16 && < 19 )': *ghc-882-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-882-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-882-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-882-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: f065a017d7a38f235f186ffe32d8261a4fd39c7e945d5cde85c0984c2569db99 + Linux_RedHat: + unknown_versioning: *ghc-882-64-centos + Linux_AmazonLinux: + unknown_versioning: *ghc-882-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-882-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: 25c5c1a70036abf3f22b2b19c10d26adfdb08e8f8574f89d4b2042de5947f990 + A_32: + Linux_Debian: + unknown_versioning: &ghc-882-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.8.2 + dlHash: ad1c628082c32635a436905a7ff83eaa4246347d869be5ef6b33c3bf85e8f00c + Linux_Ubuntu: + unknown_versioning: *ghc-882-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-882-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-882-32-deb9 + 8.8.3: + viTags: + - base-4.13.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: e0dcc0aaf3e234c5978f29e6df62947e97720ab404ec0158343df211c5480f89 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 92b9fadc442976968d2c190c14e000d737240a7d721581cda8d8741b7bd402f0 + unknown_versioning: &ghc-883-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 42fde2ef5a143e1e6b47ae8875162ea2d4d54b06f0f7fa32ee4f0eb86f2be7ad + Linux_Ubuntu: + unknown_versioning: &ghc-883-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 45ee1de3bfc98cbcc4886b65fc7651ade2d3820aa85eac2dbe9bc7bf91e7c818 + '( >= 16 && < 19 )': *ghc-883-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-883-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-883-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-883-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 4b2b5313f7c12b81e54efcb26705fa9e4ad5b98f2b58bfc76fb0c9ba1d55eb1f + Linux_RedHat: + unknown_versioning: *ghc-883-64-centos + Linux_AmazonLinux: + unknown_versioning: *ghc-883-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-883-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 7016de90dd226b06fc79d0759c5d4c83c2ab01d8c678905442c28bd948dbb782 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.8.3/ghc-8.8.3-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 569719075b4d14b3875a899df522090ae31e6fe085e6dffe518e875b09a2f0be + A_32: + Linux_Debian: + unknown_versioning: &ghc-883-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 441e2c7a4fc83ebf179712bd939b555cda7c6633545b7c8ac38049f9d85003ae + Linux_Ubuntu: + unknown_versioning: *ghc-883-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-883-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-883-32-deb9 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-aarch64-deb9-linux.tar.xz + dlSubdir: ghc-8.8.3 + dlHash: 2a6821d0e7326cfa7670851702924bbab3b092415ba41247c37419158327eed9 + 8.8.4: + viTags: + - base-4.13.0.0 + viChangeLog: https://downloads.haskell.org/~ghc/8.8.4/docs/html/users_guide/8.8.4-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-src.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: f0505e38b2235ff9f1090b51f44d6c8efd371068e5a6bb42a2a6d8b67b5ffc2d + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 8 && < 9 )': + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb8-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: 51a36892f1264744195274187298d13ac62bce2da86d4ddf76d8054ab90f2feb + unknown_versioning: &ghc-884-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: 4862559d221153caf978f4bf2c15a82c114d1e1f43b298b2ecff2ac94b586d20 + Linux_Ubuntu: + unknown_versioning: &ghc-884-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: f32e37f8aa03e74bad533ae02f62dc27a4521e78199576af490888ba34b515db + '( >= 16 && < 19 )': *ghc-884-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-884-64-fedora + Linux_Fedora: + unknown_versioning: *ghc-884-64-fedora + Linux_CentOS: + unknown_versioning: &ghc-884-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: a12aa4b1fd3c64240a8a6d15196d33e1c0e0d55b51ff78c387242126d0ef7910 + Linux_RedHat: + unknown_versioning: *ghc-884-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.8.4/ghc-8.8.4-x86_64-alpine-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: 90c6a1661de7f20c7d169cd6270125035b3332063e45103ce028df0beecf434e + Linux_AmazonLinux: + unknown_versioning: *ghc-884-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-884-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: e80a789e9d8cfb41dd87f3284b75432427c4461c1731d220d04ead8733ccdb5e + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.8.4/ghc-8.8.4-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: 8cebe5ccf454e82acd1ff52ca57590d1ab0f3f44a981b46257ec12158c8c447e + A_32: + Linux_Debian: + unknown_versioning: &ghc-884-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: 43dd954910c9027694312cef0aabc7774d102d0422b7172802cfb72f7d5da3a0 + Linux_Ubuntu: + unknown_versioning: *ghc-884-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-884-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.8.4/ghc-8.8.4-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.8.4 + dlHash: 1d18e89ee031197e55c48683e78a7ffc67601ac5fd9f73aac555eb064b3859a2 + Linux_UnknownLinux: + unknown_versioning: *ghc-884-32-deb9 + 8.10.1: + viTags: + - base-4.14.0.0 + - old + viChangeLog: https://downloads.haskell.org/~ghc/8.10.1/docs/html/users_guide/8.10.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: 4e3b07f83a266b3198310f19f71e371ebce97c769b14f0d688f4cbf2a2a1edf5 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8101-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: d1cf7886f27af070f3b7dbe1975a78b43ef2d32b86362cbe953e79464fe70761 + '( >= 10 && < 11 )': &ghc-8101-64-deb10 + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: c1e31d798b013699b3c0de4fda27fb4cda47f572df0e75e3bd598a3012060615 + unknown_versioning: *ghc-8101-64-deb9 + Linux_Ubuntu: + unknown_versioning: &ghc-8101-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: 3c4cd72b4806045779739e8f5d1658e30e57123d88c2c8966422cdbcae448470 + '( >= 16 && < 19 )': *ghc-8101-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-8101-64-fedora + Linux_Fedora: + '( >= 27 && < 28 )': *ghc-8101-64-fedora + unknown_versioning: *ghc-8101-64-fedora + Linux_CentOS: + '( >= 7 && < 8 )': &ghc-8101-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: 0618b94854edc6be5302489df905e627820b71be6b66c950f5e3088fe92df0a1 + unknown_versioning: *ghc-8101-64-centos + Linux_RedHat: + unknown_versioning: *ghc-8101-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-alpine3.10-linux-integer-simple.tar.xz + dlSubdir: ghc-8.10.1-x86_64-unknown-linux + dlHash: cb13b645d103e2fba2eb8dfcc4e5f2fbd9550c00c4df42f342b4210436dcb8a8 + Linux_AmazonLinux: + unknown_versioning: *ghc-8101-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-8101-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: 65b1ca361093de4804a7e40b3e68178e1ef720f84f743641ec8d95e56a45b3a8 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: e8646ec9b60fd40aa9505ee055f22f04601290ab7a1342c2cf37c34de9d3f142 + A_32: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8101-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: 8b53eef2c827b5f634d72920a93c0c9dd66ea288691a2bfe28def45d3c686ee2 + unknown_versioning: *ghc-8101-32-deb9 + Linux_Ubuntu: + unknown_versioning: *ghc-8101-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-8101-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.10.1/ghc-8.10.1-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: 7360cc6b29e9b4ab08f6ea5bc3bcca6f5c216933e81ef1620dcdd700f1fdb289 + Linux_UnknownLinux: + unknown_versioning: *ghc-8101-32-deb9 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-aarch64-deb9-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: c099011e07999db917e797fb5d89c31f075a562556ab99be8ab0accbf2a94db7 + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-armv7-deb9-linux.tar.xz + dlSubdir: ghc-8.10.1 + dlHash: afe1bde2b0d6deb0320b9460fffe5d9427e302df85aec866b9c1458777d52b28 + 8.10.2: + viTags: + - old + - base-4.14.1.0 + viChangeLog: https://downloads.haskell.org/~ghc/8.10.2/docs/html/users_guide/8.10.2-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-src.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 9c573a4621a78723950617c223559bdc325ea6a3409264aedf68f05510b0880b + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8102-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 4dbe3b479e76767bfeb4cbb7a4db8b761c4720266193483ca370b2ace3f10f7c + '( >= 10 && < 11 )': &ghc-8102-64-deb10 + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 94513d82c38c848f489113a75fa5ef4e5a8e3ecfaa74ca90e2620d2193ff1632 + unknown_versioning: *ghc-8102-64-deb9 + Linux_Ubuntu: + unknown_versioning: &ghc-8102-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 8c675da83e9b3c2f64ebb407b5f9ebb2c1f21aa5d701020614fdce644a542e3b + '( >= 16 && < 19 )': *ghc-8102-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-8102-64-fedora + Linux_Fedora: + '( >= 27 && < 28 )': *ghc-8102-64-fedora + unknown_versioning: *ghc-8102-64-fedora + Linux_CentOS: + '( >= 7 && < 8 )': &ghc-8102-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: fd2dccd6f496915a5f962dab24e7eeb8bee49bcc38e74b17eac76159083538fa + unknown_versioning: *ghc-8102-64-centos + Linux_RedHat: + unknown_versioning: *ghc-8102-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-alpine3.10-linux-integer-simple.tar.xz + dlSubdir: ghc-8.10.2-x86_64-unknown-linux + dlHash: 14d09a508f2a3a11875c140be8e6c5f6982ac5cd448f089ca10b7adc955fec76 + Linux_AmazonLinux: + unknown_versioning: *ghc-8102-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-8102-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: edb772b00c0d7f18bb56ad27765162ee09c508104d40f82128c9114a02f6cfc2 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-unknown-freebsd.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 9e5957f3497f4b58ecd3699568d9caaa11a47a6d7e902032c261e450fa0f6686 + A_32: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8102-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 9dae2a86ad43d08f72c783542c944d1556b075aa20a8063efae5034ea88e7c2f + unknown_versioning: *ghc-8102-32-deb9 + Linux_Ubuntu: + unknown_versioning: *ghc-8102-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-8102-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-8102-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.10.2/ghc-8.10.2-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 9ee1cf1e85e9536088b3c9e80e975074e525ea378cd4eb156071bbc4b7b38327 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-aarch64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: 5cf24189077e6e2dce2aa16367ad8a53f603e751a15010dfb23d067206e55593 + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-armv7-deb10-linux.tar.xz + dlSubdir: ghc-8.10.2 + dlHash: bb9c97826b1f4d7a8ef8bce0616b612f1ded10480ef10fcf7fb4e6d10a6681c8 + 8.10.3: + viTags: + - base-4.14.1.0 + viChangeLog: https://downloads.haskell.org/~ghc/8.10.3/docs/html/users_guide/8.10.3-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-src.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: ccdc8319549028a708d7163e2967382677b1a5a379ff94d948195b5cf46eb931 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8103-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: 95e4aadea30701fe5ab84d15f757926d843ded7115e11c4cd827809ca830718d + '( >= 10 && < 11 )': &ghc-8103-64-deb10 + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: c8f3d9f0e61a89eaba1d3ad8fb2eced1af0e81576811261b887993bee12538ac + unknown_versioning: *ghc-8103-64-deb9 + Linux_Ubuntu: + unknown_versioning: &ghc-8103-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: f8739b12008712d6b6a9ffc6c39f9d05af77ef3bcb932c9aff20fa0893c8c159 + '( >= 16 && < 19 )': *ghc-8103-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-8103-64-deb10 + Linux_Fedora: + '( >= 27 && < 28 )': *ghc-8103-64-fedora + unknown_versioning: *ghc-8103-64-fedora + Linux_CentOS: + '( >= 7 && < 8 )': &ghc-8103-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: f562ca61979ff1d21e34e69e59028cb742a8eff8d84e46bbd3a750f2ac7d8ed1 + unknown_versioning: *ghc-8103-64-centos + Linux_RedHat: + unknown_versioning: *ghc-8103-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-alpine3.10-linux-integer-simple.tar.xz + dlSubdir: ghc-8.10.3-x86_64-unknown-linux + dlHash: 8506c478ebbfb5441c3c36c07c36fc8532cacb2b3e13c6733bd44cb17b3ce96c + Linux_AmazonLinux: + unknown_versioning: *ghc-8103-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-8103-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: 2635f35d76e44e69afdfd37cae89d211975cc20f71f784363b72003e59f22015 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: 749007e995104db05cf6e3ad5bc36238cab8afac8055145661e5730e8f8af040 + A_32: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8103-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: f0addd2a16b705f58ff9e8702c3ddf3e2d6bd0d3555707b5b5095e51bafee7b1 + unknown_versioning: *ghc-8103-32-deb9 + Linux_Ubuntu: + unknown_versioning: *ghc-8103-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-8103-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-8103-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.10.3/ghc-8.10.3-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: 309201cdefd2d13b8b3fd09c26c6137048c490d219a0a9c7407c3ce1d011f60c + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-aarch64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: a531432d505a1fe886cdc8639d168eb1c92d76464c1270713e01ce81891bbadb + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-armv7-deb10-linux.tar.xz + dlSubdir: ghc-8.10.3 + dlHash: b823b58cae36fbac0741680ca7605180fa4cf4c6ae439123d282184b94d32fd6 + 8.10.4: + viTags: + - Recommended + - base-4.14.1.0 + viChangeLog: https://downloads.haskell.org/~ghc/8.10.4/docs/html/users_guide/8.10.4-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-src.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 52af871b4e08550257d720c2944ac85727d0b948407cef1bebfe7508c224910e + viPostRemove: *ghc-post-remove + viPreCompile: "If you have autoconf >= 2.70 you'll need this patch https://gitlab.haskell.org/ghc/ghc/-/snippets/2040 (see the --patchdir option)" + viArch: + A_64: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8104-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 5694200a5c38f22c142baf850b1d2f3784211d2ec9302e11693259a1ae8e38b7 + '( >= 10 && < 11 )': &ghc-8104-64-deb10 + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 816365565e9927459b035515a7db6a0db62f9796f327389b6f8a0035d12fbda0 + unknown_versioning: *ghc-8104-64-deb9 + Linux_Ubuntu: + unknown_versioning: &ghc-8104-64-fedora + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: a189eed900a8717d6d7906bafd10b9a9a9688ad942d1c75e19df480376dff9ea + '( >= 16 && < 19 )': *ghc-8104-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-8104-64-deb10 + Linux_Fedora: + '( >= 27 && < 28 )': *ghc-8104-64-fedora + unknown_versioning: *ghc-8104-64-fedora + Linux_CentOS: + '( >= 7 && < 8 )': &ghc-8104-64-centos + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: fb8a91f0cf06594172aff46c2f6f7486179e1c3760855c79fbdd3012598cc2cd + unknown_versioning: *ghc-8104-64-centos + Linux_RedHat: + unknown_versioning: *ghc-8104-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-alpine3.10-linux-integer-simple.tar.xz + dlSubdir: ghc-8.10.4-x86_64-unknown-linux + dlHash: 74c2c07537832708502716ef4ec40019f8e552ddda13c8eadf8f7c4b03a79359 + Linux_AmazonLinux: + unknown_versioning: *ghc-8104-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-8104-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 725ecf6543e63b81a3581fb8c97afd21a08ae11bc0fa4f8ee25d45f0362ef6d5 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: c9776a2ccf9629b03e967206a507fcdcb6c5189800a626e9461ababf6733c357 + A_32: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-8104-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-i386-deb9-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 0022c5b9ac22825bb7b4745af3d92cef0ba1ecd01fab3ef387ddbd47146569ad + unknown_versioning: *ghc-8104-32-deb9 + Linux_Ubuntu: + unknown_versioning: *ghc-8104-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-8104-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-8104-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.10.4/ghc-8.10.4-i386-alpine-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 9161a98bed763692101854d83af69c1316030cfe5ee6f6acde283d04ef139735 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-aarch64-deb10-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 249da6310be799a5eefe0579b6dae1701eb984afb980fe08309d19cf704038ed + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-armv7-deb10-linux.tar.xz + dlSubdir: ghc-8.10.4 + dlHash: 0d18ef83593272f6196a41cc3abdc48dfe5e14372db75d71ea19fe35320c4e81 + 9.0.1: + viTags: + - Latest + - base-4.15.0.0 + viChangeLog: https://downloads.haskell.org/~ghc/9.0.1/docs/html/users_guide/9.0.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-src.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: a5230314e4065f9fcc371dfe519748fd85c825b279abf72a24e09b83578a35f9 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-901-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: 4ca6252492f59fe589029fadca4b6f922d6a9f0ff39d19a2bd9886fde4e183d5 + '( >= 10 && < 11 )': &ghc-901-64-deb10 + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-deb10-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: c253e7eb62cc9da6524c491c85ec8d3727c2ca6035a8653388e636aaa30a2a0f + unknown_versioning: *ghc-901-64-deb9 + Linux_Ubuntu: + unknown_versioning: &ghc-901-64-fedora + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: 1fb8e27eeec51b4cdbfd1b3c16727adc5f77388d3e925e63799d8232647f316d + '( >= 16 && < 19 )': *ghc-901-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-901-64-deb10 + Linux_Fedora: + '( >= 27 && < 28 )': *ghc-901-64-fedora + unknown_versioning: *ghc-901-64-fedora + Linux_CentOS: + '( >= 7 && < 8 )': &ghc-901-64-centos + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: a23750950b6995a66ba59afe82bbc505bd3479d6ab59cf66f45bc6c056e4d87b + unknown_versioning: *ghc-901-64-centos + Linux_RedHat: + unknown_versioning: *ghc-901-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-alpine3.10-linux-integer-simple.tar.xz + dlSubdir: ghc-9.0.1-x86_64-unknown-linux + dlHash: 7c1a0154c9e361b75be6cb0305533bb8a3b963c54e8092ffd1759e5710805a5c + Linux_AmazonLinux: + unknown_versioning: *ghc-901-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-901-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: 122d60509147d0117779d275f0215bde2ff63a64cda9d88f149432d0cae71b22 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-portbld-freebsd.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: 9dbc06d8832cae5c9f86dd7b2db729b3748a47beb4fd4b1e62bb66119817c3c1 + A_32: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-901-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-i386-deb9-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: 880e37cea8328401bcfecfe4bb56eb85195f30135b140140b3f24094264f8ba5 + unknown_versioning: *ghc-901-32-deb9 + Linux_Ubuntu: + unknown_versioning: *ghc-901-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-901-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-901-32-deb9 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/9.0.1/ghc-9.0.1-i386-alpine-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: ebfeb3b91e6f2bb5a49fd3376746f7fd1b89e62e9838bf5b1530a8756ff1e6aa + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-aarch64-deb9-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: fac7a0bdfc83c05df94024a2d67b8f00a9cd2733b9cb41fb8ad76be399014906 + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-armv7-deb9-linux.tar.xz + dlSubdir: ghc-9.0.1 + dlHash: 6f404f9b88468407b3a9ec5800bcc2d01dd453ef3d63414853b4fbbd4d8df496 + 9.2.0.20210331: + viTags: + - Prerelease + - base-4.16.0.0 + viChangeLog: https://downloads.haskell.org/~ghc/9.2.1-alpha1/docs/html/users_guide/9.2.1-notes.html + viSourceDL: + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-src.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: 3ec8ec2fb77e14d68ac1c092f3e8605b6822e24f7e6dc7139dccf8feaf168699 + viPostRemove: *ghc-post-remove + viArch: + A_64: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-921-alpha1-64-deb9 + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-deb9-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: c13613cb6285a689c5b89c93fad5c6c0e95d66c8936338c44d92a1312f507006 + '( >= 10 && < 11 )': &ghc-921-alpha1-64-deb10 + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-deb10-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: 2b2a0e2bad54d1a41440c093a199207b58ff314bea7edf73387916e9952d6a53 + unknown_versioning: *ghc-921-alpha1-64-deb9 + Linux_Ubuntu: + unknown_versioning: &ghc-921-alpha1-64-fedora + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-fedora27-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: c7e648ac313c268aaa3a9651b00650da6eb293abfe14e44f44da22a758c233e7 + '( >= 16 && < 19 )': *ghc-921-alpha1-64-deb9 + Linux_Mint: + unknown_versioning: *ghc-921-alpha1-64-deb10 + Linux_Fedora: + '( >= 27 && < 28 )': *ghc-921-alpha1-64-fedora + unknown_versioning: *ghc-921-alpha1-64-fedora + Linux_CentOS: + '( >= 7 && < 8 )': &ghc-921-alpha1-64-centos + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-centos7-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: 50556cc42be665957f2bd8e5deeceb26e58e88badfa0c99a44117fda2d63200c + unknown_versioning: *ghc-921-alpha1-64-centos + Linux_RedHat: + unknown_versioning: *ghc-921-alpha1-64-centos + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-alpine3.10-linux-integer-simple.tar.xz + dlSubdir: ghc-9.2.0.20210331-x86_64-unknown-linux + dlHash: bab5f5d0ecd6522da372a9a0f0eeebbbecf0bd94788847aa3cd5bdb36682d48a + Linux_AmazonLinux: + unknown_versioning: *ghc-921-alpha1-64-centos + Linux_UnknownLinux: + unknown_versioning: *ghc-921-alpha1-64-fedora + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-x86_64-apple-darwin.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: cfd7d0479ce80607c11cf96fe25d4804783c6ebc623ca9adcb5436e3499c9c5b + A_32: + Linux_Debian: + '( >= 9 && < 10 )': &ghc-921-alpha1-32-deb9 + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-i386-deb9-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: 58ccac8e89e60b4261dfa8ca0e17d335b99f2a1fecb90322436cfea3bdce2240 + unknown_versioning: *ghc-921-alpha1-32-deb9 + Linux_Ubuntu: + unknown_versioning: *ghc-921-alpha1-32-deb9 + Linux_Mint: + unknown_versioning: *ghc-921-alpha1-32-deb9 + Linux_UnknownLinux: + unknown_versioning: *ghc-921-alpha1-32-deb9 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-aarch64-deb10-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: df355e1ed34cf0fef11444299020041f03d6c67f6c5c342db1f76b71fd31e6fe + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha1/ghc-9.2.0.20210331-armv7-deb10-linux.tar.xz + dlSubdir: ghc-9.2.0.20210331 + dlHash: 2c5133fb83943371ad8556328db4acb9081271b7c77ceaf2b74817dd0de3b486 + Cabal: + 2.4.1.0: + viTags: + - old + viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog + viArch: + A_64: + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-alpine-linux-musl.tar.xz + dlSubdir: + dlHash: 720bef015f834a03deb7180be2952a44e7c2e6c8429137570404c3de4f46b984 + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-linux.tar.xz + dlSubdir: + dlHash: 6136c189ffccaa39916f9cb5788f757166444a2d0c473b987856a79ecbf0c714 + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz + dlSubdir: + dlHash: 56361cf4b0d920fe23174751fea1fb82a8e1ce522bd9706a3fbe47a72e458c9c + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-portbld-freebsd.tar.xz + dlSubdir: + dlHash: 33b7d37ea0688c93436eac9ec139d9967687875aa1fa13f2bb73bf05a9a59a1d + A_32: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-i386-unknown-linux.tar.xz + dlSubdir: + dlHash: b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198 + 3.0.0.0: + viTags: + - old + viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog + viArch: + A_64: + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-alpine-linux-musl.tar.xz + dlHash: 2b7ea63601e11a0db2941b96e6a7036a48efc2a1ab3849d7dfce08b45f5daa58 + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-unknown-linux.tar.xz + dlHash: ee911ba67a70756eedeac662955b896d7e89432a99372aa45d2c6e71fa95a5e4 + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-apple-darwin17.7.0.tar.xz + dlHash: d4857e068560515e4cbb0e8ca124c370e07892f2a28804d87152834e5fe2b845 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz + dlHash: 2240842ab2ae7b955feb8b526aba1c7991248c803383107adf39990441294d2a + A_32: + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-alpine-linux-musl.tar.xz + dlHash: ac018f061993d40bf146517e32629bcab274b4d9f5527b1c37a665ebdf3f5ac6 + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-i386-unknown-linux.tar.xz + dlHash: 6898ccd6e6dc0872999c06daaf61d546164e12f60a1880d09852c9f0c59c5cf6 + 3.2.0.0: + viTags: + - old + viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/changelog + viArch: + A_64: + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-alpine-linux-musl.tar.xz + dlHash: 8bae37a1ce8b5f10440b5591fed734935e1411c1b765258325ffe268e2cc2042 + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-linux.tar.xz + dlHash: 32d1f7cf1065c37cb0ef99a66adb405f409b9763f14c0926f5424ae408c738ac + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-apple-darwin17.7.0.tar.xz + dlHash: 9197c17d2ece0f934f5b33e323cfcaf486e4681952687bc3d249488ce3cbe0e9 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz + dlHash: f1e35151cca91541b0fb4bdb3ed18f3c348038eab751845ad19c11307d66c273 + A_32: + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-alpine-linux-musl.tar.xz + dlHash: c2a419dedf730987b60daf8d24e871d115a09ea608d740d7c61b36e3f5b9c830 + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-i386-unknown-linux.tar.xz + dlHash: 2b3ac28549916de5f3379241797eaf60e84b6c001f2abbe73d9fadbbaf768e93 + 3.4.0.0: + viTags: + - Recommended + - Latest + viChangeLog: https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md + viArch: + A_64: + Linux_Ubuntu: + unknown_versioning: &cabal-3400-ubuntu + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz + dlHash: cf28f9ffd763476aa2b1730d85cbf155d366fac541f78ee3951e8cb2d6de63e6 + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-x86_64-alpine-3.11.6-static-noofd.tar.xz + dlHash: c74073fe79110946182e522fcadc8dcabf07c87583e8cf7801ed4e0c327241f6 + Linux_UnknownLinux: + unknown_versioning: *cabal-3400-ubuntu + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-x86_64-darwin-sierra.tar.xz + dlHash: cb10be9a53e856aa2d852fd88fb6944f138783ffe0ea84d93c9a69244e34ea91 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz + dlHash: a1e2db664ec00e42a1e071a4181f6476f6e0bad321f1ddc0cf27831119f4c6d4 + A_32: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-i386-debian-9.tar.xz + dlHash: ef3750644a53f7b1fad141b2ad02d4c7a3b239ec0cbfa7f0528fb02c1dfcebce + Linux_Alpine: + unknown_versioning: + dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-i386-alpine-linux-musl.tar.gz + dlHash: 95adb65f3a72aa8d9ce83685bc06e1eee5b801f56e204e27e957e8a35abd9cf8 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-aarch64-ubuntu-18.04.tar.xz + dlHash: 04d378347896dfdc3510b192b97489815cfa5d692f46e2758da0f789e682b8f0 + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz + dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed + GHCup: + 0.1.14.1: + viTags: + - Recommended + - Latest + viChangeLog: https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/CHANGELOG.md + viSourceDL: + viArch: + A_64: + Linux_UnknownLinux: + unknown_versioning: &ghcup-64 + dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14 + dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd + Darwin: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14 + dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919 + FreeBSD: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14 + dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9 + Linux_Alpine: + unknown_versioning: *ghcup-64 + A_32: + Linux_UnknownLinux: + unknown_versioning: &ghcup-32 + dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14 + dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa + Linux_Alpine: + unknown_versioning: *ghcup-32 + A_ARM64: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghcup/0.1.14/aarch64-linux-ghcup-0.1.14 + dlHash: 78a15f8a03917a89b67536af0993d7526d2722248a3a5cd8c500adffd7cd7691 + A_ARM: + Linux_UnknownLinux: + unknown_versioning: + dlUri: https://downloads.haskell.org/~ghcup/0.1.14/armv7-linux-ghcup-0.1.14 + dlHash: 5484dc9e16553c3d1707a9f83404c3c795dc01d01ef998cf173caf960abe793b + HLS: + 1.0.0: + viTags: + - Recommended + - Latest + viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#100 + viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md" + viArch: + A_64: + Linux_UnknownLinux: + unknown_versioning: &hls-64 + dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.0.0/haskell-language-server-Linux-1.0.0.tar.gz + dlHash: 4fab18998c5f67118a26b75b059f3b3e2ad345b6325515a552d1a24cdf87ed3f + Darwin: + unknown_versioning: + dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.0.0/haskell-language-server-macOS-1.0.0.tar.gz + dlHash: 74e7624c889c0235f0b02d7e7f164d5eb95b611d584fc8602f0b3a099b73f8be + Linux_Alpine: + unknown_versioning: *hls-64 diff --git a/ghcup.cabal b/ghcup.cabal new file mode 100644 --- /dev/null +++ b/ghcup.cabal @@ -0,0 +1,305 @@ +cabal-version: 3.0 +name: ghcup +version: 0.1.14.1 +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 as an exe/library +description: + A rewrite of the shell script ghcup, for providing + a more stable user experience and exposing an API. + +category: System +build-type: Simple +extra-doc-files: CHANGELOG.md + README.md + HACKING.md + RELEASING.md + config.yaml + ghcup-0.0.4.yaml + +source-repository head + type: git + location: https://gitlab.haskell.org/haskell/ghcup-hs.git + +flag tui + description: Build the brick powered tui (ghcup tui) + default: False + manual: True + +flag internal-downloader + description: + Compile the internal downloader, which links against OpenSSL + + default: False + manual: True + +flag tar + description: Use tar-bytestring instead of libarchive + default: False + manual: True + +library + 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.Dirs + GHCup.Utils.File + 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: + LambdaCase + MultiWayIf + PackageImports + RecordWildCards + ScopedTypeVariables + Strict + StrictData + TupleSections + + ghc-options: + -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates + + build-depends: + , aeson >=1.4 && <1.6 + , ascii-string ^>=1.0 + , 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 + , bz2 >=0.5.0.5 && <1.1 + , case-insensitive ^>=1.2.1.0 + , casing ^>=0.1.4.1 + , concurrent-output ^>=1.10.11 + , containers ^>=0.6 + , cryptohash-sha256 ^>=0.11.101.0 + , generics-sop ^>=0.5 + , haskus-utils-types ^>=1.5 + , haskus-utils-variant >=3.0 && <3.2 + , hpath >=0.11 && <0.13 + , hpath-directory ^>=0.14.1 + , hpath-filepath ^>=0.10.3 + , hpath-io ^>=0.14.1 + , hpath-posix ^>=0.13.2 + , lzma-static ^>=5.2.5.2 + , megaparsec >=8.0.0 && <9.1 + , monad-logger ^>=0.3.31 + , mtl ^>=2.2 + , optics >=0.2 && <0.5 + , optics-vl ^>=0.2 + , os-release ^>=1.0.0 + , parsec ^>=3.1 + , 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 + , streamly ^>=0.7.3 + , streamly-bytestring ^>=0.1.2 + , streamly-posix ^>=0.1.0.0 + , strict-base ^>=0.4 + , string-interpolate >=0.2.0.0 && <0.4 + , template-haskell >=2.7 && <2.17 + , text ^>=1.2.4.0 + , time ^>=1.9.3 + , transformers ^>=0.5 + , unix ^>=2.7 + , unix-bytestring ^>=0.3 + , unordered-containers ^>=0.2.10.0 + , uri-bytestring ^>=0.3.2.2 + , utf8-string ^>=1.0 + , vector ^>=0.12 + , versions ^>=4.0.1 + , vty >=5.28.2 && <5.34 + , word8 ^>=0.1.3 + , yaml ^>=0.11.4.0 + , zlib ^>=0.6.2.2 + + if flag(internal-downloader) + 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 + , terminal-progress-bar >=0.4.1 + + if flag(tar) + cpp-options: -DTAR + build-depends: tar-bytestring ^>=0.6.3.1 + + else + build-depends: libarchive ^>=3.0.0.0 + +executable ghcup + main-is: Main.hs + hs-source-dirs: app/ghcup + default-language: Haskell2010 + default-extensions: + LambdaCase + MultiWayIf + PackageImports + RecordWildCards + ScopedTypeVariables + Strict + StrictData + TupleSections + + ghc-options: + -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates -threaded + + build-depends: + , aeson >=1.4 && <1.6 + , base >=4.13 && <5 + , bytestring ^>=0.10 + , containers ^>=0.6 + , ghcup + , haskus-utils-variant >=3.0 && <3.2 + , hpath >=0.11 && <0.13 + , hpath-io ^>=0.14.1 + , megaparsec >=8.0.0 && <9.1 + , monad-logger ^>=0.3.31 + , 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 + , string-interpolate >=0.2.0.0 && <0.4 + , template-haskell >=2.7 && <2.17 + , text ^>=1.2.4.0 + , uri-bytestring ^>=0.3.2.2 + , utf8-string ^>=1.0 + , versions ^>=4.0.1 + + if flag(internal-downloader) + cpp-options: -DINTERNAL_DOWNLOADER + + if flag(tui) + cpp-options: -DBRICK + other-modules: BrickMain + build-depends: + , brick >=0.5 && <0.62 + , vector ^>=0.12 + , vty >=5.28.2 && <5.34 + + if flag(tar) + cpp-options: -DTAR + + else + build-depends: libarchive ^>=3.0.0.0 + +executable ghcup-gen + main-is: Main.hs + hs-source-dirs: app/ghcup-gen + other-modules: Validate + default-language: Haskell2010 + default-extensions: + LambdaCase + MultiWayIf + PackageImports + RecordWildCards + ScopedTypeVariables + TupleSections + + ghc-options: + -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates -threaded + + build-depends: + , aeson >=1.4 && <1.6 + , aeson-pretty ^>=0.8.8 + , base >=4.13 && <5 + , bytestring ^>=0.10 + , containers ^>=0.6 + , ghcup + , haskus-utils-variant >=3.0 && <3.2 + , hpath >=0.11 && <0.13 + , hpath-filepath ^>=0.10.3 + , monad-logger ^>=0.3.31 + , mtl ^>=2.2 + , optics >=0.2 && <0.5 + , 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 + , string-interpolate >=0.2.0.0 && <0.4 + , text ^>=1.2.4.0 + , transformers ^>=0.5 + , uri-bytestring ^>=0.3.2.2 + , utf8-string ^>=1.0 + , versions ^>=4.0.1 + , yaml ^>=0.11.4.0 + + if flag(tar) + cpp-options: -DTAR + build-depends: tar-bytestring ^>=0.6.3.1 + + else + build-depends: libarchive ^>=3.0.0.0 + +test-suite ghcup-test + type: exitcode-stdio-1.0 + main-is: Main.hs + 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 + , hpath >=0.11 && <0.13 + , hspec ^>=2.7.4 + , hspec-golden-aeson >=0.7 && <0.10 + , 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 diff --git a/lib/GHCup.hs b/lib/GHCup.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup.hs @@ -0,0 +1,1372 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +{-| +Module : GHCup +Description : GHCup installation functions +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +This module contains the main functions that correspond +to the command line interface, like installation, listing versions +and so on. + +These are the entry points. +-} +module GHCup where + + +import GHCup.Download +import GHCup.Errors +import GHCup.Platform +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Types.Optics +import GHCup.Utils +import GHCup.Utils.File +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ +import GHCup.Utils.Version.QQ +import GHCup.Version + +#if !defined(TAR) +import Codec.Archive ( ArchiveResult ) +#endif +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail ( MonadFail ) +#endif +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Resource + hiding ( throwM ) +import Data.ByteString ( ByteString ) +import Data.Either +import Data.List +import Data.Maybe +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Versions +import Data.Word8 +import GHC.IO.Exception +import HPath +import HPath.IO hiding ( hideError ) +import Haskus.Utils.Variant.Excepts +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import Safe hiding ( at ) +import System.IO.Error +import System.Posix.Env.ByteString ( getEnvironment, getEnv ) +import System.Posix.FilePath ( getSearchPath, takeExtension ) +import System.Posix.Files.ByteString +import Text.Regex.Posix + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.Encoding as E + + + + ------------------------- + --[ Tool installation ]-- + ------------------------- + + +-- | Like 'installGHCBin', except takes the 'DownloadInfo' as +-- argument instead of looking it up from 'GHCupDownloads'. +installGHCBindist :: ( MonadFail m + , MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadResource m + , MonadIO m + ) + => DownloadInfo -- ^ where/how to download + -> Version -- ^ the version to install + -> PlatformRequest -- ^ the platform to install on + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installGHCBindist dlinfo ver pfreq = do + let tver = mkTVer ver + lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] + whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + -- prepare paths + ghcdir <- lift $ ghcupGHCDir tver + + toolchainSanityChecks + + liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver pfreq + + liftE $ postGHCInstall tver + + where + toolchainSanityChecks = do + r <- forM ["CC", "LD"] (liftIO . getEnv) + case catMaybes r of + [] -> pure () + _ -> do + lift $ $(logWarn) "CC/LD environment variable is set. This will change the compiler/linker" + lift $ $(logWarn) "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda" + lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall." + + +-- | Install a packed GHC distribution. This only deals with unpacking and the GHC +-- build system and nothing else. +installPackedGHC :: ( MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadThrow m + , MonadLogger m + , MonadIO m + ) + => Path Abs -- ^ Path to the packed GHC bindist + -> Maybe TarDir -- ^ Subdir of the archive + -> Path Abs -- ^ Path to install to + -> Version -- ^ The GHC version + -> PlatformRequest + -> Excepts + '[ BuildFailed + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] m () +installPackedGHC dl msubdir inst ver pfreq@PlatformRequest{..} = do + -- unpack + tmpUnpack <- lift mkGhcupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ liftIO $ darwinNotarization _rPlatform tmpUnpack + + -- the subdir of the archive where we do the work + workdir <- maybe (pure tmpUnpack) + (liftE . intoSubdir tmpUnpack) + msubdir + + liftE $ runBuildAction tmpUnpack + (Just inst) + (installUnpackedGHC workdir inst ver pfreq) + + +-- | Install an unpacked GHC distribution. This only deals with the GHC +-- build system and nothing else. +installUnpackedGHC :: ( MonadReader AppState m + , MonadThrow m + , MonadLogger m + , MonadIO m + ) + => Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides) + -> Path Abs -- ^ Path to install to + -> Version -- ^ The GHC version + -> PlatformRequest + -> Excepts '[ProcessError] m () +installUnpackedGHC path inst ver PlatformRequest{..} = do + lift $ $(logInfo) "Installing GHC (this may take a while)" + lEM $ execLogged "./configure" + False + (("--prefix=" <> toFilePath inst) : alpineArgs) + [rel|ghc-configure|] + (Just path) + Nothing + lEM $ make ["install"] (Just path) + pure () + where + alpineArgs + | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform + = ["--disable-ld-override"] + | otherwise + = [] + + +-- | Installs GHC into @~\/.ghcup\/ghc/\@ and places the +-- following symlinks in @~\/.ghcup\/bin@: +-- +-- * @ghc-x.y.z -> ..\/ghc\/x.y.z\/bin/ghc@ +-- * @ghc-x.y -> ..\/ghc\/x.y.z\/bin/ghc@ (if x.y.z is the latest x.y version) +installGHCBin :: ( MonadFail m + , MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadResource m + , MonadIO m + ) + => GHCupDownloads -- ^ the download info to look up the tarball from + -> Version -- ^ the version to install + -> PlatformRequest -- ^ the platform to install on + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installGHCBin bDls ver pfreq = do + dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls + installGHCBindist dlinfo ver pfreq + + +-- | Like 'installCabalBin', except takes the 'DownloadInfo' as +-- argument instead of looking it up from 'GHCupDownloads'. +installCabalBindist :: ( MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadFail m + ) + => DownloadInfo + -> Version + -> PlatformRequest + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installCabalBindist dlinfo ver PlatformRequest {..} = do + lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] + + AppState {dirs = Dirs {..}} <- lift ask + + whenM + (lift (cabalInstalled ver) >>= \a -> liftIO $ + handleIO (\_ -> pure False) + $ fmap (\x -> a && isSymbolicLink x) + -- ignore when the installation is a legacy cabal (binary, not symlink) + $ getSymbolicLinkStatus (toFilePath (binDir [rel|cabal|])) + ) + (throwE $ AlreadyInstalled Cabal ver) + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + -- unpack + tmpUnpack <- lift withGHCupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ liftIO $ darwinNotarization _rPlatform tmpUnpack + + -- the subdir of the archive where we do the work + workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) + + liftE $ installCabal' workdir binDir + + -- create symlink if this is the latest version + cVers <- lift $ fmap rights getInstalledCabals + let lInstCabal = headMay . reverse . sort $ cVers + when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver + + where + -- | Install an unpacked cabal distribution. + installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) + => Path Abs -- ^ Path to the unpacked cabal bindist (where the executable resides) + -> Path Abs -- ^ Path to install to + -> Excepts '[CopyError] m () + installCabal' path inst = do + lift $ $(logInfo) "Installing cabal" + let cabalFile = [rel|cabal|] + liftIO $ createDirRecursive' inst + destFileName <- lift $ parseRel (toFilePath cabalFile <> "-" <> verToBS ver) + let destPath = inst destFileName + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path cabalFile) + destPath + Overwrite + lift $ chmod_755 destPath + + +-- | Installs cabal into @~\/.ghcup\/bin/cabal-\@ and +-- creates a default @cabal -> cabal-x.y.z.q@ symlink for +-- the latest installed version. +installCabalBin :: ( MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadFail m + ) + => GHCupDownloads + -> Version + -> PlatformRequest + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installCabalBin bDls ver pfreq = do + dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls + installCabalBindist dlinfo ver pfreq + + +-- | Like 'installHLSBin, except takes the 'DownloadInfo' as +-- argument instead of looking it up from 'GHCupDownloads'. +installHLSBindist :: ( MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadFail m + ) + => DownloadInfo + -> Version + -> PlatformRequest + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installHLSBindist dlinfo ver PlatformRequest{..} = do + lift $ $(logDebug) [i|Requested to install hls version #{ver}|] + + AppState {dirs = Dirs {..}} <- lift ask + + whenM (lift (hlsInstalled ver)) + (throwE $ AlreadyInstalled HLS ver) + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + -- unpack + tmpUnpack <- lift withGHCupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ liftIO $ darwinNotarization _rPlatform tmpUnpack + + -- the subdir of the archive where we do the work + workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) + + liftE $ installHLS' workdir binDir + + -- create symlink if this is the latest version + hlsVers <- lift $ fmap rights getInstalledHLSs + let lInstHLS = headMay . reverse . sort $ hlsVers + when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver + + where + -- | Install an unpacked hls distribution. + installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) + => Path Abs -- ^ Path to the unpacked hls bindist (where the executable resides) + -> Path Abs -- ^ Path to install to + -> Excepts '[CopyError] m () + installHLS' path inst = do + lift $ $(logInfo) "Installing HLS" + liftIO $ createDirRecursive' inst + + -- install haskell-language-server- + bins@(_:_) <- liftIO $ findFiles + path + (makeRegexOpts compExtended + execBlank + ([s|^haskell-language-server-[0-9].*$|] :: ByteString) + ) + forM_ bins $ \f -> do + toF <- parseRel (toFilePath f <> "~" <> verToBS ver) + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path f) + (inst toF) + Overwrite + lift $ chmod_755 (inst toF) + + -- install haskell-language-server-wrapper + let wrapper = [rel|haskell-language-server-wrapper|] + toF <- parseRel (toFilePath wrapper <> "-" <> verToBS ver) + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path wrapper) + (inst toF) + Overwrite + lift $ chmod_755 (inst toF) + + +-- | Installs hls binaries @haskell-language-server-\@ +-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. +installHLSBin :: ( MonadMask m + , MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadFail m + ) + => GHCupDownloads + -> Version + -> PlatformRequest + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installHLSBin bDls ver pfreq = do + dlinfo <- lE $ getDownloadInfo HLS ver pfreq bDls + installHLSBindist dlinfo ver pfreq + + + + + --------------------- + --[ Set GHC/cabal ]-- + --------------------- + + + +-- | Set GHC symlinks in @~\/.ghcup\/bin@ for the requested GHC version. The behavior depends +-- on `SetGHC`: +-- +-- * SetGHCOnly: @~\/.ghcup\/bin\/ghc -> ~\/.ghcup\/ghc\/\\/bin\/ghc@ +-- * SetGHC_XY: @~\/.ghcup\/bin\/ghc-X.Y -> ~\/.ghcup\/ghc\/\\/bin\/ghc@ +-- * SetGHC_XYZ: @~\/.ghcup\/bin\/ghc-\ -> ~\/.ghcup\/ghc\/\\/bin\/ghc@ +-- +-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\\/share symlink@ +-- for 'SetGHCOnly' constructor. +setGHC :: ( MonadReader AppState m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadIO m + , MonadCatch m + ) + => GHCTargetVersion + -> SetGHC + -> Excepts '[NotInstalled] m GHCTargetVersion +setGHC ver sghc = do + let verBS = verToBS (_tvVersion ver) + ghcdir <- lift $ ghcupGHCDir ver + + whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver)) + + -- symlink destination + AppState { dirs = Dirs {..} } <- lift ask + liftIO $ createDirRecursive' binDir + + -- first delete the old symlinks (this fixes compatibility issues + -- with old ghcup) + case sghc of + SetGHCOnly -> liftE $ rmPlain (_tvTarget ver) + SetGHC_XY -> liftE $ rmMajorSymlinks ver + SetGHC_XYZ -> liftE $ rmMinorSymlinks ver + + -- for ghc tools (ghc, ghci, haddock, ...) + verfiles <- ghcToolFiles ver + forM_ verfiles $ \file -> do + mTargetFile <- case sghc of + SetGHCOnly -> pure $ Just file + SetGHC_XY -> do + v' <- + handle + (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) + $ fmap Just + $ getMajorMinorV (_tvVersion ver) + forM v' $ \(mj, mi) -> + let major' = E.encodeUtf8 $ intToText mj <> "." <> intToText mi + in parseRel (toFilePath file <> B.singleton _hyphen <> major') + SetGHC_XYZ -> + fmap Just $ parseRel (toFilePath file <> B.singleton _hyphen <> verBS) + + -- create symlink + forM mTargetFile $ \targetFile -> do + let fullF = binDir targetFile + destL <- lift $ ghcLinkDestination (toFilePath file) ver + lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath fullF}|] + liftIO $ createSymlink fullF destL + + -- create symlink for share dir + when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verBS + + pure ver + + where + + symlinkShareDir :: (MonadReader AppState m, MonadIO m, MonadLogger m) + => Path Abs + -> ByteString + -> m () + symlinkShareDir ghcdir verBS = do + AppState { dirs = Dirs {..} } <- ask + let destdir = baseDir + case sghc of + SetGHCOnly -> do + let sharedir = [rel|share|] + let fullsharedir = ghcdir sharedir + whenM (liftIO $ doesDirectoryExist fullsharedir) $ do + let fullF = destdir sharedir + let targetF = "./ghc/" <> verBS <> "/" <> toFilePath sharedir + $(logDebug) [i|rm -f #{fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + $(logDebug) [i|ln -s #{targetF} #{fullF}|] + liftIO $ createSymlink fullF targetF + _ -> pure () + + + +-- | Set the @~\/.ghcup\/bin\/cabal@ symlink. +setCabal :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) + => Version + -> Excepts '[NotInstalled] m () +setCabal ver = do + let verBS = verToBS ver + targetFile <- parseRel ("cabal-" <> verBS) + + -- symlink destination + AppState {dirs = Dirs {..}} <- lift ask + liftIO $ createDirRecursive' binDir + + whenM (liftIO $ not <$> doesFileExist (binDir targetFile)) + $ throwE + $ NotInstalled Cabal (GHCTargetVersion Nothing ver) + + let cabalbin = binDir [rel|cabal|] + + -- delete old file (may be binary or symlink) + lift $ $(logDebug) [i|rm -f #{toFilePath cabalbin}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile + cabalbin + + -- create symlink + let destL = toFilePath targetFile + lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath cabalbin}|] + liftIO $ createSymlink cabalbin destL + + pure () + + + + +-- | Set the haskell-language-server symlinks. +setHLS :: ( MonadCatch m + , MonadReader AppState m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadIO m + ) + => Version + -> Excepts '[NotInstalled] m () +setHLS ver = do + AppState { dirs = Dirs {..} } <- lift ask + liftIO $ createDirRecursive' binDir + + -- Delete old symlinks, since these might have different ghc versions than the + -- selected version, so we could end up with stray or incorrect symlinks. + oldSyms <- lift hlsSymlinks + forM_ oldSyms $ \f -> do + lift $ $(logDebug) [i|rm #{toFilePath (binDir f)}|] + liftIO $ deleteFile (binDir f) + + -- set haskell-language-server- symlinks + bins <- lift $ hlsServerBinaries ver + when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver) + + forM_ bins $ \f -> do + let destL = toFilePath f + target <- parseRel . head . B.split _tilde . toFilePath $ f + + lift $ $(logDebug) [i|rm -f #{toFilePath (binDir target)}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir target) + + lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath (binDir target)}|] + liftIO $ createSymlink (binDir target) destL + + -- set haskell-language-server-wrapper symlink + let destL = "haskell-language-server-wrapper-" <> verToBS ver + let wrapper = binDir [rel|haskell-language-server-wrapper|] + + lift $ $(logDebug) [i|rm -f #{toFilePath wrapper}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile wrapper + + lift $ $(logDebug) [i|ln -s #{destL} #{toFilePath wrapper}|] + liftIO $ createSymlink wrapper destL + + pure () + + + + + + ------------------ + --[ List tools ]-- + ------------------ + + +-- | Filter data type for 'listVersions'. +data ListCriteria = ListInstalled + | ListSet + deriving Show + +-- | A list result describes a single tool version +-- and various of its properties. +data ListResult = ListResult + { lTool :: Tool + , lVer :: Version + , lCross :: Maybe Text -- ^ currently only for GHC + , lTag :: [Tag] + , lInstalled :: Bool + , lSet :: Bool -- ^ currently active version + , fromSrc :: Bool -- ^ compiled from source + , lStray :: Bool -- ^ not in download info + , lNoBindist :: Bool -- ^ whether the version is available for this platform/arch + , hlsPowered :: Bool + } + deriving (Eq, Ord, Show) + + +-- | Extract all available tool versions and their tags. +availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag] +availableToolVersions av tool = view + (at tool % non Map.empty % to (fmap _viTags)) + av + + +-- | List all versions from the download info, as well as stray +-- versions. +listVersions :: ( MonadCatch m + , MonadLogger m + , MonadThrow m + , MonadLogger m + , MonadIO m + , MonadReader AppState m + ) + => GHCupDownloads + -> Maybe Tool + -> Maybe ListCriteria + -> PlatformRequest + -> m [ListResult] +listVersions av lt' criteria pfreq = do + -- some annoying work to avoid too much repeated IO + cSet <- cabalSet + cabals <- getInstalledCabals' cSet + hlsSet' <- hlsSet + hlses <- getInstalledHLSs + + go lt' cSet cabals hlsSet' hlses + where + go lt cSet cabals hlsSet' hlses = do + case lt of + Just t -> do + -- get versions from GHCupDownloads + let avTools = availableToolVersions av t + lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses) + + case t of + GHC -> do + slr <- strayGHCs avTools + pure (sort (slr ++ lr)) + Cabal -> do + slr <- strayCabals avTools cSet cabals + pure (sort (slr ++ lr)) + HLS -> do + slr <- strayHLS avTools + pure (sort (slr ++ lr)) + GHCup -> pure lr + Nothing -> do + ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses + cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses + hlsvers <- go (Just HLS) cSet cabals hlsSet' hlses + ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses + pure (ghcvers <> cabalvers <> hlsvers <> ghcupvers) + strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m) + => Map.Map Version [Tag] + -> m [ListResult] + strayGHCs avTools = do + ghcs <- getInstalledGHCs + fmap catMaybes $ forM ghcs $ \case + Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do + case Map.lookup _tvVersion avTools of + Just _ -> pure Nothing + Nothing -> do + lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing + fromSrc <- ghcSrcInstalled tver + hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions + pure $ Just $ ListResult + { lTool = GHC + , lVer = _tvVersion + , lCross = Nothing + , lTag = [] + , lInstalled = True + , lStray = isNothing (Map.lookup _tvVersion avTools) + , lNoBindist = False + , .. + } + Right tver@GHCTargetVersion{ .. } -> do + lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget + fromSrc <- ghcSrcInstalled tver + hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions + pure $ Just $ ListResult + { lTool = GHC + , lVer = _tvVersion + , lCross = _tvTarget + , lTag = [] + , lInstalled = True + , lStray = True -- NOTE: cross currently cannot be installed via bindist + , lNoBindist = False + , .. + } + Left e -> do + $(logWarn) + [i|Could not parse version of stray directory #{toFilePath e}|] + pure Nothing + + strayCabals :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m) + => Map.Map Version [Tag] + -> Maybe Version + -> [Either (Path Rel) Version] + -> m [ListResult] + strayCabals avTools cSet cabals = do + fmap catMaybes $ forM cabals $ \case + Right ver -> + case Map.lookup ver avTools of + Just _ -> pure Nothing + Nothing -> do + let lSet = cSet == Just ver + pure $ Just $ ListResult + { lTool = Cabal + , lVer = ver + , lCross = Nothing + , lTag = [] + , lInstalled = True + , lStray = isNothing (Map.lookup ver avTools) + , lNoBindist = False + , fromSrc = False -- actually, we don't know :> + , hlsPowered = False + , .. + } + Left e -> do + $(logWarn) + [i|Could not parse version of stray directory #{toFilePath e}|] + pure Nothing + + strayHLS :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m) + => Map.Map Version [Tag] + -> m [ListResult] + strayHLS avTools = do + hlss <- getInstalledHLSs + fmap catMaybes $ forM hlss $ \case + Right ver -> + case Map.lookup ver avTools of + Just _ -> pure Nothing + Nothing -> do + lSet <- fmap (== Just ver) hlsSet + pure $ Just $ ListResult + { lTool = HLS + , lVer = ver + , lCross = Nothing + , lTag = [] + , lInstalled = True + , lStray = isNothing (Map.lookup ver avTools) + , lNoBindist = False + , fromSrc = False -- actually, we don't know :> + , hlsPowered = False + , .. + } + Left e -> do + $(logWarn) + [i|Could not parse version of stray directory #{toFilePath e}|] + pure Nothing + + -- NOTE: this are not cross ones, because no bindists + toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) + => Tool + -> Maybe Version + -> [Either (Path Rel) Version] + -> Maybe Version + -> [Either (Path Rel) Version] + -> (Version, [Tag]) + -> m ListResult + toListResult t cSet cabals hlsSet' hlses (v, tags) = case t of + GHC -> do + let lNoBindist = isLeft $ getDownloadInfo GHC v pfreq av + let tver = mkTVer v + lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing + lInstalled <- ghcInstalled tver + fromSrc <- ghcSrcInstalled tver + hlsPowered <- fmap (elem v) hlsGHCVersions + pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. } + Cabal -> do + let lNoBindist = isLeft $ getDownloadInfo Cabal v pfreq av + let lSet = cSet == Just v + let lInstalled = elem v $ rights cabals + pure ListResult { lVer = v + , lCross = Nothing + , lTag = tags + , lTool = t + , fromSrc = False + , lStray = False + , hlsPowered = False + , .. + } + GHCup -> do + let lSet = prettyPVP ghcUpVer == prettyVer v + let lInstalled = lSet + pure ListResult { lVer = v + , lTag = tags + , lCross = Nothing + , lTool = t + , fromSrc = False + , lStray = False + , lNoBindist = False + , hlsPowered = False + , .. + } + HLS -> do + let lNoBindist = isLeft $ getDownloadInfo HLS v pfreq av + let lSet = hlsSet' == Just v + let lInstalled = elem v $ rights hlses + pure ListResult { lVer = v + , lCross = Nothing + , lTag = tags + , lTool = t + , fromSrc = False + , lStray = False + , hlsPowered = False + , .. + } + + + filter' :: [ListResult] -> [ListResult] + filter' lr = case criteria of + Nothing -> lr + Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr + Just ListSet -> filter (\ListResult {..} -> lSet) lr + + + + -------------------- + --[ GHC/cabal rm ]-- + -------------------- + + +-- | Delete a ghc version and all its symlinks. +-- +-- This may leave GHCup without a "set" version. +-- Will try to fix the ghc-x.y symlink after removal (e.g. to an +-- older version). +rmGHCVer :: ( MonadReader AppState m + , MonadThrow m + , MonadLogger m + , MonadIO m + , MonadFail m + , MonadCatch m + ) + => GHCTargetVersion + -> Excepts '[NotInstalled] m () +rmGHCVer ver = do + isSetGHC <- lift $ fmap (== Just ver) $ ghcSet (_tvTarget ver) + + whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC ver)) + dir <- lift $ ghcupGHCDir ver + + -- this isn't atomic, order matters + when isSetGHC $ do + lift $ $(logInfo) [i|Removing ghc symlinks|] + liftE $ rmPlain (_tvTarget ver) + + lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|] + liftE $ rmMinorSymlinks ver + + lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|] + -- first remove + handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver + -- then fix them (e.g. with an earlier version) + + lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|] + liftIO $ deleteDirRecursive dir + + v' <- + handle + (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) + $ fmap Just + $ getMajorMinorV (_tvVersion ver) + forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver)) + >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) + + AppState { dirs = Dirs {..} } <- lift ask + + liftIO + $ hideError doesNotExistErrorType + $ deleteFile (baseDir [rel|share|]) + + +-- | Delete a cabal version. Will try to fix the @cabal@ symlink +-- after removal (e.g. setting it to an older version). +rmCabalVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m) + => Version + -> Excepts '[NotInstalled] m () +rmCabalVer ver = do + whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (GHCTargetVersion Nothing ver)) + + cSet <- lift cabalSet + + AppState {dirs = Dirs {..}} <- lift ask + + cabalFile <- lift $ parseRel ("cabal-" <> verToBS ver) + liftIO $ hideError doesNotExistErrorType $ deleteFile (binDir cabalFile) + + when (Just ver == cSet) $ do + cVers <- lift $ fmap rights getInstalledCabals + case headMay . reverse . sort $ cVers of + Just latestver -> setCabal latestver + Nothing -> liftIO $ hideError doesNotExistErrorType $ deleteFile + (binDir [rel|cabal|]) + + +-- | Delete a hls version. Will try to fix the hls symlinks +-- after removal (e.g. setting it to an older version). +rmHLSVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch m) + => Version + -> Excepts '[NotInstalled] m () +rmHLSVer ver = do + whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)) + + isHlsSet <- lift hlsSet + + AppState {dirs = Dirs {..}} <- lift ask + + bins <- lift $ hlsAllBinaries ver + forM_ bins $ \f -> liftIO $ deleteFile (binDir f) + + when (Just ver == isHlsSet) $ do + -- delete all set symlinks + oldSyms <- lift hlsSymlinks + forM_ oldSyms $ \f -> do + lift $ $(logDebug) [i|rm #{toFilePath (binDir f)}|] + liftIO $ deleteFile (binDir f) + -- set latest hls + hlsVers <- lift $ fmap rights getInstalledHLSs + case headMay . reverse . sort $ hlsVers of + Just latestver -> setHLS latestver + Nothing -> pure () + + + + + ------------------ + --[ Debug info ]-- + ------------------ + + +getDebugInfo :: (MonadReader AppState m, MonadLogger m, MonadCatch m, MonadIO m) + => Excepts + '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound] + m + DebugInfo +getDebugInfo = do + AppState {dirs = Dirs {..}} <- lift ask + let diBaseDir = baseDir + let diBinDir = binDir + diGHCDir <- lift ghcupGHCBaseDir + let diCacheDir = cacheDir + diArch <- lE getArchitecture + diPlatform <- liftE getPlatform + pure $ DebugInfo { .. } + + + + + --------------- + --[ Compile ]-- + --------------- + + +-- | Compile a GHC from source. This behaves wrt symlinks and installation +-- the same as 'installGHCBin'. +compileGHC :: ( MonadMask m + , MonadReader AppState m + , MonadThrow m + , MonadResource m + , MonadLogger m + , MonadIO m + , MonadFail m + ) + => GHCupDownloads + -> GHCTargetVersion -- ^ version to install + -> Either Version (Path Abs) -- ^ version to bootstrap with + -> Maybe Int -- ^ jobs + -> Maybe (Path Abs) -- ^ build config + -> Maybe (Path Abs) -- ^ patch directory + -> [Text] -- ^ additional args to ./configure + -> PlatformRequest + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , GHCupSetError + , NoDownload + , NotFoundInPATH + , PatchFailed + , UnknownArchive + , TarDirDoesNotExist + , NotInstalled +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +compileGHC dls tver bstrap jobs mbuildConfig patchdir aargs pfreq@PlatformRequest{..} + = do + lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|] + + alreadyInstalled <- lift $ ghcInstalled tver + alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver) + + -- download source tarball + dlInfo <- + preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls + ?? NoDownload + dl <- liftE $ downloadCached dlInfo Nothing + + -- unpack + tmpUnpack <- lift mkGhcupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ liftIO $ darwinNotarization _rPlatform tmpUnpack + + bghc <- case bstrap of + Right g -> pure $ Right g + Left bver -> Left <$> parseRel ("ghc-" <> verToBS bver) + workdir <- maybe (pure tmpUnpack) + (liftE . intoSubdir tmpUnpack) + (view dlSubdir dlInfo) + ghcdir <- lift $ ghcupGHCDir tver + + (bindist, bmk) <- liftE $ runBuildAction + tmpUnpack + Nothing + (do + b <- compileBindist bghc ghcdir workdir + bmk <- liftIO $ readFileStrict (build_mk workdir) + pure (b, bmk) + ) + + when alreadyInstalled $ do + lift $ $(logInfo) [i|Deleting existing installation|] + liftE $ rmGHCVer tver + liftE $ installPackedGHC bindist + (view dlSubdir dlInfo) + ghcdir + (tver ^. tvVersion) + pfreq + + liftIO $ writeFile (ghcdir ghcUpSrcBuiltFile) (Just newFilePerms) bmk + + reThrowAll GHCupSetError $ postGHCInstall tver + + -- restore + when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly + + where + defaultConf = case _tvTarget tver of + Nothing -> [s| +V=0 +BUILD_MAN = NO +BUILD_SPHINX_HTML = NO +BUILD_SPHINX_PDF = NO +HADDOCK_DOCS = YES|] + Just _ -> [s| +V=0 +BUILD_MAN = NO +BUILD_SPHINX_HTML = NO +BUILD_SPHINX_PDF = NO +HADDOCK_DOCS = NO +Stage1Only = YES|] + + compileBindist :: ( MonadReader AppState m + , MonadThrow m + , MonadCatch m + , MonadLogger m + , MonadIO m + , MonadFail m + ) + => Either (Path Rel) (Path Abs) + -> Path Abs + -> Path Abs + -> Excepts + '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError] + m + (Path Abs) -- ^ output path of bindist + compileBindist bghc ghcdir workdir = do + lift $ $(logInfo) [i|configuring build|] + liftE checkBuildConfig + + AppState { dirs = Dirs {..} } <- lift ask + + forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir + + cEnv <- liftIO getEnvironment + + if + | _tvVersion tver >= [vver|8.8.0|] -> do + bghcPath <- case bghc of + Right ghc' -> pure ghc' + Left bver -> do + spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath + liftIO (searchPath spaths bver) !? NotFoundInPATH bver + lEM $ execLogged + "./configure" + False + ( ["--prefix=" <> toFilePath ghcdir] + ++ maybe mempty + (\x -> ["--target=" <> E.encodeUtf8 x]) + (_tvTarget tver) + ++ fmap E.encodeUtf8 aargs + ) + [rel|ghc-conf|] + (Just workdir) + (Just (("GHC", toFilePath bghcPath) : cEnv)) + | otherwise -> do + lEM $ execLogged + "./configure" + False + ( [ "--prefix=" <> toFilePath ghcdir + , "--with-ghc=" <> either toFilePath toFilePath bghc + ] + ++ maybe mempty + (\x -> ["--target=" <> E.encodeUtf8 x]) + (_tvTarget tver) + ++ fmap E.encodeUtf8 aargs + ) + [rel|ghc-conf|] + (Just workdir) + (Just cEnv) + + case mbuildConfig of + Just bc -> liftIOException + doesNotExistErrorType + (FileDoesNotExistError $ toFilePath bc) + (liftIO $ copyFile bc (build_mk workdir) Overwrite) + Nothing -> + liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf + + lift $ $(logInfo) [i|Building (this may take a while)...|] + lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir) + + lift $ $(logInfo) [i|Creating bindist...|] + lEM $ make ["binary-dist"] (Just workdir) + [tar] <- liftIO $ findFiles + workdir + (makeRegexOpts compExtended + execBlank + ([s|^ghc-.*\.tar\..*$|] :: ByteString) + ) + c <- liftIO $ readFile (workdir tar) + cDigest <- + fmap (T.take 8) + . lift + . throwEither + . E.decodeUtf8' + . B16.encode + . SHA256.hashlazy + $ c + tarName <- + parseRel + [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|] + let tarPath = cacheDir tarName + handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir tar) + tarPath + Strict + lift $ $(logInfo) [i|Copied bindist to #{tarPath}|] + pure tarPath + + build_mk workdir = workdir [rel|mk/build.mk|] + + checkBuildConfig :: (MonadCatch m, MonadIO m) + => Excepts + '[FileDoesNotExistError, InvalidBuildConfig] + m + () + checkBuildConfig = do + c <- case mbuildConfig of + Just bc -> do + BL.toStrict <$> liftIOException + doesNotExistErrorType + (FileDoesNotExistError $ toFilePath bc) + (liftIO $ readFile bc) + Nothing -> pure defaultConf + let lines' = fmap T.strip . T.lines $ decUTF8Safe c + + -- for cross, we need Stage1Only + case _tvTarget tver of + Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE + (InvalidBuildConfig + [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|] + ) + Nothing -> pure () + + + + + --------------------- + --[ Upgrade GHCup ]-- + --------------------- + + +-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@, +-- if no path is provided. +upgradeGHCup :: ( MonadMask m + , MonadReader AppState m + , MonadCatch m + , MonadLogger m + , MonadThrow m + , MonadResource m + , MonadIO m + ) + => GHCupDownloads + -> Maybe (Path Abs) -- ^ full file destination to write ghcup into + -> Bool -- ^ whether to force update regardless + -- of currently installed version + -> PlatformRequest + -> Excepts + '[ CopyError + , DigestError + , DownloadFailed + , NoDownload + , NoUpdate + ] + m + Version +upgradeGHCup dls mtarget force pfreq = do + AppState {dirs = Dirs {..}} <- lift ask + lift $ $(logInfo) [i|Upgrading GHCup...|] + let latestVer = fromJust $ fst <$> getLatest dls GHCup + when (not force && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate + dli <- lE $ getDownloadInfo GHCup latestVer pfreq dls + tmp <- lift withGHCupTmpDir + let fn = [rel|ghcup|] + p <- liftE $ download dli tmp (Just fn) + let destDir = dirname destFile + destFile = fromMaybe (binDir fn) mtarget + lift $ $(logDebug) [i|mkdir -p #{toFilePath destDir}|] + liftIO $ createDirRecursive' destDir + lift $ $(logDebug) [i|rm -f #{toFilePath destFile}|] + liftIO $ hideError NoSuchThing $ deleteFile destFile + lift $ $(logDebug) [i|cp #{toFilePath p} #{toFilePath destFile}|] + handleIO (throwE . CopyError . show) $ liftIO $ copyFile p + destFile + Overwrite + lift $ chmod_755 destFile + + liftIO (isInPath destFile) >>= \b -> unless b $ + lift $ $(logWarn) [i|"#{toFilePath (dirname destFile)}" is not in PATH! You have to add it in order to use ghcup.|] + liftIO (isShadowed destFile) >>= \case + Nothing -> pure () + Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{toFilePath pa}". The upgrade will not be in effect, unless you remove "#{toFilePath pa}" or make sure "#{toFilePath destDir}" comes before "#{toFilePath (dirname pa)}" in PATH.|] + + pure latestVer + + + + ------------- + --[ Other ]-- + ------------- + + +-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for +-- both installing from source and bindist. +postGHCInstall :: ( MonadReader AppState m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadIO m + , MonadCatch m + ) + => GHCTargetVersion + -> Excepts '[NotInstalled] m () +postGHCInstall ver@GHCTargetVersion {..} = do + void $ liftE $ setGHC ver SetGHC_XYZ + + -- Create ghc-x.y symlinks. This may not be the current + -- version, create it regardless. + v' <- + handle (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) + $ fmap Just + $ getMajorMinorV _tvVersion + forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget) + >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY) + diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Download.hs @@ -0,0 +1,522 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + + +{-| +Module : GHCup.Download +Description : Downloading +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +Module for handling all download related functions. + +Generally we support downloading via: + + - curl (default) + - wget + - internal downloader (only when compiled) +-} +module GHCup.Download where + +#if defined(INTERNAL_DOWNLOADER) +import GHCup.Download.IOStreams +import GHCup.Download.Utils +#endif +import GHCup.Errors +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Types.Optics +import GHCup.Utils +import GHCup.Utils.File +import GHCup.Utils.Prelude +import GHCup.Version + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail ( MonadFail ) +#endif +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.Resource + hiding ( throwM ) +import Data.Aeson +import Data.Bifunctor +import Data.ByteString ( ByteString ) +#if defined(INTERNAL_DOWNLOADER) +import Data.CaseInsensitive ( CI ) +#endif +import Data.List ( find ) +import Data.Maybe +import Data.String.Interpolate +import Data.Time.Clock +import Data.Time.Clock.POSIX +#if defined(INTERNAL_DOWNLOADER) +import Data.Time.Format +#endif +import Data.Versions +import Data.Word8 +import GHC.IO.Exception +import HPath +import HPath.IO as HIO hiding ( hideError ) +import Haskus.Utils.Variant.Excepts +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import System.IO.Error +import System.Posix.Env.ByteString ( getEnv ) +import URI.ByteString + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Lazy as L +import qualified Data.Map.Strict as M +#if defined(INTERNAL_DOWNLOADER) +import qualified Data.CaseInsensitive as CI +import qualified Data.Text as T +#endif +import qualified Data.Text.Encoding as E +import qualified Data.Yaml as Y +import qualified System.Posix.Files.ByteString as PF +import qualified System.Posix.RawFilePath.Directory + as RD + + + + + + + ------------------ + --[ High-level ]-- + ------------------ + + + +-- | Downloads the download information! But only if we need to ;P +getDownloadsF :: ( FromJSONKey Tool + , FromJSONKey Version + , FromJSON VersionInfo + , MonadIO m + , MonadCatch m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadReader AppState m + ) + => URLSource + -> Excepts + '[JSONError , DownloadFailed , FileDoesNotExistError] + m + GHCupInfo +getDownloadsF urlSource = do + case urlSource of + GHCupURL -> liftE getBase + (OwnSource url) -> do + bs <- reThrowAll DownloadFailed $ downloadBS url + lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs) + (OwnSpec av) -> pure av + (AddSource (Left ext)) -> do + base <- liftE getBase + pure (mergeGhcupInfo base ext) + (AddSource (Right uri)) -> do + base <- liftE getBase + bsExt <- reThrowAll DownloadFailed $ downloadBS uri + ext <- lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bsExt) + pure (mergeGhcupInfo base ext) + + where + + mergeGhcupInfo :: GHCupInfo -- ^ base to merge with + -> GHCupInfo -- ^ extension overwriting the base + -> GHCupInfo + mergeGhcupInfo (GHCupInfo tr base) (GHCupInfo _ ext) = + let new = M.mapWithKey (\k a -> case M.lookup k ext of + Just a' -> M.union a' a + Nothing -> a + ) base + in GHCupInfo tr new + + +readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m) + => Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo +readFromCache = do + AppState {dirs = Dirs {..}} <- lift ask + lift $ $(logWarn) + [i|Could not get download info, trying cached version (this may not be recent!)|] + let path = view pathL' ghcupURL + yaml_file <- (cacheDir ) <$> urlBaseName path + bs <- + handleIO' NoSuchThing + (\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file)) + $ liftIO + $ readFile yaml_file + lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs) + + +getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m) + => Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo +getBase = + handleIO (\_ -> readFromCache) + $ catchE @_ @'[JSONError, FileDoesNotExistError] + (\(DownloadFailed _) -> readFromCache) + (reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed (smartDl ghcupURL) + >>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . first show . Y.decodeEither' . L.toStrict)) + where + -- First check if the json file is in the ~/.ghcup/cache dir + -- and check it's access time. If it has been accessed within the + -- last 5 minutes, just reuse it. + -- + -- If not, then send a HEAD request and check for modification time. + -- Only download the file if the modification time is newer + -- than the local file. + -- + -- Always save the local file with the mod time of the remote file. + smartDl :: forall m1 + . ( MonadCatch m1 + , MonadIO m1 + , MonadFail m1 + , MonadLogger m1 + , MonadReader AppState m1 + ) + => URI + -> Excepts + '[ FileDoesNotExistError + , HTTPStatusError + , URIParseError + , UnsupportedScheme + , NoLocationHeader + , TooManyRedirs + , ProcessError + ] + m1 + L.ByteString + smartDl uri' = do + AppState {dirs = Dirs {..}} <- lift ask + let path = view pathL' uri' + json_file <- (cacheDir ) <$> urlBaseName path + e <- liftIO $ doesFileExist json_file + if e + then do + accessTime <- + PF.accessTimeHiRes + <$> liftIO (PF.getFileStatus (toFilePath json_file)) + currentTime <- liftIO getPOSIXTime + + -- access time won't work on most linuxes, but we can try regardless + if (currentTime - accessTime) > 300 + then do -- no access in last 5 minutes, re-check upstream mod time + getModTime >>= \case + Just modTime -> do + fileMod <- liftIO $ getModificationTime json_file + if modTime > fileMod + then dlWithMod modTime json_file + else liftIO $ readFile json_file + Nothing -> do + lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|] + dlWithoutMod json_file + else -- access in less than 5 minutes, re-use file + liftIO $ readFile json_file + else do + liftIO $ createDirRecursive' cacheDir + getModTime >>= \case + Just modTime -> dlWithMod modTime json_file + Nothing -> do + -- although we don't know last-modified, we still save + -- it to a file, so we might use it in offline mode + lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|] + dlWithoutMod json_file + + where + dlWithMod modTime json_file = do + bs <- liftE $ downloadBS uri' + liftIO $ writeFileWithModTime modTime json_file bs + pure bs + dlWithoutMod json_file = do + bs <- liftE $ downloadBS uri' + liftIO $ hideError doesNotExistErrorType $ deleteFile json_file + liftIO $ writeFileL json_file (Just newFilePerms) bs + liftIO $ setModificationTime json_file (fromIntegral @Int 0) + pure bs + + + getModTime = do +#if !defined(INTERNAL_DOWNLOADER) + pure Nothing +#else + headers <- + handleIO (\_ -> pure mempty) + $ liftE + $ ( catchAllE + (\_ -> + pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString) + ) + $ getHead uri' + ) + pure $ parseModifiedHeader headers + + parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime + parseModifiedHeader headers = + (M.lookup (CI.mk "Last-Modified") headers) >>= \h -> parseTimeM + True + defaultTimeLocale + "%a, %d %b %Y %H:%M:%S %Z" + (T.unpack . decUTF8Safe $ h) + +#endif + + writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO () + writeFileWithModTime utctime path content = do + let mod_time = utcTimeToPOSIXSeconds utctime + writeFileL path (Just newFilePerms) content + setModificationTimeHiRes path mod_time + + +getDownloadInfo :: Tool + -> Version + -- ^ tool version + -> PlatformRequest + -> GHCupDownloads + -> Either NoDownload DownloadInfo +getDownloadInfo t v (PlatformRequest a p mv) dls = maybe + (Left NoDownload) + Right + (case p of + -- non-musl won't work on alpine + Linux Alpine -> with_distro <|> without_distro_ver + _ -> with_distro <|> without_distro_ver <|> without_distro + ) + + where + with_distro = distro_preview id id + without_distro_ver = distro_preview id (const Nothing) + without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing) + + distro_preview f g = + let platformVersionSpec = + preview (ix t % ix v % viArch % ix a % ix (f p)) dls + mv' = g mv + in fmap snd + . find + (\(mverRange, _) -> maybe + (isNothing mv') + (\range -> maybe False (`versionRange` range) mv') + mverRange + ) + . M.toList + =<< platformVersionSpec + + +-- | Tries to download from the given http or https url +-- and saves the result in continuous memory into a file. +-- If the filename is not provided, then we: +-- 1. try to guess the filename from the url path +-- 2. otherwise create a random file +-- +-- The file must not exist. +download :: ( MonadMask m + , MonadReader AppState m + , MonadThrow m + , MonadLogger m + , MonadIO m + ) + => DownloadInfo + -> Path Abs -- ^ destination dir + -> Maybe (Path Rel) -- ^ optional filename + -> Excepts '[DigestError , DownloadFailed] m (Path Abs) +download dli dest mfn + | scheme == "https" = dl + | scheme == "http" = dl + | scheme == "file" = cp + | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) + + where + scheme = view (dlUri % uriSchemeL' % schemeBSL') dli + cp = do + -- destination dir must exist + liftIO $ createDirRecursive' dest + destFile <- getDestFile + fromFile <- parseAbs path + liftIO $ copyFile fromFile destFile Strict + pure destFile + dl = do + let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli)) + lift $ $(logInfo) [i|downloading: #{uri'}|] + + -- destination dir must exist + liftIO $ createDirRecursive' dest + destFile <- getDestFile + + -- download + flip onException + (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile) + $ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme] + (\e -> + liftIO (hideError doesNotExistErrorType $ deleteFile destFile) + >> (throwE . DownloadFailed $ e) + ) $ do + lift getDownloader >>= \case + Curl -> do + o' <- liftIO getCurlOpts + liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True + (o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing + Wget -> do + o' <- liftIO getWgetOpts + liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" True + (o' ++ ["-O", toFilePath destFile , serializeURIRef' $ view dlUri dli]) Nothing Nothing +#if defined(INTERNAL_DOWNLOADER) + Internal -> do + (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli) + liftE $ downloadToFile https host fullPath port destFile +#endif + + liftE $ checkDigest dli destFile + pure destFile + + -- Manage to find a file we can write the body into. + getDestFile :: MonadThrow m => m (Path Abs) + getDestFile = maybe (urlBaseName path <&> (dest )) (pure . (dest )) mfn + + path = view (dlUri % pathL') dli + + +-- | Download into tmpdir or use cached version, if it exists. If filename +-- is omitted, infers the filename from the url. +downloadCached :: ( MonadMask m + , MonadResource m + , MonadThrow m + , MonadLogger m + , MonadIO m + , MonadReader AppState m + ) + => DownloadInfo + -> Maybe (Path Rel) -- ^ optional filename + -> Excepts '[DigestError , DownloadFailed] m (Path Abs) +downloadCached dli mfn = do + cache <- lift getCache + case cache of + True -> do + AppState {dirs = Dirs {..}} <- lift ask + fn <- maybe (urlBaseName $ view (dlUri % pathL') dli) pure mfn + let cachfile = cacheDir fn + fileExists <- liftIO $ doesFileExist cachfile + if + | fileExists -> do + liftE $ checkDigest dli cachfile + pure cachfile + | otherwise -> liftE $ download dli cacheDir mfn + False -> do + tmp <- lift withGHCupTmpDir + liftE $ download dli tmp mfn + + + + + ------------------ + --[ Low-level ]-- + ------------------ + + + + +-- | This is used for downloading the JSON. +downloadBS :: (MonadReader AppState m, MonadCatch m, MonadIO m, MonadLogger m) + => URI + -> Excepts + '[ FileDoesNotExistError + , HTTPStatusError + , URIParseError + , UnsupportedScheme + , NoLocationHeader + , TooManyRedirs + , ProcessError + ] + m + L.ByteString +downloadBS uri' + | scheme == "https" + = dl True + | scheme == "http" + = dl False + | scheme == "file" + = liftIOException doesNotExistErrorType (FileDoesNotExistError path) + (liftIO $ RD.readFile path) + | otherwise + = throwE UnsupportedScheme + + where + scheme = view (uriSchemeL' % schemeBSL') uri' + path = view pathL' uri' +#if defined(INTERNAL_DOWNLOADER) + dl https = do +#else + dl _ = do +#endif + lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|] + lift getDownloader >>= \case + Curl -> do + o' <- liftIO getCurlOpts + let exe = [rel|curl|] + args = o' ++ ["-sSfL", serializeURIRef' uri'] + liftIO (executeOut exe args Nothing) >>= \case + CapturedProcess ExitSuccess stdout _ -> do + pure $ L.fromStrict stdout + CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args + Wget -> do + o' <- liftIO getWgetOpts + let exe = [rel|wget|] + args = o' ++ ["-qO-", serializeURIRef' uri'] + liftIO (executeOut exe args Nothing) >>= \case + CapturedProcess ExitSuccess stdout _ -> do + pure $ L.fromStrict stdout + CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args +#if defined(INTERNAL_DOWNLOADER) + Internal -> do + (_, host', fullPath', port') <- liftE $ uriToQuadruple uri' + liftE $ downloadBS' https host' fullPath' port' +#endif + + +checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m) + => DownloadInfo + -> Path Abs + -> Excepts '[DigestError] m () +checkDigest dli file = do + verify <- lift ask <&> (not . noVerify . settings) + when verify $ do + p' <- toFilePath <$> basename file + lift $ $(logInfo) [i|verifying digest of: #{p'}|] + c <- liftIO $ readFile file + cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c + let eDigest = view dlHash dli + when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest) + + +-- | Get additional curl args from env. This is an undocumented option. +getCurlOpts :: IO [ByteString] +getCurlOpts = + getEnv "GHCUP_CURL_OPTS" >>= \case + Just r -> pure $ BS.split _space r + Nothing -> pure [] + + +-- | Get additional wget args from env. This is an undocumented option. +getWgetOpts :: IO [ByteString] +getWgetOpts = + getEnv "GHCUP_WGET_OPTS" >>= \case + Just r -> pure $ BS.split _space r + Nothing -> pure [] + diff --git a/lib/GHCup/Download/IOStreams.hs b/lib/GHCup/Download/IOStreams.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Download/IOStreams.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + + +module GHCup.Download.IOStreams where + + +import GHCup.Download.Utils +import GHCup.Errors +import GHCup.Types.Optics +import GHCup.Types.JSON ( ) +import GHCup.Utils.File +import GHCup.Utils.Prelude + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Reader +import Data.ByteString ( ByteString ) +import Data.ByteString.Builder +import Data.CaseInsensitive ( CI ) +import Data.IORef +import Data.Maybe +import Data.Text.Read +import HPath +import HPath.IO as HIO +import Haskus.Utils.Variant.Excepts +import Network.Http.Client hiding ( URL ) +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import "unix" System.Posix.IO.ByteString + hiding ( fdWrite ) +import "unix-bytestring" System.Posix.IO.ByteString + ( fdWrite ) +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) + downloadInternal False https host path port stepper + 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) + -> Path Abs -- ^ destination file to create and write to + -> Excepts '[DownloadFailed] m () +downloadToFile https host fullPath port destFile = do + fd <- liftIO $ createRegularFileFd newFilePerms destFile + let stepper = fdWrite fd + flip finally (liftIO $ closeFd fd) + $ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper + + +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 + -> Excepts + '[ HTTPStatusError + , URIParseError + , UnsupportedScheme + , NoLocationHeader + , TooManyRedirs + ] + m + () +downloadInternal = go (5 :: Int) + + where + go redirs progressBar https host path port consumer = do + r <- liftIO $ withConnection' https host port action + veitherToExcepts r >>= \case + Just r' -> + if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs + Nothing -> pure () + where + action c = do + let q = buildRequest1 $ http GET path + + sendRequest c q emptyBody + + receiveResponse + c + (\r i' -> runE $ do + let scode = getStatusCode r + if + | scode >= 200 && scode < 300 -> downloadStream r i' >> pure Nothing + | scode >= 300 && scode < 400 -> case getHeader r "Location" of + Just r' -> pure $ Just r' + Nothing -> throwE NoLocationHeader + | otherwise -> throwE $ HTTPStatusError scode + ) + + followRedirectURL bs = case parseURI strictURIParserOptions bs of + Right uri' -> do + (https', host', fullPath', port') <- liftE $ uriToQuadruple uri' + go (redirs - 1) progressBar https' host' fullPath' port' consumer + Left e -> throwE e + + downloadStream r i' = do + let size = case getHeader r "Content-Length" of + Just x' -> case decimal $ decUTF8Safe x' of + Left _ -> 0 + Right (r', _) -> r' + Nothing -> 0 + + mpb <- if progressBar + then Just <$> liftIO (newProgressBar defStyle 10 (Progress 0 size ())) + 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 + + +getHead :: (MonadCatch m, MonadIO m) + => URI + -> Excepts + '[ HTTPStatusError + , URIParseError + , UnsupportedScheme + , NoLocationHeader + , TooManyRedirs + , ProcessError + ] + m + (M.Map (CI ByteString) ByteString) +getHead uri' | scheme == "https" = head' True + | scheme == "http" = head' False + | otherwise = throwE UnsupportedScheme + + where + scheme = view (uriSchemeL' % schemeBSL') uri' + head' https = do + (_, host', fullPath', port') <- liftE $ uriToQuadruple uri' + liftE $ headInternal https host' fullPath' port' + + +headInternal :: MonadIO m + => Bool -- ^ https? + -> ByteString -- ^ host + -> ByteString -- ^ path with query + -> Maybe Int -- ^ optional port + -> Excepts + '[ HTTPStatusError + , URIParseError + , UnsupportedScheme + , TooManyRedirs + , NoLocationHeader + ] + m + (M.Map (CI ByteString) ByteString) +headInternal = go (5 :: Int) + + where + go redirs https host path port = do + r <- liftIO $ withConnection' https host port action + veitherToExcepts r >>= \case + Left r' -> + if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs + Right hs -> pure hs + where + + action c = do + let q = buildRequest1 $ http HEAD path + + sendRequest c q emptyBody + + unsafeReceiveResponse + c + (\r _ -> runE $ do + let scode = getStatusCode r + if + | scode >= 200 && scode < 300 -> do + let headers = getHeaderMap r + pure $ Right headers + | scode >= 300 && scode < 400 -> case getHeader r "Location" of + Just r' -> pure $ Left r' + Nothing -> throwE NoLocationHeader + | otherwise -> throwE $ HTTPStatusError scode + ) + + followRedirectURL bs = case parseURI strictURIParserOptions bs of + Right uri' -> do + (https', host', fullPath', port') <- liftE $ uriToQuadruple uri' + go (redirs - 1) https' host' fullPath' port' + Left e -> throwE e + + +withConnection' :: Bool + -> ByteString + -> 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) diff --git a/lib/GHCup/Download/Utils.hs b/lib/GHCup/Download/Utils.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Download/Utils.hs @@ -0,0 +1,60 @@ +{-# 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 + diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Errors.hs @@ -0,0 +1,342 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} + +{-| +Module : GHCup.Errors +Description : GHCup error types +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} +module GHCup.Errors where + +import GHCup.Types +import GHCup.Utils.Prelude + +#if !defined(TAR) +import Codec.Archive +#endif +import Control.Exception.Safe +import Data.ByteString ( ByteString ) +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Versions +import HPath +import Haskus.Utils.Variant +import Text.PrettyPrint +import Text.PrettyPrint.HughesPJClass +import URI.ByteString + + + + ------------------------ + --[ Low-level errors ]-- + ------------------------ + + + +-- | A compatible platform could not be found. +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 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 ByteString + deriving Show + +instance Pretty UnknownArchive where + pPrint (UnknownArchive file) = + text [i|The archive format is unknown. We don't know how to extract the file "#{decUTF8Safe 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 [i|of tool "#{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 [i|Unable to find next (the one after the currently set one) version of tool "#{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') = + text [i|#{tool}-#{prettyShow ver'} is already installed|] + +-- | 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 + deriving Show + +instance Pretty NotInstalled where + pPrint (NotInstalled tool ver) = + text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|] + +-- | An executable was expected to be in PATH, but was not found. +data NotFoundInPATH = NotFoundInPATH (Path Rel) + deriving Show + +instance Pretty NotFoundInPATH where + pPrint (NotFoundInPATH exe) = + text [i|The exe "#{decUTF8Safe . toFilePath $ exe}" was not found in PATH.|] + +-- | JSON decoding failed. +data JSONError = JSONDecodeError String + deriving Show + +instance Pretty JSONError where + pPrint (JSONDecodeError err) = + text [i|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 ByteString + deriving Show + +instance Pretty FileDoesNotExistError where + pPrint (FileDoesNotExistError file) = + text [i|File "#{decUTF8Safe file}" does not exist.|] + +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 Text Text + deriving Show + +instance Pretty DigestError where + pPrint (DigestError currentDigest expectedDigest) = + text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|] + +-- | Unexpected HTTP status. +data HTTPStatusError = HTTPStatusError Int + deriving Show + +instance Pretty HTTPStatusError where + pPrint (HTTPStatusError status) = + text [i|Unexpected HTTP status: #{status}|] + +-- | The 'Location' header was expected during a 3xx redirect, but not found. +data NoLocationHeader = NoLocationHeader + deriving Show + +instance Pretty NoLocationHeader where + pPrint NoLocationHeader = + text [i|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 [i|Too many redirections.|] + +-- | A patch could not be applied. +data PatchFailed = PatchFailed + deriving Show + +instance Pretty PatchFailed where + pPrint PatchFailed = + text [i|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 [i|The Tool requirements could not be found.|] + +data InvalidBuildConfig = InvalidBuildConfig Text + deriving Show + +instance Pretty InvalidBuildConfig where + pPrint (InvalidBuildConfig reason) = + text [i|The build config is invalid. Reason was: #{reason}|] + +data NoToolVersionSet = NoToolVersionSet Tool + deriving Show + +instance Pretty NoToolVersionSet where + pPrint (NoToolVersionSet tool) = + text [i|No version is set for tool "#{tool}".|] + + + ------------------------- + --[ High-level errors ]-- + ------------------------- + +-- | A download failed. The underlying error is encapsulated. +data DownloadFailed = forall x xs . (Show x, Show (V xs), Pretty x, Pretty (V xs)) => DownloadFailed (V (x ': xs)) + +instance Pretty DownloadFailed where + pPrint (DownloadFailed reason) = + text "Download failed:" <+> pPrint reason + +deriving instance Show DownloadFailed + + +-- | A build failed. +data BuildFailed = forall es . Show (V es) => BuildFailed (Path Abs) (V es) + +instance Pretty BuildFailed where + pPrint (BuildFailed path reason) = + text [i|BuildFailed failed in dir "#{decUTF8Safe . toFilePath $ path}": #{reason}|] + +deriving instance Show BuildFailed + + +-- | Setting the current GHC version failed. +data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es) + +instance Pretty GHCupSetError where + pPrint (GHCupSetError reason) = + text [i|Setting the current GHC version failed: #{reason}|] + +deriving instance Show GHCupSetError + + + --------------------------------------------- + --[ True Exceptions (e.g. for MonadThrow) ]-- + --------------------------------------------- + + +-- | Parsing failed. +data ParseError = ParseError String + deriving Show + +instance Pretty ParseError where + pPrint (ParseError reason) = + text [i|Parsing failed: #{reason}|] + +instance Exception ParseError + + +data UnexpectedListLength = UnexpectedListLength String + deriving Show + +instance Pretty UnexpectedListLength where + pPrint (UnexpectedListLength reason) = + text [i|List length unexpected: #{reason}|] + +instance Exception UnexpectedListLength + + + + ------------------------ + --[ 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 [i|Failed to parse URI. Malformed scheme: #{reason}|] + pPrint MalformedUserInfo = + text [i|Failed to parse URI. Malformed user info.|] + pPrint MalformedQuery = + text [i|Failed to parse URI. Malformed query.|] + pPrint MalformedFragment = + text [i|Failed to parse URI. Malformed fragment.|] + pPrint MalformedHost = + text [i|Failed to parse URI. Malformed host.|] + pPrint MalformedPort = + text [i|Failed to parse URI. Malformed port.|] + pPrint MalformedPath = + text [i|Failed to parse URI. Malformed path.|] + pPrint (OtherError err) = + text [i|Failed to parse URI: #{err}|] + +#if !defined(TAR) +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" +#endif diff --git a/lib/GHCup/Platform.hs b/lib/GHCup/Platform.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Platform.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# 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 : POSIX +-} +module GHCup.Platform where + + +import GHCup.Errors +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Utils.File +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 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.OsRelease +import Text.Regex.Posix + +import qualified Data.Text as T + + -------------------------- + --[ Platform detection ]-- + -------------------------- + + +-- | Get the full platform request, consisting of architecture, distro, ... +platformRequest :: (MonadLogger m, 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) + + +getPlatform :: (MonadLogger m, MonadCatch m, MonadIO m) + => Excepts + '[NoCompatiblePlatform, DistroNotFound] + m + PlatformResult +getPlatform = do + pfr <- case os of + "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 + . getMajorVersion + . decUTF8Safe + <$> getDarwinVersion + pure $ PlatformResult { _platform = Darwin, _distroVersion = ver } + "freebsd" -> do + ver <- + either (const Nothing) Just . versioning . decUTF8Safe + <$> getFreeBSDVersion + pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver } + what -> throwE $ NoCompatiblePlatform what + lift $ $(logDebug) [i|Identified Platform as: #{pfr}|] + pure pfr + where + getMajorVersion = T.intercalate "." . take 2 . T.split (== '.') + getFreeBSDVersion = + liftIO $ fmap _stdOut $ executeOut [rel|freebsd-version|] [] Nothing + getDarwinVersion = liftIO $ fmap _stdOut $ executeOut [rel|sw_vers|] + ["-productVersion"] + Nothing + + +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) $ liftIO $ asum + [ try_os_release + , try_lsb_release_cmd + , try_redhat_release + , try_debian_version + ] + let parsedVer = ver >>= either (const Nothing) Just . versioning + distro = if + | hasWord name ["debian"] -> Debian + | hasWord name ["ubuntu"] -> Ubuntu + | hasWord name ["linuxmint", "Linux Mint"] -> Mint + | hasWord name ["fedora"] -> Fedora + | hasWord name ["centos"] -> CentOS + | hasWord name ["Red Hat"] -> RedHat + | hasWord name ["alpine"] -> Alpine + | hasWord name ["exherbo"] -> Exherbo + | hasWord name ["gentoo"] -> Gentoo + | hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux + | otherwise -> UnknownLinux + pure (distro, parsedVer) + where + 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 :: 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) + + try_lsb_release_cmd :: IO (Text, Maybe Text) + try_lsb_release_cmd = do + (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) + + try_redhat_release :: IO (Text, Maybe Text) + try_redhat_release = do + t <- fmap decUTF8Safe' $ readFile redhat_release + let nameRegex n = + makeRegexOpts compIgnoreCase + execBlank + ([s|\<|] <> fS n <> [s|\>|] :: ByteString) :: Regex + let verRegex = + makeRegexOpts compIgnoreCase + execBlank + ([s|\<([0-9])+(.([0-9])+)*\>|] :: ByteString) :: Regex + let nameRe n = + fromEmpty . match (nameRegex n) $ T.unpack t :: Maybe String + verRe = fromEmpty . match verRegex $ T.unpack t :: Maybe String + (Just name) <- pure + (nameRe "CentOS" <|> nameRe "Fedora" <|> nameRe "Red Hat") + pure (T.pack name, fmap T.pack verRe) + where + fromEmpty :: String -> Maybe String + fromEmpty "" = Nothing + fromEmpty s' = Just s' + + try_debian_version :: IO (Text, Maybe Text) + try_debian_version = do + ver <- readFile debian_version + pure (T.pack "debian", Just . decUTF8Safe' $ ver) diff --git a/lib/GHCup/Requirements.hs b/lib/GHCup/Requirements.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Requirements.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : GHCup.Requirements +Description : Requirements utilities +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} +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 install the following distro packages: " + <> T.intercalate " " _distroPKGs + else "" + n = if not . T.null $ _notes then "\n Note: " <> _notes else "" + in "System requirements " <> d <> n diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Types.hs @@ -0,0 +1,415 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +{-| +Module : GHCup.Types +Description : GHCup types +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} +module GHCup.Types where + +import Data.Map.Strict ( Map ) +import Data.List.NonEmpty ( NonEmpty (..) ) +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Versions +import HPath +import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text) +import URI.ByteString + +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import qualified Data.Text.Encoding.Error as E +import qualified GHC.Generics as GHC +import qualified Graphics.Vty as Vty + + + + -------------------- + --[ GHCInfo Tree ]-- + -------------------- + + +data GHCupInfo = GHCupInfo + { _toolRequirements :: ToolRequirements + , _ghcupDownloads :: GHCupDownloads + } + deriving (Show, GHC.Generic) + + + + ------------------------- + --[ 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) + + + + + + --------------------- + --[ Download Tree ]-- + --------------------- + + +-- | Description of all binary and source downloads. This is a tree +-- of nested maps. +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 + + +-- | An installable tool. +data Tool = GHC + | Cabal + | GHCup + | HLS + deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded) + + +-- | 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 + } + deriving (Eq, GHC.Generic, Show) + + +-- | A tag. These are currently attached to a version of a tool. +data Tag = Latest + | Recommended + | Prerelease + | Base PVP + | Old -- ^ old version are hidden by default in TUI + | UnknownTag String -- ^ used for upwardscompat + deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance + +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) + +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 + deriving (Eq, GHC.Generic, Ord, Show) + +platformToString :: Platform -> String +platformToString (Linux distro) = "linux-" ++ distroToString distro +platformToString Darwin = "darwin" +platformToString FreeBSD = "freebsd" + +instance Pretty Platform where + pPrint = text . platformToString + +data LinuxDistro = Debian + | Ubuntu + | Mint + | Fedora + | CentOS + | RedHat + | Alpine + | AmazonLinux + -- rolling + | Gentoo + | Exherbo + -- not known + | UnknownLinux + -- ^ must exit + deriving (Eq, GHC.Generic, Ord, Show) + +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 + , _dlHash :: Text + } + deriving (Eq, Ord, GHC.Generic, Show) + + + + + -------------- + --[ Others ]-- + -------------- + + +-- | How to descend into a tar archive. +data TarDir = RealDir (Path Rel) + | RegexDir String -- ^ will be compiled to regex, the first match will "win" + deriving (Eq, Ord, GHC.Generic, Show) + +instance Pretty TarDir where + pPrint (RealDir path) = text [i|#{E.decodeUtf8With E.lenientDecode . toFilePath $ 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) + + +data UserSettings = UserSettings + { uCache :: Maybe Bool + , uNoVerify :: Maybe Bool + , uVerbose :: Maybe Bool + , uKeepDirs :: Maybe KeepDirs + , uDownloader :: Maybe Downloader + , uKeyBindings :: Maybe UserKeyBindings + , uUrlSource :: Maybe URLSource + } + deriving (Show, GHC.Generic) + +defaultUserSettings :: UserSettings +defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +data UserKeyBindings = UserKeyBindings + { kUp :: Maybe Vty.Key + , kDown :: Maybe Vty.Key + , kQuit :: Maybe Vty.Key + , kInstall :: Maybe Vty.Key + , kUninstall :: Maybe Vty.Key + , kSet :: Maybe Vty.Key + , kChangelog :: Maybe Vty.Key + , kShowAll :: Maybe Vty.Key + } + deriving (Show, GHC.Generic) + +data KeyBindings = KeyBindings + { bUp :: Vty.Key + , bDown :: Vty.Key + , bQuit :: Vty.Key + , bInstall :: Vty.Key + , bUninstall :: Vty.Key + , bSet :: Vty.Key + , bChangelog :: Vty.Key + , bShowAll :: Vty.Key + } + deriving (Show, GHC.Generic) + +defaultKeyBindings :: KeyBindings +defaultKeyBindings = KeyBindings + { bUp = Vty.KUp + , bDown = Vty.KDown + , bQuit = Vty.KChar 'q' + , bInstall = Vty.KChar 'i' + , bUninstall = Vty.KChar 'u' + , bSet = Vty.KChar 's' + , bChangelog = Vty.KChar 'c' + , bShowAll = Vty.KChar 'a' + } + +data AppState = AppState + { settings :: Settings + , dirs :: Dirs + , keyBindings :: KeyBindings + } deriving (Show) + +data Settings = Settings + { cache :: Bool + , noVerify :: Bool + , keepDirs :: KeepDirs + , downloader :: Downloader + , verbose :: Bool + , urlSource :: URLSource + } + deriving (Show, GHC.Generic) + +data Dirs = Dirs + { baseDir :: Path Abs + , binDir :: Path Abs + , cacheDir :: Path Abs + , logsDir :: Path Abs + , confDir :: Path Abs + } + deriving Show + +data KeepDirs = Always + | Errors + | Never + deriving (Eq, Show, Ord) + +data Downloader = Curl + | Wget +#if defined(INTERNAL_DOWNLOADER) + | Internal +#endif + deriving (Eq, Show, Ord) + +data DebugInfo = DebugInfo + { diBaseDir :: Path Abs + , diBinDir :: Path Abs + , diGHCDir :: Path Abs + , diCacheDir :: Path Abs + , diArch :: Architecture + , diPlatform :: PlatformResult + } + deriving Show + + +data SetGHC = SetGHCOnly -- ^ unversioned 'ghc' + | SetGHC_XY -- ^ ghc-x.y + | SetGHC_XYZ -- ^ ghc-x.y.z + deriving (Eq, Show) + + +data PlatformResult = PlatformResult + { _platform :: Platform + , _distroVersion :: Maybe Versioning + } + deriving (Eq, Show) + +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 + +data PlatformRequest = PlatformRequest + { _rArch :: Architecture + , _rPlatform :: Platform + , _rVersion :: Maybe Versioning + } + deriving (Eq, Show) + +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) + + +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: - +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) + + +-- | 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 Pretty Versioning where + pPrint = text . T.unpack . prettyV + +instance Pretty Version where + pPrint = text . T.unpack . prettyVer diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Types/JSON.hs @@ -0,0 +1,324 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# 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 : POSIX +-} +module GHCup.Types.JSON where + +import GHCup.Types +import GHCup.Utils.MegaParsec +import GHCup.Utils.Prelude + +import Control.Applicative ( (<|>) ) +import Data.Aeson +import Data.Aeson.TH +import Data.Aeson.Types +import Data.List.NonEmpty ( NonEmpty(..) ) +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.ByteString as BS +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import qualified Graphics.Vty as Vty +import qualified Text.Megaparsec as MP +import qualified Text.Megaparsec.Char as MPC + + +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader +deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource +deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings +deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings +deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key + +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' + +instance FromJSON URI where + parseJSON = withText "URL" $ \t -> + case parseURI strictURIParserOptions (encodeUtf8 t) of + Right x -> pure x + Left e -> fail . show $ e + +instance ToJSON Versioning where + toJSON = toJSON . prettyV + +instance FromJSON Versioning where + parseJSON = withText "Versioning" $ \t -> case versioning t of + Right x -> pure x + Left e -> fail $ "Failure in Version (FromJSON)" <> show e + +instance ToJSONKey Versioning where + toJSONKey = toJSONKeyText $ \x -> prettyV x + +instance FromJSONKey Versioning where + fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of + Right x -> pure x + Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e + +instance ToJSONKey (Maybe Versioning) where + toJSONKey = toJSONKeyText $ \case + Just x -> prettyV x + Nothing -> T.pack "unknown_versioning" + +instance FromJSONKey (Maybe Versioning) where + fromJSONKey = FromJSONKeyTextParser $ \t -> + if t == T.pack "unknown_versioning" then pure Nothing else just t + where + just t = case versioning t of + Right x -> pure $ Just x + Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e + +instance ToJSONKey Platform where + toJSONKey = toJSONKeyText $ \case + Darwin -> T.pack "Darwin" + FreeBSD -> T.pack "FreeBSD" + Linux d -> T.pack ("Linux_" <> show d) + +instance FromJSONKey Platform where + fromJSONKey = FromJSONKeyTextParser $ \t -> if + | T.pack "Darwin" == t -> pure Darwin + | T.pack "FreeBSD" == t -> pure FreeBSD + | T.pack "Linux_" `T.isPrefixOf` t -> case + T.stripPrefix (T.pack "Linux_") t + of + Just dstr -> + case + (decodeStrict (E.encodeUtf8 (T.pack "\"" <> dstr <> T.pack "\"")) :: Maybe + LinuxDistro + ) + of + Just d -> pure $ Linux d + Nothing -> + fail + $ "Unexpected failure in decoding LinuxDistro: " + <> show dstr + Nothing -> fail "Unexpected failure in Platform stripPrefix" + | otherwise -> fail "Failure in Platform (FromJSONKey)" + +instance ToJSONKey Architecture where + toJSONKey = genericToJSONKey defaultJSONKeyOptions + +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 + +instance FromJSON Version where + parseJSON = withText "Version" $ \t -> case version t of + Right x -> pure x + Left e -> fail $ "Failure in Version (FromJSON)" <> show e + +instance ToJSONKey Version where + toJSONKey = toJSONKeyText $ \x -> prettyVer x + +instance FromJSONKey Version where + fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of + 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 ToJSON (Path Rel) where + toJSON p = case and . fmap isAscii . BS.unpack $ fp of + True -> toJSON . decUTF8Safe $ fp + False -> String "/not/a/valid/path" + where fp = toFilePath p + +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 + + +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 diff --git a/lib/GHCup/Types/Optics.hs b/lib/GHCup/Types/Optics.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Types/Optics.hs @@ -0,0 +1,60 @@ +{-# 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 : POSIX +-} +module GHCup.Types.Optics where + +import GHCup.Types + +import Data.ByteString ( ByteString ) +import Optics +import URI.ByteString + +makePrisms ''Tool +makePrisms ''Architecture +makePrisms ''LinuxDistro +makePrisms ''Platform +makePrisms ''Tag + +makeLenses ''PlatformResult +makeLenses ''DownloadInfo +makeLenses ''Tag +makeLenses ''VersionInfo + +makeLenses ''GHCTargetVersion + +makeLenses ''GHCupInfo + +uriSchemeL' :: Lens' (URIRef Absolute) Scheme +uriSchemeL' = lensVL uriSchemeL + +schemeBSL' :: Lens' Scheme ByteString +schemeBSL' = lensVL schemeBSL + +authorityL' :: Lens' (URIRef a) (Maybe Authority) +authorityL' = lensVL authorityL + +authorityHostL' :: Lens' Authority Host +authorityHostL' = lensVL authorityHostL + +authorityPortL' :: Lens' Authority (Maybe Port) +authorityPortL' = lensVL authorityPortL + +portNumberL' :: Lens' Port Int +portNumberL' = lensVL portNumberL + +hostBSL' :: Lens' Host ByteString +hostBSL' = lensVL hostBSL + +pathL' :: Lens' (URIRef a) ByteString +pathL' = lensVL pathL + +queryL' :: Lens' (URIRef a) Query +queryL' = lensVL queryL diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils.hs @@ -0,0 +1,883 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + +{-| +Module : GHCup.Utils +Description : GHCup domain specific utilities +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +This module contains GHCup helpers specific to +installation and introspection of files/versions etc. +-} +module GHCup.Utils + ( module GHCup.Utils.Dirs + , module GHCup.Utils + ) +where + + +import GHCup.Errors +import GHCup.Types +import GHCup.Types.Optics +import GHCup.Types.JSON ( ) +import GHCup.Utils.Dirs +import GHCup.Utils.File +import GHCup.Utils.MegaParsec +import GHCup.Utils.Prelude +import GHCup.Utils.String.QQ + +#if !defined(TAR) +import Codec.Archive hiding ( Directory ) +#endif +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail ( MonadFail ) +#endif +import Control.Monad.Logger +import Control.Monad.Reader +import Data.ByteString ( ByteString ) +import Data.Either +import Data.Foldable +import Data.List +import Data.List.NonEmpty ( NonEmpty( (:|) )) +import Data.List.Split +import Data.Maybe +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Versions +import Data.Word8 +import GHC.IO.Exception +import HPath +import HPath.IO hiding ( hideError ) +import Haskus.Utils.Variant.Excepts +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import Safe +import System.IO.Error +import System.Posix.FilePath ( getSearchPath + , takeFileName + ) +import System.Posix.Files.ByteString ( readSymbolicLink ) +import Text.Regex.Posix +import URI.ByteString + +#if defined(TAR) +import qualified Codec.Archive.Tar as Tar +#endif +import qualified Codec.Compression.BZip as BZip +import qualified Codec.Compression.GZip as GZip +import qualified Codec.Compression.Lzma as Lzma +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map.Strict as Map +#if !defined(TAR) +import qualified Data.Text as T +#endif +import qualified Data.Text.Encoding as E +import qualified Text.Megaparsec as MP + + + + + + ------------------------ + --[ Symlink handling ]-- + ------------------------ + + +-- | The symlink destination of a ghc tool. +ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m) + => ByteString -- ^ the tool, such as 'ghc', 'haddock' etc. + -> GHCTargetVersion + -> m ByteString +ghcLinkDestination tool ver = do + AppState { dirs = Dirs {..} } <- ask + t <- parseRel tool + ghcd <- ghcupGHCDir ver + pure (relativeSymlink binDir (ghcd [rel|bin|] t)) + + +-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5. +rmMinorSymlinks :: ( MonadReader AppState m + , MonadIO m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadReader AppState m + ) + => GHCTargetVersion + -> Excepts '[NotInstalled] m () +rmMinorSymlinks tv@GHCTargetVersion{..} = do + AppState { dirs = Dirs {..} } <- lift ask + + files <- liftE $ ghcToolFiles tv + forM_ files $ \f -> do + f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion) + let fullF = binDir f_xyz + lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + + +-- | Removes the set ghc version for the given target, if any. +rmPlain :: ( MonadReader AppState m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadIO m + ) + => Maybe Text -- ^ target + -> Excepts '[NotInstalled] m () +rmPlain target = do + AppState { dirs = Dirs {..} } <- lift ask + mtv <- lift $ ghcSet target + forM_ mtv $ \tv -> do + files <- liftE $ ghcToolFiles tv + forM_ files $ \f -> do + let fullF = binDir f + lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + -- old ghcup + let hdc_file = binDir [rel|haddock-ghc|] + lift $ $(logDebug) [i|rm -f #{toFilePath hdc_file}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file + + +-- | Remove the major GHC symlink, e.g. ghc-8.6. +rmMajorSymlinks :: ( MonadReader AppState m + , MonadIO m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadReader AppState m + ) + => GHCTargetVersion + -> Excepts '[NotInstalled] m () +rmMajorSymlinks tv@GHCTargetVersion{..} = do + AppState { dirs = Dirs {..} } <- lift ask + (mj, mi) <- getMajorMinorV _tvVersion + let v' = intToText mj <> "." <> intToText mi + + files <- liftE $ ghcToolFiles tv + forM_ files $ \f -> do + f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v') + let fullF = binDir f_xyz + lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] + liftIO $ hideError doesNotExistErrorType $ deleteFile fullF + + + + + ----------------------------------- + --[ Set/Installed introspection ]-- + ----------------------------------- + + +-- | Whethe the given GHC versin is installed. +ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool +ghcInstalled ver = do + ghcdir <- ghcupGHCDir ver + liftIO $ doesDirectoryExist ghcdir + + +-- | Whether the given GHC version is installed from source. +ghcSrcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool +ghcSrcInstalled ver = do + ghcdir <- ghcupGHCDir ver + liftIO $ doesFileExist (ghcdir ghcUpSrcBuiltFile) + + +-- | Whether the given GHC version is set as the current. +ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m) + => Maybe Text -- ^ the target of the GHC version, if any + -- (e.g. armv7-unknown-linux-gnueabihf) + -> m (Maybe GHCTargetVersion) +ghcSet mtarget = do + AppState {dirs = Dirs {..}} <- ask + ghc <- parseRel $ E.encodeUtf8 (maybe "ghc" (<> "-ghc") mtarget) + let ghcBin = binDir ghc + + -- link destination is of the form ../ghc//bin/ghc + -- for old ghcup, it is ../ghc//bin/ghc- + liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do + link <- readSymbolicLink $ toFilePath ghcBin + Just <$> ghcLinkVersion link + +ghcLinkVersion :: MonadThrow m => ByteString -> m GHCTargetVersion +ghcLinkVersion bs = do + t <- throwEither $ E.decodeUtf8' bs + throwEither $ MP.parse parser "ghcLinkVersion" t + where + parser = + (do + _ <- parseUntil1 (MP.chunk "/ghc/") + _ <- MP.chunk "/ghc/" + r <- parseUntil1 (MP.chunk "/") + rest <- MP.getInput + MP.setInput r + x <- ghcTargetVerP + MP.setInput rest + pure x + ) + <* MP.chunk "/" + <* MP.takeRest + <* MP.eof + + +-- | Get all installed GHCs by reading ~/.ghcup/ghc/. +-- If a dir cannot be parsed, returns left. +getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion] +getInstalledGHCs = do + ghcdir <- ghcupGHCBaseDir + fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir + forM fs $ \f -> case parseGHCupGHCDir f of + Right r -> pure $ Right r + Left _ -> pure $ Left f + + +-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@. +getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) + => m [Either (Path Rel) Version] +getInstalledCabals = do + cs <- cabalSet -- for legacy cabal + getInstalledCabals' cs + + +getInstalledCabals' :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) + => Maybe Version + -> m [Either (Path Rel) Version] +getInstalledCabals' cs = do + AppState {dirs = Dirs {..}} <- ask + bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles + binDir + (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString)) + vs <- forM bins $ \f -> case fmap (version . decUTF8Safe) . B.stripPrefix "cabal-" . toFilePath $ f of + Just (Right r) -> pure $ Right r + Just (Left _) -> pure $ Left f + Nothing -> pure $ Left f + pure $ maybe vs (\x -> nub $ Right x:vs) cs + + +-- | Whether the given cabal version is installed. +cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool +cabalInstalled ver = do + vers <- fmap rights getInstalledCabals + pure $ elem ver vers + + +-- Return the currently set cabal version, if any. +cabalSet :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) +cabalSet = do + AppState {dirs = Dirs {..}} <- ask + let cabalbin = binDir [rel|cabal|] + b <- handleIO (\_ -> pure False) $ fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin + if + | b -> do + handleIO' NoSuchThing (\_ -> pure Nothing) $ do + broken <- liftIO $ isBrokenSymlink cabalbin + if broken + then do + $(logWarn) [i|Symlink #{cabalbin} is broken.|] + pure Nothing + else do + link <- liftIO $ readSymbolicLink $ toFilePath cabalbin + case linkVersion link of + Right v -> pure $ Just v + Left err -> do + $(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{toFilePath cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|] + pure Nothing + | otherwise -> do -- legacy behavior + mc <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut + cabalbin + ["--numeric-version"] + Nothing + fmap join $ forM mc $ \c -> if + | not (B.null (_stdOut c)), _exitCode c == ExitSuccess -> do + let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ c + case version $ decUTF8Safe reportedVer of + Left e -> throwM e + Right r -> pure $ Just r + | otherwise -> pure Nothing + where + -- We try to be extra permissive with link destination parsing, + -- because of: + -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119 + linkVersion :: MonadThrow m => ByteString -> m Version + linkVersion bs = do + t <- throwEither $ E.decodeUtf8' bs + throwEither $ MP.parse parser "" t + + parser + = MP.try (stripAbsolutePath *> cabalParse) + <|> MP.try (stripRelativePath *> cabalParse) + <|> cabalParse + -- parses the version of "cabal-3.2.0.0" -> "3.2.0.0" + cabalParse = MP.chunk "cabal-" *> version' + -- parses any path component ending with path separator, + -- e.g. "foo/" + stripPathComponet = parseUntil1 "/" *> MP.chunk "/" + -- parses an absolute path up until the last path separator, + -- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo" + stripAbsolutePath = MP.chunk "/" *> MP.many (MP.try stripPathComponet) + -- parses a relative path up until the last path separator, + -- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo" + stripRelativePath = MP.many (MP.try stripPathComponet) + + + +-- | Get all installed hls, by matching on +-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@. +getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m) + => m [Either (Path Rel) Version] +getInstalledHLSs = do + AppState { dirs = Dirs {..} } <- ask + bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles + binDir + (makeRegexOpts compExtended + execBlank + ([s|^haskell-language-server-wrapper-.*$|] :: ByteString) + ) + forM bins $ \f -> + case + fmap (version . decUTF8Safe) . B.stripPrefix "haskell-language-server-wrapper-" . toFilePath $ f + of + Just (Right r) -> pure $ Right r + Just (Left _) -> pure $ Left f + Nothing -> pure $ Left f + + +-- | Whether the given HLS version is installed. +hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool +hlsInstalled ver = do + vers <- fmap rights getInstalledHLSs + pure $ elem ver vers + + + +-- Return the currently set hls version, if any. +hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) +hlsSet = do + AppState {dirs = Dirs {..}} <- ask + let hlsBin = binDir [rel|haskell-language-server-wrapper|] + + liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do + broken <- isBrokenSymlink hlsBin + if broken + then pure Nothing + else do + link <- readSymbolicLink $ toFilePath hlsBin + Just <$> linkVersion link + where + linkVersion :: MonadThrow m => ByteString -> m Version + linkVersion bs = do + t <- throwEither $ E.decodeUtf8' bs + throwEither $ MP.parse parser "" t + where + parser = + MP.chunk "haskell-language-server-wrapper-" *> version' + + +-- | Return the GHC versions the currently selected HLS supports. +hlsGHCVersions :: ( MonadReader AppState m + , MonadIO m + , MonadThrow m + , MonadCatch m + ) + => m [Version] +hlsGHCVersions = do + h <- hlsSet + vers <- forM h $ \h' -> do + bins <- hlsServerBinaries h' + pure $ fmap + (version + . decUTF8Safe + . fromJust + . B.stripPrefix "haskell-language-server-" + . head + . B.split _tilde + . toFilePath + ) + bins + pure . rights . concat . maybeToList $ vers + + +-- | Get all server binaries for an hls version, if any. +hlsServerBinaries :: (MonadReader AppState m, MonadIO m) + => Version + -> m [Path Rel] +hlsServerBinaries ver = do + AppState { dirs = Dirs {..} } <- ask + liftIO $ handleIO (\_ -> pure []) $ findFiles + binDir + (makeRegexOpts + compExtended + execBlank + ([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> [s|$|] :: ByteString + ) + ) + + +-- | Get the wrapper binary for an hls version, if any. +hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m) + => Version + -> m (Maybe (Path Rel)) +hlsWrapperBinary ver = do + AppState { dirs = Dirs {..} } <- ask + wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles + binDir + (makeRegexOpts + compExtended + execBlank + ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> [s|$|] :: ByteString + ) + ) + case wrapper of + [] -> pure Nothing + [x] -> pure $ Just x + _ -> throwM $ UnexpectedListLength + "There were multiple hls wrapper binaries for a single version" + + +-- | Get all binaries for an hls version, if any. +hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [Path Rel] +hlsAllBinaries ver = do + hls <- hlsServerBinaries ver + wrapper <- hlsWrapperBinary ver + pure (maybeToList wrapper ++ hls) + + +-- | Get the active symlinks for hls. +hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [Path Rel] +hlsSymlinks = do + AppState { dirs = Dirs {..} } <- ask + oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles + binDir + (makeRegexOpts compExtended + execBlank + ([s|^haskell-language-server-.*$|] :: ByteString) + ) + filterM + ( fmap (== SymbolicLink) + . liftIO + . getFileType + . (binDir ) + ) + oldSyms + + + + ----------------------------------------- + --[ Major version introspection (X.Y) ]-- + ----------------------------------------- + + +-- | Extract (major, minor) from any version. +getMajorMinorV :: MonadThrow m => Version -> m (Int, Int) +getMajorMinorV Version {..} = case _vChunks of + ((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y) + _ -> throwM $ ParseError "Could not parse X.Y from version" + + +matchMajor :: Version -> Int -> Int -> Bool +matchMajor v' major' minor' = case getMajorMinorV v' of + Just (x, y) -> x == major' && y == minor' + Nothing -> False + + +-- | Get the latest installed full GHC version that satisfies X.Y. +-- This reads `ghcupGHCBaseDir`. +getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m) + => Int -- ^ major version component + -> Int -- ^ minor version component + -> Maybe Text -- ^ the target triple + -> m (Maybe GHCTargetVersion) +getGHCForMajor major' minor' mt = do + ghcs <- rights <$> getInstalledGHCs + + pure + . lastMay + . sortBy (\x y -> compare (_tvVersion x) (_tvVersion y)) + . filter + (\GHCTargetVersion {..} -> + _tvTarget == mt && matchMajor _tvVersion major' minor' + ) + $ ghcs + + +-- | Get the latest available ghc for X.Y major version. +getLatestGHCFor :: Int -- ^ major version component + -> Int -- ^ minor version component + -> GHCupDownloads + -> Maybe (Version, VersionInfo) +getLatestGHCFor major' minor' dls = + preview (ix GHC % to Map.toDescList) dls >>= lastMay . filter (\(v, _) -> matchMajor v major' minor') + + + + + ----------------- + --[ Unpacking ]-- + ----------------- + + + +-- | Unpack an archive to a temporary directory and return that path. +unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m) + => Path Abs -- ^ destination dir + -> Path Abs -- ^ archive path + -> Excepts '[UnknownArchive +#if !defined(TAR) + , ArchiveResult +#endif + ] m () +unpackToDir dest av = do + fp <- decUTF8Safe . toFilePath <$> basename av + let dfp = decUTF8Safe . toFilePath $ dest + lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|] + fn <- toFilePath <$> basename av + +#if defined(TAR) + let untar :: MonadIO m => BL.ByteString -> Excepts '[] m () + untar = liftIO . Tar.unpack (toFilePath dest) . Tar.read + + rf :: MonadIO m => Path Abs -> Excepts '[] m BL.ByteString + rf = liftIO . readFile +#else + let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m () + untar = lEM . liftIO . runArchiveM . unpackToDirLazy (T.unpack . decUTF8Safe . toFilePath $ dest) + + rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString + rf = liftIO . readFile +#endif + + -- extract, depending on file extension + if + | ".tar.gz" `B.isSuffixOf` fn -> liftE + (untar . GZip.decompress =<< rf av) + | ".tar.xz" `B.isSuffixOf` fn -> do + filecontents <- liftE $ rf av + let decompressed = Lzma.decompress filecontents + liftE $ untar decompressed + | ".tar.bz2" `B.isSuffixOf` fn -> + liftE (untar . BZip.decompress =<< rf av) + | ".tar" `B.isSuffixOf` fn -> liftE (untar =<< rf av) + | otherwise -> throwE $ UnknownArchive fn + + +getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m) + => Path Abs -- ^ archive path + -> Excepts '[UnknownArchive +#if defined(TAR) + , Tar.FormatError +#else + , ArchiveResult +#endif + ] m [ByteString] +getArchiveFiles av = do + fn <- toFilePath <$> basename av + +#if defined(TAR) + let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [ByteString] + entries = + lE @Tar.FormatError + . Tar.foldEntries + (\e x -> fmap (Tar.entryPath e :) x) + (Right []) + (\e -> Left e) + . Tar.read + + rf :: MonadIO m => Path Abs -> Excepts '[Tar.FormatError] m BL.ByteString + rf = liftIO . readFile +#else + let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [ByteString] + entries = (fmap . fmap) (E.encodeUtf8 . T.pack . filepath) . lE . readArchiveBSL + + rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString + rf = liftIO . readFile +#endif + + -- extract, depending on file extension + if + | ".tar.gz" `B.isSuffixOf` fn -> liftE + (entries . GZip.decompress =<< rf av) + | ".tar.xz" `B.isSuffixOf` fn -> do + filecontents <- liftE $ rf av + let decompressed = Lzma.decompress filecontents + liftE $ entries decompressed + | ".tar.bz2" `B.isSuffixOf` fn -> + liftE (entries . BZip.decompress =<< rf av) + | ".tar" `B.isSuffixOf` fn -> liftE (entries =<< rf av) + | otherwise -> throwE $ UnknownArchive fn + + +intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) + => Path Abs -- ^ unpacked tar dir + -> TarDir -- ^ how to descend + -> Excepts '[TarDirDoesNotExist] m (Path Abs) +intoSubdir bdir tardir = case tardir of + RealDir pr -> do + whenM (fmap not . liftIO . doesDirectoryExist $ (bdir pr)) + (throwE $ TarDirDoesNotExist tardir) + pure (bdir pr) + RegexDir r -> do + let rs = splitOn "/" r + foldlM + (\y x -> + (handleIO (\_ -> pure []) . liftIO . findFiles y . regex $ x) >>= (\case + [] -> throwE $ TarDirDoesNotExist tardir + (p : _) -> pure (y p)) . sort + ) + bdir + rs + where regex = makeRegexOpts compIgnoreCase execBlank + + + + + ------------ + --[ Tags ]-- + ------------ + + +-- | Get the tool version that has this tag. If multiple have it, +-- picks the greatest version. +getTagged :: Tag + -> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo) +getTagged tag = + to (Map.filter (\VersionInfo {..} -> tag `elem` _viTags)) + % to Map.toDescList + % _head + +getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getLatest av tool = headOf (ix tool % getTagged Latest) av + +getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getRecommended av tool = headOf (ix tool % getTagged Recommended) av + + +-- | Gets the latest GHC with a given base version. +getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo) +getLatestBaseVersion av pvpVer = + headOf (ix GHC % getTagged (Base pvpVer)) av + + + + ----------------------- + --[ AppState Getter ]-- + ----------------------- + + +getCache :: MonadReader AppState m => m Bool +getCache = ask <&> cache . settings + + +getDownloader :: MonadReader AppState m => m Downloader +getDownloader = ask <&> downloader . settings + + + + ------------- + --[ Other ]-- + ------------- + + +urlBaseName :: MonadThrow m + => ByteString -- ^ the url path (without scheme and host) + -> m (Path Rel) +urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False + + +-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\\/bin\/\*@ +-- while ignoring @*-\@ symlinks and accounting for cross triple prefix. +-- +-- Returns unversioned relative files, e.g.: +-- +-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@ +ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m) + => GHCTargetVersion + -> Excepts '[NotInstalled] m [Path Rel] +ghcToolFiles ver = do + ghcdir <- lift $ ghcupGHCDir ver + let bindir = ghcdir [rel|bin|] + + -- fail if ghc is not installed + whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) + (throwE (NotInstalled GHC ver)) + + files <- liftIO $ getDirsFiles' bindir + -- figure out the suffix, because this might not be `Version` for + -- alpha/rc releases, but x.y.a.somedate. + + -- for cross, this won't be "ghc", but e.g. + -- "armv7-unknown-linux-gnueabihf-ghc" + [ghcbin] <- liftIO $ findFiles + bindir + (makeRegexOpts compExtended + execBlank + ([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString) + ) + + let ghcbinPath = bindir ghcbin + ghcIsHadrian <- liftIO $ isHadrian ghcbinPath + onlyUnversioned <- if ghcIsHadrian + then pure id + else do + (Just symver) <- + B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName + <$> liftIO (readSymbolicLink $ toFilePath ghcbinPath) + when (B.null symver) + (throwIO $ userError "Fatal: ghc symlink target is broken") + pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x) + + pure $ onlyUnversioned files + where + -- GHC is moving some builds to Hadrian for bindists, + -- which doesn't create versioned binaries. + -- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31 + isHadrian :: Path Abs -- ^ ghcbin path + -> IO Bool + isHadrian = fmap (/= SymbolicLink) . getFileType + + +-- | This file, when residing in @~\/.ghcup\/ghc\/\\/@ signals that +-- this GHC was built from source. It contains the build config. +ghcUpSrcBuiltFile :: Path Rel +ghcUpSrcBuiltFile = [rel|.ghcup_src_built|] + + +-- | Calls gmake if it exists in PATH, otherwise make. +make :: (MonadThrow m, MonadIO m, MonadReader AppState m) + => [ByteString] + -> Maybe (Path Abs) + -> m (Either ProcessError ()) +make args workdir = do + spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath + has_gmake <- isJust <$> liftIO (searchPath spaths [rel|gmake|]) + let mymake = if has_gmake then "gmake" else "make" + execLogged mymake True args [rel|ghc-make|] workdir Nothing + + +-- | Try to apply patches in order. Fails with 'PatchFailed' +-- on first failure. +applyPatches :: (MonadLogger m, MonadIO m) + => Path Abs -- ^ dir containing patches + -> Path Abs -- ^ dir to apply patches in + -> Excepts '[PatchFailed] m () +applyPatches pdir ddir = do + patches <- liftIO $ getDirsFiles pdir + forM_ (sort patches) $ \patch' -> do + lift $ $(logInfo) [i|Applying patch #{patch'}|] + fmap (either (const Nothing) Just) + (liftIO $ exec + "patch" + True + ["-p1", "-i", toFilePath patch'] + (Just ddir) + Nothing) + !? PatchFailed + + +-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353 +darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ()) +darwinNotarization Darwin path = exec + "xattr" + True + ["-r", "-d", "com.apple.quarantine", toFilePath path] + Nothing + Nothing +darwinNotarization _ _ = pure $ Right () + + +getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI +getChangeLog dls tool (Left v') = + preview (ix tool % ix v' % viChangeLog % _Just) dls +getChangeLog dls tool (Right tag) = + preview (ix tool % getTagged tag % to snd % viChangeLog % _Just) dls + + +-- | Execute a build action while potentially cleaning up: +-- +-- 1. the build directory, depending on the KeepDirs setting +-- 2. the install destination, depending on whether the build failed +runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m) + => Path Abs -- ^ build directory (cleaned up depending on Settings) + -> Maybe (Path Abs) -- ^ dir to *always* clean up on exception + -> Excepts e m a + -> Excepts '[BuildFailed] m a +runBuildAction bdir instdir action = do + AppState { settings = Settings {..} } <- lift ask + let exAction = do + forM_ instdir $ \dir -> + liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir + when (keepDirs == Never) + $ liftIO + $ hideError doesNotExistErrorType + $ deleteDirRecursive bdir + v <- + flip onException exAction + $ catchAllE + (\es -> do + exAction + throwE (BuildFailed bdir es) + ) action + + when (keepDirs == Never || keepDirs == Errors) $ liftIO $ deleteDirRecursive + bdir + pure v + + +-- | More permissive version of 'createDirRecursive'. This doesn't +-- error when the destination is a symlink to a directory. +createDirRecursive' :: Path b -> IO () +createDirRecursive' p = + handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e) + . createDirRecursive newDirPerms + $ p + + where + isSymlinkDir e = do + ft <- getFileType p + case ft of + SymbolicLink -> do + rp <- canonicalizePath p + rft <- getFileType rp + case rft of + Directory -> pure () + _ -> throwIO e + _ -> throwIO e + + +getVersionInfo :: Version + -> Tool + -> GHCupDownloads + -> Maybe VersionInfo +getVersionInfo v' tool = + headOf + ( ix tool + % to (Map.filterWithKey (\k _ -> k == v')) + % to Map.elems + % _head + ) + + +-- Gathering monoidal values +traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b +traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty) + +-- | Gathering monoidal values +forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b +forFold = \t -> (`traverseFold` t) diff --git a/lib/GHCup/Utils/Dirs.hs b/lib/GHCup/Utils/Dirs.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/Dirs.hs @@ -0,0 +1,273 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ViewPatterns #-} + +{-| +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 : POSIX +-} +module GHCup.Utils.Dirs + ( getDirs + , ghcupConfigFile + , ghcupGHCBaseDir + , ghcupGHCDir + , mkGhcupTmpDir + , parseGHCupGHCDir + , relativeSymlink + , withGHCupTmpDir + ) +where + + +import GHCup.Errors +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Utils.MegaParsec +import GHCup.Utils.Prelude + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Data.Bifunctor +import Data.ByteString ( ByteString ) +import Data.Maybe +import GHC.IO.Exception ( IOErrorType(NoSuchThing) ) +import Haskus.Utils.Variant.Excepts +import HPath +import HPath.IO +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) +import System.Posix.Env.ByteString ( getEnv + , getEnvDefault + ) +import System.Posix.FilePath hiding ( () ) +import System.Posix.Temp.ByteString ( mkdtemp ) + +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Text.Encoding as E +import qualified Data.Yaml as Y +import qualified System.Posix.FilePath as FP +import qualified System.Posix.User as PU +import qualified Text.Megaparsec as MP + + + + ------------------------------ + --[ 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 (Path Abs) +ghcupBaseDir = do + xdg <- useXDG + if xdg + then do + bdir <- getEnv "XDG_DATA_HOME" >>= \case + Just r -> parseAbs r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home [rel|.local/share|]) + pure (bdir [rel|ghcup|]) + else do + bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case + Just r -> parseAbs r + Nothing -> liftIO getHomeDirectory + pure (bdir [rel|.ghcup|]) + + +-- | ~/.ghcup by default +-- +-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), +-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec. +ghcupConfigDir :: IO (Path Abs) +ghcupConfigDir = do + xdg <- useXDG + if xdg + then do + bdir <- getEnv "XDG_CONFIG_HOME" >>= \case + Just r -> parseAbs r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home [rel|.config|]) + pure (bdir [rel|ghcup|]) + else do + bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case + Just r -> parseAbs r + Nothing -> liftIO getHomeDirectory + pure (bdir [rel|.ghcup|]) + + +-- | 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 (Path Abs) +ghcupBinDir = do + xdg <- useXDG + if xdg + then do + getEnv "XDG_BIN_HOME" >>= \case + Just r -> parseAbs r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home [rel|.local/bin|]) + else ghcupBaseDir <&> ( [rel|bin|]) + + +-- | 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 (Path Abs) +ghcupCacheDir = do + xdg <- useXDG + if xdg + then do + bdir <- getEnv "XDG_CACHE_HOME" >>= \case + Just r -> parseAbs r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home [rel|.cache|]) + pure (bdir [rel|ghcup|]) + else ghcupBaseDir <&> ( [rel|cache|]) + + +-- | 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 (Path Abs) +ghcupLogsDir = do + xdg <- useXDG + if xdg + then do + bdir <- getEnv "XDG_CACHE_HOME" >>= \case + Just r -> parseAbs r + Nothing -> do + home <- liftIO getHomeDirectory + pure (home [rel|.cache|]) + pure (bdir [rel|ghcup/logs|]) + else ghcupBaseDir <&> ( [rel|logs|]) + + +getDirs :: IO Dirs +getDirs = do + baseDir <- ghcupBaseDir + binDir <- ghcupBinDir + cacheDir <- ghcupCacheDir + logsDir <- ghcupLogsDir + confDir <- ghcupConfigDir + pure Dirs { .. } + + + + ------------------- + --[ GHCup files ]-- + ------------------- + + +ghcupConfigFile :: (MonadIO m) + => Excepts '[JSONError] m UserSettings +ghcupConfigFile = do + confDir <- liftIO ghcupConfigDir + let file = confDir [rel|config.yaml|] + bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> readFile file + case bs of + Nothing -> pure defaultUserSettings + Just bs' -> lE' JSONDecodeError . first show . Y.decodeEither' . L.toStrict $ bs' + + + ------------------------- + --[ GHCup directories ]-- + ------------------------- + + +-- | ~/.ghcup/ghc by default. +ghcupGHCBaseDir :: (MonadReader AppState m) => m (Path Abs) +ghcupGHCBaseDir = do + AppState { dirs = Dirs {..} } <- ask + pure (baseDir [rel|ghc|]) + + +-- | Gets '~/.ghcup/ghc/'. +-- The dir may be of the form +-- * armv7-unknown-linux-gnueabihf-8.8.3 +-- * 8.8.4 +ghcupGHCDir :: (MonadReader AppState m, MonadThrow m) + => GHCTargetVersion + -> m (Path Abs) +ghcupGHCDir ver = do + ghcbasedir <- ghcupGHCBaseDir + verdir <- parseRel $ E.encodeUtf8 (tVerToText ver) + pure (ghcbasedir verdir) + + +-- | See 'ghcupToolParser'. +parseGHCupGHCDir :: MonadThrow m => Path Rel -> m GHCTargetVersion +parseGHCupGHCDir (toFilePath -> f) = do + fp <- throwEither $ E.decodeUtf8' f + throwEither $ MP.parse ghcTargetVerP "" fp + + +mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs) +mkGhcupTmpDir = do + 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 + + + + + -------------- + --[ Others ]-- + -------------- + + +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 + + +useXDG :: IO Bool +useXDG = isJust <$> getEnv "GHCUP_USE_XDG_DIRS" + + +relativeSymlink :: Path Abs -- ^ the path in which to create the symlink + -> Path Abs -- ^ the symlink destination + -> ByteString +relativeSymlink (toFilePath -> p1) (toFilePath -> 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 ("/" : drop (length common) d2) + + + + diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/File.hs @@ -0,0 +1,494 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +{-| +Module : GHCup.Utils.File +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 where + +import GHCup.Utils.Prelude +import GHCup.Types + +import Control.Concurrent +import Control.Concurrent.Async +import Control.Exception ( evaluate ) +import Control.Exception.Safe +import Control.Monad +import Control.Monad.Logger +import Control.Monad.Reader +import Control.Monad.Trans.State.Strict +import Data.ByteString ( ByteString ) +import Data.Foldable +import Data.Functor +import Data.IORef +import Data.Maybe +import Data.Sequence ( Seq, (|>) ) +import Data.String.Interpolate +import Data.Text ( Text ) +import Data.Void +import Data.Word8 +import GHC.IO.Exception +import HPath +import HPath.IO hiding ( hideError ) +import Optics hiding ((<|), (|>)) +import System.Console.Pretty hiding ( Pretty ) +import System.Console.Regions +import System.IO.Error +import System.Posix.Directory.ByteString +import System.Posix.FD as FD +import System.Posix.FilePath hiding ( () ) +import System.Posix.Files.ByteString +import System.Posix.Foreign ( oExcl ) +import "unix" System.Posix.IO.ByteString + hiding ( openFd ) +import System.Posix.Process ( ProcessStatus(..) ) +import System.Posix.Types +import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) +import Text.Regex.Posix + + +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.ByteString + as SPPB +import Streamly.External.Posix.DirStream +import qualified Streamly.Prelude as S +import qualified Text.Megaparsec as MP +import qualified Data.ByteString as BS +import qualified "unix-bytestring" System.Posix.IO.ByteString + as SPIB + + + +data ProcessError = NonZeroExit Int ByteString [ByteString] + | PTerminated ByteString [ByteString] + | PStopped ByteString [ByteString] + | NoSuchPid ByteString [ByteString] + deriving Show + +instance Pretty ProcessError where + pPrint (NonZeroExit e exe args) = + text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} failed with exit code #{e}.|] + pPrint (PTerminated exe args) = + text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} terminated.|] + pPrint (PStopped exe args) = + text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} stopped.|] + pPrint (NoSuchPid exe args) = + text [i|Could not find PID for process running "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args}.|] + +data CapturedProcess = CapturedProcess + { _exitCode :: ExitCode + , _stdOut :: ByteString + , _stdErr :: ByteString + } + deriving (Eq, Show) + +makeLenses ''CapturedProcess + + +-- | 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 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) + -- 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 :: (MonadReader AppState m, MonadIO m, MonadThrow m) + => 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 + -> m (Either ProcessError ()) +execLogged exe spath args lfile chdir env = do + AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask + logfile <- (logsDir ) <$> parseRel (toFilePath lfile <> ".log") + liftIO $ bracket (createFile (toFilePath logfile) newFilePerms) + closeFd + (action verbose) + where + action verbose 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 + ) + (putMVar done ()) + + -- fork the subprocess + pid <- SPPB.forkProcess $ do + void $ dupTo stdoutWrite stdOutput + void $ dupTo stdoutWrite stdError + closeFd stdoutRead + closeFd stdoutWrite + + -- execute the action + maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir + void $ SPPB.executeFile exe spath args env + + closeFd stdoutWrite + + -- wait for the subprocess to finish + e <- toProcessError exe args <$!> SPPB.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 fdIn = readTilEOF lineAction fdIn + + 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 -> IO () + printToRegion fileFd fdIn size pState = do + void $ displayConsoleRegions $ do + rs <- + liftIO + . fmap Sq.fromList + . sequence + . replicate size + . openConsoleRegion + $ Linear + flip runStateT mempty + $ handle + (\(ex :: SomeException) -> do + ps <- liftIO $ takeMVar pState + when ps (forM_ rs (liftIO . closeConsoleRegion)) + throw ex + ) + $ readTilEOF (lineAction rs) fdIn + + where + -- action to perform line by line + -- TODO: do this with vty for efficiency + lineAction :: (MonadMask m, MonadIO m) + => Seq ConsoleRegion + -> ByteString + -> StateT (Seq ByteString) m () + lineAction rs = \bs' -> do + void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n") + modify (swapRegs bs') + regs <- get + liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do + w <- consoleWidth + return + . T.pack + . color Blue + . T.unpack + . decUTF8Safe + . trim w + . (\b -> "[ " <> toFilePath 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 <- 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 + a <- action + void $ evaluate a + + -- close everything we don't need + closeFd childStdoutWrite + closeFd childStderrWrite + + -- start thread that writes the output + refOut <- newIORef BS.empty + refErr <- newIORef BS.empty + done <- newEmptyMVar + _ <- + forkIO + $ EX.handle (\(_ :: IOException) -> pure ()) + $ flip EX.finally (putMVar done ()) + $ writeStds parentStdoutRead parentStderrRead refOut refErr + + status <- SPPB.getProcessStatus True True pid + void $ race (takeMVar done) (threadDelay (1000000 * 3)) + + case status of + -- readFd will take care of closing the fd + Just (SPPB.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 pout perr rout rerr = do + doneOut <- newEmptyMVar + void + $ forkIO + $ hideError eofErrorType + $ flip EX.finally (putMVar doneOut ()) + $ readTilEOF (\x -> modifyIORef' rout (<> x)) pout + doneErr <- newEmptyMVar + void + $ forkIO + $ hideError eofErrorType + $ flip EX.finally (putMVar doneErr ()) + $ readTilEOF (\x -> modifyIORef' rerr (<> 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 -> 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 xi)) -> Left $ NonZeroExit xi exe args + Just (SPPB.Exited ExitSuccess ) -> Right () + Just (Terminated _ _ ) -> Left $ PTerminated exe args + Just (Stopped _ ) -> Left $ PStopped exe args + Nothing -> Left $ NoSuchPid exe args + + +-- | 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 [InappropriateType, PermissionDenied, 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 + + +-- | Check wether a binary is shadowed by another one that comes before +-- it in PATH. Returns the path to said binary, if any. +isShadowed :: Path Abs -> IO (Maybe (Path Abs)) +isShadowed p = do + let dir = dirname p + fn <- basename p + spaths <- catMaybes . fmap parseAbs <$> 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 :: Path Abs -> IO Bool +isInPath p = do + let dir = dirname p + fn <- basename p + spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath + if dir `elem` spaths + then isJust <$> searchPath [dir] fn + else pure False + + +findFiles :: Path Abs -> Regex -> IO [Path Rel] +findFiles path regex = do + dirStream <- openDirStream (toFilePath path) + f <- + (fmap . fmap) snd + . S.toList + . S.filter (\(_, p) -> match regex p) + $ dirContentsStream dirStream + pure $ parseRel =<< f + + +findFiles' :: Path Abs -> MP.Parsec Void Text () -> IO [Path Rel] +findFiles' path parser = do + dirStream <- openDirStream (toFilePath path) + f <- + (fmap . fmap) snd + . S.toList + . S.filter (\(_, p) -> case E.decodeUtf8' p of + Left _ -> False + Right p' -> isJust $ MP.parseMaybe parser p') + $ dirContentsStream dirStream + pure $ parseRel =<< f + + +isBrokenSymlink :: Path Abs -> IO Bool +isBrokenSymlink p = + handleIO + (\e -> if ioeGetErrorType e == NoSuchThing then pure True else throwIO e) + $ do + _ <- canonicalizePath p + pure False + + +chmod_755 :: (MonadLogger m, MonadIO m) => Path a -> m () +chmod_755 (toFilePath -> fp) = do + let exe_mode = + nullFileMode + `unionFileModes` ownerExecuteMode + `unionFileModes` ownerReadMode + `unionFileModes` ownerWriteMode + `unionFileModes` groupExecuteMode + `unionFileModes` groupReadMode + `unionFileModes` otherExecuteMode + `unionFileModes` otherReadMode + $(logDebug) [i|chmod 755 #{fp}|] + liftIO $ setFileMode fp exe_mode diff --git a/lib/GHCup/Utils/Logger.hs b/lib/GHCup/Utils/Logger.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/Logger.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE FlexibleContexts #-} + +{-| +Module : GHCup.Utils.Logger +Description : logger definition +Copyright : (c) Julian Ospald, 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +Here we define our main logger. +-} +module GHCup.Utils.Logger where + +import GHCup.Types +import GHCup.Utils + +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Reader +import Control.Monad.Logger +import HPath +import HPath.IO +import Prelude hiding ( appendFile ) +import System.Console.Pretty +import System.IO.Error + +import qualified Data.ByteString as B + + +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 + } + + +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") + + when (lcPrintDebug || (not lcPrintDebug && (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 :: (MonadIO m, MonadReader AppState m) => Path Rel -> m (Path Abs) +initGHCupFileLogging context = do + AppState {dirs = Dirs {..}} <- ask + let logfile = logsDir context + liftIO $ do + createDirRecursive' logsDir + hideError doesNotExistErrorType $ deleteFile logfile + createRegularFile newFilePerms logfile + pure logfile diff --git a/lib/GHCup/Utils/MegaParsec.hs b/lib/GHCup/Utils/MegaParsec.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/MegaParsec.hs @@ -0,0 +1,110 @@ +{-# 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 : POSIX +-} +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 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 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 diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/Prelude.hs @@ -0,0 +1,286 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# 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 : POSIX + +GHCup specific prelude. Lots of Excepts functionality. +-} +module GHCup.Utils.Prelude where + +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Class ( lift ) +import Data.Bifunctor +import Data.ByteString ( ByteString ) +import Data.String +import Data.Text ( Text ) +import Data.Versions +import Data.Word8 +import Haskus.Utils.Types.List +import Haskus.Utils.Variant.Excepts +import System.IO.Error +import System.Posix.Env.ByteString ( getEnvironment ) + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Data.Strict.Maybe as S +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 + + + +fS :: IsString a => String -> a +fS = fromString + +fromStrictMaybe :: S.Maybe a -> Maybe a +fromStrictMaybe = S.maybe Nothing Just + +fSM :: S.Maybe a -> Maybe a +fSM = fromStrictMaybe + +toStrictMaybe :: Maybe a -> S.Maybe a +toStrictMaybe = maybe S.Nothing S.Just + +tSM :: Maybe a -> S.Maybe a +tSM = toStrictMaybe + +internalError :: String -> IO a +internalError = fail . ("Internal error: " <>) + +iE :: String -> IO a +iE = internalError + + +showT :: Show a => a -> Text +showT = fS . show + +-- | Like 'when', but where the test can be monadic. +whenM :: Monad m => m Bool -> m () -> m () +whenM ~b ~t = ifM b t (return ()) + +-- | Like 'unless', but where the test can be monadic. +unlessM :: Monad m => m Bool -> m () -> m () +unlessM ~b ~f = ifM b (return ()) f + +-- | Like @if@, but where the test can be monadic. +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM ~b ~t ~f = do + b' <- b + if b' then t else f + +whileM :: Monad m => m a -> (a -> m Bool) -> m a +whileM ~action ~f = do + a <- action + b' <- f a + if b' then whileM action f else pure a + +whileM_ :: Monad m => m a -> (a -> m Bool) -> m () +whileM_ ~action = void . whileM action + +guardM :: (Monad m, Alternative m) => m Bool -> m () +guardM ~f = guard =<< f + + +handleIO' :: (MonadIO m, MonadCatch m) + => IOErrorType + -> (IOException -> m a) + -> m a + -> m a +handleIO' err handler = handleIO + (\e -> if err == ioeGetErrorType e then handler e else liftIO $ ioError e) + + +(??) :: forall e es a m . (Monad m, e :< es) => Maybe a -> e -> Excepts es m a +(??) m e = maybe (throwE e) pure m + + +(!?) :: forall e es a m + . (Monad m, e :< es) + => m (Maybe a) + -> e + -> Excepts es m a +(!?) em e = lift em >>= (?? e) + + +lE :: forall e es a m . (Monad m, e :< es) => Either e a -> Excepts es m a +lE = liftE . veitherToExcepts . fromEither + +lE' :: forall e' e es a m + . (Monad m, e :< es) + => (e' -> e) + -> Either e' a + -> Excepts es m a +lE' f = liftE . veitherToExcepts . fromEither . first f + +lEM :: forall e es a m . (Monad m, e :< es) => m (Either e a) -> Excepts es m a +lEM em = lift em >>= lE + +lEM' :: forall e' e es a m + . (Monad m, e :< es) + => (e' -> e) + -> m (Either e' a) + -> Excepts es m a +lEM' f em = lift em >>= lE . first f + +fromEither :: Either a b -> VEither '[a] b +fromEither = either (VLeft . V) VRight + + +liftIOException' :: ( MonadCatch m + , MonadIO m + , Monad m + , e :< es' + , LiftVariant es es' + ) + => IOErrorType + -> e + -> Excepts es m a + -> Excepts es' m a +liftIOException' errType ex = + handleIO + (\e -> + if errType == ioeGetErrorType e then throwE ex else liftIO $ ioError e + ) + . liftE + + +liftIOException :: (MonadCatch m, MonadIO m, Monad m, e :< es') + => IOErrorType + -> e + -> m a + -> Excepts es' m a +liftIOException errType ex = + handleIO + (\e -> + if errType == ioeGetErrorType e then throwE ex else liftIO $ ioError e + ) + . 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 errs def = + handleIO (\e -> if ioeGetErrorType e `elem` errs then pure def else ioError e) + + +hideErrorDefM :: [IOErrorType] -> IO a -> IO a -> IO a +hideErrorDefM errs def = + handleIO (\e -> if ioeGetErrorType e `elem` errs then def else ioError e) + + +-- TODO: does this work? +hideExcept :: forall e es es' a m + . (Monad m, e :< es, LiftVariant (Remove e es) es') + => e + -> a + -> Excepts es m a + -> Excepts es' m a +hideExcept _ a = + catchLiftLeft ((\_ -> pure a) :: (e -> Excepts es' m a)) + + +hideExcept' :: forall e es es' m + . (Monad m, e :< es, LiftVariant (Remove e es) es') + => e + -> Excepts es m () + -> Excepts es' m () +hideExcept' _ = + catchLiftLeft ((\_ -> pure ()) :: (e -> Excepts es' m ())) + + +reThrowAll :: forall e es es' a m + . (Monad m, e :< es') + => (V es -> e) + -> Excepts es m a + -> Excepts es' m a +reThrowAll f = catchAllE (throwE . f) + + +reThrowAllIO :: forall e es es' a m + . (MonadCatch m, Monad m, MonadIO m, e :< es') + => (V es -> e) + -> (IOException -> e) + -> Excepts es m a + -> Excepts es' m a +reThrowAllIO f g = handleIO (throwE . g) . catchAllE (throwE . f) + + +throwEither :: (Exception a, MonadThrow m) => Either a b -> m b +throwEither a = case a of + Left e -> throwM e + 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 + + +verToBS :: Version -> ByteString +verToBS = E.encodeUtf8 . prettyVer + + +intToText :: Integral a => a -> T.Text +intToText = TL.toStrict . B.toLazyText . B.decimal + + +removeLensFieldLabel :: String -> String +removeLensFieldLabel str' = + maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str' + + +addToCurrentEnv :: MonadIO m + => [(ByteString, ByteString)] + -> m [(ByteString, ByteString)] +addToCurrentEnv adds = do + cEnv <- liftIO getEnvironment + pure (adds ++ cEnv) + + +pvpToVersion :: PVP -> Version +pvpToVersion = + either (\_ -> error "Couldn't convert PVP to Version") id + . version + . prettyPVP + + +-- | 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 + diff --git a/lib/GHCup/Utils/String/QQ.hs b/lib/GHCup/Utils/String/QQ.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/String/QQ.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module : GHCup.Utils.String.QQ +Description : String quasi quoters +Copyright : (c) Audrey Tang 2019, Julian Ospald 2020 +License : LGPL-3.0 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +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 + ) +where + + +import Data.Char +import GHC.Exts ( IsString(..) ) +import Language.Haskell.TH.Quote + +-- | QuasiQuoter for a non-interpolating ASCII IsString literal. +-- The pattern portion is undefined. +s :: QuasiQuoter +s = QuasiQuoter + (\s' -> case and $ fmap isAscii s' of + True -> (\a -> [|fromString a|]) . trimLeadingNewline . removeCRs $ s' + False -> fail "Not ascii" + ) + (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 + diff --git a/lib/GHCup/Utils/Version/QQ.hs b/lib/GHCup/Utils/Version/QQ.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Utils/Version/QQ.hs @@ -0,0 +1,104 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# 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 : POSIX +-} +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 + , dataToExpQ + ) +import qualified Data.Text as T +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) +deriving instance Lift (NonEmpty Word) +#endif + +qq :: (Text -> Q Exp) -> QuasiQuoter +qq quoteExp' = QuasiQuoter + { quoteExp = \s -> quoteExp' . T.pack $ s + , quotePat = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" + , quoteType = \_ -> + fail "illegal QuasiQuote (allowed as expression only, used as a type)" + , quoteDec = \_ -> fail + "illegal QuasiQuote (allowed as expression only, used as a declaration)" + } + +vver :: QuasiQuoter +vver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . version + +mver :: QuasiQuoter +mver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . mess + +sver :: QuasiQuoter +sver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . semver + +vers :: QuasiQuoter +vers = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . versioning + +pver :: QuasiQuoter +pver = qq mkV + where + mkV :: Text -> Q Exp + mkV = either (fail . show) liftDataWithText . pvp + +-- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable +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) diff --git a/lib/GHCup/Version.hs b/lib/GHCup/Version.hs new file mode 100644 --- /dev/null +++ b/lib/GHCup/Version.hs @@ -0,0 +1,49 @@ +{-# 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 : POSIX +-} +module GHCup.Version where + +import GHCup.Types +import Paths_ghcup (version) + +import Data.Version (Version(versionBranch)) +import Data.Versions hiding (version) +import URI.ByteString +import URI.ByteString.QQ + +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T + +-- | This reflects the API version of the YAML. +ghcupURL :: URI +ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.4.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 + diff --git a/test/GHCup/ArbitraryTypes.hs b/test/GHCup/ArbitraryTypes.hs new file mode 100644 --- /dev/null +++ b/test/GHCup/ArbitraryTypes.hs @@ -0,0 +1,198 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module GHCup.ArbitraryTypes where + + +import GHCup.Types + +import Data.ByteString ( ByteString ) +import Data.Versions +import Data.List.NonEmpty +import HPath +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary ) +import Test.QuickCheck.Arbitrary.Generic +import URI.ByteString + +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import qualified Data.Text.Lazy as T + ( toStrict ) +import qualified Data.Text.Lazy.Builder as B +import qualified Data.Text.Lazy.Builder.Int as B + + + ----------------- + --[ utilities ]-- + ----------------- + +intToText :: Integral a => a -> T.Text +intToText = T.toStrict . B.toLazyText . B.decimal + +genVer :: Gen (Int, Int, Int) +genVer = + (\x y z -> (getPositive x, getPositive y, getPositive z)) + <$> arbitrary + <*> arbitrary + <*> arbitrary + + +instance ToADTArbitrary GHCupInfo + + + + ---------------------- + --[ base arbitrary ]-- + ---------------------- + +instance Arbitrary T.Text where + arbitrary = fmap T.pack $ listOf $ elements ['a' .. 'z'] + shrink xs = T.pack <$> shrink (T.unpack xs) + +instance Arbitrary (NonEmpty Word) where + arbitrary = fmap fromList $ listOf1 arbitrary + +-- utf8 encoded bytestring +instance Arbitrary ByteString where + arbitrary = fmap (E.encodeUtf8 . T.pack) $ listOf $ elements ['a' .. 'z'] + + + + --------------------- + --[ uri arbitrary ]-- + --------------------- + +instance Arbitrary Scheme where + arbitrary = oneof [ pure (Scheme "http"), pure (Scheme "https") ] + +instance Arbitrary Host where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary Port where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary (URIRef Absolute) where + arbitrary = + URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing + + + + ------------------------- + --[ version arbitrary ]-- + ------------------------- + +instance Arbitrary Mess where + arbitrary = do + (x, y, z) <- genVer + pure + $ either (error . show) id + $ mess (intToText x <> "." <> intToText y <> "." <> intToText z) + +instance Arbitrary Version where + arbitrary = do + (x, y, z) <- genVer + pure + $ either (error . show) id + $ version (intToText x <> "." <> intToText y <> "." <> intToText z) + +instance Arbitrary SemVer where + arbitrary = do + (x, y, z) <- genVer + pure + $ either (error . show) id + $ semver (intToText x <> "." <> intToText y <> "." <> intToText z) + +instance Arbitrary PVP where + arbitrary = do + (x, y, z) <- genVer + pure + $ either (error . show) id + $ pvp (intToText x <> "." <> intToText y <> "." <> intToText z) + +instance Arbitrary Versioning where + arbitrary = Ideal <$> arbitrary + + + + ----------------------- + --[ ghcup arbitrary ]-- + ----------------------- + +instance Arbitrary Requirements where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary DownloadInfo where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary LinuxDistro where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary Platform where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary Tag where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary Architecture where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary VersionInfo where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary VersionRange where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary (NonEmpty VersionCmp) where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary VersionCmp where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary (Path Rel) where + arbitrary = + either (error . show) id . parseRel . E.encodeUtf8 . T.pack + <$> listOf1 (elements ['a' .. 'z']) + +instance Arbitrary TarDir where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary Tool where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary GHCupInfo where + arbitrary = genericArbitrary + shrink = genericShrink + + +-- our maps are nested... the default size easily blows up most ppls ram + +instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Tool v) where + arbitrary = resize 8 $ M.fromList <$> arbitrary + +instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Version) v) where + arbitrary = resize 8 $ M.fromList <$> arbitrary + +instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Platform v) where + arbitrary = resize 8 $ M.fromList <$> arbitrary + +instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Versioning) v) where + arbitrary = resize 8 $ M.fromList <$> arbitrary + diff --git a/test/GHCup/Types/JSONSpec.hs b/test/GHCup/Types/JSONSpec.hs new file mode 100644 --- /dev/null +++ b/test/GHCup/Types/JSONSpec.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeApplications #-} + +module GHCup.Types.JSONSpec where + +import GHCup.ArbitraryTypes () +import GHCup.Types +import GHCup.Types.JSON () + +import Test.Aeson.GenericSpecs +import Test.Hspec + + + +spec :: Spec +spec = do + roundtripAndGoldenSpecs (Proxy @GHCupInfo) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,10 @@ +import Test.Hspec.Runner +import Test.Hspec.Formatters +import qualified Spec + + +main :: IO () +main = + hspecWith + defaultConfig { configFormatter = Just progress } + Spec.spec diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +-- file test/Spec.hs +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}