Update secret

File needs to be unlinked first, because it might
potentially be in use.

.gitignore

@@ -1 +1,2 @@
 dist-newstyle/
+.stack-work/

.travis.yml

@@ -0,0 +1,25 @@
+jobs:
+  include:
+    - os: osx
+      osx_image: xcode10.1
+      language: generic
+      env: ARTIFACT=x86_64-apple-darwin-10.13-ghcup
+
+    - os: osx
+      osx_image: xcode11.3
+      language: generic
+      env: ARTIFACT=x86_64-apple-darwin-10.14-ghcup
+
+script: ".travis/build.sh"
+
+deploy:
+  provider: releases
+  api_key:
+    secure: GQESg4TcYf3PQJRRaZV/kWS0hsF+OFnH2+EcwpgnIcfx4+aogMyprdh745KtBXe1FlFN1luKHksFjqceqhcg/xcNyeCJiSnLWMn4D/i4WUperEHseRBi5yZZCB1AvOjIlHrE4DS3a8pyEm1GV3G7CKY5Fu8jBjof2SnyENfd7fofhjtNHWmeFS+jBn8HRDf1YaSRYxzTw6uHLrPLsybfgQZVl7babMu/38Ghin0f5pz5OlNokzDxaubIYQHOZ7st7YndHJtBWWql/KualBWbMILy88dUVQBnbqQLP2P8d1ME8ILUjJVqz33HiRU0JzlEJyWfbvEjcJ6iD8M6n4nXTaxfu3i2UhhGsQ6SSBNKssMP4tji8nkNpMqG59wLQ/zhcetEm71fKkgJNrIMNllkqlWSo5K74IqqP9kiLg/qm8ipOJjui0gPk8tZXKcV+ztX1d1OVCapoLfiDM5l/0LLQXaTOXOV1x3e5LLQ/w2doNiH3eh5CV4II9dRu7owpaiiMBHMssmT0pH99jEeF6giHLKtt3y7l2GWoRLPdhsZZ54gxsaBxZt9GuypmkbNcr97CEnAVaWij5v0CF3w4rAWqy/tAxQpIDJOIOQBgmwG5WrBAKyKrFvEpBL5a8BPcRWJDvqKC83QeWpvPrEVdgJevC6ZN1MKzrb2SiPOwC2Kerc=
+  file: $ARTIFACT
+  on:
+    repo: haskell/ghcup-hs
+    tags: true
+  skip_cleanup: true
+  draft: true
+

.travis/build.sh

@@ -0,0 +1,22 @@
+#/bin/sh
+
+set -ex
+
+## install ghc via old ghcup
+
+mkdir -p ~/.ghcup/bin
+curl https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > ~/.ghcup/bin/ghcup
+chmod +x ~/.ghcup/bin/ghcup
+
+export PATH="$HOME/.ghcup/bin:$PATH"
+
+ghcup install 8.8.3
+ghcup install-cabal 3.2.0.0
+ghcup set 8.8.3
+
+
+## install ghcup
+
+cabal update
+cabal build -fcurl
+cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" "./${ARTIFACT}"

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for ghcup
 
-## 0.1.0.0 -- YYYY-mm-dd
+## 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.

Dockerfile

@@ -0,0 +1,42 @@
+FROM alpine:edge
+
+# ghc and cabal
+RUN apk add --no-cache \
+	curl \
+	gcc \
+	g++ \
+	gmp-dev \
+	ncurses-dev \
+	libffi-dev \
+	make \
+	xz \
+	tar \
+	perl \
+	\
+	cabal \
+	ghc
+
+# utils
+RUN apk add --no-cache \
+	bash
+
+## Package specific
+RUN apk add --no-cache \
+	zlib \
+	zlib-dev \
+	zlib-static \
+	gmp \
+	gmp-dev \
+	openssl-dev \
+	openssl-libs-static \
+	xz \
+	xz-dev
+
+RUN cabal v2-update
+
+COPY . /app
+
+WORKDIR /app
+
+RUN chmod +x /app/docker/build.sh
+

HACKING.md

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

README.md

@@ -1,37 +1,144 @@
-# ghcup
+`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).
 
-A rewrite of ghcup in haskell.
+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).
 
-## TODO
+*Ubuntu users may prefer [hvr's ppa](https://launchpad.net/~hvr/+archive/ubuntu/ghc).*
 
-* create static ghcup binaries
+## Table of Contents
-    * adjust url in GHCupDownloads
-* add print-system-reqs command
 
-## Motivation
+   * [Installation](#installation)
+   * [Usage](#usage)
+     * [Manpages](#manpages)
+   * [Design goals](#design-goals)
+   * [How](#how)
+   * [Known users](#known-users)
+   * [Known problems](#known-problems)
+   * [FAQ](#faq)
 
-Maintenance problems:
+## Installation
 
-* platform incompatibilities regularly causing breaking bugs:
+### Simple bootstrap
-	* [Mktemp not working properly on macOS](https://gitlab.haskell.org/haskell/ghcup/issues/130)
-	* [ln: illegal option -- T on macOS Catalina](https://gitlab.haskell.org/haskell/ghcup/issues/123)
-	* [Wrong tar flag on darwin](https://gitlab.haskell.org/haskell/ghcup/issues/119))
-* refactoring being difficult due to POSIX sh
 
-Benefits of a rewrite:
+Follow the instructions at [https://www.haskell.org/ghcup/](https://www.haskell.org/ghcup/)
 
-* Features such as installing [release candidates](https://gitlab.haskell.org/haskell/ghcup/issues/94) or [HEAD builds](https://gitlab.haskell.org/haskell/ghcup/issues/65) can be more conveniently implemented in a rewrite
+### Manual install
-* Refactoring will be easier
-* Better tool support (such as linting the downloads file)
-* saner downloads file format (such as JSON)
 
-Downsides:
+Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
+and place it into your `PATH` anywhere.
 
-* building static binaries for all platforms (and possibly causing SSL/DNS problems)
+Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
-* still bootstrapping those binaries via a POSIX sh script
 
-## Goals
+```sh
+export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
+```
+
+## Usage
+
+See `ghcup --help`.
+
+Common use cases are:
+
+```sh
+# list available ghc/cabal versions
+ghcup list
+
+# install the recommended GHC version
+ghcup install
+
+# install a specific GHC version
+ghcup install 8.2.2
+
+# set the currently "active" GHC version
+ghcup set 8.4.4
+
+# install cabal-install
+ghcup install-cabal
+
+# update ghcup itself
+ghcup upgrade
+```
+
+Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
+handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler)  of `ghc` is available, which `ghcup` can do.
+
+### Manpages
+
+For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
+`MANPATH` may be required to be unset.
+
+## Design goals
+
+1. simplicity
+2. non-interactive
+3. portable (eh)
+4. do one thing and do it well (UNIX philosophy)
+
+### Non-goals
+
+1. invoking `sudo`, `apt-get` or *any* package manager
+2. handling system packages
+3. handling cabal projects
+4. being a stack alternative
+
+## How
+
+Installs a specified GHC version into `~/.ghcup/ghc/<ver>`, and places `ghc-<ver>` symlinks in `~/.ghcup/bin/`.
+
+Optionally, an unversioned `ghc` link can point to a default version of your choice.
+
+This uses precompiled GHC binaries that have been compiled on fedora/debian by [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries).
+
+Alternatively, you can also tell it to compile from source (note that this might fail due to missing requirements).
+
+In addition this script can also install `cabal-install`.
+
+## Known users
+
+* [vabal](https://github.com/Franciman/vabal)
+
+## Known problems
+
+### Limited distributions supported
+
+Currently only GNU/Linux distributions compatible with the [upstream GHC](https://www.haskell.org/ghc/download_ghc_8_6_1.html#binaries) binaries are supported.
+
+### Precompiled binaries
+
+Since this uses precompiled binaries you may run into
+several problems.
+
+#### Missing libtinfo (ncurses)
+
+You may run into problems with *ncurses* and **missing libtinfo**, in case
+your distribution doesn't use the legacy way of building
+ncurses and has no compatibility symlinks in place.
+
+Ask your distributor on how to solve this or
+try to compile from source via `ghcup compile <version>`.
+
+#### Libnuma required
+
+This was a [bug](https://ghc.haskell.org/trac/ghc/ticket/15688) in the build system of some GHC versions that lead to
+unconditionally enabled libnuma support. To mitigate this you might have to install the libnuma
+package of your distribution. See [here](https://gitlab.haskell.org/haskell/ghcup/issues/58) for a discussion.
+
+### Compilation
+
+Although this script can compile GHC for you, it's just a very thin
+wrapper around the build system. It makes no effort in trying
+to figure out whether you have the correct toolchain and
+the correct dependencies. Refer to [the official docs](https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Linux)
+on how to prepare your environment for building GHC.
+
+## FAQ
+
+1. Why reimplement stack?
+
+ghcup is not a reimplementation of stack. The only common part is automatic installation of GHC, but even that differs in scope and design.
+
+2. Why not support windows?
+
+Consider using [Chocolatey](https://chocolatey.org/search?q=ghc) or [ghcups](https://github.com/kakkun61/ghcups).
 
-* Correct low-level code
-* Good exception handling
-* Cleaner user interface

RELEASING.md

@@ -0,0 +1,11 @@
+# RELEASING
+
+1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the JSON representation of it. The version of the json represents the change increments. `ghcUpVer` is the current application version.
+
+2. Add/fix downloads to `GHCupDownloads` module, then run `ghcup-gen gen` to generate the new json and validate it via `ghcup-gen check`.
+
+3. Commit and git push with tag. Wait for tests to succeed.
+
+4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
+
+5. Build ghcup releases for Linux (fully static), mac (with `-fcurl`) and FreeBSD (with `-fcurl`). Upload to `webhost.haskell.org/ghcup/bin/` and update symlinks.

TODO.md

@@ -0,0 +1,31 @@
+# TODOs and Remarks
+
+## Now
+
+* ghcup migration
+* update static links
+
+* releases, update download info and bootstrap-haskell
+
+## Maybe
+
+* maybe: changelog          Show the changelog of a GHC release (online)
+* sign the JSON? (Or check gpg keys?)
+* testing (especially distro detection -> unit tests)
+
+## Later
+
+* i386 support
+* add support for RC/alpha/HEAD versions
+
+## Cleanups
+
+* too many decodeutf8
+* avoid alternative for IO
+* use plucky or oops instead of Excepts
+
+## Questions
+
+* mirror support
+* interactive handling when distro doesn't exist and we know the tarball is incompatible?
+* ghcup-with wrapper to execute a command with a given ghc in PATH?

app/ghcup-gen/GHCupInfo.hs

@@ -0,0 +1,11 @@
+module GHCupInfo where
+
+import           GHCupDownloads
+import           ToolRequirements
+import           GHCup.Types
+
+
+ghcupInfo :: GHCupInfo
+ghcupInfo = GHCupInfo { _toolRequirements = toolRequirements
+                      , _ghcupDownloads   = ghcupDownloads
+                      }

app/ghcup-gen/Main.hs

@@ -1,20 +1,25 @@
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
 {-# 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           GHCupDownloads
+import           GHCupInfo
 
-import           Data.Aeson                     ( eitherDecode )
+import           Data.Aeson                     ( eitherDecode, encode )
 import           Data.Aeson.Encode.Pretty
+#if !MIN_VERSION_base(4,13,0)
 import           Data.Semigroup                 ( (<>) )
+#endif
 import           Options.Applicative     hiding ( style )
 import           System.Console.Pretty
 import           System.Exit
@@ -57,10 +62,13 @@ outputP = fileOutput <|> stdOutput
 
 data GenJSONOpts = GenJSONOpts
   { output :: Maybe Output
+  , pretty :: Bool
   }
 
 genJSONOpts :: Parser GenJSONOpts
-genJSONOpts = GenJSONOpts <$> optional outputP
+genJSONOpts = GenJSONOpts <$> optional outputP <*> switch
+  (short 'p' <> long "pretty" <> help "Make JSON output pretty (human readable)"
+  )
 
 
 data Input
@@ -130,14 +138,16 @@ main = do
   customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
     >>= \Options {..} -> case optCommand of
           GenJSON gopts -> do
-            let
+            let bs True =
-              bs = encodePretty' (defConfig { confIndent = Spaces 2 })
+                  encodePretty' (defConfig { confIndent = Spaces 2 }) ghcupInfo
-                                 ghcupDownloads
+                bs False = encode ghcupInfo
             case gopts of
-              GenJSONOpts { output = Nothing }        -> L.hPutStr stdout bs
+              GenJSONOpts { output = Nothing, pretty } ->
-              GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs
+                L.hPutStr stdout (bs pretty)
-              GenJSONOpts { output = Just (FileOutput file) } ->
+              GenJSONOpts { output = Just StdOutput, pretty } ->
-                L.writeFile file bs
+                L.hPutStr stdout (bs pretty)
+              GenJSONOpts { output = Just (FileOutput file), pretty } ->
+                L.writeFile file (bs pretty)
           ValidateJSON vopts -> case vopts of
             ValidateJSONOpts { input = Nothing } ->
               L.getContents >>= valAndExit validate
@@ -156,9 +166,8 @@ main = do
 
  where
   valAndExit f contents = do
-    av <- case eitherDecode contents of
+    (GHCupInfo _ av) <- case eitherDecode 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/ToolRequirements.hs

@@ -0,0 +1,94 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+
+module ToolRequirements where
+
+import           GHCup.Types
+import           GHCup.Utils.String.QQ
+
+import qualified Data.Map                      as M
+
+
+
+-- | Currently 'GHC' is used for both GHC and cabal to simplify
+-- this, until we need actual separation.
+toolRequirements :: ToolRequirements
+toolRequirements = M.fromList
+  [ ( GHC
+    , M.fromList
+      [ ( Nothing
+        , M.fromList
+          [ ( Linux UnknownLinux
+            , M.fromList
+              [ ( Nothing
+                , Requirements
+                  []
+                  [s|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.|]
+                )
+              ]
+            )
+          , ( Linux Alpine
+            , M.fromList
+              [ ( Nothing
+                , Requirements
+                  [ "curl"
+                  , "gcc"
+                  , "g++"
+                  , "gmp-dev"
+                  , "ncurses-dev"
+                  , "libffi-dev"
+                  , "make"
+                  , "xz"
+                  , "tar"
+                  , "perl"
+                  ]
+                  ""
+                )
+              ]
+            )
+          , ( Linux Ubuntu
+            , M.fromList
+              [ ( Nothing
+                , Requirements
+                  [ "build-essential"
+                  , "curl"
+                  , "libgmp-dev"
+                  , "libffi-dev"
+                  , "libncurses-dev"
+                  , "libtinfo5"
+                  ]
+                  ""
+                )
+              ]
+            )
+          , ( Darwin
+            , M.fromList
+              [ ( Nothing
+                , Requirements
+                  []
+                  "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
+            , M.fromList
+              [ ( Nothing
+                , Requirements
+                  [ "curl"
+                  , "gcc"
+                  , "gmp"
+                  , "gmake"
+                  , "ncurses"
+                  , "perl5"
+                  , "libffi"
+                  , "libiconv"
+                  ]
+                  ""
+                )
+              ]
+            )
+          ]
+        )
+      ]
+    )
+  ]

app/ghcup-gen/Validate.hs

@@ -161,7 +161,7 @@ validateTarballs dls = do
 
  where
   downloadAll dli = do
-    let settings = Settings True GHCupURL False
+    let settings = Settings True False
     let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
                                            , colorOutter  = B.hPut stderr
                                            , rawOutter    = (\_ -> pure ())

app/ghcup/Main.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
 
@@ -11,22 +13,30 @@ module Main where
 import           GHCup
 import           GHCup.Download
 import           GHCup.Errors
+import           GHCup.Platform
+import           GHCup.Requirements
 import           GHCup.Types
 import           GHCup.Utils
 import           GHCup.Utils.Logger
 import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
 import           GHCup.Version
 
+#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 )
-import           Data.Semigroup                 ( (<>) )
 import           Data.String.Interpolate
+import           Data.Text                      ( Text )
 import           Data.Versions
+import           Data.Void
+import           GHC.IO.Encoding
 import           Haskus.Utils.Variant.Excepts
 import           HPath
 import           HPath.IO
@@ -45,6 +55,7 @@ import qualified Data.ByteString.UTF8          as UTF8
 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
 
 
 
@@ -62,7 +73,8 @@ data Options = Options
   }
 
 data Command
-  = Install InstallCommand
+  = Install InstallOptions
+  | InstallCabal InstallOptions
   | SetGHC SetGHCOptions
   | List ListOptions
   | Rm RmOptions
@@ -70,16 +82,15 @@ data Command
   | Compile CompileCommand
   | Upgrade UpgradeOpts
   | NumericVersion
+  | ToolRequirements
 
 data ToolVersion = ToolVersion Version
                  | ToolTag Tag
 
 
-data InstallCommand = InstallGHC InstallOptions
-                    | InstallCabal InstallOptions
-
 data InstallOptions = InstallOptions
-  { instVer :: Maybe ToolVersion
+  { instVer      :: Maybe ToolVersion
+  , instPlatform :: Maybe PlatformRequest
   }
 
 data SetGHCOptions = SetGHCOptions
@@ -102,9 +113,10 @@ data CompileCommand = CompileGHC CompileOptions
 
 data CompileOptions = CompileOptions
   { targetVer    :: Version
-  , bootstrapVer :: Version
+  , bootstrapGhc :: Either Version (Path Abs)
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe (Path Abs)
+  , patchDir     :: Maybe (Path Abs)
   }
 
 data UpgradeOpts = UpgradeInplace
@@ -118,23 +130,26 @@ opts =
   Options
     <$> switch
           (short 'v' <> long "verbose" <> help
-            "Whether to enable verbosity (default: False)"
+            "Enable verbosity"
           )
     <*> switch
           (short 'c' <> long "cache" <> help
-            "Whether to cache downloads (default: False)"
+            "Cache downloads in ~/.ghcup/cache"
           )
     <*> (optional
           (option
             (eitherReader parseUri)
-            (short 's' <> long "url-source" <> metavar "URL" <> help
+            (  short 's'
-              "Alternative ghcup download info url" <> internal
+            <> long "url-source"
+            <> metavar "URL"
+            <> help "Alternative ghcup download info url"
+            <> internal
             )
           )
         )
     <*> switch
           (short 'n' <> long "no-verify" <> help
-            "Skip tarball checksum verification (default: False)"
+            "Skip tarball checksum verification"
           )
     <*> com
  where
@@ -147,11 +162,29 @@ com =
   subparser
       (  command
           "install"
-          (   Install
+          ((info ((Install <$> installOpts) <**> helper)
-          <$> (info (installP <**> helper)
+                 (progDesc "Install or update GHC")
-                    (progDesc "Install or update GHC/cabal")
+           )
-              )
           )
+      <> command
+           "set"
+           (   SetGHC
+           <$> (info (setGHCOpts <**> helper)
+                     (progDesc "Set currently active GHC version")
+               )
+           )
+      <> command
+           "rm"
+           (   Rm
+           <$> (info (rmOpts <**> helper) (progDesc "Remove a GHC version"))
+           )
+
+      <> command
+           "install-cabal"
+           ((info ((InstallCabal <$> installOpts) <**> helper)
+                  (progDesc "Install or update cabal")
+            )
+           )
       <> command
            "list"
            (   List
@@ -162,39 +195,17 @@ com =
       <> command
            "upgrade"
            (   Upgrade
-           <$> (info
+           <$> (info (upgradeOptsP <**> helper) (progDesc "Upgrade ghcup"))
-                 (upgradeOptsP <**> helper)
+           )
-                 (progDesc "Upgrade ghcup (per default in ~/.ghcup/bin/)")
+      <> command
+           "compile"
+           (   Compile
+           <$> (info (compileP <**> helper)
+                     (progDesc "Compile a tool from source")
                )
            )
-          <> command
-               "compile"
-               (   Compile
-               <$> (info (compileP <**> helper)
-                         (progDesc "Compile a tool from source")
-                   )
-               )
       <> commandGroup "Main commands:"
       )
-    <|> subparser
-          (  command
-              "set"
-              (   SetGHC
-              <$> (info (setGHCOpts <**> helper)
-                        (progDesc "Set the currently active GHC version")
-                  )
-              )
-          <> command
-               "rm"
-               (   Rm
-               <$> (info
-                     (rmOpts <**> helper)
-                     (progDesc "Remove a GHC version installed by ghcup")
-                   )
-               )
-          <> commandGroup "GHC commands:"
-          <> hidden
-          )
     <|> subparser
           (  command
               "debug-info"
@@ -204,32 +215,37 @@ com =
                (   (\_ -> NumericVersion)
                <$> (info (helper) (progDesc "Show the numeric version"))
                )
+          <> command
+               "tool-requirements"
+               (   (\_ -> ToolRequirements)
+               <$> (info (helper)
+                         (progDesc "Show the requirements for ghc/cabal")
+                   )
+               )
           <> commandGroup "Other commands:"
           <> hidden
           )
 
 
-installP :: Parser InstallCommand
-installP = subparser
-  (  command
-      "ghc"
-      (   InstallGHC
-      <$> (info (installOpts <**> helper) (progDesc "Install a GHC version"))
-      )
-  <> command
-       "cabal"
-       (   InstallCabal
-       <$> (info (installOpts <**> helper)
-                 (progDesc "Install or update a Cabal version")
-           )
-       )
-  )
-
 installOpts :: Parser InstallOptions
-installOpts = InstallOptions <$> optional toolVersionParser
+installOpts =
+  (flip InstallOptions)
+    <$> (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 toolVersionArgument
+
 
 setGHCOpts :: Parser SetGHCOptions
-setGHCOpts = SetGHCOptions <$> optional toolVersionParser
+setGHCOpts = SetGHCOptions <$> optional toolVersionArgument
 
 listOpts :: Parser ListOptions
 listOpts =
@@ -253,7 +269,7 @@ listOpts =
         )
 
 rmOpts :: Parser RmOptions
-rmOpts = RmOptions <$> versionParser
+rmOpts = RmOptions <$> versionArgument
 
 
 compileP :: Parser CompileCommand
@@ -287,12 +303,16 @@ compileOpts =
         )
     <*> (option
           (eitherReader
-            (bimap (const "Not a valid version") id . version . T.pack)
+            (\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-version"
+          <> long "bootstrap-ghc"
-          <> metavar "BOOTSTRAP_VERSION"
+          <> metavar "BOOTSTRAP_GHC"
-          <> help "The GHC version to bootstrap with (must be installed)"
+          <> help
+               "The GHC version (or full path) to bootstrap with (must be installed)"
           )
         )
     <*> optional
@@ -315,13 +335,19 @@ compileOpts =
               "Absolute path to build config file"
             )
           )
-
+    <*> optional
-
+          (option
-versionParser :: Parser Version
+            (eitherReader
-versionParser = option
+              (\x ->
-  (eitherReader (bimap (const "Not a valid version") id . version . T.pack))
+                bimap show id . parseAbs . E.encodeUtf8 . T.pack $ x :: Either
-  (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
+                    String
-  )
+                    (Path Abs)
+              )
+            )
+            (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+              "Absolute path to patch directory (applied in order, uses -p1)"
+            )
+          )
 
 
 toolVersionParser :: Parser ToolVersion
@@ -331,16 +357,44 @@ toolVersionParser = verP <|> toolP
   toolP =
     ToolTag
       <$> (option
-            (eitherReader
+            (eitherReader tagEither)
-              (\s' -> case fmap toLower s' of
-                "recommended" -> Right Recommended
-                "latest"      -> Right Latest
-                other         -> Left ([i|Unknown tag #{other}|])
-              )
-            )
             (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
           )
 
+-- | same as toolVersionParser, except as an argument.
+toolVersionArgument :: Parser ToolVersion
+toolVersionArgument =
+  argument (eitherReader toolVersionEither) (metavar "VERSION|TAG")
+
+
+versionArgument :: Parser Version
+versionArgument = argument
+  (eitherReader versionEither)
+  (metavar "VERSION")
+
+versionParser :: Parser Version
+versionParser = option
+  (eitherReader versionEither)
+  (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
+  )
+
+tagEither :: String -> Either String Tag
+tagEither s' = case fmap toLower s' of
+  "recommended" -> Right Recommended
+  "latest"      -> Right Latest
+  other         -> Left ([i|Unknown tag #{other}|])
+
+versionEither :: String -> Either String Version
+versionEither s' =
+  -- 'version' is a bit too lax and will parse typoed tags
+  case readMaybe ((:[]) . head $ s') :: Maybe Int of
+    Just _  -> bimap (const "Not a valid version") id . version . T.pack $ s'
+    Nothing -> Left "Not a valid version"
+
+toolVersionEither :: String -> Either String ToolVersion
+toolVersionEither s' =
+  bimap id ToolTag (tagEither s') <|> bimap id ToolVersion (versionEither s')
+
 
 toolParser :: String -> Either String Tool
 toolParser s' | t == T.pack "ghc"   = Right GHC
@@ -356,11 +410,83 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
   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
+    ]
+  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
+
+  choice' []       = fail "Empty list"
+  choice' [x     ] = x
+  choice' (x : xs) = MP.try x <|> choice' xs
+
+  parseUntil :: MP.Parsec Void Text Text -> 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)
+          )
+
+
 toSettings :: Options -> Settings
 toSettings Options {..} =
-  let cache     = optCache
+  let cache    = optCache
-      urlSource = maybe GHCupURL OwnSource optUrlSource
+      noVerify = optNoVerify
-      noVerify  = optNoVerify
   in  Settings { .. }
 
 
@@ -397,8 +523,12 @@ main = do
     >>= \opt@Options {..} -> do
           let settings = toSettings opt
 
+          -- create ~/.ghcup dir
+          ghcdir <- ghcupBaseDir
+          createDirIfMissing newDirPerms ghcdir
+
           -- logger interpreter
-          logfile <- initGHCupFileLogging ([rel|ghcup.log|] :: Path Rel)
+          logfile <- initGHCupFileLogging [rel|ghcup.log|]
           let runLogger = myLoggerT LoggerConfig
                 { lcPrintDebug = optVerbose
                 , colorOutter  = B.hPut stderr
@@ -416,7 +546,6 @@ main = do
                       , DistroNotFound
                       , FileDoesNotExistError
                       , CopyError
-                      , JSONError
                       , NoCompatibleArch
                       , NoDownload
                       , NotInstalled
@@ -427,22 +556,21 @@ main = do
                       , DownloadFailed
                       ]
 
-          let runSetGHC =
+          let
-                runLogger
+            runSetGHC =
-                  . flip runReaderT settings
+              runLogger
-                  . runE
+                . flip runReaderT settings
-                    @'[ FileDoesNotExistError
+                . runE
-                      , NotInstalled
+                  @'[ FileDoesNotExistError
-                      , TagNotFound
+                    , NotInstalled
-                      , JSONError
+                    , TagNotFound
-                      , TagNotFound
+                    , TagNotFound
-                      , DownloadFailed
+                    ]
-                      ]
 
           let runListGHC =
                 runLogger
                   . flip runReaderT settings
-                  . runE @'[FileDoesNotExistError , JSONError , DownloadFailed]
+                  . runE @'[FileDoesNotExistError]
 
           let runRmGHC =
                 runLogger . flip runReaderT settings . runE @'[NotInstalled]
@@ -461,12 +589,15 @@ main = do
                     @'[ AlreadyInstalled
                       , BuildFailed
                       , DigestError
+                      , DistroNotFound
                       , DownloadFailed
                       , GHCupSetError
+                      , NoCompatibleArch
+                      , NoCompatiblePlatform
                       , NoDownload
+                      , NotFoundInPATH
+                      , PatchFailed
                       , UnknownArchive
-                     --
-                      , JSONError
                       ]
 
           let runCompileCabal =
@@ -474,12 +605,15 @@ main = do
                   . flip runReaderT settings
                   . runResourceT
                   . runE
-                    @'[ JSONError
+                    @'[ BuildFailed
-                      , UnknownArchive
-                      , NoDownload
                       , DigestError
+                      , DistroNotFound
                       , DownloadFailed
-                      , BuildFailed
+                      , NoCompatibleArch
+                      , NoCompatiblePlatform
+                      , NoDownload
+                      , PatchFailed
+                      , UnknownArchive
                       ]
 
           let runUpgrade =
@@ -493,30 +627,42 @@ main = do
                       , NoCompatibleArch
                       , NoDownload
                       , FileDoesNotExistError
-                      , JSONError
-                      , DownloadFailed
                       , CopyError
+                      , DownloadFailed
                       ]
 
+          (GHCupInfo treq dls) <-
+            ( runLogger
+              . flip runReaderT settings
+              . runE @'[JSONError , DownloadFailed]
+              $ liftE
+              $ getDownloads (maybe GHCupURL OwnSource optUrlSource)
+              )
+              >>= \case
+                    VRight r -> pure r
+                    VLeft e ->
+                      runLogger
+                          ($(logError) [i|Error fetching download info: #{e}|])
+                        >> exitFailure
+          runLogger $ checkForUpdates dls
 
           case optCommand of
-            Install (InstallGHC InstallOptions {..}) ->
+            Install (InstallOptions {..}) ->
               void
                 $   (runInstTool $ do
-                      dls <- liftE getDownloads
+                      v <- liftE $ fromVersion dls instVer GHC
-                      v   <- liftE $ fromVersion dls instVer GHC
+                      liftE $ installGHCBin dls v instPlatform
-                      liftE $ installGHCBin dls v Nothing
                     )
                 >>= \case
-                      VRight _ -> runLogger
+                      VRight _ ->
-                        $ $(logInfo) ([s|GHC installation successful|])
+                        runLogger $ $(logInfo) ("GHC installation successful")
                       VLeft (V (AlreadyInstalled _ v)) ->
                         runLogger $ $(logWarn)
                           [i|GHC ver #{prettyVer v} already installed|]
                       VLeft (V (BuildFailed tmpdir e)) ->
                         runLogger
                             ($(logError) [i|Build failed with #{e}
-Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.|]
+Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
                             )
                           >> exitFailure
                       VLeft e -> do
@@ -524,16 +670,15 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
                           $(logError) [i|#{e}|]
                           $(logError) [i|Also check the logs in ~/.ghcup/logs|]
                         exitFailure
-            Install (InstallCabal InstallOptions {..}) ->
+            InstallCabal (InstallOptions {..}) ->
               void
                 $   (runInstTool $ do
-                      dls <- liftE getDownloads
+                      v <- liftE $ fromVersion dls instVer Cabal
-                      v   <- liftE $ fromVersion dls instVer Cabal
+                      liftE $ installCabalBin dls v instPlatform
-                      liftE $ installCabalBin dls v Nothing
                     )
                 >>= \case
-                      VRight _ -> runLogger
+                      VRight _ ->
-                        $ $(logInfo) ([s|Cabal installation successful|])
+                        runLogger $ $(logInfo) ("Cabal installation successful")
                       VLeft (V (AlreadyInstalled _ v)) ->
                         runLogger $ $(logWarn)
                           [i|Cabal ver #{prettyVer v} already installed|]
@@ -546,20 +691,18 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
             SetGHC (SetGHCOptions {..}) ->
               void
                 $   (runSetGHC $ do
-                      dls <- liftE getDownloads
+                      v <- liftE $ fromVersion dls ghcVer GHC
-                      v   <- liftE $ fromVersion dls ghcVer GHC
                       liftE $ setGHC v SetGHCOnly
                     )
                 >>= \case
                       VRight _ ->
-                        runLogger $ $(logInfo) ([s|GHC successfully set|])
+                        runLogger $ $(logInfo) ("GHC successfully set")
                       VLeft e ->
                         runLogger ($(logError) [i|#{e}|]) >> exitFailure
 
             List (ListOptions {..}) ->
               void
                 $   (runListGHC $ do
-                      dls <- liftE getDownloads
                       liftIO $ listVersions dls lTool lCriteria
                     )
                 >>= \case
@@ -590,21 +733,20 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
             Compile (CompileGHC CompileOptions {..}) ->
               void
                 $   (runCompileGHC $ do
-                      dls <- liftE getDownloads
                       liftE
-                        $ compileGHC dls targetVer bootstrapVer jobs buildConfig
+                        $ compileGHC dls targetVer bootstrapGhc jobs buildConfig patchDir
                     )
                 >>= \case
                       VRight _ ->
                         runLogger $ $(logInfo)
-                          ([s|GHC successfully compiled and installed|])
+                          ("GHC successfully compiled and installed")
                       VLeft (V (AlreadyInstalled _ v)) ->
                         runLogger $ $(logWarn)
                           [i|GHC ver #{prettyVer v} already installed|]
                       VLeft (V (BuildFailed tmpdir e)) ->
                         runLogger
                             ($(logError) [i|Build failed with #{e}
-Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.|]
+Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
                             )
                           >> exitFailure
                       VLeft e ->
@@ -613,20 +755,16 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
             Compile (CompileCabal CompileOptions {..}) ->
               void
                 $   (runCompileCabal $ do
-                      dls <- liftE getDownloads
+                      liftE $ compileCabal dls targetVer bootstrapGhc jobs patchDir
-                      liftE $ compileCabal dls
-                                           targetVer
-                                           bootstrapVer
-                                           jobs
                     )
                 >>= \case
                       VRight _ ->
                         runLogger $ $(logInfo)
-                          ([s|Cabal successfully compiled and installed|])
+                          ("Cabal successfully compiled and installed")
                       VLeft (V (BuildFailed tmpdir e)) ->
                         runLogger
                             ($(logError) [i|Build failed with #{e}
-Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.|]
+Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues.|]
                             )
                           >> exitFailure
                       VLeft e ->
@@ -641,11 +779,10 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
                 (UpgradeAt p)   -> pure $ Just p
                 UpgradeGHCupDir -> do
                   bdir <- liftIO $ ghcupBinDir
-                  pure (Just (bdir </> ([rel|ghcup|] :: Path Rel)))
+                  pure (Just (bdir </> [rel|ghcup|]))
 
               void
                 $   (runUpgrade $ do
-                      dls <- liftE getDownloads
                       liftE $ upgradeGHCup dls target
                     )
                 >>= \case
@@ -658,6 +795,21 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
                         runLogger ($(logError) [i|#{e}|]) >> exitFailure
 
             NumericVersion -> T.hPutStr stdout (prettyPVP ghcUpVer)
+            ToolRequirements -> (runLogger $ runE
+                      @'[ NoCompatiblePlatform
+                        , DistroNotFound
+                        , NoToolRequirements
+                        ] $ do
+                platform <- liftE $ getPlatform
+                req <- (getCommonRequirements platform $ treq)
+                         ?? NoToolRequirements
+                liftIO $ T.hPutStr stdout (prettyRequirements req))
+              >>= \case
+                    VRight r -> pure r
+                    VLeft e ->
+                      runLogger
+                          ($(logError) [i|Error getting tool requirements: #{e}|])
+                        >> exitFailure
   pure ()
 
 
@@ -677,6 +829,9 @@ fromVersion av (Just (ToolTag Recommended)) tool =
 
 printListResult :: [ListResult] -> IO ()
 printListResult lr = do
+  -- https://gitlab.haskell.org/ghc/ghc/issues/8118
+  setLocaleEncoding utf8
+
   let
     formatted =
       gridString
@@ -700,3 +855,12 @@ printListResult lr = do
             )
             lr
   putStrLn $ formatted
+
+
+checkForUpdates :: (MonadFail m, MonadLogger m) => GHCupDownloads -> m ()
+checkForUpdates dls = do
+  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'|]

bootstrap-haskell

@@ -0,0 +1,201 @@
+#!/bin/sh
+
+# safety subshell to avoid executing anything in case this script is not downloaded properly
+(
+
+: "${GHCUP_INSTALL_BASE_PREFIX:=$HOME}"
+
+die() {
+    (>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
+    exit 2
+}
+
+edo()
+{
+    "$@" || die "\"$*\" failed!"
+}
+
+eghcup() {
+    if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
+        edo ghcup "$@"
+    else
+        edo ghcup --verbose "$@"
+    fi
+}
+
+download_ghcup() {
+	_plat="$(uname -s)"
+	_arch=$(uname -m)
+
+    case "${_plat}" in
+        "linux"|"Linux")
+			case "${_arch}" in
+				x86_64|amd64)
+					_url=https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup
+					;;
+				i*86)
+					_url=https://downloads.haskell.org/~ghcup/i386-linux-ghcup
+					;;
+				*) die "Unknown architecture: ${_arch}"
+					;;
+			esac
+			;;
+        "FreeBSD"|"freebsd")
+			case "${_arch}" in
+				x86_64|amd64)
+					;;
+				i*86)
+					die "i386 currently not supported!"
+					;;
+				*) die "Unknown architecture: ${_arch}"
+					;;
+			esac
+			_url=https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup
+            ;;
+        "Darwin"|"darwin")
+			case "${_arch}" in
+				x86_64|amd64)
+					;;
+				i*86)
+					die "i386 currently not supported!"
+					;;
+				*) die "Unknown architecture: ${_arch}"
+					;;
+			esac
+			_url=https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup ;;
+        *) die "Unknown platform: ${_plat}"
+			;;
+    esac
+
+	edo curl -Lf "${_url}" > "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
+
+	unset _plat _arch _url
+}
+
+
+echo
+echo "Welcome to Haskell!"
+echo
+echo "This will download and install the Glasgow Haskell Compiler (GHC)"
+echo "and the Cabal build tool."
+echo
+echo "ghcup installs only into the following directory, which can be removed anytime:"
+echo "  $GHCUP_INSTALL_BASE_PREFIX/.ghcup"
+echo
+
+if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
+    printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed"
+    printf "\\033[0;35m%s\\033[0m\\n" "or ctrl-c to abort."
+    printf "\\033[0;35m%s\\033[0m\\n" "Note that this script can be re-run at any given time."
+    echo
+    # Wait for user input to continue.
+    # shellcheck disable=SC2034
+    read -r answer </dev/tty
+fi
+
+edo mkdir -p "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin
+
+if command -V "ghcup" >/dev/null 2>&1 ; then
+    if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
+        eghcup upgrade
+    fi
+else
+	download_ghcup
+    edo chmod +x "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/bin/ghcup
+
+	cat <<-EOF > "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/env || die "Failed to create env file"
+		export PATH="\$HOME/.cabal/bin:\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/bin:\$PATH"
+		EOF
+	# shellcheck disable=SC1090
+    edo . "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup/env
+fi
+
+echo
+echo "$(ghcup tool-requirements)"
+echo
+
+if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
+    printf "\\033[0;35m%s\\033[0m\\n" "Press ENTER to proceed"
+    printf "\\033[0;35m%s\\033[0m\\n" "or ctrl-c to abort."
+    printf "\\033[0;35m%s\\033[0m\\n" "Installation may take a while."
+    echo
+
+    # Wait for user input to continue.
+    # shellcheck disable=SC2034
+    read -r answer </dev/tty
+fi
+
+eghcup --cache install
+
+eghcup set
+eghcup --cache install-cabal
+
+edo cabal new-update
+
+printf "\\033[0;35m%s\\033[0m\\n" ""
+printf "\\033[0;35m%s\\033[0m\\n" "Installation done!"
+printf "\\033[0;35m%s\\033[0m\\n" ""
+
+if [ -z "${BOOTSTRAP_HASKELL_NONINTERACTIVE}" ] ; then
+    echo "In order to run ghc and cabal, you need to adjust your PATH variable."
+    echo "You may want to source '$GHCUP_INSTALL_BASE_PREFIX/.ghcup/env' in your shell"
+    echo "configuration to do so (e.g. ~/.bashrc)."
+
+	case $SHELL in
+		*/zsh) # login shell is zsh
+			GHCUP_PROFILE_FILE="$HOME/.zshrc"
+			MY_SHELL="zsh" ;;
+		*/bash) # login shell is bash
+			if [ -f "$HOME/.bashrc" ] ; then # bashrc is not sourced by default, so assume it isn't if file does not exist
+				GHCUP_PROFILE_FILE="$HOME/.bashrc"
+			else
+				GHCUP_PROFILE_FILE="$HOME/.bash_profile"
+			fi
+
+			MY_SHELL="bash" ;;
+		*/sh) # login shell is sh, but might be a symlink to bash or zsh
+			if [ -n "${BASH}" ] ; then
+				if [ -f "$HOME/.bashrc" ] ; then # bashrc is not sourced by default, so assume it isn't if file does not exist
+					GHCUP_PROFILE_FILE="$HOME/.bashrc"
+				else
+					GHCUP_PROFILE_FILE="$HOME/.bash_profile"
+				fi
+
+				MY_SHELL="bash"
+			elif [ -n "${ZSH_VERSION}" ] ; then
+				GHCUP_PROFILE_FILE="$HOME/.zshrc"
+				MY_SHELL="zsh"
+			else
+				exit 0
+			fi
+			;;
+		*) exit 0 ;;
+	esac
+
+
+	printf "\\033[0;35m%s\\033[0m\\n" ""
+	printf "\\033[0;35m%s\\033[0m\\n" "Detected ${MY_SHELL} shell on your system..."
+	printf "\\033[0;35m%s\\033[0m\\n" "If you want ghcup to automatically add the required PATH variable to \"${GHCUP_PROFILE_FILE}\""
+	printf "\\033[0;35m%s\\033[0m\\n" "answer with YES, otherwise with NO and press ENTER."
+	printf "\\033[0;35m%s\\033[0m\\n" ""
+
+    while true; do
+        read -r next_answer </dev/tty
+
+        case $next_answer in
+            [Yy]*)
+                echo "[ -f \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\" ] && source \"\${GHCUP_INSTALL_BASE_PREFIX:=\$HOME}/.ghcup/env\"" >> "${GHCUP_PROFILE_FILE}"
+                printf "\\033[0;35m%s\\033[0m\\n" "OK! ${GHCUP_PROFILE_FILE} has been modified. Restart your terminal for the changes to take effect,"
+                printf "\\033[0;35m%s\\033[0m\\n" "or type \"source ${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/env\" to apply them in your current terminal session."
+                exit 0;;
+            [Nn]*)
+                exit 0;;
+            *)
+                echo "Please type YES or NO and press enter.";;
+        esac
+    done
+fi
+)
+
+# vim: tabstop=4 shiftwidth=4 expandtab
+

cabal.project

@@ -1,7 +1,5 @@
 packages: ./ghcup.cabal
 
-with-compiler: ghc-8.6.5
-
 optimization: 2
 
 package streamly
@@ -13,3 +11,6 @@ package ghcup
 package tar-bytestring
     ghc-options: -O2
 
+constraints: http-io-streams -brotli
+
+allow-newer: base

cabal.project.freeze

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

docker/build.sh

@@ -0,0 +1,14 @@
+#!/bin/sh
+
+set -ex
+
+cd /app
+
+cabal v2-update
+
+cabal v2-install \
+	--install-method=copy \
+	--overwrite-policy=always \
+	--installdir="/bin" \
+	--ghc-options='-optl-static'
+

ghcup.cabal

@@ -1,234 +1,388 @@
-cabal-version:       2.2
+cabal-version:      3.0
+name:               ghcup
+version:            0.1.1
+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.
 
-name:                ghcup
+homepage:           https://gitlab.haskell.org/haskell/ghcup-hs
-version:             0.1.0.0
+bug-reports:        https://gitlab.haskell.org/haskell/ghcup-hs/issues
-synopsis:            ghc toolchain installer as an exe/library
+license:            LGPL-3.0-only
-description:         A rewrite of the shell script ghcup, for providing
+license-file:       LICENSE
-                     a more stable user experience and exposing an API.
+author:             Julian Ospald
-homepage:            https://github.com/hasufell/ghcup-hs
+maintainer:         hasufell@posteo.de
-bug-reports:         https://github.com/hasufell/ghcup-hs/issues
+copyright:          Julian Ospald 2020
-license:             LGPL-3.0-only
+category:           System
-license-file:        LICENSE
+build-type:         Simple
-author:              Julian Ospald
+extra-source-files: CHANGELOG.md
-maintainer:          hasufell@posteo.de
-copyright:           Julian Ospald 2020
-category:            System
-build-type:          Simple
-extra-source-files:  CHANGELOG.md
 
 source-repository head
-  type: git
+  type:     git
-  location: https://github.com/hasufell/ghcup-hs
+  location: https://gitlab.haskell.org/haskell/ghcup-hs.git
 
-common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 }
+flag Curl
-common aeson { build-depends: aeson >= 1.4 }
+  description: Use curl instead of http-io-streams for download
-common aeson-pretty { build-depends: aeson-pretty >= 0.8.8 }
+  default:     False
-common ascii-string { build-depends: ascii-string >= 1.0 }
+  manual:      True
-common async { build-depends: async >= 0.8 }
-common attoparsec { build-depends: attoparsec >= 0.13 }
-common base { build-depends: base >= 4.12 && < 5 }
-common binary { build-depends: binary >= 0.8.6.0 }
-common bytestring { build-depends: bytestring >= 0.10 }
-common bzlib { build-depends: bzlib >= 0.5.0.5 }
-common case-insensitive { build-depends: case-insensitive >= 1.2.1.0 }
-common containers { build-depends: containers >= 0.6 }
-common generics-sop { build-depends: generics-sop >= 0.5 }
-common haskus-utils-types { build-depends: haskus-utils-types >= 1.5 }
-common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
-common hopenssl { build-depends: hopenssl >= 2.2.4 }
-common hpath { build-depends: hpath >= 0.11 }
-common hpath-directory { build-depends: hpath-directory >= 0.13.2 }
-common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 }
-common hpath-io { build-depends: hpath-io >= 0.13.1 }
-common hpath-posix { build-depends: hpath-posix >= 0.11.1 }
-common http-io-streams { build-depends: http-io-streams >= 0.1.2.0 }
-common io-streams { build-depends: io-streams >= 1.5 }
-common language-bash { build-depends: language-bash >= 0.9 }
-common lzma { build-depends: lzma >= 0.0.0.3 }
-common monad-logger { build-depends: monad-logger >= 0.3.31 }
-common mtl { build-depends: mtl >= 2.2 }
-common optics { build-depends: optics >= 0.2 }
-common optics-vl { build-depends: optics-vl >= 0.2 }
-common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 }
-common parsec { build-depends: parsec >= 3.1 }
-common pretty-terminal { build-depends: pretty-terminal >= 0.1.0.0 }
-common resourcet { build-depends: resourcet >= 1.2.2 }
-common safe { build-depends: safe >= 0.3.18 }
-common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
-common streamly { build-depends: streamly >= 0.7.1 }
-common streamly-posix { build-depends: streamly-posix >= 0.1.0.0 }
-common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 }
-common strict-base { build-depends: strict-base >= 0.4 }
-common string-interpolate { build-depends: string-interpolate >= 0.2.0.0 }
-common table-layout { build-depends: table-layout >= 0.8 }
-common tar-bytestring { build-depends: tar-bytestring >= 0.6.3.0 }
-common template-haskell { build-depends: template-haskell >= 2.7 }
-common terminal-progress-bar { build-depends: terminal-progress-bar >= 0.4.1 }
-common text { build-depends: text >= 1.2 }
-common text-icu { build-depends: text-icu >= 0.7 }
-common time { build-depends: time >= 1.9.3 }
-common transformers { build-depends: transformers >= 0.5 }
-common unix { build-depends: unix >= 2.7 }
-common unix-bytestring { build-depends: unix-bytestring >= 0.3 }
-common uri-bytestring { build-depends: uri-bytestring >= 0.3.2.2 }
-common utf8-string { build-depends: utf8-string >= 1.0 }
-common vector { build-depends: vector >= 0.12 }
-common versions { build-depends: versions >= 3.5 }
-common waargonaut { build-depends: waargonaut >= 0.8 }
-common word8 { build-depends: word8 >= 0.1.3 }
-common zlib { build-depends: zlib >= 0.6.2.1 }
 
+common HsOpenSSL
+  build-depends: HsOpenSSL >=0.11.4.18
+
+common aeson
+  build-depends: aeson >=1.4
+
+common aeson-pretty
+  build-depends: aeson-pretty >=0.8.8
+
+common ascii-string
+  build-depends: ascii-string >=1.0
+
+common async
+  build-depends: async >=0.8
+
+common attoparsec
+  build-depends: attoparsec >=0.13
+
+common base
+  build-depends: base >=4.12 && <5
+
+common base16-bytestring
+  build-depends: base16-bytestring >= 0.1.1.6
+
+common binary
+  build-depends: binary >=0.8.6.0
+
+common bytestring
+  build-depends: bytestring >=0.10
+
+common bz2
+  build-depends: bz2 >=0.5.0.5
+
+common case-insensitive
+  build-depends: case-insensitive >=1.2.1.0
+
+common concurrent-output
+  build-depends: concurrent-output >=1.10.11
+
+common containers
+  build-depends: containers >=0.6
+
+common cryptohash-sha256
+  build-depends: cryptohash-sha256 >= 0.11.101.0
+
+common generics-sop
+  build-depends: generics-sop >=0.5
+
+common haskus-utils-types
+  build-depends: haskus-utils-types >=1.5
+
+common haskus-utils-variant
+  build-depends: haskus-utils-variant >=3.0
+
+common hpath
+  build-depends: hpath >=0.11
+
+common hpath-directory
+  build-depends: hpath-directory >=0.13.3
+
+common hpath-filepath
+  build-depends: hpath-filepath >=0.10.3
+
+common hpath-io
+  build-depends: hpath-io >=0.13.1
+
+common hpath-posix
+  build-depends: hpath-posix >=0.13.2
+
+common http-io-streams
+  build-depends: http-io-streams >=0.1.2.0
+
+common io-streams
+  build-depends: io-streams >=1.5
+
+common language-bash
+  build-depends: language-bash >=0.9
+
+common lzma
+  build-depends: lzma >=0.0.0.3
+
+common megaparsec
+  build-depends: megaparsec >=8.0.0
+
+common monad-logger
+  build-depends: monad-logger >=0.3.31
+
+common mtl
+  build-depends: mtl >=2.2
+
+common optics
+  build-depends: optics >=0.2
+
+common optics-vl
+  build-depends: optics-vl >=0.2
+
+common optparse-applicative
+  build-depends: optparse-applicative >=0.15.1.0
+
+common parsec
+  build-depends: parsec >=3.1
+
+common pretty-terminal
+  build-depends: pretty-terminal >=0.1.0.0
+
+common regex-posix
+  build-depends: regex-posix >=0.96
+
+common resourcet
+  build-depends: resourcet >=1.2.2
+
+common safe
+  build-depends: safe >=0.3.18
+
+common safe-exceptions
+  build-depends: safe-exceptions >=0.1
+
+common streamly
+  build-depends: streamly >=0.7.1
+
+common streamly-posix
+  build-depends: streamly-posix >=0.1.0.0
+
+common streamly-bytestring
+  build-depends: streamly-bytestring >=0.1.2
+
+common strict-base
+  build-depends: strict-base >=0.4
+
+common string-interpolate
+  build-depends: string-interpolate >=0.2.0.0
+
+common table-layout
+  build-depends: table-layout >=0.8
+
+common tar-bytestring
+  build-depends: tar-bytestring >=0.6.3.1
+
+common template-haskell
+  build-depends: template-haskell >=2.7
+
+common terminal-progress-bar
+  build-depends: terminal-progress-bar >=0.4.1
+
+common text
+  build-depends: text >=1.2
+
+common time
+  build-depends: time >=1.9.3
+
+common transformers
+  build-depends: transformers >=0.5
+
+common unix
+  build-depends: unix >=2.7
+
+common unix-bytestring
+  build-depends: unix-bytestring >=0.3
+
+common uri-bytestring
+  build-depends: uri-bytestring >=0.3.2.2
+
+common utf8-string
+  build-depends: utf8-string >=1.0
+
+common vector
+  build-depends: vector >=0.12
+
+common versions
+  build-depends: versions >=3.5
+
+common waargonaut
+  build-depends: waargonaut >=0.8
+
+common word8
+  build-depends: word8 >=0.1.3
+
+common zlib
+  build-depends: zlib >=0.6.2.1
 
 common config
-  default-language:     Haskell2010
+  default-language:   Haskell2010
-  ghc-options:          -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded
+  ghc-options:
-  default-extensions:     LambdaCase
+    -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-                        , MultiWayIf
+    -fwarn-incomplete-record-updates -threaded
-                        , PackageImports
+
-                        , RecordWildCards
+  default-extensions:
-                        , ScopedTypeVariables
+    LambdaCase
-                        , StrictData
+    MultiWayIf
-                        , Strict
+    PackageImports
-                        , TupleSections
+    RecordWildCards
+    ScopedTypeVariables
+    Strict
+    StrictData
+    TupleSections
 
 library
-  import:              config
+  import:
-                     , base
+    config
-                       -- deps
+    , base
-                     , HsOpenSSL
+    , base16-bytestring
-                     , aeson
+    , aeson
-                     , ascii-string
+    , ascii-string
-                     , async
+    , async
-                     , attoparsec
+    , attoparsec
-                     , binary
+    , binary
-                     , bytestring
+    , bytestring
-                     , bzlib
+    , bz2
-                     , case-insensitive
+    , case-insensitive
-                     , containers
+    , concurrent-output
-                     , generics-sop
+    , containers
-                     , haskus-utils-types
+    , cryptohash-sha256
-                     , haskus-utils-variant
+    , generics-sop
-                     , hopenssl
+    , haskus-utils-types
-                     , hpath
+    , haskus-utils-variant
-                     , hpath-directory
+    , hpath
-                     , hpath-filepath
+    , hpath-directory
-                     , hpath-io
+    , hpath-filepath
-                     , hpath-posix
+    , hpath-io
-                     , http-io-streams
+    , hpath-posix
-                     , io-streams
+    , language-bash
-                     , language-bash
+    , lzma
-                     , lzma
+    , monad-logger
-                     , monad-logger
+    , mtl
-                     , mtl
+    , optics
-                     , optics
+    , optics-vl
-                     , optics-vl
+    , parsec
-                     , parsec
+    , pretty-terminal
-                     , pretty-terminal
+    , regex-posix
-                     , resourcet
+    , resourcet
-                     , safe
+    , safe
-                     , safe-exceptions
+    , safe-exceptions
-                     , streamly
+    , streamly
-                     , streamly-posix
+    , streamly-posix
-                     , streamly-bytestring
+    , streamly-bytestring
-                     , strict-base
+    , strict-base
-                     , string-interpolate
+    , string-interpolate
-                     , tar-bytestring
+    , tar-bytestring
-                     , template-haskell
+    , template-haskell
-                     , terminal-progress-bar
+    , text
-                     , text
+    , time
-                     , text-icu
+    , transformers
-                     , time
+    , unix
-                     , transformers
+    , unix-bytestring
-                     , unix
+    , uri-bytestring
-                     , unix-bytestring
+    , utf8-string
-                     , uri-bytestring
+    , vector
-                     , utf8-string
+    , versions
-                     , vector
+    , word8
-                     , versions
+    , zlib
-                     , word8
+
-                     , zlib
+  exposed-modules:
-  exposed-modules:     GHCup
+    GHCup
-                       GHCup.Download
+    GHCup.Download
-                       GHCup.Errors
+    GHCup.Download.Utils
-                       GHCup.Platform
+    GHCup.Errors
-                       GHCup.Types
+    GHCup.Platform
-                       GHCup.Types.JSON
+    GHCup.Requirements
-                       GHCup.Types.Optics
+    GHCup.Types
-                       GHCup.Utils
+    GHCup.Types.JSON
-                       GHCup.Utils.Bash
+    GHCup.Types.Optics
-                       GHCup.Utils.Dirs
+    GHCup.Utils
-                       GHCup.Utils.File
+    GHCup.Utils.Bash
-                       GHCup.Utils.Logger
+    GHCup.Utils.Dirs
-                       GHCup.Utils.Prelude
+    GHCup.Utils.File
-                       GHCup.Utils.String.QQ
+    GHCup.Utils.Logger
-                       GHCup.Utils.Version.QQ
+    GHCup.Utils.Prelude
-                       GHCup.Version
+    GHCup.Utils.String.QQ
+    GHCup.Utils.Version.QQ
+    GHCup.Version
+
   -- other-modules:
   -- other-extensions:
-  hs-source-dirs:      lib
+  hs-source-dirs:  lib
+
+  if !flag(curl)
+    import:
+      , HsOpenSSL
+      , http-io-streams
+      , io-streams
+      , terminal-progress-bar
+    exposed-modules: GHCup.Download.IOStreams
+  else
+    cpp-options:     -DCURL
 
 executable ghcup
-  import:                config
+  import:
-                       , base
+    config
-                       --
+    , base
-                       , bytestring
+    , bytestring
-                       , containers
+    , containers
-                       , haskus-utils-variant
+    , haskus-utils-variant
-                       , monad-logger
+    , hpath
-                       , mtl
+    , hpath-io
-                       , optparse-applicative
+    , megaparsec
-                       , text
+    , monad-logger
-                       , versions
+    , mtl
-                       , hpath
+    , optparse-applicative
-                       , hpath-io
+    , pretty-terminal
-                       , pretty-terminal
+    , resourcet
-                       , resourcet
+    , string-interpolate
-                       , string-interpolate
+    , table-layout
-                       , table-layout
+    , text
-                       , uri-bytestring
+    , uri-bytestring
-                       , utf8-string
+    , utf8-string
-  main-is:             Main.hs
+    , versions
+
+  --
+  main-is:          Main.hs
+
   -- other-modules:
   -- other-extensions:
-  build-depends:       ghcup
+  build-depends:    ghcup
-  hs-source-dirs:      app/ghcup
+  hs-source-dirs:   app/ghcup
-  default-language:    Haskell2010
+  default-language: Haskell2010
 
 executable ghcup-gen
-  import:                config
+  import:
-                       , base
+    config
-                       --
+    , base
-                       , aeson
+    , aeson
-                       , aeson-pretty
+    , aeson-pretty
-                       , bytestring
+    , bytestring
-                       , containers
+    , containers
-                       , safe-exceptions
+    , haskus-utils-variant
-                       , haskus-utils-variant
+    , hpath
-                       , monad-logger
+    , monad-logger
-                       , mtl
+    , mtl
-                       , optics
+    , optics
-                       , optparse-applicative
+    , optparse-applicative
-                       , text
+    , pretty-terminal
-                       , versions
+    , resourcet
-                       , hpath
+    , safe-exceptions
-                       , pretty-terminal
+    , string-interpolate
-                       , resourcet
+    , table-layout
-                       , string-interpolate
+    , text
-                       , table-layout
+    , transformers
-                       , transformers
+    , uri-bytestring
-                       , uri-bytestring
+    , utf8-string
-                       , utf8-string
+    , versions
-  main-is:             Main.hs
+
-  other-modules:       GHCupDownloads
+  --
-                       Validate
+  main-is:          Main.hs
+  other-modules:
+    GHCupDownloads
+    GHCupInfo
+    ToolRequirements
+    Validate
+
   -- other-extensions:
-  build-depends:       ghcup
+  build-depends:    ghcup
-  hs-source-dirs:      app/ghcup-gen
+  hs-source-dirs:   app/ghcup-gen
-  default-language:    Haskell2010
+  default-language: Haskell2010
 
 test-suite ghcup-test
-  default-language:    Haskell2010
+  default-language: Haskell2010
-  type:                exitcode-stdio-1.0
+  type:             exitcode-stdio-1.0
-  hs-source-dirs:      test
+  hs-source-dirs:   test
-  main-is:             MyLibTest.hs
+  main-is:          MyLibTest.hs
-  build-depends:       base ^>=4.12.0.0
+  build-depends:    base >=4.12.0.0

lib/GHCup.hs

@@ -1,12 +1,14 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
 
 module GHCup where
 
@@ -27,10 +29,11 @@ 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.Class      ( lift )
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
 import           Data.ByteString                ( ByteString )
@@ -50,8 +53,7 @@ import           Prelude                 hiding ( abs
                                                 )
 import           System.IO.Error
 import           System.Posix.FilePath          ( getSearchPath )
-import           System.Posix.RawFilePath.Directory.Errors
+import           System.Posix.Files.ByteString
-                                                ( hideError )
 
 import qualified Data.ByteString               as B
 import qualified Data.Map.Strict               as Map
@@ -95,27 +97,33 @@ installGHCBin bDls ver mpfReq = do
   whenM (liftIO $ toolAlreadyInstalled GHC ver)
     $ (throwE $ AlreadyInstalled GHC ver)
   Settings {..} <- lift ask
+  pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
 
   -- download (or use cached version)
-  dlinfo        <- liftE $ getDownloadInfo bDls GHC ver mpfReq
+  dlinfo        <- lE $ getDownloadInfo GHC ver pfreq bDls
   dl            <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
   tmpUnpack     <- lift mkGhcupTmpDir
   liftE $ unpackToDir tmpUnpack dl
+  void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
 
   -- prepare paths
   ghcdir <- liftIO $ ghcupGHCDir ver
 
   -- the subdir of the archive where we do the work
-  let archiveSubdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
+  let workdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
 
-  catchAllE
+  -- Be careful about cleanup. We must catch both pure exceptions
-      (\es ->
+  -- as well as async ones.
-        liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
+  flip onException
-          >> throwE (BuildFailed archiveSubdir es)
+       (liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
-      )
+    $ catchAllE
-    $ installGHC' archiveSubdir ghcdir
+        (\es -> do
+          liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
+            >> throwE (BuildFailed workdir es)
+        )
+    $ installGHC' workdir ghcdir
 
   -- only clean up dir if the build succeeded
   liftIO $ deleteDirRecursive tmpUnpack
@@ -129,19 +137,14 @@ installGHCBin bDls ver mpfReq = do
               -> Path Abs      -- ^ Path to install to
               -> Excepts '[ProcessError] m ()
   installGHC' path inst = do
-    lift $ $(logInfo) [s|Installing GHC (this may take a while)|]
+    lift $ $(logInfo) "Installing GHC (this may take a while)"
-    lEM $ liftIO $ execLogged [s|./configure|]
+    lEM $ liftIO $ execLogged "./configure"
                               False
-                              [[s|--prefix=|] <> toFilePath inst]
+                              ["--prefix=" <> toFilePath inst]
-                              ([rel|ghc-configure.log|] :: Path Rel)
+                              [rel|ghc-configure|]
-                              (Just path)
-                              Nothing
-    lEM $ liftIO $ execLogged [s|make|]
-                              True
-                              [[s|install|]]
-                              ([rel|ghc-make.log|] :: Path Rel)
                               (Just path)
                               Nothing
+    lEM $ liftIO $ make ["install"] (Just path)
     pure ()
 
 
@@ -170,22 +173,24 @@ installCabalBin :: ( MonadMask m
 installCabalBin bDls ver mpfReq = do
   lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
   Settings {..} <- lift ask
+  pfreq@(PlatformRequest {..}) <- maybe (liftE $ platformRequest) pure mpfReq
 
   -- download (or use cached version)
-  dlinfo        <- liftE $ getDownloadInfo bDls Cabal ver mpfReq
+  dlinfo        <- lE $ getDownloadInfo Cabal ver pfreq bDls
   dl            <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
   tmpUnpack     <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
+  void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
 
   -- prepare paths
   bindir <- liftIO ghcupBinDir
 
   -- the subdir of the archive where we do the work
-  let archiveSubdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
+  let workdir = maybe tmpUnpack (tmpUnpack </>) (view dlSubdir dlinfo)
 
-  liftE $ installCabal' archiveSubdir bindir
+  liftE $ installCabal' workdir bindir
   pure ()
 
  where
@@ -195,8 +200,8 @@ installCabalBin bDls ver mpfReq = do
                 -> Path Abs      -- ^ Path to install to
                 -> Excepts '[CopyError] m ()
   installCabal' path inst = do
-    lift $ $(logInfo) [s|Installing cabal|]
+    lift $ $(logInfo) "Installing cabal"
-    let cabalFile = [rel|cabal|] :: Path Rel
+    let cabalFile = [rel|cabal|]
     liftIO $ createDirIfMissing newDirPerms inst
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile
       (path </> cabalFile)
@@ -247,7 +252,7 @@ setGHC ver sghc = do
       SetGHCOnly -> pure file
       SetGHC_XY  -> do
         major' <-
-          (\(mj, mi) -> E.encodeUtf8 $ intToText mj <> [s|.|] <> intToText mi)
+          (\(mj, mi) -> E.encodeUtf8 $ intToText mj <> "." <> intToText mi)
             <$> getGHCMajor ver
         parseRel (toFilePath file <> B.singleton _hyphen <> major')
       SetGHC_XYZ -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS)
@@ -273,11 +278,11 @@ setGHC ver sghc = do
     destdir <- liftIO $ ghcupBaseDir
     case sghc of
       SetGHCOnly -> do
-        let sharedir     = [rel|share|] :: Path Rel
+        let sharedir     = [rel|share|]
         let fullsharedir = ghcdir </> sharedir
         whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
           let fullF   = destdir </> sharedir
-          let targetF = [s|./ghc/|] <> verBS <> [s|/|] <> toFilePath sharedir
+          let targetF = "./ghc/" <> verBS <> "/" <> toFilePath sharedir
           $(logDebug) [i|rm -f #{fullF}|]
           liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
           $(logDebug) [i|ln -s #{targetF} #{fullF}|]
@@ -335,12 +340,12 @@ listVersions av lt criteria = case lt of
       fromSrc    <- ghcSrcInstalled v
       pure ListResult { lVer = v, lTag = tags, lTool = t, .. }
     Cabal -> do
-      lSet       <- fmap (== v) $ cabalSet
+      lSet <- fmap (== v) $ cabalSet
-      lInstalled <- cabalInstalled v
+      let lInstalled = lSet
       pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. }
     GHCup -> do
       let lSet       = prettyPVP ghcUpVer == prettyVer v
-      let lInstalled = True
+      let lInstalled = lSet
       pure ListResult { lVer = v, lTag = tags, lTool = t, fromSrc = False, .. }
 
 
@@ -393,7 +398,7 @@ rmGHCVer ver = do
         $   ghcupBaseDir
         >>= hideError doesNotExistErrorType
         .   deleteFile
-        .   (</> ([rel|share|] :: Path Rel))
+        .   (</> [rel|share|])
     else throwE (NotInstalled GHC ver)
 
 
@@ -404,19 +409,18 @@ rmGHCVer ver = do
     ------------------
 
 
-getDebugInfo :: (MonadLogger m, MonadCatch m, MonadReader Settings m, MonadIO m)
+getDebugInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
              => Excepts
                   '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
                   m
                   DebugInfo
 getDebugInfo = do
-  diBaseDir   <- liftIO $ ghcupBaseDir
+  diBaseDir  <- liftIO $ ghcupBaseDir
-  diBinDir    <- liftIO $ ghcupBinDir
+  diBinDir   <- liftIO $ ghcupBinDir
-  diGHCDir    <- liftIO $ ghcupGHCBaseDir
+  diGHCDir   <- liftIO $ ghcupGHCBaseDir
-  diCacheDir  <- liftIO $ ghcupCacheDir
+  diCacheDir <- liftIO $ ghcupCacheDir
-  diURLSource <- lift $ getUrlSource
+  diArch     <- lE getArchitecture
-  diArch      <- lE getArchitecture
+  diPlatform <- liftE $ getPlatform
-  diPlatform  <- liftE $ getPlatform
   pure $ DebugInfo { .. }
 
 
@@ -436,23 +440,29 @@ compileGHC :: ( MonadMask m
               , MonadFail m
               )
            => GHCupDownloads
-           -> Version          -- ^ version to install
+           -> Version                    -- ^ version to install
-           -> Version          -- ^ version to bootstrap with
+           -> Either Version (Path Abs)  -- ^ version to bootstrap with
-           -> Maybe Int        -- ^ jobs
+           -> Maybe Int                  -- ^ jobs
-           -> Maybe (Path Abs) -- ^ build config
+           -> Maybe (Path Abs)           -- ^ build config
+           -> Maybe (Path Abs)
            -> Excepts
                 '[ AlreadyInstalled
                  , BuildFailed
                  , DigestError
+                 , DistroNotFound
                  , DownloadFailed
                  , GHCupSetError
+                 , NoCompatibleArch
+                 , NoCompatiblePlatform
                  , NoDownload
+                 , NotFoundInPATH
+                 , PatchFailed
                  , UnknownArchive
                  ]
                 m
                 ()
-compileGHC dls tver bver jobs mbuildConfig = do
+compileGHC dls tver bstrap jobs mbuildConfig patchdir = do
-  lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bver}|]
+  lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
   whenM (liftIO $ toolAlreadyInstalled GHC tver)
         (throwE $ AlreadyInstalled GHC tver)
 
@@ -463,16 +473,24 @@ compileGHC dls tver bver jobs mbuildConfig = do
   -- unpack
   tmpUnpack <- lift mkGhcupTmpDir
   liftE $ unpackToDir tmpUnpack dl
+  (PlatformRequest {..}) <- liftE $ platformRequest
+  void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
 
-  bghc <- parseRel ([s|ghc-|] <> verToBS bver)
+  bghc <- case bstrap of
+    Right g    -> pure $ Right g
+    Left  bver -> Left <$> parseRel ("ghc-" <> verToBS bver)
   let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
   ghcdir <- liftIO $ ghcupGHCDir tver
 
-  catchAllE
+  -- Be careful about cleanup. We must catch both pure exceptions
-      (\es ->
+  -- as well as async ones.
-        liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
+  flip onException
-          >> throwE (BuildFailed workdir es)
+       (liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
-      )
+    $ catchAllE
+        (\es ->
+          liftIO (hideError doesNotExistErrorType $ deleteDirRecursive ghcdir)
+            >> throwE (BuildFailed workdir es)
+        )
     $ compile bghc ghcdir workdir
   markSrcBuilt ghcdir workdir
 
@@ -492,36 +510,49 @@ HADDOCK_DOCS = YES
 GhcWithLlvmCodeGen = YES|]
 
   compile :: (MonadCatch m, MonadLogger m, MonadIO m)
-          => Path Rel
+          => Either (Path Rel) (Path Abs)
           -> Path Abs
           -> Path Abs
           -> Excepts
-               '[NoDownload , FileDoesNotExistError , ProcessError]
+               '[ FileDoesNotExistError
+                , PatchFailed
+                , ProcessError
+                , NotFoundInPATH
+                ]
                m
                ()
   compile bghc ghcdir workdir = do
     lift $ $(logInfo) [i|configuring build|]
+
+    forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
+
+    -- force ld.bfd for build (others seem to misbehave, like lld from FreeBSD)
+    newEnv <- addToCurrentEnv [("LD", "ld.bfd")]
+
     if
       | tver >= [vver|8.8.0|] -> do
-        spaths   <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
+        bghcPath <- case bghc of
-        bghcPath <- (liftIO $ searchPath spaths bghc) !? NoDownload
+          Right ghc' -> pure ghc'
-        newEnv   <- addToCurrentEnv [([s|GHC|], toFilePath bghcPath)]
+          Left  bver -> do
-        lEM $ liftIO $ execLogged [s|./configure|]
+            spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
-                                  False
+            (liftIO $ searchPath spaths bver) !? NotFoundInPATH bver
-                                  [[s|--prefix=|] <> toFilePath ghcdir]
+        lEM $ liftIO $ execLogged
-                                  ([rel|ghc-configure.log|] :: Path Rel)
+          "./configure"
-                                  (Just workdir)
+          False
-                                  (Just newEnv)
+          ["--prefix=" <> toFilePath ghcdir]
+          [rel|ghc-conf|]
+          (Just workdir)
+          (Just (("GHC", toFilePath bghcPath) : newEnv))
       | otherwise -> do
         lEM $ liftIO $ execLogged
-          [s|./configure|]
+          "./configure"
           False
-          [ [s|--prefix=|] <> toFilePath ghcdir
+          [ "--prefix=" <> toFilePath ghcdir
-          , [s|--with-ghc=|] <> toFilePath bghc
+          , "--with-ghc=" <> either toFilePath toFilePath bghc
           ]
-          ([rel|ghc-configure.log|] :: Path Rel)
+          [rel|ghc-conf|]
           (Just workdir)
-          Nothing
+          (Just newEnv)
 
     case mbuildConfig of
       Just bc -> liftIOException
@@ -531,29 +562,18 @@ GhcWithLlvmCodeGen = YES|]
       Nothing ->
         liftIO $ writeFile (build_mk workdir) (Just newFilePerms) defaultConf
 
-    lift
+    lift $ $(logInfo) [i|Building (this may take a while)...|]
-      $ $(logInfo)
+    lEM $ liftIO $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs)
-          [i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/ghc-make.log' to see the progress.|]
+                        (Just workdir)
-    lEM $ liftIO $ execLogged [s|make|]
-                              True
-                              (maybe [] (\j -> [[s|-j|] <> fS (show j)]) jobs)
-                              ([rel|ghc-make.log|] :: Path Rel)
-                              (Just workdir)
-                              Nothing
 
     lift $ $(logInfo) [i|Installing...|]
-    lEM $ liftIO $ execLogged [s|make|]
+    lEM $ liftIO $ make ["install"] (Just workdir)
-                              True
-                              [[s|install|]]
-                              ([rel|ghc-make.log|] :: Path Rel)
-                              (Just workdir)
-                              Nothing
 
   markSrcBuilt ghcdir workdir = do
     let dest = (ghcdir </> ghcUpSrcBuiltFile)
     liftIO $ copyFile (build_mk workdir) dest Overwrite
 
-  build_mk workdir = workdir </> ([rel|mk/build.mk|] :: Path Rel)
+  build_mk workdir = workdir </> [rel|mk/build.mk|]
 
 
 compileCabal :: ( MonadReader Settings m
@@ -564,19 +584,24 @@ compileCabal :: ( MonadReader Settings m
                 )
              => GHCupDownloads
              -> Version          -- ^ version to install
-             -> Version          -- ^ GHC version to build with
+             -> Either Version (Path Abs)  -- ^ version to bootstrap with
              -> Maybe Int
+             -> Maybe (Path Abs)
              -> Excepts
                   '[ BuildFailed
                    , DigestError
+                   , DistroNotFound
                    , DownloadFailed
+                   , NoCompatibleArch
+                   , NoCompatiblePlatform
                    , NoDownload
+                   , PatchFailed
                    , UnknownArchive
                    ]
                   m
                   ()
-compileCabal dls tver bver jobs = do
+compileCabal dls tver bghc jobs patchdir = do
-  lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bver}|]
+  lift $ $(logDebug) [i|Requested to compile: #{tver} with ghc-#{bghc}|]
 
   -- download source tarball
   dlInfo <- preview (ix Cabal % ix tver % viSourceDL % _Just) dls ?? NoDownload
@@ -585,6 +610,8 @@ compileCabal dls tver bver jobs = do
   -- unpack
   tmpUnpack <- lift mkGhcupTmpDir
   liftE $ unpackToDir tmpUnpack dl
+  (PlatformRequest {..}) <- liftE $ platformRequest
+  void $ liftIO $ darwinNotarization _rPlatform tmpUnpack
 
   let workdir = maybe id (flip (</>)) (view dlSubdir dlInfo) $ tmpUnpack
 
@@ -596,27 +623,38 @@ compileCabal dls tver bver jobs = do
   pure ()
 
  where
-  compile :: (MonadLogger m, MonadIO m)
+  compile :: (MonadThrow m, MonadLogger m, MonadIO m)
           => Path Abs
-          -> Excepts '[ProcessError] m ()
+          -> Excepts '[ProcessError , PatchFailed] m ()
   compile workdir = do
-    lift
+    lift $ $(logInfo) [i|Building (this may take a while)...|]
-      $ $(logInfo)
+
-          [i|Building (this may take a while)... Run 'tail -f ~/.ghcup/logs/cabal-bootstrap.log' to see the progress.|]
+    forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir
+
+    ghcEnv <- case bghc of
+      Right path -> do
+        -- recover the version from /foo/ghc-6.5.4
+        bn <- basename path
+        let dn  = toFilePath $ dirname path
+        let ver = snd . B.break (== _hyphen) . toFilePath $ bn
+
+        pure
+          [ ("GHC"    , toFilePath path)
+          , ("GHC_PKG", dn <> "/" <> "ghc-pkg" <> ver)
+          ]
+      Left bver -> do
+        let v' = verToBS bver
+        pure [("GHC", "ghc-" <> v'), ("GHC_PKG", "ghc-pkg-" <> v')]
 
-    let v' = verToBS bver
     cabal_bin <- liftIO $ ghcupBinDir
-    newEnv    <- lift $ addToCurrentEnv
+    newEnv    <- lift
-      [ ([s|GHC|]    , [s|ghc-|] <> v')
+      $ addToCurrentEnv (("PREFIX", toFilePath cabal_bin) : ghcEnv)
-      , ([s|GHC_PKG|], [s|ghc-pkg-|] <> v')
+    lift $ $(logDebug) [i|Environment: #{newEnv}|]
-      , ([s|GHC_VER|], v')
-      , ([s|PREFIX|] , toFilePath cabal_bin)
-      ]
 
-    lEM $ liftIO $ execLogged [s|./bootstrap.sh|]
+    lEM $ liftIO $ execLogged "./bootstrap.sh"
                               False
-                              (maybe [] (\j -> [[s|-j|], fS (show j)]) jobs)
+                              (maybe [] (\j -> ["-j", fS (show j)]) jobs)
-                              ([rel|cabal-bootstrap.log|] :: Path Rel)
+                              [rel|cabal-bootstrap|]
                               (Just workdir)
                               (Just newEnv)
 
@@ -651,18 +689,31 @@ upgradeGHCup :: ( MonadMask m
                   Version
 upgradeGHCup dls mtarget = do
   lift $ $(logInfo) [i|Upgrading GHCup...|]
-  let latestVer = head $ getTagged dls GHCup Latest
+  let latestVer = fromJust $ getLatest dls GHCup
-  dli <- liftE $ getDownloadInfo dls GHCup latestVer Nothing
+  pfreq <- liftE platformRequest
-  tmp <- lift withGHCupTmpDir
+  dli   <- lE $ getDownloadInfo GHCup latestVer pfreq dls
-  let fn = [rel|ghcup|] :: Path Rel
+  tmp   <- lift withGHCupTmpDir
+  let fn = [rel|ghcup|]
   p <- liftE $ download dli tmp (Just fn)
+  let fileMode' =
+        newFilePerms
+          `unionFileModes` ownerExecuteMode
+          `unionFileModes` groupExecuteMode
+          `unionFileModes` otherExecuteMode
   case mtarget of
     Nothing -> do
       dest <- liftIO $ ghcupBinDir
+      liftIO $ hideError NoSuchThing $ deleteFile (dest </> fn)
       handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
                                                                (dest </> fn)
                                                                Overwrite
-    Just fullDest -> liftIO $ copyFile p fullDest Overwrite
+      liftIO $ setFileMode (toFilePath (dest </> fn)) fileMode'
+    Just fullDest -> do
+      liftIO $ hideError NoSuchThing $ deleteFile fullDest
+      handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
+                                                               fullDest
+                                                               Overwrite
+      liftIO $ setFileMode (toFilePath fullDest) fileMode'
   pure latestVer
 
 

lib/GHCup/Download.hs

@@ -1,84 +1,79 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
 
 
 module GHCup.Download where
 
-
+#if !defined(CURL)
+import           GHCup.Download.IOStreams
+import           GHCup.Download.Utils
+#endif
 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.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.Class      ( lift )
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
 import           Data.Aeson
+#if !defined(CURL)
 import           Data.ByteString                ( ByteString )
-import           Data.ByteString.Builder
 import           Data.CaseInsensitive           ( CI )
-import           Data.IORef
+#endif
 import           Data.Maybe
 import           Data.String.Interpolate
-import           Data.Text.Read
 import           Data.Time.Clock
 import           Data.Time.Clock.POSIX
+#if !defined(CURL)
 import           Data.Time.Format
+#endif
 import           Data.Versions
 import           GHC.IO.Exception
 import           HPath
-import           HPath.IO
+import           HPath.IO                      as HIO
 import           Haskus.Utils.Variant.Excepts
-import           Network.Http.Client     hiding ( URL )
-import           OpenSSL.Digest
 import           Optics
 import           Prelude                 hiding ( abs
                                                 , readFile
                                                 , writeFile
                                                 )
 import           System.IO.Error
-import "unix"    System.Posix.IO.ByteString
-                                         hiding ( fdWrite )
-import "unix-bytestring" System.Posix.IO.ByteString
-                                                ( fdWrite )
-import           System.Posix.RawFilePath.Directory.Errors
-                                                ( hideError )
-import           System.ProgressBar
 import           URI.ByteString
-import           URI.ByteString.QQ
 
-import qualified Data.Binary.Builder           as B
+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
+#if !defined(CURL)
 import qualified Data.CaseInsensitive          as CI
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
+#endif
 import qualified Data.Text.Encoding            as E
-import qualified System.IO.Streams             as Streams
 import qualified System.Posix.Files.ByteString as PF
 import qualified System.Posix.RawFilePath.Directory
                                                as RD
 
 
 
-ghcupURL :: URI
-ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
 
 
 
@@ -93,21 +88,20 @@ getDownloads :: ( FromJSONKey Tool
                 , FromJSON VersionInfo
                 , MonadIO m
                 , MonadCatch m
-                , MonadReader Settings m
                 , MonadLogger m
                 , MonadThrow m
                 , MonadFail m
                 )
-             => Excepts '[JSONError , DownloadFailed] m GHCupDownloads
+             => URLSource
-getDownloads = do
+             -> Excepts '[JSONError , DownloadFailed] m GHCupInfo
-  urlSource <- lift getUrlSource
+getDownloads urlSource = do
   lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
   case urlSource of
     GHCupURL -> do
-      bs <- reThrowAll DownloadFailed $ dl ghcupURL
+      bs <- reThrowAll DownloadFailed $ smartDl ghcupURL
       lE' JSONDecodeError $ eitherDecode' bs
     (OwnSource url) -> do
-      bs <- reThrowAll DownloadFailed $ dl url
+      bs <- reThrowAll DownloadFailed $ downloadBS url
       lE' JSONDecodeError $ eitherDecode' bs
     (OwnSpec av) -> pure $ av
 
@@ -121,24 +115,25 @@ getDownloads = do
   -- than the local file.
   --
   -- Always save the local file with the mod time of the remote file.
-  dl :: forall m1
+  smartDl :: forall m1
-      . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
+           . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
-     => URI
+          => URI
-     -> Excepts
+          -> Excepts
-          '[ FileDoesNotExistError
+               '[ FileDoesNotExistError
-           , HTTPStatusError
+                , HTTPStatusError
-           , URIParseError
+                , URIParseError
-           , UnsupportedScheme
+                , UnsupportedScheme
-           , NoLocationHeader
+                , NoLocationHeader
-           , TooManyRedirs
+                , TooManyRedirs
-           ]
+                , ProcessError
-          m1
+                ]
-          L.ByteString
+               m1
-  dl uri' = do
+               L.ByteString
+  smartDl uri' = do
     let path = view pathL' uri'
-    json_file <- (liftIO $ ghcupCacheDir)
+    cacheDir  <- liftIO $ ghcupCacheDir
-      >>= \cacheDir -> (cacheDir </>) <$> urlBaseName path
+    json_file <- (cacheDir </>) <$> urlBaseName path
-    e <- liftIO $ doesFileExist json_file
+    e         <- liftIO $ doesFileExist json_file
     if e
       then do
         accessTime <-
@@ -159,23 +154,27 @@ getDownloads = do
                     pure bs
                   else liftIO $ readFile json_file
               Nothing -> do
-                lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
+                lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
                 liftIO $ deleteFile json_file
                 liftE $ downloadBS uri'
           else -- access in less than 5 minutes, re-use file
                liftIO $ readFile json_file
       else do
+        liftIO $ createDirIfMissing newDirPerms cacheDir
         getModTime >>= \case
           Just modTime -> do
             bs <- liftE $ downloadBS uri'
             liftIO $ writeFileWithModTime modTime json_file bs
             pure bs
           Nothing -> do
-            lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
+            lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
             liftE $ downloadBS uri'
 
    where
     getModTime = do
+#if defined(CURL)
+      pure Nothing
+#else
       headers <-
         handleIO (\_ -> pure mempty)
         $ liftE
@@ -187,15 +186,16 @@ getDownloads = do
           )
       pure $ parseModifiedHeader headers
 
-
   parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
   parseModifiedHeader headers =
-    (M.lookup (CI.mk [s|Last-Modified|]) headers) >>= \h -> parseTimeM
+    (M.lookup (CI.mk "Last-Modified") headers) >>= \h -> parseTimeM
       True
       defaultTimeLocale
       "%a, %d %b %Y %H:%M:%S %Z"
       (T.unpack . E.decodeUtf8 $ h)
 
+#endif
+
   writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO ()
   writeFileWithModTime utctime path content = do
     let mod_time = utcTimeToPOSIXSeconds utctime
@@ -203,47 +203,13 @@ getDownloads = do
     setModificationTimeHiRes path mod_time
 
 
-
+getDownloadInfo :: Tool
-getDownloadInfo :: ( MonadLogger m
-                   , MonadCatch m
-                   , MonadIO m
-                   , MonadReader Settings m
-                   )
-                => GHCupDownloads
-                -> Tool
                 -> Version
-                -> Maybe PlatformRequest
-                -> Excepts
-                     '[ DistroNotFound
-                      , NoCompatiblePlatform
-                      , NoCompatibleArch
-                      , NoDownload
-                      ]
-                     m
-                     DownloadInfo
-getDownloadInfo bDls t v mpfReq = do
-  (PlatformRequest arch' plat ver) <- case mpfReq of
-    Just x  -> pure x
-    Nothing -> do
-      (PlatformResult rp rv) <- liftE getPlatform
-      ar                     <- lE getArchitecture
-      pure $ PlatformRequest ar rp rv
-
-  lE $ getDownloadInfo' t v arch' plat ver bDls
-
-
-getDownloadInfo' :: Tool
-                 -> Version
                 -- ^ tool version
-                 -> Architecture
+                -> PlatformRequest
-                -- ^ user arch
+                -> GHCupDownloads
-                 -> Platform
+                -> Either NoDownload DownloadInfo
-                -- ^ user platform
+getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
-                 -> Maybe Versioning
-                -- ^ optional version of the platform
-                 -> GHCupDownloads
-                 -> Either NoDownload DownloadInfo
-getDownloadInfo' t v a p mv dls = maybe
   (Left NoDownload)
   Right
   (with_distro <|> without_distro_ver <|> without_distro)
@@ -275,9 +241,9 @@ download :: ( MonadMask m
          -> Maybe (Path Rel)  -- ^ optional filename
          -> Excepts '[DigestError , DownloadFailed] m (Path Abs)
 download dli dest mfn
-  | scheme == [s|https|] = dl
+  | scheme == "https" = dl
-  | scheme == [s|http|] = dl
+  | scheme == "http"  = dl
-  | scheme == [s|file|] = cp
+  | scheme == "file"  = cp
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
@@ -293,19 +259,25 @@ download dli dest mfn
     let uri' = E.decodeUtf8 (serializeURIRef' (view dlUri dli))
     lift $ $(logInfo) [i|downloading: #{uri'}|]
 
-    (https, host, fullPath, port) <- reThrowAll DownloadFailed
-      $ uriToQuadruple (view dlUri dli)
-
     -- destination dir must exist
     liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms dest
     destFile <- getDestFile
 
     -- download
-    fd       <- liftIO $ createRegularFileFd newFilePerms destFile
+    flip onException
-    let stepper = fdWrite fd
+         (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
-    flip finally (liftIO $ closeFd fd)
+     $ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
-      $ reThrowAll DownloadFailed
+          (\e ->
-      $ downloadInternal True https host fullPath port stepper
+            (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
+              >> (throwE . DownloadFailed $ e)
+          ) $ do
+#if defined(CURL)
+              liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
+                ["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
+#else
+              (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
+              liftE $ downloadToFile https host fullPath port destFile
+#endif
 
     liftE $ checkDigest dli destFile
     pure destFile
@@ -354,6 +326,8 @@ downloadCached dli mfn = do
     ------------------
 
 
+
+
 -- | This is used for downloading the JSON.
 downloadBS :: (MonadCatch m, MonadIO m)
            => URI
@@ -364,15 +338,16 @@ downloadBS :: (MonadCatch m, MonadIO m)
                  , UnsupportedScheme
                  , NoLocationHeader
                  , TooManyRedirs
+                 , ProcessError
                  ]
                 m
                 L.ByteString
 downloadBS uri'
-  | scheme == [s|https|]
+  | scheme == "https"
   = dl True
-  | scheme == [s|http|]
+  | scheme == "http"
   = dl False
-  | scheme == [s|file|]
+  | scheme == "file"
   = liftIOException doesNotExistErrorType (FileDoesNotExistError path)
     $ (liftIO $ RD.readFile path)
   | otherwise
@@ -381,223 +356,19 @@ downloadBS uri'
  where
   scheme = view (uriSchemeL' % schemeBSL') uri'
   path   = view pathL' uri'
+#if defined(CURL)
+  dl _ = do
+    let exe = [rel|curl|]
+        args = ["-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
+#else
   dl https = do
     (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
     liftE $ downloadBS' https host' fullPath' port'
-
+#endif
-
--- | 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)
-
-
-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 [s|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 [s|Content-Length|] of
-            Just x' -> case decimal $ E.decodeUtf8 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
-              ]
-             m
-             (M.Map (CI ByteString) ByteString)
-getHead uri' | scheme == [s|https|] = head' True
-             | scheme == [s|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 [s|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 action = bracket acquire closeConnection action
-
- where
-  acquire = case https of
-    True -> do
-      ctx <- baselineContextSSL
-      openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
-    False -> openConnection host (fromIntegral $ fromMaybe 80 port)
-
-
--- | 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 == [s|https|] -> pure True
-    | scheme == [s|http|] -> pure False
-    | otherwise           -> throwE UnsupportedScheme
-
-  let
-    queryBS =
-      BS.intercalate [s|&|]
-        . fmap (\(x, y) -> encodeQuery x <> [s|=|] <> encodeQuery y)
-        $ (queryPairs uriQuery)
-    port =
-      preview (_Just % authorityPortL' % _Just % portNumberL') uriAuthority
-    fullpath =
-      if BS.null queryBS then uriPath else uriPath <> [s|?|] <> queryBS
-  pure (https, host, fullpath, port)
-  where encodeQuery = L.toStrict . B.toLazyByteString . urlEncodeQuery
 
 
 checkDigest :: (MonadIO m, MonadLogger m, MonadReader Settings m)
@@ -608,8 +379,9 @@ checkDigest dli file = do
   verify <- lift ask <&> (not . noVerify)
   when verify $ do
     let p' = toFilePath file
-    lift $ $(logInfo) [i|veryfing digest of: #{p'}|]
+    lift $ $(logInfo) [i|verifying digest of: #{p'}|]
     c <- liftIO $ readFile file
-    let cDigest = E.decodeUtf8 . toHex . digest (digestByName "sha256") $ c
+    let cDigest = E.decodeUtf8 . B16.encode . SHA256.hashlazy $ c
         eDigest = view dlHash dli
     when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
+

lib/GHCup/Download/IOStreams.hs

@@ -0,0 +1,254 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# 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 Data.Text.Encoding            as E
+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 $ E.decodeUtf8 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 action = bracket acquire closeConnection action
+
+ 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

@@ -0,0 +1,64 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# 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

@@ -63,6 +63,10 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
 data NotInstalled = NotInstalled Tool Version
   deriving Show
 
+-- | An executable was expected to be in PATH, but was not found.
+data NotFoundInPATH = NotFoundInPATH (Path Rel)
+  deriving Show
+
 -- | JSON decoding failed.
 data JSONError = JSONDecodeError String
   deriving Show
@@ -88,6 +92,13 @@ data NoLocationHeader = NoLocationHeader
 data TooManyRedirs = TooManyRedirs
   deriving Show
 
+-- | A patch could not be applied.
+data PatchFailed = PatchFailed
+  deriving Show
+
+-- | The tool requirements could not be found.
+data NoToolRequirements = NoToolRequirements
+  deriving Show
 
 
     -------------------------

lib/GHCup/Platform.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TemplateHaskell       #-}
 
@@ -20,7 +22,7 @@ import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.Logger
 import           Control.Monad.Reader
-import           Control.Monad.Trans.Class      ( lift )
+import           Data.ByteString                ( ByteString )
 import           Data.Foldable
 import           Data.Maybe
 import           Data.String.Interpolate
@@ -34,16 +36,31 @@ import           Prelude                 hiding ( abs
                                                 , writeFile
                                                 )
 import           System.Info
+import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
-import qualified Data.Text.ICU                 as ICU
 
     --------------------------
     --[ 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
@@ -62,16 +79,30 @@ getPlatform = do
     "linux" -> do
       (distro, ver) <- liftE getLinuxDistro
       pure $ PlatformResult { _platform = Linux distro, _distroVersion = ver }
-    -- TODO: these are not verified
+    "darwin" -> do
-    "darwin" ->
+      ver <-
-      pure $ PlatformResult { _platform = Darwin, _distroVersion = Nothing }
+        ( either (const Nothing) Just
+          . versioning
+          . getMajorVersion
+          . E.decodeUtf8
+          )
+          <$> getDarwinVersion
+      pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
     "freebsd" -> do
-      ver <- getFreeBSDVersion
+      ver <-
+        (either (const Nothing) Just . versioning . E.decodeUtf8)
+          <$> getFreeBSDVersion
       pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
     what -> throwE $ NoCompatiblePlatform what
   lift $ $(logDebug) [i|Identified Platform as: #{pfr}|]
   pure pfr
-  where getFreeBSDVersion = pure Nothing
+ 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)
@@ -100,16 +131,11 @@ getLinuxDistro = do
         | otherwise                -> UnknownLinux
   pure (distro, parsedVer)
  where
-  hasWord t matches = foldr
+  hasWord t matches = foldr (\x y -> match (regex x) (T.unpack t) || y)
-    (\x y ->
+                            False
-      ( isJust
+                            matches
-        . ICU.find (ICU.regex [ICU.CaseInsensitive] ([s|\b|] <> x <> [s|\b|]))
+   where
-        $ t
+    regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
-        )
-        || y
-    )
-    False
-    (T.pack <$> matches)
 
   os_release :: Path Abs
   os_release = [abs|/etc/os-release|]
@@ -131,8 +157,8 @@ getLinuxDistro = do
   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 [[s|-si|]] Nothing
+    name     <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing
-    ver      <- fmap _stdOut $ executeOut lsb_release_cmd [[s|-sr|]] Nothing
+    ver      <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing
     pure (E.decodeUtf8 name, Just $ E.decodeUtf8 ver)
 
   try_lsb_release :: IO (Text, Maybe Text)
@@ -144,21 +170,24 @@ getLinuxDistro = do
   try_redhat_release :: IO (Text, Maybe Text)
   try_redhat_release = do
     t <- fmap lBS2sT $ 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 =
-          join
+          fromEmpty . match (nameRegex n) $ T.unpack t :: Maybe String
-            . fmap (ICU.group 0)
+        verRe = fromEmpty . match verRegex $ T.unpack t :: Maybe String
-            . ICU.find
-                (ICU.regex [ICU.CaseInsensitive] ([s|\b|] <> fS n <> [s|\b|]))
-            $ t
-        verRe =
-          join
-            . fmap (ICU.group 0)
-            . ICU.find
-                (ICU.regex [ICU.CaseInsensitive] [s|\b(\d)+(.(\d)+)*\b|])
-            $ t
     (Just name) <- pure
       (nameRe "CentOS" <|> nameRe "Fedora" <|> nameRe "Red Hat")
-    pure (name, verRe)
+    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

lib/GHCup/Requirements.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module GHCup.Requirements where
+
+import           GHCup.Types
+import           GHCup.Types.JSON               ( )
+import           GHCup.Types.Optics
+
+import           Control.Applicative
+import           Data.Maybe
+import           Optics
+import           Prelude                 hiding ( abs
+                                                , readFile
+                                                , writeFile
+                                                )
+
+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 =
+  preview (ix GHC % ix Nothing % ix (_platform pr) % ix (_distroVersion pr)) tr
+    <|> preview (ix GHC % ix Nothing % ix (_platform pr) % ix Nothing) tr
+    <|> preview
+          ( ix GHC
+          % ix Nothing
+          % ix (set _Linux UnknownLinux $ _platform pr)
+          % ix Nothing
+          )
+          tr
+
+
+prettyRequirements :: Requirements -> T.Text
+prettyRequirements Requirements {..} =
+  let d = if not . null $ _distroPKGs
+        then
+          "\n  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

@@ -12,6 +12,39 @@ import qualified GHC.Generics                  as GHC
 
 
 
+    --------------------
+    --[ 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 Versioning) Requirements
+
+
+data Requirements = Requirements
+  { _distroPKGs :: [Text]
+  , _notes      :: Text
+  }
+  deriving (Show, GHC.Generic)
+
+
+
+
 
     ---------------------
     --[ Download Tree ]--
@@ -99,26 +132,24 @@ data DownloadInfo = DownloadInfo
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
                | OwnSource URI
-               | OwnSpec GHCupDownloads
+               | OwnSpec GHCupInfo
                deriving Show
 
 
 data Settings = Settings
-  { cache     :: Bool
+  { cache    :: Bool
-  , urlSource :: URLSource
+  , noVerify :: Bool
-  , noVerify  :: Bool
   }
   deriving Show
 
 
 data DebugInfo = DebugInfo
-  { diBaseDir   :: Path Abs
+  { diBaseDir  :: Path Abs
-  , diBinDir    :: Path Abs
+  , diBinDir   :: Path Abs
-  , diGHCDir    :: Path Abs
+  , diGHCDir   :: Path Abs
-  , diCacheDir  :: Path Abs
+  , diCacheDir :: Path Abs
-  , diURLSource :: URLSource
+  , diArch     :: Architecture
-  , diArch      :: Architecture
+  , diPlatform :: PlatformResult
-  , diPlatform  :: PlatformResult
   }
   deriving Show
 
@@ -141,4 +172,3 @@ data PlatformRequest = PlatformRequest
   , _rVersion  :: Maybe Versioning
   }
   deriving (Eq, Show)
-

lib/GHCup/Types/JSON.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeFamilies          #-}
@@ -13,12 +14,10 @@ module GHCup.Types.JSON where
 
 import           GHCup.Types
 import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
 
 import           Data.Aeson
 import           Data.Aeson.TH
 import           Data.Aeson.Types
-import           Data.Text.Encoding             ( decodeUtf8 )
 import           Data.Text.Encoding            as E
 import           Data.Versions
 import           Data.Word8
@@ -40,6 +39,8 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
 
 
 instance ToJSON URI where
@@ -70,11 +71,11 @@ instance FromJSONKey Versioning where
 instance ToJSONKey (Maybe Versioning) where
   toJSONKey = toJSONKeyText $ \case
     Just x  -> prettyV x
-    Nothing -> T.pack "unknown_version"
+    Nothing -> T.pack "unknown_versioning"
 
 instance FromJSONKey (Maybe Versioning) where
   fromJSONKey = FromJSONKeyTextParser $ \t ->
-    if t == T.pack "unknown_version" then pure Nothing else pure $ just t
+    if t == T.pack "unknown_versioning" then pure Nothing else pure $ just t
    where
     just t = case versioning t of
       Right x -> pure x
@@ -113,6 +114,19 @@ instance ToJSONKey Architecture where
 instance FromJSONKey Architecture where
   fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
 
+instance ToJSONKey (Maybe Version) where
+  toJSONKey = toJSONKeyText $ \case
+    Just x  -> prettyVer x
+    Nothing -> T.pack "unknown_version"
+
+instance FromJSONKey (Maybe Version) where
+  fromJSONKey = FromJSONKeyTextParser $ \t ->
+    if t == T.pack "unknown_version" then pure Nothing else pure $ just t
+   where
+    just t = case version t of
+      Right x -> pure x
+      Left  e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
+
 instance ToJSON Version where
   toJSON = toJSON . prettyVer
 
@@ -138,7 +152,7 @@ instance FromJSONKey Tool where
 instance ToJSON (Path Rel) where
   toJSON p = case and . fmap isAscii . BS.unpack $ fp of
     True  -> toJSON . E.decodeUtf8 $ fp
-    False -> String [s|/not/a/valid/path|]
+    False -> String "/not/a/valid/path"
     where fp = toFilePath p
 
 instance FromJSON (Path Rel) where

lib/GHCup/Types/Optics.hs

@@ -19,6 +19,7 @@ makeLenses ''DownloadInfo
 makeLenses ''Tag
 makeLenses ''VersionInfo
 
+makeLenses ''GHCupInfo
 
 uriSchemeL' :: Lens' (URIRef Absolute) Scheme
 uriSchemeL' = lensVL uriSchemeL

lib/GHCup/Utils.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TemplateHaskell       #-}
 
@@ -17,15 +19,15 @@ import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.File
 import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
 
 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.Class      ( lift )
 import           Data.Attoparsec.ByteString
 import           Data.ByteString                ( ByteString )
 import           Data.List
@@ -44,7 +46,9 @@ import           Prelude                 hiding ( abs
                                                 )
 import           Safe
 import           System.IO.Error
-import           System.Posix.FilePath          ( takeFileName )
+import           System.Posix.FilePath          ( getSearchPath
+                                                , takeFileName
+                                                )
 import           System.Posix.Files.ByteString  ( readSymbolicLink )
 import           URI.ByteString
 
@@ -70,14 +74,14 @@ import qualified Data.Text.Encoding            as E
 ghcLinkDestination :: ByteString -- ^ the tool, such as 'ghc', 'haddock' etc.
                    -> Version
                    -> ByteString
-ghcLinkDestination tool ver = [s|../ghc/|] <> verToBS ver <> [s|/bin/|] <> tool
+ghcLinkDestination tool ver = "../ghc/" <> verToBS ver <> "/bin/" <> tool
 
 
 -- | Extract the version part of the result of `ghcLinkDestination`.
 ghcLinkVersion :: MonadThrow m => ByteString -> m Version
 ghcLinkVersion = either (throwM . ParseError) pure . parseOnly parser
  where
-  parser    = string [s|../ghc/|] *> verParser <* string [s|/bin/ghc|]
+  parser    = string "../ghc/" *> verParser <* string "/bin/ghc"
   verParser = many1' (notWord8 _slash) >>= \t ->
     case version $ E.decodeUtf8 $ B.pack t of
       Left  e -> fail $ show e
@@ -90,7 +94,7 @@ rmMinorSymlinks ver = do
   bindir <- liftIO $ ghcupBinDir
   files  <- liftIO $ getDirsFiles' bindir
   let myfiles =
-        filter (\x -> ([s|-|] <> verToBS ver) `B.isSuffixOf` toFilePath x) files
+        filter (\x -> ("-" <> verToBS ver) `B.isSuffixOf` toFilePath x) files
   forM_ myfiles $ \f -> do
     let fullF = (bindir </> f)
     $(logDebug) [i|rm -f #{toFilePath fullF}|]
@@ -117,12 +121,12 @@ rmPlain ver = do
 rmMajorSymlinks :: (MonadLogger m, MonadIO m) => Version -> m ()
 rmMajorSymlinks ver = do
   (mj, mi) <- liftIO $ getGHCMajor ver
-  let v' = E.encodeUtf8 $ intToText mj <> [s|.|] <> intToText mi
+  let v' = E.encodeUtf8 $ intToText mj <> "." <> intToText mi
 
   bindir <- liftIO ghcupBinDir
 
   files  <- liftIO $ getDirsFiles' bindir
-  let myfiles = filter (\x -> ([s|-|] <> v') `B.isSuffixOf` toFilePath x) files
+  let myfiles = filter (\x -> ("-" <> v') `B.isSuffixOf` toFilePath x) files
   forM_ myfiles $ \f -> do
     let fullF = (bindir </> f)
     $(logDebug) [i|rm -f #{toFilePath fullF}|]
@@ -157,7 +161,7 @@ ghcSrcInstalled ver = do
 
 ghcSet :: (MonadIO m, MonadThrow m) => m (Maybe Version)
 ghcSet = do
-  ghcBin <- (</> ([rel|ghc|] :: Path Rel)) <$> liftIO ghcupBinDir
+  ghcBin <- (</> [rel|ghc|]) <$> liftIO ghcupBinDir
 
   -- link destination is of the form ../ghc/<ver>/bin/ghc
   liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
@@ -172,8 +176,8 @@ cabalInstalled ver = do
 
 cabalSet :: (MonadIO m, MonadThrow m) => m Version
 cabalSet = do
-  cabalbin <- (</> ([rel|cabal|] :: Path Rel)) <$> liftIO ghcupBinDir
+  cabalbin <- (</> [rel|cabal|]) <$> liftIO ghcupBinDir
-  mc       <- liftIO $ executeOut cabalbin [[s|--numeric-version|]] Nothing
+  mc       <- liftIO $ executeOut cabalbin ["--numeric-version"] Nothing
   let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ mc
   case version (E.decodeUtf8 reportedVer) of
     Left  e -> throwM e
@@ -235,15 +239,15 @@ unpackToDir dest av = do
 
   -- extract, depending on file extension
   if
-    | [s|.tar.gz|] `B.isSuffixOf` fn -> liftIO
+    | ".tar.gz" `B.isSuffixOf` fn -> liftIO
       (untar . GZip.decompress =<< readFile av)
-    | [s|.tar.xz|] `B.isSuffixOf` fn -> do
+    | ".tar.xz" `B.isSuffixOf` fn -> do
       filecontents <- liftIO $ readFile av
       let decompressed = Lzma.decompress filecontents
       liftIO $ untar decompressed
-    | [s|.tar.bz2|] `B.isSuffixOf` fn -> liftIO
+    | ".tar.bz2" `B.isSuffixOf` fn -> liftIO
       (untar . BZip.decompress =<< readFile av)
-    | [s|.tar|] `B.isSuffixOf` fn -> liftIO (untar =<< readFile av)
+    | ".tar" `B.isSuffixOf` fn -> liftIO (untar =<< readFile av)
     | otherwise -> throwE $ UnknownArchive fn
 
 
@@ -277,9 +281,6 @@ getRecommended av tool = headOf folded $ getTagged av tool Recommended
     -----------------------
 
 
-getUrlSource :: MonadReader Settings m => m URLSource
-getUrlSource = ask <&> urlSource
-
 getCache :: MonadReader Settings m => m Bool
 getCache = ask <&> cache
 
@@ -296,7 +297,7 @@ urlBaseName :: MonadThrow m
 urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
 
 
--- Get tool files from ~/.ghcup/bin/ghc/<ver>/bin/*
+-- Get tool files from '~/.ghcup/bin/ghc/<ver>/bin/*'
 -- while ignoring *-<ver> symlinks.
 --
 -- Returns unversioned relative files, e.g.:
@@ -316,7 +317,7 @@ ghcToolFiles ver = do
   -- figure out the <ver> suffix, because this might not be `Version` for
   -- alpha/rc releases, but x.y.a.somedate.
   (Just symver) <-
-    (B.stripPrefix [s|ghc-|] . takeFileName)
+    (B.stripPrefix "ghc-" . takeFileName)
       <$> (liftIO $ readSymbolicLink $ toFilePath (bindir </> [rel|ghc|]))
   when (B.null symver)
        (throwIO $ userError $ "Fatal: ghc symlink target is broken")
@@ -328,3 +329,42 @@ ghcToolFiles ver = do
 -- 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 :: [ByteString] -> Maybe (Path Abs) -> IO (Either ProcessError ())
+make args workdir = do
+  spaths    <- catMaybes . fmap parseAbs <$> getSearchPath
+  has_gmake <- isJust <$> 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
+
+
+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 ()

lib/GHCup/Utils/Dirs.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
 
 module GHCup.Utils.Dirs where
@@ -5,7 +6,6 @@ module GHCup.Utils.Dirs where
 
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
 
 import           Control.Applicative
 import           Control.Exception.Safe
@@ -39,14 +39,14 @@ import qualified System.Posix.User             as PU
 
 ghcupBaseDir :: IO (Path Abs)
 ghcupBaseDir = do
-  getEnv [s|GHCUP_INSTALL_BASE_PREFIX|] >>= \case
+  getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
     Just r  -> parseAbs r
     Nothing -> do
       home <- liftIO getHomeDirectory
-      pure (home </> ([rel|.ghcup|] :: Path Rel))
+      pure (home </> [rel|.ghcup|])
 
 ghcupGHCBaseDir :: IO (Path Abs)
-ghcupGHCBaseDir = ghcupBaseDir <&> (</> ([rel|ghc|] :: Path Rel))
+ghcupGHCBaseDir = ghcupBaseDir <&> (</> [rel|ghc|])
 
 ghcupGHCDir :: Version -> IO (Path Abs)
 ghcupGHCDir ver = do
@@ -56,19 +56,19 @@ ghcupGHCDir ver = do
 
 
 ghcupBinDir :: IO (Path Abs)
-ghcupBinDir = ghcupBaseDir <&> (</> ([rel|bin|] :: Path Rel))
+ghcupBinDir = ghcupBaseDir <&> (</> [rel|bin|])
 
 ghcupCacheDir :: IO (Path Abs)
-ghcupCacheDir = ghcupBaseDir <&> (</> ([rel|cache|] :: Path Rel))
+ghcupCacheDir = ghcupBaseDir <&> (</> [rel|cache|])
 
 ghcupLogsDir :: IO (Path Abs)
-ghcupLogsDir = ghcupBaseDir <&> (</> ([rel|logs|] :: Path Rel))
+ghcupLogsDir = ghcupBaseDir <&> (</> [rel|logs|])
 
 
 mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
 mkGhcupTmpDir = do
-  tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
+  tmpdir <- liftIO $ getEnvDefault "TMPDIR" "/tmp"
-  tmp    <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
+  tmp    <- liftIO $ mkdtemp $ (tmpdir FP.</> "ghcup-")
   parseAbs tmp
 
 
@@ -83,7 +83,7 @@ withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive
 
 getHomeDirectory :: IO (Path Abs)
 getHomeDirectory = do
-  e <- getEnv [s|HOME|]
+  e <- getEnv "HOME"
   case e of
     Just fp -> parseAbs fp
     Nothing -> do

lib/GHCup/Utils/File.hs

@@ -1,18 +1,22 @@
-{-# LANGUAGE QuasiQuotes     #-}
+{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module GHCup.Utils.File where
 
 import           GHCup.Utils.Dirs
 import           GHCup.Utils.Prelude
 
+import           Control.Concurrent
+import           Control.Exception              ( evaluate )
 import           Control.Exception.Safe
 import           Control.Monad
-import           Data.ByteString
+import           Data.ByteString                ( ByteString )
 import           Data.ByteString.Unsafe         ( unsafeUseAsCStringLen )
 import           Data.Char
 import           Data.Foldable
 import           Data.Functor
+import           Data.IORef
 import           Data.Maybe
 import           GHC.Foreign                    ( peekCStringLen )
 import           GHC.IO.Encoding                ( getLocaleEncoding )
@@ -23,7 +27,10 @@ import           Optics
 import           Streamly
 import           Streamly.External.ByteString
 import           Streamly.External.ByteString.Lazy
+import           System.Console.Pretty
+import           System.Console.Regions
 import           System.IO
+import           System.IO.Error
 import           System.Posix.Directory.ByteString
 import           System.Posix.FD               as FD
 import           System.Posix.FilePath   hiding ( (</>) )
@@ -34,6 +41,10 @@ import           System.Posix.Process           ( ProcessStatus(..) )
 import           System.Posix.Types
 
 
+import qualified Control.Exception             as EX
+import qualified Data.Text                     as T
+import qualified Data.Text.Encoding            as E
+import qualified Data.Text.Encoding.Error      as E
 import qualified System.Posix.Process.ByteString
                                                as SPPB
 import           Streamly.External.Posix.DirStream
@@ -42,7 +53,17 @@ import qualified Streamly.Internal.Memory.ArrayStream
 import qualified Streamly.FileSystem.Handle    as FH
 import qualified Streamly.Internal.Data.Unfold as SU
 import qualified Streamly.Prelude              as S
+import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as L
+import qualified "unix-bytestring" System.Posix.IO.ByteString
+                                               as SPIB
+
+
+-- | Bool signals whether the regions should be cleaned.
+data StopThread = StopThread Bool
+  deriving Show
+
+instance Exception StopThread
 
 
 data ProcessError = NonZeroExit Int ByteString [ByteString]
@@ -99,7 +120,7 @@ findExecutable ex = do
 
 -- | 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'
+executeOut :: Path b            -- ^ command as filename, e.g. 'ls'
            -> [ByteString]      -- ^ arguments to the command
            -> Maybe (Path Abs)  -- ^ chdir to this path
            -> IO CapturedProcess
@@ -116,26 +137,103 @@ execLogged :: ByteString       -- ^ thing to execute
            -> Maybe [(ByteString, ByteString)] -- ^ optional environment
            -> IO (Either ProcessError ())
 execLogged exe spath args lfile chdir env = do
-  ldir <- ghcupLogsDir
+  ldir    <- ghcupLogsDir
-  let logfile = ldir </> lfile
+  logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
   bracket (createFile (toFilePath logfile) newFilePerms) closeFd action
  where
   action fd = do
-    pid <- SPPB.forkProcess $ do
+    actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
-      -- dup stdout
+      -- start the thread that logs to stdout in a region
-      void $ dupTo fd stdOutput
+      done <- newEmptyMVar
+      tid  <-
+        forkIO
+        $ EX.handle (\(_ :: StopThread) -> pure ())
+        $ EX.handle (\(_ :: IOException) -> pure ())
+        $ flip finally (putMVar done ())
+        $ printToRegion fd stdoutRead 6
 
-      -- dup stderr
+      -- fork our subprocess
-      void $ dupTo fd stdError
+      pid <- SPPB.forkProcess $ do
+        void $ dupTo stdoutWrite stdOutput
+        void $ dupTo stdoutWrite stdError
+        closeFd stdoutWrite
+        closeFd stdoutRead
 
-      -- execute the action
+        -- execute the action
-      maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
+        maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-      SPPB.executeFile exe spath args env
+        SPPB.executeFile exe spath args env
+
+      closeFd stdoutWrite
+
+      -- wait for the subprocess to finish
+      e <- SPPB.getProcessStatus True True pid >>= \case
+        i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i
+        i                        -> pure $ toProcessError exe args i
+
+      -- make sure the logging thread stops
+      case e of
+        Left  _ -> EX.throwTo tid (StopThread False)
+        Right _ -> EX.throwTo tid (StopThread True)
+      takeMVar done
+
+      closeFd stdoutRead
+      pure e
+
+  -- Reads fdIn and logs the output in a continous scrolling area
+  -- of 'size' terminal lines. Also writes to a log file.
+  printToRegion fileFd fdIn size = do
+    ref <- newIORef ([] :: [ByteString])
+    displayConsoleRegions $ do
+      rs <- sequence . replicate size . openConsoleRegion $ Linear
+      flip finally (readTilEOF (lineAction ref rs) fdIn) -- make sure the last few lines don't get cut off
+        $ handle
+            (\(StopThread b) -> do
+              when b (forM_ rs closeConsoleRegion)
+              EX.throw (StopThread b)
+            )
+        $ do
+            hideError eofErrorType $ readTilEOF (lineAction ref rs) fdIn
+            -- wait for explicit stop from the parent to signal what cleanup to run
+            forever (threadDelay 5000)
+
+   where
+    -- action to perform line by line
+    lineAction ref rs bs' = do
+      modifyIORef' ref (swapRegs bs')
+      regs <- readIORef ref
+      forM (zip regs rs) $ \(bs, r) -> do
+        setConsoleRegion r $ do
+          w <- consoleWidth
+          return
+            . T.pack
+            . color Blue
+            . T.unpack
+            . E.decodeUtf8With E.lenientDecode
+            . trim w
+            . (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
+            $ bs
+        SPIB.fdWrite fileFd (bs <> "\n")
 
 
-    SPPB.getProcessStatus True True pid >>= \case
+    swapRegs bs regs | length regs < size = regs ++ [bs]
-      i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i
+                     | otherwise          = tail regs ++ [bs]
-      i                         -> pure $ toProcessError exe args i
+
+    -- trim output line to terminal width
+    trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
+              | otherwise                 = bs
+
+    -- read an entire line from the file descriptor (removes the newline char)
+    readLine fd' = do
+      bs <- SPIB.fdRead fd' 1
+      if
+        | bs == "\n" -> pure ""
+        | bs == ""   -> pure ""
+        | otherwise  -> fmap (bs <>) $ readLine fd'
+
+    readTilEOF action' fd' = do
+      bs <- readLine fd'
+      void $ action' bs
+      readTilEOF action' fd'
 
 
 -- | Capture the stdout and stderr of the given action, which
@@ -144,7 +242,7 @@ execLogged exe spath args lfile chdir env = do
 captureOutStreams :: IO a
                      -- ^ the action to execute in a subprocess
                   -> IO CapturedProcess
-captureOutStreams action =
+captureOutStreams action = do
   actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
     actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
       pid <- SPPB.forkProcess $ do
@@ -159,27 +257,68 @@ captureOutStreams action =
         closeFd parentStderrRead
 
         -- execute the action
-        void $ action
+        a <- action
+        void $ evaluate a
 
       -- close everything we don't need
       closeFd childStdoutWrite
       closeFd childStderrWrite
 
-      SPPB.getProcessStatus True True pid >>= \case
+      -- start thread that writes the output
+      refOut <- newIORef BS.empty
+      refErr <- newIORef BS.empty
+      done   <- newEmptyMVar
+      _      <-
+        forkIO
+        $ EX.handle (\(_ :: StopThread) -> pure ())
+        $ EX.handle (\(_ :: IOException) -> pure ())
+        $ flip finally (putMVar done ())
+        $ writeStds parentStdoutRead parentStderrRead refOut refErr
+
+      status <- SPPB.getProcessStatus True True pid
+      takeMVar done
+
+      case status of
         -- readFd will take care of closing the fd
         Just (SPPB.Exited es) -> do
-          stdout' <- L.toStrict <$> readFd parentStdoutRead
+          stdout' <- readIORef refOut
-          stderr' <- L.toStrict <$> readFd parentStderrRead
+          stderr' <- readIORef refErr
           pure $ CapturedProcess { _exitCode = es
                                  , _stdOut   = stdout'
                                  , _stdErr   = stderr'
                                  }
+
         _ -> throwIO $ userError $ ("No such PID " ++ show pid)
 
  where
-  actionWithPipes a =
+  writeStds pout perr rout rerr = do
-    createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2)
+    doneOut <- newEmptyMVar
-  cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd
+    void
+      $ forkIO
+      $ hideError eofErrorType
+      $ flip finally (putMVar doneOut ())
+      $ readTilEOF (\x -> modifyIORef' rout (<> x)) pout
+    doneErr <- newEmptyMVar
+    void
+      $ forkIO
+      $ hideError eofErrorType
+      $ flip 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
 
 
 

lib/GHCup/Utils/Prelude.hs

@@ -17,7 +17,6 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      ( lift )
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
-import           Data.Monoid                    ( (<>) )
 import           Data.String
 import           Data.Text                      ( Text )
 import           Data.Versions

lib/GHCup/Utils/Version/QQ.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -Wno-orphans    #-}
+{-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveLift         #-}
 {-# LANGUAGE FlexibleInstances  #-}
@@ -11,11 +12,12 @@ 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     ( Exp(..)
+import           Language.Haskell.TH.Syntax     ( Lift
-                                                , Lift
                                                 , dataToExpQ
                                                 )
 import qualified Data.Text                     as T
@@ -33,12 +35,15 @@ deriving instance Data Mess
 deriving instance Lift Mess
 deriving instance Data PVP
 deriving instance Lift PVP
-deriving instance Lift (NonEmpty Word)
 deriving instance Lift VSep
 deriving instance Data VSep
 deriving instance Lift VUnit
 deriving instance Data VUnit
+
+#if !MIN_VERSION_base(4,13,0)
+deriving instance Lift (NonEmpty Word)
 instance Lift Text
+#endif
 
 qq :: (Text -> Q Exp) -> QuasiQuoter
 qq quoteExp' = QuasiQuoter

lib/GHCup/Version.hs

@@ -6,6 +6,12 @@ module GHCup.Version where
 import           GHCup.Utils.Version.QQ
 
 import           Data.Versions
+import           URI.ByteString
+import           URI.ByteString.QQ
+
+-- | This reflects the API version of the JSON.
+ghcupURL :: URI
+ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
 
 ghcUpVer :: PVP
-ghcUpVer = [pver|0.1.0|]
+ghcUpVer = [pver|0.1.1|]