ghcup (empty) → 0.1.14.1
raw patch · 36 files changed
+11867/−0 lines, 36 filesdep +HsOpenSSLdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HsOpenSSL, QuickCheck, aeson, aeson-pretty, ascii-string, async, base, base16-bytestring, binary, brick, bytestring, bz2, case-insensitive, casing, concurrent-output, containers, cryptohash-sha256, generic-arbitrary, generics-sop, ghcup, haskus-utils-types, haskus-utils-variant, hpath, hpath-directory, hpath-filepath, hpath-io, hpath-posix, hspec, hspec-golden-aeson, http-io-streams, io-streams, libarchive, lzma-static, megaparsec, monad-logger, mtl, optics, optics-vl, optparse-applicative, os-release, parsec, pretty, pretty-terminal, quickcheck-arbitrary-adt, regex-posix, resourcet, safe, safe-exceptions, split, streamly, streamly-bytestring, streamly-posix, strict-base, string-interpolate, tar-bytestring, template-haskell, terminal-progress-bar, text, time, transformers, unix, unix-bytestring, unordered-containers, uri-bytestring, utf8-string, vector, versions, vty, word8, yaml, zlib
Files
- CHANGELOG.md +130/−0
- HACKING.md +75/−0
- LICENSE +165/−0
- README.md +243/−0
- RELEASING.md +19/−0
- Setup.hs +2/−0
- app/ghcup-gen/Main.hs +130/−0
- app/ghcup-gen/Validate.hs +268/−0
- app/ghcup/BrickMain.hs +605/−0
- app/ghcup/Main.hs +1866/−0
- config.yaml +61/−0
- ghcup-0.0.4.yaml +1833/−0
- ghcup.cabal +305/−0
- lib/GHCup.hs +1372/−0
- lib/GHCup/Download.hs +522/−0
- lib/GHCup/Download/IOStreams.hs +249/−0
- lib/GHCup/Download/Utils.hs +60/−0
- lib/GHCup/Errors.hs +342/−0
- lib/GHCup/Platform.hs +195/−0
- lib/GHCup/Requirements.hs +68/−0
- lib/GHCup/Types.hs +415/−0
- lib/GHCup/Types/JSON.hs +324/−0
- lib/GHCup/Types/Optics.hs +60/−0
- lib/GHCup/Utils.hs +883/−0
- lib/GHCup/Utils/Dirs.hs +273/−0
- lib/GHCup/Utils/File.hs +494/−0
- lib/GHCup/Utils/Logger.hs +75/−0
- lib/GHCup/Utils/MegaParsec.hs +110/−0
- lib/GHCup/Utils/Prelude.hs +286/−0
- lib/GHCup/Utils/String/QQ.hs +58/−0
- lib/GHCup/Utils/Version/QQ.hs +104/−0
- lib/GHCup/Version.hs +49/−0
- test/GHCup/ArbitraryTypes.hs +198/−0
- test/GHCup/Types/JSONSpec.hs +16/−0
- test/Main.hs +10/−0
- test/Spec.hs +2/−0
+ CHANGELOG.md view
@@ -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 <url> <version>`+* fix bug when cabal isn't marked executable in bindist+* fix bug when `~/.ghcup` is a valid symlink wrt #49+* Drop support for compiling cabal from source (the old bootstrap script is discontinued)++## 0.1.10 -- 2020-08-14++* Show stray Cabals (useful for pre-releases or compiled ones)++## 0.1.9 -- 2020-08-14++* Fix bug when uninstalling all cabal versions+* Fix bug when setting a non-installed ghc version as current default+* Use yaml instead of generated json for download info for ease of adding new GHC versions #44+* Allow pre-release versions of GHC/cabal+* Add XDG dirs support (set `GHCUP_USE_XDG_DIRS`) wrt #39+* Allow to specify regex for tarball subdir (e.g. `ghc-.*`)+* Allow installing arbitrary bindists more seamlessly:+ - e.g. installing GHC HEAD: `ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": { "RegexDir": "ghc-.*"}, "dlUri": "https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27" }' head`+* Avoid duplicate edits to .bashrc/.zshrc wrt #43++## 0.1.8 -- 2020-07-21++* Fix bug in logging thread dying on newlines+* Allow to install from arbitrary bindists: `ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": "ghc-8.10.1", "dlUri": "https://github.com/commercialhaskell/ghc/releases/download/ghc-8.10.1-release/ghc-8.10.1-x86_64-deb9-linux.tar.xz"}' 8.10.1`++## 0.1.7 -- 2020-07-20++* Fix a bug in libarchive not unpacking some uncleanly packed bindists+* Improved fish support in bootstrap-haskell+* Only check for upgrades when not upgrading+* Fix platform detection for i386 docker images+* Improve alpine support+ - more/proper bindists+ - don't fall back to glibc based bindists+ - install bindists with `--disable-ld-override` to avoid ld.gold bugs++## 0.1.6 -- 2020-07-13++* Create a new curses (brick) based TUI, accessible via `ghcup tui` #24+* Support multiple installed versions of cabal #23+* Improvements to `ghcup list` (show unavailable bindists for platform)+* Fix redhat downloads #29+* Support for hadrian bindists (fixes alpine-8.10.1) #31+* Add FreeBSD bindists 8.6.5 and 8.8.3+* Fix memory leak during unpack++## 0.1.5 -- 2020-04-30++* Fix errors when PATH variable contains path components that are actually files+* Add `--version` and `--numeric-version` options+* Add `changelog` command+* Also check for available GHC and Cabal updates on start+* Add base versions as tags for every GHC version (these are "installable" tags and the latest GHC version matching the tag will be picked)+* Added `--format-raw` to list subcommand+* Allow to install X.Y versions (e.g.: ghcup install 8.8)+* Implement `--keep=<always|errors|never>` to control temporary build directories cleanup+* Add proper shell completions to the repo+* Fix building of documentation+* Allow to work in offline mode and use cached files if possible+* Allow to set the downloader via `--downloader=<curl|wget>`+* Support for compiling and installing a cross GHC (see README). This is experimental.++## 0.1.4 -- 2020-04-16++* build on all platforms with curl (as a binary), wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/6+* Fix unlinking of ghc symlinks after new installation, wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/7++## 0.1.3 -- 2020-04-15++* Fix lesser bug when skipping ghcup update++## 0.1.2 -- 2020-04-15++* Fix bug when removing the set GHC version+* Fix use of undocumented `GHCUP_INSTALL_BASE_PREFIX` variable+* skip upgrade if ghcup is already latest version++## 0.1.1 -- 2020-04-15++* fix awful fdopendir bug on mac bug by updating hpath-posix++## 0.1.0++* First version. Released on an unsuspecting world.
+ HACKING.md view
@@ -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++<interactive>:2:1: error:+ • An_AffineFold cannot be used as A_Getter+ • In the expression: view (_Just % to (++ "abc")) Nothing+ In an equation for ‘it’: it = view (_Just % to (++ "abc")) Nothing+```++### 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-ver>.yaml`.++## Common Tasks++### Adding a new GHC version++1. open the latest `ghcup-<yaml-ver>.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-ver>.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.
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.
+ README.md view
@@ -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/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.++Optionally, an unversioned `ghc` link can point to a default version of your choice.++This uses precompiled GHC binaries that have been compiled on fedora/debian by [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries).++Alternatively, you can also tell it to compile from source (note that this might fail due to missing requirements).++In addition this script can also install `cabal-install`.++## Known users++* 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/<version-name>/bin/ghc` or set that GHC version+as the current one via: `ghcup set ghc <version-name>`.++This problem doesn't exist for regularly installed GHC versions.++### Limited distributions supported++Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.++### Precompiled binaries++Since this uses precompiled binaries you may run into+several problems.++#### Missing libtinfo (ncurses)++You may run into problems with *ncurses* and **missing libtinfo**, in case+your distribution doesn't use the legacy way of building+ncurses and has no compatibility symlinks in place.++Ask your distributor on how to solve this or+try to compile from source via `ghcup compile <version>`.++#### Libnuma required++This was a [bug](https://ghc.haskell.org/trac/ghc/ticket/15688) in the build system of some GHC versions that lead to+unconditionally enabled libnuma support. To mitigate this you might have to install the libnuma+package of your distribution. See [here](https://gitlab.haskell.org/haskell/ghcup/issues/58) for a discussion.++### Compilation++Although this script can compile GHC for you, it's just a very thin+wrapper around the build system. It makes no effort in trying+to figure out whether you have the correct toolchain and+the correct dependencies. Refer to [the official docs](https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Linux)+on how to prepare your environment for building GHC.++## 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?
+ RELEASING.md view
@@ -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-<ver>.yaml`, then verify with `ghcup-gen check -f ghcup-<ver>.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-<ver>.yaml` to `webhost.haskell.org/ghcup/data/`.++9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup`
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/ghcup-gen/Main.hs view
@@ -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 "<tool>-<version>" <> value def+ <> help "Only check certain tarballs (format: <tool>-<version>)"+ 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
+ app/ghcup-gen/Validate.hs view
@@ -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
+ app/ghcup/BrickMain.hs view
@@ -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}|]+
+ app/ghcup/Main.hs view
@@ -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 "<always|errors|never>"+ <> help+ "Keep build directories? (default: errors)"+ <> hidden+ ))+ <*> optional (option+ (eitherReader downloaderParser)+ ( long "downloader"+#if defined(INTERNAL_DOWNLOADER)+ <> metavar "<internal|curl|wget>"+ <> help+ "Downloader to use (default: internal)"+#else+ <> metavar "<curl|wget>"+ <> 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/<ghcver>" directory+ and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".++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/<binary>".|]++ 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 "<ghc|cabal>" <> help+ "Tool to list versions for. Default is all"+ )+ )+ <*> optional+ (option+ (eitherReader criteriaParser)+ ( short 'c'+ <> long "show-criteria"+ <> metavar "<installed|set>"+ <> 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 "<ghc|cabal|ghcup>" <> 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/<ghcver>" directory+ and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".++ This also allows building a cross-compiler. Consult the documentation+ first: <https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#configuring-the-build>++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 <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]++ 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}|]+
+ config.yaml view
@@ -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"
+ ghcup-0.0.4.yaml view
@@ -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-<ghcver>"+ 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
+ ghcup.cabal view
@@ -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
+ lib/GHCup.hs view
@@ -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/\<ver\>@ 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-\<ver\>@ 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-<ghcver>+ 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-\<ghcver\>@+-- 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\/\<ver\>\/bin\/ghc@+-- * SetGHC_XY: @~\/.ghcup\/bin\/ghc-X.Y -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@+-- * SetGHC_XYZ: @~\/.ghcup\/bin\/ghc-\<ver\> -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@+--+-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/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-<ghcver> 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)+
+ lib/GHCup/Download.hs view
@@ -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 []+
+ lib/GHCup/Download/IOStreams.hs view
@@ -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)
+ lib/GHCup/Download/Utils.hs view
@@ -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+
+ lib/GHCup/Errors.hs view
@@ -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
+ lib/GHCup/Platform.hs view
@@ -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)
+ lib/GHCup/Requirements.hs view
@@ -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
+ lib/GHCup/Types.hs view
@@ -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: <target-triple>-<version>+instance Pretty GHCTargetVersion where+ pPrint = text . T.unpack . tVerToText+++-- | A comparator and a version.+data VersionCmp = VR_gt Versioning+ | VR_gteq Versioning+ | VR_lt Versioning+ | VR_lteq Versioning+ | VR_eq Versioning+ deriving (Eq, GHC.Generic, Ord, Show)+++-- | 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
+ lib/GHCup/Types/JSON.hs view
@@ -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
+ lib/GHCup/Types/Optics.hs view
@@ -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
+ lib/GHCup/Utils.hs view
@@ -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/<ver>/bin/ghc+ -- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>+ 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/<dir>.+-- 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\/\<ver\>\/bin\/\*@+-- while ignoring @*-\<ver\>@ 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 <ver> 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\/\<ver\>\/@ 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)
+ lib/GHCup/Utils/Dirs.hs view
@@ -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/<ghcupGHCDir>'.+-- 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)++++
+ lib/GHCup/Utils/File.hs view
@@ -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
+ lib/GHCup/Utils/Logger.hs view
@@ -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
+ lib/GHCup/Utils/MegaParsec.hs view
@@ -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
+ lib/GHCup/Utils/Prelude.hs view
@@ -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+
+ lib/GHCup/Utils/String/QQ.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TemplateHaskell #-}++{-|+Module : GHCup.Utils.String.QQ+Description : String quasi quoters+Copyright : (c) Audrey Tang <audreyt@audreyt.org> 2019, Julian Ospald <hasufell@posteo.de> 2020+License : LGPL-3.0+Maintainer : hasufell@hasufell.de+Stability : experimental+Portability : 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+
+ lib/GHCup/Utils/Version/QQ.hs view
@@ -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)
+ lib/GHCup/Version.hs view
@@ -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+
+ test/GHCup/ArbitraryTypes.hs view
@@ -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+
+ test/GHCup/Types/JSONSpec.hs view
@@ -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)
+ test/Main.hs view
@@ -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
+ test/Spec.hs view
@@ -0,0 +1,2 @@+-- file test/Spec.hs+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}