packages feed

stack 2.9.3.1 → 2.11.1

raw patch · 245 files changed

+29732/−24242 lines, 245 filesdep +networkdep −temporarydep ~Cabaldep ~ansi-terminaldep ~casa-clientsetup-changed

Dependencies added: network

Dependencies removed: temporary

Dependency ranges changed: Cabal, ansi-terminal, casa-client, hi-file-parser, hpack, http-client-tls, http-download, optparse-applicative, pantry, persistent

Files

CONTRIBUTING.md view
@@ -275,15 +275,34 @@ 
 ## Backwards Compatability
 
-The Stack executable does not need to, and does not, strive for the same broad
-compatibility with versions of GHC that a library package (such as `pantry`)
-would seek. Instead, Stack aims to define a well-known combination of
-dependencies on which its executable relies. That applies in particular to the
-`Cabal` package, where Stack aims to support one, and only one, version of
-`Cabal` with each release of its executable. At the time of writing (September
-2022) that combination is defined by resolver `nightly-2022-11-14` (for
-GHC 9.2.4, and including `Cabal-3.6.3.0`) - see `stack.yaml`.
+The Stack package provides a library and an executable (`stack`) that depends on
+the library. The library is intended for use only by the executable.
 
+Consequently, the Stack package does not need to, and does not, strive for the
+compatibility with a range of versions of GHC that a library package (such as
+`pantry`) would seek.
+
+Stack aims to depend on well-known packages. The specific versions on which it
+depends at any time are specified by `package.yaml` and `stack.yaml`. It does
+not aim to be compatible with more than one version of the `Cabal` package at
+any time. At the time of writing (March 2023) the package versions are primarily
+ones in Stackage snapshot LTS Haskell 20.13 (for GHC 9.2.7), together with
+extra-dep `Cabal-3.8.1.0`.
+
+A Stack executable makes use of Cabal (the library) through a small 'Setup'
+executable that it compiles from Haskell source code. The executable compiles
+that code with a dependency on the version of Cabal that ships with the
+specified GHC compiler. Each release of Stack will aim to support all versions
+of GHC and the Cabal package in Stackage snapshots published within seven years
+of the release. For example, snapshot LTS Haskell 7.0, published on
+14 September 2016, was the first LTS Haskell snapshot to provide GHC 8.0.1 which
+comes with `Cabal-1.24.0.0`. Until, at least, 13 September 2023, Stack releases
+would aim to support the immediate predecessor, GHC 7.10.3 and `Cabal-1.22.5.0`.
+
+When a version of the Stack executable actually ceases to support a version of
+GHC and `Cabal`, that should be recorded in Stack's
+[ChangeLog](https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md).
+
 ## Code Quality
 
 The Stack project uses [yamllint](https://github.com/adrienverge/yamllint) as a
@@ -329,6 +348,48 @@ stack exec -- sh ./etc/scripts/hlint.sh
 ~~~
 
+## Code Style
+
+A single code style is not applied consistently to Stack's code and Stack is not
+Procrustean about matters of style. Rules of thumb, however, are:
+
+* keep pull requests that simply reformat code separate from those that make
+  other changes to code; and
+* when making changes to code other than reformatting, follow the existing style
+  of the function(s) or module(s) in question.
+
+That said, the following may help:
+
+* Stack's code generally avoids the use of C preprocessor (CPP) directives.
+  Windows and non-Windows code is separated in separate source code directories
+  and distinguished in Stack's Cabal file. `Stack.Constants.osIsWindows :: Bool`
+  is provided. Multi-line strings are generally formatted on the assumption that
+  GHC's `CPP` language pragma is not being used.
+* Language pragmas usually start with `NoImplictPrelude`, where applicable, and
+  then all others are listed alphabetically. The closing `#-}` are aligned, for
+  purely aesthetic reasons.
+* Stack is compiled with GHC's `-Wall` enabled, which includes `-Wtabs` (no tabs
+  in source code). Most modules are based on two spaces (with one space for a
+  `where`) for indentation but older and larger modules are still based on four
+  spaces.
+* Stack's code and documentation tends to be based on lines of no more than 80
+  characters or, if longer, no longer than necessary.
+* Stack uses export lists.
+* Stack's imports are listed alphabetically, including `Stack.Prelude`, where
+  applicable. The module names are left aligned, with space left for `qualified`
+  where it is absent.
+* Stack's code is sufficiently stable that explict import lists can sensibly be
+  used. The exception is the import of `Stack.Prelude`. Not all modules have
+  comprehensive explicit import lists.
+* Short explicit import lists follow the module name. Longer lists start on the
+  line below the module name. Spaces are used to separate listed items from
+  their enclosing parentheses.
+* As noted above, the types used to implement Stack's exceptions and the related
+ `instance` definitions are usually located at the top of the relevant module.
+* In function type signatures, the `::` is kept on the same line as the
+  function's name. This format is Haskell syntax highlighter-friendly.
+* If `where` is used, the declarations follow on a separate line.
+
 ## Testing
 
 The Stack code has both unit tests and integration tests. Integration tests can
@@ -404,6 +465,15 @@ Where again, `<PATTERN>` is the name of the folder listed in the
 [test/integration/tests/](https://github.com/commercialhaskell/stack/tree/master/test/integration/tests)
 directory.
+
+You can disable a few integration tests through the -n option : 
+
+~~~text
+stack build --flag stack:integration-tests stack --exec "stack-integration-test -n <PATTERN1> -n <PATTERN2>"
+~~~
+
+To disable folders named after `<PATTERN1>` and `<PATTERN2>`
+It's especially useful when some tests are taking a while to complete.
 
 ## Continuous integration (CI)
ChangeLog.md view
@@ -1,16 +1,71 @@ # Changelog
 
-## v2.9.3.1 - 2023-06-22
+## v2.11.1 - 2023-05-18
 
-Hackage-only release of the `stack` package:
+**Changes since v2.9.3:**
 
-* Supports building against snapshot Stackage LTS Haskell 21.0 (GHC 9.4.5),
-  without extra deps.
-* Supports build with `persistent-2.14.5.0`, using CPP directives.
-* Supports build with `unix-compat-0.7`, by removing reliance on the module
-  `System.PosixCompat.User` removed in that package.
-* Includes `cabal.project` and `cabal.config` files in the package.
+Behavior changes:
 
+* Add flag `--[no-]-only-local-bin` to Stack's `upgrade` command for a binary
+  upgrade. If the Stack executable is `my-stack`, the default is
+  `my-stack upgrade --only-local-bin` where previously it was, effectively,
+  `my-stack upgrade --no-only-local-bin`. If the Stack executable is `stack`,
+  the default is `stack upgrade --no-only-local-bin`, the same behaviour as
+  previously.
+* Use `$XDG_CACHE_HOME/stack/ghci-script`, rather than
+  `<temp>/haskell-stack-ghci` (where `<temp>` is the directory yielded by the
+  `temporary` package's `System.IO.Temp.getCanonicalTemporaryDirectory`), as the
+  base location for GHCi script files generated by `stack ghci` or `stack repl`.
+  See [#5203](https://github.com/commercialhaskell/stack/issues/5203)
+* Drop support for `Cabal` versions before 1.22 and, consequently, GHC versions
+  before 7.10.
+* `stack ghci` and `stack repl` now take into account the values of
+  `default-language` keys in Cabal files, like they take into account the values
+  of `default-extensions` keys.
+* Removed `--ghc-paths`, `--global-stack-root` and `--local-bin-path` flags for
+  `stack path`, deprecated in Stack 1.1.0 in favour of `--programs`,
+  `--stack-root` and `local-bin` respectively.
+* On Windows, `stack upgrade` always renames the file of the running Stack
+  executable (adding extension `.old`) before attempting to write to the
+  original file name.
+* On Windows, `stack upgrade` does not offer `sudo` command alternatives if
+  attempting to write to the original file name of the running Stack exectuable
+  results in a 'Permission' error.
+
+Other enhancements:
+
+* Add options of the form `--PROG-option=<argument>` to `stack build`, where
+  `PROG` is a program recognised by the Cabal library and one of `alex`, `ar`,
+  `c2hs`, `cpphs`, `gcc`, `greencard`, `happy`, `hsc2hs`, `hscolour`, `ld`,
+  `pkg-config`, `strip` and `tar`. If Cabal uses the program during the
+  configuration step, the argument is passed to it.
+* By default all `--PROG-option` options are applied to all local packages. This
+  behaviour can be changed with new configuration option `apply-prog-options`.
+* Add flag `--[no-]use-root` to `stack script` (default disabled). Used with
+  `--compile` or `--optimize`, when enabled all compilation outputs (including
+  the executable) are written to a script-specific location in the `scripts`
+  directory of the Stack root rather than the script's directory, avoiding
+  clutter of the latter directory.
+* Better error message if the value of the `STACK_WORK` environment variable or
+  `--work-dir` option is not a valid relative path.
+* Stack will use the value of the `GH_TOKEN`, or `GITHUB_TOKEN`, environment
+  variable as credentials to authenticate its GitHub REST API requests.
+* `stack uninstall` also shows how to uninstall Stack-supplied tools.
+
+Bug fixes:
+
+* Fix incorrect warning if `allow-newer-deps` are specified but `allow-newer` is
+  `false`. See
+  [#6068](https://github.com/commercialhaskell/stack/issues/6086).
+* `stack build` with `--file-watch` or `--file-watch-poll` outputs 'pretty'
+  error messages, as intended. See
+  [#5978](https://github.com/commercialhaskell/stack/issues/5978).
+* `stack build` unregisters any local packages for the sub libraries of a local
+  package that is to be unregistered. See
+  [#6046](https://github.com/commercialhaskell/stack/issues/6046).
+* The warning that sublibrary dependency is not supported is no longer triggered
+  by internal libraries.
+
 ## v2.9.3 - 2022-12-16
 
 **Changes since v2.9.1:**
@@ -932,6 +987,15 @@   download a template, Stack will check whether that template had
   been downloaded before. In that case, the cached version will be
   used. See [#3850](https://github.com/commercialhaskell/stack/issues/3850).
+* In Stack's script interpreter, `-- stack --verbosity=info script` and
+  `-- stack script --verbosity=info` now have the same effect and both override
+  the `--verbosity=error` default in the interpreter. Previously the default
+  meant the former was equivalent to
+  `-- stack --verbosity=info script --verbosity=error` and the latter was
+  equivalent to `-- stack --verbosity=error script --verbosity=info`, with the
+  subcommand's global option having precedence over the Stack command's
+  global option in each case. See
+  [#5326](https://github.com/commercialhaskell/stack/issues/5326).
 
 Other enhancements:
 
@@ -2084,7 +2148,7 @@ * Remove deprecated valid-wanted field.
 * Docker: mount home directory in container
   [#1949](https://github.com/commercialhaskell/stack/issues/1949).
-* Deprecate `--local-bin-path` instead `--local-bin`.
+* Deprecate `stack path --local-bin-path`; instead use `--local-bin`.
 * `stack image`: allow absolute source paths for `add`.
 
 Other enhancements:
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2022, Stack contributors
+Copyright (c) 2015-2023, Stack contributors
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
README.md view
@@ -6,15 +6,22 @@ 
 Stack is a cross-platform program for developing Haskell projects. It is intended for Haskellers both new and experienced.
 
-See [haskellstack.org](http://haskellstack.org) or the [doc](./doc) directory for more
-information.
+See [haskellstack.org](http://haskellstack.org), or the [doc](./doc) directory
+of this repository, for more information.
 
+### Learning to use Stack
+
+If are learning to use Stack and have questions, a discussion at the
+[Haskell Community](https://discourse.haskell.org/) forum may help. See its
+'Learn' category.
+
 ### Community
 
 You can participate with the Stack community in the following areas:
 
-* [Haskell Foundation Slack](https://haskell-foundation.slack.com/join/shared_invite/zt-z45o9x38-8L55P27r12YO0YeEufcO2w#/shared-invite/email)
-    * `#stack-users` for general Stack discussion
-    * `#stack-collaborators` for working on the Stack code base
-* [Stack Google Group mailing list](https://groups.google.com/g/haskell-stack)
-* [Haskell Community Discourse](https://discourse.haskell.org/)
+* the [Haskell Community](https://discourse.haskell.org/) forum
+* the Haskell Foundation's
+  [Slack workspace](https://haskell-foundation.slack.com/join/shared_invite/zt-z45o9x38-8L55P27r12YO0YeEufcO2w#/shared-invite/email)
+    * `#stack-users` channel, for general Stack discussion
+    * `#stack-collaborators` channel, for working on Stack's code base
+* the [Google Group mailing list](https://groups.google.com/g/haskell-stack) for Stack
Setup.hs view
@@ -46,7 +46,9 @@   withLibLBI pkg lbi $ \_ libcfg -> do
     withExeLBI pkg lbi $ \exe clbi ->
       rewriteFileEx normal (dir </> "Build_" ++ exeName' exe ++ ".hs") $ unlines
-        [ "module Build_" ++ exeName' exe ++ " where"
+        [ "module Build_" ++ exeName' exe
+        , "  ( deps"
+        , "  ) where"
         , ""
         , "deps :: [String]"
         , "deps = " ++ (show $ formatdeps (transDeps libcfg clbi))
− cabal.config 
@@ -1,206 +0,0 @@-constraints:
-  , Cabal ==3.8.1.0
-  , Cabal-syntax ==3.8.1.0
-  , Glob ==0.10.2
-  , OneTuple ==0.4.1.1
-  , QuickCheck ==2.14.3
-  , StateVar ==1.2.2
-  , Win32 ==2.12.0.1
-  , aeson ==2.1.2.1
-  , annotated-wl-pprint ==0.7.0
-  , ansi-terminal ==0.11.5
-  , ansi-terminal-types ==0.11.5
-  , ansi-wl-pprint ==0.6.9
-  , appar ==0.1.8
-  , array ==0.5.4.0
-  , asn1-encoding ==0.9.6
-  , asn1-parse ==0.9.5
-  , asn1-types ==0.3.4
-  , assoc ==1.1
-  , async ==2.2.4
-  , attoparsec ==0.14.4
-  , attoparsec-iso8601 ==1.1.0.0
-  , auto-update ==0.1.6
-  , base ==4.17.1.0
-  , base-compat ==0.12.2
-  , base-compat-batteries ==0.12.2
-  , base-orphans ==0.9.0
-  , base16-bytestring ==1.0.2.0
-  , base64-bytestring ==1.2.1.0
-  , basement ==0.0.16
-  , bifunctors ==5.5.15
-  , binary ==0.8.9.1
-  , bitvec ==1.1.4.0
-  , blaze-builder ==0.4.2.2
-  , blaze-html ==0.9.1.2
-  , blaze-markup ==0.8.2.8
-  , byteorder ==1.0.4
-  , bytestring ==0.11.4.0
-  , casa-client ==0.0.1
-  , casa-types ==0.0.2
-  , case-insensitive ==1.2.1.0
-  , cereal ==0.5.8.3
-  , clock ==0.8.3
-  , cmdargs ==0.10.22
-  , colour ==2.3.6
-  , comonad ==5.0.8
-  , conduit ==1.3.5
-  , conduit-combinators ==1.3.0
-  , conduit-extra ==1.3.6
-  , connection ==0.3.1
-  , containers ==0.6.7
-  , contravariant ==1.5.5
-  , cookie ==0.4.6
-  , cryptohash-sha256 ==0.11.102.1
-  , cryptonite ==0.30
-  , cryptonite-conduit ==0.2.2
-  , data-default-class ==0.1.2.0
-  , data-fix ==0.3.2
-  , deepseq ==1.4.8.0
-  , digest ==0.0.1.7
-  , directory ==1.3.7.1
-  , distributive ==0.6.2.1
-  , dlist ==1.0
-  , easy-file ==0.2.5
-  , echo ==0.1.4
-  , ed25519 ==0.0.5.0
-  , exceptions ==0.10.5
-  , extra ==1.7.13
-  , fast-logger ==3.2.1
-  , file-embed ==0.0.15.0
-  , filelock ==0.1.1.6
-  , filepath ==1.4.2.2
-  , foldable1-classes-compat ==0.1
-  , fsnotify ==0.4.1.0
-  , generic-deriving ==1.14.4
-  , generically ==0.1.1
-  , ghc-bignum ==1.3
-  , ghc-boot-th ==9.4.5
-  , ghc-prim ==0.9.0
-  , githash ==0.1.6.3
-  , hackage-security ==0.6.2.3
-  , hashable ==1.4.2.0
-  , hi-file-parser ==0.1.4.0
-  . hinotify ==0.4.1
-  , hourglass ==0.2.12
-  , hpack ==0.35.2
-  , hpc ==0.6.1.0
-  , http-api-data ==0.5
-  , http-client ==0.7.13.1
-  , http-client-tls ==0.3.6.1
-  , http-conduit ==2.3.8.1
-  , http-download ==0.2.0.0
-  , http-types ==0.12.3
-  , indexed-traversable ==0.1.2.1
-  , indexed-traversable-instances ==0.1.1.2
-  , infer-license ==0.2.0
-  , integer-gmp ==1.1
-  , integer-logarithms ==1.0.3.1
-  , iproute ==1.7.12
-  , libyaml ==0.1.2
-  , lift-type ==0.1.1.1
-  , lifted-base ==0.2.3.12
-  , lukko ==0.1.1.3
-  , megaparsec ==9.3.1
-  , memory ==0.18.0
-  , microlens ==0.4.13.1
-  , microlens-mtl ==0.2.0.3
-  , microlens-th ==0.4.3.13
-  , mime-types ==0.1.1.0
-  , mintty ==0.1.4
-  , monad-control ==1.0.3.1
-  , monad-logger ==0.3.40
-  , monad-loops ==0.4.3
-  , mono-traversable ==1.0.15.3
-  , mtl ==2.2.2
-  , mtl-compat ==0.2.2
-  , mustache ==2.4.2
-  , neat-interpolation ==0.5.1.3
-  , network ==3.1.4.0
-  , network-uri ==2.6.4.2
-  , old-locale ==1.0.0.7
-  , old-time ==1.1.0.3
-  , open-browser ==0.2.1.0
-  , optparse-applicative ==0.17.1.0
-  , optparse-simple ==0.1.1.4
-  , pantry ==0.8.2.2
-  , parsec ==3.1.16.1
-  , parser-combinators ==1.3.0
-  , path ==0.9.2
-  , path-io ==1.8.1
-  , path-pieces ==0.2.1
-  , pem ==0.2.4
-  , persistent ==2.14.5.0
-  , persistent-sqlite ==2.13.1.1
-  , persistent-template ==2.12.0.0
-  , pretty ==1.1.3.6
-  , primitive ==0.8.0.0
-  , process ==1.6.16.0
-  , project-template ==0.2.1.0
-  , random ==1.2.1.1
-  , resource-pool ==0.4.0.0
-  , resourcet ==1.2.6
-  , retry ==0.9.3.1
-  , rio ==0.1.22.0
-  , rio-orphans ==0.1.2.0
-  , rio-prettyprint ==0.1.4.0
-  , rts ==1.0.2
-  , safe ==0.3.19
-  , safe-exceptions ==0.1.7.3
-  , scientific ==0.3.7.0
-  , semialign ==1.3
-  , semigroupoids ==5.3.7
-  , semigroups ==0.20
-  , silently ==1.2.5.3
-  , socks ==0.6.1
-  , split ==0.2.3.5
-  , splitmix ==0.1.0.4
-  , stack ==2.9.3.1
-  , stm ==2.5.1.0
-  , stm-chans ==3.0.0.9
-  , streaming-commons ==0.2.2.6
-  , strict ==0.5
-  , syb ==0.7.2.3
-  , tagged ==0.8.7
-  , tar ==0.5.1.1
-  , tar-conduit ==0.3.2
-  , template-haskell ==2.19.0.0
-  , temporary ==1.3
-  , text ==2.0.2
-  , text-metrics ==0.3.2
-  , text-short ==0.1.5
-  , th-abstraction ==0.4.5.0
-  , th-compat ==0.1.4
-  , th-expand-syns ==0.4.11.0
-  , th-lift ==0.8.3
-  , th-lift-instances ==0.1.20
-  , th-reify-many ==0.1.10
-  , these ==1.2
-  , time ==1.12.2
-  , time-compat ==1.9.6.1
-  , tls ==1.6.0
-  , transformers ==0.5.6.2
-  , transformers-base ==0.4.6
-  , transformers-compat ==0.7.2
-  , typed-process ==0.2.11.0
-  , unix ==2.7.3
-  , unicode-data ==0.4.0.1
-  , unicode-transforms ==0.4.0.1
-  , unix-compat ==0.7
-  , unix-time ==0.4.9
-  , unliftio ==0.2.25.0
-  , unliftio-core ==0.2.1.0
-  , unordered-containers ==0.2.19.1
-  , uuid-types ==1.0.5
-  , vault ==0.3.1.5
-  , vector ==0.13.0.0
-  , vector-algorithms ==0.9.0.1
-  , vector-stream ==0.1.0.0
-  , witherable ==0.4.2
-  , x509 ==1.7.7
-  , x509-store ==1.6.9
-  , x509-system ==1.6.7
-  , x509-validation ==1.6.12
-  , yaml ==0.11.11.1
-  , zip-archive ==0.4.3
-  , zlib ==0.6.3.0
− cabal.project 
@@ -1,41 +0,0 @@--- This file is a configuration file for Cabal (the tool). It is provided to
--- assist some users of that tool to develop Stack. For information about
--- `cabal.project` files, see:
--- https://cabal.readthedocs.io/en/stable/cabal-project.html.
---
--- For information about possible limitations of the `cabal.config` files
--- corresponding to Stackage package sets that are made available by Stackage
--- see: https://github.com/fpco/stackage-server/issues/232.
---
--- `import:` is only available to users of Cabal (the tool) >= 3.8.1.0.
---
--- The constraints in file `cabal.config` can be obtained by commanding:
---
--- > stack ls dependencies cabal > cabal.config
---
--- However, be aware that, in respect of the `unix` package or the `Win32`
--- package (that may come with GHC, depending on the operating system):
---
--- * on Windows, the Stack project does not depend on `unix` but depends on
---   `Win32`; and
---
--- * on non-Windows operating systems, the Stack project does not depend on
---   `Win32` but depends on `unix`.
---
--- The command above will add one of the two packages to `cabal.config` but omit
--- the other. A comprehensive `cabal.config` will need to be created by editing
--- the command's output.
---
--- Also be aware that there may be other packages required only on non-Windows
--- systems. For example, the `hinotify` package.
---
--- Be sure to set `with-compiler: ghc-x.y.z` below to the version of GHC that is
--- specified by the snapshot specifed in Stack's project-level YAML
--- configuration file (`stack.yaml`). The relevant version of GHC can be
--- confirmed by reviewing the snapshot on Stackage. For example, at:
--- https://www.stackage.org/lts-20.23/cabal.config.
---
-
-with-compiler: ghc-9.4.5
-import: cabal.config
-packages: .
doc/CONTRIBUTING.md view
@@ -275,15 +275,34 @@ 
 ## Backwards Compatability
 
-The Stack executable does not need to, and does not, strive for the same broad
-compatibility with versions of GHC that a library package (such as `pantry`)
-would seek. Instead, Stack aims to define a well-known combination of
-dependencies on which its executable relies. That applies in particular to the
-`Cabal` package, where Stack aims to support one, and only one, version of
-`Cabal` with each release of its executable. At the time of writing (September
-2022) that combination is defined by resolver `nightly-2022-11-14` (for
-GHC 9.2.4, and including `Cabal-3.6.3.0`) - see `stack.yaml`.
+The Stack package provides a library and an executable (`stack`) that depends on
+the library. The library is intended for use only by the executable.
 
+Consequently, the Stack package does not need to, and does not, strive for the
+compatibility with a range of versions of GHC that a library package (such as
+`pantry`) would seek.
+
+Stack aims to depend on well-known packages. The specific versions on which it
+depends at any time are specified by `package.yaml` and `stack.yaml`. It does
+not aim to be compatible with more than one version of the `Cabal` package at
+any time. At the time of writing (March 2023) the package versions are primarily
+ones in Stackage snapshot LTS Haskell 20.13 (for GHC 9.2.7), together with
+extra-dep `Cabal-3.8.1.0`.
+
+A Stack executable makes use of Cabal (the library) through a small 'Setup'
+executable that it compiles from Haskell source code. The executable compiles
+that code with a dependency on the version of Cabal that ships with the
+specified GHC compiler. Each release of Stack will aim to support all versions
+of GHC and the Cabal package in Stackage snapshots published within seven years
+of the release. For example, snapshot LTS Haskell 7.0, published on
+14 September 2016, was the first LTS Haskell snapshot to provide GHC 8.0.1 which
+comes with `Cabal-1.24.0.0`. Until, at least, 13 September 2023, Stack releases
+would aim to support the immediate predecessor, GHC 7.10.3 and `Cabal-1.22.5.0`.
+
+When a version of the Stack executable actually ceases to support a version of
+GHC and `Cabal`, that should be recorded in Stack's
+[ChangeLog](https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md).
+
 ## Code Quality
 
 The Stack project uses [yamllint](https://github.com/adrienverge/yamllint) as a
@@ -329,6 +348,48 @@ stack exec -- sh ./etc/scripts/hlint.sh
 ~~~
 
+## Code Style
+
+A single code style is not applied consistently to Stack's code and Stack is not
+Procrustean about matters of style. Rules of thumb, however, are:
+
+* keep pull requests that simply reformat code separate from those that make
+  other changes to code; and
+* when making changes to code other than reformatting, follow the existing style
+  of the function(s) or module(s) in question.
+
+That said, the following may help:
+
+* Stack's code generally avoids the use of C preprocessor (CPP) directives.
+  Windows and non-Windows code is separated in separate source code directories
+  and distinguished in Stack's Cabal file. `Stack.Constants.osIsWindows :: Bool`
+  is provided. Multi-line strings are generally formatted on the assumption that
+  GHC's `CPP` language pragma is not being used.
+* Language pragmas usually start with `NoImplictPrelude`, where applicable, and
+  then all others are listed alphabetically. The closing `#-}` are aligned, for
+  purely aesthetic reasons.
+* Stack is compiled with GHC's `-Wall` enabled, which includes `-Wtabs` (no tabs
+  in source code). Most modules are based on two spaces (with one space for a
+  `where`) for indentation but older and larger modules are still based on four
+  spaces.
+* Stack's code and documentation tends to be based on lines of no more than 80
+  characters or, if longer, no longer than necessary.
+* Stack uses export lists.
+* Stack's imports are listed alphabetically, including `Stack.Prelude`, where
+  applicable. The module names are left aligned, with space left for `qualified`
+  where it is absent.
+* Stack's code is sufficiently stable that explict import lists can sensibly be
+  used. The exception is the import of `Stack.Prelude`. Not all modules have
+  comprehensive explicit import lists.
+* Short explicit import lists follow the module name. Longer lists start on the
+  line below the module name. Spaces are used to separate listed items from
+  their enclosing parentheses.
+* As noted above, the types used to implement Stack's exceptions and the related
+ `instance` definitions are usually located at the top of the relevant module.
+* In function type signatures, the `::` is kept on the same line as the
+  function's name. This format is Haskell syntax highlighter-friendly.
+* If `where` is used, the declarations follow on a separate line.
+
 ## Testing
 
 The Stack code has both unit tests and integration tests. Integration tests can
@@ -404,6 +465,15 @@ Where again, `<PATTERN>` is the name of the folder listed in the
 [test/integration/tests/](https://github.com/commercialhaskell/stack/tree/master/test/integration/tests)
 directory.
+
+You can disable a few integration tests through the -n option : 
+
+~~~text
+stack build --flag stack:integration-tests stack --exec "stack-integration-test -n <PATTERN1> -n <PATTERN2>"
+~~~
+
+To disable folders named after `<PATTERN1>` and `<PATTERN2>`
+It's especially useful when some tests are taking a while to complete.
 
 ## Continuous integration (CI)
doc/ChangeLog.md view
@@ -1,16 +1,71 @@ # Changelog
 
-## v2.9.3.1 - 2023-06-22
+## v2.11.1 - 2023-05-18
 
-Hackage-only release of the `stack` package:
+**Changes since v2.9.3:**
 
-* Supports building against snapshot Stackage LTS Haskell 21.0 (GHC 9.4.5),
-  without extra deps.
-* Supports build with `persistent-2.14.5.0`, using CPP directives.
-* Supports build with `unix-compat-0.7`, by removing reliance on the module
-  `System.PosixCompat.User` removed in that package.
-* Includes `cabal.project` and `cabal.config` files in the package.
+Behavior changes:
 
+* Add flag `--[no-]-only-local-bin` to Stack's `upgrade` command for a binary
+  upgrade. If the Stack executable is `my-stack`, the default is
+  `my-stack upgrade --only-local-bin` where previously it was, effectively,
+  `my-stack upgrade --no-only-local-bin`. If the Stack executable is `stack`,
+  the default is `stack upgrade --no-only-local-bin`, the same behaviour as
+  previously.
+* Use `$XDG_CACHE_HOME/stack/ghci-script`, rather than
+  `<temp>/haskell-stack-ghci` (where `<temp>` is the directory yielded by the
+  `temporary` package's `System.IO.Temp.getCanonicalTemporaryDirectory`), as the
+  base location for GHCi script files generated by `stack ghci` or `stack repl`.
+  See [#5203](https://github.com/commercialhaskell/stack/issues/5203)
+* Drop support for `Cabal` versions before 1.22 and, consequently, GHC versions
+  before 7.10.
+* `stack ghci` and `stack repl` now take into account the values of
+  `default-language` keys in Cabal files, like they take into account the values
+  of `default-extensions` keys.
+* Removed `--ghc-paths`, `--global-stack-root` and `--local-bin-path` flags for
+  `stack path`, deprecated in Stack 1.1.0 in favour of `--programs`,
+  `--stack-root` and `local-bin` respectively.
+* On Windows, `stack upgrade` always renames the file of the running Stack
+  executable (adding extension `.old`) before attempting to write to the
+  original file name.
+* On Windows, `stack upgrade` does not offer `sudo` command alternatives if
+  attempting to write to the original file name of the running Stack exectuable
+  results in a 'Permission' error.
+
+Other enhancements:
+
+* Add options of the form `--PROG-option=<argument>` to `stack build`, where
+  `PROG` is a program recognised by the Cabal library and one of `alex`, `ar`,
+  `c2hs`, `cpphs`, `gcc`, `greencard`, `happy`, `hsc2hs`, `hscolour`, `ld`,
+  `pkg-config`, `strip` and `tar`. If Cabal uses the program during the
+  configuration step, the argument is passed to it.
+* By default all `--PROG-option` options are applied to all local packages. This
+  behaviour can be changed with new configuration option `apply-prog-options`.
+* Add flag `--[no-]use-root` to `stack script` (default disabled). Used with
+  `--compile` or `--optimize`, when enabled all compilation outputs (including
+  the executable) are written to a script-specific location in the `scripts`
+  directory of the Stack root rather than the script's directory, avoiding
+  clutter of the latter directory.
+* Better error message if the value of the `STACK_WORK` environment variable or
+  `--work-dir` option is not a valid relative path.
+* Stack will use the value of the `GH_TOKEN`, or `GITHUB_TOKEN`, environment
+  variable as credentials to authenticate its GitHub REST API requests.
+* `stack uninstall` also shows how to uninstall Stack-supplied tools.
+
+Bug fixes:
+
+* Fix incorrect warning if `allow-newer-deps` are specified but `allow-newer` is
+  `false`. See
+  [#6068](https://github.com/commercialhaskell/stack/issues/6086).
+* `stack build` with `--file-watch` or `--file-watch-poll` outputs 'pretty'
+  error messages, as intended. See
+  [#5978](https://github.com/commercialhaskell/stack/issues/5978).
+* `stack build` unregisters any local packages for the sub libraries of a local
+  package that is to be unregistered. See
+  [#6046](https://github.com/commercialhaskell/stack/issues/6046).
+* The warning that sublibrary dependency is not supported is no longer triggered
+  by internal libraries.
+
 ## v2.9.3 - 2022-12-16
 
 **Changes since v2.9.1:**
@@ -932,6 +987,15 @@   download a template, Stack will check whether that template had
   been downloaded before. In that case, the cached version will be
   used. See [#3850](https://github.com/commercialhaskell/stack/issues/3850).
+* In Stack's script interpreter, `-- stack --verbosity=info script` and
+  `-- stack script --verbosity=info` now have the same effect and both override
+  the `--verbosity=error` default in the interpreter. Previously the default
+  meant the former was equivalent to
+  `-- stack --verbosity=info script --verbosity=error` and the latter was
+  equivalent to `-- stack --verbosity=error script --verbosity=info`, with the
+  subcommand's global option having precedence over the Stack command's
+  global option in each case. See
+  [#5326](https://github.com/commercialhaskell/stack/issues/5326).
 
 Other enhancements:
 
@@ -2084,7 +2148,7 @@ * Remove deprecated valid-wanted field.
 * Docker: mount home directory in container
   [#1949](https://github.com/commercialhaskell/stack/issues/1949).
-* Deprecate `--local-bin-path` instead `--local-bin`.
+* Deprecate `stack path --local-bin-path`; instead use `--local-bin`.
 * `stack image`: allow absolute source paths for `add`.
 
 Other enhancements:
doc/GUIDE.md view
@@ -42,10 +42,11 @@ 
 Finally, Stack is __isolated__: it will not make changes outside of specific
 Stack directories. Stack-built files generally go in either the Stack root
-directory or `./.stack-work` directories local to each project. The Stack root
-directory holds packages belonging to snapshots and any Stack-installed versions
-of GHC. Stack will not tamper with any system version of GHC or interfere with
-packages installed by other build tools, such as Cabal (the tool).
+directory or `./.stack-work` directories local to each project. The
+[Stack root](stack_root.md) directory holds packages belonging to snapshots and
+any Stack-installed versions of GHC. Stack will not tamper with any system
+version of GHC or interfere with packages installed by other build tools, such
+as Cabal (the tool).
 
 ## Downloading and Installation
 
@@ -83,7 +84,7 @@ template. This template is used by default, but in our example we will refer to
 it expressly. Other templates are available. For further information about
 templates, see the `stack templates` command
-[documentation](GUIDE_advanced.md#the-stack-templates-command).
+[documentation](templates_command.md).
 
 From the root directory for all our Haskell projects, we command:
 
@@ -247,15 +248,15 @@ 
 ~~~yaml
 resolver:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/28.yaml
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/19.yaml
 packages:
 - .
 ~~~
 
 The value of the `resolver` key tells Stack *how* to build your package: which
 GHC version to use, versions of package dependencies, and so on. Our value here
-says to use [LTS Haskell 19.28](https://www.stackage.org/lts-19.28), which
-implies GHC 9.0.2 (which is why `stack build` installs that version of GHC if it
+says to use [LTS Haskell 20.19](https://www.stackage.org/lts-20.19), which
+implies GHC 9.2.7 (which is why `stack build` installs that version of GHC if it
 is not already available to Stack). There are a number of values you can use for
 `resolver`, which we'll cover later.
 
@@ -502,7 +503,7 @@ a bit of information about it at
 [https://www.stackage.org/lts](https://www.stackage.org/lts), including:
 
-* The appropriate resolver value (`resolver: lts-20.4`, as is currently the
+* The appropriate resolver value (`resolver: lts-20.19`, as is currently the
   latest LTS)
 * The GHC version used
 * A full list of all packages available in this snapshot
@@ -521,16 +522,16 @@ 
 ## Resolvers and changing your compiler version
 
-Let's explore package sets a bit further. Instead of lts-19.17, let's change our
-`stack.yaml` file to use the [latest nightly](https://www.stackage.org/nightly).
-Right now, this is currently 2022-12-16 - please see the resolver from the link
-above to get the latest.
+Let's explore package sets a bit further. Instead of `lts-20.19`, let's change
+our `stack.yaml` file to use the
+[latest nightly](https://www.stackage.org/nightly). Right now, this is currently
+2023-05-05 - please see the resolver from the link above to get the latest.
 
 Then, commanding `stack build` again will produce:
 
 ~~~text
 stack build
-# Downloaded nightly-2022-12-16 build plan.
+# Downloaded nightly-2023-05-05 build plan.
 # build output ...
 ~~~
 
@@ -545,8 +546,8 @@ 
 When passed on the command line, you also get some additional "short-cut"
 versions of resolvers: `--resolver nightly` will use the newest Nightly resolver
-available, `--resolver lts` will use the newest LTS, and `--resolver lts-19`
-will use the newest LTS in the 19.x series. The reason these are only available
+available, `--resolver lts` will use the newest LTS, and `--resolver lts-20`
+will use the newest LTS in the 20.x series. The reason these are only available
 on the command line and not in your `stack.yaml` file is that using them:
 
 1. Will slow down your build (since Stack then needs to download information on
@@ -556,11 +557,11 @@ 
 ### Changing GHC versions
 
-Finally, let's try using an older LTS snapshot. We'll use the newest 18.x
+Finally, let's try using an older LTS snapshot. We'll use the newest 19.x
 snapshot with the command:
 
 ~~~text
-stack --resolver lts-18 build
+stack --resolver lts-19 build
 # build output ...
 ~~~
 
@@ -807,7 +808,7 @@   non-standard content into the shared snapshot database.
 
 As you probably guessed, there can be multiple snapshot databases available. See
-the contents of the `snapshots` directory in the Stack root.
+the contents of the `snapshots` directory in the [Stack root](stack_root.md).
 
 * On Unix-like operating systems, each snapshot is in the last of a sequence of
   three subdirectories named after the platform, a 256-bit hash of the source
@@ -1265,9 +1266,6 @@ --local-hoogle-root      Local project documentation root
 --dist-dir               Dist work directory, relative to package directory
 --local-hpc-root         Where HPC reports and tix files are stored
---local-bin-path         DEPRECATED: Use '--local-bin' instead
---ghc-paths              DEPRECATED: Use '--programs' instead
---global-stack-root      DEPRECATED: Use '--stack-root' instead
 ~~~
 
 In addition, `stack path` accepts the flags above on the command line to state
@@ -1342,7 +1340,7 @@ 
 ~~~text
 Run from outside a project, using implicit global project config
-Using latest snapshot resolver: lts-18.3
+Using latest snapshot resolver: lts-20.19
 Writing global (non-project-specific) config file to: /home/michael/.stack/global/stack.yaml
 Note: You can change the snapshot via the resolver field there.
 I installed the stm package via --package stm
@@ -1428,72 +1426,6 @@ configuration. It has no effect on projects at all. Every package you install
 with it is put into isolated databases just like everywhere else. The only magic
 is that it's the catch-all project whenever you're running Stack somewhere else.
-
-## Setting the Stack root location
-
-The Stack root is a directory where Stack stores important files. The location
-and contents of the directory depend on the operating system and/or whether
-Stack is configured to use the XDG Base Directory Specification.
-
-The location of the Stack root can be configured by setting the `STACK_ROOT`
-environment variable or using Stack's `--stack-root` option on the command line.
-
-=== "Unix-like"
-
-    The Stack root contains snapshot packages; tools such as GHC, in a
-    `programs` directory; and Stack's global YAML configuration file
-    (`config.yaml`).
-
-    The default Stack root is `~/.stack`.
-
-=== "Windows"
-
-    The Stack root contains snapshot packages; and Stack's global YAML
-    configuration file (`config.yaml`). The default location of tools such as
-    GHC and MSYS2 is outside of the Stack root.
-
-    The default Stack root is `%APPDIR%\stack`.
-
-    The default location of tools is `%LOCALAPPDATA%\Programs\stack`.
-
-    On Windows, the length of filepaths may be limited (to
-    [MAX_PATH](https://docs.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation?tabs=cmd)),
-    and things can break when this limit is exceeded. Setting a Stack root with
-    a short path to its location (for example, `C:\sr`) can help.
-
-=== "XDG Base Directory Specification"
-
-    On Unix-like operating systems and Windows, Stack can be configured to
-    follow the XDG Base Directory Specification if the environment variable
-    `STACK_XDG` is set to any non-empty value. However, Stack will ignore that
-    configuration if the Stack root location has been set on the command line or
-    the `STACK_ROOT` environment variable exists.
-
-    If Stack is following the XDG Base Directory Specification, the Stack root
-    contains what it would otherwise contain for the operating system, but
-    Stack's global YAML configuration file (`config.yaml`) may be located
-    elsewhere.
-
-    The Stack root is `<XDG_DATA_HOME>/stack`. If the `XDG_DATA_HOME`
-    environment variable does not exist, the default is `~/.local/share/stack`
-    on Unix-like operating systems and `%APPDIR%\stack` on Windows.
-
-    The location of `config.yaml` is `<XDG_CONFIG_HOME>/stack`. If the
-    `XDG_CONFIG_HOME` environment variable does not exist, the default is
-    `~/.config/stack` on Unix-like operating systems and `%APPDIR%\stack` on
-    Windows.
-
-The location of the Stack root is reported by command:
-
-~~~text
-stack path --stack-root
-~~~
-
-The full path of Stack's global YAML configuration file is reported by command:
-
-~~~text
-stack path --global-config
-~~~
 
 ## `stack.yaml` versus Cabal files
doc/README.md view
@@ -33,10 +33,10 @@     Stack so that if Stack needs a version of GHC, GHCup takes over obtaining
     and installing that version.
 
-=== "Unix-like"
+=== "Linux"
 
-    For most Unix-like operating systems, the easiest way to install Stack
-    directly is to command:
+    For most Linux distributions, the easiest way to install Stack
+    directly (rather than use GHCup) is to command:
 
     ~~~text
     curl -sSL https://get.haskellstack.org/ | sh
@@ -57,10 +57,78 @@         installation instructions in the
         [install and upgrade guide](install_and_upgrade.md).
 
+=== "macOS"
+
+    From late 2020, Apple began a transition from Mac computers with Intel
+    processors (Intel-based Mac) to
+    [Mac computers with Apple silicon](https://support.apple.com/en-gb/HT211814).
+
+    === "Intel-based"
+
+        For most Intel-based Mac computers, the easiest way to install Stack
+        directly (rather than use GHCup) is to command:
+
+        ~~~text
+        curl -sSL https://get.haskellstack.org/ | sh
+        ~~~
+
+        or:
+
+        ~~~text
+        wget -qO- https://get.haskellstack.org/ | sh
+        ~~~
+
+        !!! note
+
+            The script at [get.haskellstack.org](https://get.haskellstack.org/)
+            will ask for root access using `sudo`. It needs such access in order
+            to use your platform's package manager to install dependencies and
+            to install to `/usr/local/bin`. If you prefer more control, follow
+            the manual installation instructions in the
+            [install and upgrade guide](install_and_upgrade.md).
+
+    === "Apple silicon"
+
+        Mac computers with Apple silicon have an M1, M1 Pro, M1 Max, M1 Ultra or
+        M2 chip. These chips use an architecture known as ARM64 or AArch64.
+
+        For Mac computers with Apple silicon, the easiest way to install Stack
+        directly (rather than use GHCup) is to obtain the 'unofficial'
+        `osx-aarch64` binary distribution released by the GHCup developers and
+        copy it to a location on the PATH. `*.tar.gz` archive files containing
+        those binary distributions are available at the directories here:
+        [:material-cloud-download-outline:](https://downloads.haskell.org/ghcup/unofficial-bindists/stack/).
+
+        It is still possible to use the commands:
+
+        ~~~text
+        curl -sSL https://get.haskellstack.org/ | sh
+        ~~~
+
+        or:
+
+        ~~~text
+        wget -qO- https://get.haskellstack.org/ | sh
+        ~~~
+
+        However, those commands will download and install the version of Stack
+        for Intel-based Mac computers. Mac computers with Apple silicon will
+        use Apple's
+        [Rosetta 2 application](https://support.apple.com/en-gb/HT211861) to
+        use that version of Stack.
+
+        Apple's Terminal application will not detect automatically that Rosetta
+        has not yet been installed. Rosetta can be manually installed by
+        commanding:
+
+        ~~~text
+        softwareupdate --install-rosetta
+        ~~~
+
 === "Windows"
 
-    On 64-bit Windows, the easiest way to install Stack directly is to download
-    and install the
+    On 64-bit Windows, the easiest way to install Stack directly (rather than
+    use GHCup) is to download and install the
     [Windows installer](https://get.haskellstack.org/stable/windows-x86_64-installer.exe).
 
     !!! note
@@ -70,8 +138,8 @@ 
 === "Other/direct downloads"
 
-    For other operating systems and direct downloads, see the
-    [install and upgrade guide](install_and_upgrade.md).
+    For other operating systems and direct downloads (rather than use GHCup),
+    see the [install and upgrade guide](install_and_upgrade.md).
 
 ## How to upgrade Stack
 
@@ -267,7 +335,7 @@ 1.  Clone the `stack` repository from GitHub with the command:
 
     ~~~text
-    git clone https://github.com/commercialhaskell/stack.git`
+    git clone https://github.com/commercialhaskell/stack.git
     ~~~
 
 2.  Change the current working directory to the cloned `stack` directory with the
doc/Stack_and_VS_Code.md view
@@ -75,9 +75,9 @@ 
 For this workaround to work, each time that a resolver is used that references a
 different version of GHC, then GHCup must be used to install it (if GHCup has
-not already installed that version). For example, to use `resolver: lts-19.16`
-(GHC 9.0.2), the command `ghcup install ghc 9.0.2` must have been used to
-install GHC 9.0.2. That may be a minor inconvenience for some people, as one the
+not already installed that version). For example, to use `resolver: lts-20.19`
+(GHC 9.2.7), the command `ghcup install ghc 9.2.7` must have been used to
+install GHC 9.2.7. That may be a minor inconvenience for some people, as one the
 primary benefits of Stack over other Haskell build tools has been that Stack
 automatically ensures that the necessary version of GHC is available.
doc/build_command.md view
@@ -3,37 +3,30 @@ # The `stack build` command and its synonyms
 
 ~~~text
-stack build [TARGET] [--dry-run] [--pedantic] [--fast]
-            [--ghc-options OPTIONS] [--flag PACKAGE:[-]FLAG]
-            [--dependencies-only | --only-snapshot |
-              --only-dependencies | --only-locals]
-            [--file-watch | --file-watch-poll] [--watch-all]
-            [--exec COMMAND [ARGUMENT(S)]] [--only-configure]
-            [--trace] [--profile] [--no-strip]
+stack build [TARGET] [--dry-run] [--pedantic] [--fast] [--ghc-options OPTIONS]
+            [--flag PACKAGE:[-]FLAG] [--dependencies-only | --only-snapshot |
+              --only-dependencies | --only-locals] [--file-watch |
+              --file-watch-poll] [--watch-all] [--exec COMMAND [ARGUMENT(S)]]
+            [--only-configure] [--trace] [--profile] [--no-strip]
             [--[no-]library-profiling] [--[no-]executable-profiling]
             [--[no-]library-stripping] [--[no-]executable-stripping]
             [--[no-]haddock] [--haddock-arguments HADDOCK_ARGS]
-            [--[no-]open] [--[no-]haddock-deps]
-            [--[no-]haddock-internal]
+            [--[no-]open] [--[no-]haddock-deps] [--[no-]haddock-internal]
             [--[no-]haddock-hyperlink-source] [--[no-]copy-bins]
-            [--[no-]copy-compiler-tool] [--[no-]prefetch]
-            [--[no-]keep-going] [--[no-]keep-tmp-files]
-            [--[no-]force-dirty] [--[no-]test] [--[no-]rerun-tests]
-            [--ta|--test-arguments TEST_ARGS] [--coverage]
+            [--[no-]copy-compiler-tool] [--[no-]prefetch] [--[no-]keep-going]
+            [--[no-]keep-tmp-files] [--[no-]force-dirty] [--[no-]test]
+            [--[no-]rerun-tests] [--ta|--test-arguments TEST_ARGS] [--coverage]
             [--no-run-tests] [--test-suite-timeout ARG]
             [--[no-]tests-allow-stdin] [--[no-]bench]
-            [--ba|--benchmark-arguments BENCH_ARGS]
-            [--no-run-benchmarks] [--[no-]reconfigure]
-            [--cabal-verbosity VERBOSITY | --[no-]cabal-verbose]
-            [--[no-]split-objs] [--skip ARG]
+            [--ba|--benchmark-arguments BENCH_ARGS] [--no-run-benchmarks]
+            [--[no-]reconfigure] [--cabal-verbosity VERBOSITY |
+              --[no-]cabal-verbose] [--[no-]split-objs] [--skip ARG]
             [--[no-]interleaved-output] [--ddump-dir ARG]
 ~~~
 
-## Overview
-
-Stack's primary command is `build`. This page describes its interface. The goal
-of the interface is to do the right thing for simple input, and allow
-flexibility for more complicated goals.
+`stack build` and its synonyms (`stack test`, `stack bench`, `stack haddock` and
+`stack install`) are Stack's primany command. The command provides a simple
+interface for simple tasks and flexibility for more complicated goals.
 
 See the introductory part of Stack's
 [user's guide](GUIDE.md#the-stack-build-command) for an introduction to the
@@ -41,26 +34,23 @@ 
 ## Synonyms
 
-The synonym commands for `build` are:
+The synonym commands for `stack build` are:
 
-|Synonym command|Equivalent `build` command flag|
-|---------------|-------------------------------|
-|`stack test`   |`stack build --test`           |
-|`stack bench`  |`stack build --bench`          |
-|`stack haddock`|`stack build --haddock`        |
-|`stack install`|`stack build --copy-bins`      |
+|Synonym command|Equivalent `stack build` command flag|
+|---------------|-------------------------------------|
+|`stack test`   |`stack build --test`                 |
+|`stack bench`  |`stack build --bench`                |
+|`stack haddock`|`stack build --haddock`              |
+|`stack install`|`stack build --copy-bins`            |
 
 The advantage of the synonym commands is that they are convenient and short. The
-advantage of the flags is that they compose. For example,
-`stack build --test --copy-bins` will build libraries, executables, and test
-suites, run the test suites, and then copy the executables to your local bin
-path (more on this below).
+advantage of the flags is that they compose. See the examples below.
 
 ## Components
 
 Every Cabal package is made up of one or more components. It can have an
-optional library component, one or more optional executable components, one or
-more optional test suite components, and one or more optional benchmark
+optional public library component, one or more optional executable components,
+one or more optional test suite components, and one or more optional benchmark
 components.
 
 Stack allows you to identify a specific component to be built. For example,
@@ -95,21 +85,34 @@     of the test suite and benchmark components, respectively, are selected to be
     built.
 
+    Stackage snapshots do not include directly GHC boot packages (packages that
+    come with GHC and are included in GHC's global package database). For
+    example, if `Cabal` is not a local package or an extra dep, then
+    `stack build Cabal` will specify the latest version of that package in the
+    package index, which may differ from the version provided by the version of
+    GHC specified by the snapshot.
+
 *   *package identifier*, e.g. `stack build foobar-1.2.3`, is usually used to
-    include specific package versions from the package index. If the version
-    selected conflicts with an existing local package or extra dep, then Stack
-    fails with an error. Otherwise, this is the same as using
-    `stack build foobar`, except instead of using the latest version from the
-    package index, the version specified is used.
+    include specific package versions from the package index.
 
+    If the package name conflicts with that of a local package, then Stack
+    fails with an error.
+
+    Otherwise, this is the same as using `stack build foobar` (that is, ignoring
+    the specified version), unless the specified version exists in the package
+    index. If it exists, then the latest revision of that version from the
+    package index is used.
+
 *   *component*. Instead of referring to an entire package and letting Stack
     decide which components to build, you select individual components from
     inside a package. This can be done for more fine-grained control over which
     test suites to run, or to have a faster compilation cycle. There are
     multiple ways to refer to a specific component (provided for convenience):
 
-    *   `packagename:comptype:compname` is the most explicit. The available
-        comptypes are `exe`, `test`, and `bench`.
+    *   `<package-name>:lib` or `<package-name>:<comp-type>:<comp-name>` (where
+        the component type, `<comp-type>`, is one of `exe`, `test`, or `bench`)
+        is the most explicit. The library component type (`lib`) does not have
+        an associated component name, `<comp-name>`.
 
         !!! note
 
@@ -118,14 +121,14 @@             all currently released versions of Cabal. See
             [issue#1046](https://github.com/commercialhaskell/stack/issues/1406)
 
-    *   `packagename:compname` allows you to leave out the component type, as
-         that will (almost?) always be redundant with the component name. For
+    *   `<package-name>:<comp-name>` allows you to leave out the component type,
+         as that will often be unique for a given component name. For
          example, `stack build mypackage:mytestsuite`.
 
-    *   `:compname` is a useful shortcut, saying "find the component in all of
-        the local packages." This will result in an error if multiple packages
-        have a component with the same name. To continue the above example,
-        `stack build :mytestsuite`.
+    *   `:<comp-name>` is a useful shortcut, saying "find the component
+        `<comp-name>` in all of the local packages". This will result in an
+        error if more than one package has a component with the specified name.
+        To continue the above example, `stack build :mytestsuite`.
 
 *   *directory*, e.g. `stack build foo/bar`, will find all local packages that
     exist in the given directory hierarchy and then follow the same procedure as
@@ -153,23 +156,23 @@ In addition to specifying targets, you can also control what gets built, or
 retained, with the following flags:
 
-### The `stack build --bench` flag
+### `--bench` flag
 
 Pass the flag to add benchmark components to the targets, if specific components
-are not identified.
+are not identified. The `stack bench` synonym sets this flag.
 
-### The `stack build --dependencies-only` flag
+### `--dependencies-only` flag
 
 Pass the flag to skip building the targets. The flag `--only-dependencies` has
 the same effect.
 
-### The `stack build --[no-]dry-run` flag
+### `--[no-]dry-run` flag
 
 Default: Disabled
 
 Set the flag to build nothing and output information about the build plan.
 
-### The `stack build --flag` option
+### `--flag` option
 
 `stack build --flag <package_name>:[-]<flag_name>` sets (or unsets) the
 specified Cabal flag for the specified package.
@@ -191,22 +194,46 @@     behavior currently and doesn't require that the modules be listed. This may
     change in a future release.
 
-### The `stack build --[no-]force-dirty` flag
+### `--[no-]force-dirty` flag
 
 Default: Disabled
 
 Set the flag to force rebuild of packages even when it doesn't seem necessary
 based on file dirtiness.
 
-### The `stack build --[no-]haddock` flag
+### `--[no-]haddock` flag
 
 Default: Disabled
 
 Set the flag to build Haddock documentation. This may cause a lot of packages to
-get re-built, so that the documentation links work.
+get re-built, so that the documentation links work. The `stack haddock` synonym
+sets this flag.
 
-### The `stack build --[no-]keep-going` flag
+### `--haddock-arguments` option
 
+`stack haddock --haddock-arguments <haddock_arguments>` passes the specified
+arguments to the Haddock tool.
+
+### `--[no-]haddock-deps` flag
+
+Default: Enabled (if building Haddock documnentation)
+
+Unset the flag to disable building Haddock documentation for dependencies.
+
+### `--[no-]haddock-hyperlink-source` flag
+
+Default: Enabled
+
+Unset the flag to disable building building hyperlinked source for Haddock.
+
+### `--[no-]haddock-internal` flag
+
+Default: Disabled
+
+Set the flag to enable building Haddock documentation for internal modules.
+
+### `--[no-]keep-going` flag
+
 Default (`stack build`): Disabled
 
 Default (`stack test` or `stack bench`): Enabled
@@ -214,7 +241,7 @@ Set the flag to continue building packages even after some build step fails.
 The packages which depend upon the failed build won't get built.
 
-### The `stack build --[no-]keep-tmp-files` flag
+### `--[no-]keep-tmp-files` flag
 
 Default: Disabled
 
@@ -222,7 +249,7 @@ otherwise be considered temporary and deleted. It may be useful to inspect
 these, if a build fails. By default, they are not kept.
 
-### The `stack build --only-configure` flag
+### `--only-configure` flag
 
 [:octicons-tag-24: 0.1.4.0](https://github.com/commercialhaskell/stack/releases/tag/v0.1.4.0)
 
@@ -234,17 +261,22 @@     If there are downstream actions that require a package to be built then a
     full build will occur, even if the flag is passed.
 
-### The `stack build --only-dependencies` flag
+### `--only-dependencies` flag
 
 Pass the flag to skip building the targets. The flag `--dependencies-only` has
 the same effect.
 
-### The `stack build --only-snapshot` flag
+### `--only-locals` flag
 
+Pass the flag to build only packages in the local database. Fails if the build
+plan includes packages in the snapshot database.
+
+### `--only-snapshot` flag
+
 Pass the flag to build only snapshot dependencies, which are cached and shared
 with other projects.
 
-### The `stack build --[no-]reconfigure` flag
+### `--[no-]reconfigure` flag
 
 Default: Disabled
 
@@ -252,7 +284,7 @@ on file dirtiness. This is sometimes useful with custom `Setup.hs` files, in
 particular when they depend on external data files.
 
-### The `stack build --skip` option
+### `--skip` option
 
 `stack build --skip <component>` skips building the specified components of a
 local package. It allows you to skip test suites and benchmark without
@@ -263,36 +295,210 @@ 
 This option can be specified multiple times to skip multiple components.
 
-### The `stack build --test` flag
+### `--test` flag
 
 Pass the flag to add test suite components to the targets, if specific
-components are not identified.
+components are not identified. The `stack test` synonym sets this flag.
 
-## Other flags and options
+## Controlling when building occurs
 
-There are a number of other flags accepted by `stack build`. Instead of listing
-all of them, please use `stack build --help`. Some particularly convenient ones
-worth mentioning here since they compose well with the rest of the build system
-as described:
+### `--file-watch` flag
 
-### The `stack build --coverage` flag
+Pass the flag to rebuild your project every time a file changes. By default it
+will take into account all files belonging to the targets you specify. See also
+the `--watch-all` flag.
 
+### `--file-watch-poll` flag
+
+Like the `--file-watch` flag, but based on polling the file system instead of
+using events to determine if a file has changed.
+
+### `--watch-all` flag
+
+Pass the flag to rebuild your project every time any local file changes (from
+project packages or from local dependencies). See also the `--file-watch` flag.
+
+## Controlling what happens after building
+
+### `--exec` option
+
+`stack build --exec "<command> [<arguments>]"` will run the specified command
+after a successful build.
+
+## Flags affecting GHC's behaviour
+
+### `--[no-]executable-profiling` flag
+
+Default: Disabled
+
+Set the flag to enable executable profiling for TARGETs and all its
+dependencies.
+
+### `--[no-]executable-stripping` flag
+
+Default: Enabled
+
+Unset the flag to disable executable stripping for TARGETs and all its
+dependencies.
+
+### `--fast` flag
+
+Pass the flag to build your project with the GHC option `-O0`. `-O0` disables
+GHC's optimisations (which is GHC's default).
+
+### `--ghc-options` option
+
+`stack build --ghc-options <ghc_options>` passes the specified command line
+options to GHC, depending on Stack's
+[`apply-ghc-options`](yaml_configuration.md#apply-ghc-options) YAML
+configuration option. This option can be specified multiple times.
+
+GHC's command line options are _order-dependent_ and evaluated from left to
+right. Later options can override earlier options. Stack applies the options
+specified at the command line last. Any existing GHC command line options of a
+package are applied after those specified at the command line.
+
+### `--[no-]library-profiling` flag
+
+Default: Disabled
+
+Set the flag to enable library profiling for TARGETs and all its dependencies.
+
+### `--[no-]library-stripping` flag
+
+Default: Enabled
+
+Unset the flag to disable library stripping for TARGETs and all its
+dependencies.
+
+### `--pedantic` flag
+
+Pass the flag to build your project with the GHC options `-Wall` and `-Werror`.
+`-Wall` turns on all warning options that indicate potentially suspicious code.
+`-Werror` makes any warning into a fatal error.
+
+### `--profile` flag
+
+Pass the flag to enable profiling in libraries, executables, etc. for all
+expressions, and generate a profiling report in tests or benchmarks.
+
+### `--[no-]split-objs` flag
+
+:octicons-beaker-24: Experimental
+
+Default: Disabled
+
+Set the flag to enable the GHC option `--split-objs`. This will reduce output
+size (at the cost of build time).
+
+!!! note
+
+    The behaviour of this feature may be changed and improved. You will need to
+    clean your project's Stack working directory before use. If you want to
+    compile all dependencies with split-objs, you will need to delete the
+    snapshot (and all snapshots that could reference that snapshot).
+
+### `--no-strip` flag
+
+Pass the flag to disable DWARF debugging symbol stripping in libraries,
+executables, etc. for all expressions, producing larger executables but allowing
+the use of standard debuggers/profiling tools/other utilities that use debugging
+symbols.
+
+### `--trace` flag
+
+Pass the flag to enable profiling in libraries, executables, etc. for all
+expressions, and generate a backtrace on exception.
+
+## Flags affecting other tools' behaviour
+
+### `--PROG-option` options
+
+[:octicons-tag-24: 2.11.1](https://github.com/commercialhaskell/stack/releases/tag/v2.11.1)
+
+`PROG` is a program recognised by Cabal (the library) and one of `alex`, `ar`,
+`c2hs`, `cpphs`, `gcc`, `greencard`, `happy`, `hsc2hs`, `hscolour`, `ld`,
+`pkg-config`, `strip` and `tar`.
+
+`stack build --PROG-option <PROG_argument>` passes the specified command line
+argument to `PROG`, if it used by Cabal during the configuration step. This
+option can be specified multiple times. For example, if the program `happy` is
+used by Cabal during the configuration step, you could command
+`stack build --happy-option=--ghc` or `stack build --happy-option --ghc` to pass
+to `happy` its `--ghc` flag.
+
+By default, all and any `--PROG-option` options on Stack's command line are
+applied to all local packages (targets or otherwise). This behaviour can be
+changed. See the
+[`apply-prog-options`](yaml_configuration.md#apply-prog-options) configuration
+option.
+
+Stack can also be configured to pass Cabal's `--PROG-option`, `--PROG-options`
+or other options to Cabal during the configuration step. For further
+information, see the documentation for the
+[configure-options](yaml_configuration.md#configure-options) configuration
+option.
+
+## Flags relating to build outputs
+
+### `--[no]-cabal-verbose` flag
+
+Default: Disabled
+
+Set the flag to enable verbose output from Cabal (the library). This flag is an
+alternative to the `--cabal-verbosity` option.
+
+### `--[no]-cabal-verbosity` option
+
+`stack build --cabal-verbosity <verbosity_level>` sets the specified verbosity
+level for output from Cabal (the library). It accepts Cabal's numerical and
+extended syntax. This option is an alternative to setting the `--cabal-verbose`
+flag.
+
+### `--[no-]copy-bins` flag
+
+[:octicons-tag-24: 0.1.3.0](https://github.com/commercialhaskell/stack/releases/tag/v0.1.3.0)
+
+Default: Disabled
+
+Set the flag to enable copying of built executable files (binaries) of targets
+to Stack's local binary directory (see `stack path --local-bin`). The
+`stack install` synonym sets this flag.
+
+### `--[no-]copy-compiler-tool` flag
+
+[:octicons-tag-24: 1.6.1](https://github.com/commercialhaskell/stack/releases/tag/v1.6.1)
+
+Default: Disabled
+
+Set the flag to enable copying of built executable files (binaries) of targets
+to Stack's compiler tools binary directory (see
+`stack path --compiler-tools-bin`).
+
+### `--coverage` flag
+
 Pass the flag to generate a code coverage report. For further information, see
 the [code coverage](hpc_command.md) documentation.
 
-### The `stack build --exec` option
+### `--ddump-dir` option
 
-`stack build --exec "<command> [<arguments>]"` will run a command after a
-successful build.
+GHC has a number of `ddump-*` flags and options to allow dumping out of
+intermediate structures produced by the compiler. They include the
+`-ddump-to-file` flag that causes the output from other flags to be dumped to a
+file or files.
 
-### The `stack build --file-watch` flag
+`stack build --ddump_dir <relative_directory>` causes Stack to copy `*.dump-*`
+files to subdirectories of the specified directory, which is relative to Stack's
+working directory for the project.
 
-Pass the flag to rebuild your project every time a file changes. By default it
-will take into account all files belonging to the targets you specify. See also
-the `--watch-all` flag.
+For example:
 
-### The `stack build --[no-]interleaved-output` flag
+~~~text
+stack build --ghc-options "-ddump-to-file -ddump-timings" --ddump-dir my-ddump-dir
+~~~
 
+### `--[no-]interleaved-output` flag
+
 [:octicons-tag-24: 2.1.1](https://github.com/commercialhaskell/stack/releases/tag/v2.1.1)
 
 Default: Enabled
@@ -345,19 +551,23 @@   default `dump-logs` mode is to output the contents of the log files that are
   warnings.
 
-### The `stack build --pedantic` flag
+### `--[no]-open` flag
 
-Pass the flag to build your project with the GHC options `-Wall` and `-Werror`.
-`-Wall` turns on all warning options that indicate potentially suspicious code.
-`-Werror` makes any warning into a fatal error.
+Default: Disabled
 
-### The `stack build --watch-all` flag
+Set the flag to enable opening the local Haddock documentation in the browser.
 
-Pass the flag to rebuild your project every time any local file changes (from
-project packages or from local dependencies). See also the `--file-watch` flag.
+## Other flags and options
 
-### The `stack build --tests-allow-stdin` flag
+### `--[no]-prefetch` flag
 
+Default: Disabled
+
+Set the flag to enable fetching packages necessary for the build immediately.
+This can be useful with `stack build --dry-run`.
+
+### `--tests-allow-stdin` flag
+
 [:octicons-tag-24: 2.9.3](https://github.com/commercialhaskell/stack/releases/tag/v2.9.3)
 
 Default: Enabled
@@ -370,26 +580,82 @@ pass `--no-tests-allow-stdin` and the executable seeks input on the standard
 input channel, an exception will be thown.
 
-## Composition
+## Examples
 
-To come back to the composable approach described above, consider this example
-(which uses the `wai` [repository](https://github.com/yesodweb/wai/)). The
-command:
+All the following examples assume that:
 
-~~~text
-stack build --file-watch --test --copy-bins --haddock wai-extra :warp warp:doctest --exec 'echo Yay, it worked!'
-~~~
+*   if `stack build` is commanded outside of a project directory, there is no
+    `stack.yaml` file in the current directory or ancestor directory and,
+    consequently, the project-level configuration will be determined by a
+    `stack.yaml` file in the `global-project` directory in the
+    [Stack root](stack_root.md) (for further information, see the
+    [YAML configuration](yaml_configuration.md) documentation); and
 
-will start Stack up in file watch mode, waiting for files in your project to
-change. When first starting, and each time a file changes, it will do all of the
-following.
+*   if `stack build` is commanded in a project directory, there is a
+    `stack.yaml` file in that directory.
 
-* Build the wai-extra package and its test suites
-* Build the `warp` executable
-* Build the warp package's doctest component (which, as you may guess, is a
-  test site)
-* Run all of the wai-extra package's test suite components and the doctest test
-  suite component
-* If all of that succeeds:
-    * Copy generated executables to the local bin path
-    * Run the command `echo Yay, it worked!`
+Examples:
+
+*   In the project directory, `stack build --test --copy-bins` or, equivalently,
+    `stack test --copy-bins` or `stack install --test`, will build libraries,
+    executables, and test suites, run the test suites, and then copy the
+    executables to Stack's local binary directory (see
+    `stack path --local-bin`). This is an example of the flags composing.
+
+*   The following example uses a clone of the
+    `wai` [repository](https://github.com/yesodweb/wai/). The `wai` project
+    comprises a number of packages, including `wai-extra` and `warp`. In the
+    `wai` project directory, the command:
+
+    ~~~text
+    stack build --file-watch --test --copy-bins --haddock wai-extra :warp warp:doctest --exec 'echo Yay, it worked!'
+    ~~~
+
+    will start Stack up in file watch mode, waiting for files in your project to
+    change. When first starting, and each time a file changes, it will do all of
+    the following.
+
+    *   Build the `wai-extra` package and its test suites
+    *   Build the `warp` executable
+    *   Build the `warp` package's `doctest` component (which is a test site)
+    *   Run all of the `wai-extra` package's test suite components and the
+        `doctest` test suite component
+    *   If all of that succeeds:
+          * Copy generated executables to Stack's local binary directory (see
+            `stack path --local-bin`)
+          * Run the command `echo Yay, it worked!`
+
+*   The following example uses the `Adga` package and assumes that `Adga-2.6.3`
+    is the latest version in the package index (e.g. Hackage) and is not a
+    version in the snapshot specified by the `stack.yaml` in the
+    `global-project` directory in the Stack root.
+
+    Outside a project directory, `stack build Adga-2.6.3 --copy-bins` or,
+    equivalently, `stack install Agda-2.6.3`, will attempt to build the
+    libraries and executables of the identified version of the package in the
+    package index (using the `stack.yaml` file in the `global-project`
+    directory in the Stack root), and then copy the executables to Stack's local
+    binary directory (see `stack path --local-bin`).
+
+    If a different snapshot is required to build the identified version of the
+    package, then that can be specified at the command line. For example, to use
+    the most recent Stackage Nightly snapshot:
+
+    ~~~text
+    stack --resolver nightly install Agda-2.6.3
+    ~~~
+
+    Alternatively, Stack can be used to unpack the package from the package
+    index into a local project directory named after the package identifier (for
+    further infomation, see the [`stack unpack` command](unpack_command.md)
+    documentation) and, if the package does not provide its own Stack
+    configuration file (`stack.yaml`), to attempt to initialise that
+    configuration (for further information, see the
+    [`stack init` command](init_command.md) documentation). For example:
+
+    ~~~text
+    stack unpack Agda-2.6.3
+    cd Agda-2.6.3  # Change to the project directory
+    stack init     # Attempt to create a project stack.yaml file
+    stack install  # Equivalent to stack build --copy-bins
+    ~~~
doc/config_command.md view
@@ -85,8 +85,8 @@ project-level configuration file (`stack.yaml`).
 
 A snapshot of `lts` or `nightly` will be translated into the most recent
-available. A snapshot of `lts-19` will be translated into the most recent
-available in the `lts-19` sequence.
+available. A snapshot of `lts-20` will be translated into the most recent
+available in the `lts-20` sequence.
 
 Known bug:
doc/custom_snapshot.md view
@@ -17,8 +17,8 @@     snapshot specification.
 
 ~~~yaml
-resolver: lts-8.21 # Inherits GHC version and package set
-compiler: ghc-8.0.1 # Overwrites GHC version in the resolver, optional
+resolver: lts-20.19 # Inherits GHC version and package set
+compiler: ghc-9.6.1 # Overwrites GHC version in the resolver, optional
 
 # Additional packages, follows extra-deps syntax
 packages:
@@ -61,37 +61,37 @@ 
 ### Overriding the compiler
 
-The following snapshot specification will be identical to `lts-7.1`, but instead
-use `ghc-7.10.3` instead of `ghc-8.0.1`:
+The following snapshot specification will be identical to `lts-20.19`, but instead
+use `ghc-9.2.6` instead of `ghc-9.2.7`:
 
 ~~~yaml
-resolver: lts-7.1
-compiler: ghc-7.10.3
+resolver: lts-20.19
+compiler: ghc-9.2.6
 ~~~
 
 ### Dropping packages
 
-The following snapshot specification will be identical to `lts-7.1`, but without
+The following snapshot specification will be identical to `lts-20.19`, but without
 the `text` package in our snapshot. Removing this package will cause all the
 packages that depend on `text` to be unbuildable, but they will still be present
 in the snapshot.
 
 ~~~yaml
-resolver: lts-7.1
+resolver: lts-20.19
 drop-packages:
-  - text
+- text
 ~~~
 
 ### Hiding packages
 
-The following snapshot specification will be identical to `lts-7.1`, but the
+The following snapshot specification will be identical to `lts-20.19`, but the
 `text` package will be hidden when registering. This will affect, for example,
 the import parser in the script command.
 
 ~~~yaml
-resolver: lts-7.1
+resolver: lts-20.19
 hidden:
-  - text
+- text
 ~~~
 
 ### Specifying GHC options
@@ -99,13 +99,13 @@ In order to specify GHC options for a package, you use the same syntax as the
 [ghc-options](yaml_configuration.md#ghc-options) key for build configuration.
 
-The following snapshot specification will be identical to `lts-7.1`, but
+The following snapshot specification will be identical to `lts-20.19`, but
 provides `-O1` as a ghc-option for `text`:
 
 ~~~yaml
-resolver: lts-7.1
+resolver: lts-20.19
 packages:
-  - text-1.2.2.1
+- text-1.2.5.0
 ghc-options:
   text: -O1
 ~~~
@@ -122,13 +122,13 @@ 
 In order to specify Cabal flags for a package, you use the same syntax as the
 [flags](yaml_configuration.md#flags) key for build configuration. The
-following snapshot specification will be identical to `lts-7.1`, but
+following snapshot specification will be identical to `lts-20.19`, but
 it enables the `developer` Cabal flag:
 
 ~~~yaml
-resolver: lts-7.1
+resolver: lts-20.19
 packages:
-  - text-1.2.2.1
+- text-1.2.5.0
 flags:
   text:
     developer: true
doc/environment_variables.md view
@@ -5,6 +5,22 @@ The environment variables listed in alphabetal order below can affect how Stack
 behaves.
 
+## `GH_TOKEN` or `GITHUB_TOKEN`
+
+[:octicons-tag-24: 2.11.1](https://github.com/commercialhaskell/stack/releases/tag/v2.11.1)
+
+Stack will use the value of the `GH_TOKEN` or, in the alternative,
+`GITHUB_TOKEN` environment variable (if not an empty string) as credentials to
+authenticate its requests of the GitHub REST API, using HTTP 'Basic'
+authentication.
+
+GitHub limits the rate of unauthenticated requests to its API, although most
+users of Stack will not experience that limit from the use of Stack alone. The
+limit for authenticated requests is significantly higher.
+
+For more information about authentication of requests of the GitHub REST API,
+see GitHub's REST API documentation.
+
 ## `HACKAGE_KEY`
 
 [:octicons-tag-24: 2.7.5](https://github.com/commercialhaskell/stack/releases/tag/v2.7.5)
@@ -73,20 +89,25 @@ Related command: all commands that make use of Stack's global YAML configuration
 file (`config.yaml`).
 
-Overridden by: Stack's global `--stack-root` option.
+Overridden by: Stack's global
+[`--stack-root`](global_flags.md#-stack-root-option) option.
 
-The environment variable `STACK_ROOT` can be used to specify the Stack root
-directory.
+The environment variable `STACK_ROOT` can be used to specify the
+[Stack root](stack_root.md) directory.
 
 ## `STACK_WORK`
 
-Related command: all commands that make use of Stack's working directory.
+Related command: all commands that make use of Stack's work directories.
 
-Overridden by: Stack's global `--work-dir` option.
+Overridden by: Stack's [`work-dir`](yaml_configuration.md#work-dir) non-project
+specific configuration option, or global
+[`--work-dir`](global_flags.md#-work-dir-option) option.
 
-The environment variable `STACK_YAML` can be used to specify Stack's
-working directory in a project. The path must be a relative one, relative to the
-root directory of the project.
+The environment variable `STACK_WORK` can be used to specify the path of Stack's
+work directory, within a local project or package directory, and override
+Stack's default of `.stack-work`. The path must be a relative one, relative to
+the root directory of the project or package. The relative path cannot include a
+`..` (parent directory) component.
 
 ## `STACK_XDG`
 
@@ -94,7 +115,8 @@ YAML configuration file (`config.yaml`).
 
 Overridden by: the use of Stack's `STACK_ROOT` environment variable, or the use
-of Stack's global `--stack-root` option.
+of Stack's global
+[`--stack-root`](global_flags.md#-stack-root-option) option.
 
 On Unix-like operating systems and Windows, Stack can be configured to follow
 the XDG Base Directory Specification if the environment variable `STACK_XDG` is
@@ -105,7 +127,8 @@ Related command: all commands that make use of Stack's project-level YAML
 configuration file.
 
-Overridden by: Stack's global `--stack-yaml` option.
+Overridden by: Stack's global
+[`--stack-yaml`](global_flags.md#-stack-yaml-option) option.
 
 The environment variable `STACK_YAML` can be used to specify Stack's
 project-level YAML configuration file.
doc/faq.md view
@@ -9,7 +9,7 @@ ## What version of GHC is used when I run something like `stack ghci`?
 
 The version of GHC, as well as which packages can be installed, are specified by
-the _resolver_. This may be something like `lts-19.19`, which is from
+the _resolver_. This may be something like `lts-20.19`, which is from
 [Stackage](https://www.stackage.org/). The [user's guide](GUIDE.md) discusses
 the resolver in more detail.
 
@@ -76,11 +76,11 @@ value in your `stack.yaml` file, e.g.:
 
 ~~~yaml
-resolver: lts-19.19
+resolver: lts-20.19
 packages:
-- '.'
+- .
 extra-deps:
-- text-2.0.1
+- text-2.0.2
 ~~~
 
 ## I need to use a package (or version of a package) that is not available on Hackage, what should I do?
@@ -91,9 +91,9 @@ directory where your `stack.yaml` file lives, e.g.
 
 ~~~yaml
-resolver: lts-19.19
+resolver: lts-20.19
 packages:
-- '.'
+- .
 extra-deps:
 - third-party/proprietary-dep
 - github-version-of/conduit
doc/ghc_command.md view
@@ -15,4 +15,5 @@ Pass the option `--package <package>` to add the initial GHC argument
 `-package-id=<unit_id>`, where `<unit_id>` is the unit ID of the specified
 package in the installed package database. The option can be specified multiple
-times.
+times. The approach taken to these packages is the same as if they were
+specified as targets to [`stack build`](build_command.md#target-syntax).
doc/ghci.md view
@@ -29,6 +29,14 @@ `-XNoImplicitPrelude`, but it is likely that modules in the other component
 assume that the `Prelude` is implicitly imported.
 
+`stack ghci` configures GHCi by using a GHCi script file. Such files are located
+in subdirectories of `<XDG_CACHE_HOME>/stack/ghci-script`, where
+`<XDG_CACHE_HOME>` refers to the
+[XDG Base Directory Specification](https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html)
+for user-specific non-essential (cached) data. On Unix-like operating systems,
+the default for `<XDG_CACHE_HOME>` is `$HOME/.cache`. On Windows, the default
+is `%LOCALAPPDATA%`.
+
 ## Selecting Main module
 
 When loading multiple packages, there may be multiple definitions for the `Main`
doc/global_flags.md view
@@ -7,50 +7,50 @@ commands accept the `--setup-info-yaml` and `--snapshot-location-base` options
 and the `--help` flag.
 
-## The `--allow-different-user` flag
+## `--allow-different-user` flag
 
 Restrictions: POSIX systems only
 
 Default: True, if inside Docker; false otherwise
 
-Enable/disable permitting users other than the owner of the Stack root directory
-to use a Stack installation. For further information, see the documentation for
-the corresponding non-project specific configuration
-[option](yaml_configuration.md#allow-different-user).
+Enable/disable permitting users other than the owner of the
+[Stack root](stack_root.md) directory to use a Stack installation. For further
+information, see the documentation for the corresponding non-project specific
+configuration [option](yaml_configuration.md#allow-different-user).
 
-## The `--arch` option
+## `--arch` option
 
 Pass the option `--arch <architecture>` to specify the relevant machine
 architecture. For further information, see the documentation for the
 corresponding non-project specific configuration
 [option](yaml_configuration.md#arch).
 
-## The `--color` or `-colour` options
+## `--color` or `-colour` options
 
 Pass the option `stack --color <when>` to specify when to use color in output.
 For further information, see the documentation for the corresponding non-project
 specific configuration [option](yaml_configuration.md#color).
 
-## The `--compiler` option
+## `--compiler` option
 
 Pass the option `--compiler <compiler>` to specify the compiler. For further
 information, see the [YAML configuration](yaml_configuration.md#compiler)
 documentation.
 
-## The `--custom-preprocessor-extensions` option
+## `--custom-preprocessor-extensions` option
 
 Pass the option `--custom-preprocessor-extensions <extension>` to specify an
 extension used for a custom preprocessor. For further information, see the
 documentation for the corresponding non-project specific configuration
 [option](yaml_configuration.md#custom-preprocessor-extensions).
 
-## The `--docker*` flags and options
+## `--docker*` flags and options
 
 Stack supports automatically performing builds inside a Docker container. For
 further information see `stack --docker-help` or the
 [Docker integratiom](docker_integration.md) documentation.
 
-## The `--[no-]dump-logs` flag
+## `--[no-]dump-logs` flag
 
 Default: Dump warning logs
 
@@ -58,39 +58,39 @@ console. For further information, see the documentation for the corresponding
 non-project specific configuration [option](yaml_configuration.md#dump-logs).
 
-## The `--extra-include-dirs` option
+## `--extra-include-dirs` option
 
 Pass the option `--extra-include-dirs <director>` to specify an extra directory
 to check for C header files. The option can be specified multiple times. For
 further information, see the documentation for the corresponding non-project
 specific configuration [option](yaml_configuration.md#extra-include-dirs).
 
-## The `--extra-lib-dirs` option
+## `--extra-lib-dirs` option
 
 Pass the option `--extra-lib-dirs <director>` to specify an extra directory
 to check for libraries. The option can be specified multiple times. For further
 information, see the documentation for the corresponding non-project specific
 configuration [option](yaml_configuration.md#extra-lib-dirs).
 
-## The `--ghc-build` option
+## `--ghc-build` option
 
 Pass the option `--ghc-build <build>` to specify the relevant specialised GHC
 build. For further information, see the documentation for the corresponding
 non-project specific configuration [option](yaml_configuration.md#ghc-build).
 
-## The `--ghc-variant` option
+## `--ghc-variant` option
 
 Pass the option `--ghc-variant <variant>` to specify the relevant GHC variant.
 For further information, see the documentation for the corresponding non-project
 specific configuration [option](yaml_configuration.md#ghc-variant).
 
-## The `--hpack-numeric-version` flag
+## `--hpack-numeric-version` flag
 
 Pass the flag `--hpack-numeric-version` to cause Stack to report the numeric
 version of its built-in Hpack library to standard output (e.g. `0.35.0`) and
 quit.
 
-## The `--[no-]install-ghc` flag
+## `--[no-]install-ghc` flag
 
 Default: Enabled
 
@@ -98,30 +98,38 @@ information, see the documentation for the corresponding non-project specific
 configuration [option](yaml_configuration.md#install-ghc).
 
-## The `--jobs` or `-j` option
+## `--jobs` or `-j` option
 
 Pass the option `--jobs <number_of_jobs>` to specify the number of concurrent
 jobs to run. For further information, see the documentation for the
 corresponding non-project specific configuration
 [option](yaml_configuration.md#jobs).
 
-## The `--local-bin-path` option
+## `--local-bin-path` option
 
-Pass the option `--local-bin-path <directory>` to specify the directory in which
-Stack installs executables. For further information, see the documentation for
-the corresponding non-project specific configuration
-[option](yaml_configuration.md#local-bin-path).
+Pass the option `--local-bin-path <directory>` to set the target directory for
+[`stack build --copy-bins`](build_command.md#-no-copy-bins-flag) and
+`stack install`. An absolute or relative path can be specified. A relative path
+at the command line is always assumed to be relative to the current directory.
 
-## The `--lock-file` option
+For further information, see the documentation for the corresponding non-project
+specific configuration [option](yaml_configuration.md#local-bin-path).
 
+## `--lock-file` option
+
 Default: `read-write`, if snapshot specified in YAML configuration file;
 `read-only`, if a different snapshot is specified on the command line.
 
 Pass the option `--lock-file <mode>` to specify how Stack interacts with lock
-files. Valid modes are `error-on-write`, `ignore`, `read-only` and `read-write`.
+files. Valid modes are:
 
-## The `--[no-]modify-code-page` flag
+* `error-on-write`: Stack reports an error, rather than write a lock file;
+* `ignore`: Stack ignores lock files;
+* `read-only`: Stack only reads lock files; and
+* `read-write`: Stack reads and writes lock files.
 
+## `--[no-]modify-code-page` flag
+
 Restrictions: Windows systems only
 
 Default: Enabled
@@ -130,24 +138,32 @@ see the documentation for the corresponding non-project specific configuration
 [option](yaml_configuration.md#modify-code-page).
 
-## The `--nix*` flags and options
+## `--nix*` flags and options
 
 Stack can be configured to integrate with Nix. For further information, see
 `stack --nix-help` or the [Nix integration](nix_integration.md) documentation.
 
-## The `--numeric-version` flag
+## `--numeric-version` flag
 
 Pass the flag `--numeric-version` to cause Stack to report its numeric version
 to standard output (e.g. `2.9.1`) and quit.
 
-## The `--resolver` option
+## `--resolver` option
 
 Pass the option `--resolver <snapshot>` to specify the snapshot. For further
 information, see the
 [YAML configuration](yaml_configuration.md#resolver-or-snapshot) documentation.
 
-## The `--[no-]rsl-in-log` flag
+At the command line (only):
 
+*   `--resolver lts-<major_version>` specifies the latest Stackage LTS Haskell
+    snapshot with the specified major version;
+*   `--resolver lts` specifies, from those with the greatest major version, the
+    latest Stackage LTS Haskell snapshot; and
+*   `--resolver nightly` specifies the most recent Stackage Nightly snapshot.
+
+## `--[no-]rsl-in-log` flag
+
 [:octicons-tag-24: 2.9.1](https://github.com/commercialhaskell/stack/releases/tag/v2.9.1)
 
 Default: Disabled
@@ -156,18 +172,18 @@ Information about the raw snapshot layer can be lengthy. If you do not need it,
 it is best omitted from the debug output.
 
-## The `--[no-]script-no-run-compile` flag
+## `--[no-]script-no-run-compile` flag
 
 Default: Disabled
 
 Enables/disables the use of options `--no-run --compile` with the
 [`stack script` command](script_command.md).
 
-## The `--silent` flag
+## `--silent` flag
 
 Equivalent to the `--verbosity silent` option.
 
-## The `--[no-]skip-ghc-check` option
+## `--[no-]skip-ghc-check` option
 
 Default: Disabled
 
@@ -175,7 +191,7 @@ further information, see the documentation for the corresponding non-project
 specific configuration [option](yaml_configuration.md#skip-ghc-check).
 
-## The `--[no-]skip-msys` option
+## `--[no-]skip-msys` option
 
 Restrictions: Windows systems only
 
@@ -185,20 +201,21 @@ the documentation for the corresponding non-project specific configuration
 [option](yaml_configuration.md#skip-msys).
 
-## The `--stack-colors` or `--stack-colours` options
+## `--stack-colors` or `--stack-colours` options
 
 Pass the option `--stack-colors <styles>` to specify Stack's output styles. For
 further information, see the documentation for the corresponding non-project
 specific configuration [option](yaml_configuration.md#stack-colors).
 
-## The `--stack-root` option
+## `--stack-root` option
 
 Overrides: `STACK_ROOT` environment variable
 
 Pass the option `--stack-root <absolute_path_to_the_Stack_root>` to specify the
-path to the Stack root directory. The path must be an absolute one.
+path to the [Stack root](stack_root.md) directory. The path must be an absolute
+one.
 
-## The `--stack-yaml` option
+## `--stack-yaml` option
 
 Default: `stack.yaml`
 
@@ -207,38 +224,38 @@ Pass the option `--stack-yaml <file>` to specify Stack's project-level YAML
 configuration file.
 
-## The `--[no-]system-ghc` flag
+## `--[no-]system-ghc` flag
 
 Default: Disabled
 
 Enables/disables the use of a GHC executable on the PATH, if one is available
 and its version matches.
 
-## The `--[no-]terminal` flag
+## `--[no-]terminal` flag
 
 Default: Stack is running in a terminal (as detected)
 
 Enables/disables whether Stack is running in a terminal.
 
-## The `--terminal-width` option
+## `--terminal-width` option
 
 Default: the terminal width (if detected); otherwise `100`
 
 Pass the option `--terminal-width <width>` to specify the width of the terminal,
 used by Stack's pretty printed messages.
 
-## The `--[no-]time-in-logs` flag
+## `--[no-]time-in-logs` flag
 
 Default: Enabled
 
 Enables/disables the inclusion of time stamps against logging entries when the
 verbosity level is 'debug'.
 
-## The `--verbose` or `-v` flags
+## `--verbose` or `-v` flags
 
 Equivalent to the `--verbosity debug` option.
 
-## The `--verbosity` option
+## `--verbosity` option
 
 Default: `info`
 
@@ -246,51 +263,53 @@ Possible levels are `silent`, `error`, `warn`, `info` and `debug`, in order of
 increasing amounts of information provided by logging.
 
-## The `--version` flag
+## `--version` flag
 
 Pass the flag `--version` to cause Stack to report its version to standard
 output and quit. For versions that are release candidates, the report will list
 the dependencies that Stack has been compiled with.
 
-## The `--with-gcc` option
+## `--with-gcc` option
 
 Pass the option `--with-gcc <path_to_gcc>` to specify use of a GCC executable.
 For further information, see the documentation for the corresponding non-project
 specific configuration [option](yaml_configuration.md#with-gcc).
 
-## The `--with-hpack` option
+## `--with-hpack` option
 
 Pass the option `--with-hpack <hpack>` to specify use of an Hpack executable.
 For further information, see the documentation for the corresponding
 non-project specific configuration [option](yaml_configuration.md#with-hpack).
 
-## The `--work-dir` option
+## `--work-dir` option
 
 Default: `.stack-work`
 
-Overrides: `STACK_WORK` environment variable
+Overrides: [`STACK_WORK`](environment_variables.md#stack_work) environment
+variable, and [`work-dir`](yaml_configuration.md) non-project specific
+configuration option.
 
 Pass the option `--work-dir <relative_path_to_the_Stack_root>` to specify the
-path to Stack's work directory for the project. The path must be a relative one,
-relative to the project's root directory. For further information, see the
-documentation for the corresponding non-project specific configuration
-[option](yaml_configuration.md#work-dir).
+path to Stack's work directory, within a local project or package directory. The
+path must be a relative one, relative to the the root directory of the project
+or package. The relative path cannot include a `..` (parent directory)
+component.
 
-## The `--setup-info-yaml` command option
+## `--setup-info-yaml` command option
 
 Default: `https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml`
 
 The `--setup-info-yaml <url>` command option specifies the location of a
 `setup-info` dictionary. The option can be specified multiple times.
 
-## The `--snapshot-location-base` command option
+## `--snapshot-location-base` command option
 
 Default: `https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master`
 
 The `--snapshot-location-base <url>` command option specifies the base location
 of snapshots.
 
-## The `--help` command flag
+## `--help` command flag
 
 If Stack is passed the `--help` command flag, it will output help for the
 command.
doc/glossary.md view
@@ -18,6 +18,7 @@ |FreeBSD            |A Unix-like operating system.                             |
 |GCC                |The [GNU Compiler Collection](https://gcc.gnu.org/) or its executable `gcc`.|
 |GHC                |The [Glasgow Haskell Compiler](https://www.haskell.org/ghc/).|
+|GHC boot package   |A package that comes with GHC, is included in GHC's global package database, and is not included in a Stackage snapshot. See the output of command `stack exec -- ghc-pkg list --global`.|
 |GHCi               |GHC's [interactive environment](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html).|
 |GHCJS              |A Haskell to JavaScript [compiler](https://github.com/ghcjs/ghcjs).|
 |GHCup              |An [installer](https://www.haskell.org/ghcup/) for Haskell.
@@ -47,6 +48,7 @@ |`stack.yaml`       |A project-level configuration file used by Stack, which may also contain non-project-specific options.|
 |Stackage           |A [distribution](https://www.stackage.org/) of compatible Haskell packages.|
 |Stack root         |A directory in which Stack stores important files. See `stack path --stack-root`. On Windows, or if Stack is configured to use the XDG Base Directory Specification, Stack also stores important files outside of the Stack root.|
+|Stack work directory|A directory within a local project or package directory in which Stack stores files created during the build process. Named `.stack-work`, by default.|
 |Unix-like operating systems|Linux, FreeBSD and macOS.                         |
 |VS Code            |[Visual Studio Code](https://code.visualstudio.com/), a source code editor.|
 |Windows            |A group of operating systems developed by Microsoft.      |
doc/init_command.md view
@@ -10,14 +10,17 @@ (`stack.yaml`) for an existing project, based on the Cabal file or
 `package.yaml` file for each of its packages.
 
-Stack searches for Cabal and `package.yaml` files in the current directory,
-unless one or more directories are specified as arguments.
+By default:
 
-Stack also searches for Cabal and `package.yaml` files in subdirectories, unless
-the `--ignore-subdirs` flag is passed.
+* Stack searches for Cabal and `package.yaml` files in the current directory.
+  Specify one or more directories as arguments to cause Stack to search them;
 
-Stack will not overwrite an existing `stack.yaml` file, unless the `--force`
-flag is passed.
+* Stack also searches for Cabal and `package.yaml` files in subdirectories. Pass
+  the flag `--ignore-subdirs` to ignore subdirectories;
 
-Pass the `--ignore-subdirs` flag to cause Stack to ignore conflicting or
-incompatible user packages while initialising.
+* Stack will not overwrite an existing `stack.yaml` file. Pass the flag
+  `--force` to allow overwriting; and
+
+* Stack will not initialise if there are conflicting or incompatable user
+  packages. Pass the flag `--omit-packages` to cause Stack to ignore such
+  matters while initialising.
doc/install_and_upgrade.md view
@@ -37,8 +37,8 @@ 
 === "Linux"
 
-    For most Linux distributions, the easiest way to install Stack is to
-    command:
+    For most Linux distributions, the easiest way to install Stack directly
+    (rather than use GHCup) is to command:
 
     ~~~text
     curl -sSL https://get.haskellstack.org/ | sh
@@ -207,24 +207,24 @@         There is also an unofficial package for openSUSE or SUSE Linux
         Enterprise. Its Stack version may lag behind. To install it:
 
-        === openSUSE Tumbleweed
+        === "openSUSE Tumbleweed"
 
             ~~~text
             sudo zypper in stack
             ~~~
 
-        === openSUSE Leap
+        === "openSUSE Leap"
 
             ~~~text
             sudo zypper ar http://download.opensuse.org/repositories/devel:/languages:/haskell/openSUSE_Leap_42.1/devel:languages:haskell.repo
             sudo zypper in stack
             ~~~
 
-        === SUSE Linux Enterprise 12
+        === "SUSE Linux Enterprise 12"
 
             ~~~text
             sudo zypper ar http://download.opensuse.org/repositories/devel:/languages:/haskell/SLE_12/devel:languages:haskell.repo
-            sude zypper in stack
+            sudo zypper in stack
             ~~~
 
     === "Ubuntu"
@@ -240,44 +240,122 @@ 
 === "macOS"
 
-    The easiest way to install Stack is to command:
+    From late 2020, Apple began a transition from Mac computers with Intel
+    processors (Intel-based Mac) to
+    [Mac computers with Apple silicon](https://support.apple.com/en-gb/HT211814).
 
-    ~~~text
-    curl -sSL https://get.haskellstack.org/ | sh
-    ~~~
+    === "Intel-based"
 
-    or:
+        Intel-based Mac computers have processors with x86_64 architectures. For
+        most Intel-based Mac computers, the easiest way to install Stack
+        directly (rather than use GHCup) is to command:
 
-    ~~~text
-    wget -qO- https://get.haskellstack.org/ | sh
-    ~~~
+        ~~~text
+        curl -sSL https://get.haskellstack.org/ | sh
+        ~~~
 
-    !!! note
+        or:
 
-        The script at [get.haskellstack.org](https://get.haskellstack.org/) will
-        ask for root access using `sudo`. It needs such access in order to use
-        your platform's package manager to install dependencies and to install
-        to `/usr/local/bin`. If you prefer more control, follow the manual
-        installation instructions below.
+        ~~~text
+        wget -qO- https://get.haskellstack.org/ | sh
+        ~~~
 
-    !!! info
+        !!! note
 
-        We generally test on the current version of macOS and do our best to
-        keep it compatible with the three most recent major versions. Stack may
-        also work on older versions.
+            The script at [get.haskellstack.org](https://get.haskellstack.org/)
+            will ask for root access using `sudo`. It needs such access in order
+            to use your platform's package manager to install dependencies and
+            to install to `/usr/local/bin`. If you prefer more control, follow
+            the manual installation instructions below.
 
-    ### Manual download
+        !!! info
 
-    * Click
-      [:material-cloud-download-outline:](https://get.haskellstack.org/stable/osx-x86_64.tar.gz)
-      to download an archive file with the latest release for x86_64
-      architectures.
+            We generally test on the current version of macOS and do our best to
+            keep it compatible with the three most recent major versions. Stack
+            may also work on older versions.
 
-    * Extract the archive and place `stack` somewhere on your PATH (see the
-      [Path](#path) section below).
+        ### Manual download
 
-    * Now you can run Stack from the command line in a terminal.
+        * Click
+          [:material-cloud-download-outline:](https://get.haskellstack.org/stable/osx-x86_64.tar.gz)
+          to download an archive file with the latest release for x86_64
+          architectures.
 
+        * Extract the archive and place `stack` somewhere on your PATH (see the
+          [Path](#path) section below).
+
+        * Now you can run Stack from the command line in a terminal.
+
+    === "Apple silicon"
+
+        Mac computers with Apple silicon have an M1, M1 Pro, M1 Max, M1 Ultra or
+        M2 chip. These chips use an architecture known as ARM64 or AArch64.
+
+        The Stack repository uses GitHub-hosted runners to create binary
+        distributions for macOS. GitHub-hosted runners are not expected to be
+        available for macOS on Apple silicon until July to September 2023.
+
+        Consequently, for Mac computers with Apple silicon, the easiest way to
+        install Stack directly (rather than use GHCup) is to obtain the
+        'unofficial' `osx-aarch64` binary distribution released by the GHCup
+        developers and copy it to a location on the PATH. `*.tar.gz` archive
+        files containing those binary distributions are available at the
+        directories here:
+        [:material-cloud-download-outline:](https://downloads.haskell.org/ghcup/unofficial-bindists/stack/).
+
+        It is still possible to use the commands:
+
+        ~~~text
+        curl -sSL https://get.haskellstack.org/ | sh
+        ~~~
+
+        or:
+
+        ~~~text
+        wget -qO- https://get.haskellstack.org/ | sh
+        ~~~
+
+        However, those commands will download and install the version of Stack
+        for Intel-based Mac computers. Mac computers with Apple silicon will
+        use Apple's
+        [Rosetta 2 application](https://support.apple.com/en-gb/HT211861) to
+        use that version of Stack.
+
+        Apple's Terminal application will not detect automatically that Rosetta
+        has not yet been installed. Rosetta can be manually installed by
+        commanding:
+
+        ~~~text
+        softwareupdate --install-rosetta
+        ~~~
+
+        The installation of Stack or some packages (e.g. `network`) requiring C
+        source compilation might fail with `configure: error: C compiler cannot
+        build executables`. In that case you should pass `-arch arm64` as part
+        of the `CFLAGS` environment variable. This setting will be picked up by
+        the C compiler of your choice.
+
+        ~~~bash
+        # Assuming BASH below
+
+        # passing CFLAGS in-line with the command giving rise to the error
+        CFLAGS="-arch arm64 ${CFLAGS:-}" some_command_to_install_stack
+        CFLAGS="-arch arm64 ${CFLAGS:-}" stack [build|install]
+
+        # -- OR --
+
+        # ~/.bash_profile
+        # NOTE: only do this if you do not have to cross-compile, or remember to unset
+        # CFLAGS when needed
+        export CFLAGS="-arch arm64 ${CFLAGS:-}"
+        ~~~
+
+        The setting instructs the C compiler to compile objects for ARM64. These
+        can then be linked with libraries built for ARM64. Without the
+        instruction, the C compiler, invoked by Cabal running in x86-64, would
+        compile x86-64 objects and attempt to link them with existing ARM64
+        libraries, resulting in the error above.
+
     ### Using Homebrew
 
     [Homebrew](https://brew.sh/) is a popular package manager for macOS. If you
@@ -320,35 +398,8 @@     * [GHC 7.8.4 fails with `/usr/bin/ar: permission denied`](faq.md#usr-bin-ar-permission-denied)
     * [DYLD_LIBRARY_PATH is ignored](faq.md#dyld-library-path-ignored)
 
-    If you are on macOS 10.12 (Sierra) and encounter GHC panic while building, see
-    this [issue](https://github.com/commercialhaskell/stack/issues/2577)
-
-    On Apple silicon chip (AArch64/ARM64) architectures, the installation of
-    Stack or some packages (e.g. `network`) requiring C source compilation might
-    fail with `configure: error: C compiler cannot build executables`. In that
-    case you should pass `-arch arm64` as part of the `CFLAGS` environment
-    variable. This setting will be picked up by the C compiler of your choice.
-
-    ~~~bash
-    # Assuming BASH below
-
-    # passing CFLAGS in-line with the command giving rise to the error
-    CFLAGS="-arch arm64 ${CFLAGS:-}" some_command_to_install_stack
-    CFLAGS="-arch arm64 ${CFLAGS:-}" stack [build|install]
-
-    # -- OR --
-
-    # ~/.bash_profile
-    # NOTE: only do this if you do not have to cross-compile, or remember to unset
-    # CFLAGS when needed
-    export CFLAGS="-arch arm64 ${CFLAGS:-}"
-    ~~~
-
-    The setting instructs the C compiler to compile objects for ARM64. These can
-    then be linked with libraries built for ARM64. Without the instruction, the C
-    compiler, invoked by Cabal running in x86-64, would compile x86-64 objects and
-    attempt to link them with existing ARM64 libraries, resulting in the error
-    above.
+    If you are on macOS 10.12 (Sierra) and encounter GHC panic while building,
+    see this [issue](https://github.com/commercialhaskell/stack/issues/2577).
 
     It is possible to set up auto-completion of Stack commands. For further
     information, see the [shell auto-completion](shell_autocompletion.md)
@@ -356,7 +407,8 @@ 
 === "Windows"
 
-    On 64-bit Windows, you can download and install the
+    On 64-bit Windows, the easiest way to install Stack directly (rather than
+    use GHCup) is to download and use the
     [Windows installer](https://get.haskellstack.org/stable/windows-x86_64-installer.exe).
 
     !!! note "Anti-virus software"
doc/list_command.md view
@@ -13,7 +13,7 @@ package index, suggestions (not necessarily good ones) will be made about the
 intended package name.
 
-`stack --resolver <snapshot> <package_name>` will list the version of the
+`stack --resolver <snapshot> list <package_name>` will list the version of the
 package in the specified snapshot, unless the package comes with GHC on
 Unix-like operating systems. If the package name cannot be found in the
 snapshot, the command will fail, identifying only the package(s) that did not
@@ -21,35 +21,37 @@ 
 More than one package name can be specified.
 
-`stack --resolver <snapshot>` will list all the packages in the specified
+`stack --resolver <snapshot> list` will list all the packages in the specified
 snapshot, except those which come with GHC on Unix-like operating systems.
 
 For example:
 
 ~~~text
 stack list base unix Win32 acme-missiles pantry
-base-4.17.0.0
-unix-2.8.0.0
-Win32-2.13.3.0
+base-4.18.0.0
+unix-2.8.1.1
+Win32-2.13.4.0
 acme-missiles-0.3
-pantry-0.5.7
+pantry-0.8.1
 
 stack list paltry
 Could not find package paltry, updating
 ...
 Package index cache populated
-- Could not find package paltry on Hackage. Perhaps you meant: pretty, pasty, xattr, alloy, para, pappy, alure, polar, factory, pastis
+Error: [S-4926]
+- Could not find package paltry on Hackage. Perhaps you meant: retry, path, pantry, pretty, pasty, xattr, alloy, para, pappy, alure
 
-stack --resolver lts-19.25 base unix Win32 acme-missiles pantry
+stack --resolver lts-20.19 list base unix Win32 acme-missiles pantry
+Error: [S-4926]
 - Package does not appear in snapshot: base
 - Package does not appear in snapshot: unix
 - Package does not appear in snapshot: acme-missiles
 
-stack --resolver lts-19.25 Win32 pantry
+stack --resolver lts-20.19 list Win32 pantry
 Win32-2.12.0.1
 pantry-0.5.7
 
-stack --resolver lts-19.25
+stack --resolver lts-20.19 list
 AC-Angle-1.0
 ALUT-2.4.0.3
 ...
doc/lock_files.md view
@@ -145,30 +145,40 @@       sha256: 614bc0cca76937507ea0a5ccc17a504c997ce458d7f2f9e43b15a10c8eaeb033
 ~~~
 
-## Creation
+## Creation procedure
 
 Whenever a project-level configuration file (`stack.yaml`) is loaded, Stack
 checks for a lock file in the same file path, with a `.lock` extension added.
 For example, if you command:
 
 ~~~text
-stack build --stack-yaml my-stack.yaml
+stack --stack-yaml my-stack.yaml build
 ~~~
 
-Stack will use a lock file in the location `my-stack.yaml.lock`. For the rest of
-this document, we'll assume that the files are simply `stack.yaml` and
+or
+
+~~~text
+stack --stack-yaml my-stack.yaml build --dry-run
+~~~
+
+then Stack will use a lock file in the location `my-stack.yaml.lock`. For the
+rest of this document, we'll assume that the files are simply `stack.yaml` and
 `stack.yaml.lock`.
 
-If the lock file does not exist, it will be created by:
+If the lock file does not exist, subject to Stack's
+[`--lock-file`](global_flags.md#-lock-file-option) option, it will be
+created by:
 
 * Loading the `stack.yaml`
 * Loading all snapshot files
 * Completing all missing information
-* Writing out the new `stack.yaml.lock` file
+* Writing out the new `stack.yaml.lock` file to the disk
 
 ## Update procedure
 
-When loading a Stack project all completed package or snapshot locations (even
-when they were completed using information from a lock file) get collected to
-form a new lock file in memory and compare against the one on disk, writing if
-there are any differences.
+Whenever a project-level configuration file (`stack.yaml`) is loaded, all
+completed package or snapshot locations (even those completed using information
+from a lock file) get collected to form a new lock file in memory. Subject to
+Stack's [`--lock-file`](global_flags.md#-lock-file-option) option, that new lock
+file is compared against the one on disk and, if there are any differences,
+written out to the disk.
doc/new_command.md view
@@ -7,17 +7,87 @@           [--omit-packages] [--force] [--ignore-subdirs]
 ~~~
 
-`stack new` creates a new Stack project for a package using a template.
+`stack new` creates a new Stack project for a package using a project template.
 
 The project is created in a new directory named after the package, unless the
 `--bare` flag is passed, in which case the project is created in the current
 directory.
 
-The template used is a default one (named `new-template`), unless another
-template is specified as an argument.
-
 The `--param <key>:<value>` option specifies a key-value pair to populate a key
 in a template. The option can be specified multiple times.
 
 The arguments specifying directories and the `--ignore-subdirs`, `--force` and
 `--omit-packages` flags are as for the [`stack init` command](init_command.md).
+
+## Project templates
+
+A project template file can be located in a repository named `stack-templates`
+on GitHub, GitLab or Bitbucket; at a URL; or on the local file system.
+
+Project template file names have the extension `.hsfiles`. The extension does
+not need to be specified with `stack new`.
+
+A project template file `my-template.hsfiles` in a repository
+`username/stack-templates` on GitHub, GitLab or Bitbucket can be specified
+with `stack new` as:
+
+~~~test
+<service>:username/my-template
+~~~
+
+where `<service>` is one of `github` for [GitHub](https://github.com/),
+`gitlab` for [GitLab](https://gitlab.com), or `bitbucket` for
+[Bitbucket](https://bitbucket.com).
+
+The default service is GitHub, the default username is `commercialhaskell` and
+the default project template name is `new-template`.
+
+## Examples
+
+Create a project for package `my-project` in new directory `my-project` with the
+default project template file:
+
+~~~text
+stack new my-project
+~~~
+
+Create a project for package `my-package` in the current directory with the
+default project template file:
+
+~~~text
+stack new my-package --bare
+~~~
+
+Create a project with the `rio` project template at the default repository:
+
+~~~text
+stack new my-project rio
+~~~
+
+Create a project with the `mysql` project template provided by the
+`yesodweb/stack-templates` repository on GitHub:
+
+~~~text
+stack new my-project yesodweb/mysql
+~~~
+
+Create a project with the `my-template` project template provided by the
+`username/stack-templates` repository on Bitbucket:
+
+~~~text
+stack new my-project bitbucket:username/my-template
+~~~
+
+Create a project with the `my-template.hsfiles` project template file at
+`https://example.com`:
+
+~~~text
+stack new my-project https://example.com/my-template
+~~~
+
+Create a project with the local project template file
+`<path_to_template>/my-template.hsfiles`:
+
+~~~text
+stack new my-project <path_to_template_file>/my-template
+~~~
doc/nix_integration.md view
@@ -5,7 +5,16 @@ [:octicons-tag-24: 0.1.10.0](https://github.com/commercialhaskell/stack/releases/tag/v0.1.10.0)
 
 [Nix](https://nixos.org/) is a purely functional package manager. Stack can be
-configured to integrate with Nix.
+configured to integrate with Nix. Integration provides these benefits:
+
+* more reproducible builds. This is because fixed versions of any system
+  libraries and commands required to build the project are automatically built
+  using Nix and managed locally for each project. These system packages never
+  conflict with any existing versions of these libraries on your system. That
+  they are managed locally to the project means that you don't need to alter
+  your system in any way to build any odd project pulled from the Internet; and
+* implicit sharing of system packages between projects. This means you don't
+  have more copies on-disk than you need.
 
 The Nix package manager is a pre-requisite for integration. On Linux (including
 Windows Subsystem for Linux) and macOS, it can be downloaded and installed from
doc/pantry.md view
@@ -90,7 +90,7 @@ 
 1.  Hackage packages
 2.  Git and Mecurial repositories
-3.  Local or remote archives
+3.  Local or remote archives (such as GitHub archives)
 
 All three types support optional tree metadata to be added, which can be used
 for reproducibility and faster downloads. This information can automatically be
@@ -98,49 +98,47 @@ 
 ### Hackage packages
 
-Packages can be stated by a name-version combination. The basic syntax for this
-is:
+A package can be identified by its name, version and Cabal file revision
+number, with revision `0` being the original Cabal file. For example:
 
 ~~~yaml
 extra-deps:
-- acme-missiles-0.3
+- acme-missiles-0.3@rev:0
 ~~~
 
-Using this syntax, the most recent Cabal file revision available will
-be used.
-
-You can specify a specific revision number, with `0` being the original file,
-like this:
+A package name and version only can be stated. Using this syntax, the most
+recent Cabal file revision available in the package index will be used. For
+example:
 
 ~~~yaml
 extra-deps:
-- acme-missiles-0.3@rev:0
+- acme-missiles-0.3
 ~~~
 
-For safer, more reproducible builds, you can optionally specify the SHA256 hash
-of the Cabal file's contents, like this:
+This syntax is often used in practice, but may result in one build differing
+from another, if a new or further Cabal file revision is added to the package
+index between the builds.
 
+As an alternative to specifying the Cabal file revision number, you can specify
+the package name and version with the SHA256 hash of the contents of its Cabal
+file. Doing so is slightly more resilient than using the Cabal file revision
+number, as it does not rely on the correct ordering in the package index.
+For example:
+
 ~~~yaml
 extra-deps:
 - acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1
 ~~~
 
-You can optionally also specify the size of the Cabal file in bytes, like this:
+Optionally, you can specify also the size of the Cabal file in bytes. For
+example (where the file size is `631` bytes):
 
 ~~~yaml
 extra-deps:
 - acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1,631
 ~~~
 
-!!! note
-
-    Specifying package using SHA256 is slightly more resilient in that it does
-    not rely on correct ordering in the package index, while revision number is
-    likely simpler to use. In practice, both should guarantee equally
-    reproducible build plans.
-
-You can also include the Pantry tree information. The following would be
-generated and stored in the lock file:
+Optionally, you can specify also the Pantry tree information. For example:
 
 ~~~yaml
 - hackage: acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1,613
@@ -149,10 +147,20 @@     sha256: 614bc0cca76937507ea0a5ccc17a504c997ce458d7f2f9e43b15a10c8eaeb033
 ~~~
 
+A Pantry tree is a list of CAS (content-addressable storage)
+'SHA256 hash'-'size in bytes' keys for each of the files in a package.
+
+The SHA256 hash of the contents of the Cabal file and its size in bytes is
+provided in Stack's lock file. For further information, see the
+[lock files](lock_files.md) documentation. The SHA256 hash and file size
+alternative is also what Stack uses when it makes suggestions about missing
+packages.
+
 ### Git and Mercurial repositories
 
-You can give a Git or Mercurial repository at a specific commit, and Stack will
-clone that repository. For example:
+You can specify a Git or Mercurial repository at a specific commit, and Stack
+will clone that repository and, if it has submodules (Git), update the
+repository's submodules. For example:
 
 ~~~yaml
 extra-deps:
@@ -193,19 +201,6 @@ _not_ included by default and needs to be explicitly specified if a required
 package is found in the top-level directory of the repository.
 
-#### GitHub
-
-[:octicons-tag-24: 1.7.1](https://github.com/commercialhaskell/stack/releases/tag/v1.7.1)
-
-You can specify packages from GitHub repository name using `github`. For
-example:
-
-~~~yaml
-extra-deps:
-- github: snoyberg/http-client
-  commit: a5f4f30f01366738f913968163d856366d7e0342
-~~~
-
 #### git-annex
 
 [git-annex](https://git-annex.branchable.com) is not supported. This is because
@@ -225,8 +220,10 @@ fonts export-ignore
 ~~~
 
-### Local or remote archives
+### Local or remote archives (such as GitHub archives)
 
+#### Filepaths or URLs to archive files
+
 You can use filepaths referring to local archive files or HTTP or HTTPS URLs
 referring to remote archive files, either tarballs or ZIP files.
 
@@ -250,3 +247,27 @@ - archive: ../acme-missiles-0.3.tar.gz
   sha256: e563d8b524017a06b32768c4db8eff1f822f3fb22a90320b7e414402647b735b
 ~~~
+
+#### GitHub archive files
+
+[:octicons-tag-24: 1.7.1](https://github.com/commercialhaskell/stack/releases/tag/v1.7.1)
+
+You can specify a GitHub respository at a specific commit and Stack will obtain
+from GitHub an archive file of the files in the repository at that point in its
+history. For example:
+
+~~~yaml
+extra-deps:
+- github: snoyberg/http-client
+  commit: a5f4f30f01366738f913968163d856366d7e0342
+~~~
+
+!!! note
+
+    An archive file of the files in a GitHub repository at a point in its
+    history is not the same as a clone of the repository (including its history)
+    and the updating of any submodules. If you need the latter, use the syntax
+    for a [Git repository](pantry.md#git-and-mercurial-repositories).
+
+    If the package fails to build due to missing files, it may be that updated
+    submodules are required.
doc/path_command.md view
@@ -10,7 +10,6 @@            [--global-pkg-db] [--ghc-package-path] [--snapshot-install-root]
            [--local-install-root] [--snapshot-doc-root] [--local-doc-root]
            [--local-hoogle-root] [--dist-dir] [--local-hpc-root]
-           [--local-bin-path] [--ghc-paths] [--global-stack-root]
 ~~~
 
 `stack path` provides information about files and locations used by Stack.
@@ -28,12 +27,9 @@ |--extra-include-dirs   |Extra include directories.                            |
 |--extra-library-dirs   |Extra library directories.                            |
 |--ghc-package-path     |The `GHC_PACKAGE_PATH` environment variable.          |
-|--ghc-paths            |Deprecated.                                           |
 |--global-config        |Stack's user-specific global YAML configuration file (`config.yaml`).|
 |--global-pkg-db        |The global package database.                          |
-|--global-stack-root    |Deprecated.                                           |
 |--local-bin            |The directory in which Stack installs executables.    |
-|--local-bin-path       |Deprecated.                                           |
 |--local-doc-root       |The root directory for local project documentation.   |
 |--local-hoogle-root    |The root directory for local project documentation.   |
 |--local-hpc-root       |The root directory for .tix files and HPC reports.    |
doc/query_command.md view
@@ -2,6 +2,8 @@ 
 # The `stack query` command
 
+:octicons-beaker-24: Experimental
+
 [:octicons-tag-24: 0.1.6.0](https://github.com/commercialhaskell/stack/releases/tag/v0.1.6.0)
 
 ~~~text
doc/run_command.md view
@@ -17,19 +17,21 @@ argument to be passed to what is run, other than a first argument recognised as
 an executable target.
 
-By default, the `GHC_PACKAGE_PATH` environment variable is set for the
-subprocess. Pass the `--no-ghc-package-path` flag to not set the variable.
+By default:
 
-By default, the `STACK_EXE` environment variable is set with the path to Stack.
-Pass the `--no-stack-exe` flag to not set the variable.
+*   the `GHC_PACKAGE_PATH` environment variable is set for the subprocess. Pass
+    the `--no-ghc-package-path` flag to not set the variable; and
 
+*   the `STACK_EXE` environment variable is set with the path to Stack. Pass the
+    `--no-stack-exe` flag to not set the variable.
+
 The `--cwd` option can be used to set the working directory before the
 executable is run.
 
+The `--package` option (which can be specified multiple times) can be used to
+add a package name to build targets.
+
 The `--rts-options` option (which can be specified multiple times) can be used
 to pass a list of GHC's
 [runtime system (RTS) options](https://downloads.haskell.org/~ghc/latest/docs/users_guide/runtime_control.html#)
 to the executable when it is run. (The `+RTS` and `-RTS` must not be included.)
-
-The `--package` option (which can be specified multiple times) can be used to
-add a package name to build targets.
doc/runghc_command.md view
@@ -16,4 +16,5 @@ Pass the option `--package <package>` to add the initial GHC argument
 `-package-id=<unit_id>`, where `<unit_id>` is the unit ID of the specified
 package in the installed package database. The option can be specified multiple
-times.
+times. The approach taken to these packages is the same as if they were
+specified as targets to [`stack build`](build_command.md#target-syntax).
doc/script_command.md view
@@ -5,28 +5,31 @@ ~~~text
 stack script [--package PACKAGE] FILE
              [-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to program)]
-             [--compile | --optimize] [--ghc-options OPTIONS]
+             [--compile | --optimize] [--[no-]use-root] [--ghc-options OPTIONS]
              [--extra-dep PACKAGE-VERSION] [--no-run]
 ~~~
 
-The `stack script` command also either runs a specified Haskell source file
-(using GHC's `runghc`) or, optionally, compiles a specified Haskell source file
-(using GHC) and, by default, runs it.
+The `stack script` command either runs a specified Haskell source file (using
+GHC's `runghc`) or, optionally, compiles such a file (using GHC) and, by
+default, runs it.
 
-However, unlike `stack ghc` and `stack runghc`, the command ignores all Stack
-YAML configuration files. A snapshot must be specified on the command line (with
-the `--resolver` option). For example:
+Unlike `stack ghc` and `stack runghc`, the command ignores all Stack YAML
+configuration files (global and project-level). A snapshot must be specified on
+the command line (with the `--resolver` option). For example:
 
 ~~~text
-stack --resolver lts-19.28 MyScript.hs
+stack --resolver lts-20.19 MyScript.hs
 ~~~
 
 or, equivalently:
 
 ~~~text
-stack script --resolver lts-19.28 MyScript.hs
+stack script --resolver lts-20.19 MyScript.hs
 ~~~
 
+The `stack script` command behaves as if the `--install-ghc` flag had been
+passed at the command line.
+
 Everything after `--` on the command line is interpreted as a command line
 argument to be passed to what is run.
 
@@ -47,10 +50,20 @@ file is compiled, passing the `--no-run` flag will mean the compiled code is not
 run.
 
+By default, all the compilation outputs (including the executable) are written
+to the directory of the source file. Pass the `--use-root` flag to write such
+outputs to a script-specific location in the `scripts` directory of the Stack
+root. The location reflects the absolute path to the source file, but ignoring
+the drive. This can avoid clutter in the source file directory.
+
 Additional options can be passed to GHC using the `--ghc-options` option.
 
-For example, `MyScript.hs`:
+## Examples
 
+For example, Haskell source file `MyScript.hs` at location
+`<drive>Users/jane/my-project` (where `<drive>` could be `/` on Unix-like
+operating systems or `C:/` or similar on Windows):
+
 ~~~haskell
 module Main (main) where
 
@@ -69,5 +82,12 @@ can be compiled and run, with arguments, with:
 
 ~~~text
-stack --resolver lts-19.28 script --package acme-missiles --compile MyScript.hs -- "Don't panic!" "Duck and cover!"
+stack --resolver lts-20.19 script --package acme-missiles --compile MyScript.hs -- "Don't panic!" "Duck and cover!"
 ~~~
+
+All the compilation outputs (like `Main.hi`, `Main.o`, and the executable
+`MyScript`) will be written to the `my-project` directory.
+
+If compiled and run with the additional flag `--use-root`, all the compilation
+outputs will be written to a directory named `MyScript.hs` at
+`Users/jane/my-project/` in the `scripts` directory of the Stack root.
doc/scripts.md view
@@ -2,9 +2,9 @@ 
 # Stack's script interpreter
 
-Stack also offers a very useful feature for running files: a script interpreter.
-For too long have Haskellers felt shackled to bash or Python because it's just
-too hard to create reusable source-only Haskell scripts. Stack attempts to solve
+Stack offers a very useful feature for running files: a script interpreter. For
+too long have Haskellers felt shackled to bash or Python because it's just too
+hard to create reusable source-only Haskell scripts. Stack attempts to solve
 that.
 
 You can use `stack <file_name>` to execute a Haskell source file. Usually, the
@@ -19,7 +19,7 @@ 
 ~~~haskell
 #!/usr/bin/env stack
--- stack script --resolver lts-19.28 --package turtle
+-- stack script --resolver lts-20.19 --package turtle
 {-# LANGUAGE OverloadedStrings #-}
 import Turtle (echo)
 main = echo "Hello World!"
@@ -78,10 +78,10 @@ 
 The second line of the source code is the Stack interpreter options comment. In
 this example, it specifies the `stack script` command with the options of a
-LTS Haskell 19.28 snapshot (`--resolver lts-19.28`) and ensuring the
+LTS Haskell 20.19 snapshot (`--resolver lts-20.19`) and ensuring the
 [`turtle` package](https://hackage.haskell.org/package/turtle) is available
 (`--package turtle`). The version of the package will be that in the specified
-snapshot (`lts-19.28` provides `turtle-1.5.25`).
+snapshot (`lts-20.19` provides `turtle-1.5.25`).
 
 ## Arguments and interpreter options and arguments
 
@@ -116,7 +116,7 @@ ~~~haskell
 #!/usr/bin/env stack
 {- stack script
-   --resolver lts-19.28
+   --resolver lts-20.19
    --
    +RTS -s -RTS
 -}
@@ -132,7 +132,7 @@ is equivalent to the following command at the command line:
 
 ~~~text
-stack script --resolver lts-19.28 -- MyScript.hs arg1 arg2 +RTS -s -RTS
+stack script --resolver lts-20.19 -- MyScript.hs arg1 arg2 +RTS -s -RTS
 ~~~
 
 where `+RTS -s -RTS` are some of GHC's
@@ -161,7 +161,7 @@ ~~~haskell
 #!/usr/bin/env stack
 {- stack script
-   --resolver lts-19.28
+   --resolver lts-20.19
    --package turtle
    --package "stm async"
    --package http-client,http-conduit
@@ -170,7 +170,8 @@ 
 ## Stack configuration for scripts
 
-With the `stack script` command, all Stack YAML configuration files are ignored.
+With the `stack script` command, all Stack YAML configuration files (global and
+project-level) are ignored.
 
 With the `stack runghc` command, if the current working directory is inside a
 project then that project's Stack project-level YAML configuration is effective
@@ -190,7 +191,7 @@ 
 ~~~haskell
 {- stack script
-   --resolver lts-19.28
+   --resolver lts-20.19
    --package acme-missiles
 -}
 import Acme.Missiles (launchMissiles)
@@ -201,7 +202,7 @@ 
 The command `stack --script-no-run-compile Script.hs` then behaves as if the
 command
-`stack script --resolver lts-19.28 --package acme-missiles --no-run --compile -- Script.hs`
+`stack script --resolver lts-20.19 --package acme-missiles --no-run --compile -- Script.hs`
 had been given. `Script.hs` is compiled (without optimisation) and the resulting
 executable is not run: no missiles are launched in the process!
 
@@ -209,8 +210,9 @@ 
 The `stack script` command will automatically:
 
-* Install GHC and libraries if missing
-* Require that all packages used be explicitly stated on the command line
+* Install GHC and libraries, if missing. `stack script` behaves as if the
+  `--install-ghc` flag had been passed at the command line.
+* Require that all packages used be explicitly stated on the command line.
 
 This ensures that your scripts are _independent_ of any prior deployment
 specific configuration, and are _reliable_ by using exactly the same version of
@@ -237,7 +239,7 @@ {- stack
   runghc
   --install-ghc
-  --resolver lts-19.17
+  --resolver lts-20.19
   --package base
   --package turtle
   --
@@ -260,7 +262,7 @@ {- stack
    exec ghci
    --install-ghc
-   --resolver lts-19.28
+   --resolver lts-20.19
    --package turtle
 -}
 ~~~
doc/sdist_command.md view
@@ -13,12 +13,12 @@ `stack sdist` generates a file for your package, in the format accepted by
 Hackage for uploads. The command will report the location of the generated file.
 
-## The `stack sdist --ignore-check` flag
+## `--ignore-check` flag
 
 Pass the flag to disable checks of the package for common mistakes. By default,
 the command will check the package for common mistakes.
 
-## The `stack sdist --pvp-bounds` option
+## `--pvp-bounds` option
 
 The `--pvp-bounds <pvp_bounds_mode>` option determines whether and, if so, how
 PVP version bounds should be added to the Cabal file of the package. The
@@ -29,12 +29,12 @@ For futher information, see the
 [YAML configuration](yaml_configuration.md#pvp-bounds) documentation.
 
-## The `stack sdist --tar-dir` option
+## `--tar-dir` option
 
 The `--tar-dir <path_to_directory>` option determines whether the package
 archive should be copied to the specified directory.
 
-## The `stack sdist --[no-]test-tarball` flag
+## `--[no-]test-tarball` flag
 
 Default: Disabled
doc/setup_command.md view
@@ -7,28 +7,74 @@             [--ghcjs-boot-options GHCJS_BOOT] [--[no-]ghcjs-boot-clean]
 ~~~
 
-`stack setup` attempts to install a version of GHC - by default, the version
-required by the project and only if it is not already available to Stack. For
-example:
+`stack setup` attempts to install a version of GHC.
 
-~~~text
-stack setup
-stack will use a sandboxed GHC it installed
-For more information on paths, see 'stack path' and 'stack exec env'
-To use this GHC and packages outside of a project, consider using:
-stack ghc, stack ghci, stack runghc, or stack exec
-~~~
+By default:
 
-Alternatively, the version of GHC to be installed can be specified as an
-argument. For example `stack setup 9.0.2`.
+* the version of GHC is the one required by the project. Specify the version of
+  GHC as an argument to attempt to install a different version of GHC. For
+  example `stack setup 9.4.4` will attempt to install GHC 9.4.4; and
 
-Set the `--reinstall` flag (disabled by default) to attempt to install the
-version of GHC regardless of whether it is already available to Stack.
+* an attempt to install is made only if the version of GHC is not already
+  available to Stack. Pass the flag `--reinstall` (disabled by default) to
+  attempt to install the version of GHC regardless of whether it is already
+  available to Stack.
 
-The `--ghc-bindist <url>` option can be used to specify the URL of the GHC to be
+Pass the option `--ghc-bindist <url>` to specify the URL of the GHC to be
 downloaded and installed. This option requires the use of the `--ghc-variant`
-option specifying a custom GHC variant.
+option specifying a custom GHC variant. For further information about the
+`--ghc-variant` option, see the see the
+[YAML configuration](yaml_configuration.md#ghc-variant) documentation.
 
 If Stack is configured not to install GHC (`install-ghc: false` or passing the
 `--no-install-ghc` flag) then `stack setup` will warn that the flag and the
 command are inconsistent and take no action.
+
+=== "Linux"
+
+    A particular binary distribution of GHC will depend on certain libraries,
+    which need to be available.
+
+    There are many different Linux distributions and different versions of a
+    particular Linux distribution. One Linux distribution/version may make
+    available different libraries to another Linux distribution/version.
+
+    In attempting to identify the particular binary distribution of GHC that is
+    required on Linux, Stack will refer to the presence or absence of certain
+    libraries or the versions of those libraries.
+
+    For example, Stack 2.11.1 considers:
+
+    *   the version of `libc6`, the
+        [GNU C Library](https://www.gnu.org/software/libc/) (glibc), that is
+        present. The GNU C Library is designed to be backwards compatible.
+
+    *   if `libgmp.so.3` or `libgmp.so.10` is present. These files are provided
+        by different versions of the
+        [GNU Multiple Precision Arithmetic Library](https://gmplib.org/).
+
+    *   if `libncursesw.so.6` is present. This file is provided by a shared
+        library for terminal handling with wide character support.
+
+    *   if `libtinfo.so.5` or `libtinfo.so.6` is present. These files are
+        provided by different versions of a shared low-level terminfo library
+        for terminal handling.
+
+    Stack 2.11.1 uses `ghc-build`:
+
+    * `tinfo6` to indicate `libgmp.so.10` and `libtinfo.so.6` are present and
+      `libc6` is compatible with `libc6` 2.32.
+    * `tinfo6-libc6-pre232` to indicate `libgmp.so.10` and `libtinfo.so.6` are
+       present and `libc6` is not compatible with `libc6` 2.32.
+    * `ncurses6` to indicate `libgmp.so.10` and `libncursesw.so.6` are present
+    * `gmp4` to indicate `libgmp.so.3` is present
+
+    By default, Stack associates:
+
+    * the `tinfo6` build with the 'Fedora 33' binary distribution of GHC 9.4.1
+      to 9.4.4. Those binary distributions require versions of `libc6` that are
+      compatible with `libc6` 2.32; and
+
+    * the `tinfo6-libc6-pre232` build with the 'Debian 10' binary distribution
+      of GHC 9.4.1 to 9.4.4. Those binary distributions require versions of
+      `libc6` that are compatible with `libc6` 2.28.
+ doc/stack_root.md view
@@ -0,0 +1,119 @@+<div class="hidden-warning"><a href="https://docs.haskellstack.org/"><img src="https://cdn.jsdelivr.net/gh/commercialhaskell/stack/doc/img/hidden-warning.svg"></a></div>
+
+# Stack root location
+
+The Stack root is a directory where Stack stores important files. The location
+and contents of the directory depend on the operating system, whether
+Stack is configured to use the XDG Base Directory Specification, and/or
+whether an alternative location to Stack's default 'programs' directory has
+been specified.
+
+The location of the Stack root can be configured by setting the
+[`STACK_ROOT`](environment_variables.md#stack_root) environment variable or
+using Stack's [`--stack-root`](global_flags.md#stack-root-option) option on the
+command line.
+
+=== "Unix-like"
+
+    The Stack root contains snapshot packages; (by default) tools such as GHC,
+    in a `programs` directory; Stack's global
+    [YAML configuration](yaml_configuration.md#yaml-configuration) file
+    (`config.yaml`); and Stack's
+    [`global-projects`](yaml_configuration.md#yaml-configuration) directory.
+
+    The default Stack root is `~/.stack`.
+
+=== "Windows"
+
+    The Stack root contains snapshot packages; Stack's global
+    [YAML configuration](yaml_configuration.md#yaml-configuration) file
+    (`config.yaml`); and Stack's
+    [`global-projects`](yaml_configuration.md#yaml-configuration) directory. The
+    default location of tools such as GHC and MSYS2 is outside of the Stack
+    root.
+
+    The default Stack root is `%APPDIR%\stack`.
+
+    If the `LOCALAPPDATA` environment variable exists, the default location of
+    tools is `%LOCALAPPDATA%\Programs\stack`. Otherwise, it is the `programs`
+    directory in the Stack root.
+
+    !!! warning
+
+        If there is a space character in the `%LOCALAPPDATA%` path (which may be
+        the case if the relevant user account name and its corresponding user
+        profile path have a space) this may cause problems with building
+        packages that make use of the GNU project's `autoconf` package and
+        `configure` shell script files. That may be the case particularly if
+        there is no corresponding short name ('8 dot 3' name) for the directory
+        in the path with the space (which may be the case if '8 dot 3' names
+        have been stripped or their creation not enabled by default). If there
+        are problems building, it will be necessary to override the default
+        location of Stack's 'programs' directory to specify an alternative path
+        that does not contain space characters. Examples of packages on
+        Hackage that make use of `configure` are `network` and `process`.
+
+    On Windows, the length of filepaths may be limited (to
+    [MAX_PATH](https://docs.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation?tabs=cmd)),
+    and things can break when this limit is exceeded. Setting a Stack root with
+    a short path to its location (for example, `C:\sr`) can help.
+
+=== "XDG Base Directory Specification"
+
+    On Unix-like operating systems and Windows, Stack can be configured to
+    follow the XDG Base Directory Specification if the environment variable
+    `STACK_XDG` is set to any non-empty value. However, Stack will ignore that
+    configuration if the Stack root location has been set on the command line or
+    the `STACK_ROOT` environment variable exists.
+
+    If Stack is following the XDG Base Directory Specification, the Stack root
+    contains what it would otherwise contain for the operating system, but
+    Stack's global YAML configuration file (`config.yaml`) may be located
+    elsewhere.
+
+    The Stack root is `<XDG_DATA_HOME>/stack`. If the `XDG_DATA_HOME`
+    environment variable does not exist, the default is `~/.local/share/stack`
+    on Unix-like operating systems and `%APPDIR%\stack` on Windows.
+
+    The location of `config.yaml` is `<XDG_CONFIG_HOME>/stack`. If the
+    `XDG_CONFIG_HOME` environment variable does not exist, the default is
+    `~/.config/stack` on Unix-like operating systems and `%APPDIR%\stack` on
+    Windows.
+
+    This approach treats:
+
+    *   the project-level YAML configuration file that is common to all projects
+        without another such file in their project directory or its ancestor
+        directories as _data_ rather than as part of Stack's own
+        _configuration_;
+
+    *   the snapshots database as essential data rather than as non-essential
+        data that would be part of a _cache_, notwithstanding that Stack will
+        rebuild that database as its contents are needed; and
+
+    *   the Pantry store as essential data rather than as non-essential data
+        that would be part of a _cache_, notwithstanding that Stack will
+        download the package index and rebuild the store if it is absent.
+
+An alternative to the default location of tools such as GHC can be specified
+with the [`local-programs-path`](yaml_configuration.md#local-programs-path)
+configuration option.
+
+The location of the Stack root is reported by command:
+
+~~~text
+stack path --stack-root
+~~~
+
+The full path of Stack's global YAML configuration file is reported by command:
+
+~~~text
+stack path --global-config
+~~~
+
+The location of tools such as GHC for the current platform is reported by
+command:
+
+~~~text
+stack path --programs
+~~~
doc/stack_yaml_vs_cabal_package_file.md view
@@ -64,8 +64,8 @@ 
 The most common means by which this set of packages is defined is via a
 snapshot provided by Stackage. For example, if you go to the page
-<https://www.stackage.org/lts-19.17>, you will see a list of 2,910 packages at
-specific version numbers. When you then specify `resolver: lts-19.17`, you're
+<https://www.stackage.org/lts-20.19>, you will see a list of 3,051 packages at
+specific version numbers. When you then specify `resolver: lts-20.19`, you're
 telling Stack to use those package versions in resolving dependencies down to
 specific versions of packages.
doc/templates_command.md view
@@ -6,70 +6,29 @@ stack templates
 ~~~
 
-`stack templates` provides information about how to find templates available for
-`stack new`.
-
-Stack provides multiple templates to start a new project from. You can specify
-one of these templates following your project name in the `stack new` command:
-
-~~~text
-stack new my-rio-project rio
-Downloading template "rio" to create project "my-rio-project" in my-rio-project/ ...
-Looking for .cabal or package.yaml files to use to init the project.
-Using cabal packages:
-- my-rio-project/
-
-Selecting the best among 18 snapshots...
-
-* Matches ...
-
-Selected resolver: ...
-Initialising configuration using resolver: ...
-Total number of user packages considered: 1
-Writing configuration to file: my-rio-project/stack.yaml
-All done.
-<Stack root>\templates\rio.hsfiles:   10.10 KiB downloaded...
-~~~
-
-The default templates repository is
-https://github.com/commercialhaskell/stack-templates. You can download templates
-from a different GitHub user by prefixing the username and a slash. Command:
-
-~~~text
-stack new my-yesod-project yesodweb/simple
-~~~
-
-Then template file `simple.hsfiles` would be downloaded from GitHub repository
-`yesodweb/stack-templates`.
-
-You can even download templates from a service other that GitHub, such as
-[GitLab](https://gitlab.com) or [Bitbucket](https://bitbucket.com). For example,
-command:
-
-~~~text
-stack new my-project gitlab:user29/foo
-~~~
-
-Template file `foo.hsfiles` would be downloaded from GitLab, user account
-`user29`, repository `stack-templates`.
-
-If you need more flexibility, you can specify the full URL of the template.
-Command:
+`stack templates` provides information about project templates used with the
+[`stack new` command](new_command.md).
 
-~~~text
-stack new my-project https://my-site.com/content/template9.hsfiles
-~~~
+Project templates are specified in `.hsfiles` files. The format of those files
+is documented at the
+[`commercialhaskell/stack-templates`](https://github.com/commercialhaskell/stack-templates#project-template-format)
+repository on GitHub.
 
-(The `.hsfiles` extension is optional; it will be added if it's not specified.)
+Any GitHub, GitLab or Bitbucket repository named `stack-templates` can provide
+project template files. For example, a template file
+`username/stack-templates/my-template.hsfiles` on GitHub can be identified as
+`username/my-template` when using `stack new`. The relevant service can be
+specified by a prefix: `github:` for [GitHub](https://github.com/) (the default
+service), `gitlab:` for [GitLab](https://gitlab.com), or `bitbucket:` for
+[Bitbucket](https://bitbucket.com).
 
-Alternatively you can use a local template by specifying the path. Command:
+[`commercialhaskell/stack-templates`](https://github.com/commercialhaskell/stack-templates#project-template-format)
+on GitHub is the default repository for project templates. Its username
+(`commercialhaskell`) does not need to be specified when using `stack new`.
 
-~~~text
-stack new project <path_to_template>/template.hsfiles
-~~~
+The project template that `stack new` uses by default is named `new-template`
+and provided at the default repository.
 
-As a starting point for creating your own templates, you can use the
-["simple" template](https://github.com/commercialhaskell/stack-templates/blob/master/simple.hsfiles).
-The
-[stack-templates repository](https://github.com/commercialhaskell/stack-templates#readme)
-provides an introduction into creating templates.
+The default repository provides 24 other project templates. Its Wiki provides
+a description of some of those templates and information about the location of
+other templates.
doc/uninstall_command.md view
@@ -6,5 +6,6 @@ stack uninstall
 ~~~
 
-`stack uninstall` provides information about how to uninstall Stack. It does not
-itself uninstall Stack.
+`stack uninstall` provides information about how to uninstall Stack or a
+Stack-supplied tool (such as GHC or, on Windows, MSYS2). It does not
+itself uninstall Stack or a Stack-supplied tool.
doc/unpack_command.md view
@@ -8,4 +8,12 @@ 
 `stack unpack` downloads a tarball for the specified package and unpacks it.
 
-Pass the option `--to <directory>` to specify the destination directory.
+By default:
+
+*   the download is for the most recent version of the package in the package
+    index (eg Hackage). Specify the package name and its version (for example,
+    `acme-missiles-0.1.0.0`) for a particular version of the package; and
+
+*   the package is unpacked into a directory named after the package and its
+    version. Pass the option `--to <directory>` to specify the destination
+    directory.
doc/upgrade_command.md view
@@ -6,7 +6,8 @@ 
 ~~~text
 stack upgrade [--binary-only] [--binary-platform ARG] [--force-download]
-              [--binary-version ARG] [--github-org ARG] [--github-repo ARG]
+              [--[no-]only-local-bin] [--binary-version ARG] [--github-org ARG]
+              [--github-repo ARG]
 ~~~
 
 or:
@@ -15,10 +16,76 @@ stack upgrade [--source-only] [--git] [--git-repo ARG] [--git-branch ARG]
 ~~~
 
-`stack upgrade` will get a new version of Stack, either from an existing
-binary distribution (pass the `--binary-only` flag, the default) or from
-compiling source code (pass the `--source-only` flag). The `--binary-only` and
-`--source-only` flags are alternatives.
+`stack upgrade` will get a new version of Stack.
 
-`--git` is a convenient way to get the most recent version from the `master`
-branch, for those testing and living on the bleeding edge.
+By default:
+
+* the new version will be from an existing binary distribution. Pass the
+  `--source-only` flag to specify compiling from source code. The
+  `--binary-only` and `--source-only` flags are alternatives;
+
+* the new version will not overwrite the existing version unless it is newer.
+  Pass the `--force-download` flag to force a download;
+
+* when an existing binary distribution is applicable, it will be put in Stack's
+  local binary directory (see `stack path --local-bin`) and named `stack`
+  (replacing any existing executable named `stack` there);
+
+* if the current running Stack executable is named `stack` (or, on Windows,
+  `stack.exe`) (this is case insensitive), an existing binary distribution will
+  replace it. If the executable is located outside of Stack's local binary
+  directory, pass the `--only-local-bin` flag to skip that step;
+
+* if the current running Stack executable is named other than `stack` (and, on
+  Windows, `stack.exe`), an existing binary distribution will only be put in
+  Stack's local binary directory and named `stack`. Pass the
+  `--no-only-local-bin` flag to replace also the current running executable;
+
+* the new version will be the latest available. Pass the
+  `--binary-version <version>` option to specify the version (this implies
+  `--force-download`);
+
+* the binary distribution will be sought from the GitHub organisation/user
+  `commercialhaskell`. Pass the `--github-org <user>` option to specify a
+  different GitHub user;
+
+* the binary distribution will be sought from the GitHub repository `stack`.
+  Pass the `--github-repo <repository>` option to specify a different
+  repository; and
+
+* the binary distribution will be sought for the current platform. Pass the
+  `--binary-platform <platform>` option to specify a different platform
+  (`<operating_system>-<architecture>-<suffix>`).
+
+When compiling from source code, by default:
+
+*   Stack will obtain the source code for the most recent version in the package
+    index (eg Hackage). Pass the flag `--git` to specify the most recent version
+    from the `master` branch of Stack's repository (pass the option
+    `--git-branch <branch>` to specify a different branch and the option
+    `--git-repo <repo_url>` to specify a different repository).
+
+## Examples
+
+* `stack upgrade` seeks an upgrade to the latest version of Stack available as a
+  binary distribution for the platform, if newer.
+
+* `stack upgrade --force-download` seeks an upgrade to the latest version of
+  Stack available as a binary distribution for the platform, even if not newer.
+
+* If the Stack executable is named `my-stack`, `my-stack upgrade` seeks only to
+  put the latest version of Stack available as a binary distribution for the
+  platform, if newer, in Stack's local binary directory and name it `stack`.
+  `my-stack upgrade --no-only-local-bin` seeks also to upgrade `my-stack` to the
+  latest version of Stack available.
+
+* `stack upgrade --binary-version 2.11.1` seeks an upgrade to Stack 2.11.1 if
+  available as a binary distribution for the platform, even if not newer.
+
+* `stack upgrade --source-only` seeks an upgrade by building Stack with
+  Stack from the latest version of the source code in the package index
+  (i.e. Hackage).
+
+* `stack upgrade --source-only --git` seeks an upgrade by building Stack with
+  Stack from the latest version of the source code in the `master` branch of
+  Stack's repository.
doc/upload_command.md view
@@ -68,17 +68,17 @@      stack upload .
      ~~~
 
-## The `stack upload --candidate` flag
+## `--candidate` flag
 
 Pass the flag to upload a
 [package candidate](http://hackage.haskell.org/upload#candidates).
 
-## The `stack upload --ignore-check` flag
+## `--ignore-check` flag
 
 Pass the flag to disable checks of the package for common mistakes. By default,
 the command will check the package for common mistakes.
 
-## The `stack upload --pvp-bounds` option
+## `--pvp-bounds` option
 
 The `--pvp-bounds <pvp_bounds_mode>` option determines whether and, if so, how
 PVP version bounds should be added to the Cabal file of the package. The
@@ -89,12 +89,12 @@ For futher information, see the
 [YAML configuration](yaml_configuration.md#pvp-bounds) documentation.
 
-## The `stack upload --tar-dir` option
+## `--tar-dir` option
 
 The `--tar-dir <path_to_directory>` option determines whether the package
 archive should be copied to the specified directory.
 
-## The `stack upload --[no-]test-tarball` flag
+## `--[no-]test-tarball` flag
 
 Default: Disabled
doc/yaml_configuration.md view
@@ -21,7 +21,8 @@ 1. A file specified by the `--stack-yaml` command line option.
 2. A file specified by the `STACK_YAML` environment variable.
 3. A file named `stack.yaml` in the current directory or an ancestor directory.
-4. A file name `stack.yaml` in the `global-project` directory in the Stack root.
+4. A file name `stack.yaml` in the `global-project` directory in the
+   [Stack root](stack_root.md).
 
 The **global** configuration file (`config.yaml`) contains only
 non-project-specific options.
@@ -33,19 +34,19 @@ === "Unix-like"
 
     `config.yaml` is located in `/etc/stack` (for system-wide options); and/or
-    in the Stack root (for user-specific options).
+    in the [Stack root](stack_root.md) (for user-specific options).
 
 === "Windows"
 
-    `config.yaml` is located in the Stack root.
+    `config.yaml` is located in the [Stack root](stack_root.md).
 
 === "XDG Base Directory Specification"
 
     On Unix-like operating systems and Windows, Stack can be configured to
     follow the XDG Base Directory Specification if the environment variable
     `STACK_XDG` is set to any non-empty value. However, Stack will ignore that
-    configuration if the Stack root location has been set on the command line or
-    the `STACK_ROOT` environment variable exists.
+    configuration if the [Stack root](stack_root.md) location has been set on
+    the command line or the `STACK_ROOT` environment variable exists.
 
     If Stack is following the XDG Base Directory Specification, the location of
     `config.yaml` (for user-specific options) is `<XDG_CONFIG_HOME>/stack`. If
@@ -95,10 +96,10 @@ since a snapshot states how dependencies are resolved. There are currently
 four resolver types:
 
-* LTS Haskell snapshots, e.g. `resolver: lts-19.17`
-* Stackage Nightly snapshots, e.g. `resolver: nightly-2002-08-04`
+* LTS Haskell snapshots, e.g. `resolver: lts-20.19`
+* Stackage Nightly snapshots, e.g. `resolver: nightly-2023-05-05`
 * No snapshot, just use packages shipped with the compiler. For GHC this looks
-  like `resolver: ghc-9.2.4`
+  like `resolver: ghc-9.6.1`
 * Custom snapshot, via a URL or relative file path. For further information, see
   the [Pantry](pantry.md) documentation.
 
@@ -118,132 +119,106 @@ - .
 ~~~
 
-_NOTE_ From Stack 1.11, Stack moved over to Pantry for managing extra-deps, and
-removed some legacy syntax for specifying dependencies in `packages`. Some
-conversion notes are provided below.
-
 The `packages` key specifies a list of packages that are part of your local
-project. These are specified via paths to local directories. The paths are
+project. These are specified via paths to local directories. A path is
 considered relative to the directory containing the `stack.yaml` file. For
-example, if your `stack.yaml` is located at `/foo/bar/stack.yaml`, and you have:
+example, if the `stack.yaml` is located at `/dir1/dir2/stack.yaml`, and has:
 
 ~~~yaml
 packages:
-- hello
-- there/world
+- my-package
+- dir3/my-other-package
 ~~~
 
-Your configuration means "I have packages in `/foo/bar/hello` and
-`/foo/bar/there/world`.
+the configuration means "project packages in directories `/dir1/dir2/my-package`
+and `/dir1/dir2/dir3/my-other-package`".
 
-If these packages should be treated as dependencies instead, specify them in
-`extra-deps` key, described below.
+The `packages` key is optional. The default value, '`.`', means that the
+project has a single package located in the current directory.
 
-The `packages` key is _optional_. The default item, '`.`', means that your
-project has exactly one package, and it is located in the current directory.
+Each specified package directory must have a valid Cabal file or Hpack
+`package.yaml` file present. Any subdirectories of the directory are not
+searched for Cabal files. A subdirectory has to be specified as an independent
+item in the list of packages.
 
-Each package directory specified must have a valid Cabal file or Hpack
-`package.yaml` file present. The subdirectories of the directory are not
-searched for Cabal files. Subdirectories will have to be specified as
-independent items in the list of packages.
+A project package is different from a dependency, both a snapshot dependency
+(via the [`resolver` or `snapshot`](#resolver-or-snapshot) key) and an
+extra-deps dependency (via the [`extra-deps`](#extra-deps) key). For example:
 
-Project packages are different from snapshot dependencies (via `resolver`) and
-extra dependencies (via `extra-deps`) in multiple ways, e.g.:
+* a project package will be built by default by commanding
+  [`stack build`](build_command.md) without specific targets. A dependency will
+  only be built if it is depended upon; and
+* test suites and benchmarks may be run for a project package. They are never
+  run for a dependency.
 
-* Project packages will be built by default with a `stack build` without
-  specific targets. Dependencies will only be built if they are depended upon.
-* Test suites and benchmarks may be run for project packages. They are never run
-  for extra dependencies.
+### extra-deps
 
-__Legacy syntax__ Prior to Stack 1.11, it was possible to specify dependencies
-in your `packages` configuration value as well. This support was removed to
-simplify the file format. Instead, these values should be moved to `extra-deps`.
-As a concrete example, you would convert:
+Default: `[]`
 
-~~~yaml
-packages:
-- .
-- location:
-    git: https://github.com/bitemyapp/esqueleto.git
-    commit: 08c9b4cdf977d5bcd1baba046a007940c1940758
-  extra-dep: true
-- location:
-    git: https://github.com/yesodweb/wai.git
-    commit: 6bf765e000c6fd14e09ebdea6c4c5b1510ff5376
-    subdirs:
-      - wai-extra
-  extra-dep: true
+The `extra-deps` key specifies a list of extra dependencies on top of what is
+defined in the snapshot (specified by the
+[`resolver` or `snapshot`](#resolver-or-snapshot) key). A dependency may come
+from either a Pantry package location or a local file path.
 
-extra-deps:
-  - streaming-commons-0.2.0.0
-  - time-1.9.1
-  - yesod-colonnade-1.3.0.1
-  - yesod-elements-1.1
-~~~
+A Pantry package location is one or three different kinds of sources:
 
-into
+* the package index (Hackage);
+* an archive (a tarball or zip file, either local or over HTTP or HTTPS); or
+* a Git or Mercurial repository.
 
-~~~yaml
-packages:
-- .
+For further information on the format for specifying a Pantry package location,
+see the [Pantry](pantry.md) documentation. For example:
 
+~~~yaml
 extra-deps:
-  - streaming-commons-0.2.0.0
-  - time-1.9.1
-  - yesod-colonnade-1.3.0.1
-  - yesod-elements-1.1
-  - git: https://github.com/bitemyapp/esqueleto.git
-    commit: 08c9b4cdf977d5bcd1baba046a007940c1940758
-  - git: https://github.com/yesodweb/wai.git
-    commit: 6bf765e000c6fd14e09ebdea6c4c5b1510ff5376
-    subdirs:
-      - wai-extra
+# The latest revision of a package in the package index (Hackage):
+- acme-missiles-0.3
+# A specific revision of a package in the package index (Hackage):
+- acme-missiles-0.3@rev:0
+# An *.tar.gz archive file over HTTPS:
+- url: https://github.com/example-user/my-repo/archive/08c9b4cdf977d5bcd1baba046a007940c1940758.tar.gz
+  subdirs:
+  - my-package
+# A Git repository at a specific commit:
+- git: https://github.com/example-user/my-repo.git
+  commit: 08c9b4cdf977d5bcd1baba046a007940c1940758
+# An archive of files at a point in the history of a GitHub repository
+# (identified by a specific commit):
+- github: example-user/my-repo
+  commit: 08c9b4cdf977d5bcd1baba046a007940c1940758
+  subdirs:
+  - my-package
 ~~~
 
-And, in fact, the `packages` value could be left off entirely since it's using
-the default value.
-
-### extra-deps
+!!! note
 
-Default: `[]`
+    GHC boot packages are special. An extra-dep with the same package name and
+    version as a GHC boot package will be ignored.
 
-This key allows you to specify extra dependencies on top of what is defined in
-your snapshot (specified by the `resolver` key mentioned above). These
-dependencies may either come from a local file path or a Pantry package
-location.
+For a local file path source, the path is considered relative to the directory
+containing the `stack.yaml` file. For example, if the `stack.yaml` is located
+at `/dir1/dir2/stack.yaml`, and has:
 
-For the local file path case, the same relative path rules as apply to
-`packages` apply.
+~~~yaml
+extra-deps:
+- my-package
+- dir3/my-other-package
+~~~
 
-Pantry package locations allow you to include dependencies from three different
-kinds of sources:
+the configuration means "extra-deps packages in directories
+`/dir1/dir2/my-package` and `/dir1/dir2/dir3/my-other-package`".
 
-* Hackage
-* Archives (tarballs or zip files, either local or over HTTP or HTTPS)
-* Git or Mercurial repositories
+!!! note
 
-Here's an example using all of the above:
+    A local file path that has the format of a package identifier will be
+    interpreted as a reference to a package on Hackage. Prefix it with `./` to
+    avoid that confusion.
 
-~~~yaml
-extra-deps:
-- vendor/hashable
-- streaming-commons-0.2.0.0
-- time-1.9.1
-- yesod-colonnade-1.3.0.1
-- yesod-elements-1.1
-- git: https://github.com/bitemyapp/esqueleto.git
-  commit: 08c9b4cdf977d5bcd1baba046a007940c1940758
-- url: https://github.com/yesodweb/wai/archive/6bf765e000c6fd14e09ebdea6c4c5b1510ff5376.tar.gz
-  subdirs:
-    - wai-extra
-- github: snoyberg/conduit
-  commit: 2e3e41de93821bcfe8ec6210aeca21be3f2087bf
-  subdirs:
-    - network-conduit-tls
-~~~
+!!! note
 
-For further information on the format for specifying dependencies, see the
-[Pantry](pantry.md) documentation.
+    A specified extra-dep that does not have the format of a valid Pantry
+    package location (for example, a reference to a package on Hackage that
+    omits the package's version) will be interpreted as a local file path.
 
 ### flags
 
@@ -340,8 +315,8 @@ 
 Command line equivalent (takes precedence): `--[no-]allow-different-user` flag
 
-Allow users other than the owner of the Stack root to use the Stack
-installation.
+Allow users other than the owner of the [Stack root](stack_root.md) to use the
+Stack installation.
 
 ~~~yaml
 allow-different-user: true
@@ -367,8 +342,10 @@ allow-newer: true
 ~~~
 
-### allow-newer-deps (experimental)
+### allow-newer-deps
 
+:octicons-beaker-24: Experimental
+
 [:octicons-tag-24: 2.9.3](https://github.com/commercialhaskell/stack/releases/tag/v2.9.3)
 
 Default: `none`
@@ -388,18 +365,40 @@ 
 Default: `locals`
 
-Which packages do ghc-options on the command line get applied to? Before Stack
-0.1.6, the default value was `targets`
+Related command line:
+[`stack build --ghc-options`](build_command.md#-ghc-options-option) option
 
-~~~yaml
-apply-ghc-options: locals # all local packages
-# apply-ghc-options: targets # all local packages that are targets
-# apply-ghc-options: everything # applied even to snapshot and extra-deps
-~~~
+Determines to which packages any GHC command line options specified on the
+command line are applied. Possible values are: `everything` (all packages, local
+or otherwise), `locals` (all local packages, targets or otherwise), and
+`targets` (all local packages that are targets).
 
-Note that `everything` is a slightly dangerous value, as it can break invariants
-about your snapshot database.
+!!! note
 
+    The use of `everything` can break invariants about your snapshot database.
+
+!!! note
+
+    Before Stack 0.1.6.0, the default value was `targets`.
+
+### apply-prog-options
+
+[:octicons-tag-24: 2.11.1](https://github.com/commercialhaskell/stack/releases/tag/v2.11.1)
+
+Default: `locals`
+
+Related command line:
+[`stack build --PROG-option`](build_command.md#-prog-option-options) options
+
+Determines to which packages all and any `--PROG-option` command line options
+specified on the command line are applied. Possible values are: `everything`
+(all packages, local or otherwise), `locals` (all local packages, targets or
+otherwise), and `targets` (all local packages that are targets).
+
+!!! note
+
+    The use of `everything` can break invariants about your snapshot database.
+
 ### arch
 
 Default: The machine architecture on which Stack is running.
@@ -475,6 +474,18 @@ [`stack build` command](build_command.md) documentation and the
 [users guide](GUIDE.md#the-build-command).
 
+### casa-repo-prefix
+
+[:octicons-tag-24: 2.3.1](https://github.com/commercialhaskell/stack/releases/tag/v2.3.1)
+
+Default: `https://casa.fpcomplete.com`
+
+This option specifies the prefix for the URL used to pull information from the
+Casa (content-addressable storage archive) server that is used by Stack to cache
+Cabal files and all other files in packages. For further information, see this
+blog post about
+[Casa and Stack](https://www.fpcomplete.com/blog/casa-and-stack/).
+
 ### color
 
 Command line equivalent (takes precedence): `--color` option
@@ -495,17 +506,19 @@ 
 Overrides the compiler version in the resolver. Note that the `compiler-check`
 flag also applies to the version numbers. This uses the same syntax as compiler
-resolvers like `ghc-9.2.4`. This can be used to override the
+resolvers like `ghc-9.6.1`. This can be used to override the
 compiler for a Stackage snapshot, like this:
 
 ~~~yaml
-resolver: lts-14.20
-compiler: ghc-8.6.4
+resolver: lts-20.19
+compiler: ghc-9.6.1
 compiler-check: match-exact
 ~~~
 
-#### Building GHC from source (experimental)
+#### Building GHC from source
 
+:octicons-beaker-24: Experimental
+
 [:octicons-tag-24: 2.1.1](https://github.com/commercialhaskell/stack/releases/tag/v2.1.1)
 
 Stack supports building the GHC compiler from source. The version to build and
@@ -614,16 +627,23 @@ 
 [:octicons-tag-24: 2.1.1](https://github.com/commercialhaskell/stack/releases/tag/v2.1.1)
 
-Options which are passed to the configure step of the Cabal build process.
-These can either be set by package name, or using the `$everything`,
-`$targets`, and `$locals` special keys. These special keys have the same
-meaning as in `ghc-options`.
+Related command line (takes precedence):
+[`stack build --PROG-option`](build_command.md#prog-option-options) options
 
+`configure-options` can specify Cabal (the library) options (including
+`--PROG-option` or `--PROG-options` options) for the configure step of the Cabal
+build process for a named package, all local packages that are targets (using
+the `$targets` key), all local packages (targets or otherwise) (using the
+`$locals` key), or all packages (local or otherwise) (using the `$everything`
+key).
+
 ~~~yaml
 configure-options:
   $everything:
   - --with-gcc
   - /some/path
+  $locals:
+  - --happy-option=--ghc
   my-package:
   - --another-flag
 ~~~
@@ -749,25 +769,38 @@ 
 `ghc-build` specifies a specialized architecture for the GHC executable.
 Normally this is determined automatically, but it can be overridden. Possible
-arguments include `standard`, `gmp4`, `nopie`, `tinfo6`, `tinfo6-nopie`,
-`ncurses6`, `int-native` and `integersimple`.
+arguments include `standard`, `gmp4`, `nopie`, `tinfo6`, `tinfo6-libc6-pre232`,
+`tinfo6-nopie`, `ncurses6`, `int-native` and `integersimple`.
 
 ### ghc-options
 
 [:octicons-tag-24: 0.1.4.0](https://github.com/commercialhaskell/stack/releases/tag/v0.1.4.0)
 
-Allows specifying per-package and global GHC options:
+Default: `{}`
 
+Related command line (takes precedence):
+[`stack build --ghc-options`](build_command.md#ghc-options-option) option
+
+`ghc-options` can specify GHC command line options for a named package, all
+local packages that are targets (using the `$targets` key), all local packages
+(targets or otherwise) (using the `$locals` key), or all packages (local or
+otherwise) (using the `$everything` key).
+
 ~~~yaml
 ghc-options:
-    # All packages
-    "$locals": -Wall
-    "$targets": -Werror
-    "$everything": -O2
-    some-package: -DSOME_CPP_FLAG
+  "$everything": -O2
+  "$locals": -Wall
+  "$targets": -Werror
+  some-package: -DSOME_CPP_FLAG
 ~~~
 
-Since Stack 1.6.0, setting a GHC options for a specific package will
+GHC's command line options are _order-dependent_ and evaluated from left to
+right. Later options can override earlier options. Stack applies options (as
+applicable) in the order of `$everything`, `$locals`, `$targets`, and then those
+for the named package. Any existing GHC command line options of a package are
+applied after those specified in Stack's YAML configuration.
+
+Since Stack 1.6.1, setting a GHC options for a specific package will
 automatically promote it to a local package (much like setting a custom package
 flag). However, setting options via `$everything` on all flags will not do so
 (see
@@ -775,17 +808,10 @@ for reasoning). This can lead to unpredictable behavior by affecting your
 snapshot packages.
 
-The behavior of the `$locals`, `$targets`, and `$everything` special keys
-mirrors the behavior for the
-[`apply-ghc-options` setting](#apply-ghc-options), which affects command line
-parameters.
-
 !!! note
 
-    Prior to Stack 1.6.0, the `$locals`, `$targets`, and `$everything` keys
-    were not supported. Instead, you could use `"*"` for the behavior
-    represented now by `$everything`. It is highly recommended to switch to the
-    new, more expressive, keys.
+    Before Stack 1.6.1, the key `*` (then deprecated) had the same function as
+    the key `$everything`.
 
 ### ghc-variant
 
@@ -899,44 +925,48 @@ 
 Command line equivalent (takes precedence): `--local-bin-path` option
 
-Target directory for `stack install` and `stack build --copy-bins`.
+Specifies the target directory for
+[`stack build --copy-bins`](build_command.md#-no-copy-bins-flag) and
+`stack install`. An absolute or relative path can be specified.
 
+If the project-level configuration is provided in the `global-project` directory
+in the [Stack root](stack_root.md), a relative path is assumed to be relative to
+the current directory. Otherwise, it is assumed to be relative to the directory
+of the project-level configuration file.
+
 ### local-programs-path
 
 [:octicons-tag-24: 1.3.0](https://github.com/commercialhaskell/stack/releases/tag/v1.3.0)
 
-The behaviour of this option differs between Unix-like operating systems and
-Windows.
+This overrides the location of the Stack 'programs' directory, where tools like
+GHC get installed. The path must be an absolute one.
 
-=== "Unix-like"
+Stack's defaults differ between Unix-like operating systems and Windows.
 
-    Default: `programs` directory in the Stack root.
+=== "Unix-like"
 
-    This overrides the location of the Stack 'programs' directory, where tools
-    like GHC get installed.
+    Default: `programs` directory in the [Stack root](stack_root.md).
 
 === "Windows"
 
     Default: `%LOCALAPPDATA%\Programs\stack`, if the `%LOCALAPPDATA%`
-    environment variable exists.
+    environment variable exists. Otherwise, the `programs` directory in the
+    [Stack root](stack_root.md).
 
-    This overrides the location of the Stack 'programs' directory, where tools
-    like GHC and MSYS2 get installed.
+    The MSYS2 tool is also installed in the Stack 'programs' directory.
 
     !!! warning
 
-        If there is a space character in the `%LOCALAPPDATA%` path (which may be
-        the case if the relevant user account name and its corresponding user
-        profile path have a space) this may cause problems with building
-        packages that make use of the GNU project's `autoconf` package and
-        `configure` shell script files. That may be the case particularly if
-        there is no corresponding short name ('8 dot 3' name) for the directory
-        in the path with the space (which may be the case if '8 dot 3' names
-        have been stripped or their creation not enabled by default). If there
-        are problems building, it will be necessary to override the default
-        location of Stack's 'programs' directory to specify an alternative path
-        that does not contain space characters. Examples of packages on
-        Hackage that make use of `configure` are `network` and `process`.
+        If there is a space character in the path to Stack's 'programs'
+        directory this may cause problems with building packages that make use
+        of the GNU project's `autoconf` package and `configure` shell script
+        files. That may be the case particularly if there is no corresponding
+        short name ('8 dot 3' name) for the directory in the path with the space
+        (which may be the case if '8 dot 3' names have been stripped or their
+        creation not enabled by default). If there are problems building, it
+        will be necessary to specify an alternative path that does not contain
+        space characters. Examples of packages on Hackage that make use of
+        `configure` are `network` and `process`.
 
 ### modify-code-page
 
@@ -1211,7 +1241,7 @@ 
 'Platforms' are pairs of an operating system and a machine architecture (for
 example, 32-bit i386 or 64-bit x86-64) (represented by the
-`Cabal.Distribution.Systems.Platform` type). Stack currently (version 2.9.1)
+`Cabal.Distribution.Systems.Platform` type). Stack currently (version 2.11.1)
 supports the following pairs in the format of the `setup-info` key:
 
 |Operating system|I386 arch|X86_64 arch|Other machine architectures                                 |
@@ -1509,7 +1539,7 @@     author-name: Your Name
     author-email: youremail@example.com
     category: Your Projects Category
-    copyright: 'Copyright (c) 2022 Your Name'
+    copyright: 'Copyright (c) 2023 Your Name'
     github-username: yourusername
 ~~~
 
@@ -1561,12 +1591,16 @@ 
 Default: `.stack-work`
 
-Command line equivalent (takes precedence): `--work-dir` option
+Command line equivalent (takes precedence):
+[`--work-dir`](global_flags.md#-work-dir-option) option
 
-Environment variable alternative (lowest precedence): `STACK_WORK`
+Environment variable alternative (lowest precedence):
+[`STACK_WORK`](environment_variables.md#stack_work)
 
-`work-dir` (or the contents of `STACK_WORK`) specifies the relative path of
-Stack's 'work' directory.
+`work-dir` specifies the path of Stack's work directory, within a local project
+or package directory. The path must be a relative one, relative to the
+root directory of the project or package. The relative path cannot include a
+`..` (parent directory) component.
 
 ## Customisation scripts
 
@@ -1575,10 +1609,10 @@ [:octicons-tag-24: 2.9.1](https://github.com/commercialhaskell/stack/releases/tag/v2.9.1)
 
 On Unix-like operating systems and Windows, Stack's installation procedure can
-be fully customised by placing a `sh` shell script (a 'hook') in the Stack root
-directory at `hooks/ghc-install.sh`. On Unix-like operating systems, the script
-file must be made executable. The script is run by the `sh` application (which
-is provided by MSYS2 on Windows).
+be fully customised by placing a `sh` shell script (a 'hook') in the
+[Stack root](stack_root.md) directory at `hooks/ghc-install.sh`. On Unix-like
+operating systems, the script file must be made executable. The script is run by
+the `sh` application (which is provided by MSYS2 on Windows).
 
 The script **must** return an exit code of `0` and the standard output **must**
 be the absolute path to the GHC binary that was installed. Otherwise Stack will
src/Control/Concurrent/Execute.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE RecordWildCards    #-}
 
 -- Concurrent execution with dependencies. Types currently hard-coded for needs
@@ -13,64 +12,70 @@     , runActions
     ) where
 
-import           Control.Concurrent.STM   (retry)
+import           Control.Concurrent.STM ( retry )
 import           Stack.Prelude
-import           Data.List (sortBy)
-import qualified Data.Set                 as Set
+import           Data.List ( sortBy )
+import qualified Data.Set as Set
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Control.Concurrent.Execute" module.
 data ExecuteException
-    = InconsistentDependenciesBug
-    deriving (Show, Typeable)
+  = InconsistentDependenciesBug
+  deriving (Show, Typeable)
 
 instance Exception ExecuteException where
-    displayException InconsistentDependenciesBug = bugReport "[S-2816]"
-        "Inconsistent dependencies were discovered while executing your build \
-        \plan."
+  displayException InconsistentDependenciesBug = bugReport "[S-2816]"
+    "Inconsistent dependencies were discovered while executing your build \
+    \plan."
 
 data ActionType
-    = ATBuild
-      -- ^ Action for building a package's library and executables. If
-      -- 'taskAllInOne' is 'True', then this will also build benchmarks
-      -- and tests. It is 'False' when then library's benchmarks or
-      -- test-suites have cyclic dependencies.
-    | ATBuildFinal
-      -- ^ Task for building the package's benchmarks and test-suites.
-      -- Requires that the library was already built.
-    | ATRunTests
-      -- ^ Task for running the package's test-suites.
-    | ATRunBenchmarks
-      -- ^ Task for running the package's benchmarks.
-    deriving (Show, Eq, Ord)
-data ActionId = ActionId !PackageIdentifier !ActionType
-    deriving (Show, Eq, Ord)
-data Action = Action
-    { actionId :: !ActionId
-    , actionDeps :: !(Set ActionId)
-    , actionDo :: !(ActionContext -> IO ())
-    , actionConcurrency :: !Concurrency
-    }
+  = ATBuild
+    -- ^ Action for building a package's library and executables. If
+    -- 'taskAllInOne' is 'True', then this will also build benchmarks
+    -- and tests. It is 'False' when then library's benchmarks or
+    -- test-suites have cyclic dependencies.
+  | ATBuildFinal
+    -- ^ Task for building the package's benchmarks and test-suites.
+    -- Requires that the library was already built.
+  | ATRunTests
+    -- ^ Task for running the package's test-suites.
+  | ATRunBenchmarks
+    -- ^ Task for running the package's benchmarks.
+  deriving (Show, Eq, Ord)
 
-data Concurrency = ConcurrencyAllowed | ConcurrencyDisallowed
-    deriving (Eq)
+data ActionId
+  = ActionId !PackageIdentifier !ActionType
+  deriving (Eq, Ord, Show)
 
+data Action
+  = Action
+  { actionId :: !ActionId
+  , actionDeps :: !(Set ActionId)
+  , actionDo :: !(ActionContext -> IO ())
+  , actionConcurrency :: !Concurrency
+  }
+
+data Concurrency
+  = ConcurrencyAllowed
+  | ConcurrencyDisallowed
+  deriving Eq
+
 data ActionContext = ActionContext
-    { acRemaining :: !(Set ActionId)
+  { acRemaining :: !(Set ActionId)
     -- ^ Does not include the current action
-    , acDownstream :: [Action]
+  , acDownstream :: [Action]
     -- ^ Actions which depend on the current action
-    , acConcurrency :: !Concurrency
+  , acConcurrency :: !Concurrency
     -- ^ Whether this action may be run concurrently with others
-    }
+  }
 
 data ExecuteState = ExecuteState
-    { esActions    :: TVar [Action]
-    , esExceptions :: TVar [SomeException]
-    , esInAction   :: TVar (Set ActionId)
-    , esCompleted  :: TVar Int
-    , esKeepGoing  :: Bool
-    }
+  { esActions    :: TVar [Action]
+  , esExceptions :: TVar [SomeException]
+  , esInAction   :: TVar (Set ActionId)
+  , esCompleted  :: TVar Int
+  , esKeepGoing  :: Bool
+  }
 
 runActions :: Int -- ^ threads
            -> Bool -- ^ keep going after one task has failed
@@ -78,81 +83,80 @@            -> (TVar Int -> TVar (Set ActionId) -> IO ()) -- ^ progress updated
            -> IO [SomeException]
 runActions threads keepGoing actions0 withProgress = do
-    es <- ExecuteState
-        <$> newTVarIO (sortActions actions0)
-        <*> newTVarIO []
-        <*> newTVarIO Set.empty
-        <*> newTVarIO 0
-        <*> pure keepGoing
-    _ <- async $ withProgress (esCompleted es) (esInAction es)
-    if threads <= 1
-        then runActions' es
-        else replicateConcurrently_ threads $ runActions' es
-    readTVarIO $ esExceptions es
+  es <- ExecuteState
+    <$> newTVarIO (sortActions actions0)
+    <*> newTVarIO []
+    <*> newTVarIO Set.empty
+    <*> newTVarIO 0
+    <*> pure keepGoing
+  _ <- async $ withProgress (esCompleted es) (esInAction es)
+  if threads <= 1
+    then runActions' es
+    else replicateConcurrently_ threads $ runActions' es
+  readTVarIO $ esExceptions es
 
 -- | Sort actions such that those that can't be run concurrently are at
 -- the end.
 sortActions :: [Action] -> [Action]
 sortActions = sortBy (compareConcurrency `on` actionConcurrency)
-  where
-    -- NOTE: Could derive Ord. However, I like to make this explicit so
-    -- that changes to the datatype must consider how it's affecting
-    -- this.
-    compareConcurrency ConcurrencyAllowed ConcurrencyDisallowed = LT
-    compareConcurrency ConcurrencyDisallowed ConcurrencyAllowed = GT
-    compareConcurrency _ _ = EQ
+ where
+  -- NOTE: Could derive Ord. However, I like to make this explicit so
+  -- that changes to the datatype must consider how it's affecting
+  -- this.
+  compareConcurrency ConcurrencyAllowed ConcurrencyDisallowed = LT
+  compareConcurrency ConcurrencyDisallowed ConcurrencyAllowed = GT
+  compareConcurrency _ _ = EQ
 
 runActions' :: ExecuteState -> IO ()
-runActions' ExecuteState {..} =
-    loop
-  where
-    breakOnErrs inner = do
-        errs <- readTVar esExceptions
-        if null errs || esKeepGoing
-            then inner
-            else pure $ pure ()
-    withActions inner = do
-        as <- readTVar esActions
-        if null as
-            then pure $ pure ()
-            else inner as
-    loop = join $ atomically $ breakOnErrs $ withActions $ \as ->
-        case break (Set.null . actionDeps) as of
-            (_, []) -> do
-                inAction <- readTVar esInAction
-                if Set.null inAction
-                    then do
-                        unless esKeepGoing $
-                            modifyTVar esExceptions
-                                (toException InconsistentDependenciesBug:)
-                        pure $ pure ()
-                    else retry
-            (xs, action:ys) -> do
-                inAction <- readTVar esInAction
-                case actionConcurrency action of
-                  ConcurrencyAllowed -> pure ()
-                  ConcurrencyDisallowed -> unless (Set.null inAction) retry
-                let as' = xs ++ ys
-                    remaining = Set.union
-                        (Set.fromList $ map actionId as')
-                        inAction
-                writeTVar esActions as'
-                modifyTVar esInAction (Set.insert $ actionId action)
-                pure $ mask $ \restore -> do
-                    eres <- try $ restore $ actionDo action ActionContext
-                        { acRemaining = remaining
-                        , acDownstream = downstreamActions (actionId action) as'
-                        , acConcurrency = actionConcurrency action
-                        }
-                    atomically $ do
-                        modifyTVar esInAction (Set.delete $ actionId action)
-                        modifyTVar esCompleted (+1)
-                        case eres of
-                            Left err -> modifyTVar esExceptions (err:)
-                            Right () ->
-                                let dropDep a = a { actionDeps = Set.delete (actionId action) $ actionDeps a }
-                                 in modifyTVar esActions $ map dropDep
-                    restore loop
+runActions' ExecuteState {..} = loop
+ where
+  breakOnErrs inner = do
+    errs <- readTVar esExceptions
+    if null errs || esKeepGoing
+      then inner
+      else pure $ pure ()
+  withActions inner = do
+    as <- readTVar esActions
+    if null as
+      then pure $ pure ()
+      else inner as
+  loop = join $ atomically $ breakOnErrs $ withActions $ \as ->
+    case break (Set.null . actionDeps) as of
+      (_, []) -> do
+        inAction <- readTVar esInAction
+        if Set.null inAction
+          then do
+            unless esKeepGoing $
+              modifyTVar esExceptions (toException InconsistentDependenciesBug:)
+            pure $ pure ()
+          else retry
+      (xs, action:ys) -> do
+        inAction <- readTVar esInAction
+        case actionConcurrency action of
+          ConcurrencyAllowed -> pure ()
+          ConcurrencyDisallowed -> unless (Set.null inAction) retry
+        let as' = xs ++ ys
+            remaining = Set.union
+              (Set.fromList $ map actionId as')
+              inAction
+        writeTVar esActions as'
+        modifyTVar esInAction (Set.insert $ actionId action)
+        pure $ mask $ \restore -> do
+          eres <- try $ restore $ actionDo action ActionContext
+            { acRemaining = remaining
+            , acDownstream = downstreamActions (actionId action) as'
+            , acConcurrency = actionConcurrency action
+            }
+          atomically $ do
+            modifyTVar esInAction (Set.delete $ actionId action)
+            modifyTVar esCompleted (+1)
+            case eres of
+              Left err -> modifyTVar esExceptions (err:)
+              Right () ->
+                let dropDep a =
+                      a { actionDeps = Set.delete (actionId action) $ actionDeps a }
+                in  modifyTVar esActions $ map dropDep
+          restore loop
 
 downstreamActions :: ActionId -> [Action] -> [Action]
 downstreamActions aid = filter (\a -> aid `Set.member` actionDeps a)
src/Data/Attoparsec/Args.hs view
@@ -2,24 +2,23 @@ {-# LANGUAGE OverloadedStrings #-}
 
 -- | Parsing of Stack command line arguments
-
 module Data.Attoparsec.Args
-    ( EscapingMode (..)
-    , argsParser
-    , parseArgs
-    , parseArgsFromString
-    ) where
+  ( EscapingMode (..)
+  , argsParser
+  , parseArgs
+  , parseArgsFromString
+  ) where
 
-import           Data.Attoparsec.Text ((<?>))
+import           Data.Attoparsec.Text ( (<?>) )
 import qualified Data.Attoparsec.Text as P
 import qualified Data.Text as T
 import           Stack.Prelude
 
 -- | Mode for parsing escape characters.
 data EscapingMode
-    = Escaping
-    | NoEscaping
-    deriving (Show,Eq,Enum)
+  = Escaping
+  | NoEscaping
+  deriving (Enum, Eq, Show)
 
 -- | Parse arguments using 'argsParser'.
 parseArgs :: EscapingMode -> Text -> Either String [String]
@@ -34,13 +33,13 @@ argsParser :: EscapingMode -> P.Parser [String]
 argsParser mode = many (P.skipSpace *> (quoted <|> unquoted)) <*
                   P.skipSpace <* (P.endOfInput <?> "unterminated string")
-  where
-    unquoted = P.many1 naked
-    quoted = P.char '"' *> str <* P.char '"'
-    str = many ( case mode of
-                     Escaping -> escaped <|> nonquote
-                     NoEscaping -> nonquote
-               )
-    escaped = P.char '\\' *> P.anyChar
-    nonquote = P.satisfy (/= '"')
-    naked = P.satisfy (not . flip elem ("\" " :: String))
+ where
+  unquoted = P.many1 naked
+  quoted = P.char '"' *> str <* P.char '"'
+  str = many ( case mode of
+                 Escaping -> escaped <|> nonquote
+                 NoEscaping -> nonquote
+             )
+  escaped = P.char '\\' *> P.anyChar
+  nonquote = P.satisfy (/= '"')
+  naked = P.satisfy (not . flip elem ("\" " :: String))
src/Data/Attoparsec/Combinators.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | More readable combinators for writing parsers.
-
 module Data.Attoparsec.Combinators
   ( alternating
   , appending
@@ -12,19 +11,21 @@ import           Stack.Prelude
 
 -- | Concatenate two parsers.
-appending :: (Applicative f,Semigroup a)
-                 => f a -> f a -> f a
+appending ::
+     (Applicative f, Semigroup a)
+  => f a
+  -> f a
+  -> f a
 appending a b = (<>) <$> a <*> b
 
 -- | Alternative parsers.
-alternating :: Alternative f
-            => f a -> f a -> f a
+alternating :: Alternative f => f a -> f a -> f a
 alternating a b = a <|> b
 
 -- | Pure something.
-pured :: (Applicative g,Applicative f) => g a -> g (f a)
+pured :: (Applicative g, Applicative f) => g a -> g (f a)
 pured = fmap pure
 
 -- | Concating the result of an action.
-concating :: (Monoid m,Applicative f) => f [m] -> f m
+concating :: (Monoid m, Applicative f) => f [m] -> f m
 concating = fmap mconcat
src/Data/Attoparsec/Interpreter.hs view
@@ -48,63 +48,63 @@ 
   Nested block comments are not supported.
 -}
-
 module Data.Attoparsec.Interpreter
-    ( interpreterArgsParser -- for unit tests
-    , getInterpreterArgs
-    ) where
+  ( interpreterArgsParser -- for unit tests
+  , getInterpreterArgs
+  ) where
 
-import           Data.Attoparsec.Args
-import           Data.Attoparsec.Text ((<?>))
+import           Data.Attoparsec.Args ( EscapingMode (..), argsParser )
+import           Data.Attoparsec.Text ( (<?>) )
 import qualified Data.Attoparsec.Text as P
-import           Data.Char (isSpace)
-import           Conduit
-import           Data.Conduit.Attoparsec
-import           Data.List (intercalate)
-import           Data.Text (pack)
+import           Data.Char ( isSpace )
+import           Conduit ( decodeUtf8C, withSourceFile )
+import           Data.Conduit.Attoparsec ( ParseError (..), Position (..), sinkParserEither )
+import           Data.List ( intercalate )
+import           Data.Text ( pack )
+import           Stack.Constants ( stackProgName )
 import           Stack.Prelude
-import           System.FilePath (takeExtension)
-import           System.IO (hPutStrLn)
+import           System.FilePath ( takeExtension )
+import           System.IO ( hPutStrLn )
 
 -- | Parser to extract the Stack command line embedded inside a comment
 -- after validating the placement and formatting rules for a valid
 -- interpreter specification.
 interpreterArgsParser :: Bool -> String -> P.Parser String
 interpreterArgsParser isLiterate progName = P.option "" sheBangLine *> interpreterComment
-  where
-    sheBangLine =   P.string "#!"
-                 *> P.manyTill P.anyChar P.endOfLine
+ where
+  sheBangLine =   P.string "#!"
+               *> P.manyTill P.anyChar P.endOfLine
 
-    commentStart psr =   (psr <?> (progName ++ " options comment"))
-                      *> P.skipSpace
-                      *> (P.string (pack progName) <?> show progName)
+  commentStart psr =   (psr <?> (progName ++ " options comment"))
+                    *> P.skipSpace
+                    *> (P.string (pack progName) <?> show progName)
 
-    -- Treat newlines as spaces inside the block comment
-    anyCharNormalizeSpace = let normalizeSpace c = if isSpace c then ' ' else c
-                            in P.satisfyWith normalizeSpace $ const True
+  -- Treat newlines as spaces inside the block comment
+  anyCharNormalizeSpace = let normalizeSpace c = if isSpace c then ' ' else c
+                            in  P.satisfyWith normalizeSpace $ const True
 
-    comment start end = commentStart start
-      *> ((end >> pure "")
-          <|> (P.space *> (P.manyTill anyCharNormalizeSpace end <?> "-}")))
+  comment start end = commentStart start
+    *> ((end >> pure "")
+        <|> (P.space *> (P.manyTill anyCharNormalizeSpace end <?> "-}")))
 
-    horizontalSpace = P.satisfy P.isHorizontalSpace
+  horizontalSpace = P.satisfy P.isHorizontalSpace
 
-    lineComment =  comment "--" (P.endOfLine <|> P.endOfInput)
-    literateLineComment = comment
-      (">" *> horizontalSpace *> "--")
-      (P.endOfLine <|> P.endOfInput)
-    blockComment = comment "{-" (P.string "-}")
+  lineComment =  comment "--" (P.endOfLine <|> P.endOfInput)
+  literateLineComment = comment
+    (">" *> horizontalSpace *> "--")
+    (P.endOfLine <|> P.endOfInput)
+  blockComment = comment "{-" (P.string "-}")
 
-    literateBlockComment =
-      (">" *> horizontalSpace *> "{-")
-      *> P.skipMany (("" <$ horizontalSpace) <|> (P.endOfLine *> ">"))
-      *> (P.string (pack progName) <?> progName)
-      *> P.manyTill' (P.satisfy (not . P.isEndOfLine)
-                       <|> (' ' <$ (P.endOfLine *> ">" <?> ">"))) "-}"
+  literateBlockComment =
+    (">" *> horizontalSpace *> "{-")
+    *> P.skipMany (("" <$ horizontalSpace) <|> (P.endOfLine *> ">"))
+    *> (P.string (pack progName) <?> progName)
+    *> P.manyTill' (P.satisfy (not . P.isEndOfLine)
+                     <|> (' ' <$ (P.endOfLine *> ">" <?> ">"))) "-}"
 
-    interpreterComment = if isLiterate
-                            then literateLineComment <|> literateBlockComment
-                            else lineComment <|> blockComment
+  interpreterComment = if isLiterate
+                         then literateLineComment <|> literateBlockComment
+                         else lineComment <|> blockComment
 
 -- | Extract Stack arguments from a correctly placed and correctly formatted
 -- comment when it is being used as an interpreter
@@ -114,40 +114,40 @@   case eArgStr of
     Left err -> handleFailure $ decodeError err
     Right str -> parseArgStr str
-  where
-    parseFile src =
-         runConduit
-       $ src
-      .| decodeUtf8C
-      .| sinkParserEither (interpreterArgsParser isLiterate stackProgName)
+ where
+  parseFile src =
+       runConduit
+     $ src
+    .| decodeUtf8C
+    .| sinkParserEither (interpreterArgsParser isLiterate stackProgName)
 
-    isLiterate = takeExtension file == ".lhs"
+  isLiterate = takeExtension file == ".lhs"
 
-    -- FIXME We should print anything only when explicit verbose mode is
-    -- specified by the user on command line. But currently the
-    -- implementation does not accept or parse any command line flags in
-    -- interpreter mode. We can only invoke the interpreter as
-    -- "stack <file name>" strictly without any options.
-    stackWarn s = hPutStrLn stderr $ stackProgName ++ ": WARNING! " ++ s
+  -- FIXME We should print anything only when explicit verbose mode is
+  -- specified by the user on command line. But currently the
+  -- implementation does not accept or parse any command line flags in
+  -- interpreter mode. We can only invoke the interpreter as
+  -- "stack <file name>" strictly without any options.
+  stackWarn s = hPutStrLn stderr $ stackProgName ++ ": WARNING! " ++ s
 
-    handleFailure err = do
-      mapM_ stackWarn (lines err)
-      stackWarn "Missing or unusable Stack options specification"
-      stackWarn "Using runghc without any additional Stack options"
-      pure ["runghc"]
+  handleFailure err = do
+    mapM_ stackWarn (lines err)
+    stackWarn "Missing or unusable Stack options specification"
+    stackWarn "Using runghc without any additional Stack options"
+    pure ["runghc"]
 
-    parseArgStr str =
-      case P.parseOnly (argsParser Escaping) (pack str) of
-        Left err -> handleFailure ("Error parsing command specified in the "
-                        ++ "Stack options comment: " ++ err)
-        Right [] -> handleFailure "Empty argument list in Stack options comment"
-        Right args -> pure args
+  parseArgStr str =
+    case P.parseOnly (argsParser Escaping) (pack str) of
+      Left err -> handleFailure ("Error parsing command specified in the "
+                      ++ "Stack options comment: " ++ err)
+      Right [] -> handleFailure "Empty argument list in Stack options comment"
+      Right args -> pure args
 
-    decodeError e =
-      case e of
-        ParseError ctxs _ (Position l col _) ->
-          if null ctxs
-          then "Parse error"
-          else ("Expecting " ++ intercalate " or " ctxs)
-          ++ " at line " ++ show l ++ ", column " ++ show col
-        DivergentParser -> "Divergent parser"
+  decodeError e =
+    case e of
+      ParseError ctxs _ (Position l col _) ->
+        if null ctxs
+        then "Parse error"
+        else ("Expecting " ++ intercalate " or " ctxs)
+        ++ " at line " ++ show l ++ ", column " ++ show col
+      DivergentParser -> "Divergent parser"
src/Data/Monoid/Map.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
 module Data.Monoid.Map
   ( MonoidMap (..)
   ) where
@@ -10,7 +7,8 @@ 
 -- | Utility newtype wrapper to make Map's Monoid also use the
 -- element's Monoid.
-newtype MonoidMap k a = MonoidMap (Map k a)
+newtype MonoidMap k a
+  = MonoidMap (Map k a)
   deriving (Eq, Functor, Generic, Ord, Read, Show)
 
 instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where
src/Network/HTTP/StackClient.hs view
@@ -5,7 +5,6 @@ -- |
 -- Wrapper functions of 'Network.HTTP.Simple' and 'Network.HTTP.Client' to
 -- add the 'User-Agent' HTTP request header to each request.
-
 module Network.HTTP.StackClient
   ( httpJSON
   , httpLbs
@@ -92,11 +91,12 @@                    , setRequestCheckStatus, setRequestHeader, setRequestMethod
                    )
 import qualified Network.HTTP.Simple
+                   ( httpJSON, httpLbs, httpNoBody, httpSink, withResponse )
 import           Network.HTTP.Types
                    ( hAccept, hContentLength, hContentMD5, methodPut
                    , notFound404
                    )
-import           Path
+import           Path ( Abs, File, Path )
 import           Prelude ( until, (!!) )
 import           RIO
 import           RIO.PrettyPrint ( HasTerm )
@@ -118,17 +118,19 @@ httpNoBody = Network.HTTP.Simple.httpNoBody . setUserAgent
 
 
-httpSink
-  :: MonadUnliftIO m
+httpSink ::
+     MonadUnliftIO m
   => Request
   -> (Response () -> ConduitM Strict.ByteString Void m a)
   -> m a
 httpSink = Network.HTTP.Simple.httpSink . setUserAgent
 
 
-withResponse
-  :: (MonadUnliftIO m, MonadIO n)
-  => Request -> (Response (ConduitM i Strict.ByteString n ()) -> m a) -> m a
+withResponse ::
+     (MonadUnliftIO m, MonadIO n)
+  => Request
+  -> (Response (ConduitM i Strict.ByteString n ()) -> m a)
+  -> m a
 withResponse = Network.HTTP.Simple.withResponse . setUserAgent
 
 -- | Set the user-agent request header
@@ -145,7 +147,7 @@          => Request
          -> Path Abs File -- ^ destination
          -> RIO env Bool -- ^ Was a downloaded performed (True) or did the file already exist (False)?
-download req dest = Download.download (setUserAgent req) dest
+download req = Download.download (setUserAgent req)
 
 -- | Same as 'download', but will download a file a second time if it is already present.
 --
@@ -154,7 +156,7 @@            => Request
            -> Path Abs File -- ^ destination
            -> RIO env Bool
-redownload req dest = Download.redownload (setUserAgent req) dest
+redownload req = Download.redownload (setUserAgent req)
 
 -- | Copied and extended version of Network.HTTP.Download.download.
 --
@@ -169,30 +171,29 @@ -- Throws VerifiedDownloadException.
 -- Throws IOExceptions related to file system operations.
 -- Throws HttpException.
-verifiedDownload
-         :: HasTerm env
-         => DownloadRequest
-         -> Path Abs File -- ^ destination
-         -> (Maybe Integer -> ConduitM ByteString Void (RIO env) ()) -- ^ custom hook to observe progress
-         -> RIO env Bool -- ^ Whether a download was performed
-verifiedDownload dr destpath progressSink =
-    Download.verifiedDownload dr' destpath progressSink
-  where
-    dr' = modifyRequest setUserAgent dr
+verifiedDownload ::
+     HasTerm env
+  => DownloadRequest
+  -> Path Abs File -- ^ destination
+  -> (Maybe Integer -> ConduitM ByteString Void (RIO env) ())
+     -- ^ custom hook to observe progress
+  -> RIO env Bool -- ^ Whether a download was performed
+verifiedDownload dr = Download.verifiedDownload dr'
+ where
+  dr' = modifyRequest setUserAgent dr
 
-verifiedDownloadWithProgress
-  :: HasTerm env
+verifiedDownloadWithProgress ::
+     HasTerm env
   => DownloadRequest
   -> Path Abs File
   -> Text
   -> Maybe Int
   -> RIO env Bool
 verifiedDownloadWithProgress req destpath lbl msize =
-    verifiedDownload req destpath (chattyDownloadProgress lbl msize)
-
+  verifiedDownload req destpath (chattyDownloadProgress lbl msize)
 
-chattyDownloadProgress
-  :: ( HasLogFunc env
+chattyDownloadProgress ::
+     ( HasLogFunc env
      , MonadIO m
      , MonadReader env m
      )
@@ -201,35 +202,38 @@   -> f
   -> ConduitT ByteString c m ()
 chattyDownloadProgress label mtotalSize _ = do
-    _ <- logSticky $ RIO.display label <> ": download has begun"
-    CL.map (Sum . Strict.length)
-      .| chunksOverTime 1
-      .| go
-  where
-    go = evalStateC 0 $ awaitForever $ \(Sum size) -> do
-        modify (+ size)
-        totalSoFar <- get
-        logSticky $ fromString $
-            case mtotalSize of
-                Nothing -> chattyProgressNoTotal totalSoFar
-                Just 0 -> chattyProgressNoTotal totalSoFar
-                Just totalSize -> chattyProgressWithTotal totalSoFar totalSize
+  _ <- logSticky $ RIO.display label <> ": download has begun"
+  CL.map (Sum . Strict.length)
+    .| chunksOverTime 1
+    .| go
+ where
+  go = evalStateC 0 $ awaitForever $ \(Sum size) -> do
+    modify (+ size)
+    totalSoFar <- get
+    logSticky $ fromString $
+      case mtotalSize of
+        Nothing -> chattyProgressNoTotal totalSoFar
+        Just 0 -> chattyProgressNoTotal totalSoFar
+        Just totalSize -> chattyProgressWithTotal totalSoFar totalSize
 
-    -- Example: ghc: 42.13 KiB downloaded...
-    chattyProgressNoTotal totalSoFar =
-        printf ("%s: " <> bytesfmt "%7.2f" totalSoFar <> " downloaded...")
-                (T.unpack label)
+  -- Example: ghc: 42.13 KiB downloaded...
+  chattyProgressNoTotal totalSoFar =
+    printf ("%s: " <> bytesfmt "%7.2f" totalSoFar <> " downloaded...")
+           (T.unpack label)
 
     -- Example: ghc: 50.00 MiB / 100.00 MiB (50.00%) downloaded...
-    chattyProgressWithTotal totalSoFar total =
-      printf ("%s: " <>
-              bytesfmt "%7.2f" totalSoFar <> " / " <>
-              bytesfmt "%.2f" total <>
-              " (%6.2f%%) downloaded...")
-              (T.unpack label)
-              percentage
-      where percentage :: Double
-            percentage = fromIntegral totalSoFar / fromIntegral total * 100
+  chattyProgressWithTotal totalSoFar total =
+    printf (  "%s: "
+           <> bytesfmt "%7.2f" totalSoFar
+           <> " / "
+           <> bytesfmt "%.2f" total
+           <> " (%6.2f%%) downloaded..."
+           )
+           (T.unpack label)
+           percentage
+   where
+    percentage :: Double
+    percentage = fromIntegral totalSoFar / fromIntegral total * 100
 
 -- | Given a printf format string for the decimal part and a number of
 -- bytes, formats the bytes using an appropriate unit and returns the
@@ -241,35 +245,39 @@ bytesfmt formatter bs = printf (formatter <> " %s")
                                (fromIntegral (signum bs) * dec :: Double)
                                (bytesSuffixes !! i)
-  where
-    (dec,i) = getSuffix (abs bs)
-    getSuffix n = until p (\(x,y) -> (x / 1024, y+1)) (fromIntegral n,0)
-      where p (n',numDivs) = n' < 1024 || numDivs == (length bytesSuffixes - 1)
-    bytesSuffixes :: [String]
-    bytesSuffixes = ["B","KiB","MiB","GiB","TiB","PiB","EiB","ZiB","YiB"]
+ where
+  (dec,i) = getSuffix (abs bs)
+  getSuffix n = until p (\(x,y) -> (x / 1024, y+1)) (fromIntegral n,0)
+   where
+    p (n',numDivs) = n' < 1024 || numDivs == length bytesSuffixes - 1
+  bytesSuffixes :: [String]
+  bytesSuffixes = ["B", "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB"]
 
 -- Await eagerly (collect with monoidal append),
 -- but space out yields by at least the given amount of time.
 -- The final yield may come sooner, and may be a superfluous mempty.
 -- Note that Integer and Float literals can be turned into NominalDiffTime
 -- (these literals are interpreted as "seconds")
-chunksOverTime :: (Monoid a, Semigroup a, MonadIO m) => NominalDiffTime -> ConduitM a a m ()
+chunksOverTime ::
+     (Monoid a, Semigroup a, MonadIO m)
+  => NominalDiffTime
+  -> ConduitM a a m ()
 chunksOverTime diff = do
-    currentTime <- liftIO getCurrentTime
-    evalStateC (currentTime, mempty) go
-  where
-    -- State is a tuple of:
-    -- * the last time a yield happened (or the beginning of the sink)
-    -- * the accumulated awaits since the last yield
-    go = await >>= \case
-      Nothing -> do
-        (_, acc) <- get
-        yield acc
-      Just a -> do
-        (lastTime, acc) <- get
-        let acc' = acc <> a
-        currentTime <- liftIO getCurrentTime
-        if diff < diffUTCTime currentTime lastTime
-          then put (currentTime, mempty) >> yield acc'
-          else put (lastTime,    acc')
-        go
+  currentTime <- liftIO getCurrentTime
+  evalStateC (currentTime, mempty) go
+ where
+  -- State is a tuple of:
+  -- * the last time a yield happened (or the beginning of the sink)
+  -- * the accumulated awaits since the last yield
+  go = await >>= \case
+    Nothing -> do
+      (_, acc) <- get
+      yield acc
+    Just a -> do
+      (lastTime, acc) <- get
+      let acc' = acc <> a
+      currentTime <- liftIO getCurrentTime
+      if diff < diffUTCTime currentTime lastTime
+        then put (currentTime, mempty) >> yield acc'
+        else put (lastTime,    acc')
+      go
src/Options/Applicative/Builder/Extra.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Extra functions for optparse-applicative.
 
@@ -152,25 +151,24 @@   -> Parser a
 enableDisableFlagsNoDefault enabledValue disabledValue name helpSuffix mods =
   last <$> some
-    (   (   flag'
-              enabledValue
-              (  hidden
-              <> internal
-              <> long name
-              <> help helpSuffix
-              <> mods
-              )
-        <|> flag'
-              disabledValue
-              (  hidden
-              <> internal
-              <> long ("no-" ++ name)
-              <> help helpSuffix
-              <> mods
-              )
-        )
+    (   flag'
+          enabledValue
+          (  hidden
+          <> internal
+          <> long name
+          <> help helpSuffix
+          <> mods
+          )
     <|> flag'
           disabledValue
+          (  hidden
+          <> internal
+          <> long ("no-" ++ name)
+          <> help helpSuffix
+          <> mods
+          )
+    <|> flag'
+          disabledValue
           (  long ("[no-]" ++ name)
           <> help ("Enable/disable " ++ helpSuffix)
           <> mods
@@ -209,7 +207,7 @@     , takeBaseName progName
     , " --"
     , helpName
-    , "' for details"
+    , "' for details."
     ]
 
 -- | Display extra help if extra help option passed in arguments.
@@ -346,30 +344,33 @@       | input == "" && pcoAbsolute -> pure ["/"]
       | otherwise -> pure []
     Just searchDir -> do
-      entries <- getDirectoryContents searchDir `catch` \(_ :: IOException) -> pure []
+      entries <-
+        getDirectoryContents searchDir `catch` \(_ :: IOException) -> pure []
       fmap catMaybes $ forM entries $ \entry ->
         -- Skip . and .. unless user is typing . or ..
-        if entry `elem` ["..", "."] && searchPrefix `notElem` ["..", "."] then pure Nothing else
-          if searchPrefix `isPrefixOf` entry
-            then do
-              let path = searchDir </> entry
-              case (pcoFileFilter path, pcoDirFilter path) of
-                (True, True) -> pure $ Just (inputSearchDir </> entry)
-                (fileAllowed, dirAllowed) -> do
-                  isDir <- doesDirectoryExist path
-                  if (if isDir then dirAllowed else fileAllowed)
-                    then pure $ Just (inputSearchDir </> entry)
-                    else pure Nothing
-            else pure Nothing
+        if entry `elem` ["..", "."] && searchPrefix `notElem` ["..", "."]
+          then pure Nothing
+          else
+            if searchPrefix `isPrefixOf` entry
+              then do
+                let path = searchDir </> entry
+                case (pcoFileFilter path, pcoDirFilter path) of
+                  (True, True) -> pure $ Just (inputSearchDir </> entry)
+                  (fileAllowed, dirAllowed) -> do
+                    isDir <- doesDirectoryExist path
+                    if (if isDir then dirAllowed else fileAllowed)
+                      then pure $ Just (inputSearchDir </> entry)
+                      else pure Nothing
+              else pure Nothing
 
 unescapeBashArg :: String -> String
 unescapeBashArg ('\'' : rest) = rest
 unescapeBashArg ('\"' : rest) = go rest
  where
-  pattern = "$`\"\\\n" :: String
+  special = "$`\"\\\n" :: String
   go [] = []
   go ('\\' : x : xs)
-    | x `elem` pattern = x : xs
+    | x `elem` special = x : xs
     | otherwise = '\\' : x : go xs
   go (x : xs) = x : go xs
 unescapeBashArg input = go input
src/Options/Applicative/Complicated.hs view
@@ -29,34 +29,36 @@                    ( Mod (..), mkCommand, mkParser )
 import           Options.Applicative.Types ( OptReader (..) )
 import           Stack.Prelude
-import           Stack.Types.Config ( AddCommand, GlobalOptsMonoid, Runner )
+import           Stack.Types.AddCommand ( AddCommand )
+import           Stack.Types.GlobalOptsMonoid ( GlobalOptsMonoid )
+import           Stack.Types.Runner ( Runner )
 import           System.Environment ( getArgs )
 
 -- | Generate and execute a complicated options parser.
 complicatedOptions ::
      Version
-  -- ^ numeric version
+     -- ^ numeric version
   -> Maybe String
-  -- ^ version string
+     -- ^ version string
   -> String
-  -- ^ Hpack numeric version, as string
+     -- ^ Hpack numeric version, as string
   -> String
-  -- ^ header
+     -- ^ header
   -> String
-  -- ^ program description (displayed between usage and options listing in the
-  -- help output)
+     -- ^ program description (displayed between usage and options listing in
+     -- the help output)
   -> String
-  -- ^ footer
+     -- ^ footer
   -> Parser GlobalOptsMonoid
-  -- ^ common settings
+     -- ^ common settings
   -> Maybe (  ParserFailure ParserHelp
            -> [String]
            -> IO (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
            )
-  -- ^ optional handler for parser failure; 'handleParseResult' is called by
-  -- default
+     -- ^ optional handler for parser failure; 'handleParseResult' is called by
+     -- default
   -> AddCommand
-  -- ^ commands (use 'addCommand')
+     -- ^ commands (use 'addCommand')
   -> IO (GlobalOptsMonoid, RIO Runner ())
 complicatedOptions numericVersion stringVersion numericHpackVersion h pd
   footerStr commonParser mOnFailure commandParser = do
@@ -86,19 +88,19 @@     infoOption
       s
       (  long "version"
-      <> help "Show version"
+      <> help "Show version."
       )
   numericVersionOption =
     infoOption
       (versionString numericVersion)
       (  long "numeric-version"
-      <> help "Show only version number"
+      <> help "Show only version number."
       )
   numericHpackVersionOption =
     infoOption
       numericHpackVersion
       (  long "hpack-numeric-version"
-      <> help "Show only Hpack's version number"
+      <> help "Show only Hpack's version number."
       )
 
 -- | Add a command to the options dispatcher.
@@ -119,15 +121,15 @@ -- | Add a command that takes sub-commands to the options dispatcher.
 addSubCommands ::
      String
-  -- ^ command string
+     -- ^ command string
   -> String
-  -- ^ title of command
+     -- ^ title of command
   -> String
-  -- ^ footer of command help
+     -- ^ footer of command help
   -> Parser GlobalOptsMonoid
-  -- ^ common parser
+     -- ^ common parser
   -> AddCommand
-  -- ^ sub-commands (use 'addCommand')
+     -- ^ sub-commands (use 'addCommand')
   -> AddCommand
 addSubCommands cmd title footerStr commonParser commandParser =
   addCommand'
@@ -160,11 +162,11 @@ -- | Generate a complicated options parser.
 complicatedParser ::
      String
-  -- ^ metavar for the sub-command
+     -- ^ metavar for the sub-command
   -> Parser GlobalOptsMonoid
-  -- ^ common settings
+     -- ^ common settings
   -> AddCommand
-  -- ^ commands (use 'addCommand')
+     -- ^ commands (use 'addCommand')
   -> Parser (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
 complicatedParser commandMetavar commonParser commandParser =
   (,)
@@ -189,4 +191,4 @@ helpOption =
   abortOption showHelpText $
        long "help"
-    <> help "Show this help text"
+    <> help "Show this help text."
src/Path/CheckInstall.hs view
@@ -1,33 +1,37 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Path.CheckInstall
   ( warnInstallSearchPathIssues
   ) where
 
-import           Control.Monad.Extra ( anyM, (&&^) )
+import           Control.Monad.Extra ( (&&^), anyM )
 import qualified Data.Text as T
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.Config ( HasConfig )
 import qualified System.Directory as D
 import qualified System.FilePath as FP
 
--- | Checks if the installed executable will be available on the user's
--- PATH. This doesn't use @envSearchPath menv@ because it includes paths
--- only visible when running in the Stack environment.
+-- | Checks if the installed executable will be available on the user's PATH.
+-- This doesn't use @envSearchPath menv@ because it includes paths only visible
+-- when running in the Stack environment.
 warnInstallSearchPathIssues :: HasConfig env => FilePath -> [Text] -> RIO env ()
 warnInstallSearchPathIssues destDir installed = do
   searchPath <- liftIO FP.getSearchPath
   destDirIsInPATH <- liftIO $
-    anyM (\dir -> D.doesDirectoryExist dir &&^ fmap (FP.equalFilePath destDir) (D.canonicalizePath dir)) searchPath
+    anyM
+      ( \dir ->     D.doesDirectoryExist dir
+                &&^ fmap (FP.equalFilePath destDir) (D.canonicalizePath dir)
+      )
+      searchPath
   if destDirIsInPATH
     then forM_ installed $ \exe -> do
       mexePath <- (liftIO . D.findExecutable . T.unpack) exe
       case mexePath of
         Just exePath -> do
-          exeDir <- (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
-          unless (exeDir `FP.equalFilePath` destDir) $ do
+          exeDir <-
+            (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
+          unless (exeDir `FP.equalFilePath` destDir) $
             prettyWarnL
               [ flow "The"
               , style File . fromString . T.unpack $ exe
@@ -38,15 +42,16 @@               , style File . fromString . T.unpack $ exe
               , "calls on the command line will not use this version."
               ]
-        Nothing -> do
+        Nothing ->
           prettyWarnL
             [ flow "Installation path"
             , style Dir . fromString $ destDir
             , flow "is on the PATH but the"
             , style File . fromString . T.unpack $ exe
-            , flow "executable that was just installed could not be found on the PATH."
+            , flow "executable that was just installed could not be found on \
+                   \the PATH."
             ]
-    else do
+    else
       prettyWarnL
         [ flow "Installation path "
         , style Dir . fromString $ destDir
src/Path/Extended.hs view
@@ -1,23 +1,25 @@ module Path.Extended
- ( fileExtension
- , addExtension
- , replaceExtension
- ) where
+  ( fileExtension
+  , addExtension
+  , replaceExtension
+  ) where
 
-import           Control.Monad.Catch
-import qualified Path
-import           Path (Path, File)
+import           Control.Monad.Catch ( MonadThrow )
+import qualified Path ( addExtension, fileExtension, replaceExtension )
+import           Path ( File, Path )
 
 fileExtension :: MonadThrow m => Path b File -> m String
 fileExtension = Path.fileExtension
 
-addExtension :: MonadThrow m
+addExtension ::
+     MonadThrow m
   => String
   -> Path b File
   -> m (Path b File)
 addExtension = Path.addExtension
 
-replaceExtension :: MonadThrow m
+replaceExtension ::
+     MonadThrow m
   => String
   -> Path b File
   -> m (Path b File)
src/Path/Extra.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE ViewPatterns      #-}
 
 -- | Extra Path utilities.
-
 module Path.Extra
   ( toFilePathNoTrailingSep
   , dropRoot
@@ -15,18 +14,28 @@   , pathToLazyByteString
   , pathToText
   , tryGetModificationTime
+  , forgivingResolveDir
+  , forgivingResolveFile
+  , forgivingResolveFile'
   ) where
 
 import           Data.Time ( UTCTime )
 import           Path
+                   ( Abs, Dir, File, PathException (..), Rel, parseAbsDir
+                   , parseAbsFile, toFilePath
+                   )
+import           Path.Internal ( Path (Path) )
 import           Path.IO
-import           Path.Internal ( Path (..) )
+                   ( doesDirExist, doesFileExist, getCurrentDir
+                   , getModificationTime
+                   )
 import           RIO
 import           System.IO.Error ( isDoesNotExistError )
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified System.Directory as D
 import qualified System.FilePath as FP
 
 -- | Convert to FilePath but don't add a trailing slash.
@@ -48,8 +57,13 @@ -- | Add a relative FilePath to the end of a Path
 -- We can't parse the FilePath first because we need to account for ".."
 -- in the FilePath (#2895)
-concatAndCollapseAbsDir :: MonadThrow m => Path Abs Dir -> FilePath -> m (Path Abs Dir)
-concatAndCollapseAbsDir base rel = parseCollapsedAbsDir (toFilePath base FP.</> rel)
+concatAndCollapseAbsDir ::
+     MonadThrow m
+  => Path Abs Dir
+  -> FilePath
+  -> m (Path Abs Dir)
+concatAndCollapseAbsDir base rel =
+  parseCollapsedAbsDir (toFilePath base FP.</> rel)
 
 -- | Collapse intermediate "." and ".." directories from a path.
 --
@@ -64,16 +78,16 @@ -- (adapted from @Text.Pandoc.Shared@)
 collapseFilePath :: FilePath -> FilePath
 collapseFilePath = FP.joinPath . reverse . foldl' go [] . FP.splitDirectories
-  where
-    go rs "." = rs
-    go r@(p:rs) ".." = case p of
-                            ".." -> "..":r
-                            (checkPathSeparator -> True) -> "..":r
-                            _ -> rs
-    go _ (checkPathSeparator -> True) = [[FP.pathSeparator]]
-    go rs x = x:rs
-    checkPathSeparator [x] = FP.isPathSeparator x
-    checkPathSeparator _ = False
+ where
+  go rs "." = rs
+  go r@(p:rs) ".." = case p of
+                          ".." -> "..":r
+                          (checkPathSeparator -> True) -> "..":r
+                          _ -> rs
+  go _ (checkPathSeparator -> True) = [[FP.pathSeparator]]
+  go rs x = x:rs
+  checkPathSeparator [x] = FP.isPathSeparator x
+  checkPathSeparator _ = False
 
 -- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on
 -- Windows).
@@ -94,19 +108,21 @@ --
 -- > forgivingAbsence (resolveFile …) >>= rejectMissingFile
 
-rejectMissingFile :: MonadIO m
+rejectMissingFile ::
+     MonadIO m
   => Maybe (Path Abs File)
   -> m (Maybe (Path Abs File))
 rejectMissingFile Nothing = pure Nothing
-rejectMissingFile (Just p) = bool Nothing (Just p) `liftM` doesFileExist p
+rejectMissingFile (Just p) = bool Nothing (Just p) <$> doesFileExist p
 
 -- | See 'rejectMissingFile'.
 
-rejectMissingDir :: MonadIO m
+rejectMissingDir ::
+     MonadIO m
   => Maybe (Path Abs Dir)
   -> m (Maybe (Path Abs Dir))
 rejectMissingDir Nothing = pure Nothing
-rejectMissingDir (Just p) = bool Nothing (Just p) `liftM` doesDirExist p
+rejectMissingDir (Just p) = bool Nothing (Just p) <$> doesDirExist p
 
 -- | Convert to a lazy ByteString using toFilePath and UTF8.
 pathToLazyByteString :: Path b t -> BSL.ByteString
@@ -120,4 +136,50 @@ pathToText = T.pack . toFilePath
 
 tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)
-tryGetModificationTime = liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime
+tryGetModificationTime =
+  liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime
+
+-- | 'Path.IO.resolveDir' (@path-io@ package) throws 'InvalidAbsDir' (@path@
+-- package) if the directory does not exist; this function yields 'Nothing'.
+forgivingResolveDir ::
+     MonadIO m
+  => Path Abs Dir
+     -- ^ Base directory
+  -> FilePath
+     -- ^ Path to resolve
+  -> m (Maybe (Path Abs Dir))
+forgivingResolveDir b p = liftIO $
+  D.canonicalizePath (toFilePath b FP.</> p) >>= \cp ->
+    catch
+      (Just <$> parseAbsDir cp)
+      ( \e -> case e of
+          InvalidAbsDir _ -> pure Nothing
+          _ -> throwIO e
+      )
+
+-- | 'Path.IO.resolveFile' (@path-io@ package) throws 'InvalidAbsFile' (@path@
+-- package) if the file does not exist; this function yields 'Nothing'.
+forgivingResolveFile ::
+     MonadIO m
+  => Path Abs Dir
+     -- ^ Base directory
+  -> FilePath
+     -- ^ Path to resolve
+  -> m (Maybe (Path Abs File))
+forgivingResolveFile b p = liftIO $
+  D.canonicalizePath (toFilePath b FP.</> p) >>= \cp ->
+    catch
+      (Just <$> parseAbsFile cp)
+      ( \e -> case e of
+          InvalidAbsFile _ -> pure Nothing
+          _ -> throwIO e
+      )
+
+-- | 'Path.IO.resolveFile'' (@path-io@ package) throws 'InvalidAbsFile' (@path@
+-- package) if the file does not exist; this function yields 'Nothing'.
+forgivingResolveFile' ::
+     MonadIO m
+  => FilePath
+     -- ^ Path to resolve
+  -> m (Maybe (Path Abs File))
+forgivingResolveFile' p = getCurrentDir >>= flip forgivingResolveFile p
src/Path/Find.hs view
@@ -11,26 +11,26 @@   ) where
 
 import qualified Data.List as L
-import           Path
-import           Path.IO hiding (findFiles)
+import           Path ( Abs, Dir, File, Path, parent, toFilePath )
+import           Path.IO ( listDir )
 import           RIO
 import           System.IO.Error ( isPermissionError )
 import           System.PosixCompat.Files
                    ( getSymbolicLinkStatus, isSymbolicLink )
 
 -- | Find the location of a file matching the given predicate.
-findFileUp :: (MonadIO m,MonadThrow m)
-           => Path Abs Dir                -- ^ Start here.
-           -> (Path Abs File -> Bool)     -- ^ Predicate to match the file.
-           -> Maybe (Path Abs Dir)        -- ^ Do not ascend above this directory.
-           -> m (Maybe (Path Abs File))  -- ^ Absolute file path.
+findFileUp :: (MonadIO m, MonadThrow m)
+           => Path Abs Dir              -- ^ Start here.
+           -> (Path Abs File -> Bool)   -- ^ Predicate to match the file.
+           -> Maybe (Path Abs Dir)      -- ^ Do not ascend above this directory.
+           -> m (Maybe (Path Abs File)) -- ^ Absolute file path.
 findFileUp = findPathUp snd
 
 -- | Find the location of a directory matching the given predicate.
 findDirUp :: (MonadIO m,MonadThrow m)
-          => Path Abs Dir                -- ^ Start here.
-          -> (Path Abs Dir -> Bool)      -- ^ Predicate to match the directory.
-          -> Maybe (Path Abs Dir)        -- ^ Do not ascend above this directory.
+          => Path Abs Dir               -- ^ Start here.
+          -> (Path Abs Dir -> Bool)     -- ^ Predicate to match the directory.
+          -> Maybe (Path Abs Dir)       -- ^ Do not ascend above this directory.
           -> m (Maybe (Path Abs Dir))   -- ^ Absolute directory path.
 findDirUp = findPathUp fst
 
@@ -38,17 +38,21 @@ findPathUp :: (MonadIO m,MonadThrow m)
            => (([Path Abs Dir],[Path Abs File]) -> [Path Abs t])
               -- ^ Choose path type from pair.
-           -> Path Abs Dir                     -- ^ Start here.
-           -> (Path Abs t -> Bool)             -- ^ Predicate to match the path.
-           -> Maybe (Path Abs Dir)             -- ^ Do not ascend above this directory.
-           -> m (Maybe (Path Abs t))           -- ^ Absolute path.
-findPathUp pathType dir p upperBound =
-  do entries <- listDir dir
-     case L.find p (pathType entries) of
-       Just path -> pure (Just path)
-       Nothing | Just dir == upperBound -> pure Nothing
-               | parent dir == dir -> pure Nothing
-               | otherwise -> findPathUp pathType (parent dir) p upperBound
+           -> Path Abs Dir
+              -- ^ Start here.
+           -> (Path Abs t -> Bool)
+              -- ^ Predicate to match the path.
+           -> Maybe (Path Abs Dir)
+              -- ^ Do not ascend above this directory.
+           -> m (Maybe (Path Abs t))
+              -- ^ Absolute path.
+findPathUp pathType dir p upperBound = do
+  entries <- listDir dir
+  case L.find p (pathType entries) of
+    Just path -> pure (Just path)
+    Nothing | Just dir == upperBound -> pure Nothing
+            | parent dir == dir -> pure Nothing
+            | otherwise -> findPathUp pathType (parent dir) p upperBound
 
 -- | Find files matching predicate below a root directory.
 --
@@ -57,38 +61,45 @@ --
 -- TODO: write one of these that traverses symbolic links but
 -- efficiently ignores loops.
-findFiles :: Path Abs Dir            -- ^ Root directory to begin with.
-          -> (Path Abs File -> Bool) -- ^ Predicate to match files.
-          -> (Path Abs Dir -> Bool)  -- ^ Predicate for which directories to traverse.
-          -> IO [Path Abs File]      -- ^ List of matching files.
-findFiles dir p traversep =
-  do (dirs,files) <- catchJust (\ e -> if isPermissionError e
-                                         then Just ()
-                                         else Nothing)
-                               (listDir dir)
-                               (\ _ -> pure ([], []))
-     filteredFiles <- evaluate $ force (filter p files)
-     filteredDirs <- filterM (fmap not . isSymLink) dirs
-     subResults <-
-       forM filteredDirs
-            (\entry ->
-               if traversep entry
-                  then findFiles entry p traversep
-                  else pure [])
-     pure (concat (filteredFiles : subResults))
+findFiles :: Path Abs Dir
+             -- ^ Root directory to begin with.
+          -> (Path Abs File -> Bool)
+             -- ^ Predicate to match files.
+          -> (Path Abs Dir -> Bool)
+             -- ^ Predicate for which directories to traverse.
+          -> IO [Path Abs File]
+             -- ^ List of matching files.
+findFiles dir p traversep = do
+  (dirs,files) <- catchJust (\ e -> if isPermissionError e
+                                      then Just ()
+                                      else Nothing)
+                            (listDir dir)
+                            (\ _ -> pure ([], []))
+  filteredFiles <- evaluate $ force (filter p files)
+  filteredDirs <- filterM (fmap not . isSymLink) dirs
+  subResults <-
+    forM filteredDirs
+         (\entry ->
+            if traversep entry
+               then findFiles entry p traversep
+               else pure [])
+  pure (concat (filteredFiles : subResults))
 
 isSymLink :: Path Abs t -> IO Bool
 isSymLink = fmap isSymbolicLink . getSymbolicLinkStatus . toFilePath
 
 -- | @findInParents f path@ applies @f@ to @path@ and its 'parent's until
 -- it finds a 'Just' or reaches the root directory.
-findInParents :: MonadIO m => (Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a)
+findInParents ::
+     MonadIO m
+  => (Path Abs Dir -> m (Maybe a))
+  -> Path Abs Dir -> m (Maybe a)
 findInParents f path = do
-    mres <- f path
-    case mres of
-        Just res -> pure (Just res)
-        Nothing -> do
-            let next = parent path
-            if next == path
-                then pure Nothing
-                else findInParents f next
+  mres <- f path
+  case mres of
+    Just res -> pure (Just res)
+    Nothing -> do
+      let next = parent path
+      if next == path
+        then pure Nothing
+        else findInParents f next
src/Stack/Build.hs view
@@ -1,97 +1,121 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Build the project.
 
 module Stack.Build
-  ( build
+  ( buildCmd
+  , build
   , buildLocalTargets
   , loadPackage
   , mkBaseConfigOpts
-  , queryBuildInfo
   , splitObjsWarning
-  , CabalVersionException (..)
   ) where
 
-import           Data.Aeson ( Value (Object, Array), (.=), object )
-import qualified Data.Aeson.Key as Key
-import qualified Data.Aeson.KeyMap as KeyMap
-import           Data.List ( (\\), isPrefixOf )
+import           Data.Attoparsec.Args ( EscapingMode (Escaping), parseArgs )
+import           Data.List ( (\\) )
 import           Data.List.Extra ( groupSort )
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import           Data.Text.Encoding ( decodeUtf8 )
-import qualified Data.Text.IO as TIO
-import           Data.Text.Read ( decimal )
-import qualified Data.Vector as V
-import qualified Data.Yaml as Yaml
 import qualified Distribution.PackageDescription as C
-import           Distribution.Types.Dependency ( depLibraries )
+import           Distribution.Types.Dependency ( Dependency (..), depLibraries )
 import           Distribution.Version ( mkVersion )
-import           Path ( parent )
-import           Stack.Build.ConstructPlan
-import           Stack.Build.Execute
-import           Stack.Build.Installed
-import           Stack.Build.Source
-import           Stack.Package
+import           Stack.Build.ConstructPlan ( constructPlan )
+import           Stack.Build.Execute ( executePlan, preFetch, printPlan )
+import           Stack.Build.Installed ( getInstalled, toInstallMap )
+import           Stack.Build.Source ( localDependencies, projectLocalPackages )
+import           Stack.Build.Target ( NeedTargets (..) )
+import           Stack.FileWatch ( fileWatch, fileWatchPoll )
+import           Stack.Package ( resolvePackage )
 import           Stack.Prelude hiding ( loadPackage )
+import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
 import           Stack.Setup ( withNewLocalBuildTargets )
 import           Stack.Types.Build
-import           Stack.Types.Compiler ( compilerVersionText, getGhcVersion )
+                   ( Plan (..), Task (..), TaskType (..), taskLocation )
+import           Stack.Types.Build.Exception
+                   ( BuildException (..), BuildPrettyException (..) )
+import           Stack.Types.BuildConfig ( HasBuildConfig, stackYamlL )
+import           Stack.Types.BuildOpts
+                   ( BuildCommand (..), BuildOpts (..), BuildOptsCLI (..)
+                   , FileWatchOpts (..), buildOptsMonoidBenchmarksL
+                   , buildOptsMonoidHaddockL, buildOptsMonoidInstallExesL
+                   , buildOptsMonoidTestsL
+                   )
+import           Stack.Types.Compiler ( getGhcVersion )
+import           Stack.Types.CompilerPaths ( cabalVersionL )
 import           Stack.Types.Config
-import           Stack.Types.NamedComponent
+                   ( Config (..), HasConfig (..), buildOptsL
+                   )
+import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), HasSourceMap
+                   , actualCompilerVersionL, installationRootDeps
+                   , installationRootLocal, packageDatabaseDeps
+                   , packageDatabaseExtra, packageDatabaseLocal
+                   )
+import           Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
+import           Stack.Types.NamedComponent ( exeComponents )
 import           Stack.Types.Package
+                   ( InstallLocation (..), LocalPackage (..), Package (..)
+                   , PackageConfig (..), lpFiles, lpFilesForComponents )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( Runner, globalOptsL )
 import           Stack.Types.SourceMap
+                   ( CommonPackage (..), ProjectPackage (..), SMTargets (..)
+                   , SourceMap (..), Target (..) )
 import           System.Terminal ( fixCodePage )
 
-data CabalVersionException
-    = AllowNewerNotSupported Version
-    | CabalVersionNotSupported Version
-    deriving (Show, Typeable)
-
-instance Exception CabalVersionException where
-    displayException (AllowNewerNotSupported cabalVer) = concat
-        [ "Error: [S-8503]\n"
-        , "'--allow-newer' requires Cabal version 1.22 or greater, but "
-        , "version "
-        , versionString cabalVer
-        , " was found."
-        ]
-    displayException (CabalVersionNotSupported cabalVer) = concat
-        [ "Error: [S-5973]\n"
-        , "Stack no longer supports Cabal versions before 1.19.2, "
-        , "but version "
-        , versionString cabalVer
-        , " was found. To fix this, consider updating the resolver to lts-3.0 "
-        , "or later or to nightly-2015-05-05 or later."
-        ]
+newtype CabalVersionPrettyException
+  = CabalVersionNotSupported Version
+  deriving (Show, Typeable)
 
-data QueryException
-    = SelectorNotFound [Text]
-    | IndexOutOfRange [Text]
-    | NoNumericSelector [Text]
-    | CannotApplySelector Value [Text]
-    deriving (Show, Typeable)
+instance Pretty CabalVersionPrettyException where
+  pretty (CabalVersionNotSupported cabalVer) =
+    "[S-5973]"
+    <> line
+    <> fillSep
+         [ flow "Stack does not support Cabal versions before 1.22, but \
+                \version"
+         , fromString $ versionString cabalVer
+         , flow "was found. To fix this, consider updating the snapshot to"
+         , style Shell "lts-3.0"
+         , flow "or later or to"
+         , style Shell "nightly-2015-05-05"
+         , flow "or later."
+         ]
 
-instance Exception QueryException where
-    displayException (SelectorNotFound sels) =
-        err "[S-4419]" "Selector not found" sels
-    displayException (IndexOutOfRange sels) =
-        err "[S-8422]" "Index out of range" sels
-    displayException (NoNumericSelector sels) =
-        err "[S-4360]" "Encountered array and needed numeric selector" sels
-    displayException (CannotApplySelector value sels) =
-        err "[S-1711]" ("Cannot apply selector to " ++ show value) sels
+instance Exception CabalVersionPrettyException
 
--- | Helper function for 'QueryException' instance of 'Show'
-err :: String -> String -> [Text] -> String
-err msg code sels = "Error: " ++ code ++ "\n" ++ msg ++ ": " ++ show sels
+-- | Helper for build and install commands
+buildCmd :: BuildOptsCLI -> RIO Runner ()
+buildCmd opts = do
+  when (any (("-prof" `elem`) . fromRight [] . parseArgs Escaping) (boptsCLIGhcOptions opts)) $
+    prettyThrowIO GHCProfOptionInvalid
+  local (over globalOptsL modifyGO) $
+    case boptsCLIFileWatch opts of
+      FileWatchPoll -> fileWatchPoll (inner . Just)
+      FileWatch -> fileWatch (inner . Just)
+      NoFileWatch -> inner Nothing
+ where
+  inner ::
+       Maybe (Set (Path Abs File) -> IO ())
+    -> RIO Runner ()
+  inner setLocalFiles = withConfig YesReexec $ withEnvConfig NeedTargets opts $
+      Stack.Build.build setLocalFiles
+  -- Read the build command from the CLI and enable it to run
+  modifyGO =
+    case boptsCLICommand opts of
+      Test -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True)
+      Haddock ->
+        set (globalOptsBuildOptsMonoidL.buildOptsMonoidHaddockL) (Just True)
+      Bench ->
+        set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True)
+      Install ->
+        set (globalOptsBuildOptsMonoidL.buildOptsMonoidInstallExesL) (Just True)
+      Build -> id -- Default case is just Build
 
 -- | Build.
 --
@@ -153,145 +177,162 @@         preFetch plan
 
     if boptsCLIDryrun boptsCli
-        then printPlan plan
-        else executePlan boptsCli baseConfigOpts locals
-                         globalDumpPkgs
-                         snapshotDumpPkgs
-                         localDumpPkgs
-                         installedMap
-                         (smtTargets $ smTargets sourceMap)
-                         plan
+      then printPlan plan
+      else executePlan
+             boptsCli
+             baseConfigOpts
+             locals
+             globalDumpPkgs
+             snapshotDumpPkgs
+             localDumpPkgs
+             installedMap
+             (smtTargets $ smTargets sourceMap)
+             plan
 
-buildLocalTargets :: HasEnvConfig env => NonEmpty Text -> RIO env (Either SomeException ())
+buildLocalTargets ::
+     HasEnvConfig env
+  => NonEmpty Text
+  -> RIO env (Either SomeException ())
 buildLocalTargets targets =
   tryAny $ withNewLocalBuildTargets (NE.toList targets) $ build Nothing
 
 justLocals :: Plan -> [PackageIdentifier]
 justLocals =
-    map taskProvides .
-    filter ((== Local) . taskLocation) .
-    Map.elems .
-    planTasks
+  map taskProvides .
+  filter ((== Local) . taskLocation) .
+  Map.elems .
+  planTasks
 
 checkCabalVersion :: HasEnvConfig env => RIO env ()
 checkCabalVersion = do
-    allowNewer <- view $ configL.to configAllowNewer
-    cabalVer <- view cabalVersionL
-    -- https://github.com/haskell/cabal/issues/2023
-    when (allowNewer && cabalVer < mkVersion [1, 22]) $ throwM $
-        AllowNewerNotSupported cabalVer
-    -- Since --exact-configuration is always passed, some old cabal
-    -- versions can no longer be used. See the following link for why
-    -- it's 1.19.2:
-    -- https://github.com/haskell/cabal/blob/580fe6b6bf4e1648b2f66c1cb9da9f1f1378492c/cabal-install/Distribution/Client/Setup.hs#L592
-    when (cabalVer < mkVersion [1, 19, 2]) $ throwM $
-        CabalVersionNotSupported cabalVer
+  cabalVer <- view cabalVersionL
+  when (cabalVer < mkVersion [1, 22]) $
+    prettyThrowM $ CabalVersionNotSupported cabalVer
 
 -- | See https://github.com/commercialhaskell/stack/issues/1198.
-warnIfExecutablesWithSameNameCouldBeOverwritten
-    :: HasLogFunc env => [LocalPackage] -> Plan -> RIO env ()
+warnIfExecutablesWithSameNameCouldBeOverwritten ::
+     HasTerm env
+  => [LocalPackage]
+  -> Plan
+  -> RIO env ()
 warnIfExecutablesWithSameNameCouldBeOverwritten locals plan = do
-    logDebug "Checking if we are going to build multiple executables with the same name"
-    forM_ (Map.toList warnings) $ \(exe,(toBuild,otherLocals)) -> do
-        let exe_s
-                | length toBuild > 1 = "several executables with the same name:"
-                | otherwise = "executable"
-            exesText pkgs =
-                T.intercalate
-                    ", "
-                    ["'" <> T.pack (packageNameString p) <> ":" <> exe <> "'" | p <- pkgs]
-        (logWarn . display . T.unlines . concat)
-            [ [ "Building " <> exe_s <> " " <> exesText toBuild <> "." ]
-            , [ "Only one of them will be available via 'stack exec' or locally installed."
-              | length toBuild > 1
-              ]
-            , [ "Other executables with the same name might be overwritten: " <>
-                exesText otherLocals <> "."
-              | not (null otherLocals)
-              ]
-            ]
-  where
-    -- Cases of several local packages having executables with the same name.
-    -- The Map entries have the following form:
-    --
-    --  executable name: ( package names for executables that are being built
-    --                   , package names for other local packages that have an
-    --                     executable with the same name
-    --                   )
-    warnings :: Map Text ([PackageName],[PackageName])
-    warnings =
-        Map.mapMaybe
-            (\(pkgsToBuild,localPkgs) ->
-                case (pkgsToBuild,NE.toList localPkgs \\ NE.toList pkgsToBuild) of
-                    (_ :| [],[]) ->
-                        -- We want to build the executable of single local package
-                        -- and there are no other local packages with an executable of
-                        -- the same name. Nothing to warn about, ignore.
-                        Nothing
-                    (_,otherLocals) ->
-                        -- We could be here for two reasons (or their combination):
-                        -- 1) We are building two or more executables with the same
-                        --    name that will end up overwriting each other.
-                        -- 2) In addition to the executable(s) that we want to build
-                        --    there are other local packages with an executable of the
-                        --    same name that might get overwritten.
-                        -- Both cases warrant a warning.
-                        Just (NE.toList pkgsToBuild,otherLocals))
-            (Map.intersectionWith (,) exesToBuild localExes)
-    exesToBuild :: Map Text (NonEmpty PackageName)
-    exesToBuild =
-        collect
-            [ (exe,pkgName')
-            | (pkgName',task) <- Map.toList (planTasks plan)
-            , TTLocalMutable lp <- [taskType task]
-            , exe <- (Set.toList . exeComponents . lpComponents) lp
-            ]
-    localExes :: Map Text (NonEmpty PackageName)
-    localExes =
-        collect
-            [ (exe,packageName pkg)
-            | pkg <- map lpPackage locals
-            , exe <- Set.toList (packageExes pkg)
+  logDebug "Checking if we are going to build multiple executables with the same name"
+  forM_ (Map.toList warnings) $ \(exe, (toBuild, otherLocals)) -> do
+    let exe_s
+          | length toBuild > 1 = flow "several executables with the same name:"
+          | otherwise = "executable"
+        exesText pkgs =
+          fillSep $ punctuate
+            ","
+            [ style
+                PkgComponent
+                (fromString $ packageNameString p <> ":" <> T.unpack exe)
+            | p <- pkgs
             ]
-    collect :: Ord k => [(k,v)] -> Map k (NonEmpty v)
-    collect = Map.map NE.fromList . Map.fromDistinctAscList . groupSort
+    prettyWarnL $
+         [ "Building"
+         , exe_s
+         , exesText toBuild <> "."
+         ]
+      <> [ fillSep
+             [ flow "Only one of them will be available via"
+             , style Shell "stack exec"
+             , flow "or locally installed."
+             ]
+         | length toBuild > 1
+         ]
+      <> [ fillSep
+             [ flow "Other executables with the same name might be overwritten:"
+             , exesText otherLocals <> "."
+             ]
+         | not (null otherLocals)
+         ]
+ where
+  -- Cases of several local packages having executables with the same name.
+  -- The Map entries have the following form:
+  --
+  --  executable name: ( package names for executables that are being built
+  --                   , package names for other local packages that have an
+  --                     executable with the same name
+  --                   )
+  warnings :: Map Text ([PackageName],[PackageName])
+  warnings =
+    Map.mapMaybe
+      (\(pkgsToBuild,localPkgs) ->
+        case (pkgsToBuild,NE.toList localPkgs \\ NE.toList pkgsToBuild) of
+          (_ :| [],[]) ->
+            -- We want to build the executable of single local package
+            -- and there are no other local packages with an executable of
+            -- the same name. Nothing to warn about, ignore.
+            Nothing
+          (_,otherLocals) ->
+            -- We could be here for two reasons (or their combination):
+            -- 1) We are building two or more executables with the same
+            --    name that will end up overwriting each other.
+            -- 2) In addition to the executable(s) that we want to build
+            --    there are other local packages with an executable of the
+            --    same name that might get overwritten.
+            -- Both cases warrant a warning.
+            Just (NE.toList pkgsToBuild,otherLocals))
+      (Map.intersectionWith (,) exesToBuild localExes)
+  exesToBuild :: Map Text (NonEmpty PackageName)
+  exesToBuild =
+    collect
+      [ (exe,pkgName')
+      | (pkgName',task) <- Map.toList (planTasks plan)
+      , TTLocalMutable lp <- [taskType task]
+      , exe <- (Set.toList . exeComponents . lpComponents) lp
+      ]
+  localExes :: Map Text (NonEmpty PackageName)
+  localExes =
+    collect
+      [ (exe,packageName pkg)
+      | pkg <- map lpPackage locals
+      , exe <- Set.toList (packageExes pkg)
+      ]
+  collect :: Ord k => [(k,v)] -> Map k (NonEmpty v)
+  collect = Map.map NE.fromList . Map.fromDistinctAscList . groupSort
 
-warnAboutSplitObjs :: HasLogFunc env => BuildOpts -> RIO env ()
-warnAboutSplitObjs bopts | boptsSplitObjs bopts = do
-    logWarn $ "Building with --split-objs is enabled. " <> fromString splitObjsWarning
+warnAboutSplitObjs :: HasTerm env => BuildOpts -> RIO env ()
+warnAboutSplitObjs bopts | boptsSplitObjs bopts =
+  prettyWarnL
+    [ flow "Building with"
+    , style Shell "--split-objs"
+    , flow "is enabled."
+    , flow splitObjsWarning
+    ]
 warnAboutSplitObjs _ = pure ()
 
 splitObjsWarning :: String
-splitObjsWarning = unwords
-     [ "Note that this feature is EXPERIMENTAL, and its behavior may be changed and improved."
-     , "You will need to clean your workdirs before use. If you want to compile all dependencies"
-     , "with split-objs, you will need to delete the snapshot (and all snapshots that could"
-     , "reference that snapshot)."
-     ]
+splitObjsWarning =
+  "Note that this feature is EXPERIMENTAL, and its behavior may be changed and \
+  \improved. You will need to clean your workdirs before use. If you want to \
+  \compile all dependencies with split-objs, you will need to delete the \
+  \snapshot (and all snapshots that could reference that snapshot)."
 
 -- | Get the @BaseConfigOpts@ necessary for constructing configure options
 mkBaseConfigOpts :: (HasEnvConfig env)
                  => BuildOptsCLI -> RIO env BaseConfigOpts
 mkBaseConfigOpts boptsCli = do
-    bopts <- view buildOptsL
-    snapDBPath <- packageDatabaseDeps
-    localDBPath <- packageDatabaseLocal
-    snapInstallRoot <- installationRootDeps
-    localInstallRoot <- installationRootLocal
-    packageExtraDBs <- packageDatabaseExtra
-    pure BaseConfigOpts
-        { bcoSnapDB = snapDBPath
-        , bcoLocalDB = localDBPath
-        , bcoSnapInstallRoot = snapInstallRoot
-        , bcoLocalInstallRoot = localInstallRoot
-        , bcoBuildOpts = bopts
-        , bcoBuildOptsCLI = boptsCli
-        , bcoExtraDBs = packageExtraDBs
-        }
+  bopts <- view buildOptsL
+  snapDBPath <- packageDatabaseDeps
+  localDBPath <- packageDatabaseLocal
+  snapInstallRoot <- installationRootDeps
+  localInstallRoot <- installationRootLocal
+  packageExtraDBs <- packageDatabaseExtra
+  pure BaseConfigOpts
+    { bcoSnapDB = snapDBPath
+    , bcoLocalDB = localDBPath
+    , bcoSnapInstallRoot = snapInstallRoot
+    , bcoLocalInstallRoot = localInstallRoot
+    , bcoBuildOpts = bopts
+    , bcoBuildOptsCLI = boptsCli
+    , bcoExtraDBs = packageExtraDBs
+    }
 
 -- | Provide a function for loading package information from the package index
-loadPackage
-  :: (HasBuildConfig env, HasSourceMap env)
+loadPackage ::
+     (HasBuildConfig env, HasSourceMap env)
   => PackageLocationImmutable
   -> Map FlagName Bool
   -> [Text] -- ^ GHC options
@@ -311,101 +352,44 @@         }
   resolvePackage pkgConfig <$> loadCabalFileImmutable loc
 
--- | Query information about the build and print the result to stdout in YAML format.
-queryBuildInfo :: HasEnvConfig env
-               => [Text] -- ^ selectors
-               -> RIO env ()
-queryBuildInfo selectors0 =
-        rawBuildInfo
-    >>= select id selectors0
-    >>= liftIO . TIO.putStrLn . addGlobalHintsComment . decodeUtf8 . Yaml.encode
-  where
-    select _ [] value = pure value
-    select front (sel:sels) value =
-        case value of
-            Object o ->
-                case KeyMap.lookup (Key.fromText sel) o of
-                    Nothing -> throwIO $ SelectorNotFound sels'
-                    Just value' -> cont value'
-            Array v ->
-                case decimal sel of
-                    Right (i, "")
-                        | i >= 0 && i < V.length v -> cont $ v V.! i
-                        | otherwise -> throwIO $ IndexOutOfRange sels'
-                    _ -> throwIO $ NoNumericSelector sels'
-            _ -> throwIO $ CannotApplySelector value sels'
-      where
-        cont = select (front . (sel:)) sels
-        sels' = front [sel]
-    -- Include comments to indicate that this portion of the "stack
-    -- query" API is not necessarily stable.
-    addGlobalHintsComment
-      | null selectors0 = T.replace globalHintsLine ("\n" <> globalHintsComment <> globalHintsLine)
-      -- Append comment instead of pre-pending. The reasoning here is
-      -- that something *could* expect that the result of 'stack query
-      -- global-hints ghc-boot' is just a string literal. Seems easier
-      -- for to expect the first line of the output to be the literal.
-      | ["global-hints"] `isPrefixOf` selectors0 = (<> ("\n" <> globalHintsComment))
-      | otherwise = id
-    globalHintsLine = "\nglobal-hints:\n"
-    globalHintsComment = T.concat
-      [ "# Note: global-hints is experimental and may be renamed / removed in the future.\n"
-      , "# See https://github.com/commercialhaskell/stack/issues/3796"
-      ]
--- | Get the raw build information object
-rawBuildInfo :: HasEnvConfig env => RIO env Value
-rawBuildInfo = do
-    locals <- projectLocalPackages
-    wantedCompiler <- view $ wantedCompilerVersionL.to (utf8BuilderToText . display)
-    actualCompiler <- view $ actualCompilerVersionL.to compilerVersionText
-    pure $ object
-        [ "locals" .= Object (KeyMap.fromList $ map localToPair locals)
-        , "compiler" .= object
-            [ "wanted" .= wantedCompiler
-            , "actual" .= actualCompiler
-            ]
-        ]
-  where
-    localToPair lp =
-        (Key.fromText $ T.pack $ packageNameString $ packageName p, value)
-      where
-        p = lpPackage lp
-        value = object
-            [ "version" .= CabalString (packageVersion p)
-            , "path" .= toFilePath (parent $ lpCabalFile lp)
-            ]
-
 checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m ()
 checkComponentsBuildable lps =
-    unless (null unbuildable) $ throwM $ SomeTargetsNotBuildable unbuildable
-  where
-    unbuildable =
-        [ (packageName (lpPackage lp), c)
-        | lp <- lps
-        , c <- Set.toList (lpUnbuildable lp)
-        ]
+  unless (null unbuildable) $
+    prettyThrowM $ SomeTargetsNotBuildable unbuildable
+ where
+  unbuildable =
+    [ (packageName (lpPackage lp), c)
+    | lp <- lps
+    , c <- Set.toList (lpUnbuildable lp)
+    ]
 
--- | Find if sublibrary dependency exist in each project
-checkSubLibraryDependencies :: HasLogFunc env => [ProjectPackage] -> RIO env ()
-checkSubLibraryDependencies proj = do
-  forM_ proj $ \p -> do
-    C.GenericPackageDescription _ _ _ lib subLibs foreignLibs exes tests benches <- liftIO $ cpGPD . ppCommon $ p
+-- | Find if any sublibrary dependency (other than internal libraries) exists in
+-- each project package.
+checkSubLibraryDependencies :: HasTerm env => [ProjectPackage] -> RIO env ()
+checkSubLibraryDependencies projectPackages =
+  forM_ projectPackages $ \projectPackage -> do
+    C.GenericPackageDescription pkgDesc _ _ lib subLibs foreignLibs exes tests benches <-
+      liftIO $ cpGPD . ppCommon $ projectPackage
 
-    let dependencies = concatMap getDeps subLibs <>
+    let pName = pkgName . C.package $ pkgDesc
+        dependencies = concatMap getDeps subLibs <>
                        concatMap getDeps foreignLibs <>
                        concatMap getDeps exes <>
                        concatMap getDeps tests <>
                        concatMap getDeps benches <>
                        maybe [] C.condTreeConstraints lib
-        libraries = concatMap (toList . depLibraries) dependencies
+        notInternal (Dependency pName' _ _) = pName' /= pName
+        publicDependencies = filter notInternal dependencies
+        publicLibraries = concatMap (toList . depLibraries) publicDependencies
 
-    when (subLibDepExist libraries)
-      (logWarn "SubLibrary dependency is not supported, this will almost certainly fail")
-  where
-    getDeps (_, C.CondNode _ dep _) = dep
-    subLibDepExist lib =
-      any (\x ->
-        case x of
-          C.LSubLibName _ -> True
-          C.LMainLibName  -> False
-      ) lib
+    when (subLibDepExist publicLibraries) $
+      prettyWarnS
+        "Sublibrary dependency is not supported, this will almost certainly \
+        \fail."
+ where
+  getDeps (_, C.CondNode _ dep _) = dep
+  subLibDepExist = any
+    ( \case
+        C.LSubLibName _ -> True
+        C.LMainLibName  -> False
+    )
src/Stack/Build/Cache.hs view
@@ -1,37 +1,33 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
 
 -- | Cache information about previous builds
 module Stack.Build.Cache
-    ( tryGetBuildCache
-    , tryGetConfigCache
-    , tryGetCabalMod
-    , tryGetSetupConfigMod
-    , tryGetPackageProjectRoot
-    , getInstalledExes
-    , tryGetFlagCache
-    , deleteCaches
-    , markExeInstalled
-    , markExeNotInstalled
-    , writeFlagCache
-    , writeBuildCache
-    , writeConfigCache
-    , writeCabalMod
-    , writeSetupConfigMod
-    , writePackageProjectRoot
-    , TestStatus (..)
-    , setTestStatus
-    , getTestStatus
-    , writePrecompiledCache
-    , readPrecompiledCache
-    -- Exported for testing
-    , BuildCache (..)
-    ) where
+  ( tryGetBuildCache
+  , tryGetConfigCache
+  , tryGetCabalMod
+  , tryGetSetupConfigMod
+  , tryGetPackageProjectRoot
+  , getInstalledExes
+  , tryGetFlagCache
+  , deleteCaches
+  , markExeInstalled
+  , markExeNotInstalled
+  , writeFlagCache
+  , writeBuildCache
+  , writeConfigCache
+  , writeCabalMod
+  , writeSetupConfigMod
+  , writePackageProjectRoot
+  , TestStatus (..)
+  , setTestStatus
+  , getTestStatus
+  , writePrecompiledCache
+  , readPrecompiledCache
+  -- Exported for testing
+  , BuildCache (..)
+  ) where
 
 import           Crypto.Hash ( hashWith, SHA256 (..) )
 import qualified Data.ByteArray as Mem ( convert )
@@ -41,18 +37,41 @@ import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 import           Foreign.C.Types ( CTime )
-import           Path
+import           Path ( (</>), filename, parent, parseRelFile )
 import           Path.IO
-import           Stack.Constants
+                   ( ensureDir, ignoringAbsence, listDir, makeRelative
+                   , removeFile
+                   )
+import           Stack.Constants ( bindirSuffix, relDirInstalledPackages )
 import           Stack.Constants.Config
+                   ( buildCachesDir, configCabalMod, configPackageProjectRoot
+                   , configSetupConfigMod, testSuccessFile
+                   )
 import           Stack.Prelude
 import           Stack.Storage.Project
+                   ( ConfigCacheKey, configCacheKey, deactiveConfigCache
+                   , loadConfigCache, saveConfigCache
+                   )
 import           Stack.Storage.User
+                   ( PrecompiledCacheKey, loadPrecompiledCache
+                   , precompiledCacheKey, savePrecompiledCache
+                   )
 import           Stack.Types.Build
-import           Stack.Types.Cache
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
+                   ( BuildCache (..), ConfigCache, FileCacheInfo
+                   , InstallLocation (..), Installed (..), PrecompiledCache (..)
+                   )
+import           Stack.Types.Cache ( ConfigCacheType (..) )
+import           Stack.Types.CompilerPaths ( cabalVersionL )
+import           Stack.Types.Config ( stackRootL )
+import           Stack.Types.ConfigureOpts
+                   ( BaseConfigOpts (..), ConfigureOpts (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL
+                   , installationRootDeps, installationRootLocal
+                   , platformGhcRelDir
+                   )
+import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
+import           Stack.Types.NamedComponent ( NamedComponent (..) )
 import           Stack.Types.SourceMap ( smRelDir )
 import           System.PosixCompat.Files
                    ( modificationTime, getFileStatus, setFileTimes )
@@ -60,67 +79,66 @@ -- | Directory containing files to mark an executable as installed
 exeInstalledDir :: (HasEnvConfig env)
                 => InstallLocation -> RIO env (Path Abs Dir)
-exeInstalledDir Snap = (</> relDirInstalledPackages) `liftM` installationRootDeps
-exeInstalledDir Local = (</> relDirInstalledPackages) `liftM` installationRootLocal
+exeInstalledDir Snap = (</> relDirInstalledPackages) <$> installationRootDeps
+exeInstalledDir Local = (</> relDirInstalledPackages) <$> installationRootLocal
 
 -- | Get all of the installed executables
 getInstalledExes :: (HasEnvConfig env)
                  => InstallLocation -> RIO env [PackageIdentifier]
 getInstalledExes loc = do
-    dir <- exeInstalledDir loc
-    (_, files) <- liftIO $ handleIO (const $ pure ([], [])) $ listDir dir
-    pure $
-        concat $
-        M.elems $
-        -- If there are multiple install records (from a Stack version
-        -- before https://github.com/commercialhaskell/stack/issues/2373
-        -- was fixed), then we don't know which is correct - ignore them.
-        M.fromListWith (\_ _ -> []) $
-        map (\x -> (pkgName x, [x])) $
-        mapMaybe (parsePackageIdentifier . toFilePath . filename) files
+  dir <- exeInstalledDir loc
+  (_, files) <- liftIO $ handleIO (const $ pure ([], [])) $ listDir dir
+  pure $
+    concat $
+    M.elems $
+    -- If there are multiple install records (from a Stack version before
+    -- https://github.com/commercialhaskell/stack/issues/2373 was fixed), then
+    -- we don't know which is correct - ignore them.
+    M.fromListWith (\_ _ -> []) $
+    map (\x -> (pkgName x, [x])) $
+    mapMaybe (parsePackageIdentifier . toFilePath . filename) files
 
 -- | Mark the given executable as installed
 markExeInstalled :: (HasEnvConfig env)
                  => InstallLocation -> PackageIdentifier -> RIO env ()
 markExeInstalled loc ident = do
-    dir <- exeInstalledDir loc
-    ensureDir dir
-    ident' <- parseRelFile $ packageIdentifierString ident
-    let fp = dir </> ident'
-    -- Remove old install records for this package.
-    -- TODO: This is a bit in-efficient. Put all this metadata into one file?
-    installed <- getInstalledExes loc
-    forM_ (filter (\x -> pkgName ident == pkgName x) installed)
-          (markExeNotInstalled loc)
-    -- TODO consideration for the future: list all of the executables
-    -- installed, and invalidate this file in getInstalledExes if they no
-    -- longer exist
-    writeBinaryFileAtomic fp "Installed"
+  dir <- exeInstalledDir loc
+  ensureDir dir
+  ident' <- parseRelFile $ packageIdentifierString ident
+  let fp = dir </> ident'
+  -- Remove old install records for this package.
+  -- TODO: This is a bit in-efficient. Put all this metadata into one file?
+  installed <- getInstalledExes loc
+  forM_ (filter (\x -> pkgName ident == pkgName x) installed)
+        (markExeNotInstalled loc)
+  -- TODO consideration for the future: list all of the executables installed,
+  -- and invalidate this file in getInstalledExes if they no longer exist
+  writeBinaryFileAtomic fp "Installed"
 
 -- | Mark the given executable as not installed
 markExeNotInstalled :: (HasEnvConfig env)
                     => InstallLocation -> PackageIdentifier -> RIO env ()
 markExeNotInstalled loc ident = do
-    dir <- exeInstalledDir loc
-    ident' <- parseRelFile $ packageIdentifierString ident
-    liftIO $ ignoringAbsence (removeFile $ dir </> ident')
+  dir <- exeInstalledDir loc
+  ident' <- parseRelFile $ packageIdentifierString ident
+  liftIO $ ignoringAbsence (removeFile $ dir </> ident')
 
 buildCacheFile :: (HasEnvConfig env, MonadReader env m, MonadThrow m)
                => Path Abs Dir
                -> NamedComponent
                -> m (Path Abs File)
 buildCacheFile dir component = do
-    cachesDir <- buildCachesDir dir
-    smh <- view $ envConfigL.to envConfigSourceMapHash
-    smDirName <- smRelDir smh
-    let nonLibComponent prefix name = prefix <> "-" <> T.unpack name
-    cacheFileName <- parseRelFile $ case component of
-        CLib -> "lib"
-        CInternalLib name -> nonLibComponent "internal-lib" name
-        CExe name -> nonLibComponent "exe" name
-        CTest name -> nonLibComponent "test" name
-        CBench name -> nonLibComponent "bench" name
-    pure $ cachesDir </> smDirName </> cacheFileName
+  cachesDir <- buildCachesDir dir
+  smh <- view $ envConfigL.to envConfigSourceMapHash
+  smDirName <- smRelDir smh
+  let nonLibComponent prefix name = prefix <> "-" <> T.unpack name
+  cacheFileName <- parseRelFile $ case component of
+    CLib -> "lib"
+    CInternalLib name -> nonLibComponent "internal-lib" name
+    CExe name -> nonLibComponent "exe" name
+    CTest name -> nonLibComponent "test" name
+    CBench name -> nonLibComponent "bench" name
+  pure $ cachesDir </> smDirName </> cacheFileName
 
 -- | Try to read the dirtiness cache for the given package directory.
 tryGetBuildCache :: HasEnvConfig env
@@ -134,21 +152,27 @@     liftIO (tryAny (Yaml.decodeFileThrow (toFilePath fp)))
 
 -- | Try to read the dirtiness cache for the given package directory.
-tryGetConfigCache :: HasEnvConfig env
-                  => Path Abs Dir -> RIO env (Maybe ConfigCache)
+tryGetConfigCache ::
+     HasEnvConfig env
+  => Path Abs Dir
+  -> RIO env (Maybe ConfigCache)
 tryGetConfigCache dir =
-    loadConfigCache $ configCacheKey dir ConfigCacheTypeConfig
+  loadConfigCache $ configCacheKey dir ConfigCacheTypeConfig
 
 -- | Try to read the mod time of the Cabal file from the last build
-tryGetCabalMod :: HasEnvConfig env
-               => Path Abs Dir -> RIO env (Maybe CTime)
+tryGetCabalMod ::
+     HasEnvConfig env
+  => Path Abs Dir
+  -> RIO env (Maybe CTime)
 tryGetCabalMod dir = do
   fp <- toFilePath <$> configCabalMod dir
   tryGetFileMod fp
 
 -- | Try to read the mod time of setup-config file from the last build
-tryGetSetupConfigMod :: HasEnvConfig env
-               => Path Abs Dir -> RIO env (Maybe CTime)
+tryGetSetupConfigMod ::
+     HasEnvConfig env
+  => Path Abs Dir
+  -> RIO env (Maybe CTime)
 tryGetSetupConfigMod dir = do
   fp <- toFilePath <$> configSetupConfigMod dir
   tryGetFileMod fp
@@ -156,11 +180,13 @@ tryGetFileMod :: MonadIO m => FilePath -> m (Maybe CTime)
 tryGetFileMod fp =
   liftIO $ either (const Nothing) (Just . modificationTime) <$>
-      tryIO (getFileStatus fp)
+    tryIO (getFileStatus fp)
 
 -- | Try to read the project root from the last build of a package
-tryGetPackageProjectRoot :: HasEnvConfig env
-               => Path Abs Dir -> RIO env (Maybe ByteString)
+tryGetPackageProjectRoot ::
+     HasEnvConfig env
+  => Path Abs Dir
+  -> RIO env (Maybe ByteString)
 tryGetPackageProjectRoot dir = do
   fp <- toFilePath <$> configPackageProjectRoot dir
   tryReadFileBinary fp
@@ -168,7 +194,7 @@ tryReadFileBinary :: MonadIO m => FilePath -> m (Maybe ByteString)
 tryReadFileBinary fp =
   liftIO $ either (const Nothing) Just <$>
-      tryIO (readFileBinary fp)
+    tryIO (readFileBinary fp)
 
 -- | Write the dirtiness cache for this package's files.
 writeBuildCache :: HasEnvConfig env
@@ -176,10 +202,10 @@                 -> NamedComponent
                 -> Map FilePath FileCacheInfo -> RIO env ()
 writeBuildCache dir component times = do
-    fp <- toFilePath <$> buildCacheFile dir component
-    liftIO $ Yaml.encodeFile fp BuildCache
-        { buildCacheTimes = times
-        }
+  fp <- toFilePath <$> buildCacheFile dir component
+  liftIO $ Yaml.encodeFile fp BuildCache
+    { buildCacheTimes = times
+    }
 
 -- | Write the dirtiness cache for this package's configuration.
 writeConfigCache :: HasEnvConfig env
@@ -187,7 +213,7 @@                 -> ConfigCache
                 -> RIO env ()
 writeConfigCache dir =
-    saveConfigCache (configCacheKey dir ConfigCacheTypeConfig)
+  saveConfigCache (configCacheKey dir ConfigCacheTypeConfig)
 
 -- | See 'tryGetCabalMod'
 writeCabalMod :: HasEnvConfig env
@@ -195,71 +221,71 @@               -> CTime
               -> RIO env ()
 writeCabalMod dir x = do
-    fp <- configCabalMod dir
-    writeBinaryFileAtomic fp "Just used for its modification time"
-    liftIO $ setFileTimes (toFilePath fp) x x
+  fp <- configCabalMod dir
+  writeBinaryFileAtomic fp "Just used for its modification time"
+  liftIO $ setFileTimes (toFilePath fp) x x
 
 -- | See 'tryGetSetupConfigMod'
-writeSetupConfigMod
-  :: HasEnvConfig env
+writeSetupConfigMod ::
+     HasEnvConfig env
   => Path Abs Dir
   -> Maybe CTime
   -> RIO env ()
 writeSetupConfigMod dir Nothing = do
-    fp <- configSetupConfigMod dir
-    ignoringAbsence $ removeFile fp
+  fp <- configSetupConfigMod dir
+  ignoringAbsence $ removeFile fp
 writeSetupConfigMod dir (Just x) = do
-    fp <- configSetupConfigMod dir
-    writeBinaryFileAtomic fp "Just used for its modification time"
-    liftIO $ setFileTimes (toFilePath fp) x x
+  fp <- configSetupConfigMod dir
+  writeBinaryFileAtomic fp "Just used for its modification time"
+  liftIO $ setFileTimes (toFilePath fp) x x
 
 -- | See 'tryGetPackageProjectRoot'
-writePackageProjectRoot
-  :: HasEnvConfig env
+writePackageProjectRoot ::
+     HasEnvConfig env
   => Path Abs Dir
   -> ByteString
   -> RIO env ()
 writePackageProjectRoot dir projectRoot = do
-    fp <- configPackageProjectRoot dir
-    writeBinaryFileAtomic fp (byteString projectRoot)
+  fp <- configPackageProjectRoot dir
+  writeBinaryFileAtomic fp (byteString projectRoot)
 
 -- | Delete the caches for the project.
 deleteCaches :: HasEnvConfig env => Path Abs Dir -> RIO env ()
-deleteCaches dir
-    {- FIXME confirm that this is acceptable to remove
-    bfp <- buildCacheFile dir
-    removeFileIfExists bfp
-    -}
- = deactiveConfigCache $ configCacheKey dir ConfigCacheTypeConfig
+deleteCaches dir =
+  {- FIXME confirm that this is acceptable to remove
+  bfp <- buildCacheFile dir
+  removeFileIfExists bfp
+  -}
+  deactiveConfigCache $ configCacheKey dir ConfigCacheTypeConfig
 
 flagCacheKey :: (HasEnvConfig env) => Installed -> RIO env ConfigCacheKey
 flagCacheKey installed = do
-    installationRoot <- installationRootLocal
-    case installed of
-        Library _ gid _ ->
-            pure $
-            configCacheKey installationRoot (ConfigCacheTypeFlagLibrary gid)
-        Executable ident ->
-            pure $
-            configCacheKey
-                installationRoot
-                (ConfigCacheTypeFlagExecutable ident)
+  installationRoot <- installationRootLocal
+  case installed of
+    Library _ gid _ ->
+      pure $
+      configCacheKey installationRoot (ConfigCacheTypeFlagLibrary gid)
+    Executable ident ->
+      pure $
+        configCacheKey
+          installationRoot
+          (ConfigCacheTypeFlagExecutable ident)
 
 -- | Loads the flag cache for the given installed extra-deps
 tryGetFlagCache :: HasEnvConfig env
                 => Installed
                 -> RIO env (Maybe ConfigCache)
 tryGetFlagCache gid = do
-    key <- flagCacheKey gid
-    loadConfigCache key
+  key <- flagCacheKey gid
+  loadConfigCache key
 
 writeFlagCache :: HasEnvConfig env
                => Installed
                -> ConfigCache
                -> RIO env ()
 writeFlagCache gid cache = do
-    key <- flagCacheKey gid
-    saveConfigCache key cache
+  key <- flagCacheKey gid
+  saveConfigCache key cache
 
 successBS, failureBS, unknownBS :: IsString s => s
 successBS = "success"
@@ -267,7 +293,10 @@ unknownBS = "unknown"
 
 -- | Status of a test suite
-data TestStatus = TSSuccess | TSFailure | TSUnknown
+data TestStatus
+  = TSSuccess
+  | TSFailure
+  | TSUnknown
 
 -- | Mark test suite status
 setTestStatus :: HasEnvConfig env
@@ -275,12 +304,12 @@               -> TestStatus
               -> RIO env ()
 setTestStatus dir status = do
-    fp <- testSuccessFile dir
-    writeBinaryFileAtomic fp $
-      case status of
-        TSSuccess -> successBS
-        TSFailure -> failureBS
-        TSUnknown -> unknownBS
+  fp <- testSuccessFile dir
+  writeBinaryFileAtomic fp $
+    case status of
+      TSSuccess -> successBS
+      TSFailure -> failureBS
+      TSUnknown -> unknownBS
 
 -- | Check if the test suite already passed
 getTestStatus :: HasEnvConfig env
@@ -288,8 +317,8 @@               -> RIO env TestStatus
 getTestStatus dir = do
   fp <- testSuccessFile dir
-  -- we could ensure the file is the right size first,
-  -- but we're not expected an attack from the user's filesystem
+  -- we could ensure the file is the right size first, but we're not expected an
+  -- attack from the user's filesystem
   eres <- tryIO (readFileBinary $ toFilePath fp)
   pure $
     case eres of
@@ -322,9 +351,8 @@   compiler <- view actualCompilerVersionL
   cabalVersion <- view cabalVersionL
 
-  -- The goal here is to come up with a string representing the
-  -- package location which is unique. Luckily @TreeKey@s are exactly
-  -- that!
+  -- The goal here is to come up with a string representing the package location
+  -- which is unique. Luckily @TreeKey@s are exactly that!
   treeKey <- getPackageLocationTreeKey loc
   let packageKey = utf8BuilderToText $ display treeKey
 
@@ -360,22 +388,23 @@     Library _ ipid _ -> Just <$> pathFromPkgId stackRootRelative ipid
   sublibpaths <- mapM (pathFromPkgId stackRootRelative) sublibs
   exes' <- forM (Set.toList exes) $ \exe -> do
-      name <- parseRelFile $ T.unpack exe
-      stackRootRelative $ bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
+    name <- parseRelFile $ T.unpack exe
+    stackRootRelative $ bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
   let precompiled = PrecompiledCache
         { pcLibrary = mlibpath
         , pcSubLibs = sublibpaths
         , pcExes = exes'
         }
   savePrecompiledCache key precompiled
-  -- reuse precompiled cache with haddocks also in case when haddocks are not required
+  -- reuse precompiled cache with haddocks also in case when haddocks are not
+  -- required
   when buildHaddocks $ do
     key' <- getPrecompiledCacheKey loc copts False depIDs
     savePrecompiledCache key' precompiled
-  where
-    pathFromPkgId stackRootRelative ipid = do
-      ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf"
-      stackRootRelative $ bcoSnapDB baseConfigOpts </> ipid'
+ where
+  pathFromPkgId stackRootRelative ipid = do
+    ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf"
+    stackRootRelative $ bcoSnapDB baseConfigOpts </> ipid'
 
 -- | Check the cache for a precompiled package matching the given
 -- configuration.
@@ -386,22 +415,21 @@                      -> Set GhcPkgId -- ^ dependencies
                      -> RIO env (Maybe (PrecompiledCache Abs))
 readPrecompiledCache loc copts buildHaddocks depIDs = do
-    key <- getPrecompiledCacheKey loc copts buildHaddocks depIDs
-    mcache <- loadPrecompiledCache key
-    maybe (pure Nothing) (fmap Just . mkAbs) mcache
-  where
-    -- Since commit ed9ccc08f327bad68dd2d09a1851ce0d055c0422,
-    -- pcLibrary paths are stored as relative to the Stack
-    -- root. Therefore, we need to prepend the Stack root when
-    -- checking that the file exists. For the older cached paths, the
-    -- file will contain an absolute path, which will make `stackRoot
-    -- </>` a no-op.
-    mkAbs :: PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
-    mkAbs pc0 = do
-      stackRoot <- view stackRootL
-      let mkAbs' = (stackRoot </>)
-      pure PrecompiledCache
-        { pcLibrary = mkAbs' <$> pcLibrary pc0
-        , pcSubLibs = mkAbs' <$> pcSubLibs pc0
-        , pcExes = mkAbs' <$> pcExes pc0
-        }
+  key <- getPrecompiledCacheKey loc copts buildHaddocks depIDs
+  mcache <- loadPrecompiledCache key
+  maybe (pure Nothing) (fmap Just . mkAbs) mcache
+ where
+  -- Since commit ed9ccc08f327bad68dd2d09a1851ce0d055c0422, pcLibrary paths are
+  -- stored as relative to the Stack root. Therefore, we need to prepend the
+  -- Stack root when checking that the file exists. For the older cached paths,
+  -- the file will contain an absolute path, which will make `stackRoot </>`
+  -- a no-op.
+  mkAbs :: PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
+  mkAbs pc0 = do
+    stackRoot <- view stackRootL
+    let mkAbs' = (stackRoot </>)
+    pure PrecompiledCache
+      { pcLibrary = mkAbs' <$> pcLibrary pc0
+      , pcSubLibs = mkAbs' <$> pcSubLibs pc0
+      , pcExes = mkAbs' <$> pcExes pc0
+      }
src/Stack/Build/ConstructPlan.hs view
@@ -1,1022 +1,1280 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TupleSections         #-}
-{-# LANGUAGE ViewPatterns          #-}
-
--- | Construct a @Plan@ for how to build
-module Stack.Build.ConstructPlan
-  ( constructPlan
-  ) where
-
-import           Control.Monad.RWS.Strict hiding ( (<>) )
-import           Control.Monad.State.Strict ( execState )
-import qualified Data.List as L
-import qualified Data.Map.Strict as M
-import qualified Data.Map.Strict as Map
-import           Data.Monoid.Map ( MonoidMap(..) )
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import           Distribution.Types.BuildType ( BuildType (Configure) )
-import           Distribution.Types.PackageName ( mkPackageName )
-import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
-import           Path ( parent )
-import           RIO.Process ( findExecutable, HasProcessContext (..) )
-import           Stack.Build.Cache
-import           Stack.Build.Haddock
-import           Stack.Build.Installed
-import           Stack.Build.Source
-import           Stack.Constants
-import           Stack.Package
-import           Stack.PackageDump
-import           Stack.Prelude hiding ( loadPackage )
-import           Stack.SourceMap
-import           Stack.Types.Build
-import           Stack.Types.Compiler
-import           Stack.Types.Config
-import           Stack.Types.Dependency
-                   ( DepValue (DepValue), DepType (AsLibrary) )
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
-import           Stack.Types.Package
-import           Stack.Types.SourceMap
-import           Stack.Types.Version
-import           System.Environment ( lookupEnv )
-import           System.IO ( putStrLn )
-
-data PackageInfo
-    =
-      -- | This indicates that the package is already installed, and
-      -- that we shouldn't build it from source. This is only the case
-      -- for global packages.
-      PIOnlyInstalled InstallLocation Installed
-      -- | This indicates that the package isn't installed, and we know
-      -- where to find its source.
-    | PIOnlySource PackageSource
-      -- | This indicates that the package is installed and we know
-      -- where to find its source. We may want to reinstall from source.
-    | PIBoth PackageSource Installed
-    deriving (Show)
-
-combineSourceInstalled :: PackageSource
-                       -> (InstallLocation, Installed)
-                       -> PackageInfo
-combineSourceInstalled ps (location, installed) =
-    assert (psVersion ps == installedVersion installed) $
-    case location of
-        -- Always trust something in the snapshot
-        Snap -> PIOnlyInstalled location installed
-        Local -> PIBoth ps installed
-
-type CombinedMap = Map PackageName PackageInfo
-
-combineMap :: Map PackageName PackageSource -> InstalledMap -> CombinedMap
-combineMap = Map.mergeWithKey
-    (\_ s i -> Just $ combineSourceInstalled s i)
-    (fmap PIOnlySource)
-    (fmap (uncurry PIOnlyInstalled))
-
-data AddDepRes
-    = ADRToInstall Task
-    | ADRFound InstallLocation Installed
-    deriving Show
-
-data W = W
-    { wFinals :: !(Map PackageName (Either ConstructPlanException Task))
-    , wInstall :: !(Map Text InstallLocation)
-    -- ^ executable to be installed, and location where the binary is placed
-    , wDirty :: !(Map PackageName Text)
-    -- ^ why a local package is considered dirty
-    , wWarnings :: !([Text] -> [Text])
-    -- ^ Warnings
-    , wParents :: !ParentMap
-    -- ^ Which packages a given package depends on, along with the package's version
-    } deriving Generic
-instance Semigroup W where
-    (<>) = mappenddefault
-instance Monoid W where
-    mempty = memptydefault
-    mappend = (<>)
-
-type M = RWST -- TODO replace with more efficient WS stack on top of StackT
-    Ctx
-    W
-    (Map PackageName (Either ConstructPlanException AddDepRes))
-    IO
-
-data Ctx = Ctx
-    { baseConfigOpts :: !BaseConfigOpts
-    , loadPackage    :: !(PackageLocationImmutable -> Map FlagName Bool -> [Text] -> [Text] -> M Package)
-    , combinedMap    :: !CombinedMap
-    , ctxEnvConfig   :: !EnvConfig
-    , callStack      :: ![PackageName]
-    , wanted         :: !(Set PackageName)
-    , localNames     :: !(Set PackageName)
-    , mcurator       :: !(Maybe Curator)
-    , pathEnvVar     :: !Text
-    }
-
-instance HasPlatform Ctx
-instance HasGHCVariant Ctx
-instance HasLogFunc Ctx where
-    logFuncL = configL.logFuncL
-instance HasRunner Ctx where
-    runnerL = configL.runnerL
-instance HasStylesUpdate Ctx where
-  stylesUpdateL = runnerL.stylesUpdateL
-instance HasTerm Ctx where
-  useColorL = runnerL.useColorL
-  termWidthL = runnerL.termWidthL
-instance HasConfig Ctx
-instance HasPantryConfig Ctx where
-    pantryConfigL = configL.pantryConfigL
-instance HasProcessContext Ctx where
-    processContextL = configL.processContextL
-instance HasBuildConfig Ctx
-instance HasSourceMap Ctx where
-    sourceMapL = envConfigL.sourceMapL
-instance HasCompiler Ctx where
-    compilerPathsL = envConfigL.compilerPathsL
-instance HasEnvConfig Ctx where
-    envConfigL = lens ctxEnvConfig (\x y -> x { ctxEnvConfig = y })
-
--- | Computes a build plan. This means figuring out which build 'Task's
--- to take, and the interdependencies among the build 'Task's. In
--- particular:
---
--- 1) It determines which packages need to be built, based on the
--- transitive deps of the current targets. For local packages, this is
--- indicated by the 'lpWanted' boolean. For extra packages to build,
--- this comes from the @extraToBuild0@ argument of type @Set
--- PackageName@. These are usually packages that have been specified on
--- the commandline.
---
--- 2) It will only rebuild an upstream package if it isn't present in
--- the 'InstalledMap', or if some of its dependencies have changed.
---
--- 3) It will only rebuild a local package if its files are dirty or
--- some of its dependencies have changed.
-constructPlan :: forall env. HasEnvConfig env
-              => BaseConfigOpts
-              -> [DumpPackage] -- ^ locally registered
-              -> (PackageLocationImmutable -> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package) -- ^ load upstream package
-              -> SourceMap
-              -> InstalledMap
-              -> Bool
-              -> RIO env Plan
-constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap initialBuildSteps = do
-    logDebug "Constructing the build plan"
-
-    when hasBaseInDeps $
-      prettyWarn $ flow "You are trying to upgrade/downgrade base, which is almost certainly not what you really want. Please, consider using another GHC version if you need a certain version of base, or removing base from extra-deps. See more at https://github.com/commercialhaskell/stack/issues/3940." <> line
-
-    econfig <- view envConfigL
-    globalCabalVersion <- view $ compilerPathsL.to cpCabalVersion
-    sources <- getSources globalCabalVersion
-    mcur <- view $ buildConfigL.to bcCurator
-
-    let onTarget = void . addDep
-    let inner = mapM_ onTarget $ Map.keys (smtTargets $ smTargets sourceMap)
-    pathEnvVar' <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH"
-    let ctx = mkCtx econfig globalCabalVersion sources mcur pathEnvVar'
-    ((), m, W efinals installExes dirtyReason warnings parents) <-
-        liftIO $ runRWST inner ctx M.empty
-    mapM_ (logWarn . display) (warnings [])
-    let toEither (_, Left e)  = Left e
-        toEither (k, Right v) = Right (k, v)
-        (errlibs, adrs) = partitionEithers $ map toEither $ M.toList m
-        (errfinals, finals) = partitionEithers $ map toEither $ M.toList efinals
-        errs = errlibs ++ errfinals
-    if null errs
-        then do
-            let toTask (_, ADRFound _ _) = Nothing
-                toTask (name, ADRToInstall task) = Just (name, task)
-                tasks = M.fromList $ mapMaybe toTask adrs
-                takeSubset =
-                    case boptsCLIBuildSubset $ bcoBuildOptsCLI baseConfigOpts0 of
-                        BSAll -> pure
-                        BSOnlySnapshot -> pure . stripLocals
-                        BSOnlyDependencies -> pure . stripNonDeps (M.keysSet $ smDeps sourceMap)
-                        BSOnlyLocals -> errorOnSnapshot
-            takeSubset Plan
-                { planTasks = tasks
-                , planFinals = M.fromList finals
-                , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps
-                , planInstallExes =
-                    if boptsInstallExes (bcoBuildOpts baseConfigOpts0) ||
-                       boptsInstallCompilerTool (bcoBuildOpts baseConfigOpts0)
-                        then installExes
-                        else Map.empty
-                }
-        else do
-            planDebug $ show errs
-            stackYaml <- view stackYamlL
-            stackRoot <- view stackRootL
-            throwM $ PrettyException $
-                ConstructPlanFailed errs stackYaml stackRoot parents (wanted ctx) prunedGlobalDeps
-  where
-    hasBaseInDeps = Map.member (mkPackageName "base") (smDeps sourceMap)
-
-    mkCtx econfig globalCabalVersion sources mcur pathEnvVar' = Ctx
-        { baseConfigOpts = baseConfigOpts0
-        , loadPackage = \w x y z -> runRIO econfig $
-            applyForceCustomBuild globalCabalVersion <$> loadPackage0 w x y z
-        , combinedMap = combineMap sources installedMap
-        , ctxEnvConfig = econfig
-        , callStack = []
-        , wanted = Map.keysSet (smtTargets $ smTargets sourceMap)
-        , localNames = Map.keysSet (smProject sourceMap)
-        , mcurator = mcur
-        , pathEnvVar = pathEnvVar'
-        }
-
-    prunedGlobalDeps = flip Map.mapMaybe (smGlobal sourceMap) $ \gp ->
-      case gp of
-         ReplacedGlobalPackage deps ->
-           let pruned = filter (not . inSourceMap) deps
-           in if null pruned then Nothing else Just pruned
-         GlobalPackage _ -> Nothing
-
-    inSourceMap pname = pname `Map.member` smDeps sourceMap ||
-                        pname `Map.member` smProject sourceMap
-
-    getSources globalCabalVersion = do
-      let loadLocalPackage' pp = do
-            lp <- loadLocalPackage pp
-            pure lp { lpPackage = applyForceCustomBuild globalCabalVersion $ lpPackage lp }
-      pPackages <- for (smProject sourceMap) $ \pp -> do
-        lp <- loadLocalPackage' pp
-        pure $ PSFilePath lp
-      bopts <- view $ configL.to configBuild
-      deps <- for (smDeps sourceMap) $ \dp ->
-        case dpLocation dp of
-          PLImmutable loc ->
-            pure $ PSRemote loc (getPLIVersion loc) (dpFromSnapshot dp) (dpCommon dp)
-          PLMutable dir -> do
-            pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts)
-            lp <- loadLocalPackage' pp
-            pure $ PSFilePath lp
-      pure $ pPackages <> deps
-
--- | Throw an exception if there are any snapshot packages in the plan.
-errorOnSnapshot :: Plan -> RIO env Plan
-errorOnSnapshot plan@(Plan tasks _finals _unregister installExes) = do
-  let snapTasks = Map.keys $ Map.filter (\t -> taskLocation t == Snap) tasks
-  let snapExes = Map.keys $ Map.filter (== Snap) installExes
-  unless (null snapTasks && null snapExes) $ throwIO $
-    NotOnlyLocal snapTasks snapExes
-  pure plan
-
-data NotOnlyLocal
-    = NotOnlyLocal [PackageName] [Text]
-    deriving (Show, Typeable)
-
-instance Exception NotOnlyLocal where
-  displayException (NotOnlyLocal packages exes) = concat
-    [ "Error: [S-1727]\n"
-    , "Specified only-locals, but I need to build snapshot contents:\n"
-    , if null packages then "" else concat
-        [ "Packages: "
-        , L.intercalate ", " (map packageNameString packages)
-        , "\n"
-        ]
-    , if null exes then "" else concat
-        [ "Executables: "
-        , L.intercalate ", " (map T.unpack exes)
-        , "\n"
-        ]
-    ]
-
--- | State to be maintained during the calculation of local packages
--- to unregister.
-data UnregisterState = UnregisterState
-    { usToUnregister :: !(Map GhcPkgId (PackageIdentifier, Text))
-    , usKeep :: ![DumpPackage]
-    , usAnyAdded :: !Bool
-    }
-
--- | Determine which packages to unregister based on the given tasks and
--- already registered local packages
-mkUnregisterLocal :: Map PackageName Task
-                  -- ^ Tasks
-                  -> Map PackageName Text
-                  -- ^ Reasons why packages are dirty and must be rebuilt
-                  -> [DumpPackage]
-                  -- ^ Local package database dump
-                  -> Bool
-                  -- ^ If true, we're doing a special initialBuildSteps
-                  -- build - don't unregister target packages.
-                  -> Map GhcPkgId (PackageIdentifier, Text)
-mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps =
-    -- We'll take multiple passes through the local packages. This
-    -- will allow us to detect that a package should be unregistered,
-    -- as well as all packages directly or transitively depending on
-    -- it.
-    loop Map.empty localDumpPkgs
-  where
-    loop toUnregister keep
-        -- If any new packages were added to the unregister Map, we
-        -- need to loop through the remaining packages again to detect
-        -- if a transitive dependency is being unregistered.
-        | usAnyAdded us = loop (usToUnregister us) (usKeep us)
-        -- Nothing added, so we've already caught them all. Return the
-        -- Map we've already calculated.
-        | otherwise = usToUnregister us
-      where
-        -- Run the unregister checking function on all packages we
-        -- currently think we'll be keeping.
-        us = execState (mapM_ go keep) UnregisterState
-            { usToUnregister = toUnregister
-            , usKeep = []
-            , usAnyAdded = False
-            }
-
-    go dp = do
-        us <- get
-        case go' (usToUnregister us) ident deps of
-            -- Not unregistering, add it to the keep list
-            Nothing -> put us { usKeep = dp : usKeep us }
-            -- Unregistering, add it to the unregister Map and
-            -- indicate that a package was in fact added to the
-            -- unregister Map so we loop again.
-            Just reason -> put us
-                { usToUnregister = Map.insert gid (ident, reason) (usToUnregister us)
-                , usAnyAdded = True
-                }
-      where
-        gid = dpGhcPkgId dp
-        ident = dpPackageIdent dp
-        deps = dpDepends dp
-
-    go' toUnregister ident deps
-      -- If we're planning on running a task on it, then it must be
-      -- unregistered, unless it's a target and an initial-build-steps
-      -- build is being done.
-      | Just task <- Map.lookup name tasks
-          = if initialBuildSteps && taskIsTarget task && taskProvides task == ident
-              then Nothing
-              else Just $ fromMaybe "" $ Map.lookup name dirtyReason
-      -- Check if a dependency is going to be unregistered
-      | (dep, _):_ <- mapMaybe (`Map.lookup` toUnregister) deps
-          = Just $ "Dependency being unregistered: " <> T.pack (packageIdentifierString dep)
-      -- None of the above, keep it!
-      | otherwise = Nothing
-      where
-        name :: PackageName
-        name = pkgName ident
-
--- | Given a 'LocalPackage' and its 'lpTestBench', adds a 'Task' for
--- running its tests and benchmarks.
---
--- If @isAllInOne@ is 'True', then this means that the build step will
--- also build the tests. Otherwise, this indicates that there's a cyclic
--- dependency and an additional build step needs to be done.
---
--- This will also add all the deps needed to build the tests /
--- benchmarks. If @isAllInOne@ is 'True' (the common case), then all of
--- these should have already been taken care of as part of the build
--- step.
-addFinal :: LocalPackage -> Package -> Bool -> Bool -> M ()
-addFinal lp package isAllInOne buildHaddocks = do
-    depsRes <- addPackageDeps package
-    res <- case depsRes of
-        Left e -> pure $ Left e
-        Right (missing, present, _minLoc) -> do
-            ctx <- ask
-            pure $ Right Task
-                { taskProvides = PackageIdentifier
-                    (packageName package)
-                    (packageVersion package)
-                , taskConfigOpts = TaskConfigOpts missing $ \missing' ->
-                    let allDeps = Map.union present missing'
-                     in configureOpts
-                            (view envConfigL ctx)
-                            (baseConfigOpts ctx)
-                            allDeps
-                            True -- local
-                            Mutable
-                            package
-                , taskBuildHaddock = buildHaddocks
-                , taskPresent = present
-                , taskType = TTLocalMutable lp
-                , taskAllInOne = isAllInOne
-                , taskCachePkgSrc = CacheSrcLocal (toFilePath (parent (lpCabalFile lp)))
-                , taskAnyMissing = not $ Set.null missing
-                , taskBuildTypeConfig = packageBuildTypeConfig package
-                }
-    tell mempty { wFinals = Map.singleton (packageName package) res }
-
--- | Given a 'PackageName', adds all of the build tasks to build the
--- package, if needed.
---
--- 'constructPlan' invokes this on all the target packages, setting
--- @treatAsDep'@ to False, because those packages are direct build
--- targets. 'addPackageDeps' invokes this while recursing into the
--- dependencies of a package. As such, it sets @treatAsDep'@ to True,
--- forcing this package to be marked as a dependency, even if it is
--- directly wanted. This makes sense - if we left out packages that are
--- deps, it would break the --only-dependencies build plan.
-addDep :: PackageName
-       -> M (Either ConstructPlanException AddDepRes)
-addDep name = do
-    ctx <- ask
-    m <- get
-    case Map.lookup name m of
-        Just res -> do
-            planDebug $ "addDep: Using cached result for " ++ show name ++ ": " ++ show res
-            pure res
-        Nothing -> do
-            res <- if name `elem` callStack ctx
-                then do
-                    planDebug $ "addDep: Detected cycle " ++ show name ++ ": " ++ show (callStack ctx)
-                    pure $ Left $ DependencyCycleDetected $ name : callStack ctx
-                else local (\ctx' -> ctx' { callStack = name : callStack ctx' }) $ do
-                    let mpackageInfo = Map.lookup name $ combinedMap ctx
-                    planDebug $ "addDep: Package info for " ++ show name ++ ": " ++ show mpackageInfo
-                    case mpackageInfo of
-                        -- TODO look up in the package index and see if there's a
-                        -- recommendation available
-                        Nothing -> pure $ Left $ UnknownPackage name
-                        Just (PIOnlyInstalled loc installed) -> do
-                            -- FIXME Slightly hacky, no flags since
-                            -- they likely won't affect executable
-                            -- names. This code does not feel right.
-                            let version = installedVersion installed
-                                askPkgLoc = liftRIO $ do
-                                  mrev <- getLatestHackageRevision YesRequireHackageIndex name version
-                                  case mrev of
-                                    Nothing -> do
-                                      -- this could happen for GHC boot libraries missing from Hackage
-                                      logWarn $ "No latest package revision found for: " <>
-                                          fromString (packageNameString name) <> ", dependency callstack: " <>
-                                          displayShow (map packageNameString $ callStack ctx)
-                                      pure Nothing
-                                    Just (_rev, cfKey, treeKey) ->
-                                      pure . Just $
-                                          PLIHackage (PackageIdentifier name version) cfKey treeKey
-                            tellExecutablesUpstream name askPkgLoc loc Map.empty
-                            pure $ Right $ ADRFound loc installed
-                        Just (PIOnlySource ps) -> do
-                            tellExecutables name ps
-                            installPackage name ps Nothing
-                        Just (PIBoth ps installed) -> do
-                            tellExecutables name ps
-                            installPackage name ps (Just installed)
-            updateLibMap name res
-            pure res
-
--- FIXME what's the purpose of this? Add a Haddock!
-tellExecutables :: PackageName -> PackageSource -> M ()
-tellExecutables _name (PSFilePath lp)
-    | lpWanted lp = tellExecutablesPackage Local $ lpPackage lp
-    | otherwise = pure ()
--- Ignores ghcOptions because they don't matter for enumerating
--- executables.
-tellExecutables name (PSRemote pkgloc _version _fromSnapshot cp) =
-    tellExecutablesUpstream name (pure $ Just pkgloc) Snap (cpFlags cp)
-
-tellExecutablesUpstream ::
-       PackageName
-    -> M (Maybe PackageLocationImmutable)
-    -> InstallLocation
-    -> Map FlagName Bool
-    -> M ()
-tellExecutablesUpstream name retrievePkgLoc loc flags = do
-    ctx <- ask
-    when (name `Set.member` wanted ctx) $ do
-        mPkgLoc <- retrievePkgLoc
-        forM_ mPkgLoc $ \pkgLoc -> do
-            p <- loadPackage ctx pkgLoc flags [] []
-            tellExecutablesPackage loc p
-
-tellExecutablesPackage :: InstallLocation -> Package -> M ()
-tellExecutablesPackage loc p = do
-    cm <- asks combinedMap
-    -- Determine which components are enabled so we know which ones to copy
-    let myComps =
-            case Map.lookup (packageName p) cm of
-                Nothing -> assert False Set.empty
-                Just (PIOnlyInstalled _ _) -> Set.empty
-                Just (PIOnlySource ps) -> goSource ps
-                Just (PIBoth ps _) -> goSource ps
-
-        goSource (PSFilePath lp)
-            | lpWanted lp = exeComponents (lpComponents lp)
-            | otherwise = Set.empty
-        goSource PSRemote{} = Set.empty
-
-    tell mempty { wInstall = Map.fromList $ map (, loc) $ Set.toList $ filterComps myComps $ packageExes p }
-  where
-    filterComps myComps x
-        | Set.null myComps = x
-        | otherwise = Set.intersection x myComps
-
--- | Given a 'PackageSource' and perhaps an 'Installed' value, adds
--- build 'Task's for the package and its dependencies.
-installPackage :: PackageName
-               -> PackageSource
-               -> Maybe Installed
-               -> M (Either ConstructPlanException AddDepRes)
-installPackage name ps minstalled = do
-    ctx <- ask
-    case ps of
-        PSRemote pkgLoc _version _fromSnapshot cp -> do
-            planDebug $ "installPackage: Doing all-in-one build for upstream package " ++ show name
-            package <- loadPackage ctx pkgLoc (cpFlags cp) (cpGhcOptions cp) (cpCabalConfigOpts cp)
-            resolveDepsAndInstall True (cpHaddocks cp) ps package minstalled
-        PSFilePath lp -> do
-            case lpTestBench lp of
-                Nothing -> do
-                    planDebug $ "installPackage: No test / bench component for " ++ show name ++ " so doing an all-in-one build."
-                    resolveDepsAndInstall True (lpBuildHaddocks lp) ps (lpPackage lp) minstalled
-                Just tb -> do
-                    -- Attempt to find a plan which performs an all-in-one
-                    -- build.  Ignore the writer action + reset the state if
-                    -- it fails.
-                    s <- get
-                    res <- pass $ do
-                        res <- addPackageDeps tb
-                        let writerFunc w = case res of
-                                Left _ -> mempty
-                                _ -> w
-                        pure (res, writerFunc)
-                    case res of
-                        Right deps -> do
-                          planDebug $ "installPackage: For " ++ show name ++ ", successfully added package deps"
-                          -- in curator builds we can't do all-in-one build as test/benchmark failure
-                          -- could prevent library from being available to its dependencies
-                          -- but when it's already available it's OK to do that
-                          splitRequired <- expectedTestOrBenchFailures <$> asks mcurator
-                          let isAllInOne = not splitRequired
-                          adr <- installPackageGivenDeps isAllInOne (lpBuildHaddocks lp) ps tb minstalled deps
-                          let finalAllInOne = case adr of
-                                ADRToInstall _ | splitRequired -> False
-                                _ -> True
-                          -- FIXME: this redundantly adds the deps (but
-                          -- they'll all just get looked up in the map)
-                          addFinal lp tb finalAllInOne False
-                          pure $ Right adr
-                        Left _ -> do
-                            -- Reset the state to how it was before
-                            -- attempting to find an all-in-one build
-                            -- plan.
-                            planDebug $ "installPackage: Before trying cyclic plan, resetting lib result map to " ++ show s
-                            put s
-                            -- Otherwise, fall back on building the
-                            -- tests / benchmarks in a separate step.
-                            res' <- resolveDepsAndInstall False (lpBuildHaddocks lp) ps (lpPackage lp) minstalled
-                            when (isRight res') $ do
-                                -- Insert it into the map so that it's
-                                -- available for addFinal.
-                                updateLibMap name res'
-                                addFinal lp tb False False
-                            pure res'
- where
-   expectedTestOrBenchFailures maybeCurator = fromMaybe False $ do
-     curator <- maybeCurator
-     pure $ Set.member name (curatorExpectTestFailure curator) ||
-            Set.member name (curatorExpectBenchmarkFailure curator)
-
-resolveDepsAndInstall :: Bool
-                      -> Bool
-                      -> PackageSource
-                      -> Package
-                      -> Maybe Installed
-                      -> M (Either ConstructPlanException AddDepRes)
-resolveDepsAndInstall isAllInOne buildHaddocks ps package minstalled = do
-    res <- addPackageDeps package
-    case res of
-        Left err -> pure $ Left err
-        Right deps -> liftM Right $ installPackageGivenDeps isAllInOne buildHaddocks ps package minstalled deps
-
--- | Checks if we need to install the given 'Package', given the results
--- of 'addPackageDeps'. If dependencies are missing, the package is
--- dirty, or it's not installed, then it needs to be installed.
-installPackageGivenDeps :: Bool
-                        -> Bool
-                        -> PackageSource
-                        -> Package
-                        -> Maybe Installed
-                        -> ( Set PackageIdentifier
-                           , Map PackageIdentifier GhcPkgId
-                           , IsMutable )
-                        -> M AddDepRes
-installPackageGivenDeps isAllInOne buildHaddocks ps package minstalled (missing, present, minMutable) = do
-    let name = packageName package
-    ctx <- ask
-    mRightVersionInstalled <- case (minstalled, Set.null missing) of
-        (Just installed, True) -> do
-            shouldInstall <- checkDirtiness ps installed package present buildHaddocks
-            pure $ if shouldInstall then Nothing else Just installed
-        (Just _, False) -> do
-            let t = T.intercalate ", " $ map (T.pack . packageNameString . pkgName) (Set.toList missing)
-            tell mempty { wDirty = Map.singleton name $ "missing dependencies: " <> addEllipsis t }
-            pure Nothing
-        (Nothing, _) -> pure Nothing
-    let loc = psLocation ps
-        mutable = installLocationIsMutable loc <> minMutable
-    pure $ case mRightVersionInstalled of
-        Just installed -> ADRFound loc installed
-        Nothing -> ADRToInstall Task
-            { taskProvides = PackageIdentifier
-                (packageName package)
-                (packageVersion package)
-            , taskConfigOpts = TaskConfigOpts missing $ \missing' ->
-                let allDeps = Map.union present missing'
-                 in configureOpts
-                        (view envConfigL ctx)
-                        (baseConfigOpts ctx)
-                        allDeps
-                        (psLocal ps)
-                        mutable
-                        package
-            , taskBuildHaddock = buildHaddocks
-            , taskPresent = present
-            , taskType =
-                case ps of
-                    PSFilePath lp ->
-                      TTLocalMutable lp
-                    PSRemote pkgLoc _version _fromSnapshot _cp ->
-                      TTRemotePackage mutable package pkgLoc
-            , taskAllInOne = isAllInOne
-            , taskCachePkgSrc = toCachePkgSrc ps
-            , taskAnyMissing = not $ Set.null missing
-            , taskBuildTypeConfig = packageBuildTypeConfig package
-            }
-
--- | Is the build type of the package Configure
-packageBuildTypeConfig :: Package -> Bool
-packageBuildTypeConfig pkg = packageBuildType pkg == Configure
-
--- Update response in the lib map. If it is an error, and there's
--- already an error about cyclic dependencies, prefer the cyclic error.
-updateLibMap :: PackageName -> Either ConstructPlanException AddDepRes -> M ()
-updateLibMap name val = modify $ \mp ->
-    case (M.lookup name mp, val) of
-        (Just (Left DependencyCycleDetected{}), Left _) -> mp
-        _ -> M.insert name val mp
-
-addEllipsis :: Text -> Text
-addEllipsis t
-    | T.length t < 100 = t
-    | otherwise = T.take 97 t <> "..."
-
--- | Given a package, recurses into all of its dependencies. The results
--- indicate which packages are missing, meaning that their 'GhcPkgId's
--- will be figured out during the build, after they've been built. The
--- 2nd part of the tuple result indicates the packages that are already
--- installed which will be used.
---
--- The 3rd part of the tuple is an 'InstallLocation'. If it is 'Local',
--- then the parent package must be installed locally. Otherwise, if it
--- is 'Snap', then it can either be installed locally or in the
--- snapshot.
-addPackageDeps ::
-     Package
-  -> M ( Either
-           ConstructPlanException
-           ( Set PackageIdentifier
-           , Map PackageIdentifier GhcPkgId
-           , IsMutable
-           )
-       )
-addPackageDeps package = do
-    ctx <- ask
-    checkAndWarnForUnknownTools package
-    let deps' = packageDeps package
-    deps <- forM (Map.toList deps') $ \(depname, DepValue range depType) -> do
-        eres <- addDep depname
-        let getLatestApplicableVersionAndRev :: M (Maybe (Version, BlobKey))
-            getLatestApplicableVersionAndRev = do
-              vsAndRevs <- runRIO ctx $ getHackagePackageVersions YesRequireHackageIndex UsePreferredVersions depname
-              pure $ do
-                lappVer <- latestApplicableVersion range $ Map.keysSet vsAndRevs
-                revs <- Map.lookup lappVer vsAndRevs
-                (cabalHash, _) <- Map.maxView revs
-                Just (lappVer, cabalHash)
-        case eres of
-            Left e -> do
-                addParent depname range Nothing
-                let bd =
-                        case e of
-                            UnknownPackage name -> assert (name == depname) NotInBuildPlan
-                            DependencyCycleDetected names -> BDDependencyCycleDetected names
-                            -- ultimately we won't show any
-                            -- information on this to the user, we'll
-                            -- allow the dependency failures alone to
-                            -- display to avoid spamming the user too
-                            -- much
-                            DependencyPlanFailures _ _  -> Couldn'tResolveItsDependencies (packageVersion package)
-                mlatestApplicable <- getLatestApplicableVersionAndRev
-                pure $ Left (depname, (range, mlatestApplicable, bd))
-            Right adr | depType == AsLibrary && not (adrHasLibrary adr) ->
-                pure $ Left (depname, (range, Nothing, HasNoLibrary))
-            Right adr -> do
-                addParent depname range Nothing
-                inRange <- if adrVersion adr `withinRange` range
-                    then pure True
-                    else do
-                        let warn_ reason =
-                                tell mempty { wWarnings = (msg:) }
-                              where
-                                msg = T.concat
-                                    [ "WARNING: Ignoring "
-                                    , T.pack $ packageNameString $ packageName package
-                                    , "'s bounds on "
-                                    , T.pack $ packageNameString depname
-                                    , " ("
-                                    , versionRangeText range
-                                    , "); using "
-                                    , T.pack $ packageIdentifierString $ PackageIdentifier depname (adrVersion adr)
-                                    , ".\nReason: "
-                                    , reason
-                                    , "."
-                                    ]
-                        allowNewer <- view $ configL.to configAllowNewer
-                        allowNewerDeps <- view $ configL.to configAllowNewerDeps
-                        let inSnapshotCheck = do
-                                -- We ignore dependency information for packages in a snapshot
-                                x <- inSnapshot (packageName package) (packageVersion package)
-                                y <- inSnapshot depname (adrVersion adr)
-                                if x && y
-                                    then do
-                                        warn_ "trusting snapshot over Cabal file dependency information"
-                                        pure True
-                                    else pure False
-                        if allowNewer
-                            then do
-                                warn_ "allow-newer enabled"
-                                case allowNewerDeps of
-                                    Nothing -> pure True
-                                    Just boundsIgnoredDeps ->
-                                        pure $ packageName package `elem` boundsIgnoredDeps
-                            else do
-                                when (isJust allowNewerDeps) $
-                                    warn_ "allow-newer-deps are specified but allow-newer isn't enabled"
-                                inSnapshotCheck
-
-
-                if inRange
-                    then case adr of
-                        ADRToInstall task -> pure $ Right
-                            (Set.singleton $ taskProvides task, Map.empty, taskTargetIsMutable task)
-                        ADRFound loc (Executable _) -> pure $ Right
-                            (Set.empty, Map.empty, installLocationIsMutable loc)
-                        ADRFound loc (Library ident gid _) -> pure $ Right
-                            (Set.empty, Map.singleton ident gid, installLocationIsMutable loc)
-                    else do
-                        mlatestApplicable <- getLatestApplicableVersionAndRev
-                        pure $ Left (depname, (range, mlatestApplicable, DependencyMismatch $ adrVersion adr))
-    case partitionEithers deps of
-        -- Note that the Monoid for 'InstallLocation' means that if any
-        -- is 'Local', the result is 'Local', indicating that the parent
-        -- package must be installed locally. Otherwise the result is
-        -- 'Snap', indicating that the parent can either be installed
-        -- locally or in the snapshot.
-        ([], pairs) -> pure $ Right $ mconcat pairs
-        (errs, _) -> pure $ Left $ DependencyPlanFailures
-            package
-            (Map.fromList errs)
-  where
-    adrVersion (ADRToInstall task) = pkgVersion $ taskProvides task
-    adrVersion (ADRFound _ installed) = installedVersion installed
-    -- Update the parents map, for later use in plan construction errors
-    -- - see 'getShortestDepsPath'.
-    addParent depname range mversion = tell mempty { wParents = MonoidMap $ M.singleton depname val }
-      where
-        val = (First mversion, [(packageIdentifier package, range)])
-
-    adrHasLibrary :: AddDepRes -> Bool
-    adrHasLibrary (ADRToInstall task) = taskHasLibrary task
-    adrHasLibrary (ADRFound _ Library{}) = True
-    adrHasLibrary (ADRFound _ Executable{}) = False
-
-    taskHasLibrary :: Task -> Bool
-    taskHasLibrary task =
-      case taskType task of
-        TTLocalMutable lp -> packageHasLibrary $ lpPackage lp
-        TTRemotePackage _ p _ -> packageHasLibrary p
-
-    -- make sure we consider internal libraries as libraries too
-    packageHasLibrary :: Package -> Bool
-    packageHasLibrary p =
-      not (Set.null (packageInternalLibraries p)) ||
-      case packageLibraries p of
-        HasLibraries _ -> True
-        NoLibraries -> False
-
-checkDirtiness :: PackageSource
-               -> Installed
-               -> Package
-               -> Map PackageIdentifier GhcPkgId
-               -> Bool
-               -> M Bool
-checkDirtiness ps installed package present buildHaddocks = do
-    ctx <- ask
-    moldOpts <- runRIO ctx $ tryGetFlagCache installed
-    let configOpts = configureOpts
-            (view envConfigL ctx)
-            (baseConfigOpts ctx)
-            present
-            (psLocal ps)
-            (installLocationIsMutable $ psLocation ps) -- should be Local i.e. mutable always
-            package
-        wantConfigCache = ConfigCache
-            { configCacheOpts = configOpts
-            , configCacheDeps = Set.fromList $ Map.elems present
-            , configCacheComponents =
-                case ps of
-                    PSFilePath lp -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
-                    PSRemote{} -> Set.empty
-            , configCacheHaddock = buildHaddocks
-            , configCachePkgSrc = toCachePkgSrc ps
-            , configCachePathEnvVar = pathEnvVar ctx
-            }
-        config = view configL ctx
-    mreason <-
-      case moldOpts of
-        Nothing -> pure $ Just "old configure information not found"
-        Just oldOpts
-          | Just reason <- describeConfigDiff config oldOpts wantConfigCache -> pure $ Just reason
-          | True <- psForceDirty ps -> pure $ Just "--force-dirty specified"
-          | otherwise -> do
-              dirty <- psDirty ps
-              pure $
-                case dirty of
-                  Just files -> Just $ "local file changes: " <> addEllipsis (T.pack $ unwords $ Set.toList files)
-                  Nothing -> Nothing
-    case mreason of
-        Nothing -> pure False
-        Just reason -> do
-            tell mempty { wDirty = Map.singleton (packageName package) reason }
-            pure True
-
-describeConfigDiff :: Config -> ConfigCache -> ConfigCache -> Maybe Text
-describeConfigDiff config old new
-    | configCachePkgSrc old /= configCachePkgSrc new = Just $
-        "switching from " <>
-        pkgSrcName (configCachePkgSrc old) <> " to " <>
-        pkgSrcName (configCachePkgSrc new)
-    | not (configCacheDeps new `Set.isSubsetOf` configCacheDeps old) = Just "dependencies changed"
-    | not $ Set.null newComponents =
-        Just $ "components added: " `T.append` T.intercalate ", "
-            (map (decodeUtf8With lenientDecode) (Set.toList newComponents))
-    | not (configCacheHaddock old) && configCacheHaddock new = Just "rebuilding with haddocks"
-    | oldOpts /= newOpts = Just $ T.pack $ concat
-        [ "flags changed from "
-        , show oldOpts
-        , " to "
-        , show newOpts
-        ]
-    | otherwise = Nothing
-  where
-    stripGhcOptions =
-        go
-      where
-        go [] = []
-        go ("--ghc-option":x:xs) = go' Ghc x xs
-        go ("--ghc-options":x:xs) = go' Ghc x xs
-        go ((T.stripPrefix "--ghc-option=" -> Just x):xs) = go' Ghc x xs
-        go ((T.stripPrefix "--ghc-options=" -> Just x):xs) = go' Ghc x xs
-        go (x:xs) = x : go xs
-
-        go' wc x xs = checkKeepers wc x $ go xs
-
-        checkKeepers wc x xs =
-            case filter isKeeper $ T.words x of
-                [] -> xs
-                keepers -> T.pack (compilerOptionsCabalFlag wc) : T.unwords keepers : xs
-
-        -- GHC options which affect build results and therefore should always
-        -- force a rebuild
-        --
-        -- For the most part, we only care about options generated by Stack
-        -- itself
-        isKeeper = (== "-fhpc") -- more to be added later
-
-    userOpts = filter (not . isStackOpt)
-             . (if configRebuildGhcOptions config
-                   then id
-                   else stripGhcOptions)
-             . map T.pack
-             . (\(ConfigureOpts x y) -> x ++ y)
-             . configCacheOpts
-
-    (oldOpts, newOpts) = removeMatching (userOpts old) (userOpts new)
-
-    removeMatching (x:xs) (y:ys)
-        | x == y = removeMatching xs ys
-    removeMatching xs ys = (xs, ys)
-
-    newComponents = configCacheComponents new `Set.difference` configCacheComponents old
-
-    pkgSrcName (CacheSrcLocal fp) = T.pack fp
-    pkgSrcName CacheSrcUpstream = "upstream source"
-
-psForceDirty :: PackageSource -> Bool
-psForceDirty (PSFilePath lp) = lpForceDirty lp
-psForceDirty PSRemote{} = False
-
-psDirty
-  :: (MonadIO m, HasEnvConfig env, MonadReader env m)
-  => PackageSource
-  -> m (Maybe (Set FilePath))
-psDirty (PSFilePath lp) = runMemoizedWith $ lpDirtyFiles lp
-psDirty PSRemote {} = pure Nothing -- files never change in a remote package
-
-psLocal :: PackageSource -> Bool
-psLocal (PSFilePath _ ) = True
-psLocal PSRemote{} = False
-
-psLocation :: PackageSource -> InstallLocation
-psLocation (PSFilePath _) = Local
-psLocation PSRemote{} = Snap
-
--- | Get all of the dependencies for a given package, including build
--- tool dependencies.
-checkAndWarnForUnknownTools :: Package -> M ()
-checkAndWarnForUnknownTools p = do
-    -- Check whether the tool is on the PATH before warning about it.
-    warnings <- fmap catMaybes $ forM (Set.toList $ packageUnknownTools p) $
-      \name@(ExeName toolName) -> do
-        let settings = minimalEnvSettings { esIncludeLocals = True }
-        config <- view configL
-        menv <- liftIO $ configProcessContextSettings config settings
-        mfound <- runRIO menv $ findExecutable $ T.unpack toolName
-        case mfound of
-            Left _ -> pure $ Just $ ToolWarning name (packageName p)
-            Right _ -> pure Nothing
-    tell mempty { wWarnings = (map toolWarningText warnings ++) }
-    pure ()
-
--- | Warn about tools in the snapshot definition. States the tool name
--- expected and the package name using it.
-data ToolWarning = ToolWarning ExeName PackageName
-  deriving Show
-
-toolWarningText :: ToolWarning -> Text
-toolWarningText (ToolWarning (ExeName toolName) pkgName') =
-    "No packages found in snapshot which provide a " <>
-    T.pack (show toolName) <>
-    " executable, which is a build-tool dependency of " <>
-    T.pack (packageNameString pkgName')
-
--- | Strip out anything from the @Plan@ intended for the local database
-stripLocals :: Plan -> Plan
-stripLocals plan = plan
-    { planTasks = Map.filter checkTask $ planTasks plan
-    , planFinals = Map.empty
-    , planUnregisterLocal = Map.empty
-    , planInstallExes = Map.filter (/= Local) $ planInstallExes plan
-    }
-  where
-    checkTask task = taskLocation task == Snap
-
-stripNonDeps :: Set PackageName -> Plan -> Plan
-stripNonDeps deps plan = plan
-    { planTasks = Map.filter checkTask $ planTasks plan
-    , planFinals = Map.empty
-    , planInstallExes = Map.empty -- TODO maybe don't disable this?
-    }
-  where
-    checkTask task = taskProvides task `Set.member` missingForDeps
-    providesDep task = pkgName (taskProvides task) `Set.member` deps
-    missing = Map.fromList $ map (taskProvides &&& tcoMissing . taskConfigOpts) $
-              Map.elems (planTasks plan)
-    missingForDeps = flip execState mempty $ do
-      for_ (Map.elems $ planTasks plan) $ \task ->
-        when (providesDep task) $ collectMissing mempty (taskProvides task)
-
-    collectMissing dependents pid = do
-      when (pid `elem` dependents) $ impureThrow $ TaskCycleBug pid
-      modify'(<> Set.singleton pid)
-      mapM_ (collectMissing (pid:dependents)) (fromMaybe mempty $ M.lookup pid missing)
-
--- | Is the given package/version combo defined in the snapshot or in the global database?
-inSnapshot :: PackageName -> Version -> M Bool
-inSnapshot name version = do
-    ctx <- ask
-    pure $ fromMaybe False $ do
-        ps <- Map.lookup name (combinedMap ctx)
-        case ps of
-            PIOnlySource (PSRemote _ srcVersion FromSnapshot _) ->
-                pure $ srcVersion == version
-            PIBoth (PSRemote _ srcVersion FromSnapshot _) _ ->
-                pure $ srcVersion == version
-            -- OnlyInstalled occurs for global database
-            PIOnlyInstalled loc (Library pid _gid _lic) ->
-              assert (loc == Snap) $
-              assert (pkgVersion pid == version) $
-              Just True
-            _ -> pure False
-
--- TODO: Consider intersecting version ranges for multiple deps on a
--- package.  This is why VersionRange is in the parent map.
-
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+-- | Construct a @Plan@ for how to build
+module Stack.Build.ConstructPlan
+  ( constructPlan
+  ) where
+
+import           Control.Monad.RWS.Strict hiding ( (<>) )
+import qualified Data.List as L
+import qualified Data.Map.Merge.Strict as Map
+import qualified Data.Map.Strict as Map
+import           Data.Monoid.Map ( MonoidMap(..) )
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import           Distribution.Types.BuildType ( BuildType (Configure) )
+import           Distribution.Types.PackageName ( mkPackageName )
+import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
+import           Path ( parent )
+import           RIO.Process ( HasProcessContext (..), findExecutable )
+import           RIO.State ( State, execState )
+import           Stack.Build.Cache ( tryGetFlagCache )
+import           Stack.Build.Haddock ( shouldHaddockDeps )
+import           Stack.Build.Source ( loadLocalPackage )
+import           Stack.Constants ( compilerOptionsCabalFlag )
+import           Stack.Package ( applyForceCustomBuild )
+import           Stack.Prelude hiding ( loadPackage )
+import           Stack.SourceMap ( getPLIVersion, mkProjectPackage )
+import           Stack.Types.Build
+                   ( CachePkgSrc (..), ConfigCache (..), Plan (..), Task (..)
+                   , TaskConfigOpts (..), TaskType (..)
+                   , installLocationIsMutable, taskIsTarget, taskLocation
+                   , taskTargetIsMutable, toCachePkgSrc
+                   )
+import           Stack.Types.Build.Exception
+                   ( BadDependency (..), BuildException (..)
+                   , BuildPrettyException (..), ConstructPlanException (..)
+                   )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), stackYamlL )
+import           Stack.Types.BuildOpts
+                   ( BuildOpts (..), BuildOptsCLI (..), BuildSubset (..) )
+import           Stack.Types.Compiler ( WhichCompiler (..) )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), HasCompiler (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..), stackRootL )
+import           Stack.Types.ConfigureOpts
+                   ( BaseConfigOpts (..), ConfigureOpts (..), configureOpts )
+import           Stack.Types.Curator ( Curator (..) )
+import           Stack.Types.Dependency
+                   ( DepValue (DepValue), DepType (AsLibrary) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..) )
+import           Stack.Types.EnvSettings ( EnvSettings (..), minimalEnvSettings )
+import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
+import           Stack.Types.IsMutable ( IsMutable (..) )
+import           Stack.Types.NamedComponent ( exeComponents, renderComponent )
+import           Stack.Types.Package
+                   ( ExeName (..), InstallLocation (..), Installed (..)
+                   , InstalledMap, LocalPackage (..), Package (..)
+                   , PackageLibraries (..), PackageSource (..), installedVersion
+                   , packageIdentifier, psVersion, runMemoizedWith
+                   )
+import           Stack.Types.ParentMap ( ParentMap )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( HasRunner (..) )
+import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..), FromSnapshot (..)
+                   , GlobalPackage (..), SMTargets (..), SourceMap (..)
+                   )
+import           Stack.Types.Version
+                   ( latestApplicableVersion, versionRangeText, withinRange )
+import           System.Environment ( lookupEnv )
+import           System.IO ( putStrLn )
+
+data PackageInfo
+  = PIOnlyInstalled InstallLocation Installed
+    -- ^ This indicates that the package is already installed, and that we
+    -- shouldn't build it from source. This is only the case for global
+    -- packages.
+  | PIOnlySource PackageSource
+    -- ^ This indicates that the package isn't installed, and we know where to
+    -- find its source.
+  | PIBoth PackageSource Installed
+    -- ^ This indicates that the package is installed and we know where to find
+    -- its source. We may want to reinstall from source.
+  deriving Show
+
+combineSourceInstalled :: PackageSource
+                       -> (InstallLocation, Installed)
+                       -> PackageInfo
+combineSourceInstalled ps (location, installed) =
+  assert (psVersion ps == installedVersion installed) $
+    case location of
+      -- Always trust something in the snapshot
+      Snap -> PIOnlyInstalled location installed
+      Local -> PIBoth ps installed
+
+type CombinedMap = Map PackageName PackageInfo
+
+combineMap :: Map PackageName PackageSource -> InstalledMap -> CombinedMap
+combineMap = Map.merge
+  (Map.mapMissing (\_ s -> PIOnlySource s))
+  (Map.mapMissing (\_ i -> uncurry PIOnlyInstalled i))
+  (Map.zipWithMatched (\_ s i -> combineSourceInstalled s i))
+
+data AddDepRes
+  = ADRToInstall Task
+  | ADRFound InstallLocation Installed
+  deriving Show
+
+data W = W
+  { wFinals :: !(Map PackageName (Either ConstructPlanException Task))
+  , wInstall :: !(Map Text InstallLocation)
+    -- ^ executable to be installed, and location where the binary is placed
+  , wDirty :: !(Map PackageName Text)
+    -- ^ why a local package is considered dirty
+  , wWarnings :: !([StyleDoc] -> [StyleDoc])
+    -- ^ Warnings
+  , wParents :: !ParentMap
+    -- ^ Which packages a given package depends on, along with the package's
+    -- version
+  }
+  deriving Generic
+
+instance Semigroup W where
+  (<>) = mappenddefault
+
+instance Monoid W where
+  mempty = memptydefault
+  mappend = (<>)
+
+type M = RWST -- TODO replace with more efficient WS stack on top of (RIO Ctx).
+  Ctx
+  W
+  (Map PackageName (Either ConstructPlanException AddDepRes))
+  -- ^ Library map
+  IO
+
+data Ctx = Ctx
+  { baseConfigOpts :: !BaseConfigOpts
+  , loadPackage    :: !(  PackageLocationImmutable
+                       -> Map FlagName Bool
+                       -> [Text]
+                       -> [Text]
+                       -> M Package
+                       )
+  , combinedMap    :: !CombinedMap
+  , ctxEnvConfig   :: !EnvConfig
+  , callStack      :: ![PackageName]
+  , wanted         :: !(Set PackageName)
+  , localNames     :: !(Set PackageName)
+  , mcurator       :: !(Maybe Curator)
+  , pathEnvVar     :: !Text
+  }
+
+instance HasPlatform Ctx where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
+instance HasGHCVariant Ctx where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
+instance HasLogFunc Ctx where
+  logFuncL = configL.logFuncL
+
+instance HasRunner Ctx where
+  runnerL = configL.runnerL
+
+instance HasStylesUpdate Ctx where
+  stylesUpdateL = runnerL.stylesUpdateL
+
+instance HasTerm Ctx where
+  useColorL = runnerL.useColorL
+  termWidthL = runnerL.termWidthL
+
+instance HasConfig Ctx where
+  configL = buildConfigL.lens bcConfig (\x y -> x { bcConfig = y })
+  {-# INLINE configL #-}
+
+instance HasPantryConfig Ctx where
+  pantryConfigL = configL.pantryConfigL
+
+instance HasProcessContext Ctx where
+  processContextL = configL.processContextL
+
+instance HasBuildConfig Ctx where
+  buildConfigL = envConfigL.lens
+    envConfigBuildConfig
+    (\x y -> x { envConfigBuildConfig = y })
+
+instance HasSourceMap Ctx where
+  sourceMapL = envConfigL.sourceMapL
+
+instance HasCompiler Ctx where
+  compilerPathsL = envConfigL.compilerPathsL
+
+instance HasEnvConfig Ctx where
+  envConfigL = lens ctxEnvConfig (\x y -> x { ctxEnvConfig = y })
+
+-- | Computes a build plan. This means figuring out which build 'Task's to take,
+-- and the interdependencies among the build 'Task's. In particular:
+--
+-- 1) It determines which packages need to be built, based on the transitive
+-- deps of the current targets. For local packages, this is indicated by the
+-- 'lpWanted' boolean. For extra packages to build, this comes from the
+-- @extraToBuild0@ argument of type @Set PackageName@. These are usually
+-- packages that have been specified on the command line.
+--
+-- 2) It will only rebuild an upstream package if it isn't present in the
+-- 'InstalledMap', or if some of its dependencies have changed.
+--
+-- 3) It will only rebuild a local package if its files are dirty or some of its
+-- dependencies have changed.
+constructPlan ::
+     forall env. HasEnvConfig env
+  => BaseConfigOpts
+  -> [DumpPackage] -- ^ locally registered
+  -> (  PackageLocationImmutable
+     -> Map FlagName Bool
+     -> [Text]
+     -> [Text]
+     -> RIO EnvConfig Package
+     )
+     -- ^ load upstream package
+  -> SourceMap
+  -> InstalledMap
+  -> Bool
+  -> RIO env Plan
+constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap initialBuildSteps = do
+  logDebug "Constructing the build plan"
+
+  when hasBaseInDeps $
+    prettyWarn $
+         fillSep
+           [ flow "You are trying to upgrade or downgrade the"
+           , style Current "base"
+           , flow "package, which is almost certainly not what you really \
+                  \want. Please, consider using another GHC version if you \
+                  \need a certain version of"
+           , style Current "base" <> ","
+           , flow "or removing"
+           , style Current "base"
+           , flow "as an"
+           , style Shell "extra-deps" <> "."
+           , flow "For further information, see"
+           , style Url "https://github.com/commercialhaskell/stack/issues/3940" <> "."
+           ]
+      <> line
+
+  econfig <- view envConfigL
+  globalCabalVersion <- view $ compilerPathsL.to cpCabalVersion
+  sources <- getSources globalCabalVersion
+  mcur <- view $ buildConfigL.to bcCurator
+
+  let onTarget = void . addDep
+  let inner = mapM_ onTarget $ Map.keys (smtTargets $ smTargets sourceMap)
+  pathEnvVar' <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH"
+  let ctx = mkCtx econfig globalCabalVersion sources mcur pathEnvVar'
+  ((), m, W efinals installExes dirtyReason warnings parents) <-
+    liftIO $ runRWST inner ctx Map.empty
+  mapM_ prettyWarn (warnings [])
+  let toEither (_, Left e)  = Left e
+      toEither (k, Right v) = Right (k, v)
+      (errlibs, adrs) = partitionEithers $ map toEither $ Map.toList m
+      (errfinals, finals) = partitionEithers $ map toEither $ Map.toList efinals
+      errs = errlibs ++ errfinals
+  if null errs
+    then do
+      let toTask (_, ADRFound _ _) = Nothing
+          toTask (name, ADRToInstall task) = Just (name, task)
+          tasks = Map.fromList $ mapMaybe toTask adrs
+          takeSubset =
+            case boptsCLIBuildSubset $ bcoBuildOptsCLI baseConfigOpts0 of
+              BSAll -> pure
+              BSOnlySnapshot -> pure . stripLocals
+              BSOnlyDependencies ->
+                pure . stripNonDeps (Map.keysSet $ smDeps sourceMap)
+              BSOnlyLocals -> errorOnSnapshot
+      takeSubset Plan
+        { planTasks = tasks
+        , planFinals = Map.fromList finals
+        , planUnregisterLocal =
+            mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps
+        , planInstallExes =
+            if boptsInstallExes (bcoBuildOpts baseConfigOpts0) ||
+               boptsInstallCompilerTool (bcoBuildOpts baseConfigOpts0)
+                then installExes
+                else Map.empty
+        }
+    else do
+      planDebug $ show errs
+      stackYaml <- view stackYamlL
+      stackRoot <- view stackRootL
+      prettyThrowM $ ConstructPlanFailed
+        errs stackYaml stackRoot parents (wanted ctx) prunedGlobalDeps
+ where
+  hasBaseInDeps = Map.member (mkPackageName "base") (smDeps sourceMap)
+
+  mkCtx econfig globalCabalVersion sources mcur pathEnvVar' = Ctx
+    { baseConfigOpts = baseConfigOpts0
+    , loadPackage = \w x y z -> runRIO econfig $
+        applyForceCustomBuild globalCabalVersion <$> loadPackage0 w x y z
+    , combinedMap = combineMap sources installedMap
+    , ctxEnvConfig = econfig
+    , callStack = []
+    , wanted = Map.keysSet (smtTargets $ smTargets sourceMap)
+    , localNames = Map.keysSet (smProject sourceMap)
+    , mcurator = mcur
+    , pathEnvVar = pathEnvVar'
+    }
+
+  prunedGlobalDeps = flip Map.mapMaybe (smGlobal sourceMap) $
+    \case
+      ReplacedGlobalPackage deps ->
+        let pruned = filter (not . inSourceMap) deps
+        in  if null pruned then Nothing else Just pruned
+      GlobalPackage _ -> Nothing
+
+  inSourceMap pname = pname `Map.member` smDeps sourceMap ||
+                      pname `Map.member` smProject sourceMap
+
+  getSources :: Version -> RIO env (Map PackageName PackageSource)
+  getSources globalCabalVersion = do
+    let loadLocalPackage' pp = do
+          lp <- loadLocalPackage pp
+          let lpPackage' =
+                applyForceCustomBuild globalCabalVersion $ lpPackage lp
+          pure lp { lpPackage = lpPackage' }
+    pPackages <- for (smProject sourceMap) $ \pp -> do
+      lp <- loadLocalPackage' pp
+      pure $ PSFilePath lp
+    bopts <- view $ configL.to configBuild
+    deps <- for (smDeps sourceMap) $ \dp ->
+      case dpLocation dp of
+        PLImmutable loc ->
+          pure $
+            PSRemote loc (getPLIVersion loc) (dpFromSnapshot dp) (dpCommon dp)
+        PLMutable dir -> do
+          pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts)
+          lp <- loadLocalPackage' pp
+          pure $ PSFilePath lp
+    pure $ pPackages <> deps
+
+-- | Throw an exception if there are any snapshot packages in the plan.
+errorOnSnapshot :: Plan -> RIO env Plan
+errorOnSnapshot plan@(Plan tasks _finals _unregister installExes) = do
+  let snapTasks = Map.keys $ Map.filter (\t -> taskLocation t == Snap) tasks
+  let snapExes = Map.keys $ Map.filter (== Snap) installExes
+  unless (null snapTasks && null snapExes) $ throwIO $
+    NotOnlyLocal snapTasks snapExes
+  pure plan
+
+data NotOnlyLocal
+  = NotOnlyLocal [PackageName] [Text]
+  deriving (Show, Typeable)
+
+instance Exception NotOnlyLocal where
+  displayException (NotOnlyLocal packages exes) = concat
+    [ "Error: [S-1727]\n"
+    , "Specified only-locals, but I need to build snapshot contents:\n"
+    , if null packages then "" else concat
+        [ "Packages: "
+        , L.intercalate ", " (map packageNameString packages)
+        , "\n"
+        ]
+    , if null exes then "" else concat
+        [ "Executables: "
+        , L.intercalate ", " (map T.unpack exes)
+        , "\n"
+        ]
+    ]
+
+-- | State to be maintained during the calculation of local packages
+-- to unregister.
+data UnregisterState = UnregisterState
+  { usToUnregister :: !(Map GhcPkgId (PackageIdentifier, Text))
+  , usKeep :: ![DumpPackage]
+  , usAnyAdded :: !Bool
+  }
+
+-- | Determine which packages to unregister based on the given tasks and
+-- already registered local packages.
+mkUnregisterLocal ::
+     Map PackageName Task
+     -- ^ Tasks
+  -> Map PackageName Text
+     -- ^ Reasons why packages are dirty and must be rebuilt
+  -> [DumpPackage]
+     -- ^ Local package database dump
+  -> Bool
+     -- ^ If true, we're doing a special initialBuildSteps build - don't
+     -- unregister target packages.
+  -> Map GhcPkgId (PackageIdentifier, Text)
+mkUnregisterLocal tasks dirtyReason localDumpPkgs initialBuildSteps =
+  -- We'll take multiple passes through the local packages. This will allow us
+  -- to detect that a package should be unregistered, as well as all packages
+  -- directly or transitively depending on it.
+  loop Map.empty localDumpPkgs
+ where
+  loop ::
+       Map GhcPkgId (PackageIdentifier, Text)
+       -- ^ Current local packages to unregister.
+    -> [DumpPackage]
+       -- ^ Current local packages to keep.
+    -> Map GhcPkgId (PackageIdentifier, Text)
+       -- ^ Revised local packages to unregister.
+  loop toUnregister keep
+    -- If any new packages were added to the unregister Map, we need to loop
+    -- through the remaining packages again to detect if a transitive dependency
+    -- is being unregistered.
+    | usAnyAdded us = loop (usToUnregister us) (usKeep us)
+    -- Nothing added, so we've already caught them all. Return the Map we've
+    -- already calculated.
+    | otherwise = usToUnregister us
+   where
+    -- Run the unregister checking function on all packages we currently think
+    -- we'll be keeping.
+    us = execState (mapM_ go keep) initialUnregisterState
+    initialUnregisterState = UnregisterState
+      { usToUnregister = toUnregister
+      , usKeep = []
+      , usAnyAdded = False
+      }
+
+  go :: DumpPackage -> State UnregisterState ()
+  go dp = do
+    us <- get
+    case maybeUnregisterReason (usToUnregister us) ident mParentLibId deps of
+      -- Not unregistering, add it to the keep list.
+      Nothing -> put us { usKeep = dp : usKeep us }
+      -- Unregistering, add it to the unregister Map; and indicate that a
+      -- package was in fact added to the unregister Map, so we loop again.
+      Just reason -> put us
+        { usToUnregister = Map.insert gid (ident, reason) (usToUnregister us)
+        , usAnyAdded = True
+        }
+   where
+    gid = dpGhcPkgId dp
+    ident = dpPackageIdent dp
+    mParentLibId = dpParentLibIdent dp
+    deps = dpDepends dp
+
+  maybeUnregisterReason ::
+       Map GhcPkgId (PackageIdentifier, Text)
+       -- ^ Current local packages to unregister.
+    -> PackageIdentifier
+       -- ^ Package identifier.
+    -> Maybe PackageIdentifier
+       -- ^ If package for sub library, package identifier of the parent.
+    -> [GhcPkgId]
+       -- ^ Dependencies of the package.
+    -> Maybe Text
+       -- ^ If to be unregistered, the reason for doing so.
+  maybeUnregisterReason toUnregister ident mParentLibId deps
+    -- If the package is not for a sub library, then it is directly relevant. If
+    -- it is, then the relevant package is the parent. If we are planning on
+    -- running a task on the relevant package, then the package must be
+    -- unregistered, unless it is a target and an initial-build-steps build is
+    -- being done.
+    | Just task <- Map.lookup relevantPkgName tasks =
+        if    initialBuildSteps
+           && taskIsTarget task
+           && taskProvides task == relevantPkgId
+          then Nothing
+          else Just $ fromMaybe "" $ Map.lookup relevantPkgName dirtyReason
+    -- Check if a dependency is going to be unregistered
+    | (dep, _):_ <- mapMaybe (`Map.lookup` toUnregister) deps =
+        Just $ "Dependency being unregistered: "
+          <> T.pack (packageIdentifierString dep)
+    -- None of the above, keep it!
+    | otherwise = Nothing
+    where
+      -- If the package is not for a sub library, then the relevant package
+      -- identifier is that of the package. If it is, then the relevant package
+      -- identifier is that of the parent.
+      relevantPkgId :: PackageIdentifier
+      relevantPkgId = fromMaybe ident mParentLibId
+      -- If the package is not for a sub library, then the relevant package name
+      -- is that of the package. If it is, then the relevant package name is
+      -- that of the parent.
+      relevantPkgName :: PackageName
+      relevantPkgName = maybe (pkgName ident) pkgName mParentLibId
+
+-- | Given a 'LocalPackage' and its 'lpTestBench', adds a 'Task' for running its
+-- tests and benchmarks.
+--
+-- If @isAllInOne@ is 'True', then this means that the build step will also
+-- build the tests. Otherwise, this indicates that there's a cyclic dependency
+-- and an additional build step needs to be done.
+--
+-- This will also add all the deps needed to build the tests / benchmarks. If
+-- @isAllInOne@ is 'True' (the common case), then all of these should have
+-- already been taken care of as part of the build step.
+addFinal :: LocalPackage -> Package -> Bool -> Bool -> M ()
+addFinal lp package isAllInOne buildHaddocks = do
+  depsRes <- addPackageDeps package
+  res <- case depsRes of
+    Left e -> pure $ Left e
+    Right (missing, present, _minLoc) -> do
+      ctx <- ask
+      pure $ Right Task
+        { taskProvides = PackageIdentifier
+            (packageName package)
+            (packageVersion package)
+        , taskConfigOpts = TaskConfigOpts missing $ \missing' ->
+            let allDeps = Map.union present missing'
+            in  configureOpts
+                  (view envConfigL ctx)
+                  (baseConfigOpts ctx)
+                  allDeps
+                  True -- local
+                  Mutable
+                  package
+        , taskBuildHaddock = buildHaddocks
+        , taskPresent = present
+        , taskType = TTLocalMutable lp
+        , taskAllInOne = isAllInOne
+        , taskCachePkgSrc = CacheSrcLocal (toFilePath (parent (lpCabalFile lp)))
+        , taskAnyMissing = not $ Set.null missing
+        , taskBuildTypeConfig = packageBuildTypeConfig package
+        }
+  tell mempty { wFinals = Map.singleton (packageName package) res }
+
+-- | Given a 'PackageName', adds all of the build tasks to build the package, if
+-- needed. First checks if the package name is in the library map.
+--
+-- 'constructPlan' invokes this on all the target packages, setting
+-- @treatAsDep'@ to False, because those packages are direct build targets.
+-- 'addPackageDeps' invokes this while recursing into the dependencies of a
+-- package. As such, it sets @treatAsDep'@ to True, forcing this package to be
+-- marked as a dependency, even if it is directly wanted. This makes sense - if
+-- we left out packages that are deps, it would break the --only-dependencies
+-- build plan.
+addDep :: PackageName -> M (Either ConstructPlanException AddDepRes)
+addDep name = do
+  libMap <- get
+  case Map.lookup name libMap of
+    Just res -> do
+      planDebug $
+        "addDep: Using cached result for " ++ show name ++ ": " ++ show res
+      pure res
+    Nothing -> addDep' name
+
+-- | Given a 'PackageName', adds all of the build tasks to build the package.
+-- First checks that the package name is not already in the call stack.
+addDep' :: PackageName -> M (Either ConstructPlanException AddDepRes)
+addDep' name = do
+  ctx <- ask
+  let mpackageInfo = Map.lookup name $ combinedMap ctx
+  res <- if name `elem` callStack ctx
+    then do
+      planDebug $
+           "addDep': Detected cycle "
+        <> show name
+        <> ": "
+        <> show (callStack ctx)
+      pure $ Left $ DependencyCycleDetected $ name : callStack ctx
+    else local (\ctx' -> ctx' { callStack = name : callStack ctx' }) $ do
+      case mpackageInfo of
+        -- TODO look up in the package index and see if there's a
+        -- recommendation available
+        Nothing -> do
+          planDebug $
+               "addDep': No package info for "
+            <> show name
+          pure $ Left $ UnknownPackage name
+        Just packageInfo -> addDep'' name packageInfo
+  updateLibMap name res
+  pure res
+
+-- | Given a 'PackageName' and its 'PackageInfo' from the combined map, adds all
+-- of the build tasks to build the package. Assumes that the head of the call
+-- stack is the current package name.
+addDep'' ::
+     PackageName
+  -> PackageInfo
+  -> M (Either ConstructPlanException AddDepRes)
+addDep'' name packageInfo = do
+  planDebug $
+       "addDep'': Package info for "
+    <> show name
+    <> ": "
+    <> show packageInfo
+  case packageInfo of
+    PIOnlyInstalled loc installed -> do
+      -- FIXME Slightly hacky, no flags since they likely won't affect
+      -- executable names. This code does not feel right.
+      let version = installedVersion installed
+          askPkgLoc = liftRIO $ do
+            mrev <- getLatestHackageRevision YesRequireHackageIndex name version
+            case mrev of
+              Nothing -> do
+                -- This could happen for GHC boot libraries missing from
+                -- Hackage.
+                cs <- asks (L.tail . callStack)
+                prettyWarnL
+                  $ flow "No latest package revision found for"
+                  : style Current (fromString $ packageNameString name) <> ","
+                  : flow "dependency callstack:"
+                  : mkNarrativeList Nothing False
+                      (map (fromString . packageNameString) cs :: [StyleDoc])
+                pure Nothing
+              Just (_rev, cfKey, treeKey) ->
+                pure $ Just $
+                  PLIHackage (PackageIdentifier name version) cfKey treeKey
+      tellExecutablesUpstream name askPkgLoc loc Map.empty
+      pure $ Right $ ADRFound loc installed
+    PIOnlySource ps -> do
+      tellExecutables name ps
+      installPackage name ps Nothing
+    PIBoth ps installed -> do
+      tellExecutables name ps
+      installPackage name ps (Just installed)
+
+-- FIXME what's the purpose of this? Add a Haddock!
+tellExecutables :: PackageName -> PackageSource -> M ()
+tellExecutables _name (PSFilePath lp)
+  | lpWanted lp = tellExecutablesPackage Local $ lpPackage lp
+  | otherwise = pure ()
+-- Ignores ghcOptions because they don't matter for enumerating executables.
+tellExecutables name (PSRemote pkgloc _version _fromSnapshot cp) =
+  tellExecutablesUpstream name (pure $ Just pkgloc) Snap (cpFlags cp)
+
+tellExecutablesUpstream ::
+     PackageName
+  -> M (Maybe PackageLocationImmutable)
+  -> InstallLocation
+  -> Map FlagName Bool
+  -> M ()
+tellExecutablesUpstream name retrievePkgLoc loc flags = do
+  ctx <- ask
+  when (name `Set.member` wanted ctx) $ do
+    mPkgLoc <- retrievePkgLoc
+    forM_ mPkgLoc $ \pkgLoc -> do
+      p <- loadPackage ctx pkgLoc flags [] []
+      tellExecutablesPackage loc p
+
+tellExecutablesPackage :: InstallLocation -> Package -> M ()
+tellExecutablesPackage loc p = do
+  cm <- asks combinedMap
+  -- Determine which components are enabled so we know which ones to copy
+  let myComps =
+        case Map.lookup (packageName p) cm of
+          Nothing -> assert False Set.empty
+          Just (PIOnlyInstalled _ _) -> Set.empty
+          Just (PIOnlySource ps) -> goSource ps
+          Just (PIBoth ps _) -> goSource ps
+
+      goSource (PSFilePath lp)
+        | lpWanted lp = exeComponents (lpComponents lp)
+        | otherwise = Set.empty
+      goSource PSRemote{} = Set.empty
+
+  tell mempty
+    { wInstall = Map.fromList $
+        map (, loc) $ Set.toList $ filterComps myComps $ packageExes p
+    }
+ where
+  filterComps myComps x
+    | Set.null myComps = x
+    | otherwise = Set.intersection x myComps
+
+-- | Given a 'PackageSource' and perhaps an 'Installed' value, adds build
+-- 'Task's for the package and its dependencies.
+installPackage :: PackageName
+               -> PackageSource
+               -> Maybe Installed
+               -> M (Either ConstructPlanException AddDepRes)
+installPackage name ps minstalled = do
+  ctx <- ask
+  case ps of
+    PSRemote pkgLoc _version _fromSnapshot cp -> do
+      planDebug $
+           "installPackage: Doing all-in-one build for upstream package "
+        <> show name
+      package <- loadPackage
+        ctx pkgLoc (cpFlags cp) (cpGhcOptions cp) (cpCabalConfigOpts cp)
+      resolveDepsAndInstall True (cpHaddocks cp) ps package minstalled
+    PSFilePath lp -> do
+      case lpTestBench lp of
+        Nothing -> do
+          planDebug $
+               "installPackage: No test / bench component for "
+            <> show name
+            <> " so doing an all-in-one build."
+          resolveDepsAndInstall
+            True (lpBuildHaddocks lp) ps (lpPackage lp) minstalled
+        Just tb -> do
+          -- Attempt to find a plan which performs an all-in-one build. Ignore
+          -- the writer action + reset the state if it fails.
+          libMap <- get
+          res <- pass $ do
+            res <- addPackageDeps tb
+            let writerFunc w = case res of
+                  Left _ -> mempty
+                  _ -> w
+            pure (res, writerFunc)
+          case res of
+            Right deps -> do
+              planDebug $
+                   "installPackage: For "
+                <> show name
+                <> ", successfully added package deps"
+              -- in curator builds we can't do all-in-one build as
+              -- test/benchmark failure could prevent library from being
+              -- available to its dependencies but when it's already available
+              -- it's OK to do that
+              splitRequired <- expectedTestOrBenchFailures <$> asks mcurator
+              let isAllInOne = not splitRequired
+              adr <- installPackageGivenDeps
+                isAllInOne (lpBuildHaddocks lp) ps tb minstalled deps
+              let finalAllInOne = case adr of
+                    ADRToInstall _ | splitRequired -> False
+                    _ -> True
+              -- FIXME: this redundantly adds the deps (but they'll all just
+              -- get looked up in the map)
+              addFinal lp tb finalAllInOne False
+              pure $ Right adr
+            Left _ -> do
+              -- Reset the state to how it was before attempting to find an
+              -- all-in-one build plan.
+              planDebug $
+                   "installPackage: Before trying cyclic plan, resetting lib \
+                   \result map to "
+                <> show libMap
+              put libMap
+              -- Otherwise, fall back on building the tests / benchmarks in a
+              -- separate step.
+              res' <- resolveDepsAndInstall
+                False (lpBuildHaddocks lp) ps (lpPackage lp) minstalled
+              when (isRight res') $ do
+                -- Insert it into the map so that it's available for addFinal.
+                updateLibMap name res'
+                addFinal lp tb False False
+              pure res'
+ where
+  expectedTestOrBenchFailures maybeCurator = fromMaybe False $ do
+    curator <- maybeCurator
+    pure $ Set.member name (curatorExpectTestFailure curator) ||
+           Set.member name (curatorExpectBenchmarkFailure curator)
+
+resolveDepsAndInstall :: Bool
+                      -> Bool
+                      -> PackageSource
+                      -> Package
+                      -> Maybe Installed
+                      -> M (Either ConstructPlanException AddDepRes)
+resolveDepsAndInstall isAllInOne buildHaddocks ps package minstalled = do
+  res <- addPackageDeps package
+  case res of
+    Left err -> pure $ Left err
+    Right deps ->
+      Right <$>
+        installPackageGivenDeps
+          isAllInOne buildHaddocks ps package minstalled deps
+
+-- | Checks if we need to install the given 'Package', given the results
+-- of 'addPackageDeps'. If dependencies are missing, the package is dirty, or
+-- it's not installed, then it needs to be installed.
+installPackageGivenDeps :: Bool
+                        -> Bool
+                        -> PackageSource
+                        -> Package
+                        -> Maybe Installed
+                        -> ( Set PackageIdentifier
+                           , Map PackageIdentifier GhcPkgId
+                           , IsMutable )
+                        -> M AddDepRes
+installPackageGivenDeps isAllInOne buildHaddocks ps package minstalled
+  (missing, present, minMutable) = do
+    let name = packageName package
+    ctx <- ask
+    mRightVersionInstalled <- case (minstalled, Set.null missing) of
+      (Just installed, True) -> do
+        shouldInstall <-
+          checkDirtiness ps installed package present buildHaddocks
+        pure $ if shouldInstall then Nothing else Just installed
+      (Just _, False) -> do
+        let t = T.intercalate ", " $
+                  map (T.pack . packageNameString . pkgName) (Set.toList missing)
+        tell mempty
+          { wDirty =
+              Map.singleton name $ "missing dependencies: " <> addEllipsis t
+          }
+        pure Nothing
+      (Nothing, _) -> pure Nothing
+    let loc = psLocation ps
+        mutable = installLocationIsMutable loc <> minMutable
+    pure $ case mRightVersionInstalled of
+      Just installed -> ADRFound loc installed
+      Nothing -> ADRToInstall Task
+        { taskProvides = PackageIdentifier
+            (packageName package)
+            (packageVersion package)
+        , taskConfigOpts = TaskConfigOpts missing $ \missing' ->
+            let allDeps = Map.union present missing'
+            in  configureOpts
+                  (view envConfigL ctx)
+                  (baseConfigOpts ctx)
+                  allDeps
+                  (psLocal ps)
+                  mutable
+                  package
+        , taskBuildHaddock = buildHaddocks
+        , taskPresent = present
+        , taskType =
+            case ps of
+              PSFilePath lp ->
+                TTLocalMutable lp
+              PSRemote pkgLoc _version _fromSnapshot _cp ->
+                TTRemotePackage mutable package pkgLoc
+        , taskAllInOne = isAllInOne
+        , taskCachePkgSrc = toCachePkgSrc ps
+        , taskAnyMissing = not $ Set.null missing
+        , taskBuildTypeConfig = packageBuildTypeConfig package
+        }
+
+-- | Is the build type of the package Configure
+packageBuildTypeConfig :: Package -> Bool
+packageBuildTypeConfig pkg = packageBuildType pkg == Configure
+
+-- Update response in the library map. If it is an error, and there's already an
+-- error about cyclic dependencies, prefer the cyclic error.
+updateLibMap :: PackageName -> Either ConstructPlanException AddDepRes -> M ()
+updateLibMap name val = modify $ \mp ->
+  case (Map.lookup name mp, val) of
+    (Just (Left DependencyCycleDetected{}), Left _) -> mp
+    _ -> Map.insert name val mp
+
+addEllipsis :: Text -> Text
+addEllipsis t
+  | T.length t < 100 = t
+  | otherwise = T.take 97 t <> "..."
+
+-- | Given a package, recurses into all of its dependencies. The results
+-- indicate which packages are missing, meaning that their 'GhcPkgId's will be
+-- figured out during the build, after they've been built. The 2nd part of the
+-- tuple result indicates the packages that are already installed which will be
+-- used.
+--
+-- The 3rd part of the tuple is an 'InstallLocation'. If it is 'Local', then the
+-- parent package must be installed locally. Otherwise, if it is 'Snap', then it
+-- can either be installed locally or in the snapshot.
+addPackageDeps ::
+     Package
+  -> M ( Either
+           ConstructPlanException
+           ( Set PackageIdentifier
+           , Map PackageIdentifier GhcPkgId
+           , IsMutable
+           )
+       )
+addPackageDeps package = do
+  ctx <- ask
+  checkAndWarnForUnknownTools package
+  let deps' = packageDeps package
+  deps <- forM (Map.toList deps') $ \(depname, DepValue range depType) -> do
+    eres <- addDep depname
+    let getLatestApplicableVersionAndRev :: M (Maybe (Version, BlobKey))
+        getLatestApplicableVersionAndRev = do
+          vsAndRevs <-
+            runRIO ctx $
+              getHackagePackageVersions
+                YesRequireHackageIndex UsePreferredVersions depname
+          pure $ do
+            lappVer <- latestApplicableVersion range $ Map.keysSet vsAndRevs
+            revs <- Map.lookup lappVer vsAndRevs
+            (cabalHash, _) <- Map.maxView revs
+            Just (lappVer, cabalHash)
+    case eres of
+      Left e -> do
+        addParent depname range Nothing
+        let bd = case e of
+              UnknownPackage name -> assert (name == depname) NotInBuildPlan
+              DependencyCycleDetected names -> BDDependencyCycleDetected names
+              -- ultimately we won't show any information on this to the user,
+              -- we'll allow the dependency failures alone to display to avoid
+              -- spamming the user too much
+              DependencyPlanFailures _ _  ->
+                Couldn'tResolveItsDependencies (packageVersion package)
+        mlatestApplicable <- getLatestApplicableVersionAndRev
+        pure $ Left (depname, (range, mlatestApplicable, bd))
+      Right adr | depType == AsLibrary && not (adrHasLibrary adr) ->
+        pure $ Left (depname, (range, Nothing, HasNoLibrary))
+      Right adr -> do
+        addParent depname range Nothing
+        inRange <- if adrVersion adr `withinRange` range
+          then pure True
+          else do
+            let warn_ isIgnoring reason = tell mempty { wWarnings = (msg:) }
+                 where
+                  msg =
+                       fillSep
+                         [ if isIgnoring then "Ignoring" else flow "Not ignoring"
+                         , style Current (fromString . packageNameString $ packageName package) <> "'s"
+                         , flow "bounds on"
+                         , style Current (fromString $ packageNameString depname)
+                         , parens (fromString . T.unpack $ versionRangeText range)
+                         , flow "and using"
+                         , style Current (fromString . packageIdentifierString $
+                             PackageIdentifier depname (adrVersion adr)) <> "."
+                         ]
+                    <> line
+                    <> fillSep
+                         [ "Reason:"
+                         , reason <> "."
+                         ]
+            allowNewer <- view $ configL.to configAllowNewer
+            allowNewerDeps <- view $ configL.to configAllowNewerDeps
+            let inSnapshotCheck = do
+                  -- We ignore dependency information for packages in a snapshot
+                  x <- inSnapshot (packageName package) (packageVersion package)
+                  y <- inSnapshot depname (adrVersion adr)
+                  if x && y
+                    then do
+                      warn_ True
+                        ( flow "trusting snapshot over Cabal file dependency \
+                               \information"
+                        )
+                      pure True
+                    else pure False
+            if allowNewer
+              then case allowNewerDeps of
+                Nothing -> do
+                  warn_ True $
+                    fillSep
+                      [ style Shell "allow-newer"
+                      , "enabled"
+                      ]
+                  pure True
+                Just boundsIgnoredDeps -> do
+                  let pkgName = packageName package
+                      pkgName' = fromString $ packageNameString pkgName
+                      isBoundsIgnoreDep = pkgName `elem` boundsIgnoredDeps
+                      reason = if isBoundsIgnoreDep
+                        then fillSep
+                          [ style Current pkgName'
+                          , flow "is an"
+                          , style Shell "allow-newer-dep"
+                          , flow "and"
+                          , style Shell "allow-newer"
+                          , "enabled"
+                          ]
+                        else fillSep
+                          [ style Current pkgName'
+                          , flow "is not an"
+                          , style Shell "allow-newer-dep"
+                          , flow "although"
+                          , style Shell "allow-newer"
+                          , "enabled"
+                          ]
+                  warn_ isBoundsIgnoreDep reason
+                  pure isBoundsIgnoreDep
+              else do
+                when (isJust allowNewerDeps) $
+                  warn_ False $
+                    fillSep
+                      [ "although"
+                      , style Shell "allow-newer-deps"
+                      , flow "are specified,"
+                      , style Shell "allow-newer"
+                      , "is"
+                      , style Shell "false"
+                      ]
+                inSnapshotCheck
+        if inRange
+          then case adr of
+            ADRToInstall task -> pure $ Right
+              ( Set.singleton $ taskProvides task
+              , Map.empty, taskTargetIsMutable task
+              )
+            ADRFound loc (Executable _) -> pure $ Right
+              ( Set.empty, Map.empty
+              , installLocationIsMutable loc
+              )
+            ADRFound loc (Library ident gid _) -> pure $ Right
+              ( Set.empty, Map.singleton ident gid
+              , installLocationIsMutable loc
+              )
+          else do
+            mlatestApplicable <- getLatestApplicableVersionAndRev
+            pure $ Left
+              ( depname
+              , ( range
+                , mlatestApplicable
+                , DependencyMismatch $ adrVersion adr
+                )
+              )
+  case partitionEithers deps of
+    -- Note that the Monoid for 'InstallLocation' means that if any
+    -- is 'Local', the result is 'Local', indicating that the parent
+    -- package must be installed locally. Otherwise the result is
+    -- 'Snap', indicating that the parent can either be installed
+    -- locally or in the snapshot.
+    ([], pairs) -> pure $ Right $ mconcat pairs
+    (errs, _) -> pure $ Left $ DependencyPlanFailures
+      package
+      (Map.fromList errs)
+ where
+  adrVersion (ADRToInstall task) = pkgVersion $ taskProvides task
+  adrVersion (ADRFound _ installed) = installedVersion installed
+  -- Update the parents map, for later use in plan construction errors
+  -- - see 'getShortestDepsPath'.
+  addParent depname range mversion =
+    tell mempty { wParents = MonoidMap $ Map.singleton depname val }
+   where
+    val = (First mversion, [(packageIdentifier package, range)])
+
+  adrHasLibrary :: AddDepRes -> Bool
+  adrHasLibrary (ADRToInstall task) = taskHasLibrary task
+  adrHasLibrary (ADRFound _ Library{}) = True
+  adrHasLibrary (ADRFound _ Executable{}) = False
+
+  taskHasLibrary :: Task -> Bool
+  taskHasLibrary task =
+    case taskType task of
+      TTLocalMutable lp -> packageHasLibrary $ lpPackage lp
+      TTRemotePackage _ p _ -> packageHasLibrary p
+
+  -- make sure we consider internal libraries as libraries too
+  packageHasLibrary :: Package -> Bool
+  packageHasLibrary p =
+    not (Set.null (packageInternalLibraries p)) ||
+    case packageLibraries p of
+      HasLibraries _ -> True
+      NoLibraries -> False
+
+checkDirtiness :: PackageSource
+               -> Installed
+               -> Package
+               -> Map PackageIdentifier GhcPkgId
+               -> Bool
+               -> M Bool
+checkDirtiness ps installed package present buildHaddocks = do
+  ctx <- ask
+  moldOpts <- runRIO ctx $ tryGetFlagCache installed
+  let configOpts = configureOpts
+        (view envConfigL ctx)
+        (baseConfigOpts ctx)
+        present
+        (psLocal ps)
+        (installLocationIsMutable $ psLocation ps) -- should be Local i.e. mutable always
+        package
+      wantConfigCache = ConfigCache
+        { configCacheOpts = configOpts
+        , configCacheDeps = Set.fromList $ Map.elems present
+        , configCacheComponents =
+            case ps of
+              PSFilePath lp ->
+                Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
+              PSRemote{} -> Set.empty
+        , configCacheHaddock = buildHaddocks
+        , configCachePkgSrc = toCachePkgSrc ps
+        , configCachePathEnvVar = pathEnvVar ctx
+        }
+      config = view configL ctx
+  mreason <-
+    case moldOpts of
+      Nothing -> pure $ Just "old configure information not found"
+      Just oldOpts
+        | Just reason <- describeConfigDiff config oldOpts wantConfigCache ->
+            pure $ Just reason
+        | True <- psForceDirty ps -> pure $ Just "--force-dirty specified"
+        | otherwise -> do
+            dirty <- psDirty ps
+            pure $
+              case dirty of
+                Just files -> Just $
+                     "local file changes: "
+                  <> addEllipsis (T.pack $ unwords $ Set.toList files)
+                Nothing -> Nothing
+  case mreason of
+    Nothing -> pure False
+    Just reason -> do
+      tell mempty { wDirty = Map.singleton (packageName package) reason }
+      pure True
+
+describeConfigDiff :: Config -> ConfigCache -> ConfigCache -> Maybe Text
+describeConfigDiff config old new
+  | configCachePkgSrc old /= configCachePkgSrc new = Just $
+      "switching from " <>
+      pkgSrcName (configCachePkgSrc old) <> " to " <>
+      pkgSrcName (configCachePkgSrc new)
+  | not (configCacheDeps new `Set.isSubsetOf` configCacheDeps old) =
+      Just "dependencies changed"
+  | not $ Set.null newComponents =
+      Just $ "components added: " `T.append` T.intercalate ", "
+          (map (decodeUtf8With lenientDecode) (Set.toList newComponents))
+  | not (configCacheHaddock old) && configCacheHaddock new =
+      Just "rebuilding with haddocks"
+  | oldOpts /= newOpts = Just $ T.pack $ concat
+      [ "flags changed from "
+      , show oldOpts
+      , " to "
+      , show newOpts
+      ]
+  | otherwise = Nothing
+ where
+  stripGhcOptions = go
+   where
+    go [] = []
+    go ("--ghc-option":x:xs) = go' Ghc x xs
+    go ("--ghc-options":x:xs) = go' Ghc x xs
+    go ((T.stripPrefix "--ghc-option=" -> Just x):xs) = go' Ghc x xs
+    go ((T.stripPrefix "--ghc-options=" -> Just x):xs) = go' Ghc x xs
+    go (x:xs) = x : go xs
+
+    go' wc x xs = checkKeepers wc x $ go xs
+
+    checkKeepers wc x xs =
+      case filter isKeeper $ T.words x of
+        [] -> xs
+        keepers -> T.pack (compilerOptionsCabalFlag wc) : T.unwords keepers : xs
+
+    -- GHC options which affect build results and therefore should always force
+    -- a rebuild
+    --
+    -- For the most part, we only care about options generated by Stack itself
+    isKeeper = (== "-fhpc") -- more to be added later
+
+  userOpts = filter (not . isStackOpt)
+           . (if configRebuildGhcOptions config
+                then id
+                else stripGhcOptions)
+           . map T.pack
+           . (\(ConfigureOpts x y) -> x ++ y)
+           . configCacheOpts
+   where
+    -- options set by Stack
+    isStackOpt :: Text -> Bool
+    isStackOpt t = any (`T.isPrefixOf` t)
+      [ "--dependency="
+      , "--constraint="
+      , "--package-db="
+      , "--libdir="
+      , "--bindir="
+      , "--datadir="
+      , "--libexecdir="
+      , "--sysconfdir"
+      , "--docdir="
+      , "--htmldir="
+      , "--haddockdir="
+      , "--enable-tests"
+      , "--enable-benchmarks"
+      , "--exact-configuration"
+      -- Treat these as causing dirtiness, to resolve
+      -- https://github.com/commercialhaskell/stack/issues/2984
+      --
+      -- , "--enable-library-profiling"
+      -- , "--enable-executable-profiling"
+      -- , "--enable-profiling"
+      ] || t == "--user"
+
+  (oldOpts, newOpts) = removeMatching (userOpts old) (userOpts new)
+
+  removeMatching (x:xs) (y:ys)
+    | x == y = removeMatching xs ys
+  removeMatching xs ys = (xs, ys)
+
+  newComponents =
+    configCacheComponents new `Set.difference` configCacheComponents old
+
+  pkgSrcName (CacheSrcLocal fp) = T.pack fp
+  pkgSrcName CacheSrcUpstream = "upstream source"
+
+psForceDirty :: PackageSource -> Bool
+psForceDirty (PSFilePath lp) = lpForceDirty lp
+psForceDirty PSRemote{} = False
+
+psDirty ::
+     (MonadIO m, HasEnvConfig env, MonadReader env m)
+  => PackageSource
+  -> m (Maybe (Set FilePath))
+psDirty (PSFilePath lp) = runMemoizedWith $ lpDirtyFiles lp
+psDirty PSRemote {} = pure Nothing -- files never change in a remote package
+
+psLocal :: PackageSource -> Bool
+psLocal (PSFilePath _ ) = True
+psLocal PSRemote{} = False
+
+psLocation :: PackageSource -> InstallLocation
+psLocation (PSFilePath _) = Local
+psLocation PSRemote{} = Snap
+
+-- | Get all of the dependencies for a given package, including build
+-- tool dependencies.
+checkAndWarnForUnknownTools :: Package -> M ()
+checkAndWarnForUnknownTools p = do
+  -- Check whether the tool is on the PATH before warning about it.
+  warnings <- fmap catMaybes $ forM (Set.toList $ packageUnknownTools p) $
+    \name@(ExeName toolName) -> do
+      let settings = minimalEnvSettings { esIncludeLocals = True }
+      config <- view configL
+      menv <- liftIO $ configProcessContextSettings config settings
+      mfound <- runRIO menv $ findExecutable $ T.unpack toolName
+      case mfound of
+        Left _ -> pure $ Just $ ToolWarning name (packageName p)
+        Right _ -> pure Nothing
+  tell mempty { wWarnings = (map toolWarningText warnings ++) }
+  pure ()
+
+-- | Warn about tools in the snapshot definition. States the tool name
+-- expected and the package name using it.
+data ToolWarning
+  = ToolWarning ExeName PackageName
+  deriving Show
+
+toolWarningText :: ToolWarning -> StyleDoc
+toolWarningText (ToolWarning (ExeName toolName) pkgName') = fillSep
+  [ flow "No packages found in snapshot which provide a"
+  , style PkgComponent (fromString $ show toolName)
+  , flow "executable, which is a build-tool dependency of"
+  , style Current (fromString $ packageNameString pkgName')
+  ]
+
+-- | Strip out anything from the @Plan@ intended for the local database
+stripLocals :: Plan -> Plan
+stripLocals plan = plan
+  { planTasks = Map.filter checkTask $ planTasks plan
+  , planFinals = Map.empty
+  , planUnregisterLocal = Map.empty
+  , planInstallExes = Map.filter (/= Local) $ planInstallExes plan
+  }
+ where
+  checkTask task = taskLocation task == Snap
+
+stripNonDeps :: Set PackageName -> Plan -> Plan
+stripNonDeps deps plan = plan
+  { planTasks = Map.filter checkTask $ planTasks plan
+  , planFinals = Map.empty
+  , planInstallExes = Map.empty -- TODO maybe don't disable this?
+  }
+ where
+  checkTask task = taskProvides task `Set.member` missingForDeps
+  providesDep task = pkgName (taskProvides task) `Set.member` deps
+  missing = Map.fromList $ map (taskProvides &&& tcoMissing . taskConfigOpts) $
+            Map.elems (planTasks plan)
+  missingForDeps = flip execState mempty $
+    for_ (Map.elems $ planTasks plan) $ \task ->
+      when (providesDep task) $
+        collectMissing mempty (taskProvides task)
+
+  collectMissing dependents pid = do
+    when (pid `elem` dependents) $
+      impureThrow $ TaskCycleBug pid
+    modify' (<> Set.singleton pid)
+    mapM_ (collectMissing (pid:dependents)) (fromMaybe mempty $ Map.lookup pid missing)
+
+-- | Is the given package/version combo defined in the snapshot or in the global
+-- database?
+inSnapshot :: PackageName -> Version -> M Bool
+inSnapshot name version = do
+  ctx <- ask
+  pure $ fromMaybe False $ do
+    ps <- Map.lookup name (combinedMap ctx)
+    case ps of
+      PIOnlySource (PSRemote _ srcVersion FromSnapshot _) ->
+        pure $ srcVersion == version
+      PIBoth (PSRemote _ srcVersion FromSnapshot _) _ ->
+        pure $ srcVersion == version
+      -- OnlyInstalled occurs for global database
+      PIOnlyInstalled loc (Library pid _gid _lic) ->
+        assert (loc == Snap) $
+        assert (pkgVersion pid == version) $
+        Just True
+      _ -> pure False
+
+-- TODO: Consider intersecting version ranges for multiple deps on a
+-- package.  This is why VersionRange is in the parent map.
 
 -- Switch this to 'True' to enable some debugging putStrLn in this module
 planDebug :: MonadIO m => String -> m ()
src/Stack/Build/Execute.hs view
@@ -1,2361 +1,2810 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TupleSections         #-}
-{-# LANGUAGE TypeFamilies          #-}
-
--- | Perform a build
-module Stack.Build.Execute
-  ( printPlan
-  , preFetch
-  , executePlan
-  -- * Running Setup.hs
-  , ExecuteEnv
-  , withExecuteEnv
-  , withSingleContext
-  , ExcludeTHLoading (..)
-  , KeepOutputOpen (..)
-  ) where
-
-import           Control.Concurrent.Execute
-import           Control.Concurrent.STM ( check )
-import           Crypto.Hash
-import           Data.Attoparsec.Text ( char, choice, digit, parseOnly )
-import qualified Data.Attoparsec.Text as P ( string )
-import qualified Data.ByteArray as Mem ( convert )
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Builder
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Base64.URL as B64URL
-import           Data.Char ( isSpace )
-import           Conduit
-import qualified Data.Conduit.Binary as CB
-import qualified Data.Conduit.Filesystem as CF
-import qualified Data.Conduit.List as CL
-import           Data.Conduit.Process.Typed ( createSource )
-import qualified Data.Conduit.Text as CT
-import qualified Data.List as L
-import           Data.List.NonEmpty ( nonEmpty )
-import qualified Data.List.NonEmpty as NonEmpty ( toList )
-import           Data.List.Split ( chunksOf )
-import qualified Data.Map.Strict as M
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import           Data.Text.Encoding ( decodeUtf8 )
-import           Data.Tuple
-import           Data.Time
-                   ( ZonedTime, getZonedTime, formatTime, defaultTimeLocale )
-import qualified Data.ByteString.Char8 as S8
-import qualified Distribution.PackageDescription as C
-import qualified Distribution.Simple.Build.Macros as C
-import           Distribution.System ( OS (Windows), Platform (Platform) )
-import qualified Distribution.Text as C
-import           Distribution.Types.PackageName ( mkPackageName )
-import           Distribution.Types.UnqualComponentName
-                   ( mkUnqualComponentName )
-import           Distribution.Verbosity ( showForCabal )
-import           Distribution.Version ( mkVersion )
-import           Pantry.Internal.Companion
-import           Path
-import           Path.CheckInstall
-import           Path.Extra ( toFilePathNoTrailingSep, rejectMissingFile )
-import           Path.IO
-                   hiding ( findExecutable, makeAbsolute, withSystemTempDir )
-import           RIO.Process
-import           Stack.Build.Cache
-import           Stack.Build.Haddock
-import           Stack.Build.Installed
-import           Stack.Build.Source
-import           Stack.Build.Target
-import           Stack.Config
-import           Stack.Constants
-import           Stack.Constants.Config
-import           Stack.Coverage
-import           Stack.DefaultColorWhen ( defaultColorWhen )
-import           Stack.GhcPkg
-import           Stack.Package
-import           Stack.PackageDump
-import           Stack.Prelude
-import           Stack.Types.Build
-import           Stack.Types.Compiler
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
-import           Stack.Types.Package
-import           Stack.Types.PackageFile
-import           Stack.Types.Version
-import qualified System.Directory as D
-import           System.Environment ( getExecutablePath, lookupEnv )
-import           System.FileLock
-                   ( withTryFileLock, SharedExclusive (Exclusive)
-                   , withFileLock
-                   )
-import qualified System.FilePath as FP
-import           System.IO.Error ( isDoesNotExistError )
-import           System.PosixCompat.Files
-                   ( createLink, modificationTime, getFileStatus )
-import           System.Random ( randomIO )
-
--- | Has an executable been built or not?
-data ExecutableBuildStatus
-    = ExecutableBuilt
-    | ExecutableNotBuilt
-  deriving (Show, Eq, Ord)
-
--- | Fetch the packages necessary for a build, for example in combination with a dry run.
-preFetch :: HasEnvConfig env => Plan -> RIO env ()
-preFetch plan
-    | Set.null pkgLocs = logDebug "Nothing to fetch"
-    | otherwise = do
-        logDebug $
-            "Prefetching: " <>
-            mconcat (L.intersperse ", " (display <$> Set.toList pkgLocs))
-        fetchPackages pkgLocs
-  where
-    pkgLocs = Set.unions $ map toPkgLoc $ Map.elems $ planTasks plan
-
-    toPkgLoc task =
-        case taskType task of
-            TTLocalMutable{} -> Set.empty
-            TTRemotePackage _ _ pkgloc -> Set.singleton pkgloc
-
--- | Print a description of build plan for human consumption.
-printPlan :: HasRunner env => Plan -> RIO env ()
-printPlan plan = do
-    case Map.elems $ planUnregisterLocal plan of
-        [] -> logInfo "No packages would be unregistered."
-        xs -> do
-            logInfo "Would unregister locally:"
-            forM_ xs $ \(ident, reason) -> logInfo $
-                fromString (packageIdentifierString ident) <>
-                if T.null reason
-                  then ""
-                  else " (" <> display reason <> ")"
-
-    logInfo ""
-
-    case Map.elems $ planTasks plan of
-        [] -> logInfo "Nothing to build."
-        xs -> do
-            logInfo "Would build:"
-            mapM_ (logInfo . displayTask) xs
-
-    let hasTests = not . Set.null . testComponents . taskComponents
-        hasBenches = not . Set.null . benchComponents . taskComponents
-        tests = Map.elems $ Map.filter hasTests $ planFinals plan
-        benches = Map.elems $ Map.filter hasBenches $ planFinals plan
-
-    unless (null tests) $ do
-        logInfo ""
-        logInfo "Would test:"
-        mapM_ (logInfo . displayTask) tests
-    unless (null benches) $ do
-        logInfo ""
-        logInfo "Would benchmark:"
-        mapM_ (logInfo . displayTask) benches
-
-    logInfo ""
-
-    case Map.toList $ planInstallExes plan of
-        [] -> logInfo "No executables to be installed."
-        xs -> do
-            logInfo "Would install executables:"
-            forM_ xs $ \(name, loc) -> logInfo $
-                display name <>
-                " from " <>
-                (case loc of
-                   Snap -> "snapshot"
-                   Local -> "local") <>
-                " database"
-
--- | For a dry run
-displayTask :: Task -> Utf8Builder
-displayTask task =
-    fromString (packageIdentifierString (taskProvides task)) <>
-    ": database=" <>
-    (case taskLocation task of
-        Snap -> "snapshot"
-        Local -> "local") <>
-    ", source=" <>
-    (case taskType task of
-        TTLocalMutable lp -> fromString $ toFilePath $ parent $ lpCabalFile lp
-        TTRemotePackage _ _ pl -> display pl) <>
-    (if Set.null missing
-        then ""
-        else ", after: " <>
-             mconcat (L.intersperse "," (fromString . packageIdentifierString <$> Set.toList missing)))
-  where
-    missing = tcoMissing $ taskConfigOpts task
-
-data ExecuteEnv = ExecuteEnv
-    { eeConfigureLock  :: !(MVar ())
-    , eeInstallLock    :: !(MVar ())
-    , eeBuildOpts      :: !BuildOpts
-    , eeBuildOptsCLI   :: !BuildOptsCLI
-    , eeBaseConfigOpts :: !BaseConfigOpts
-    , eeGhcPkgIds      :: !(TVar (Map PackageIdentifier Installed))
-    , eeTempDir        :: !(Path Abs Dir)
-    , eeSetupHs        :: !(Path Abs File)
-    -- ^ Temporary Setup.hs for simple builds
-    , eeSetupShimHs    :: !(Path Abs File)
-    -- ^ Temporary SetupShim.hs, to provide access to initial-build-steps
-    , eeSetupExe       :: !(Maybe (Path Abs File))
-    -- ^ Compiled version of eeSetupHs
-    , eeCabalPkgVer    :: !Version
-    , eeTotalWanted    :: !Int
-    , eeLocals         :: ![LocalPackage]
-    , eeGlobalDB       :: !(Path Abs Dir)
-    , eeGlobalDumpPkgs :: !(Map GhcPkgId DumpPackage)
-    , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId DumpPackage))
-    , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId DumpPackage))
-    , eeLogFiles       :: !(TChan (Path Abs Dir, Path Abs File))
-    , eeCustomBuilt    :: !(IORef (Set PackageName))
-    -- ^ Stores which packages with custom-setup have already had their
-    -- Setup.hs built.
-    , eeLargestPackageName :: !(Maybe Int)
-    -- ^ For nicer interleaved output: track the largest package name size
-    , eePathEnvVar :: !Text
-    -- ^ Value of the PATH environment variable
-    }
-
-buildSetupArgs :: [String]
-buildSetupArgs =
-     [ "-rtsopts"
-     , "-threaded"
-     , "-clear-package-db"
-     , "-global-package-db"
-     , "-hide-all-packages"
-     , "-package"
-     , "base"
-     , "-main-is"
-     , "StackSetupShim.mainOverride"
-     ]
-
-simpleSetupCode :: Builder
-simpleSetupCode = "import Distribution.Simple\nmain = defaultMain"
-
-simpleSetupHash :: String
-simpleSetupHash =
-    T.unpack $ decodeUtf8 $ S.take 8 $ B64URL.encode $ Mem.convert $ hashWith SHA256 $
-    toStrictBytes $
-    Data.ByteString.Builder.toLazyByteString $
-    encodeUtf8Builder (T.pack (unwords buildSetupArgs)) <> setupGhciShimCode <> simpleSetupCode
-
--- | Get a compiled Setup exe
-getSetupExe :: HasEnvConfig env
-            => Path Abs File -- ^ Setup.hs input file
-            -> Path Abs File -- ^ SetupShim.hs input file
-            -> Path Abs Dir -- ^ temporary directory
-            -> RIO env (Maybe (Path Abs File))
-getSetupExe setupHs setupShimHs tmpdir = do
-    wc <- view $ actualCompilerVersionL.whichCompilerL
-    platformDir <- platformGhcRelDir
-    config <- view configL
-    cabalVersionString <- view $ cabalVersionL.to versionString
-    actualCompilerVersionString <- view $ actualCompilerVersionL.to compilerVersionString
-    platform <- view platformL
-    let baseNameS = concat
-            [ "Cabal-simple_"
-            , simpleSetupHash
-            , "_"
-            , cabalVersionString
-            , "_"
-            , actualCompilerVersionString
-            ]
-        exeNameS = baseNameS ++
-            case platform of
-                Platform _ Windows -> ".exe"
-                _ -> ""
-        outputNameS =
-            case wc of
-                Ghc -> exeNameS
-        setupDir =
-            view stackRootL config </>
-            relDirSetupExeCache </>
-            platformDir
-
-    exePath <- (setupDir </>) <$> parseRelFile exeNameS
-
-    exists <- liftIO $ D.doesFileExist $ toFilePath exePath
-
-    if exists
-        then pure $ Just exePath
-        else do
-            tmpExePath <- fmap (setupDir </>) $ parseRelFile $ "tmp-" ++ exeNameS
-            tmpOutputPath <- fmap (setupDir </>) $ parseRelFile $ "tmp-" ++ outputNameS
-            ensureDir setupDir
-            let args = buildSetupArgs ++
-                    [ "-package"
-                    , "Cabal-" ++ cabalVersionString
-                    , toFilePath setupHs
-                    , toFilePath setupShimHs
-                    , "-o"
-                    , toFilePath tmpOutputPath
-                    ]
-            compilerPath <- getCompilerPath
-            withWorkingDir (toFilePath tmpdir) $ proc (toFilePath compilerPath) args (\pc0 -> do
-              let pc = setStdout (useHandleOpen stderr) pc0
-              runProcess_ pc)
-                `catch` \ece ->
-                    throwM $ PrettyException $
-                        SetupHsBuildFailure
-                            (eceExitCode ece)
-                            Nothing
-                            compilerPath
-                            args
-                            Nothing
-                            []
-            renameFile tmpExePath exePath
-            pure $ Just exePath
-
--- | Execute a function that takes an 'ExecuteEnv'.
-withExecuteEnv :: forall env a. HasEnvConfig env
-               => BuildOpts
-               -> BuildOptsCLI
-               -> BaseConfigOpts
-               -> [LocalPackage]
-               -> [DumpPackage] -- ^ global packages
-               -> [DumpPackage] -- ^ snapshot packages
-               -> [DumpPackage] -- ^ local packages
-               -> Maybe Int -- ^ largest package name, for nicer interleaved output
-               -> (ExecuteEnv -> RIO env a)
-               -> RIO env a
-withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages mlargestPackageName inner =
-    createTempDirFunction stackProgName $ \tmpdir -> do
-        configLock <- liftIO $ newMVar ()
-        installLock <- liftIO $ newMVar ()
-        idMap <- liftIO $ newTVarIO Map.empty
-        config <- view configL
-
-        customBuiltRef <- newIORef Set.empty
-
-        -- Create files for simple setup and setup shim, if necessary
-        let setupSrcDir =
-                view stackRootL config </>
-                relDirSetupExeSrc
-        ensureDir setupSrcDir
-        setupFileName <- parseRelFile ("setup-" ++ simpleSetupHash ++ ".hs")
-        let setupHs = setupSrcDir </> setupFileName
-        setupHsExists <- doesFileExist setupHs
-        unless setupHsExists $ writeBinaryFileAtomic setupHs simpleSetupCode
-        setupShimFileName <- parseRelFile ("setup-shim-" ++ simpleSetupHash ++ ".hs")
-        let setupShimHs = setupSrcDir </> setupShimFileName
-        setupShimHsExists <- doesFileExist setupShimHs
-        unless setupShimHsExists $ writeBinaryFileAtomic setupShimHs setupGhciShimCode
-        setupExe <- getSetupExe setupHs setupShimHs tmpdir
-
-        cabalPkgVer <- view cabalVersionL
-        globalDB <- view $ compilerPathsL.to cpGlobalDB
-        snapshotPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId snapshotPackages)
-        localPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId localPackages)
-        logFilesTChan <- liftIO $ atomically newTChan
-        let totalWanted = length $ filter lpWanted locals
-        pathEnvVar <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH"
-        inner ExecuteEnv
-            { eeBuildOpts = bopts
-            , eeBuildOptsCLI = boptsCli
-             -- Uncertain as to why we cannot run configures in parallel. This
-             -- appears to be a Cabal library bug. Original issue:
-             -- https://github.com/commercialhaskell/stack/issues/84. Ideally
-             -- we'd be able to remove this.
-            , eeConfigureLock = configLock
-            , eeInstallLock = installLock
-            , eeBaseConfigOpts = baseConfigOpts
-            , eeGhcPkgIds = idMap
-            , eeTempDir = tmpdir
-            , eeSetupHs = setupHs
-            , eeSetupShimHs = setupShimHs
-            , eeSetupExe = setupExe
-            , eeCabalPkgVer = cabalPkgVer
-            , eeTotalWanted = totalWanted
-            , eeLocals = locals
-            , eeGlobalDB = globalDB
-            , eeGlobalDumpPkgs = toDumpPackagesByGhcPkgId globalPackages
-            , eeSnapshotDumpPkgs = snapshotPackagesTVar
-            , eeLocalDumpPkgs = localPackagesTVar
-            , eeLogFiles = logFilesTChan
-            , eeCustomBuilt = customBuiltRef
-            , eeLargestPackageName = mlargestPackageName
-            , eePathEnvVar = pathEnvVar
-            } `finally` dumpLogs logFilesTChan totalWanted
-  where
-    toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp))
-
-    createTempDirFunction
-        | boptsKeepTmpFiles bopts = withKeepSystemTempDir
-        | otherwise = withSystemTempDir
-
-    dumpLogs :: TChan (Path Abs Dir, Path Abs File) -> Int -> RIO env ()
-    dumpLogs chan totalWanted = do
-        allLogs <- fmap reverse $ liftIO $ atomically drainChan
-        case allLogs of
-            -- No log files generated, nothing to dump
-            [] -> pure ()
-            firstLog:_ -> do
-                toDump <- view $ configL.to configDumpLogs
-                case toDump of
-                    DumpAllLogs -> mapM_ (dumpLog "") allLogs
-                    DumpWarningLogs -> mapM_ dumpLogIfWarning allLogs
-                    DumpNoLogs
-                        | totalWanted > 1 ->
-                            logInfo $
-                                "Build output has been captured to log files, use " <>
-                                "--dump-logs to see it on the console"
-                        | otherwise -> pure ()
-                logInfo $ "Log files have been written to: " <>
-                          fromString (toFilePath (parent (snd firstLog)))
-
-        -- We only strip the colors /after/ we've dumped logs, so that
-        -- we get pretty colors in our dump output on the terminal.
-        colors <- shouldForceGhcColorFlag
-        when colors $ liftIO $ mapM_ (stripColors . snd) allLogs
-      where
-        drainChan :: STM [(Path Abs Dir, Path Abs File)]
-        drainChan = do
-            mx <- tryReadTChan chan
-            case mx of
-                Nothing -> pure []
-                Just x -> do
-                    xs <- drainChan
-                    pure $ x:xs
-
-    dumpLogIfWarning :: (Path Abs Dir, Path Abs File) -> RIO env ()
-    dumpLogIfWarning (pkgDir, filepath) = do
-      firstWarning <- withSourceFile (toFilePath filepath) $ \src ->
-            runConduit
-          $ src
-         .| CT.decodeUtf8Lenient
-         .| CT.lines
-         .| CL.map stripCR
-         .| CL.filter isWarning
-         .| CL.take 1
-      unless (null firstWarning) $ dumpLog " due to warnings" (pkgDir, filepath)
-
-    isWarning :: Text -> Bool
-    isWarning t = ": Warning:" `T.isSuffixOf` t -- prior to GHC 8
-               || ": warning:" `T.isInfixOf` t -- GHC 8 is slightly different
-               || "mwarning:" `T.isInfixOf` t -- colorized output
-
-    dumpLog :: String -> (Path Abs Dir, Path Abs File) -> RIO env ()
-    dumpLog msgSuffix (pkgDir, filepath) = do
-        logInfo $
-          "\n--  Dumping log file" <>
-          fromString msgSuffix <>
-          ": " <>
-          fromString (toFilePath filepath) <>
-          "\n"
-        compilerVer <- view actualCompilerVersionL
-        withSourceFile (toFilePath filepath) $ \src ->
-              runConduit
-            $ src
-           .| CT.decodeUtf8Lenient
-           .| mungeBuildOutput ExcludeTHLoading ConvertPathsToAbsolute pkgDir compilerVer
-           .| CL.mapM_ (logInfo . display)
-        logInfo $ "\n--  End of log file: " <> fromString (toFilePath filepath) <> "\n"
-
-    stripColors :: Path Abs File -> IO ()
-    stripColors fp = do
-      let colorfp = toFilePath fp ++ "-color"
-      withSourceFile (toFilePath fp) $ \src ->
-        withSinkFile colorfp $ \sink ->
-        runConduit $ src .| sink
-      withSourceFile colorfp $ \src ->
-        withSinkFile (toFilePath fp) $ \sink ->
-        runConduit $ src .| noColors .| sink
-
-      where
-        noColors = do
-          CB.takeWhile (/= 27) -- ESC
-          mnext <- CB.head
-          case mnext of
-            Nothing -> pure ()
-            Just x -> assert (x == 27) $ do
-              -- Color sequences always end with an m
-              CB.dropWhile (/= 109) -- m
-              CB.drop 1 -- drop the m itself
-              noColors
-
--- | Perform the actual plan
-executePlan :: HasEnvConfig env
-            => BuildOptsCLI
-            -> BaseConfigOpts
-            -> [LocalPackage]
-            -> [DumpPackage] -- ^ global packages
-            -> [DumpPackage] -- ^ snapshot packages
-            -> [DumpPackage] -- ^ local packages
-            -> InstalledMap
-            -> Map PackageName Target
-            -> Plan
-            -> RIO env ()
-executePlan boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = do
-    logDebug "Executing the build plan"
-    bopts <- view buildOptsL
-    withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages mlargestPackageName
-      (executePlan' installedMap targets plan)
-
-    copyExecutables (planInstallExes plan)
-
-    config <- view configL
-    menv' <- liftIO $ configProcessContextSettings config EnvSettings
-                    { esIncludeLocals = True
-                    , esIncludeGhcPackagePath = True
-                    , esStackExe = True
-                    , esLocaleUtf8 = False
-                    , esKeepGhcRts = False
-                    }
-    withProcessContext menv' $
-      forM_ (boptsCLIExec boptsCli) $ \(cmd, args) ->
-      proc cmd args runProcess_
-  where
-    mlargestPackageName =
-      Set.lookupMax $
-      Set.map (length . packageNameString) $
-      Map.keysSet (planTasks plan) <> Map.keysSet (planFinals plan)
-
-copyExecutables ::
-       HasEnvConfig env
-    => Map Text InstallLocation
-    -> RIO env ()
-copyExecutables exes | Map.null exes = pure ()
-copyExecutables exes = do
-    snapBin <- (</> bindirSuffix) `liftM` installationRootDeps
-    localBin <- (</> bindirSuffix) `liftM` installationRootLocal
-    compilerSpecific <- boptsInstallCompilerTool <$> view buildOptsL
-    destDir <- if compilerSpecific
-                   then bindirCompilerTools
-                   else view $ configL.to configLocalBin
-    ensureDir destDir
-
-    destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir
-
-    platform <- view platformL
-    let ext =
-            case platform of
-                Platform _ Windows -> ".exe"
-                _ -> ""
-
-    currExe <- liftIO getExecutablePath -- needed for windows, see below
-
-    installed <- forMaybeM (Map.toList exes) $ \(name, loc) -> do
-        let bindir =
-                case loc of
-                    Snap -> snapBin
-                    Local -> localBin
-        mfp <- liftIO $ forgivingAbsence (resolveFile bindir $ T.unpack name ++ ext)
-          >>= rejectMissingFile
-        case mfp of
-            Nothing -> do
-                logWarn $
-                    "Couldn't find executable " <>
-                    display name <>
-                    " in directory " <>
-                    fromString (toFilePath bindir)
-                pure Nothing
-            Just file -> do
-                let destFile = destDir' FP.</> T.unpack name ++ ext
-                logInfo $
-                    "Copying from " <>
-                    fromString (toFilePath file) <>
-                    " to " <>
-                    fromString destFile
-
-                liftIO $ case platform of
-                    Platform _ Windows | FP.equalFilePath destFile currExe ->
-                        windowsRenameCopy (toFilePath file) destFile
-                    _ -> D.copyFile (toFilePath file) destFile
-                pure $ Just (name <> T.pack ext)
-
-    unless (null installed) $ do
-        logInfo ""
-        logInfo $
-            "Copied executables to " <>
-            fromString destDir' <>
-            ":"
-    forM_ installed $ \exe -> logInfo ("- " <> display exe)
-    unless compilerSpecific $ warnInstallSearchPathIssues destDir' installed
-
-
--- | Windows can't write over the current executable. Instead, we rename the
--- current executable to something else and then do the copy.
-windowsRenameCopy :: FilePath -> FilePath -> IO ()
-windowsRenameCopy src dest = do
-    D.copyFile src new
-    D.renameFile dest old
-    D.renameFile new dest
-  where
-    new = dest ++ ".new"
-    old = dest ++ ".old"
-
--- | Perform the actual plan (internal)
-executePlan' :: HasEnvConfig env
-             => InstalledMap
-             -> Map PackageName Target
-             -> Plan
-             -> ExecuteEnv
-             -> RIO env ()
-executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do
-    when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports
-    cv <- view actualCompilerVersionL
-    case nonEmpty . Map.toList $ planUnregisterLocal plan of
-        Nothing -> pure ()
-        Just ids -> do
-            localDB <- packageDatabaseLocal
-            unregisterPackages cv localDB ids
-
-    liftIO $ atomically $ modifyTVar' eeLocalDumpPkgs $ \initMap ->
-        foldl' (flip Map.delete) initMap $ Map.keys (planUnregisterLocal plan)
-
-    run <- askRunInIO
-
-    -- If running tests concurrently with each other, then create an MVar
-    -- which is empty while each test is being run.
-    concurrentTests <- view $ configL.to configConcurrentTests
-    mtestLock <- if concurrentTests then pure Nothing else Just <$> liftIO (newMVar ())
-
-    let actions = concatMap (toActions installedMap' mtestLock run ee) $ Map.elems $ Map.mergeWithKey
-            (\_ b f -> Just (Just b, Just f))
-            (fmap (\b -> (Just b, Nothing)))
-            (fmap (\f -> (Nothing, Just f)))
-            (planTasks plan)
-            (planFinals plan)
-    threads <- view $ configL.to configJobs
-    let keepGoing =
-            fromMaybe (not (M.null (planFinals plan))) (boptsKeepGoing eeBuildOpts)
-    terminal <- view terminalL
-    errs <- liftIO $ runActions threads keepGoing actions $ \doneVar actionsVar -> do
-        let total = length actions
-            loop prev
-                | prev == total =
-                    run $ logStickyDone ("Completed " <> display total <> " action(s).")
-                | otherwise = do
-                    inProgress <- readTVarIO actionsVar
-                    let packageNames = map (\(ActionId pkgID _) -> pkgName pkgID) (toList inProgress)
-                        nowBuilding :: [PackageName] -> Utf8Builder
-                        nowBuilding []    = ""
-                        nowBuilding names = mconcat $ ": " : L.intersperse ", " (map (fromString . packageNameString) names)
-                    when terminal $ run $
-                        logSticky $
-                            "Progress " <> display prev <> "/" <> display total <>
-                                nowBuilding packageNames
-                    done <- atomically $ do
-                        done <- readTVar doneVar
-                        check $ done /= prev
-                        pure done
-                    loop done
-        when (total > 1) $ loop 0
-    when (toCoverage $ boptsTestOpts eeBuildOpts) $ do
-        generateHpcUnifiedReport
-        generateHpcMarkupIndex
-    unless (null errs) $ throwM $ PrettyException (ExecutionFailure errs)
-    when (boptsHaddock eeBuildOpts) $ do
-        snapshotDumpPkgs <- liftIO (readTVarIO eeSnapshotDumpPkgs)
-        localDumpPkgs <- liftIO (readTVarIO eeLocalDumpPkgs)
-        generateLocalHaddockIndex eeBaseConfigOpts localDumpPkgs eeLocals
-        generateDepsHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs localDumpPkgs eeLocals
-        generateSnapHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs
-        when (boptsOpenHaddocks eeBuildOpts) $ do
-            let planPkgs, localPkgs, installedPkgs, availablePkgs
-                    :: Map PackageName (PackageIdentifier, InstallLocation)
-                planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan)
-                localPkgs =
-                    Map.fromList
-                        [(packageName p, (packageIdentifier p, Local)) | p <- map lpPackage eeLocals]
-                installedPkgs = Map.map (swap . second installedPackageIdentifier) installedMap'
-                availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs]
-            openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets)
-  where
-    installedMap' = Map.difference installedMap0
-                  $ Map.fromList
-                  $ map (\(ident, _) -> (pkgName ident, ()))
-                  $ Map.elems
-                  $ planUnregisterLocal plan
-
-unregisterPackages ::
-       (HasProcessContext env, HasLogFunc env, HasPlatform env, HasCompiler env)
-    => ActualCompiler
-    -> Path Abs Dir
-    -> NonEmpty (GhcPkgId, (PackageIdentifier, Text))
-    -> RIO env ()
-unregisterPackages cv localDB ids = do
-    let logReason ident reason =
-            logInfo $
-            fromString (packageIdentifierString ident) <> ": unregistering" <>
-            if T.null reason
-                then ""
-                else " (" <> display reason <> ")"
-    let unregisterSinglePkg select (gid, (ident, reason)) = do
-            logReason ident reason
-            pkg <- getGhcPkgExe
-            unregisterGhcPkgIds pkg localDB $ select ident gid :| []
-
-    case cv of
-        -- GHC versions >= 8.2.1 support batch unregistering of packages. See
-        -- https://gitlab.haskell.org/ghc/ghc/issues/12637
-        ACGhc v | v >= mkVersion [8, 2, 1] -> do
-                platform <- view platformL
-                -- According to https://support.microsoft.com/en-us/help/830473/command-prompt-cmd-exe-command-line-string-limitation
-                -- the maximum command line length on Windows since XP is 8191 characters.
-                -- We use conservative batch size of 100 ids on this OS thus argument name '-ipid', package name,
-                -- its version and a hash should fit well into this limit.
-                -- On Unix-like systems we're limited by ARG_MAX which is normally hundreds
-                -- of kilobytes so batch size of 500 should work fine.
-                let batchSize = case platform of
-                      Platform _ Windows -> 100
-                      _ -> 500
-                let chunksOfNE size = mapMaybe nonEmpty . chunksOf size . NonEmpty.toList
-                for_ (chunksOfNE batchSize ids) $ \batch -> do
-                    for_ batch $ \(_, (ident, reason)) -> logReason ident reason
-                    pkg <- getGhcPkgExe
-                    unregisterGhcPkgIds pkg localDB $ fmap (Right . fst) batch
-
-        -- GHC versions >= 7.9 support unregistering of packages via their
-        -- GhcPkgId.
-        ACGhc v | v >= mkVersion [7, 9] -> for_ ids . unregisterSinglePkg $ \_ident gid -> Right gid
-
-        _ -> for_ ids . unregisterSinglePkg $ \ident _gid -> Left ident
-
-toActions :: HasEnvConfig env
-          => InstalledMap
-          -> Maybe (MVar ())
-          -> (RIO env () -> IO ())
-          -> ExecuteEnv
-          -> (Maybe Task, Maybe Task) -- build and final
-          -> [Action]
-toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
-    abuild ++ afinal
-  where
-    abuild =
-        case mbuild of
-            Nothing -> []
-            Just task@Task {..} ->
-                [ Action
-                    { actionId = ActionId taskProvides ATBuild
-                    , actionDeps =
-                        Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts)
-                    , actionDo = \ac -> runInBase $ singleBuild ac ee task installedMap False
-                    , actionConcurrency = ConcurrencyAllowed
-                    }
-                ]
-    afinal =
-        case mfinal of
-            Nothing -> []
-            Just task@Task {..} ->
-                (if taskAllInOne then id else (:)
-                    Action
-                        { actionId = ActionId taskProvides ATBuildFinal
-                        , actionDeps = addBuild
-                            (Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts))
-                        , actionDo = \ac -> runInBase $ singleBuild ac ee task installedMap True
-                        , actionConcurrency = ConcurrencyAllowed
-                        }) $
-                -- These are the "final" actions - running tests and benchmarks.
-                (if Set.null tests then id else (:)
-                    Action
-                        { actionId = ActionId taskProvides ATRunTests
-                        , actionDeps = finalDeps
-                        , actionDo = \ac -> withLock mtestLock $ runInBase $ do
-                            singleTest topts (Set.toList tests) ac ee task installedMap
-                        -- Always allow tests tasks to run concurrently with
-                        -- other tasks, particularly build tasks. Note that
-                        -- 'mtestLock' can optionally make it so that only
-                        -- one test is run at a time.
-                        , actionConcurrency = ConcurrencyAllowed
-                        }) $
-                (if Set.null benches then id else (:)
-                    Action
-                        { actionId = ActionId taskProvides ATRunBenchmarks
-                        , actionDeps = finalDeps
-                        , actionDo = \ac -> runInBase $ do
-                            singleBench beopts (Set.toList benches) ac ee task installedMap
-                        -- Never run benchmarks concurrently with any other task, see #3663
-                        , actionConcurrency = ConcurrencyDisallowed
-                        })
-                []
-              where
-                comps = taskComponents task
-                tests = testComponents comps
-                benches = benchComponents comps
-                finalDeps =
-                    if taskAllInOne
-                        then addBuild mempty
-                        else Set.singleton (ActionId taskProvides ATBuildFinal)
-                addBuild =
-                    case mbuild of
-                        Nothing -> id
-                        Just _ -> Set.insert $ ActionId taskProvides ATBuild
-    withLock Nothing f = f
-    withLock (Just lock) f = withMVar lock $ \() -> f
-    bopts = eeBuildOpts ee
-    topts = boptsTestOpts bopts
-    beopts = boptsBenchmarkOpts bopts
-
--- | Generate the ConfigCache
-getConfigCache :: HasEnvConfig env
-               => ExecuteEnv -> Task -> InstalledMap -> Bool -> Bool
-               -> RIO env (Map PackageIdentifier GhcPkgId, ConfigCache)
-getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBench = do
-    let extra =
-            -- We enable tests if the test suite dependencies are already
-            -- installed, so that we avoid unnecessary recompilation based on
-            -- cabal_macros.h changes when switching between 'stack build' and
-            -- 'stack test'. See:
-            -- https://github.com/commercialhaskell/stack/issues/805
-            case taskType of
-                TTLocalMutable _ ->
-                  -- FIXME: make this work with exact-configuration.
-                  -- Not sure how to plumb the info atm. See
-                  -- https://github.com/commercialhaskell/stack/issues/2049
-                  [ "--enable-tests" | enableTest] ++
-                  [ "--enable-benchmarks" | enableBench]
-                TTRemotePackage{} -> []
-    idMap <- liftIO $ readTVarIO eeGhcPkgIds
-    let getMissing ident =
-            case Map.lookup ident idMap of
-                Nothing
-                    -- Expect to instead find it in installedMap if it's
-                    -- an initialBuildSteps target.
-                    | boptsCLIInitialBuildSteps eeBuildOptsCLI && taskIsTarget task,
-                      Just (_, installed) <- Map.lookup (pkgName ident) installedMap
-                        -> installedToGhcPkgId ident installed
-                Just installed -> installedToGhcPkgId ident installed
-                _ -> throwM $ PackageIdMissingBug ident
-        installedToGhcPkgId ident (Library ident' x _) = assert (ident == ident') $ Just (ident, x)
-        installedToGhcPkgId _ (Executable _) = Nothing
-        missing' = Map.fromList $ mapMaybe getMissing $ Set.toList missing
-        TaskConfigOpts missing mkOpts = taskConfigOpts
-        opts = mkOpts missing'
-        allDeps = Set.fromList $ Map.elems missing' ++ Map.elems taskPresent
-        cache = ConfigCache
-            { configCacheOpts = opts
-                { coNoDirs = coNoDirs opts ++ map T.unpack extra
-                }
-            , configCacheDeps = allDeps
-            , configCacheComponents =
-                case taskType of
-                    TTLocalMutable lp -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
-                    TTRemotePackage{} -> Set.empty
-            , configCacheHaddock = taskBuildHaddock
-            , configCachePkgSrc = taskCachePkgSrc
-            , configCachePathEnvVar = eePathEnvVar
-            }
-        allDepsMap = Map.union missing' taskPresent
-    pure (allDepsMap, cache)
-
--- | Ensure that the configuration for the package matches what is given
-ensureConfig :: HasEnvConfig env
-             => ConfigCache -- ^ newConfigCache
-             -> Path Abs Dir -- ^ package directory
-             -> ExecuteEnv
-             -> RIO env () -- ^ announce
-             -> (ExcludeTHLoading -> [String] -> RIO env ()) -- ^ cabal
-             -> Path Abs File -- ^ Cabal file
-             -> Task
-             -> RIO env Bool
-ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = do
-    newCabalMod <- liftIO $ modificationTime <$> getFileStatus (toFilePath cabalfp)
-    setupConfigfp <- setupConfigFromDir pkgDir
-    let getNewSetupConfigMod =
-          liftIO $ either (const Nothing) (Just . modificationTime) <$>
-          tryJust (guard . isDoesNotExistError) (getFileStatus (toFilePath setupConfigfp))
-    newSetupConfigMod <- getNewSetupConfigMod
-    newProjectRoot <- S8.pack . toFilePath <$> view projectRootL
-    -- See https://github.com/commercialhaskell/stack/issues/3554
-    taskAnyMissingHack <- view $ actualCompilerVersionL.to getGhcVersion.to (< mkVersion [8, 4])
-    needConfig <-
-        if boptsReconfigure eeBuildOpts || (taskAnyMissing task && taskAnyMissingHack)
-            then pure True
-            else do
-                -- We can ignore the components portion of the config
-                -- cache, because it's just used to inform 'construct
-                -- plan that we need to plan to build additional
-                -- components. These components don't affect the actual
-                -- package configuration.
-                let ignoreComponents cc = cc { configCacheComponents = Set.empty }
-                -- Determine the old and new configuration in the local directory, to
-                -- determine if we need to reconfigure.
-                mOldConfigCache <- tryGetConfigCache pkgDir
-
-                mOldCabalMod <- tryGetCabalMod pkgDir
-
-                -- Cabal's setup-config is created per OS/Cabal version, multiple
-                -- projects using the same package could get a conflict because of this
-                mOldSetupConfigMod <- tryGetSetupConfigMod pkgDir
-                mOldProjectRoot <- tryGetPackageProjectRoot pkgDir
-
-                pure $ fmap ignoreComponents mOldConfigCache /= Just (ignoreComponents newConfigCache)
-                      || mOldCabalMod /= Just newCabalMod
-                      || mOldSetupConfigMod /= newSetupConfigMod
-                      || mOldProjectRoot /= Just newProjectRoot
-    let ConfigureOpts dirs nodirs = configCacheOpts newConfigCache
-
-    when (taskBuildTypeConfig task) ensureConfigureScript
-
-    when needConfig $ withMVar eeConfigureLock $ \_ -> do
-        deleteCaches pkgDir
-        announce
-        cp <- view compilerPathsL
-        let (GhcPkgExe pkgPath) = cpPkg cp
-        let programNames =
-              case cpWhich cp of
-                Ghc ->
-                  [ ("ghc", toFilePath (cpCompiler cp))
-                  , ("ghc-pkg", toFilePath pkgPath)
-                  ]
-        exes <- forM programNames $ \(name, file) -> do
-            mpath <- findExecutable file
-            pure $ case mpath of
-                Left _ -> []
-                Right x -> pure $ concat ["--with-", name, "=", x]
-        -- Configure cabal with arguments determined by
-        -- Stack.Types.Build.configureOpts
-        cabal KeepTHLoading $ "configure" : concat
-            [ concat exes
-            , dirs
-            , nodirs
-            ]
-        -- Only write the cache for local packages.  Remote packages are built
-        -- in a temporary directory so the cache would never be used anyway.
-        case taskType task of
-            TTLocalMutable{} -> writeConfigCache pkgDir newConfigCache
-            TTRemotePackage{} -> pure ()
-        writeCabalMod pkgDir newCabalMod
-        -- This file gets updated one more time by the configure step, so get
-        -- the most recent value. We could instead change our logic above to
-        -- check if our config mod file is newer than the file above, but this
-        -- seems reasonable too.
-        getNewSetupConfigMod >>= writeSetupConfigMod pkgDir
-        writePackageProjectRoot pkgDir newProjectRoot
-
-    pure needConfig
-  where
-    -- When build-type is Configure, we need to have a configure
-    -- script in the local directory. If it doesn't exist, build it
-    -- with autoreconf -i. See:
-    -- https://github.com/commercialhaskell/stack/issues/3534
-    ensureConfigureScript = do
-      let fp = pkgDir </> relFileConfigure
-      exists <- doesFileExist fp
-      unless exists $ do
-        logInfo $ "Trying to generate configure with autoreconf in " <> fromString (toFilePath pkgDir)
-        let autoreconf = if osIsWindows
-                           then readProcessNull "sh" ["autoreconf", "-i"]
-                           else readProcessNull "autoreconf" ["-i"]
-            -- On Windows 10, an upstream issue with the `sh autoreconf -i`
-            -- command means that command clears, but does not then restore, the
-            -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. The
-            -- following hack re-enables the lost ANSI-capability.
-            fixupOnWindows = when osIsWindows (void $ liftIO defaultColorWhen)
-        withWorkingDir (toFilePath pkgDir) $ autoreconf `catchAny` \ex -> do
-          fixupOnWindows
-          logWarn $ "Unable to run autoreconf: " <> displayShow ex
-          when osIsWindows $ do
-            logInfo $ "Check that executable perl is on the path in Stack's " <>
-              "MSYS2 \\usr\\bin folder, and working, and that script file " <>
-              "autoreconf is on the path in that location. To check that " <>
-              "perl or autoreconf are on the path in the required location, " <>
-              "run commands:"
-            logInfo ""
-            logInfo "  stack exec where -- perl"
-            logInfo "  stack exec where -- autoreconf"
-            logInfo ""
-            logInfo $ "If perl or autoreconf is not on the path in the " <>
-              "required location, add them with command (note that the " <>
-              "relevant package name is 'autoconf' not 'autoreconf'):"
-            logInfo ""
-            logInfo "  stack exec pacman -- --sync --refresh autoconf"
-            logInfo ""
-            logInfo $ "Some versions of perl from MSYS2 are broken. See " <>
-              "https://github.com/msys2/MSYS2-packages/issues/1611 and " <>
-              "https://github.com/commercialhaskell/stack/pull/4781. To " <>
-              "test if perl in the required location is working, try command:"
-            logInfo ""
-            logInfo "  stack exec perl -- --version"
-            logInfo ""
-        fixupOnWindows
-
--- | Make a padded prefix for log messages
-packageNamePrefix :: ExecuteEnv -> PackageName -> Utf8Builder
-packageNamePrefix ee name' =
-  let name = packageNameString name'
-      paddedName =
-        case eeLargestPackageName ee of
-          Nothing -> name
-          Just len -> assert (len >= length name) $ take len $ name ++ L.repeat ' '
-   in fromString paddedName <> "> "
-
-announceTask :: HasLogFunc env => ExecuteEnv -> Task -> Utf8Builder -> RIO env ()
-announceTask ee task action = logInfo $
-    packageNamePrefix ee (pkgName (taskProvides task)) <>
-    action
-
--- | Ensure we're the only action using the directory.  See
--- <https://github.com/commercialhaskell/stack/issues/2730>
-withLockedDistDir ::
-     HasEnvConfig env
-  => (Utf8Builder -> RIO env ()) -- ^ announce
-  -> Path Abs Dir -- ^ root directory for package
-  -> RIO env a
-  -> RIO env a
-withLockedDistDir announce root inner = do
-  distDir <- distRelativeDir
-  let lockFP = root </> distDir </> relFileBuildLock
-  ensureDir $ parent lockFP
-
-  mres <-
-    withRunInIO $ \run ->
-    withTryFileLock (toFilePath lockFP) Exclusive $ \_lock ->
-    run inner
-
-  case mres of
-    Just res -> pure res
-    Nothing -> do
-      let complainer delay = do
-            delay 5000000 -- 5 seconds
-            announce $ "blocking for directory lock on " <> fromString (toFilePath lockFP)
-            forever $ do
-              delay 30000000 -- 30 seconds
-              announce $ "still blocking for directory lock on " <>
-                         fromString (toFilePath lockFP) <>
-                         "; maybe another Stack process is running?"
-      withCompanion (\x -> complainer x) $
-        \stopComplaining ->
-        withRunInIO $ \run ->
-        withFileLock (toFilePath lockFP) Exclusive $ \_ ->
-        run $ stopComplaining *> inner
-
--- | How we deal with output from GHC, either dumping to a log file or the
--- console (with some prefix).
-data OutputType
-  = OTLogFile !(Path Abs File) !Handle
-  | OTConsole !(Maybe Utf8Builder)
-
--- | This sets up a context for executing build steps which need to run
--- Cabal (via a compiled Setup.hs).  In particular it does the following:
---
--- * Ensures the package exists in the file system, downloading if necessary.
---
--- * Opens a log file if the built output shouldn't go to stderr.
---
--- * Ensures that either a simple Setup.hs is built, or the package's
---   custom setup is built.
---
--- * Provides the user a function with which run the Cabal process.
-withSingleContext :: forall env a. HasEnvConfig env
-                  => ActionContext
-                  -> ExecuteEnv
-                  -> Task
-                  -> Map PackageIdentifier GhcPkgId
-                  -- ^ All dependencies' package ids to provide to Setup.hs.
-                  -> Maybe String
-                  -> (  Package                                -- Package info
-                     -> Path Abs File                          -- Cabal file path
-                     -> Path Abs Dir                           -- Package root directory file path
-                     -- Note that the `Path Abs Dir` argument is redundant with the `Path Abs File`
-                     -- argument, but we provide both to avoid recalculating `parent` of the `File`.
-                     -> (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
-                                                               -- Function to run Cabal with args
-                     -> (Utf8Builder -> RIO env ())      -- An 'announce' function, for different build phases
-                     -> OutputType
-                     -> RIO env a)
-                  -> RIO env a
-withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} allDeps msuffix inner0 =
-    withPackage $ \package cabalfp pkgDir ->
-    withOutputType pkgDir package $ \outputType ->
-    withCabal package pkgDir outputType $ \cabal ->
-    inner0 package cabalfp pkgDir cabal announce outputType
-  where
-    announce = announceTask ee task
-
-    wanted =
-        case taskType of
-            TTLocalMutable lp -> lpWanted lp
-            TTRemotePackage{} -> False
-
-    -- Output to the console if this is the last task, and the user
-    -- asked to build it specifically. When the action is a
-    -- 'ConcurrencyDisallowed' action (benchmarks), then we can also be
-    -- sure to have exclusive access to the console, so output is also
-    -- sent to the console in this case.
-    --
-    -- See the discussion on #426 for thoughts on sending output to the
-    -- console from concurrent tasks.
-    console =
-      (wanted &&
-       all (\(ActionId ident _) -> ident == taskProvides) (Set.toList acRemaining) &&
-       eeTotalWanted == 1
-      ) || (acConcurrency == ConcurrencyDisallowed)
-
-    withPackage inner =
-        case taskType of
-            TTLocalMutable lp -> do
-              let root = parent $ lpCabalFile lp
-              withLockedDistDir announce root $
-                inner (lpPackage lp) (lpCabalFile lp) root
-            TTRemotePackage _ package pkgloc -> do
-                suffix <- parseRelDir $ packageIdentifierString $ packageIdent package
-                let dir = eeTempDir </> suffix
-                unpackPackageLocation dir pkgloc
-
-                -- See: https://github.com/commercialhaskell/stack/issues/157
-                distDir <- distRelativeDir
-                let oldDist = dir </> relDirDist
-                    newDist = dir </> distDir
-                exists <- doesDirExist oldDist
-                when exists $ do
-                  -- Previously used takeDirectory, but that got confused
-                  -- by trailing slashes, see:
-                  -- https://github.com/commercialhaskell/stack/issues/216
-                  --
-                  -- Instead, use Path which is a bit more resilient
-                  ensureDir $ parent newDist
-                  renameDir oldDist newDist
-
-                let name = pkgName taskProvides
-                cabalfpRel <- parseRelFile $ packageNameString name ++ ".cabal"
-                let cabalfp = dir </> cabalfpRel
-                inner package cabalfp dir
-
-    withOutputType pkgDir package inner
-        -- Not in interleaved mode. When building a single wanted package, dump
-        -- to the console with no prefix.
-        | console = inner $ OTConsole Nothing
-
-        -- If the user requested interleaved output, dump to the console with a
-        -- prefix.
-        | boptsInterleavedOutput eeBuildOpts =
-             inner $ OTConsole $ Just $ packageNamePrefix ee $ packageName package
-
-        -- Neither condition applies, dump to a file.
-        | otherwise = do
-            logPath <- buildLogPath package msuffix
-            ensureDir (parent logPath)
-            let fp = toFilePath logPath
-
-            -- We only want to dump logs for local non-dependency packages
-            case taskType of
-                TTLocalMutable lp | lpWanted lp ->
-                    liftIO $ atomically $ writeTChan eeLogFiles (pkgDir, logPath)
-                _ -> pure ()
-
-            withBinaryFile fp WriteMode $ \h -> inner $ OTLogFile logPath h
-
-    withCabal ::
-           Package
-        -> Path Abs Dir
-        -> OutputType
-        -> ((KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ()) -> RIO env a)
-        -> RIO env a
-    withCabal package pkgDir outputType inner = do
-        config <- view configL
-        unless (configAllowDifferentUser config) $
-            checkOwnership (pkgDir </> configWorkDir config)
-        let envSettings = EnvSettings
-                { esIncludeLocals = taskLocation task == Local
-                , esIncludeGhcPackagePath = False
-                , esStackExe = False
-                , esLocaleUtf8 = True
-                , esKeepGhcRts = False
-                }
-        menv <- liftIO $ configProcessContextSettings config envSettings
-        distRelativeDir' <- distRelativeDir
-        esetupexehs <-
-            -- Avoid broken Setup.hs files causing problems for simple build
-            -- types, see:
-            -- https://github.com/commercialhaskell/stack/issues/370
-            case (packageBuildType package, eeSetupExe) of
-                (C.Simple, Just setupExe) -> pure $ Left setupExe
-                _ -> liftIO $ Right <$> getSetupHs pkgDir
-        inner $ \keepOutputOpen stripTHLoading args -> do
-            let cabalPackageArg
-                    -- Omit cabal package dependency when building
-                    -- Cabal. See
-                    -- https://github.com/commercialhaskell/stack/issues/1356
-                    | packageName package == mkPackageName "Cabal" = []
-                    | otherwise =
-                        ["-package=" ++ packageIdentifierString
-                                            (PackageIdentifier cabalPackageName
-                                                              eeCabalPkgVer)]
-                packageDBArgs =
-                    ( "-clear-package-db"
-                    : "-global-package-db"
-                    : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts)
-                    ) ++
-                    ( ("-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts))
-                    : ("-package-db=" ++ toFilePathNoTrailingSep (bcoLocalDB eeBaseConfigOpts))
-                    : ["-hide-all-packages"]
-                    )
-
-                warnCustomNoDeps :: RIO env ()
-                warnCustomNoDeps =
-                    case (taskType, packageBuildType package) of
-                        (TTLocalMutable lp, C.Custom) | lpWanted lp -> do
-                            prettyWarnL
-                                [ flow "Package"
-                                , fromString $ packageNameString $ packageName package
-                                , flow "uses a custom Cabal build, but does not use a custom-setup stanza"
-                                ]
-                        _ -> pure ()
-
-                getPackageArgs :: Path Abs Dir -> RIO env [String]
-                getPackageArgs setupDir =
-                    case packageSetupDeps package of
-                        -- The package is using the Cabal custom-setup
-                        -- configuration introduced in Cabal 1.24. In
-                        -- this case, the package is providing an
-                        -- explicit list of dependencies, and we
-                        -- should simply use all of them.
-                        Just customSetupDeps -> do
-                            unless (Map.member (mkPackageName "Cabal") customSetupDeps) $
-                                prettyWarnL
-                                    [ fromString $ packageNameString $ packageName package
-                                    , "has a setup-depends field, but it does not mention a Cabal dependency. This is likely to cause build errors."
-                                    ]
-                            matchedDeps <- forM (Map.toList customSetupDeps) $ \(name, range) -> do
-                                let matches (PackageIdentifier name' version) =
-                                        name == name' &&
-                                        version `withinRange` range
-                                case filter (matches . fst) (Map.toList allDeps) of
-                                    x:xs -> do
-                                        unless (null xs)
-                                            (logWarn ("Found multiple installed packages for custom-setup dep: " <> fromString (packageNameString name)))
-                                        pure ("-package-id=" ++ ghcPkgIdString (snd x), Just (fst x))
-                                    [] -> do
-                                        logWarn ("Could not find custom-setup dep: " <> fromString (packageNameString name))
-                                        pure ("-package=" ++ packageNameString name, Nothing)
-                            let depsArgs = map fst matchedDeps
-                            -- Generate setup_macros.h and provide it to ghc
-                            let macroDeps = mapMaybe snd matchedDeps
-                                cppMacrosFile = setupDir </> relFileSetupMacrosH
-                                cppArgs = ["-optP-include", "-optP" ++ toFilePath cppMacrosFile]
-                            writeBinaryFileAtomic cppMacrosFile (encodeUtf8Builder (T.pack (C.generatePackageVersionMacros (packageVersion package) macroDeps)))
-                            pure (packageDBArgs ++ depsArgs ++ cppArgs)
-
-                        -- This branch is usually taken for builds, and
-                        -- is always taken for `stack sdist`.
-                        --
-                        -- This approach is debatable. It adds access to the
-                        -- snapshot package database for Cabal. There are two
-                        -- possible objections:
-                        --
-                        -- 1. This doesn't isolate the build enough; arbitrary
-                        -- other packages available could cause the build to
-                        -- succeed or fail.
-                        --
-                        -- 2. This doesn't provide enough packages: we should also
-                        -- include the local database when building local packages.
-                        --
-                        -- Currently, this branch is only taken via `stack
-                        -- sdist` or when explicitly requested in the
-                        -- stack.yaml file.
-                        Nothing -> do
-                            warnCustomNoDeps
-                            pure $ cabalPackageArg ++
-                                    -- NOTE: This is different from
-                                    -- packageDBArgs above in that it does not
-                                    -- include the local database and does not
-                                    -- pass in the -hide-all-packages argument
-                                    ("-clear-package-db"
-                                    : "-global-package-db"
-                                    : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts)
-                                ++ ["-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)])
-
-                setupArgs = ("--builddir=" ++ toFilePathNoTrailingSep distRelativeDir') : args
-
-                runExe :: Path Abs File -> [String] -> RIO env ()
-                runExe exeName fullArgs = do
-                    compilerVer <- view actualCompilerVersionL
-                    runAndOutput compilerVer `catch` \ece -> do
-                        (mlogFile, bss) <-
-                            case outputType of
-                                OTConsole _ -> pure (Nothing, [])
-                                OTLogFile logFile h ->
-                                    if keepOutputOpen == KeepOpen
-                                    then pure (Nothing, []) -- expected failure build continues further
-                                    else do
-                                        liftIO $ hClose h
-                                        fmap (Just logFile,) $ withSourceFile (toFilePath logFile) $ \src ->
-                                               runConduit
-                                             $ src
-                                            .| CT.decodeUtf8Lenient
-                                            .| mungeBuildOutput stripTHLoading makeAbsolute pkgDir compilerVer
-                                            .| CL.consume
-                        throwM $ PrettyException $ CabalExitedUnsuccessfully
-                            (eceExitCode ece)
-                            taskProvides
-                            exeName
-                            fullArgs
-                            mlogFile
-                            bss
-                  where
-                    runAndOutput :: ActualCompiler -> RIO env ()
-                    runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $ withProcessContext menv $ case outputType of
-                        OTLogFile _ h -> do
-                          let prefixWithTimestamps =
-                                if configPrefixTimestamps config
-                                   then PrefixWithTimestamps
-                                   else WithoutTimestamps
-                          void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs
-                              (sinkWithTimestamps prefixWithTimestamps h)
-                              (sinkWithTimestamps prefixWithTimestamps h)
-                        OTConsole mprefix ->
-                            let prefix = fold mprefix in
-                            void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs
-                                (outputSink KeepTHLoading LevelWarn compilerVer prefix)
-                                (outputSink stripTHLoading LevelInfo compilerVer prefix)
-                    outputSink ::
-                           HasCallStack
-                        => ExcludeTHLoading
-                        -> LogLevel
-                        -> ActualCompiler
-                        -> Utf8Builder
-                        -> ConduitM S.ByteString Void (RIO env) ()
-                    outputSink excludeTH level compilerVer prefix =
-                        CT.decodeUtf8Lenient
-                        .| mungeBuildOutput excludeTH makeAbsolute pkgDir compilerVer
-                        .| CL.mapM_ (logGeneric "" level . (prefix <>) . display)
-                    -- If users want control, we should add a config option for this
-                    makeAbsolute :: ConvertPathsToAbsolute
-                    makeAbsolute = case stripTHLoading of
-                        ExcludeTHLoading -> ConvertPathsToAbsolute
-                        KeepTHLoading    -> KeepPathsAsIs
-
-            exeName <- case esetupexehs of
-                Left setupExe -> pure setupExe
-                Right setuphs -> do
-                    distDir <- distDirFromDir pkgDir
-                    let setupDir = distDir </> relDirSetup
-                        outputFile = setupDir </> relFileSetupLower
-                    customBuilt <- liftIO $ readIORef eeCustomBuilt
-                    if Set.member (packageName package) customBuilt
-                        then pure outputFile
-                        else do
-                            ensureDir setupDir
-                            compilerPath <- view $ compilerPathsL.to cpCompiler
-                            packageArgs <- getPackageArgs setupDir
-                            runExe compilerPath $
-                                [ "--make"
-                                , "-odir", toFilePathNoTrailingSep setupDir
-                                , "-hidir", toFilePathNoTrailingSep setupDir
-                                , "-i", "-i."
-                                ] ++ packageArgs ++
-                                [ toFilePath setuphs
-                                , toFilePath eeSetupShimHs
-                                , "-main-is"
-                                , "StackSetupShim.mainOverride"
-                                , "-o", toFilePath outputFile
-                                , "-threaded"
-                                ] ++
-
-                                -- Apply GHC options
-                                -- https://github.com/commercialhaskell/stack/issues/4526
-                                map T.unpack (
-                                  Map.findWithDefault [] AGOEverything (configGhcOptionsByCat config) ++
-                                  case configApplyGhcOptions config of
-                                    AGOEverything -> boptsCLIGhcOptions eeBuildOptsCLI
-                                    AGOTargets -> []
-                                    AGOLocals -> [])
-
-                            liftIO $ atomicModifyIORef' eeCustomBuilt $
-                                \oldCustomBuilt -> (Set.insert (packageName package) oldCustomBuilt, ())
-                            pure outputFile
-            let cabalVerboseArg =
-                  let CabalVerbosity cv = boptsCabalVerbose eeBuildOpts
-                  in  "--verbose=" <> showForCabal cv
-            runExe exeName $ cabalVerboseArg:setupArgs
-
--- Implements running a package's build, used to implement 'ATBuild' and
--- 'ATBuildFinal' tasks.  In particular this does the following:
---
--- * Checks if the package exists in the precompiled cache, and if so,
---   add it to the database instead of performing the build.
---
--- * Runs the configure step if needed ('ensureConfig')
---
--- * Runs the build step
---
--- * Generates haddocks
---
--- * Registers the library and copies the built executables into the
---   local install directory. Note that this is literally invoking Cabal
---   with @copy@, and not the copying done by @stack install@ - that is
---   handled by 'copyExecutables'.
-singleBuild :: forall env. (HasEnvConfig env, HasRunner env)
-            => ActionContext
-            -> ExecuteEnv
-            -> Task
-            -> InstalledMap
-            -> Bool             -- ^ Is this a final build?
-            -> RIO env ()
-singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap isFinalBuild = do
-    (allDepsMap, cache) <- getConfigCache ee task installedMap enableTests enableBenchmarks
-    mprecompiled <- getPrecompiled cache
-    minstalled <-
-        case mprecompiled of
-            Just precompiled -> copyPreCompiled precompiled
-            Nothing -> do
-                mcurator <- view $ buildConfigL.to bcCurator
-                realConfigAndBuild cache mcurator allDepsMap
-    case minstalled of
-        Nothing -> pure ()
-        Just installed -> do
-            writeFlagCache installed cache
-            liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed
-  where
-    pname = pkgName taskProvides
-    doHaddock mcurator package
-                      = taskBuildHaddock &&
-                        not isFinalBuild &&
-                        -- Works around haddock failing on bytestring-builder since it has no modules
-                        -- when bytestring is new enough.
-                        packageHasExposedModules package &&
-                        -- Special help for the curator tool to avoid haddocks that are known to fail
-                        maybe True (Set.notMember pname . curatorSkipHaddock) mcurator
-    expectHaddockFailure mcurator =
-        maybe False (Set.member pname . curatorExpectHaddockFailure) mcurator
-    fulfillHaddockExpectations mcurator action | expectHaddockFailure mcurator = do
-        eres <- tryAny $ action KeepOpen
-        case eres of
-          Right () -> logWarn $ fromString (packageNameString pname) <> ": unexpected Haddock success"
-          Left _ -> pure ()
-    fulfillHaddockExpectations _ action = do
-        action CloseOnException
-
-    buildingFinals = isFinalBuild || taskAllInOne
-    enableTests = buildingFinals && any isCTest (taskComponents task)
-    enableBenchmarks = buildingFinals && any isCBench (taskComponents task)
-
-    annSuffix executableBuildStatuses = if result == "" then "" else " (" <> result <> ")"
-      where
-        result = T.intercalate " + " $ concat
-            [ ["lib" | taskAllInOne && hasLib]
-            , ["internal-lib" | taskAllInOne && hasSubLib]
-            , ["exe" | taskAllInOne && hasExe]
-            , ["test" | enableTests]
-            , ["bench" | enableBenchmarks]
-            ]
-        (hasLib, hasSubLib, hasExe) = case taskType of
-            TTLocalMutable lp ->
-              let package = lpPackage lp
-                  hasLibrary =
-                    case packageLibraries package of
-                      NoLibraries -> False
-                      HasLibraries _ -> True
-                  hasSubLibrary = not . Set.null $ packageInternalLibraries package
-                  hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp
-               in (hasLibrary, hasSubLibrary, hasExecutables)
-            -- This isn't true, but we don't want to have this info for
-            -- upstream deps.
-            _ -> (False, False, False)
-
-    getPrecompiled cache =
-        case taskType of
-            TTRemotePackage Immutable _ loc -> do
-                mpc <- readPrecompiledCache
-                       loc
-                       (configCacheOpts cache)
-                       (configCacheHaddock cache)
-                       (configCacheDeps cache)
-                case mpc of
-                    Nothing -> pure Nothing
-                    -- Only pay attention to precompiled caches that refer to packages within
-                    -- the snapshot.
-                    Just pc | maybe False
-                                    (bcoSnapInstallRoot eeBaseConfigOpts `isProperPrefixOf`)
-                                    (pcLibrary pc) ->
-                        pure Nothing
-                    -- If old precompiled cache files are left around but snapshots are deleted,
-                    -- it is possible for the precompiled file to refer to the very library
-                    -- we're building, and if flags are changed it may try to copy the library
-                    -- to itself. This check prevents that from happening.
-                    Just pc -> do
-                        let allM _ [] = pure True
-                            allM f (x:xs) = do
-                                b <- f x
-                                if b then allM f xs else pure False
-                        b <- liftIO $ allM doesFileExist $ maybe id (:) (pcLibrary pc) $ pcExes pc
-                        pure $ if b then Just pc else Nothing
-            _ -> pure Nothing
-
-    copyPreCompiled (PrecompiledCache mlib sublibs exes) = do
-        wc <- view $ actualCompilerVersionL.whichCompilerL
-        announceTask ee task "using precompiled package"
-
-        -- We need to copy .conf files for the main library and all sublibraries which exist in the cache,
-        -- from their old snapshot to the new one. However, we must unregister any such library in the new
-        -- snapshot, in case it was built with different flags.
-        let
-          subLibNames = map T.unpack . Set.toList $ case taskType of
-            TTLocalMutable lp -> packageInternalLibraries $ lpPackage lp
-            TTRemotePackage _ p _ -> packageInternalLibraries p
-          PackageIdentifier name version = taskProvides
-          mainLibName = packageNameString name
-          mainLibVersion = versionString version
-          pkgName = mainLibName ++ "-" ++ mainLibVersion
-          -- z-package-z-internal for internal lib internal of package package
-          toCabalInternalLibName n = concat ["z-", mainLibName, "-z-", n, "-", mainLibVersion]
-          allToUnregister = map (const pkgName) (maybeToList mlib) ++ map toCabalInternalLibName subLibNames
-          allToRegister = maybeToList mlib ++ sublibs
-
-        unless (null allToRegister) $ do
-            withMVar eeInstallLock $ \() -> do
-                -- We want to ignore the global and user databases.
-                -- Unfortunately, ghc-pkg doesn't take such arguments on the
-                -- command line. Instead, we'll set GHC_PACKAGE_PATH. See:
-                -- https://github.com/commercialhaskell/stack/issues/1146
-
-                let modifyEnv = Map.insert
-                      (ghcPkgPathEnvVar wc)
-                      (T.pack $ toFilePathNoTrailingSep $ bcoSnapDB eeBaseConfigOpts)
-
-                withModifyEnvVars modifyEnv $ do
-                  GhcPkgExe ghcPkgExe <- getGhcPkgExe
-
-                  -- first unregister everything that needs to be unregistered
-                  forM_ allToUnregister $ \packageName -> catchAny
-                      (readProcessNull (toFilePath ghcPkgExe) [ "unregister", "--force", packageName])
-                      (const (pure ()))
-
-                  -- now, register the cached conf files
-                  forM_ allToRegister $ \libpath ->
-                    proc (toFilePath ghcPkgExe) [ "register", "--force", toFilePath libpath] readProcess_
-
-        liftIO $ forM_ exes $ \exe -> do
-            ensureDir bindir
-            let dst = bindir </> filename exe
-            createLink (toFilePath exe) (toFilePath dst) `catchIO` \_ -> copyFile exe dst
-        case (mlib, exes) of
-            (Nothing, _:_) -> markExeInstalled (taskLocation task) taskProvides
-            _ -> pure ()
-
-        -- Find the package in the database
-        let pkgDbs = [bcoSnapDB eeBaseConfigOpts]
-
-        case mlib of
-            Nothing -> pure $ Just $ Executable taskProvides
-            Just _ -> do
-                mpkgid <- loadInstalledPkg pkgDbs eeSnapshotDumpPkgs pname
-
-                pure $ Just $
-                    case mpkgid of
-                        Nothing -> assert False $ Executable taskProvides
-                        Just pkgid -> Library taskProvides pkgid Nothing
-      where
-        bindir = bcoSnapInstallRoot eeBaseConfigOpts </> bindirSuffix
-
-    realConfigAndBuild cache mcurator allDepsMap = withSingleContext ac ee task allDepsMap Nothing
-        $ \package cabalfp pkgDir cabal0 announce _outputType -> do
-            let cabal = cabal0 CloseOnException
-            executableBuildStatuses <- getExecutableBuildStatuses package pkgDir
-            when (not (cabalIsSatisfied executableBuildStatuses) && taskIsTarget task)
-                 (logInfo
-                      ("Building all executables for `" <> fromString (packageNameString (packageName package)) <>
-                       "' once. After a successful build of all of them, only specified executables will be rebuilt."))
-
-            _neededConfig <- ensureConfig cache pkgDir ee (announce ("configure" <> display (annSuffix executableBuildStatuses))) cabal cabalfp task
-            let installedMapHasThisPkg :: Bool
-                installedMapHasThisPkg =
-                    case Map.lookup (packageName package) installedMap of
-                        Just (_, Library ident _ _) -> ident == taskProvides
-                        Just (_, Executable _) -> True
-                        _ -> False
-
-            case ( boptsCLIOnlyConfigure eeBuildOptsCLI
-                 , boptsCLIInitialBuildSteps eeBuildOptsCLI && taskIsTarget task) of
-                -- A full build is done if there are downstream actions,
-                -- because their configure step will require that this
-                -- package is built. See
-                -- https://github.com/commercialhaskell/stack/issues/2787
-                (True, _) | null acDownstream -> pure Nothing
-                (_, True) | null acDownstream || installedMapHasThisPkg -> do
-                    initialBuildSteps executableBuildStatuses cabal announce
-                    pure Nothing
-                _ -> fulfillCuratorBuildExpectations pname mcurator enableTests enableBenchmarks Nothing $
-                     Just <$> realBuild cache package pkgDir cabal0 announce executableBuildStatuses
-
-    initialBuildSteps executableBuildStatuses cabal announce = do
-        announce ("initial-build-steps" <> display (annSuffix executableBuildStatuses))
-        cabal KeepTHLoading ["repl", "stack-initial-build-steps"]
-
-    realBuild ::
-           ConfigCache
-        -> Package
-        -> Path Abs Dir
-        -> (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
-        -> (Utf8Builder -> RIO env ())
-        -> Map Text ExecutableBuildStatus
-        -> RIO env Installed
-    realBuild cache package pkgDir cabal0 announce executableBuildStatuses = do
-        let cabal = cabal0 CloseOnException
-        wc <- view $ actualCompilerVersionL.whichCompilerL
-
-        markExeNotInstalled (taskLocation task) taskProvides
-        case taskType of
-            TTLocalMutable lp -> do
-                when enableTests $ setTestStatus pkgDir TSUnknown
-                caches <- runMemoizedWith $ lpNewBuildCaches lp
-                mapM_ (uncurry (writeBuildCache pkgDir))
-                      (Map.toList caches)
-            TTRemotePackage{} -> pure ()
-
-        -- FIXME: only output these if they're in the build plan.
-
-        let postBuildCheck _succeeded = do
-                mlocalWarnings <- case taskType of
-                    TTLocalMutable lp -> do
-                        warnings <- checkForUnlistedFiles taskType pkgDir
-                        -- TODO: Perhaps only emit these warnings for non extra-dep?
-                        pure (Just (lpCabalFile lp, warnings))
-                    _ -> pure Nothing
-                -- NOTE: once
-                -- https://github.com/commercialhaskell/stack/issues/2649
-                -- is resolved, we will want to partition the warnings
-                -- based on variety, and output in different lists.
-                let showModuleWarning (UnlistedModulesWarning comp modules) =
-                      "- In" <+>
-                      fromString (T.unpack (renderComponent comp)) <>
-                      ":" <> line <>
-                      indent 4 ( mconcat
-                               $ L.intersperse line
-                               $ map
-                                   (style Good . fromString . C.display)
-                                   modules
-                               )
-                forM_ mlocalWarnings $ \(cabalfp, warnings) -> do
-                    unless (null warnings) $ prettyWarn $
-                           flow "The following modules should be added to \
-                                \exposed-modules or other-modules in" <+>
-                                pretty cabalfp
-                        <> ":"
-                        <> line
-                        <> indent 4 ( mconcat
-                                    $ L.intersperse line
-                                    $ map showModuleWarning warnings
-                                    )
-                        <> blankLine
-                        <> flow "Missing modules in the Cabal file are likely \
-                                \to cause undefined reference errors from the \
-                                \linker, along with other problems."
-
-        () <- announce ("build" <> display (annSuffix executableBuildStatuses))
-        config <- view configL
-        extraOpts <- extraBuildOptions wc eeBuildOpts
-        let stripTHLoading
-                | configHideTHLoading config = ExcludeTHLoading
-                | otherwise                  = KeepTHLoading
-        cabal stripTHLoading (("build" :) $ (++ extraOpts) $
-            case (taskType, taskAllInOne, isFinalBuild) of
-                (_, True, True) -> throwM AllInOneBuildBug
-                (TTLocalMutable lp, False, False) -> primaryComponentOptions executableBuildStatuses lp
-                (TTLocalMutable lp, False, True) -> finalComponentOptions lp
-                (TTLocalMutable lp, True, False) -> primaryComponentOptions executableBuildStatuses lp ++ finalComponentOptions lp
-                (TTRemotePackage{}, _, _) -> [])
-          `catch` \ex -> case ex of
-              CabalExitedUnsuccessfully{} ->
-                  postBuildCheck False >> throwM (PrettyException ex)
-              _ -> throwM ex
-        postBuildCheck True
-
-        mcurator <- view $ buildConfigL.to bcCurator
-        when (doHaddock mcurator package) $ do
-            announce "haddock"
-            sourceFlag <- if not (boptsHaddockHyperlinkSource eeBuildOpts) then pure [] else do
-                -- See #2429 for why the temp dir is used
-                ec
-                  <- withWorkingDir (toFilePath eeTempDir)
-                   $ proc "haddock" ["--hyperlinked-source"]
-                   $ \pc -> withProcessWait
-                     (setStdout createSource $ setStderr createSource pc) $ \p ->
-                       runConcurrently
-                         $ Concurrently (runConduit $ getStdout p .| CL.sinkNull)
-                        *> Concurrently (runConduit $ getStderr p .| CL.sinkNull)
-                        *> Concurrently (waitExitCode p)
-                case ec of
-                    -- Fancy crosslinked source
-                    ExitSuccess -> pure ["--haddock-option=--hyperlinked-source"]
-                    -- Older hscolour colouring
-                    ExitFailure _ -> do
-                        hscolourExists <- doesExecutableExist "HsColour"
-                        unless hscolourExists $ logWarn
-                            ("Warning: haddock not generating hyperlinked sources because 'HsColour' not\n" <>
-                             "found on PATH (use 'stack install hscolour' to install).")
-                        pure ["--hyperlink-source" | hscolourExists]
-
-            -- For GHC 8.4 and later, provide the --quickjump option.
-            actualCompiler <- view actualCompilerVersionL
-            let quickjump =
-                  case actualCompiler of
-                    ACGhc ghcVer
-                      | ghcVer >= mkVersion [8, 4] -> ["--haddock-option=--quickjump"]
-                    _ -> []
-
-            fulfillHaddockExpectations mcurator $ \keep -> cabal0 keep KeepTHLoading $ concat
-                [ ["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"]
-                , sourceFlag
-                , ["--internal" | boptsHaddockInternal eeBuildOpts]
-                , [ "--haddock-option=" <> opt
-                  | opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ]
-                , quickjump
-                ]
-
-        let hasLibrary =
-              case packageLibraries package of
-                NoLibraries -> False
-                HasLibraries _ -> True
-            packageHasComponentSet f = not $ Set.null $ f package
-            hasInternalLibrary = packageHasComponentSet packageInternalLibraries
-            hasExecutables = packageHasComponentSet packageExes
-            shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || hasExecutables)
-        when shouldCopy $ withMVar eeInstallLock $ \() -> do
-            announce "copy/register"
-            eres <- try $ cabal KeepTHLoading ["copy"]
-            case eres of
-                Left err@CabalExitedUnsuccessfully{} ->
-                    throwM $ CabalCopyFailed
-                               (packageBuildType package == C.Simple)
-                               (displayException err)
-                _ -> pure ()
-            when hasLibrary $ cabal KeepTHLoading ["register"]
-
-        -- copy ddump-* files
-        case T.unpack <$> boptsDdumpDir eeBuildOpts of
-          Just ddumpPath | buildingFinals && not (null ddumpPath) -> do
-            distDir <- distRelativeDir
-            ddumpDir <- parseRelDir ddumpPath
-
-            logDebug $ fromString ("ddump-dir: " <> toFilePath ddumpDir)
-            logDebug $ fromString ("dist-dir: " <> toFilePath distDir)
-
-            runConduitRes
-              $ CF.sourceDirectoryDeep False (toFilePath distDir)
-             .| CL.filter (L.isInfixOf ".dump-")
-             .| CL.mapM_ (\src -> liftIO $ do
-                  parentDir <- parent <$> parseRelDir src
-                  destBaseDir <- (ddumpDir </>) <$> stripProperPrefix distDir parentDir
-                  -- exclude .stack-work dir
-                  unless (".stack-work" `L.isInfixOf` toFilePath destBaseDir) $ do
-                    ensureDir destBaseDir
-                    src' <- parseRelFile src
-                    copyFile src' (destBaseDir </> filename src'))
-          _ -> pure ()
-
-        let (installedPkgDb, installedDumpPkgsTVar) =
-                case taskLocation task of
-                    Snap ->
-                         ( bcoSnapDB eeBaseConfigOpts
-                         , eeSnapshotDumpPkgs )
-                    Local ->
-                        ( bcoLocalDB eeBaseConfigOpts
-                        , eeLocalDumpPkgs )
-        let ident = PackageIdentifier (packageName package) (packageVersion package)
-        -- only pure the sublibs to cache them if we also cache the main lib (that is, if it exists)
-        (mpkgid, sublibsPkgIds) <- case packageLibraries package of
-            HasLibraries _ -> do
-                sublibsPkgIds <- fmap catMaybes $
-                  forM (Set.toList $ packageInternalLibraries package) $ \sublib -> do
-                    -- z-haddock-library-z-attoparsec for internal lib attoparsec of haddock-library
-                    let sublibName = T.concat ["z-", T.pack $ packageNameString $ packageName package, "-z-", sublib]
-                    case parsePackageName $ T.unpack sublibName of
-                      Nothing -> pure Nothing -- invalid lib, ignored
-                      Just subLibName -> loadInstalledPkg [installedPkgDb] installedDumpPkgsTVar subLibName
-
-                mpkgid <- loadInstalledPkg [installedPkgDb] installedDumpPkgsTVar (packageName package)
-                case mpkgid of
-                    Nothing -> throwM $ Couldn'tFindPkgId $ packageName package
-                    Just pkgid -> pure (Library ident pkgid Nothing, sublibsPkgIds)
-            NoLibraries -> do
-                markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache?
-                pure (Executable ident, []) -- don't pure sublibs in this case
-
-        case taskType of
-            TTRemotePackage Immutable _ loc ->
-              writePrecompiledCache
-                eeBaseConfigOpts
-                loc
-                (configCacheOpts cache)
-                (configCacheHaddock cache)
-                (configCacheDeps cache)
-                mpkgid sublibsPkgIds (packageExes package)
-            _ -> pure ()
-
-        case taskType of
-            -- For packages from a package index, pkgDir is in the tmp
-            -- directory. We eagerly delete it if no other tasks
-            -- require it, to reduce space usage in tmp (#3018).
-            TTRemotePackage{} -> do
-                let remaining = filter (\(ActionId x _) -> x == taskProvides) (Set.toList acRemaining)
-                when (null remaining) $ removeDirRecur pkgDir
-            TTLocalMutable{} -> pure ()
-
-        pure mpkgid
-
-    loadInstalledPkg pkgDbs tvar name = do
-        pkgexe <- getGhcPkgExe
-        dps <- ghcPkgDescribe pkgexe name pkgDbs $ conduitDumpPackage .| CL.consume
-        case dps of
-            [] -> pure Nothing
-            [dp] -> do
-                liftIO $ atomically $ modifyTVar' tvar (Map.insert (dpGhcPkgId dp) dp)
-                pure $ Just (dpGhcPkgId dp)
-            _ -> throwM $ MulipleResultsBug name dps
-
--- | Get the build status of all the package executables. Do so by
--- testing whether their expected output file exists, e.g.
---
--- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha
--- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha.exe
--- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha.jsexe/ (NOTE: a dir)
-getExecutableBuildStatuses ::
-       HasEnvConfig env
-    => Package -> Path Abs Dir -> RIO env (Map Text ExecutableBuildStatus)
-getExecutableBuildStatuses package pkgDir = do
-    distDir <- distDirFromDir pkgDir
-    platform <- view platformL
-    fmap
-        M.fromList
-        (mapM (checkExeStatus platform distDir) (Set.toList (packageExes package)))
-
--- | Check whether the given executable is defined in the given dist directory.
-checkExeStatus ::
-       HasLogFunc env
-    => Platform
-    -> Path b Dir
-    -> Text
-    -> RIO env (Text, ExecutableBuildStatus)
-checkExeStatus platform distDir name = do
-    exename <- parseRelDir (T.unpack name)
-    exists <- checkPath (distDir </> relDirBuild </> exename)
-    pure
-        ( name
-        , if exists
-              then ExecutableBuilt
-              else ExecutableNotBuilt)
-  where
-    checkPath base =
-        case platform of
-            Platform _ Windows -> do
-                fileandext <- parseRelFile (file ++ ".exe")
-                doesFileExist (base </> fileandext)
-            _ -> do
-                fileandext <- parseRelFile file
-                doesFileExist (base </> fileandext)
-      where
-        file = T.unpack name
-
--- | Check if any unlisted files have been found, and add them to the build cache.
-checkForUnlistedFiles ::
-     HasEnvConfig env
-  => TaskType
-  -> Path Abs Dir
-  -> RIO env [PackageWarning]
-checkForUnlistedFiles (TTLocalMutable lp) pkgDir = do
-    caches <- runMemoizedWith $ lpNewBuildCaches lp
-    (addBuildCache,warnings) <-
-        addUnlistedToBuildCache
-            (lpPackage lp)
-            (lpCabalFile lp)
-            (lpComponents lp)
-            caches
-    forM_ (M.toList addBuildCache) $ \(component, newToCache) -> do
-        let cache = Map.findWithDefault Map.empty component caches
-        writeBuildCache pkgDir component $
-            Map.unions (cache : newToCache)
-    pure warnings
-checkForUnlistedFiles TTRemotePackage{} _ = pure []
-
--- | Implements running a package's tests. Also handles producing
--- coverage reports if coverage is enabled.
-singleTest :: HasEnvConfig env
-           => TestOpts
-           -> [Text]
-           -> ActionContext
-           -> ExecuteEnv
-           -> Task
-           -> InstalledMap
-           -> RIO env ()
-singleTest topts testsToRun ac ee task installedMap = do
-    -- FIXME: Since this doesn't use cabal, we should be able to avoid using a
-    -- full blown 'withSingleContext'.
-    (allDepsMap, _cache) <- getConfigCache ee task installedMap True False
-    mcurator <- view $ buildConfigL.to bcCurator
-    let pname = pkgName $ taskProvides task
-        expectFailure = expectTestFailure pname mcurator
-    withSingleContext ac ee task allDepsMap (Just "test") $ \package _cabalfp pkgDir _cabal announce outputType -> do
-        config <- view configL
-        let needHpc = toCoverage topts
-
-        toRun <-
-            if toDisableRun topts
-              then do
-                  announce "Test running disabled by --no-run-tests flag."
-                  pure False
-              else if toRerunTests topts
-                  then pure True
-                  else do
-                    status <- getTestStatus pkgDir
-                    case status of
-                      TSSuccess -> do
-                        unless (null testsToRun) $ announce "skipping already passed test"
-                        pure False
-                      TSFailure
-                        | expectFailure -> do
-                            announce "skipping already failed test that's expected to fail"
-                            pure False
-                        | otherwise -> do
-                            announce "rerunning previously failed test"
-                            pure True
-                      TSUnknown -> pure True
-
-        when toRun $ do
-            buildDir <- distDirFromDir pkgDir
-            hpcDir <- hpcDirFromDir pkgDir
-            when needHpc (ensureDir hpcDir)
-
-            let suitesToRun
-                  = [ testSuitePair
-                    | testSuitePair <- Map.toList $ packageTests package
-                    , let testName = fst testSuitePair
-                    , testName `elem` testsToRun
-                    ]
-
-            errs <- liftM Map.unions $ forM suitesToRun $ \(testName, suiteInterface) -> do
-                let stestName = T.unpack testName
-                (testName', isTestTypeLib) <-
-                    case suiteInterface of
-                        C.TestSuiteLibV09{} -> pure (stestName ++ "Stub", True)
-                        C.TestSuiteExeV10{} -> pure (stestName, False)
-                        interface -> throwM (TestSuiteTypeUnsupported interface)
-
-                let exeName = testName' ++
-                        case configPlatform config of
-                            Platform _ Windows -> ".exe"
-                            _ -> ""
-                tixPath <- liftM (pkgDir </>) $ parseRelFile $ exeName ++ ".tix"
-                exePath <- liftM (buildDir </>) $ parseRelFile $ "build/" ++ testName' ++ "/" ++ exeName
-                exists <- doesFileExist exePath
-                -- in Stack.Package.packageFromPackageDescription we filter out
-                -- package itself of any dependencies so any tests requiring loading
-                -- of their own package library will fail
-                -- so to prevent this we return it back here but unfortunately unconditionally
-                installed <- case Map.lookup pname installedMap of
-                  Just (_, installed) -> pure $ Just installed
-                  Nothing -> do
-                    idMap <- liftIO $ readTVarIO (eeGhcPkgIds ee)
-                    pure $ Map.lookup (taskProvides task) idMap
-                let pkgGhcIdList = case installed of
-                                       Just (Library _ ghcPkgId _) -> [ghcPkgId]
-                                       _ -> []
-                -- doctest relies on template-haskell in QuickCheck-based tests
-                thGhcId <- case L.find ((== "template-haskell") . pkgName . dpPackageIdent. snd)
-                                (Map.toList $ eeGlobalDumpPkgs ee) of
-                  Just (ghcId, _) -> pure ghcId
-                  Nothing -> throwIO TemplateHaskellNotFoundBug
-                -- env variable GHC_ENVIRONMENT is set for doctest so module names for
-                -- packages with proper dependencies should no longer get ambiguous
-                -- see e.g. https://github.com/doctest/issues/119
-                -- also we set HASKELL_DIST_DIR to a package dist directory so
-                -- doctest will be able to load modules autogenerated by Cabal
-                let setEnv f pc = modifyEnvVars pc $ \envVars ->
-                      Map.insert "HASKELL_DIST_DIR" (T.pack $ toFilePath buildDir) $
-                      Map.insert "GHC_ENVIRONMENT" (T.pack f) envVars
-                    fp' = eeTempDir ee </> testGhcEnvRelFile
-                -- Add a random suffix to avoid conflicts between parallel jobs
-                -- See https://github.com/commercialhaskell/stack/issues/5024
-                randomInt <- liftIO (randomIO :: IO Int)
-                let randomSuffix = "." <> show (abs randomInt)
-                fp <- toFilePath <$> addExtension randomSuffix fp'
-                let snapDBPath = toFilePathNoTrailingSep (bcoSnapDB $ eeBaseConfigOpts ee)
-                    localDBPath = toFilePathNoTrailingSep (bcoLocalDB $ eeBaseConfigOpts ee)
-                    ghcEnv =
-                        "clear-package-db\n" <>
-                        "global-package-db\n" <>
-                        "package-db " <> fromString snapDBPath <> "\n" <>
-                        "package-db " <> fromString localDBPath <> "\n" <>
-                        foldMap (\ghcId -> "package-id " <> display (unGhcPkgId ghcId) <> "\n")
-                            (pkgGhcIdList ++ thGhcId:M.elems allDepsMap)
-                writeFileUtf8Builder fp ghcEnv
-                menv <- liftIO $ setEnv fp =<< configProcessContextSettings config EnvSettings
-                    { esIncludeLocals = taskLocation task == Local
-                    , esIncludeGhcPackagePath = True
-                    , esStackExe = True
-                    , esLocaleUtf8 = False
-                    , esKeepGhcRts = False
-                    }
-                let emptyResult = Map.singleton testName Nothing
-                withProcessContext menv $ if exists
-                    then do
-                        -- We clear out the .tix files before doing a run.
-                        when needHpc $ do
-                            tixexists <- doesFileExist tixPath
-                            when tixexists $
-                                logWarn ("Removing HPC file " <> fromString (toFilePath tixPath))
-                            liftIO $ ignoringAbsence (removeFile tixPath)
-
-                        let args = toAdditionalArgs topts
-                            argsDisplay = case args of
-                                            [] -> ""
-                                            _ -> ", args: " <> T.intercalate " " (map showProcessArgDebug args)
-                        announce $ "test (suite: " <> display testName <> display argsDisplay <> ")"
-
-                        -- Clear "Progress: ..." message before
-                        -- redirecting output.
-                        case outputType of
-                          OTConsole _ -> do
-                            logStickyDone ""
-                            liftIO $ hFlush stdout
-                            liftIO $ hFlush stderr
-                          OTLogFile _ _ -> pure ()
-
-                        let output =
-                                case outputType of
-                                    OTConsole Nothing -> Nothing <$ inherit
-                                    OTConsole (Just prefix) -> fmap
-                                      (\src -> Just $ runConduit $ src .|
-                                               CT.decodeUtf8Lenient .|
-                                               CT.lines .|
-                                               CL.map stripCR .|
-                                               CL.mapM_ (\t -> logInfo $ prefix <> display t))
-                                      createSource
-                                    OTLogFile _ h -> Nothing <$ useHandleOpen h
-                            optionalTimeout action
-                                | Just maxSecs <- toMaximumTimeSeconds topts, maxSecs > 0 = do
-                                    timeout (maxSecs * 1000000) action
-                                | otherwise = Just <$> action
-
-                        mec <- withWorkingDir (toFilePath pkgDir) $
-                          optionalTimeout $ proc (toFilePath exePath) args $ \pc0 -> do
-                            changeStdin <-
-                              if isTestTypeLib
-                                then do
-                                  logPath <- buildLogPath package (Just stestName)
-                                  ensureDir (parent logPath)
-                                  pure $ setStdin
-                                       $ byteStringInput
-                                       $ BL.fromStrict
-                                       $ encodeUtf8 $ fromString $
-                                       show (logPath, mkUnqualComponentName (T.unpack testName))
-                                else do
-                                  isTerminal <- view $ globalOptsL.to globalTerminal
-                                  if toAllowStdin topts && isTerminal
-                                    then pure id
-                                    else pure $ setStdin $ byteStringInput mempty
-                            let pc = changeStdin
-                                   $ setStdout output
-                                   $ setStderr output
-                                     pc0
-                            withProcessWait pc $ \p -> do
-                              case (getStdout p, getStderr p) of
-                                (Nothing, Nothing) -> pure ()
-                                (Just x, Just y) -> concurrently_ x y
-                                (x, y) -> assert False $ concurrently_ (fromMaybe (pure ()) x) (fromMaybe (pure ()) y)
-                              waitExitCode p
-                        -- Add a trailing newline, incase the test
-                        -- output didn't finish with a newline.
-                        case outputType of
-                          OTConsole Nothing -> logInfo ""
-                          _ -> pure ()
-                        -- Move the .tix file out of the package
-                        -- directory into the hpc work dir, for
-                        -- tidiness.
-                        when needHpc $
-                            updateTixFile (packageName package) tixPath testName'
-                        let announceResult result = announce $ "Test suite " <> display testName <> " " <> result
-                        case mec of
-                            Just ExitSuccess -> do
-                                announceResult "passed"
-                                pure Map.empty
-                            Nothing -> do
-                                announceResult "timed out"
-                                if expectFailure
-                                then pure Map.empty
-                                else pure $ Map.singleton testName Nothing
-                            Just ec -> do
-                                announceResult "failed"
-                                if expectFailure
-                                then pure Map.empty
-                                else pure $ Map.singleton testName (Just ec)
-                    else do
-                        unless expectFailure $ logError $ displayShow $ TestSuiteExeMissing
-                            (packageBuildType package == C.Simple)
-                            exeName
-                            (packageNameString (packageName package))
-                            (T.unpack testName)
-                        pure emptyResult
-
-            when needHpc $ do
-                let testsToRun' = map f testsToRun
-                    f tName =
-                        case Map.lookup tName (packageTests package) of
-                            Just C.TestSuiteLibV09{} -> tName <> "Stub"
-                            _ -> tName
-                generateHpcReport pkgDir package testsToRun'
-
-            bs <- liftIO $
-                case outputType of
-                    OTConsole _ -> pure ""
-                    OTLogFile logFile h -> do
-                        hClose h
-                        S.readFile $ toFilePath logFile
-
-            let succeeded = Map.null errs
-            unless (succeeded || expectFailure) $ throwM $ TestSuiteFailure
-                (taskProvides task)
-                errs
-                (case outputType of
-                   OTLogFile fp _ -> Just fp
-                   OTConsole _ -> Nothing)
-                bs
-
-            setTestStatus pkgDir $ if succeeded then TSSuccess else TSFailure
-
--- | Implements running a package's benchmarks.
-singleBench :: HasEnvConfig env
-            => BenchmarkOpts
-            -> [Text]
-            -> ActionContext
-            -> ExecuteEnv
-            -> Task
-            -> InstalledMap
-            -> RIO env ()
-singleBench beopts benchesToRun ac ee task installedMap = do
-    (allDepsMap, _cache) <- getConfigCache ee task installedMap False True
-    withSingleContext ac ee task allDepsMap (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _outputType -> do
-        let args = map T.unpack benchesToRun <> maybe []
-                         ((:[]) . ("--benchmark-options=" <>))
-                         (beoAdditionalArgs beopts)
-
-        toRun <-
-            if beoDisableRun beopts
-              then do
-                  announce "Benchmark running disabled by --no-run-benchmarks flag."
-                  pure False
-              else do
-                  pure True
-
-        when toRun $ do
-            announce "benchmarks"
-            cabal CloseOnException KeepTHLoading ("bench" : args)
-
-data ExcludeTHLoading = ExcludeTHLoading | KeepTHLoading
-data ConvertPathsToAbsolute = ConvertPathsToAbsolute | KeepPathsAsIs
--- | special marker for expected failures in curator builds, using those
--- we need to keep log handle open as build continues further even after a failure
-data KeepOutputOpen = KeepOpen | CloseOnException deriving Eq
-
--- | Strip Template Haskell "Loading package" lines and making paths absolute.
-mungeBuildOutput :: forall m. MonadIO m
-                 => ExcludeTHLoading       -- ^ exclude TH loading?
-                 -> ConvertPathsToAbsolute -- ^ convert paths to absolute?
-                 -> Path Abs Dir           -- ^ package's root directory
-                 -> ActualCompiler         -- ^ compiler we're building with
-                 -> ConduitM Text Text m ()
-mungeBuildOutput excludeTHLoading makeAbsolute pkgDir compilerVer = void $
-    CT.lines
-    .| CL.map stripCR
-    .| CL.filter (not . isTHLoading)
-    .| filterLinkerWarnings
-    .| toAbsolute
-  where
-    -- | Is this line a Template Haskell "Loading package" line
-    -- ByteString
-    isTHLoading :: Text -> Bool
-    isTHLoading = case excludeTHLoading of
-        KeepTHLoading    -> const False
-        ExcludeTHLoading -> \bs ->
-            "Loading package " `T.isPrefixOf` bs &&
-            ("done." `T.isSuffixOf` bs || "done.\r" `T.isSuffixOf` bs)
-
-    filterLinkerWarnings :: ConduitM Text Text m ()
-    filterLinkerWarnings
-        -- Check for ghc 7.8 since it's the only one prone to producing
-        -- linker warnings on Windows x64
-        | getGhcVersion compilerVer >= mkVersion [7, 8] = doNothing
-        | otherwise = CL.filter (not . isLinkerWarning)
-
-    isLinkerWarning :: Text -> Bool
-    isLinkerWarning str =
-        ("ghc.exe: warning:" `T.isPrefixOf` str || "ghc.EXE: warning:" `T.isPrefixOf` str) &&
-        "is linked instead of __imp_" `T.isInfixOf` str
-
-    -- | Convert GHC error lines with file paths to have absolute file paths
-    toAbsolute :: ConduitM Text Text m ()
-    toAbsolute = case makeAbsolute of
-        KeepPathsAsIs          -> doNothing
-        ConvertPathsToAbsolute -> CL.mapM toAbsolutePath
-
-    toAbsolutePath :: Text -> m Text
-    toAbsolutePath bs = do
-        let (x, y) = T.break (== ':') bs
-        mabs <-
-            if isValidSuffix y
-                then liftIO $ liftM (fmap ((T.takeWhile isSpace x <>) . T.pack . toFilePath)) $
-                         forgivingAbsence (resolveFile pkgDir (T.unpack $ T.dropWhile isSpace x)) `catch`
-                             \(_ :: PathException) -> pure Nothing
-                else pure Nothing
-        case mabs of
-            Nothing -> pure bs
-            Just fp -> pure $ fp `T.append` y
-
-    doNothing :: ConduitM Text Text m ()
-    doNothing = awaitForever yield
-
-    -- | Match the error location format at the end of lines
-    isValidSuffix = isRight . parseOnly lineCol
-    lineCol = char ':'
-           >> choice
-                [ num >> char ':' >> num >> optional (char '-' >> num) >> pure ()
-                , char '(' >> num >> char ',' >> num >> P.string ")-(" >> num >> char ',' >> num >> char ')' >> pure ()
-                ]
-           >> char ':'
-           >> pure ()
-        where num = some digit
-
--- | Whether to prefix log lines with timestamps.
-data PrefixWithTimestamps = PrefixWithTimestamps | WithoutTimestamps
-
--- | Write stream of lines to handle, but adding timestamps.
-sinkWithTimestamps :: MonadIO m => PrefixWithTimestamps -> Handle -> ConduitT ByteString Void m ()
-sinkWithTimestamps prefixWithTimestamps h =
-    case prefixWithTimestamps of
-        PrefixWithTimestamps ->
-            CB.lines .| CL.mapM addTimestamp .| CL.map (<> "\n") .| sinkHandle h
-        WithoutTimestamps -> sinkHandle h
-  where
-    addTimestamp theLine = do
-        now <- liftIO getZonedTime
-        pure (formatZonedTimeForLog now <> " " <> theLine)
-
--- | Format a time in ISO8601 format. We choose ZonedTime over UTCTime
--- because a user expects to see logs in their local time, and would
--- be confused to see UTC time. Stack's debug logs also use the local
--- time zone.
-formatZonedTimeForLog :: ZonedTime -> ByteString
-formatZonedTimeForLog = S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q"
-
--- | Find the Setup.hs or Setup.lhs in the given directory. If none exists,
--- throw an exception.
-getSetupHs :: Path Abs Dir -- ^ project directory
-           -> IO (Path Abs File)
-getSetupHs dir = do
-    exists1 <- doesFileExist fp1
-    if exists1
-        then pure fp1
-        else do
-            exists2 <- doesFileExist fp2
-            if exists2
-                then pure fp2
-                else throwM $ NoSetupHsFound dir
-  where
-    fp1 = dir </> relFileSetupHs
-    fp2 = dir </> relFileSetupLhs
-
--- Do not pass `-hpcdir` as GHC option if the coverage is not enabled.
--- This helps running stack-compiled programs with dynamic interpreters like `hint`.
--- Cfr: https://github.com/commercialhaskell/stack/issues/997
-extraBuildOptions :: (HasEnvConfig env, HasRunner env)
-                  => WhichCompiler -> BuildOpts -> RIO env [String]
-extraBuildOptions wc bopts = do
-    colorOpt <- appropriateGhcColorFlag
-    let optsFlag = compilerOptionsCabalFlag wc
-        baseOpts = maybe "" (" " ++) colorOpt
-    if toCoverage (boptsTestOpts bopts)
-      then do
-        hpcIndexDir <- toFilePathNoTrailingSep <$> hpcRelativeDir
-        pure [optsFlag, "-hpcdir " ++ hpcIndexDir ++ baseOpts]
-      else
-        pure [optsFlag, baseOpts]
-
--- Library, internal and foreign libraries and executable build components.
-primaryComponentOptions :: Map Text ExecutableBuildStatus -> LocalPackage -> [String]
-primaryComponentOptions executableBuildStatuses lp =
-      -- TODO: get this information from target parsing instead,
-      -- which will allow users to turn off library building if
-      -- desired
-      (case packageLibraries package of
-         NoLibraries -> []
-         HasLibraries names ->
-             map T.unpack
-           $ T.append "lib:" (T.pack (packageNameString (packageName package)))
-           : map (T.append "flib:") (Set.toList names)) ++
-      map (T.unpack . T.append "lib:") (Set.toList $ packageInternalLibraries package) ++
-      map (T.unpack . T.append "exe:") (Set.toList $ exesToBuild executableBuildStatuses lp)
-  where
-    package = lpPackage lp
-
--- | History of this function:
---
--- * Normally it would do either all executables or if the user
---   specified requested components, just build them. Afterwards, due
---   to this Cabal bug <https://github.com/haskell/cabal/issues/2780>,
---   we had to make Stack build all executables every time.
---
--- * In <https://github.com/commercialhaskell/stack/issues/3229> this
---   was flagged up as very undesirable behavior on a large project,
---   hence the behavior below that we build all executables once
---   (modulo success), and thereafter pay attention to user-wanted
---   components.
---
-exesToBuild :: Map Text ExecutableBuildStatus -> LocalPackage -> Set Text
-exesToBuild executableBuildStatuses lp =
-    if cabalIsSatisfied executableBuildStatuses && lpWanted lp
-        then exeComponents (lpComponents lp)
-        else packageExes (lpPackage lp)
-
--- | Do the current executables satisfy Cabal's bugged out requirements?
-cabalIsSatisfied :: Map k ExecutableBuildStatus -> Bool
-cabalIsSatisfied = all (== ExecutableBuilt) . M.elems
-
--- Test-suite and benchmark build components.
-finalComponentOptions :: LocalPackage -> [String]
-finalComponentOptions lp =
-    map (T.unpack . renderComponent) $
-    Set.toList $
-    Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp)
-
-taskComponents :: Task -> Set NamedComponent
-taskComponents task =
-    case taskType task of
-        TTLocalMutable lp -> lpComponents lp -- FIXME probably just want lpWanted
-        TTRemotePackage{} -> Set.empty
-
-expectTestFailure :: PackageName -> Maybe Curator -> Bool
-expectTestFailure pname mcurator =
-    maybe False (Set.member pname . curatorExpectTestFailure) mcurator
-
-expectBenchmarkFailure :: PackageName -> Maybe Curator -> Bool
-expectBenchmarkFailure pname mcurator =
-    maybe False (Set.member pname . curatorExpectBenchmarkFailure) mcurator
-
-fulfillCuratorBuildExpectations ::
-       (HasLogFunc env, HasCallStack)
-    => PackageName
-    -> Maybe Curator
-    -> Bool
-    -> Bool
-    -> b
-    -> RIO env b
-    -> RIO env b
-fulfillCuratorBuildExpectations pname mcurator enableTests _ defValue action | enableTests &&
-                                                                          expectTestFailure pname mcurator = do
-    eres <- tryAny action
-    case eres of
-      Right res -> do
-          logWarn $ fromString (packageNameString pname) <> ": unexpected test build success"
-          pure res
-      Left _ -> pure defValue
-fulfillCuratorBuildExpectations pname mcurator _ enableBench defValue action | enableBench &&
-                                                                          expectBenchmarkFailure pname mcurator = do
-    eres <- tryAny action
-    case eres of
-      Right res -> do
-          logWarn $ fromString (packageNameString pname) <> ": unexpected benchmark build success"
-          pure res
-      Left _ -> pure defValue
-fulfillCuratorBuildExpectations _ _ _ _ _ action = do
-    action
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+-- | Perform a build
+module Stack.Build.Execute
+  ( printPlan
+  , preFetch
+  , executePlan
+  -- * Running Setup.hs
+  , ExecuteEnv
+  , withExecuteEnv
+  , withSingleContext
+  , ExcludeTHLoading (..)
+  , KeepOutputOpen (..)
+  ) where
+
+import           Control.Concurrent.Execute
+                   ( Action (..), ActionContext (..), ActionId (..)
+                   , ActionType (..)
+                   , Concurrency (..), runActions
+                   )
+import           Control.Concurrent.STM ( check )
+import           Crypto.Hash ( SHA256 (..), hashWith )
+import           Data.Attoparsec.Text ( char, choice, digit, parseOnly )
+import qualified Data.Attoparsec.Text as P ( string )
+import qualified Data.ByteArray as Mem ( convert )
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Builder ( toLazyByteString )
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Base64.URL as B64URL
+import           Data.Char ( isSpace )
+import           Conduit
+                   ( ConduitT, awaitForever, runConduitRes, sinkHandle
+                   , withSinkFile, withSourceFile, yield
+                   )
+import qualified Data.Conduit.Binary as CB
+import qualified Data.Conduit.Filesystem as CF
+import qualified Data.Conduit.List as CL
+import           Data.Conduit.Process.Typed ( createSource )
+import qualified Data.Conduit.Text as CT
+import qualified Data.List as L
+import           Data.List.NonEmpty ( nonEmpty )
+import qualified Data.List.NonEmpty as NonEmpty ( toList )
+import           Data.List.Split ( chunksOf )
+import qualified Data.Map.Merge.Strict as Map
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import           Data.Text.Encoding ( decodeUtf8 )
+import           Data.Tuple ( swap )
+import           Data.Time
+                   ( ZonedTime, getZonedTime, formatTime, defaultTimeLocale )
+import qualified Data.ByteString.Char8 as S8
+import qualified Distribution.PackageDescription as C
+import           Distribution.Pretty ( prettyShow )
+import qualified Distribution.Simple.Build.Macros as C
+import           Distribution.System ( OS (Windows), Platform (Platform) )
+import qualified Distribution.Text as C
+import           Distribution.Types.MungedPackageName
+                   ( encodeCompatPackageName )
+import           Distribution.Types.PackageName ( mkPackageName )
+import           Distribution.Types.UnqualComponentName
+                   ( mkUnqualComponentName )
+import           Distribution.Verbosity ( showForCabal )
+import           Distribution.Version ( mkVersion )
+import           Pantry.Internal.Companion ( Companion, withCompanion )
+import           Path
+                   ( PathException, (</>), addExtension, filename
+                   , isProperPrefixOf, parent, parseRelDir, parseRelFile
+                   , stripProperPrefix
+                   )
+import           Path.CheckInstall ( warnInstallSearchPathIssues )
+import           Path.Extra
+                   ( forgivingResolveFile, rejectMissingFile
+                   , toFilePathNoTrailingSep
+                   )
+import           Path.IO
+                   ( copyFile, doesDirExist, doesFileExist, ensureDir
+                   , ignoringAbsence, removeDirRecur, removeFile, renameDir
+                   , renameFile
+                   )
+import           RIO.Process
+                   ( HasProcessContext, byteStringInput, doesExecutableExist
+                   , eceExitCode, findExecutable, getStderr, getStdout, inherit
+                   , modifyEnvVars, proc, readProcess_, runProcess_, setStderr
+                   , setStdin, setStdout, showProcessArgDebug, useHandleOpen
+                   , waitExitCode, withModifyEnvVars, withProcessWait
+                   , withWorkingDir
+                   )
+import           Stack.Build.Cache
+                   ( TestStatus (..), deleteCaches, getTestStatus
+                   , markExeInstalled, markExeNotInstalled, readPrecompiledCache
+                   , setTestStatus, tryGetCabalMod, tryGetConfigCache
+                   , tryGetPackageProjectRoot, tryGetSetupConfigMod
+                   , writeBuildCache, writeCabalMod, writeConfigCache
+                   , writeFlagCache, writePrecompiledCache
+                   , writePackageProjectRoot, writeSetupConfigMod
+                   )
+import           Stack.Build.Haddock
+                   ( generateDepsHaddockIndex, generateLocalHaddockIndex
+                   , generateSnapHaddockIndex, openHaddocksInBrowser
+                   )
+import           Stack.Build.Installed (  )
+import           Stack.Build.Source ( addUnlistedToBuildCache )
+import           Stack.Build.Target (  )
+import           Stack.Config ( checkOwnership )
+import           Stack.Constants
+                   ( bindirSuffix, cabalPackageName, compilerOptionsCabalFlag
+                   , osIsWindows, relDirBuild, relDirDist, relDirSetup
+                   , relDirSetupExeCache, relDirSetupExeSrc, relFileBuildLock
+                   , relFileConfigure, relFileSetupHs, relFileSetupLhs
+                   , relFileSetupLower, relFileSetupMacrosH, setupGhciShimCode
+                   , stackProgName, testGhcEnvRelFile
+                   )
+import           Stack.Constants.Config
+                   ( distDirFromDir, distRelativeDir, hpcDirFromDir
+                   , hpcRelativeDir, setupConfigFromDir
+                   )
+import           Stack.Coverage
+                   ( deleteHpcReports, generateHpcMarkupIndex, generateHpcReport
+                   , generateHpcUnifiedReport, updateTixFile
+                   )
+import           Stack.DefaultColorWhen ( defaultColorWhen )
+import           Stack.GhcPkg ( ghcPkgPathEnvVar, unregisterGhcPkgIds )
+import           Stack.Package ( buildLogPath )
+import           Stack.PackageDump ( conduitDumpPackage, ghcPkgDescribe )
+import           Stack.Prelude
+import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
+import           Stack.Types.Build
+                   ( ConfigCache (..), Plan (..), PrecompiledCache (..)
+                   , Task (..), TaskConfigOpts (..), TaskType (..)
+                   , configCacheComponents, taskIsTarget, taskLocation
+                   )
+import           Stack.Types.Build.Exception
+                   ( BuildException (..), BuildPrettyException (..) )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), projectRootL )
+import           Stack.Types.BuildOpts
+                   ( BenchmarkOpts (..), BuildOpts (..), BuildOptsCLI (..)
+                   , CabalVerbosity (..), HaddockOpts (..), TestOpts (..)
+                   )
+import           Stack.Types.Compiler
+                   ( ActualCompiler (..), WhichCompiler (..)
+                   , compilerVersionString, getGhcVersion, whichCompilerL
+                   )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), GhcPkgExe (..), HasCompiler (..)
+                   , cabalVersionL, cpWhich, getCompilerPath, getGhcPkgExe
+                   )
+import           Stack.Types.Config
+                   ( Config (..), HasConfig (..), buildOptsL, stackRootL )
+import           Stack.Types.ConfigureOpts
+                   ( BaseConfigOpts (..), ConfigureOpts (..) )
+import           Stack.Types.DumpLogs ( DumpLogs (..) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.EnvConfig
+                   ( HasEnvConfig (..), actualCompilerVersionL
+                   , appropriateGhcColorFlag, bindirCompilerTools
+                   , installationRootDeps, installationRootLocal
+                   , packageDatabaseLocal, platformGhcRelDir
+                   , shouldForceGhcColorFlag
+                   )
+import           Stack.Types.EnvSettings ( EnvSettings (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString, unGhcPkgId )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.IsMutable ( IsMutable (..) )
+import           Stack.Types.NamedComponent
+                   ( NamedComponent, benchComponents, exeComponents, isCBench
+                   , isCTest, renderComponent, testComponents
+                   )
+import           Stack.Types.Package
+                   ( InstallLocation (..), Installed (..), InstalledMap
+                   , LocalPackage (..), Package (..), PackageLibraries (..)
+                   , installedPackageIdentifier, packageIdent, packageIdentifier
+                   , runMemoizedWith
+                   )
+import           Stack.Types.PackageFile ( PackageWarning (..) )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Curator ( Curator (..) )
+import           Stack.Types.Runner ( HasRunner, globalOptsL, terminalL )
+import           Stack.Types.SourceMap ( Target )
+import           Stack.Types.Version ( withinRange )
+import qualified System.Directory as D
+import           System.Environment ( getExecutablePath, lookupEnv )
+import           System.FileLock
+                   ( SharedExclusive (Exclusive), withFileLock, withTryFileLock
+                   )
+import qualified System.FilePath as FP
+import           System.IO.Error ( isDoesNotExistError )
+import           System.PosixCompat.Files
+                   ( createLink, getFileStatus, modificationTime )
+import           System.Random ( randomIO )
+
+-- | Has an executable been built or not?
+data ExecutableBuildStatus
+  = ExecutableBuilt
+  | ExecutableNotBuilt
+  deriving (Eq, Ord, Show)
+
+-- | Fetch the packages necessary for a build, for example in combination with
+-- a dry run.
+preFetch :: HasEnvConfig env => Plan -> RIO env ()
+preFetch plan
+  | Set.null pkgLocs = logDebug "Nothing to fetch"
+  | otherwise = do
+      logDebug $
+           "Prefetching: "
+        <> mconcat (L.intersperse ", " (display <$> Set.toList pkgLocs))
+      fetchPackages pkgLocs
+ where
+  pkgLocs = Set.unions $ map toPkgLoc $ Map.elems $ planTasks plan
+
+  toPkgLoc task =
+    case taskType task of
+      TTLocalMutable{} -> Set.empty
+      TTRemotePackage _ _ pkgloc -> Set.singleton pkgloc
+
+-- | Print a description of build plan for human consumption.
+printPlan :: (HasRunner env, HasTerm env) => Plan -> RIO env ()
+printPlan plan = do
+  case Map.elems $ planUnregisterLocal plan of
+    [] -> prettyInfo $
+               flow "No packages would be unregistered."
+            <> line
+    xs -> do
+      let unregisterMsg (ident, reason) = fillSep $
+              fromString (packageIdentifierString ident)
+            : [ parens $ flow (T.unpack reason) | not $ T.null reason ]
+      prettyInfo $
+           flow "Would unregister locally:"
+        <> line
+        <> bulletedList (map unregisterMsg xs)
+        <> line
+
+  case Map.elems $ planTasks plan of
+    [] -> prettyInfo $
+               flow "Nothing to build."
+            <> line
+    xs -> do
+      prettyInfo $
+           flow "Would build:"
+        <> line
+        <> bulletedList (map displayTask xs)
+        <> line
+
+  let hasTests = not . Set.null . testComponents . taskComponents
+      hasBenches = not . Set.null . benchComponents . taskComponents
+      tests = Map.elems $ Map.filter hasTests $ planFinals plan
+      benches = Map.elems $ Map.filter hasBenches $ planFinals plan
+
+  unless (null tests) $ do
+    prettyInfo $
+         flow "Would test:"
+      <> line
+      <> bulletedList (map displayTask tests)
+      <> line
+
+  unless (null benches) $ do
+    prettyInfo $
+         flow "Would benchmark:"
+      <> line
+      <> bulletedList (map displayTask benches)
+      <> line
+
+  case Map.toList $ planInstallExes plan of
+    [] -> prettyInfo $
+               flow "No executables to be installed."
+            <> line
+    xs -> do
+      let executableMsg (name, loc) = fillSep $
+              fromString (T.unpack name)
+            : "from"
+            : ( case loc of
+                  Snap -> "snapshot" :: StyleDoc
+                  Local -> "local" :: StyleDoc
+              )
+            : ["database."]
+      prettyInfo $
+           flow "Would install executables:"
+        <> line
+        <> bulletedList (map executableMsg xs)
+        <> line
+
+-- | For a dry run
+displayTask :: Task -> StyleDoc
+displayTask task = fillSep $
+     [ fromString (packageIdentifierString (taskProvides task)) <> ":"
+     ,    "database="
+       <> ( case taskLocation task of
+              Snap -> "snapshot" :: StyleDoc
+              Local -> "local" :: StyleDoc
+          )
+       <> ","
+     ,    "source="
+       <> ( case taskType task of
+              TTLocalMutable lp -> pretty $ parent $ lpCabalFile lp
+              TTRemotePackage _ _ pl -> fromString $ T.unpack $ textDisplay pl
+          )
+       <> if Set.null missing
+            then mempty
+            else ","
+     ]
+  <> [ fillSep $
+           "after:"
+         : mkNarrativeList Nothing False
+             (map (fromString . packageIdentifierString) (Set.toList missing) :: [StyleDoc])
+     | not $ Set.null missing
+     ]
+ where
+  missing = tcoMissing $ taskConfigOpts task
+
+data ExecuteEnv = ExecuteEnv
+  { eeConfigureLock  :: !(MVar ())
+  , eeInstallLock    :: !(MVar ())
+  , eeBuildOpts      :: !BuildOpts
+  , eeBuildOptsCLI   :: !BuildOptsCLI
+  , eeBaseConfigOpts :: !BaseConfigOpts
+  , eeGhcPkgIds      :: !(TVar (Map PackageIdentifier Installed))
+  , eeTempDir        :: !(Path Abs Dir)
+  , eeSetupHs        :: !(Path Abs File)
+    -- ^ Temporary Setup.hs for simple builds
+  , eeSetupShimHs    :: !(Path Abs File)
+    -- ^ Temporary SetupShim.hs, to provide access to initial-build-steps
+  , eeSetupExe       :: !(Maybe (Path Abs File))
+    -- ^ Compiled version of eeSetupHs
+  , eeCabalPkgVer    :: !Version
+  , eeTotalWanted    :: !Int
+  , eeLocals         :: ![LocalPackage]
+  , eeGlobalDB       :: !(Path Abs Dir)
+  , eeGlobalDumpPkgs :: !(Map GhcPkgId DumpPackage)
+  , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId DumpPackage))
+  , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId DumpPackage))
+  , eeLogFiles       :: !(TChan (Path Abs Dir, Path Abs File))
+  , eeCustomBuilt    :: !(IORef (Set PackageName))
+    -- ^ Stores which packages with custom-setup have already had their
+    -- Setup.hs built.
+  , eeLargestPackageName :: !(Maybe Int)
+    -- ^ For nicer interleaved output: track the largest package name size
+  , eePathEnvVar :: !Text
+    -- ^ Value of the PATH environment variable
+  }
+
+buildSetupArgs :: [String]
+buildSetupArgs =
+  [ "-rtsopts"
+  , "-threaded"
+  , "-clear-package-db"
+  , "-global-package-db"
+  , "-hide-all-packages"
+  , "-package"
+  , "base"
+  , "-main-is"
+  , "StackSetupShim.mainOverride"
+  ]
+
+simpleSetupCode :: Builder
+simpleSetupCode = "import Distribution.Simple\nmain = defaultMain"
+
+simpleSetupHash :: String
+simpleSetupHash =
+    T.unpack
+  $ decodeUtf8
+  $ S.take 8
+  $ B64URL.encode
+  $ Mem.convert
+  $ hashWith SHA256
+  $ toStrictBytes
+  $ Data.ByteString.Builder.toLazyByteString
+  $  encodeUtf8Builder (T.pack (unwords buildSetupArgs))
+  <> setupGhciShimCode
+  <> simpleSetupCode
+
+-- | Get a compiled Setup exe
+getSetupExe :: HasEnvConfig env
+            => Path Abs File -- ^ Setup.hs input file
+            -> Path Abs File -- ^ SetupShim.hs input file
+            -> Path Abs Dir -- ^ temporary directory
+            -> RIO env (Maybe (Path Abs File))
+getSetupExe setupHs setupShimHs tmpdir = do
+  wc <- view $ actualCompilerVersionL.whichCompilerL
+  platformDir <- platformGhcRelDir
+  config <- view configL
+  cabalVersionString <- view $ cabalVersionL.to versionString
+  actualCompilerVersionString <-
+    view $ actualCompilerVersionL.to compilerVersionString
+  platform <- view platformL
+  let baseNameS = concat
+        [ "Cabal-simple_"
+        , simpleSetupHash
+        , "_"
+        , cabalVersionString
+        , "_"
+        , actualCompilerVersionString
+        ]
+      exeNameS = baseNameS ++
+        case platform of
+          Platform _ Windows -> ".exe"
+          _ -> ""
+      outputNameS =
+        case wc of
+            Ghc -> exeNameS
+      setupDir =
+        view stackRootL config </>
+        relDirSetupExeCache </>
+        platformDir
+
+  exePath <- (setupDir </>) <$> parseRelFile exeNameS
+
+  exists <- liftIO $ D.doesFileExist $ toFilePath exePath
+
+  if exists
+    then pure $ Just exePath
+    else do
+      tmpExePath <- fmap (setupDir </>) $ parseRelFile $ "tmp-" ++ exeNameS
+      tmpOutputPath <-
+        fmap (setupDir </>) $ parseRelFile $ "tmp-" ++ outputNameS
+      ensureDir setupDir
+      let args = buildSetupArgs ++
+            [ "-package"
+            , "Cabal-" ++ cabalVersionString
+            , toFilePath setupHs
+            , toFilePath setupShimHs
+            , "-o"
+            , toFilePath tmpOutputPath
+            ]
+      compilerPath <- getCompilerPath
+      withWorkingDir (toFilePath tmpdir) $
+        proc (toFilePath compilerPath) args (\pc0 -> do
+          let pc = setStdout (useHandleOpen stderr) pc0
+          runProcess_ pc)
+            `catch` \ece ->
+              prettyThrowM $ SetupHsBuildFailure
+                (eceExitCode ece) Nothing compilerPath args Nothing []
+      renameFile tmpExePath exePath
+      pure $ Just exePath
+
+-- | Execute a function that takes an 'ExecuteEnv'.
+withExecuteEnv ::
+     forall env a. HasEnvConfig env
+  => BuildOpts
+  -> BuildOptsCLI
+  -> BaseConfigOpts
+  -> [LocalPackage]
+  -> [DumpPackage] -- ^ global packages
+  -> [DumpPackage] -- ^ snapshot packages
+  -> [DumpPackage] -- ^ local packages
+  -> Maybe Int -- ^ largest package name, for nicer interleaved output
+  -> (ExecuteEnv -> RIO env a)
+  -> RIO env a
+withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages mlargestPackageName inner =
+  createTempDirFunction stackProgName $ \tmpdir -> do
+    configLock <- liftIO $ newMVar ()
+    installLock <- liftIO $ newMVar ()
+    idMap <- liftIO $ newTVarIO Map.empty
+    config <- view configL
+
+    customBuiltRef <- newIORef Set.empty
+
+    -- Create files for simple setup and setup shim, if necessary
+    let setupSrcDir =
+            view stackRootL config </>
+            relDirSetupExeSrc
+    ensureDir setupSrcDir
+    setupFileName <- parseRelFile ("setup-" ++ simpleSetupHash ++ ".hs")
+    let setupHs = setupSrcDir </> setupFileName
+    setupHsExists <- doesFileExist setupHs
+    unless setupHsExists $ writeBinaryFileAtomic setupHs simpleSetupCode
+    setupShimFileName <-
+      parseRelFile ("setup-shim-" ++ simpleSetupHash ++ ".hs")
+    let setupShimHs = setupSrcDir </> setupShimFileName
+    setupShimHsExists <- doesFileExist setupShimHs
+    unless setupShimHsExists $
+      writeBinaryFileAtomic setupShimHs setupGhciShimCode
+    setupExe <- getSetupExe setupHs setupShimHs tmpdir
+
+    cabalPkgVer <- view cabalVersionL
+    globalDB <- view $ compilerPathsL.to cpGlobalDB
+    snapshotPackagesTVar <-
+      liftIO $ newTVarIO (toDumpPackagesByGhcPkgId snapshotPackages)
+    localPackagesTVar <-
+      liftIO $ newTVarIO (toDumpPackagesByGhcPkgId localPackages)
+    logFilesTChan <- liftIO $ atomically newTChan
+    let totalWanted = length $ filter lpWanted locals
+    pathEnvVar <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH"
+    inner ExecuteEnv
+      { eeBuildOpts = bopts
+      , eeBuildOptsCLI = boptsCli
+        -- Uncertain as to why we cannot run configures in parallel. This
+        -- appears to be a Cabal library bug. Original issue:
+        -- https://github.com/commercialhaskell/stack/issues/84. Ideally
+        -- we'd be able to remove this.
+      , eeConfigureLock = configLock
+      , eeInstallLock = installLock
+      , eeBaseConfigOpts = baseConfigOpts
+      , eeGhcPkgIds = idMap
+      , eeTempDir = tmpdir
+      , eeSetupHs = setupHs
+      , eeSetupShimHs = setupShimHs
+      , eeSetupExe = setupExe
+      , eeCabalPkgVer = cabalPkgVer
+      , eeTotalWanted = totalWanted
+      , eeLocals = locals
+      , eeGlobalDB = globalDB
+      , eeGlobalDumpPkgs = toDumpPackagesByGhcPkgId globalPackages
+      , eeSnapshotDumpPkgs = snapshotPackagesTVar
+      , eeLocalDumpPkgs = localPackagesTVar
+      , eeLogFiles = logFilesTChan
+      , eeCustomBuilt = customBuiltRef
+      , eeLargestPackageName = mlargestPackageName
+      , eePathEnvVar = pathEnvVar
+      } `finally` dumpLogs logFilesTChan totalWanted
+ where
+  toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp))
+
+  createTempDirFunction
+    | boptsKeepTmpFiles bopts = withKeepSystemTempDir
+    | otherwise = withSystemTempDir
+
+  dumpLogs :: TChan (Path Abs Dir, Path Abs File) -> Int -> RIO env ()
+  dumpLogs chan totalWanted = do
+    allLogs <- fmap reverse $ liftIO $ atomically drainChan
+    case allLogs of
+      -- No log files generated, nothing to dump
+      [] -> pure ()
+      firstLog:_ -> do
+        toDump <- view $ configL.to configDumpLogs
+        case toDump of
+          DumpAllLogs -> mapM_ (dumpLog "") allLogs
+          DumpWarningLogs -> mapM_ dumpLogIfWarning allLogs
+          DumpNoLogs
+              | totalWanted > 1 ->
+                  prettyInfoL
+                    [ flow "Build output has been captured to log files, use"
+                    , style Shell "--dump-logs"
+                    , flow "to see it on the console."
+                    ]
+              | otherwise -> pure ()
+        prettyInfoL
+          [ flow "Log files have been written to:"
+          , pretty (parent (snd firstLog))
+          ]
+
+    -- We only strip the colors /after/ we've dumped logs, so that we get pretty
+    -- colors in our dump output on the terminal.
+    colors <- shouldForceGhcColorFlag
+    when colors $ liftIO $ mapM_ (stripColors . snd) allLogs
+   where
+    drainChan :: STM [(Path Abs Dir, Path Abs File)]
+    drainChan = do
+      mx <- tryReadTChan chan
+      case mx of
+        Nothing -> pure []
+        Just x -> do
+          xs <- drainChan
+          pure $ x:xs
+
+  dumpLogIfWarning :: (Path Abs Dir, Path Abs File) -> RIO env ()
+  dumpLogIfWarning (pkgDir, filepath) = do
+    firstWarning <- withSourceFile (toFilePath filepath) $ \src ->
+         runConduit
+       $ src
+      .| CT.decodeUtf8Lenient
+      .| CT.lines
+      .| CL.map stripCR
+      .| CL.filter isWarning
+      .| CL.take 1
+    unless (null firstWarning) $ dumpLog " due to warnings" (pkgDir, filepath)
+
+  isWarning :: Text -> Bool
+  isWarning t = ": Warning:" `T.isSuffixOf` t -- prior to GHC 8
+             || ": warning:" `T.isInfixOf` t -- GHC 8 is slightly different
+             || "mwarning:" `T.isInfixOf` t -- colorized output
+
+  dumpLog :: String -> (Path Abs Dir, Path Abs File) -> RIO env ()
+  dumpLog msgSuffix (pkgDir, filepath) = do
+    prettyNote $
+         fillSep
+           ( ( fillSep
+                 ( flow "Dumping log file"
+                 : [ flow msgSuffix | L.null msgSuffix ]
+                 )
+             <> ":"
+             )
+           : [ pretty filepath <> "." ]
+           )
+      <> line
+    compilerVer <- view actualCompilerVersionL
+    withSourceFile (toFilePath filepath) $ \src ->
+         runConduit
+       $ src
+      .| CT.decodeUtf8Lenient
+      .| mungeBuildOutput ExcludeTHLoading ConvertPathsToAbsolute pkgDir compilerVer
+      .| CL.mapM_ (logInfo . display)
+    prettyNote $
+         fillSep
+           [ flow "End of log file:"
+           , pretty filepath <> "."
+           ]
+      <> line
+
+  stripColors :: Path Abs File -> IO ()
+  stripColors fp = do
+    let colorfp = toFilePath fp ++ "-color"
+    withSourceFile (toFilePath fp) $ \src ->
+      withSinkFile colorfp $ \sink ->
+      runConduit $ src .| sink
+    withSourceFile colorfp $ \src ->
+      withSinkFile (toFilePath fp) $ \sink ->
+      runConduit $ src .| noColors .| sink
+
+   where
+    noColors = do
+      CB.takeWhile (/= 27) -- ESC
+      mnext <- CB.head
+      case mnext of
+        Nothing -> pure ()
+        Just x -> assert (x == 27) $ do
+          -- Color sequences always end with an m
+          CB.dropWhile (/= 109) -- m
+          CB.drop 1 -- drop the m itself
+          noColors
+
+-- | Perform the actual plan
+executePlan :: HasEnvConfig env
+            => BuildOptsCLI
+            -> BaseConfigOpts
+            -> [LocalPackage]
+            -> [DumpPackage] -- ^ global packages
+            -> [DumpPackage] -- ^ snapshot packages
+            -> [DumpPackage] -- ^ local packages
+            -> InstalledMap
+            -> Map PackageName Target
+            -> Plan
+            -> RIO env ()
+executePlan boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = do
+  logDebug "Executing the build plan"
+  bopts <- view buildOptsL
+  withExecuteEnv
+    bopts
+    boptsCli
+    baseConfigOpts
+    locals
+    globalPackages
+    snapshotPackages
+    localPackages
+    mlargestPackageName
+    (executePlan' installedMap targets plan)
+
+  copyExecutables (planInstallExes plan)
+
+  config <- view configL
+  menv' <- liftIO $ configProcessContextSettings config EnvSettings
+             { esIncludeLocals = True
+             , esIncludeGhcPackagePath = True
+             , esStackExe = True
+             , esLocaleUtf8 = False
+             , esKeepGhcRts = False
+             }
+  withProcessContext menv' $
+    forM_ (boptsCLIExec boptsCli) $ \(cmd, args) ->
+    proc cmd args runProcess_
+ where
+  mlargestPackageName =
+    Set.lookupMax $
+    Set.map (length . packageNameString) $
+    Map.keysSet (planTasks plan) <> Map.keysSet (planFinals plan)
+
+copyExecutables ::
+       HasEnvConfig env
+    => Map Text InstallLocation
+    -> RIO env ()
+copyExecutables exes | Map.null exes = pure ()
+copyExecutables exes = do
+  snapBin <- (</> bindirSuffix) <$> installationRootDeps
+  localBin <- (</> bindirSuffix) <$> installationRootLocal
+  compilerSpecific <- boptsInstallCompilerTool <$> view buildOptsL
+  destDir <- if compilerSpecific
+               then bindirCompilerTools
+               else view $ configL.to configLocalBin
+  ensureDir destDir
+
+  destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir
+
+  platform <- view platformL
+  let ext =
+        case platform of
+          Platform _ Windows -> ".exe"
+          _ -> ""
+
+  currExe <- liftIO getExecutablePath -- needed for windows, see below
+
+  installed <- forMaybeM (Map.toList exes) $ \(name, loc) -> do
+    let bindir =
+            case loc of
+                Snap -> snapBin
+                Local -> localBin
+    mfp <- forgivingResolveFile bindir (T.unpack name ++ ext)
+      >>= rejectMissingFile
+    case mfp of
+      Nothing -> do
+        prettyWarnL
+          [ flow "Couldn't find executable"
+          , style Current (fromString $ T.unpack name)
+          , flow "in directory"
+          , pretty bindir <> "."
+          ]
+        pure Nothing
+      Just file -> do
+        let destFile = destDir' FP.</> T.unpack name ++ ext
+        prettyInfoL
+          [ flow "Copying from"
+          , pretty file
+          , "to"
+          , style File (fromString destFile) <> "."
+          ]
+
+        liftIO $ case platform of
+          Platform _ Windows | FP.equalFilePath destFile currExe ->
+              windowsRenameCopy (toFilePath file) destFile
+          _ -> D.copyFile (toFilePath file) destFile
+        pure $ Just (name <> T.pack ext)
+
+  unless (null installed) $ do
+    prettyInfo $
+         fillSep
+           [ flow "Copied executables to"
+           , pretty destDir <> ":"
+           ]
+      <> line
+      <> bulletedList
+           (map (fromString . T.unpack . textDisplay) installed :: [StyleDoc])
+  unless compilerSpecific $ warnInstallSearchPathIssues destDir' installed
+
+
+-- | Windows can't write over the current executable. Instead, we rename the
+-- current executable to something else and then do the copy.
+windowsRenameCopy :: FilePath -> FilePath -> IO ()
+windowsRenameCopy src dest = do
+  D.copyFile src new
+  D.renameFile dest old
+  D.renameFile new dest
+ where
+  new = dest ++ ".new"
+  old = dest ++ ".old"
+
+-- | Perform the actual plan (internal)
+executePlan' :: HasEnvConfig env
+             => InstalledMap
+             -> Map PackageName Target
+             -> Plan
+             -> ExecuteEnv
+             -> RIO env ()
+executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do
+  when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports
+  cv <- view actualCompilerVersionL
+  case nonEmpty . Map.toList $ planUnregisterLocal plan of
+    Nothing -> pure ()
+    Just ids -> do
+      localDB <- packageDatabaseLocal
+      unregisterPackages cv localDB ids
+
+  liftIO $ atomically $ modifyTVar' eeLocalDumpPkgs $ \initMap ->
+    foldl' (flip Map.delete) initMap $ Map.keys (planUnregisterLocal plan)
+
+  run <- askRunInIO
+
+  -- If running tests concurrently with each other, then create an MVar
+  -- which is empty while each test is being run.
+  concurrentTests <- view $ configL.to configConcurrentTests
+  mtestLock <- if concurrentTests
+                 then pure Nothing
+                 else Just <$> liftIO (newMVar ())
+
+  let actions = concatMap (toActions installedMap' mtestLock run ee) $
+        Map.elems $ Map.merge
+          (Map.mapMissing (\_ b -> (Just b, Nothing)))
+          (Map.mapMissing (\_ f -> (Nothing, Just f)))
+          (Map.zipWithMatched (\_ b f -> (Just b, Just f)))
+          (planTasks plan)
+          (planFinals plan)
+  threads <- view $ configL.to configJobs
+  let keepGoing =
+        fromMaybe (not (Map.null (planFinals plan))) (boptsKeepGoing eeBuildOpts)
+  terminal <- view terminalL
+  errs <- liftIO $ runActions threads keepGoing actions $
+    \doneVar actionsVar -> do
+      let total = length actions
+          loop prev
+            | prev == total =
+                run $ logStickyDone
+                  ( "Completed " <> display total <> " action(s).")
+            | otherwise = do
+                inProgress <- readTVarIO actionsVar
+                let packageNames = map
+                      (\(ActionId pkgID _) -> pkgName pkgID)
+                      (toList inProgress)
+                    nowBuilding :: [PackageName] -> Utf8Builder
+                    nowBuilding []    = ""
+                    nowBuilding names = mconcat $
+                        ": "
+                      : L.intersperse ", "
+                          (map (fromString . packageNameString) names)
+                when terminal $ run $
+                  logSticky $
+                    "Progress " <> display prev <> "/" <> display total <>
+                        nowBuilding packageNames
+                done <- atomically $ do
+                  done <- readTVar doneVar
+                  check $ done /= prev
+                  pure done
+                loop done
+      when (total > 1) $ loop 0
+  when (toCoverage $ boptsTestOpts eeBuildOpts) $ do
+    generateHpcUnifiedReport
+    generateHpcMarkupIndex
+  unless (null errs) $
+    prettyThrowM $ ExecutionFailure errs
+  when (boptsHaddock eeBuildOpts) $ do
+    snapshotDumpPkgs <- liftIO (readTVarIO eeSnapshotDumpPkgs)
+    localDumpPkgs <- liftIO (readTVarIO eeLocalDumpPkgs)
+    generateLocalHaddockIndex eeBaseConfigOpts localDumpPkgs eeLocals
+    generateDepsHaddockIndex
+      eeBaseConfigOpts
+      eeGlobalDumpPkgs
+      snapshotDumpPkgs
+      localDumpPkgs
+      eeLocals
+    generateSnapHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs
+    when (boptsOpenHaddocks eeBuildOpts) $ do
+      let planPkgs, localPkgs, installedPkgs, availablePkgs
+            :: Map PackageName (PackageIdentifier, InstallLocation)
+          planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan)
+          localPkgs =
+            Map.fromList
+              [ (packageName p, (packageIdentifier p, Local))
+              | p <- map lpPackage eeLocals
+              ]
+          installedPkgs =
+            Map.map (swap . second installedPackageIdentifier) installedMap'
+          availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs]
+      openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets)
+ where
+  installedMap' = Map.difference installedMap0
+                $ Map.fromList
+                $ map (\(ident, _) -> (pkgName ident, ()))
+                $ Map.elems
+                $ planUnregisterLocal plan
+
+unregisterPackages ::
+     (HasCompiler env, HasPlatform env, HasProcessContext env, HasTerm env)
+  => ActualCompiler
+  -> Path Abs Dir
+  -> NonEmpty (GhcPkgId, (PackageIdentifier, Text))
+  -> RIO env ()
+unregisterPackages cv localDB ids = do
+  let logReason ident reason =
+        prettyInfoL
+          (  [ fromString (packageIdentifierString ident) <> ":"
+             , "unregistering"
+             ]
+          <> [ parens (flow $ T.unpack reason) | not $ T.null reason ]
+          )
+  let unregisterSinglePkg select (gid, (ident, reason)) = do
+        logReason ident reason
+        pkg <- getGhcPkgExe
+        unregisterGhcPkgIds pkg localDB $ select ident gid :| []
+  case cv of
+    -- GHC versions >= 8.2.1 support batch unregistering of packages. See
+    -- https://gitlab.haskell.org/ghc/ghc/issues/12637
+    ACGhc v | v >= mkVersion [8, 2, 1] -> do
+      platform <- view platformL
+      -- According to
+      -- https://support.microsoft.com/en-us/help/830473/command-prompt-cmd-exe-command-line-string-limitation
+      -- the maximum command line length on Windows since XP is 8191 characters.
+      -- We use conservative batch size of 100 ids on this OS thus argument name
+      -- '-ipid', package name, its version and a hash should fit well into this
+      -- limit. On Unix-like systems we're limited by ARG_MAX which is normally
+      -- hundreds of kilobytes so batch size of 500 should work fine.
+      let batchSize = case platform of
+            Platform _ Windows -> 100
+            _ -> 500
+      let chunksOfNE size = mapMaybe nonEmpty . chunksOf size . NonEmpty.toList
+      for_ (chunksOfNE batchSize ids) $ \batch -> do
+        for_ batch $ \(_, (ident, reason)) -> logReason ident reason
+        pkg <- getGhcPkgExe
+        unregisterGhcPkgIds pkg localDB $ fmap (Right . fst) batch
+
+    -- GHC versions >= 7.9 support unregistering of packages via their GhcPkgId.
+    ACGhc v | v >= mkVersion [7, 9] ->
+      for_ ids . unregisterSinglePkg $ \_ident gid -> Right gid
+
+    _ -> for_ ids . unregisterSinglePkg $ \ident _gid -> Left ident
+
+toActions :: HasEnvConfig env
+          => InstalledMap
+          -> Maybe (MVar ())
+          -> (RIO env () -> IO ())
+          -> ExecuteEnv
+          -> (Maybe Task, Maybe Task) -- build and final
+          -> [Action]
+toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
+  abuild ++ afinal
+ where
+  abuild = case mbuild of
+    Nothing -> []
+    Just task@Task {..} ->
+      [ Action
+          { actionId = ActionId taskProvides ATBuild
+          , actionDeps =
+              Set.map (`ActionId` ATBuild) (tcoMissing taskConfigOpts)
+          , actionDo =
+              \ac -> runInBase $ singleBuild ac ee task installedMap False
+          , actionConcurrency = ConcurrencyAllowed
+          }
+      ]
+  afinal = case mfinal of
+    Nothing -> []
+    Just task@Task {..} ->
+      (if taskAllInOne then id else (:)
+          Action
+              { actionId = ActionId taskProvides ATBuildFinal
+              , actionDeps = addBuild
+                  (Set.map (`ActionId` ATBuild) (tcoMissing taskConfigOpts))
+              , actionDo =
+                  \ac -> runInBase $ singleBuild ac ee task installedMap True
+              , actionConcurrency = ConcurrencyAllowed
+              }) $
+      -- These are the "final" actions - running tests and benchmarks.
+      (if Set.null tests then id else (:)
+          Action
+              { actionId = ActionId taskProvides ATRunTests
+              , actionDeps = finalDeps
+              , actionDo = \ac -> withLock mtestLock $ runInBase $
+                  singleTest topts (Set.toList tests) ac ee task installedMap
+              -- Always allow tests tasks to run concurrently with
+              -- other tasks, particularly build tasks. Note that
+              -- 'mtestLock' can optionally make it so that only
+              -- one test is run at a time.
+              , actionConcurrency = ConcurrencyAllowed
+              }) $
+      (if Set.null benches then id else (:)
+          Action
+              { actionId = ActionId taskProvides ATRunBenchmarks
+              , actionDeps = finalDeps
+              , actionDo = \ac -> runInBase $
+                  singleBench
+                    beopts
+                    (Set.toList benches)
+                    ac
+                    ee
+                    task
+                    installedMap
+                -- Never run benchmarks concurrently with any other task, see
+                -- #3663
+              , actionConcurrency = ConcurrencyDisallowed
+              })
+      []
+     where
+      comps = taskComponents task
+      tests = testComponents comps
+      benches = benchComponents comps
+      finalDeps =
+        if taskAllInOne
+          then addBuild mempty
+          else Set.singleton (ActionId taskProvides ATBuildFinal)
+      addBuild =
+        case mbuild of
+          Nothing -> id
+          Just _ -> Set.insert $ ActionId taskProvides ATBuild
+  withLock Nothing f = f
+  withLock (Just lock) f = withMVar lock $ \() -> f
+  bopts = eeBuildOpts ee
+  topts = boptsTestOpts bopts
+  beopts = boptsBenchmarkOpts bopts
+
+-- | Generate the ConfigCache
+getConfigCache ::
+     HasEnvConfig env
+  => ExecuteEnv
+  -> Task
+  -> InstalledMap
+  -> Bool
+  -> Bool
+  -> RIO env (Map PackageIdentifier GhcPkgId, ConfigCache)
+getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBench = do
+  let extra =
+        -- We enable tests if the test suite dependencies are already
+        -- installed, so that we avoid unnecessary recompilation based on
+        -- cabal_macros.h changes when switching between 'stack build' and
+        -- 'stack test'. See:
+        -- https://github.com/commercialhaskell/stack/issues/805
+        case taskType of
+          TTLocalMutable _ ->
+            -- FIXME: make this work with exact-configuration.
+            -- Not sure how to plumb the info atm. See
+            -- https://github.com/commercialhaskell/stack/issues/2049
+            [ "--enable-tests" | enableTest] ++
+            [ "--enable-benchmarks" | enableBench]
+          TTRemotePackage{} -> []
+  idMap <- liftIO $ readTVarIO eeGhcPkgIds
+  let getMissing ident =
+        case Map.lookup ident idMap of
+          Nothing
+              -- Expect to instead find it in installedMap if it's
+              -- an initialBuildSteps target.
+              | boptsCLIInitialBuildSteps eeBuildOptsCLI && taskIsTarget task,
+                Just (_, installed) <- Map.lookup (pkgName ident) installedMap
+                  -> installedToGhcPkgId ident installed
+          Just installed -> installedToGhcPkgId ident installed
+          _ -> throwM $ PackageIdMissingBug ident
+      installedToGhcPkgId ident (Library ident' x _) =
+        assert (ident == ident') $ Just (ident, x)
+      installedToGhcPkgId _ (Executable _) = Nothing
+      missing' = Map.fromList $ mapMaybe getMissing $ Set.toList missing
+      TaskConfigOpts missing mkOpts = taskConfigOpts
+      opts = mkOpts missing'
+      allDeps = Set.fromList $ Map.elems missing' ++ Map.elems taskPresent
+      cache = ConfigCache
+        { configCacheOpts = opts
+            { coNoDirs = coNoDirs opts ++ map T.unpack extra
+            }
+        , configCacheDeps = allDeps
+        , configCacheComponents =
+            case taskType of
+              TTLocalMutable lp ->
+                Set.map (encodeUtf8 . renderComponent) $ lpComponents lp
+              TTRemotePackage{} -> Set.empty
+        , configCacheHaddock = taskBuildHaddock
+        , configCachePkgSrc = taskCachePkgSrc
+        , configCachePathEnvVar = eePathEnvVar
+        }
+      allDepsMap = Map.union missing' taskPresent
+  pure (allDepsMap, cache)
+
+-- | Ensure that the configuration for the package matches what is given
+ensureConfig :: HasEnvConfig env
+             => ConfigCache -- ^ newConfigCache
+             -> Path Abs Dir -- ^ package directory
+             -> ExecuteEnv
+             -> RIO env () -- ^ announce
+             -> (ExcludeTHLoading -> [String] -> RIO env ()) -- ^ cabal
+             -> Path Abs File -- ^ Cabal file
+             -> Task
+             -> RIO env Bool
+ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp task = do
+  newCabalMod <-
+    liftIO $ modificationTime <$> getFileStatus (toFilePath cabalfp)
+  setupConfigfp <- setupConfigFromDir pkgDir
+  let getNewSetupConfigMod =
+        liftIO $ either (const Nothing) (Just . modificationTime) <$>
+        tryJust
+          (guard . isDoesNotExistError)
+          (getFileStatus (toFilePath setupConfigfp))
+  newSetupConfigMod <- getNewSetupConfigMod
+  newProjectRoot <- S8.pack . toFilePath <$> view projectRootL
+  -- See https://github.com/commercialhaskell/stack/issues/3554
+  taskAnyMissingHack <-
+    view $ actualCompilerVersionL.to getGhcVersion.to (< mkVersion [8, 4])
+  needConfig <-
+    if   boptsReconfigure eeBuildOpts
+      || (taskAnyMissing task && taskAnyMissingHack)
+      then pure True
+      else do
+        -- We can ignore the components portion of the config
+        -- cache, because it's just used to inform 'construct
+        -- plan that we need to plan to build additional
+        -- components. These components don't affect the actual
+        -- package configuration.
+        let ignoreComponents cc = cc { configCacheComponents = Set.empty }
+        -- Determine the old and new configuration in the local directory, to
+        -- determine if we need to reconfigure.
+        mOldConfigCache <- tryGetConfigCache pkgDir
+
+        mOldCabalMod <- tryGetCabalMod pkgDir
+
+        -- Cabal's setup-config is created per OS/Cabal version, multiple
+        -- projects using the same package could get a conflict because of this
+        mOldSetupConfigMod <- tryGetSetupConfigMod pkgDir
+        mOldProjectRoot <- tryGetPackageProjectRoot pkgDir
+
+        pure $
+                fmap ignoreComponents mOldConfigCache
+             /= Just (ignoreComponents newConfigCache)
+          || mOldCabalMod /= Just newCabalMod
+          || mOldSetupConfigMod /= newSetupConfigMod
+          || mOldProjectRoot /= Just newProjectRoot
+  let ConfigureOpts dirs nodirs = configCacheOpts newConfigCache
+
+  when (taskBuildTypeConfig task) ensureConfigureScript
+
+  when needConfig $ withMVar eeConfigureLock $ \_ -> do
+    deleteCaches pkgDir
+    announce
+    cp <- view compilerPathsL
+    let (GhcPkgExe pkgPath) = cpPkg cp
+    let programNames =
+          case cpWhich cp of
+            Ghc ->
+              [ ("ghc", toFilePath (cpCompiler cp))
+              , ("ghc-pkg", toFilePath pkgPath)
+              ]
+    exes <- forM programNames $ \(name, file) -> do
+      mpath <- findExecutable file
+      pure $ case mpath of
+          Left _ -> []
+          Right x -> pure $ concat ["--with-", name, "=", x]
+    -- Configure cabal with arguments determined by
+    -- Stack.Types.Build.configureOpts
+    cabal KeepTHLoading $ "configure" : concat
+      [ concat exes
+      , dirs
+      , nodirs
+      ]
+    -- Only write the cache for local packages.  Remote packages are built in a
+    -- temporary directory so the cache would never be used anyway.
+    case taskType task of
+      TTLocalMutable{} -> writeConfigCache pkgDir newConfigCache
+      TTRemotePackage{} -> pure ()
+    writeCabalMod pkgDir newCabalMod
+    -- This file gets updated one more time by the configure step, so get the
+    -- most recent value. We could instead change our logic above to check if
+    -- our config mod file is newer than the file above, but this seems
+    -- reasonable too.
+    getNewSetupConfigMod >>= writeSetupConfigMod pkgDir
+    writePackageProjectRoot pkgDir newProjectRoot
+
+  pure needConfig
+ where
+  -- When build-type is Configure, we need to have a configure script in the
+  -- local directory. If it doesn't exist, build it with autoreconf -i. See:
+  -- https://github.com/commercialhaskell/stack/issues/3534
+  ensureConfigureScript = do
+    let fp = pkgDir </> relFileConfigure
+    exists <- doesFileExist fp
+    unless exists $ do
+      prettyInfoL
+        [ flow "Trying to generate configure with autoreconf in"
+        , pretty pkgDir <> "."
+        ]
+      let autoreconf = if osIsWindows
+                         then readProcessNull "sh" ["autoreconf", "-i"]
+                         else readProcessNull "autoreconf" ["-i"]
+          -- On Windows 10, an upstream issue with the `sh autoreconf -i`
+          -- command means that command clears, but does not then restore, the
+          -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. The
+          -- following hack re-enables the lost ANSI-capability.
+          fixupOnWindows = when osIsWindows (void $ liftIO defaultColorWhen)
+      withWorkingDir (toFilePath pkgDir) $ autoreconf `catchAny` \ex -> do
+        fixupOnWindows
+        prettyWarn $
+             fillSep
+               [ flow "Stack failed to run"
+               , style Shell "autoreconf" <> "."
+               ]
+          <> blankLine
+          <> flow "Stack encountered the following error:"
+          <> blankLine
+          <> string (displayException ex)
+        when osIsWindows $ do
+          prettyInfo $
+               fillSep
+                 [ flow "Check that executable"
+                 , style File "perl"
+                 , flow "is on the path in Stack's MSYS2"
+                 , style Dir "\\usr\\bin"
+                 , flow "folder, and working, and that script file"
+                 , style File "autoreconf"
+                 , flow "is on the path in that location. To check that"
+                 , style File "perl"
+                 , "or"
+                 , style File "autoreconf"
+                 , flow "are on the path in the required location, run commands:"
+                 ]
+            <> blankLine
+            <> indent 4 (style Shell $ flow "stack exec where -- perl")
+            <> line
+            <> indent 4 (style Shell $ flow "stack exec where -- autoreconf")
+            <> blankLine
+            <> fillSep
+                 [ "If"
+                 , style File "perl"
+                 , "or"
+                 , style File "autoreconf"
+                 , flow "is not on the path in the required location, add them \
+                        \with command (note that the relevant package name is"
+                 , style File "autoconf"
+                 , "not"
+                 , style File "autoreconf" <> "):"
+                 ]
+            <> blankLine
+            <> indent 4
+                 (style Shell $ flow "stack exec pacman -- --sync --refresh autoconf")
+            <> blankLine
+            <> fillSep
+                 [ flow "Some versions of"
+                 , style File "perl"
+                 , flow "from MSYS2 are broken. See"
+                 , style Url "https://github.com/msys2/MSYS2-packages/issues/1611"
+                 , "and"
+                 , style Url "https://github.com/commercialhaskell/stack/pull/4781" <> "."
+                 , "To test if"
+                 , style File "perl"
+                 , flow "in the required location is working, try command:"
+                 ]
+            <> blankLine
+            <> indent 4 (style Shell $ flow "stack exec perl -- --version")
+            <> blankLine
+      fixupOnWindows
+
+-- | Make a padded prefix for log messages
+packageNamePrefix :: ExecuteEnv -> PackageName -> String
+packageNamePrefix ee name' =
+  let name = packageNameString name'
+      paddedName =
+        case eeLargestPackageName ee of
+          Nothing -> name
+          Just len ->
+            assert (len >= length name) $ take len $ name ++ L.repeat ' '
+  in  paddedName <> "> "
+
+announceTask ::
+     HasLogFunc env
+  => ExecuteEnv
+  -> Task
+  -> Utf8Builder
+  -> RIO env ()
+announceTask ee task action = logInfo $
+  fromString (packageNamePrefix ee (pkgName (taskProvides task))) <> action
+
+prettyAnnounceTask ::
+     HasTerm env
+  => ExecuteEnv
+  -> Task
+  -> StyleDoc
+  -> RIO env ()
+prettyAnnounceTask ee task action = prettyInfo $
+  fromString (packageNamePrefix ee (pkgName (taskProvides task))) <> action
+
+-- | Ensure we're the only action using the directory.  See
+-- <https://github.com/commercialhaskell/stack/issues/2730>
+withLockedDistDir ::
+     forall env a. HasEnvConfig env
+  => (StyleDoc -> RIO env ()) -- ^ A pretty announce function
+  -> Path Abs Dir -- ^ root directory for package
+  -> RIO env a
+  -> RIO env a
+withLockedDistDir announce root inner = do
+  distDir <- distRelativeDir
+  let lockFP = root </> distDir </> relFileBuildLock
+  ensureDir $ parent lockFP
+
+  mres <-
+    withRunInIO $ \run ->
+    withTryFileLock (toFilePath lockFP) Exclusive $ \_lock ->
+    run inner
+
+  case mres of
+    Just res -> pure res
+    Nothing -> do
+      let complainer :: Companion (RIO env)
+          complainer delay = do
+            delay 5000000 -- 5 seconds
+            announce $ fillSep
+              [ flow "blocking for directory lock on"
+              , pretty lockFP
+              ]
+            forever $ do
+              delay 30000000 -- 30 seconds
+              announce $ fillSep
+                [ flow "still blocking for directory lock on"
+                , pretty lockFP <> ";"
+                , flow "maybe another Stack process is running?"
+                ]
+      withCompanion complainer $
+        \stopComplaining ->
+          withRunInIO $ \run ->
+            withFileLock (toFilePath lockFP) Exclusive $ \_ ->
+              run $ stopComplaining *> inner
+
+-- | How we deal with output from GHC, either dumping to a log file or the
+-- console (with some prefix).
+data OutputType
+  = OTLogFile !(Path Abs File) !Handle
+  | OTConsole !(Maybe Utf8Builder)
+
+-- | This sets up a context for executing build steps which need to run
+-- Cabal (via a compiled Setup.hs).  In particular it does the following:
+--
+-- * Ensures the package exists in the file system, downloading if necessary.
+--
+-- * Opens a log file if the built output shouldn't go to stderr.
+--
+-- * Ensures that either a simple Setup.hs is built, or the package's
+--   custom setup is built.
+--
+-- * Provides the user a function with which run the Cabal process.
+withSingleContext ::
+     forall env a. HasEnvConfig env
+  => ActionContext
+  -> ExecuteEnv
+  -> Task
+  -> Map PackageIdentifier GhcPkgId
+     -- ^ All dependencies' package ids to provide to Setup.hs.
+  -> Maybe String
+  -> (  Package        -- Package info
+     -> Path Abs File  -- Cabal file path
+     -> Path Abs Dir   -- Package root directory file path
+        -- Note that the `Path Abs Dir` argument is redundant with the
+        -- `Path Abs File` argument, but we provide both to avoid recalculating
+        -- `parent` of the `File`.
+     -> (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
+        -- Function to run Cabal with args
+     -> (Utf8Builder -> RIO env ())
+        -- An plain 'announce' function, for different build phases
+     -> OutputType
+     -> RIO env a)
+  -> RIO env a
+withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} allDeps msuffix inner0 =
+  withPackage $ \package cabalfp pkgDir ->
+  withOutputType pkgDir package $ \outputType ->
+  withCabal package pkgDir outputType $ \cabal ->
+  inner0 package cabalfp pkgDir cabal announce outputType
+ where
+  announce = announceTask ee task
+  prettyAnnounce = prettyAnnounceTask ee task
+
+  wanted =
+    case taskType of
+      TTLocalMutable lp -> lpWanted lp
+      TTRemotePackage{} -> False
+
+  -- Output to the console if this is the last task, and the user asked to build
+  -- it specifically. When the action is a 'ConcurrencyDisallowed' action
+  -- (benchmarks), then we can also be sure to have exclusive access to the
+  -- console, so output is also sent to the console in this case.
+  --
+  -- See the discussion on #426 for thoughts on sending output to the console
+  --from concurrent tasks.
+  console =
+       (  wanted
+       && all
+            (\(ActionId ident _) -> ident == taskProvides)
+            (Set.toList acRemaining)
+       && eeTotalWanted == 1
+       )
+    || acConcurrency == ConcurrencyDisallowed
+
+  withPackage inner =
+    case taskType of
+      TTLocalMutable lp -> do
+        let root = parent $ lpCabalFile lp
+        withLockedDistDir prettyAnnounce root $
+          inner (lpPackage lp) (lpCabalFile lp) root
+      TTRemotePackage _ package pkgloc -> do
+          suffix <- parseRelDir $ packageIdentifierString $ packageIdent package
+          let dir = eeTempDir </> suffix
+          unpackPackageLocation dir pkgloc
+
+          -- See: https://github.com/commercialhaskell/stack/issues/157
+          distDir <- distRelativeDir
+          let oldDist = dir </> relDirDist
+              newDist = dir </> distDir
+          exists <- doesDirExist oldDist
+          when exists $ do
+            -- Previously used takeDirectory, but that got confused
+            -- by trailing slashes, see:
+            -- https://github.com/commercialhaskell/stack/issues/216
+            --
+            -- Instead, use Path which is a bit more resilient
+            ensureDir $ parent newDist
+            renameDir oldDist newDist
+
+          let name = pkgName taskProvides
+          cabalfpRel <- parseRelFile $ packageNameString name ++ ".cabal"
+          let cabalfp = dir </> cabalfpRel
+          inner package cabalfp dir
+
+  withOutputType pkgDir package inner
+    -- Not in interleaved mode. When building a single wanted package, dump
+    -- to the console with no prefix.
+    | console = inner $ OTConsole Nothing
+
+    -- If the user requested interleaved output, dump to the console with a
+    -- prefix.
+    | boptsInterleavedOutput eeBuildOpts = inner $
+        OTConsole $ Just $ fromString (packageNamePrefix ee $ packageName package)
+
+    -- Neither condition applies, dump to a file.
+    | otherwise = do
+        logPath <- buildLogPath package msuffix
+        ensureDir (parent logPath)
+        let fp = toFilePath logPath
+
+        -- We only want to dump logs for local non-dependency packages
+        case taskType of
+          TTLocalMutable lp | lpWanted lp ->
+              liftIO $ atomically $ writeTChan eeLogFiles (pkgDir, logPath)
+          _ -> pure ()
+
+        withBinaryFile fp WriteMode $ \h -> inner $ OTLogFile logPath h
+
+  withCabal ::
+       Package
+    -> Path Abs Dir
+    -> OutputType
+    -> (  (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
+       -> RIO env a
+       )
+    -> RIO env a
+  withCabal package pkgDir outputType inner = do
+    config <- view configL
+    unless (configAllowDifferentUser config) $
+      checkOwnership (pkgDir </> configWorkDir config)
+    let envSettings = EnvSettings
+          { esIncludeLocals = taskLocation task == Local
+          , esIncludeGhcPackagePath = False
+          , esStackExe = False
+          , esLocaleUtf8 = True
+          , esKeepGhcRts = False
+          }
+    menv <- liftIO $ configProcessContextSettings config envSettings
+    distRelativeDir' <- distRelativeDir
+    esetupexehs <-
+      -- Avoid broken Setup.hs files causing problems for simple build
+      -- types, see:
+      -- https://github.com/commercialhaskell/stack/issues/370
+      case (packageBuildType package, eeSetupExe) of
+        (C.Simple, Just setupExe) -> pure $ Left setupExe
+        _ -> liftIO $ Right <$> getSetupHs pkgDir
+    inner $ \keepOutputOpen stripTHLoading args -> do
+      let cabalPackageArg
+            -- Omit cabal package dependency when building
+            -- Cabal. See
+            -- https://github.com/commercialhaskell/stack/issues/1356
+            | packageName package == mkPackageName "Cabal" = []
+            | otherwise =
+                ["-package=" ++ packageIdentifierString
+                                    (PackageIdentifier cabalPackageName
+                                                      eeCabalPkgVer)]
+          packageDBArgs =
+            ( "-clear-package-db"
+            : "-global-package-db"
+            : map
+                (("-package-db=" ++) . toFilePathNoTrailingSep)
+                (bcoExtraDBs eeBaseConfigOpts)
+            ) ++
+            ( (  "-package-db="
+              ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)
+              )
+            : (  "-package-db="
+              ++ toFilePathNoTrailingSep (bcoLocalDB eeBaseConfigOpts)
+              )
+            : ["-hide-all-packages"]
+            )
+
+          warnCustomNoDeps :: RIO env ()
+          warnCustomNoDeps =
+            case (taskType, packageBuildType package) of
+              (TTLocalMutable lp, C.Custom) | lpWanted lp ->
+                prettyWarnL
+                  [ flow "Package"
+                  , fromString $ packageNameString $ packageName package
+                  , flow "uses a custom Cabal build, but does not use a \
+                         \custom-setup stanza"
+                  ]
+              _ -> pure ()
+
+          getPackageArgs :: Path Abs Dir -> RIO env [String]
+          getPackageArgs setupDir =
+            case packageSetupDeps package of
+              -- The package is using the Cabal custom-setup
+              -- configuration introduced in Cabal 1.24. In
+              -- this case, the package is providing an
+              -- explicit list of dependencies, and we
+              -- should simply use all of them.
+              Just customSetupDeps -> do
+                unless (Map.member (mkPackageName "Cabal") customSetupDeps) $
+                  prettyWarnL
+                    [ fromString $ packageNameString $ packageName package
+                    , flow "has a setup-depends field, but it does not mention \
+                           \a Cabal dependency. This is likely to cause build \
+                           \errors."
+                    ]
+                matchedDeps <-
+                  forM (Map.toList customSetupDeps) $ \(name, range) -> do
+                    let matches (PackageIdentifier name' version) =
+                          name == name' &&
+                          version `withinRange` range
+                    case filter (matches . fst) (Map.toList allDeps) of
+                      x:xs -> do
+                        unless (null xs) $
+                          prettyWarnL
+                            [ flow "Found multiple installed packages for \
+                                   \custom-setup dep:"
+                            , style Current (fromString $ packageNameString name) <> "."
+                            ]
+                        pure ("-package-id=" ++ ghcPkgIdString (snd x), Just (fst x))
+                      [] -> do
+                        prettyWarnL
+                          [ flow "Could not find custom-setup dep:"
+                          , style Current (fromString $ packageNameString name) <> "."
+                          ]
+                        pure ("-package=" ++ packageNameString name, Nothing)
+                let depsArgs = map fst matchedDeps
+                -- Generate setup_macros.h and provide it to ghc
+                let macroDeps = mapMaybe snd matchedDeps
+                    cppMacrosFile = setupDir </> relFileSetupMacrosH
+                    cppArgs =
+                      ["-optP-include", "-optP" ++ toFilePath cppMacrosFile]
+                writeBinaryFileAtomic
+                  cppMacrosFile
+                  ( encodeUtf8Builder
+                      ( T.pack
+                          ( C.generatePackageVersionMacros
+                              (packageVersion package)
+                              macroDeps
+                          )
+                      )
+                  )
+                pure (packageDBArgs ++ depsArgs ++ cppArgs)
+
+              -- This branch is usually taken for builds, and is always taken
+              -- for `stack sdist`.
+              --
+              -- This approach is debatable. It adds access to the snapshot
+              -- package database for Cabal. There are two possible objections:
+              --
+              -- 1. This doesn't isolate the build enough; arbitrary other
+              -- packages available could cause the build to succeed or fail.
+              --
+              -- 2. This doesn't provide enough packages: we should also
+              -- include the local database when building local packages.
+              --
+              -- Currently, this branch is only taken via `stack sdist` or when
+              -- explicitly requested in the stack.yaml file.
+              Nothing -> do
+                warnCustomNoDeps
+                pure $
+                     cabalPackageArg
+                      -- NOTE: This is different from packageDBArgs above in
+                      -- that it does not include the local database and does
+                      -- not pass in the -hide-all-packages argument
+                  ++ ( "-clear-package-db"
+                     : "-global-package-db"
+                     : map
+                         (("-package-db=" ++) . toFilePathNoTrailingSep)
+                         (bcoExtraDBs eeBaseConfigOpts)
+                     ++ [    "-package-db="
+                          ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)
+                        ]
+                     )
+
+          setupArgs =
+            ("--builddir=" ++ toFilePathNoTrailingSep distRelativeDir') : args
+
+          runExe :: Path Abs File -> [String] -> RIO env ()
+          runExe exeName fullArgs = do
+            compilerVer <- view actualCompilerVersionL
+            runAndOutput compilerVer `catch` \ece -> do
+              (mlogFile, bss) <-
+                case outputType of
+                  OTConsole _ -> pure (Nothing, [])
+                  OTLogFile logFile h ->
+                    if keepOutputOpen == KeepOpen
+                    then
+                      pure (Nothing, []) -- expected failure build continues further
+                    else do
+                      liftIO $ hClose h
+                      fmap (Just logFile,) $ withSourceFile (toFilePath logFile) $
+                        \src ->
+                             runConduit
+                           $ src
+                          .| CT.decodeUtf8Lenient
+                          .| mungeBuildOutput
+                               stripTHLoading makeAbsolute pkgDir compilerVer
+                          .| CL.consume
+              prettyThrowM $ CabalExitedUnsuccessfully
+                (eceExitCode ece) taskProvides exeName fullArgs mlogFile bss
+           where
+            runAndOutput :: ActualCompiler -> RIO env ()
+            runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $
+              withProcessContext menv $ case outputType of
+                OTLogFile _ h -> do
+                  let prefixWithTimestamps =
+                        if configPrefixTimestamps config
+                          then PrefixWithTimestamps
+                          else WithoutTimestamps
+                  void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs
+                    (sinkWithTimestamps prefixWithTimestamps h)
+                    (sinkWithTimestamps prefixWithTimestamps h)
+                OTConsole mprefix ->
+                  let prefix = fold mprefix
+                  in  void $ sinkProcessStderrStdout
+                        (toFilePath exeName)
+                        fullArgs
+                        (outputSink KeepTHLoading LevelWarn compilerVer prefix)
+                        (outputSink stripTHLoading LevelInfo compilerVer prefix)
+            outputSink ::
+                 HasCallStack
+              => ExcludeTHLoading
+              -> LogLevel
+              -> ActualCompiler
+              -> Utf8Builder
+              -> ConduitM S.ByteString Void (RIO env) ()
+            outputSink excludeTH level compilerVer prefix =
+              CT.decodeUtf8Lenient
+              .| mungeBuildOutput excludeTH makeAbsolute pkgDir compilerVer
+              .| CL.mapM_ (logGeneric "" level . (prefix <>) . display)
+            -- If users want control, we should add a config option for this
+            makeAbsolute :: ConvertPathsToAbsolute
+            makeAbsolute = case stripTHLoading of
+              ExcludeTHLoading -> ConvertPathsToAbsolute
+              KeepTHLoading    -> KeepPathsAsIs
+
+      exeName <- case esetupexehs of
+        Left setupExe -> pure setupExe
+        Right setuphs -> do
+          distDir <- distDirFromDir pkgDir
+          let setupDir = distDir </> relDirSetup
+              outputFile = setupDir </> relFileSetupLower
+          customBuilt <- liftIO $ readIORef eeCustomBuilt
+          if Set.member (packageName package) customBuilt
+            then pure outputFile
+            else do
+              ensureDir setupDir
+              compilerPath <- view $ compilerPathsL.to cpCompiler
+              packageArgs <- getPackageArgs setupDir
+              runExe compilerPath $
+                [ "--make"
+                , "-odir", toFilePathNoTrailingSep setupDir
+                , "-hidir", toFilePathNoTrailingSep setupDir
+                , "-i", "-i."
+                ] ++ packageArgs ++
+                [ toFilePath setuphs
+                , toFilePath eeSetupShimHs
+                , "-main-is"
+                , "StackSetupShim.mainOverride"
+                , "-o", toFilePath outputFile
+                , "-threaded"
+                ] ++
+
+                -- Apply GHC options
+                -- https://github.com/commercialhaskell/stack/issues/4526
+                map
+                  T.unpack
+                  ( Map.findWithDefault
+                      []
+                      AGOEverything
+                      (configGhcOptionsByCat config)
+                  ++ case configApplyGhcOptions config of
+                       AGOEverything -> boptsCLIGhcOptions eeBuildOptsCLI
+                       AGOTargets -> []
+                       AGOLocals -> []
+                  )
+
+              liftIO $ atomicModifyIORef' eeCustomBuilt $
+                \oldCustomBuilt ->
+                  (Set.insert (packageName package) oldCustomBuilt, ())
+              pure outputFile
+      let cabalVerboseArg =
+            let CabalVerbosity cv = boptsCabalVerbose eeBuildOpts
+            in  "--verbose=" <> showForCabal cv
+      runExe exeName $ cabalVerboseArg:setupArgs
+
+-- Implements running a package's build, used to implement 'ATBuild' and
+-- 'ATBuildFinal' tasks.  In particular this does the following:
+--
+-- * Checks if the package exists in the precompiled cache, and if so,
+--   add it to the database instead of performing the build.
+--
+-- * Runs the configure step if needed ('ensureConfig')
+--
+-- * Runs the build step
+--
+-- * Generates haddocks
+--
+-- * Registers the library and copies the built executables into the
+--   local install directory. Note that this is literally invoking Cabal
+--   with @copy@, and not the copying done by @stack install@ - that is
+--   handled by 'copyExecutables'.
+singleBuild :: forall env. (HasEnvConfig env, HasRunner env)
+            => ActionContext
+            -> ExecuteEnv
+            -> Task
+            -> InstalledMap
+            -> Bool             -- ^ Is this a final build?
+            -> RIO env ()
+singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap isFinalBuild = do
+  (allDepsMap, cache) <-
+    getConfigCache ee task installedMap enableTests enableBenchmarks
+  mprecompiled <- getPrecompiled cache
+  minstalled <-
+    case mprecompiled of
+      Just precompiled -> copyPreCompiled precompiled
+      Nothing -> do
+        mcurator <- view $ buildConfigL.to bcCurator
+        realConfigAndBuild cache mcurator allDepsMap
+  case minstalled of
+    Nothing -> pure ()
+    Just installed -> do
+      writeFlagCache installed cache
+      liftIO $ atomically $
+        modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed
+ where
+  PackageIdentifier pname pversion = taskProvides
+  doHaddock mcurator package =
+       taskBuildHaddock
+    && not isFinalBuild
+       -- Works around haddock failing on bytestring-builder since it has no
+       -- modules when bytestring is new enough.
+    && packageHasExposedModules package
+       -- Special help for the curator tool to avoid haddocks that are known
+       -- to fail
+    && maybe True (Set.notMember pname . curatorSkipHaddock) mcurator
+  expectHaddockFailure =
+      maybe False (Set.member pname . curatorExpectHaddockFailure)
+  fulfillHaddockExpectations mcurator action
+    | expectHaddockFailure mcurator = do
+        eres <- tryAny $ action KeepOpen
+        case eres of
+          Right () -> prettyWarnL
+            [ style Current (fromString $ packageNameString pname) <> ":"
+            , flow "unexpected Haddock success."
+            ]
+          Left _ -> pure ()
+  fulfillHaddockExpectations _ action = action CloseOnException
+
+  buildingFinals = isFinalBuild || taskAllInOne
+  enableTests = buildingFinals && any isCTest (taskComponents task)
+  enableBenchmarks = buildingFinals && any isCBench (taskComponents task)
+
+  annSuffix executableBuildStatuses =
+    if result == "" then "" else " (" <> result <> ")"
+   where
+    result = T.intercalate " + " $ concat
+      [ ["lib" | taskAllInOne && hasLib]
+      , ["internal-lib" | taskAllInOne && hasSubLib]
+      , ["exe" | taskAllInOne && hasExe]
+      , ["test" | enableTests]
+      , ["bench" | enableBenchmarks]
+      ]
+    (hasLib, hasSubLib, hasExe) = case taskType of
+      TTLocalMutable lp ->
+        let package = lpPackage lp
+            hasLibrary =
+              case packageLibraries package of
+                NoLibraries -> False
+                HasLibraries _ -> True
+            hasSubLibrary = not . Set.null $ packageInternalLibraries package
+            hasExecutables =
+              not . Set.null $ exesToBuild executableBuildStatuses lp
+        in  (hasLibrary, hasSubLibrary, hasExecutables)
+      -- This isn't true, but we don't want to have this info for upstream deps.
+      _ -> (False, False, False)
+
+  getPrecompiled cache =
+    case taskType of
+      TTRemotePackage Immutable _ loc -> do
+        mpc <- readPrecompiledCache
+                 loc
+                 (configCacheOpts cache)
+                 (configCacheHaddock cache)
+                 (configCacheDeps cache)
+        case mpc of
+          Nothing -> pure Nothing
+          -- Only pay attention to precompiled caches that refer to packages
+          -- within the snapshot.
+          Just pc
+            | maybe False
+                (bcoSnapInstallRoot eeBaseConfigOpts `isProperPrefixOf`)
+                (pcLibrary pc) -> pure Nothing
+          -- If old precompiled cache files are left around but snapshots are
+          -- deleted, it is possible for the precompiled file to refer to the
+          -- very library we're building, and if flags are changed it may try to
+          -- copy the library to itself. This check prevents that from
+          -- happening.
+          Just pc -> do
+            let allM _ [] = pure True
+                allM f (x:xs) = do
+                  b <- f x
+                  if b then allM f xs else pure False
+            b <- liftIO $
+                   allM doesFileExist $ maybe id (:) (pcLibrary pc) $ pcExes pc
+            pure $ if b then Just pc else Nothing
+      _ -> pure Nothing
+
+  copyPreCompiled (PrecompiledCache mlib sublibs exes) = do
+    wc <- view $ actualCompilerVersionL.whichCompilerL
+    announceTask ee task "using precompiled package"
+
+    -- We need to copy .conf files for the main library and all sublibraries
+    -- which exist in the cache, from their old snapshot to the new one.
+    -- However, we must unregister any such library in the new snapshot, in case
+    -- it was built with different flags.
+    let
+      subLibNames = Set.toList $ case taskType of
+        TTLocalMutable lp -> packageInternalLibraries $ lpPackage lp
+        TTRemotePackage _ p _ -> packageInternalLibraries p
+      toMungedPackageId :: Text -> MungedPackageId
+      toMungedPackageId sublib =
+        let sublibName = LSubLibName $ mkUnqualComponentName $ T.unpack sublib
+        in  MungedPackageId (MungedPackageName pname sublibName) pversion
+      allToUnregister = mcons
+        (prettyShow taskProvides <$ mlib)
+        (map (prettyShow . toMungedPackageId) subLibNames)
+      allToRegister = mcons mlib sublibs
+
+    unless (null allToRegister) $
+      withMVar eeInstallLock $ \() -> do
+        -- We want to ignore the global and user databases.
+        -- Unfortunately, ghc-pkg doesn't take such arguments on the
+        -- command line. Instead, we'll set GHC_PACKAGE_PATH. See:
+        -- https://github.com/commercialhaskell/stack/issues/1146
+
+        let modifyEnv = Map.insert
+              (ghcPkgPathEnvVar wc)
+              (T.pack $ toFilePathNoTrailingSep $ bcoSnapDB eeBaseConfigOpts)
+
+        withModifyEnvVars modifyEnv $ do
+          GhcPkgExe ghcPkgExe <- getGhcPkgExe
+
+          -- first unregister everything that needs to be unregistered
+          forM_ allToUnregister $ \packageName -> catchAny
+            ( readProcessNull
+                (toFilePath ghcPkgExe)
+                [ "unregister", "--force", packageName]
+            )
+            (const (pure ()))
+
+          -- now, register the cached conf files
+          forM_ allToRegister $ \libpath ->
+            proc
+              (toFilePath ghcPkgExe)
+              [ "register", "--force", toFilePath libpath]
+              readProcess_
+
+    liftIO $ forM_ exes $ \exe -> do
+      ensureDir bindir
+      let dst = bindir </> filename exe
+      createLink (toFilePath exe) (toFilePath dst) `catchIO` \_ -> copyFile exe dst
+    case (mlib, exes) of
+      (Nothing, _:_) -> markExeInstalled (taskLocation task) taskProvides
+      _ -> pure ()
+
+    -- Find the package in the database
+    let pkgDbs = [bcoSnapDB eeBaseConfigOpts]
+
+    case mlib of
+      Nothing -> pure $ Just $ Executable taskProvides
+      Just _ -> do
+        mpkgid <- loadInstalledPkg pkgDbs eeSnapshotDumpPkgs pname
+
+        pure $ Just $
+          case mpkgid of
+            Nothing -> assert False $ Executable taskProvides
+            Just pkgid -> Library taskProvides pkgid Nothing
+   where
+    bindir = bcoSnapInstallRoot eeBaseConfigOpts </> bindirSuffix
+
+  realConfigAndBuild cache mcurator allDepsMap =
+    withSingleContext ac ee task allDepsMap Nothing $
+      \package cabalfp pkgDir cabal0 announce _outputType -> do
+        let cabal = cabal0 CloseOnException
+        executableBuildStatuses <- getExecutableBuildStatuses package pkgDir
+        when (  not (cabalIsSatisfied executableBuildStatuses)
+             && taskIsTarget task
+             ) $
+          prettyInfoL
+            [ flow "Building all executables for"
+            , style Current (fromString $ packageNameString $ packageName package)
+            , flow "once. After a successful build of all of them, only \
+                   \specified executables will be rebuilt."
+            ]
+        _neededConfig <-
+          ensureConfig
+            cache
+            pkgDir
+            ee
+            ( announce
+                (  "configure"
+                <> display (annSuffix executableBuildStatuses)
+                )
+            )
+            cabal
+            cabalfp
+            task
+        let installedMapHasThisPkg :: Bool
+            installedMapHasThisPkg =
+              case Map.lookup (packageName package) installedMap of
+                Just (_, Library ident _ _) -> ident == taskProvides
+                Just (_, Executable _) -> True
+                _ -> False
+
+        case ( boptsCLIOnlyConfigure eeBuildOptsCLI
+             , boptsCLIInitialBuildSteps eeBuildOptsCLI && taskIsTarget task) of
+          -- A full build is done if there are downstream actions,
+          -- because their configure step will require that this
+          -- package is built. See
+          -- https://github.com/commercialhaskell/stack/issues/2787
+          (True, _) | null acDownstream -> pure Nothing
+          (_, True) | null acDownstream || installedMapHasThisPkg -> do
+            initialBuildSteps executableBuildStatuses cabal announce
+            pure Nothing
+          _ -> fulfillCuratorBuildExpectations
+                 pname
+                 mcurator
+                 enableTests
+                 enableBenchmarks
+                 Nothing
+                 (Just <$>
+                    realBuild cache package pkgDir cabal0 announce executableBuildStatuses)
+
+  initialBuildSteps executableBuildStatuses cabal announce = do
+    announce
+      (  "initial-build-steps"
+      <> display (annSuffix executableBuildStatuses)
+      )
+    cabal KeepTHLoading ["repl", "stack-initial-build-steps"]
+
+  realBuild ::
+       ConfigCache
+    -> Package
+    -> Path Abs Dir
+    -> (KeepOutputOpen -> ExcludeTHLoading -> [String] -> RIO env ())
+    -> (Utf8Builder -> RIO env ())
+       -- ^ A plain 'announce' function
+    -> Map Text ExecutableBuildStatus
+    -> RIO env Installed
+  realBuild cache package pkgDir cabal0 announce executableBuildStatuses = do
+    let cabal = cabal0 CloseOnException
+    wc <- view $ actualCompilerVersionL.whichCompilerL
+
+    markExeNotInstalled (taskLocation task) taskProvides
+    case taskType of
+      TTLocalMutable lp -> do
+        when enableTests $ setTestStatus pkgDir TSUnknown
+        caches <- runMemoizedWith $ lpNewBuildCaches lp
+        mapM_
+          (uncurry (writeBuildCache pkgDir))
+          (Map.toList caches)
+      TTRemotePackage{} -> pure ()
+
+    -- FIXME: only output these if they're in the build plan.
+
+    let postBuildCheck _succeeded = do
+          mlocalWarnings <- case taskType of
+            TTLocalMutable lp -> do
+                warnings <- checkForUnlistedFiles taskType pkgDir
+                -- TODO: Perhaps only emit these warnings for non extra-dep?
+                pure (Just (lpCabalFile lp, warnings))
+            _ -> pure Nothing
+          -- NOTE: once
+          -- https://github.com/commercialhaskell/stack/issues/2649
+          -- is resolved, we will want to partition the warnings
+          -- based on variety, and output in different lists.
+          let showModuleWarning (UnlistedModulesWarning comp modules) =
+                "- In" <+>
+                fromString (T.unpack (renderComponent comp)) <>
+                ":" <> line <>
+                indent 4 ( mconcat
+                         $ L.intersperse line
+                         $ map
+                             (style Good . fromString . C.display)
+                             modules
+                         )
+          forM_ mlocalWarnings $ \(cabalfp, warnings) ->
+            unless (null warnings) $ prettyWarn $
+                 flow "The following modules should be added to \
+                      \exposed-modules or other-modules in" <+>
+                      pretty cabalfp
+              <> ":"
+              <> line
+              <> indent 4 ( mconcat
+                          $ L.intersperse line
+                          $ map showModuleWarning warnings
+                          )
+              <> blankLine
+              <> flow "Missing modules in the Cabal file are likely to cause \
+                      \undefined reference errors from the linker, along with \
+                      \other problems."
+
+    () <- announce
+      (  "build"
+      <> display (annSuffix executableBuildStatuses)
+      )
+    config <- view configL
+    extraOpts <- extraBuildOptions wc eeBuildOpts
+    let stripTHLoading
+          | configHideTHLoading config = ExcludeTHLoading
+          | otherwise                  = KeepTHLoading
+    cabal stripTHLoading (("build" :) $ (++ extraOpts) $
+        case (taskType, taskAllInOne, isFinalBuild) of
+            (_, True, True) -> throwM AllInOneBuildBug
+            (TTLocalMutable lp, False, False) ->
+              primaryComponentOptions executableBuildStatuses lp
+            (TTLocalMutable lp, False, True) -> finalComponentOptions lp
+            (TTLocalMutable lp, True, False) ->
+                 primaryComponentOptions executableBuildStatuses lp
+              ++ finalComponentOptions lp
+            (TTRemotePackage{}, _, _) -> [])
+      `catch` \ex -> case ex of
+        CabalExitedUnsuccessfully{} ->
+          postBuildCheck False >> prettyThrowM ex
+        _ -> throwM ex
+    postBuildCheck True
+
+    mcurator <- view $ buildConfigL.to bcCurator
+    when (doHaddock mcurator package) $ do
+      announce "haddock"
+      sourceFlag <- if not (boptsHaddockHyperlinkSource eeBuildOpts)
+        then pure []
+        else do
+          -- See #2429 for why the temp dir is used
+          ec
+            <- withWorkingDir (toFilePath eeTempDir)
+             $ proc "haddock" ["--hyperlinked-source"]
+             $ \pc -> withProcessWait
+               (setStdout createSource $ setStderr createSource pc) $ \p ->
+                 runConcurrently
+                   $ Concurrently (runConduit $ getStdout p .| CL.sinkNull)
+                  *> Concurrently (runConduit $ getStderr p .| CL.sinkNull)
+                  *> Concurrently (waitExitCode p)
+          case ec of
+            -- Fancy crosslinked source
+            ExitSuccess -> pure ["--haddock-option=--hyperlinked-source"]
+            -- Older hscolour colouring
+            ExitFailure _ -> do
+              hscolourExists <- doesExecutableExist "HsColour"
+              unless hscolourExists $
+                prettyWarnL
+                  [ flow "Warning: Haddock is not generating hyperlinked \
+                         \sources because 'HsColour' not found on PATH (use"
+                  , style Shell (flow "stack install hscolour")
+                  , flow "to install)."
+                  ]
+              pure ["--hyperlink-source" | hscolourExists]
+
+      -- For GHC 8.4 and later, provide the --quickjump option.
+      actualCompiler <- view actualCompilerVersionL
+      let quickjump =
+            case actualCompiler of
+              ACGhc ghcVer
+                | ghcVer >= mkVersion [8, 4] -> ["--haddock-option=--quickjump"]
+              _ -> []
+
+      fulfillHaddockExpectations mcurator $ \keep ->
+        cabal0 keep KeepTHLoading $ concat
+          [ [ "haddock"
+            , "--html"
+            , "--hoogle"
+            , "--html-location=../$pkg-$version/"
+            ]
+          , sourceFlag
+          , ["--internal" | boptsHaddockInternal eeBuildOpts]
+          , [ "--haddock-option=" <> opt
+            | opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ]
+          , quickjump
+          ]
+
+    let hasLibrary =
+          case packageLibraries package of
+            NoLibraries -> False
+            HasLibraries _ -> True
+        packageHasComponentSet f = not $ Set.null $ f package
+        hasInternalLibrary = packageHasComponentSet packageInternalLibraries
+        hasExecutables = packageHasComponentSet packageExes
+        shouldCopy =
+             not isFinalBuild
+          && (hasLibrary || hasInternalLibrary || hasExecutables)
+    when shouldCopy $ withMVar eeInstallLock $ \() -> do
+      announce "copy/register"
+      eres <- try $ cabal KeepTHLoading ["copy"]
+      case eres of
+        Left err@CabalExitedUnsuccessfully{} ->
+          throwM $ CabalCopyFailed
+                     (packageBuildType package == C.Simple)
+                     (displayException err)
+        _ -> pure ()
+      when hasLibrary $ cabal KeepTHLoading ["register"]
+
+    -- copy ddump-* files
+    case T.unpack <$> boptsDdumpDir eeBuildOpts of
+      Just ddumpPath | buildingFinals && not (null ddumpPath) -> do
+        distDir <- distRelativeDir
+        ddumpDir <- parseRelDir ddumpPath
+
+        logDebug $ fromString ("ddump-dir: " <> toFilePath ddumpDir)
+        logDebug $ fromString ("dist-dir: " <> toFilePath distDir)
+
+        runConduitRes
+          $ CF.sourceDirectoryDeep False (toFilePath distDir)
+         .| CL.filter (L.isInfixOf ".dump-")
+         .| CL.mapM_ (\src -> liftIO $ do
+              parentDir <- parent <$> parseRelDir src
+              destBaseDir <-
+                (ddumpDir </>) <$> stripProperPrefix distDir parentDir
+              -- exclude .stack-work dir
+              unless (".stack-work" `L.isInfixOf` toFilePath destBaseDir) $ do
+                ensureDir destBaseDir
+                src' <- parseRelFile src
+                copyFile src' (destBaseDir </> filename src'))
+      _ -> pure ()
+
+    let (installedPkgDb, installedDumpPkgsTVar) =
+          case taskLocation task of
+            Snap ->
+              ( bcoSnapDB eeBaseConfigOpts
+              , eeSnapshotDumpPkgs )
+            Local ->
+              ( bcoLocalDB eeBaseConfigOpts
+              , eeLocalDumpPkgs )
+    let ident = PackageIdentifier (packageName package) (packageVersion package)
+    -- only pure the sublibs to cache them if we also cache the main lib (that
+    -- is, if it exists)
+    (mpkgid, sublibsPkgIds) <- case packageLibraries package of
+      HasLibraries _ -> do
+        sublibsPkgIds <- fmap catMaybes $
+          forM (Set.toList $ packageInternalLibraries package) $ \sublib -> do
+            let sublibName = MungedPackageName
+                  (packageName package)
+                  (LSubLibName $ mkUnqualComponentName $ T.unpack sublib)
+            loadInstalledPkg
+              [installedPkgDb]
+              installedDumpPkgsTVar
+              (encodeCompatPackageName sublibName)
+
+        mpkgid <- loadInstalledPkg
+                    [installedPkgDb]
+                    installedDumpPkgsTVar
+                    (packageName package)
+        case mpkgid of
+          Nothing -> throwM $ Couldn'tFindPkgId $ packageName package
+          Just pkgid -> pure (Library ident pkgid Nothing, sublibsPkgIds)
+      NoLibraries -> do
+        markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow
+                                                          -- with writeFlagCache?
+        pure (Executable ident, []) -- don't pure sublibs in this case
+
+    case taskType of
+      TTRemotePackage Immutable _ loc ->
+        writePrecompiledCache
+          eeBaseConfigOpts
+          loc
+          (configCacheOpts cache)
+          (configCacheHaddock cache)
+          (configCacheDeps cache)
+          mpkgid sublibsPkgIds (packageExes package)
+      _ -> pure ()
+
+    case taskType of
+      -- For packages from a package index, pkgDir is in the tmp directory. We
+      -- eagerly delete it if no other tasks require it, to reduce space usage
+      -- in tmp (#3018).
+      TTRemotePackage{} -> do
+        let remaining =
+              filter
+                (\(ActionId x _) -> x == taskProvides)
+                (Set.toList acRemaining)
+        when (null remaining) $ removeDirRecur pkgDir
+      TTLocalMutable{} -> pure ()
+
+    pure mpkgid
+
+  loadInstalledPkg ::
+       [Path Abs Dir]
+    -> TVar (Map GhcPkgId DumpPackage)
+    -> PackageName
+    -> RIO env (Maybe GhcPkgId)
+  loadInstalledPkg pkgDbs tvar name = do
+    pkgexe <- getGhcPkgExe
+    dps <- ghcPkgDescribe pkgexe name pkgDbs $ conduitDumpPackage .| CL.consume
+    case dps of
+      [] -> pure Nothing
+      [dp] -> do
+        liftIO $ atomically $ modifyTVar' tvar (Map.insert (dpGhcPkgId dp) dp)
+        pure $ Just (dpGhcPkgId dp)
+      _ -> throwM $ MultipleResultsBug name dps
+
+-- | Get the build status of all the package executables. Do so by
+-- testing whether their expected output file exists, e.g.
+--
+-- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha
+-- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha.exe
+-- .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/alpha/alpha.jsexe/ (NOTE: a dir)
+getExecutableBuildStatuses ::
+     HasEnvConfig env
+  => Package
+  -> Path Abs Dir
+  -> RIO env (Map Text ExecutableBuildStatus)
+getExecutableBuildStatuses package pkgDir = do
+  distDir <- distDirFromDir pkgDir
+  platform <- view platformL
+  fmap
+    Map.fromList
+    (mapM (checkExeStatus platform distDir) (Set.toList (packageExes package)))
+
+-- | Check whether the given executable is defined in the given dist directory.
+checkExeStatus ::
+     HasLogFunc env
+  => Platform
+  -> Path b Dir
+  -> Text
+  -> RIO env (Text, ExecutableBuildStatus)
+checkExeStatus platform distDir name = do
+  exename <- parseRelDir (T.unpack name)
+  exists <- checkPath (distDir </> relDirBuild </> exename)
+  pure
+    ( name
+    , if exists
+        then ExecutableBuilt
+        else ExecutableNotBuilt)
+ where
+  checkPath base =
+    case platform of
+      Platform _ Windows -> do
+        fileandext <- parseRelFile (file ++ ".exe")
+        doesFileExist (base </> fileandext)
+      _ -> do
+        fileandext <- parseRelFile file
+        doesFileExist (base </> fileandext)
+   where
+    file = T.unpack name
+
+-- | Check if any unlisted files have been found, and add them to the build cache.
+checkForUnlistedFiles ::
+     HasEnvConfig env
+  => TaskType
+  -> Path Abs Dir
+  -> RIO env [PackageWarning]
+checkForUnlistedFiles (TTLocalMutable lp) pkgDir = do
+  caches <- runMemoizedWith $ lpNewBuildCaches lp
+  (addBuildCache,warnings) <-
+    addUnlistedToBuildCache
+      (lpPackage lp)
+      (lpCabalFile lp)
+      (lpComponents lp)
+      caches
+  forM_ (Map.toList addBuildCache) $ \(component, newToCache) -> do
+    let cache = Map.findWithDefault Map.empty component caches
+    writeBuildCache pkgDir component $
+      Map.unions (cache : newToCache)
+  pure warnings
+checkForUnlistedFiles TTRemotePackage{} _ = pure []
+
+-- | Implements running a package's tests. Also handles producing
+-- coverage reports if coverage is enabled.
+singleTest :: HasEnvConfig env
+           => TestOpts
+           -> [Text]
+           -> ActionContext
+           -> ExecuteEnv
+           -> Task
+           -> InstalledMap
+           -> RIO env ()
+singleTest topts testsToRun ac ee task installedMap = do
+  -- FIXME: Since this doesn't use cabal, we should be able to avoid using a
+  -- full blown 'withSingleContext'.
+  (allDepsMap, _cache) <- getConfigCache ee task installedMap True False
+  mcurator <- view $ buildConfigL.to bcCurator
+  let pname = pkgName $ taskProvides task
+      expectFailure = expectTestFailure pname mcurator
+  withSingleContext ac ee task allDepsMap (Just "test") $
+    \package _cabalfp pkgDir _cabal announce outputType -> do
+      config <- view configL
+      let needHpc = toCoverage topts
+
+      toRun <-
+        if toDisableRun topts
+          then do
+            announce "Test running disabled by --no-run-tests flag."
+            pure False
+          else if toRerunTests topts
+            then pure True
+            else do
+              status <- getTestStatus pkgDir
+              case status of
+                TSSuccess -> do
+                  unless (null testsToRun) $
+                    announce "skipping already passed test"
+                  pure False
+                TSFailure
+                  | expectFailure -> do
+                      announce "skipping already failed test that's expected to fail"
+                      pure False
+                  | otherwise -> do
+                      announce "rerunning previously failed test"
+                      pure True
+                TSUnknown -> pure True
+
+      when toRun $ do
+        buildDir <- distDirFromDir pkgDir
+        hpcDir <- hpcDirFromDir pkgDir
+        when needHpc (ensureDir hpcDir)
+
+        let suitesToRun
+              = [ testSuitePair
+                | testSuitePair <- Map.toList $ packageTests package
+                , let testName = fst testSuitePair
+                , testName `elem` testsToRun
+                ]
+
+        errs <- fmap Map.unions $ forM suitesToRun $ \(testName, suiteInterface) -> do
+          let stestName = T.unpack testName
+          (testName', isTestTypeLib) <-
+            case suiteInterface of
+              C.TestSuiteLibV09{} -> pure (stestName ++ "Stub", True)
+              C.TestSuiteExeV10{} -> pure (stestName, False)
+              interface -> throwM (TestSuiteTypeUnsupported interface)
+
+          let exeName = testName' ++
+                case configPlatform config of
+                  Platform _ Windows -> ".exe"
+                  _ -> ""
+          tixPath <- fmap (pkgDir </>) $ parseRelFile $ exeName ++ ".tix"
+          exePath <-
+            fmap (buildDir </>) $ parseRelFile $
+              "build/" ++ testName' ++ "/" ++ exeName
+          exists <- doesFileExist exePath
+          -- in Stack.Package.packageFromPackageDescription we filter out
+          -- package itself of any dependencies so any tests requiring loading
+          -- of their own package library will fail so to prevent this we return
+          -- it back here but unfortunately unconditionally
+          installed <- case Map.lookup pname installedMap of
+            Just (_, installed) -> pure $ Just installed
+            Nothing -> do
+              idMap <- liftIO $ readTVarIO (eeGhcPkgIds ee)
+              pure $ Map.lookup (taskProvides task) idMap
+          let pkgGhcIdList = case installed of
+                               Just (Library _ ghcPkgId _) -> [ghcPkgId]
+                               _ -> []
+          -- doctest relies on template-haskell in QuickCheck-based tests
+          thGhcId <-
+            case L.find ((== "template-haskell") . pkgName . dpPackageIdent. snd)
+                   (Map.toList $ eeGlobalDumpPkgs ee) of
+              Just (ghcId, _) -> pure ghcId
+              Nothing -> throwIO TemplateHaskellNotFoundBug
+          -- env variable GHC_ENVIRONMENT is set for doctest so module names for
+          -- packages with proper dependencies should no longer get ambiguous
+          -- see e.g. https://github.com/doctest/issues/119
+          -- also we set HASKELL_DIST_DIR to a package dist directory so
+          -- doctest will be able to load modules autogenerated by Cabal
+          let setEnv f pc = modifyEnvVars pc $ \envVars ->
+                Map.insert "HASKELL_DIST_DIR" (T.pack $ toFilePath buildDir) $
+                Map.insert "GHC_ENVIRONMENT" (T.pack f) envVars
+              fp' = eeTempDir ee </> testGhcEnvRelFile
+          -- Add a random suffix to avoid conflicts between parallel jobs
+          -- See https://github.com/commercialhaskell/stack/issues/5024
+          randomInt <- liftIO (randomIO :: IO Int)
+          let randomSuffix = "." <> show (abs randomInt)
+          fp <- toFilePath <$> addExtension randomSuffix fp'
+          let snapDBPath =
+                toFilePathNoTrailingSep (bcoSnapDB $ eeBaseConfigOpts ee)
+              localDBPath =
+                toFilePathNoTrailingSep (bcoLocalDB $ eeBaseConfigOpts ee)
+              ghcEnv =
+                   "clear-package-db\n"
+                <> "global-package-db\n"
+                <> "package-db "
+                <> fromString snapDBPath
+                <> "\n"
+                <> "package-db "
+                <> fromString localDBPath
+                <> "\n"
+                <> foldMap
+                     ( \ghcId ->
+                            "package-id "
+                         <> display (unGhcPkgId ghcId)
+                         <> "\n"
+                     )
+                     (pkgGhcIdList ++ thGhcId:Map.elems allDepsMap)
+          writeFileUtf8Builder fp ghcEnv
+          menv <- liftIO $
+            setEnv fp =<< configProcessContextSettings config EnvSettings
+              { esIncludeLocals = taskLocation task == Local
+              , esIncludeGhcPackagePath = True
+              , esStackExe = True
+              , esLocaleUtf8 = False
+              , esKeepGhcRts = False
+              }
+          let emptyResult = Map.singleton testName Nothing
+          withProcessContext menv $ if exists
+            then do
+                -- We clear out the .tix files before doing a run.
+                when needHpc $ do
+                  tixexists <- doesFileExist tixPath
+                  when tixexists $
+                    prettyWarnL
+                      [ flow "Removing HPC file"
+                      , pretty tixPath <> "."
+                      ]
+                  liftIO $ ignoringAbsence (removeFile tixPath)
+
+                let args = toAdditionalArgs topts
+                    argsDisplay = case args of
+                      [] -> ""
+                      _ ->    ", args: "
+                           <> T.intercalate " " (map showProcessArgDebug args)
+                announce $
+                     "test (suite: "
+                  <> display testName
+                  <> display argsDisplay
+                  <> ")"
+
+                -- Clear "Progress: ..." message before
+                -- redirecting output.
+                case outputType of
+                  OTConsole _ -> do
+                    logStickyDone ""
+                    liftIO $ hFlush stdout
+                    liftIO $ hFlush stderr
+                  OTLogFile _ _ -> pure ()
+
+                let output = case outputType of
+                      OTConsole Nothing -> Nothing <$ inherit
+                      OTConsole (Just prefix) -> fmap
+                        ( \src -> Just $
+                               runConduit $ src
+                            .| CT.decodeUtf8Lenient
+                            .| CT.lines
+                            .| CL.map stripCR
+                            .| CL.mapM_ (\t -> logInfo $ prefix <> display t)
+                        )
+                        createSource
+                      OTLogFile _ h -> Nothing <$ useHandleOpen h
+                    optionalTimeout action
+                      | Just maxSecs <- toMaximumTimeSeconds topts, maxSecs > 0 =
+                          timeout (maxSecs * 1000000) action
+                      | otherwise = Just <$> action
+
+                mec <- withWorkingDir (toFilePath pkgDir) $
+                  optionalTimeout $ proc (toFilePath exePath) args $ \pc0 -> do
+                    changeStdin <-
+                      if isTestTypeLib
+                        then do
+                          logPath <- buildLogPath package (Just stestName)
+                          ensureDir (parent logPath)
+                          pure $
+                              setStdin
+                            $ byteStringInput
+                            $ BL.fromStrict
+                            $ encodeUtf8 $ fromString $
+                            show ( logPath
+                                 , mkUnqualComponentName (T.unpack testName)
+                                 )
+                        else do
+                          isTerminal <- view $ globalOptsL.to globalTerminal
+                          if toAllowStdin topts && isTerminal
+                            then pure id
+                            else pure $ setStdin $ byteStringInput mempty
+                    let pc = changeStdin
+                           $ setStdout output
+                           $ setStderr output
+                             pc0
+                    withProcessWait pc $ \p -> do
+                      case (getStdout p, getStderr p) of
+                        (Nothing, Nothing) -> pure ()
+                        (Just x, Just y) -> concurrently_ x y
+                        (x, y) -> assert False $
+                          concurrently_
+                            (fromMaybe (pure ()) x)
+                            (fromMaybe (pure ()) y)
+                      waitExitCode p
+                -- Add a trailing newline, incase the test
+                -- output didn't finish with a newline.
+                case outputType of
+                  OTConsole Nothing -> prettyInfo blankLine
+                  _ -> pure ()
+                -- Move the .tix file out of the package
+                -- directory into the hpc work dir, for
+                -- tidiness.
+                when needHpc $
+                  updateTixFile (packageName package) tixPath testName'
+                let announceResult result =
+                      announce $
+                           "Test suite "
+                        <> display testName
+                        <> " "
+                        <> result
+                case mec of
+                  Just ExitSuccess -> do
+                    announceResult "passed"
+                    pure Map.empty
+                  Nothing -> do
+                    announceResult "timed out"
+                    if expectFailure
+                    then pure Map.empty
+                    else pure $ Map.singleton testName Nothing
+                  Just ec -> do
+                    announceResult "failed"
+                    if expectFailure
+                    then pure Map.empty
+                    else pure $ Map.singleton testName (Just ec)
+              else do
+                unless expectFailure $
+                  logError $
+                    displayShow $ TestSuiteExeMissing
+                      (packageBuildType package == C.Simple)
+                      exeName
+                      (packageNameString (packageName package))
+                      (T.unpack testName)
+                pure emptyResult
+
+        when needHpc $ do
+          let testsToRun' = map f testsToRun
+              f tName =
+                  case Map.lookup tName (packageTests package) of
+                    Just C.TestSuiteLibV09{} -> tName <> "Stub"
+                    _ -> tName
+          generateHpcReport pkgDir package testsToRun'
+
+        bs <- liftIO $
+          case outputType of
+            OTConsole _ -> pure ""
+            OTLogFile logFile h -> do
+              hClose h
+              S.readFile $ toFilePath logFile
+
+        let succeeded = Map.null errs
+        unless (succeeded || expectFailure) $
+          throwM $ TestSuiteFailure
+            (taskProvides task)
+            errs
+            (case outputType of
+               OTLogFile fp _ -> Just fp
+               OTConsole _ -> Nothing)
+            bs
+
+        setTestStatus pkgDir $ if succeeded then TSSuccess else TSFailure
+
+-- | Implements running a package's benchmarks.
+singleBench :: HasEnvConfig env
+            => BenchmarkOpts
+            -> [Text]
+            -> ActionContext
+            -> ExecuteEnv
+            -> Task
+            -> InstalledMap
+            -> RIO env ()
+singleBench beopts benchesToRun ac ee task installedMap = do
+  (allDepsMap, _cache) <- getConfigCache ee task installedMap False True
+  withSingleContext ac ee task allDepsMap (Just "bench") $
+    \_package _cabalfp _pkgDir cabal announce _outputType -> do
+      let args = map T.unpack benchesToRun <> maybe []
+                       ((:[]) . ("--benchmark-options=" <>))
+                       (beoAdditionalArgs beopts)
+
+      toRun <-
+        if beoDisableRun beopts
+          then do
+            announce "Benchmark running disabled by --no-run-benchmarks flag."
+            pure False
+          else pure True
+
+      when toRun $ do
+        announce "benchmarks"
+        cabal CloseOnException KeepTHLoading ("bench" : args)
+
+data ExcludeTHLoading
+  = ExcludeTHLoading
+  | KeepTHLoading
+
+data ConvertPathsToAbsolute
+  = ConvertPathsToAbsolute
+  | KeepPathsAsIs
+
+-- | special marker for expected failures in curator builds, using those we need
+-- to keep log handle open as build continues further even after a failure
+data KeepOutputOpen
+  = KeepOpen
+  | CloseOnException
+  deriving Eq
+
+-- | Strip Template Haskell "Loading package" lines and making paths absolute.
+mungeBuildOutput ::
+     forall m. (MonadIO m, MonadUnliftIO m)
+  => ExcludeTHLoading       -- ^ exclude TH loading?
+  -> ConvertPathsToAbsolute -- ^ convert paths to absolute?
+  -> Path Abs Dir           -- ^ package's root directory
+  -> ActualCompiler         -- ^ compiler we're building with
+  -> ConduitM Text Text m ()
+mungeBuildOutput excludeTHLoading makeAbsolute pkgDir compilerVer = void $
+  CT.lines
+  .| CL.map stripCR
+  .| CL.filter (not . isTHLoading)
+  .| filterLinkerWarnings
+  .| toAbsolute
+ where
+  -- | Is this line a Template Haskell "Loading package" line
+  -- ByteString
+  isTHLoading :: Text -> Bool
+  isTHLoading = case excludeTHLoading of
+    KeepTHLoading    -> const False
+    ExcludeTHLoading -> \bs ->
+      "Loading package " `T.isPrefixOf` bs &&
+      ("done." `T.isSuffixOf` bs || "done.\r" `T.isSuffixOf` bs)
+
+  filterLinkerWarnings :: ConduitM Text Text m ()
+  filterLinkerWarnings
+    -- Check for ghc 7.8 since it's the only one prone to producing
+    -- linker warnings on Windows x64
+    | getGhcVersion compilerVer >= mkVersion [7, 8] = doNothing
+    | otherwise = CL.filter (not . isLinkerWarning)
+
+  isLinkerWarning :: Text -> Bool
+  isLinkerWarning str =
+       (  "ghc.exe: warning:" `T.isPrefixOf` str
+       || "ghc.EXE: warning:" `T.isPrefixOf` str
+       )
+    && "is linked instead of __imp_" `T.isInfixOf` str
+
+  -- | Convert GHC error lines with file paths to have absolute file paths
+  toAbsolute :: ConduitM Text Text m ()
+  toAbsolute = case makeAbsolute of
+    KeepPathsAsIs          -> doNothing
+    ConvertPathsToAbsolute -> CL.mapM toAbsolutePath
+
+  toAbsolutePath :: Text -> m Text
+  toAbsolutePath bs = do
+    let (x, y) = T.break (== ':') bs
+    mabs <-
+      if isValidSuffix y
+        then
+          fmap (fmap ((T.takeWhile isSpace x <>) . T.pack . toFilePath)) $
+            forgivingResolveFile pkgDir (T.unpack $ T.dropWhile isSpace x) `catch`
+              \(_ :: PathException) -> pure Nothing
+        else pure Nothing
+    case mabs of
+      Nothing -> pure bs
+      Just fp -> pure $ fp `T.append` y
+
+  doNothing :: ConduitM Text Text m ()
+  doNothing = awaitForever yield
+
+  -- | Match the error location format at the end of lines
+  isValidSuffix = isRight . parseOnly lineCol
+  lineCol = char ':'
+    >> choice
+         [ num >> char ':' >> num >> optional (char '-' >> num) >> pure ()
+         , char '(' >> num >> char ',' >> num >> P.string ")-(" >> num >>
+           char ',' >> num >> char ')' >> pure ()
+         ]
+    >> char ':'
+    >> pure ()
+   where
+    num = some digit
+
+-- | Whether to prefix log lines with timestamps.
+data PrefixWithTimestamps
+  = PrefixWithTimestamps
+  | WithoutTimestamps
+
+-- | Write stream of lines to handle, but adding timestamps.
+sinkWithTimestamps ::
+     MonadIO m
+  => PrefixWithTimestamps
+  -> Handle
+  -> ConduitT ByteString Void m ()
+sinkWithTimestamps prefixWithTimestamps h =
+  case prefixWithTimestamps of
+    PrefixWithTimestamps ->
+      CB.lines .| CL.mapM addTimestamp .| CL.map (<> "\n") .| sinkHandle h
+    WithoutTimestamps -> sinkHandle h
+ where
+  addTimestamp theLine = do
+    now <- liftIO getZonedTime
+    pure (formatZonedTimeForLog now <> " " <> theLine)
+
+-- | Format a time in ISO8601 format. We choose ZonedTime over UTCTime
+-- because a user expects to see logs in their local time, and would
+-- be confused to see UTC time. Stack's debug logs also use the local
+-- time zone.
+formatZonedTimeForLog :: ZonedTime -> ByteString
+formatZonedTimeForLog =
+  S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q"
+
+-- | Find the Setup.hs or Setup.lhs in the given directory. If none exists,
+-- throw an exception.
+getSetupHs :: Path Abs Dir -- ^ project directory
+           -> IO (Path Abs File)
+getSetupHs dir = do
+  exists1 <- doesFileExist fp1
+  if exists1
+    then pure fp1
+    else do
+      exists2 <- doesFileExist fp2
+      if exists2
+        then pure fp2
+        else throwM $ NoSetupHsFound dir
+ where
+  fp1 = dir </> relFileSetupHs
+  fp2 = dir </> relFileSetupLhs
+
+-- Do not pass `-hpcdir` as GHC option if the coverage is not enabled.
+-- This helps running stack-compiled programs with dynamic interpreters like
+-- `hint`. Cfr: https://github.com/commercialhaskell/stack/issues/997
+extraBuildOptions :: (HasEnvConfig env, HasRunner env)
+                  => WhichCompiler -> BuildOpts -> RIO env [String]
+extraBuildOptions wc bopts = do
+  colorOpt <- appropriateGhcColorFlag
+  let optsFlag = compilerOptionsCabalFlag wc
+      baseOpts = maybe "" (" " ++) colorOpt
+  if toCoverage (boptsTestOpts bopts)
+    then do
+      hpcIndexDir <- toFilePathNoTrailingSep <$> hpcRelativeDir
+      pure [optsFlag, "-hpcdir " ++ hpcIndexDir ++ baseOpts]
+    else
+      pure [optsFlag, baseOpts]
+
+-- Library, internal and foreign libraries and executable build components.
+primaryComponentOptions ::
+     Map Text ExecutableBuildStatus
+  -> LocalPackage
+  -> [String]
+primaryComponentOptions executableBuildStatuses lp =
+    -- TODO: get this information from target parsing instead,
+    -- which will allow users to turn off library building if
+    -- desired
+    (case packageLibraries package of
+      NoLibraries -> []
+      HasLibraries names ->
+          map T.unpack
+        $ T.append "lib:" (T.pack (packageNameString (packageName package)))
+        : map (T.append "flib:") (Set.toList names)) ++
+    map
+      (T.unpack . T.append "lib:")
+      (Set.toList $ packageInternalLibraries package) ++
+    map
+      (T.unpack . T.append "exe:")
+      (Set.toList $ exesToBuild executableBuildStatuses lp)
+ where
+  package = lpPackage lp
+
+-- | History of this function:
+--
+-- * Normally it would do either all executables or if the user specified
+--   requested components, just build them. Afterwards, due to this Cabal bug
+--   <https://github.com/haskell/cabal/issues/2780>, we had to make Stack build
+--   all executables every time.
+--
+-- * In <https://github.com/commercialhaskell/stack/issues/3229> this was
+--   flagged up as very undesirable behavior on a large project, hence the
+--   behavior below that we build all executables once (modulo success), and
+--   thereafter pay attention to user-wanted components.
+--
+exesToBuild :: Map Text ExecutableBuildStatus -> LocalPackage -> Set Text
+exesToBuild executableBuildStatuses lp =
+  if cabalIsSatisfied executableBuildStatuses && lpWanted lp
+    then exeComponents (lpComponents lp)
+    else packageExes (lpPackage lp)
+
+-- | Do the current executables satisfy Cabal's bugged out requirements?
+cabalIsSatisfied :: Map k ExecutableBuildStatus -> Bool
+cabalIsSatisfied = all (== ExecutableBuilt) . Map.elems
+
+-- Test-suite and benchmark build components.
+finalComponentOptions :: LocalPackage -> [String]
+finalComponentOptions lp =
+  map (T.unpack . renderComponent) $
+  Set.toList $
+  Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp)
+
+taskComponents :: Task -> Set NamedComponent
+taskComponents task =
+  case taskType task of
+    TTLocalMutable lp -> lpComponents lp -- FIXME probably just want lpWanted
+    TTRemotePackage{} -> Set.empty
+
+expectTestFailure :: PackageName -> Maybe Curator -> Bool
+expectTestFailure pname =
+  maybe False (Set.member pname . curatorExpectTestFailure)
+
+expectBenchmarkFailure :: PackageName -> Maybe Curator -> Bool
+expectBenchmarkFailure pname =
+  maybe False (Set.member pname . curatorExpectBenchmarkFailure)
+
+fulfillCuratorBuildExpectations ::
+     (HasCallStack, HasTerm env)
+  => PackageName
+  -> Maybe Curator
+  -> Bool
+  -> Bool
+  -> b
+  -> RIO env b
+  -> RIO env b
+fulfillCuratorBuildExpectations pname mcurator enableTests _ defValue action
+  | enableTests && expectTestFailure pname mcurator = do
+      eres <- tryAny action
+      case eres of
+        Right res -> do
+          prettyWarnL
+            [ style Current (fromString $ packageNameString pname) <> ":"
+            , flow "unexpected test build success."
+            ]
+          pure res
+        Left _ -> pure defValue
+fulfillCuratorBuildExpectations pname mcurator _ enableBench defValue action
+  | enableBench && expectBenchmarkFailure pname mcurator = do
+      eres <- tryAny action
+      case eres of
+        Right res -> do
+          prettyWarnL
+            [ style Current (fromString $ packageNameString pname) <> ":"
+            , flow "unexpected benchmark build success."
+            ]
+          pure res
+        Left _ -> pure defValue
+fulfillCuratorBuildExpectations _ _ _ _ _ action = action
src/Stack/Build/Haddock.hs view
@@ -1,278 +1,304 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE NamedFieldPuns       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
 
 -- | Generate haddocks
 module Stack.Build.Haddock
-    ( generateLocalHaddockIndex
-    , generateDepsHaddockIndex
-    , generateSnapHaddockIndex
-    , openHaddocksInBrowser
-    , shouldHaddockPackage
-    , shouldHaddockDeps
-    ) where
+  ( generateDepsHaddockIndex
+  , generateLocalHaddockIndex
+  , generateSnapHaddockIndex
+  , openHaddocksInBrowser
+  , shouldHaddockDeps
+  , shouldHaddockPackage
+  ) where
 
 import qualified Data.Foldable as F
 import qualified Data.HashSet as HS
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import           Data.Time ( UTCTime )
-import           Path
+import           Path ( (</>), parent, parseRelDir )
 import           Path.Extra
+                   ( parseCollapsedAbsFile, toFilePathNoTrailingSep
+                   , tryGetModificationTime
+                   )
 import           Path.IO
+                   ( copyDirRecur', doesFileExist, ensureDir, ignoringAbsence
+                   , removeDirRecur
+                   )
 import           RIO.List ( intercalate )
-import           RIO.Process
-import           Stack.Constants
-import           Stack.PackageDump
+import           RIO.Process ( HasProcessContext, withWorkingDir )
+import           Stack.Constants ( docDirSuffix, relDirAll, relFileIndexHtml )
 import           Stack.Prelude
-import           Stack.Types.Build
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
+import           Stack.Types.Build.Exception ( BuildException (..) )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), HasCompiler (..) )
+import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
+import           Stack.Types.BuildOpts
+                   ( BuildOpts (..), BuildOptsCLI (..), HaddockOpts (..) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
 import           Stack.Types.Package
+                   ( InstallLocation (..), LocalPackage (..), Package (..) )
 import qualified System.FilePath as FP
 import           Web.Browser ( openBrowser )
 
-openHaddocksInBrowser
-    :: HasTerm env
-    => BaseConfigOpts
-    -> Map PackageName (PackageIdentifier, InstallLocation)
-    -- ^ Available packages and their locations for the current project
-    -> Set PackageName
-    -- ^ Build targets as determined by 'Stack.Build.Source.loadSourceMap'
-    -> RIO env ()
+openHaddocksInBrowser ::
+     HasTerm env
+  => BaseConfigOpts
+  -> Map PackageName (PackageIdentifier, InstallLocation)
+  -- ^ Available packages and their locations for the current project
+  -> Set PackageName
+  -- ^ Build targets as determined by 'Stack.Build.Source.loadSourceMap'
+  -> RIO env ()
 openHaddocksInBrowser bco pkgLocations buildTargets = do
-    let cliTargets = (boptsCLITargets . bcoBuildOptsCLI) bco
-        getDocIndex = do
-            let localDocs = haddockIndexFile (localDepsDocDir bco)
-            localExists <- doesFileExist localDocs
-            if localExists
-                then pure localDocs
-                else do
-                    let snapDocs = haddockIndexFile (snapDocDir bco)
-                    snapExists <- doesFileExist snapDocs
-                    if snapExists
-                        then pure snapDocs
-                        else throwIO HaddockIndexNotFound
-    docFile <-
-        case (cliTargets, map (`Map.lookup` pkgLocations) (Set.toList buildTargets)) of
-            ([_], [Just (pkgId, iloc)]) -> do
-                pkgRelDir <- (parseRelDir . packageIdentifierString) pkgId
-                let docLocation =
-                        case iloc of
-                            Snap -> snapDocDir bco
-                            Local -> localDocDir bco
-                let docFile = haddockIndexFile (docLocation </> pkgRelDir)
-                exists <- doesFileExist docFile
-                if exists
-                    then pure docFile
-                    else do
-                        logWarn $
-                            "Expected to find documentation at " <>
-                            fromString (toFilePath docFile) <>
-                            ", but that file is missing.  Opening doc index instead."
-                        getDocIndex
-            _ -> getDocIndex
-    prettyInfo $ "Opening" <+> pretty docFile <+> "in the browser."
-    _ <- liftIO $ openBrowser (toFilePath docFile)
-    pure ()
+  let cliTargets = (boptsCLITargets . bcoBuildOptsCLI) bco
+      getDocIndex = do
+        let localDocs = haddockIndexFile (localDepsDocDir bco)
+        localExists <- doesFileExist localDocs
+        if localExists
+          then pure localDocs
+          else do
+            let snapDocs = haddockIndexFile (snapDocDir bco)
+            snapExists <- doesFileExist snapDocs
+            if snapExists
+              then pure snapDocs
+              else throwIO HaddockIndexNotFound
+  docFile <-
+    case (cliTargets, map (`Map.lookup` pkgLocations) (Set.toList buildTargets)) of
+      ([_], [Just (pkgId, iloc)]) -> do
+        pkgRelDir <- (parseRelDir . packageIdentifierString) pkgId
+        let docLocation =
+              case iloc of
+                Snap -> snapDocDir bco
+                Local -> localDocDir bco
+        let docFile = haddockIndexFile (docLocation </> pkgRelDir)
+        exists <- doesFileExist docFile
+        if exists
+            then pure docFile
+            else do
+              prettyWarnL
+                [ flow "Expected to find documentation at"
+                , pretty docFile <> ","
+                , flow "but that file is missing. Opening doc index instead."
+                ]
+              getDocIndex
+      _ -> getDocIndex
+  prettyInfo $ "Opening" <+> pretty docFile <+> "in the browser."
+  _ <- liftIO $ openBrowser (toFilePath docFile)
+  pure ()
 
 -- | Determine whether we should haddock for a package.
-shouldHaddockPackage :: BuildOpts
-                     -> Set PackageName  -- ^ Packages that we want to generate haddocks for
-                                         -- in any case (whether or not we are going to generate
-                                         -- haddocks for dependencies)
-                     -> PackageName
-                     -> Bool
+shouldHaddockPackage ::
+     BuildOpts
+  -> Set PackageName
+     -- ^ Packages that we want to generate haddocks for in any case (whether or
+     -- not we are going to generate haddocks for dependencies)
+  -> PackageName
+  -> Bool
 shouldHaddockPackage bopts wanted name =
-    if Set.member name wanted
-        then boptsHaddock bopts
-        else shouldHaddockDeps bopts
+  if Set.member name wanted
+    then boptsHaddock bopts
+    else shouldHaddockDeps bopts
 
 -- | Determine whether to build haddocks for dependencies.
 shouldHaddockDeps :: BuildOpts -> Bool
-shouldHaddockDeps bopts = fromMaybe (boptsHaddock bopts) (boptsHaddockDeps bopts)
+shouldHaddockDeps bopts =
+  fromMaybe (boptsHaddock bopts) (boptsHaddockDeps bopts)
 
 -- | Generate Haddock index and contents for local packages.
-generateLocalHaddockIndex
-    :: (HasProcessContext env, HasLogFunc env, HasCompiler env)
-    => BaseConfigOpts
-    -> Map GhcPkgId DumpPackage  -- ^ Local package dump
-    -> [LocalPackage]
-    -> RIO env ()
+generateLocalHaddockIndex ::
+     (HasCompiler env, HasProcessContext env, HasTerm env)
+  => BaseConfigOpts
+  -> Map GhcPkgId DumpPackage  -- ^ Local package dump
+  -> [LocalPackage]
+  -> RIO env ()
 generateLocalHaddockIndex bco localDumpPkgs locals = do
-    let dumpPackages =
-            mapMaybe
-                (\LocalPackage{lpPackage = Package{packageName, packageVersion}} ->
-                    F.find
-                        (\dp -> dpPackageIdent dp == PackageIdentifier packageName packageVersion)
-                        localDumpPkgs)
-                locals
-    generateHaddockIndex
-        "local packages"
-        bco
-        dumpPackages
-        "."
-        (localDocDir bco)
+  let dumpPackages =
+        mapMaybe
+          ( \LocalPackage{lpPackage = Package{packageName, packageVersion}} ->
+              F.find
+                ( \dp -> dpPackageIdent dp ==
+                         PackageIdentifier packageName packageVersion
+                )
+                localDumpPkgs
+          )
+          locals
+  generateHaddockIndex
+    "local packages"
+    bco
+    dumpPackages
+    "."
+    (localDocDir bco)
 
--- | Generate Haddock index and contents for local packages and their dependencies.
-generateDepsHaddockIndex
-    :: (HasProcessContext env, HasLogFunc env, HasCompiler env)
-    => BaseConfigOpts
-    -> Map GhcPkgId DumpPackage  -- ^ Global dump information
-    -> Map GhcPkgId DumpPackage  -- ^ Snapshot dump information
-    -> Map GhcPkgId DumpPackage  -- ^ Local dump information
-    -> [LocalPackage]
-    -> RIO env ()
+-- | Generate Haddock index and contents for local packages and their
+-- dependencies.
+generateDepsHaddockIndex ::
+     (HasCompiler env, HasProcessContext env, HasTerm env)
+  => BaseConfigOpts
+  -> Map GhcPkgId DumpPackage  -- ^ Global dump information
+  -> Map GhcPkgId DumpPackage  -- ^ Snapshot dump information
+  -> Map GhcPkgId DumpPackage  -- ^ Local dump information
+  -> [LocalPackage]
+  -> RIO env ()
 generateDepsHaddockIndex bco globalDumpPkgs snapshotDumpPkgs localDumpPkgs locals = do
-    let deps = (mapMaybe (`lookupDumpPackage` allDumpPkgs) . nubOrd . findTransitiveDepends . mapMaybe getGhcPkgId) locals
-        depDocDir = localDepsDocDir bco
-    generateHaddockIndex
-        "local packages and dependencies"
-        bco
-        deps
-        ".."
-        depDocDir
-  where
-    getGhcPkgId :: LocalPackage -> Maybe GhcPkgId
-    getGhcPkgId LocalPackage{lpPackage = Package{packageName, packageVersion}} =
-        let pkgId = PackageIdentifier packageName packageVersion
-            mdpPkg = F.find (\dp -> dpPackageIdent dp == pkgId) localDumpPkgs
-        in fmap dpGhcPkgId mdpPkg
-    findTransitiveDepends :: [GhcPkgId] -> [GhcPkgId]
-    findTransitiveDepends = (`go` HS.empty) . HS.fromList
-      where
-        go todo checked =
-            case HS.toList todo of
-                [] -> HS.toList checked
-                (ghcPkgId:_) ->
-                    let deps =
-                            case lookupDumpPackage ghcPkgId allDumpPkgs of
-                                Nothing -> HS.empty
-                                Just pkgDP -> HS.fromList (dpDepends pkgDP)
-                        deps' = deps `HS.difference` checked
-                        todo' = HS.delete ghcPkgId (deps' `HS.union` todo)
-                        checked' = HS.insert ghcPkgId checked
-                    in go todo' checked'
-    allDumpPkgs = [localDumpPkgs, snapshotDumpPkgs, globalDumpPkgs]
+  let deps = ( mapMaybe
+                 (`lookupDumpPackage` allDumpPkgs)
+                 . nubOrd
+                 . findTransitiveDepends
+                 . mapMaybe getGhcPkgId
+             ) locals
+      depDocDir = localDepsDocDir bco
+  generateHaddockIndex
+    "local packages and dependencies"
+    bco
+    deps
+    ".."
+    depDocDir
+ where
+  getGhcPkgId :: LocalPackage -> Maybe GhcPkgId
+  getGhcPkgId LocalPackage{lpPackage = Package{packageName, packageVersion}} =
+    let pkgId = PackageIdentifier packageName packageVersion
+        mdpPkg = F.find (\dp -> dpPackageIdent dp == pkgId) localDumpPkgs
+    in  fmap dpGhcPkgId mdpPkg
+  findTransitiveDepends :: [GhcPkgId] -> [GhcPkgId]
+  findTransitiveDepends = (`go` HS.empty) . HS.fromList
+   where
+    go todo checked =
+      case HS.toList todo of
+        [] -> HS.toList checked
+        (ghcPkgId:_) ->
+          let deps = case lookupDumpPackage ghcPkgId allDumpPkgs of
+                       Nothing -> HS.empty
+                       Just pkgDP -> HS.fromList (dpDepends pkgDP)
+              deps' = deps `HS.difference` checked
+              todo' = HS.delete ghcPkgId (deps' `HS.union` todo)
+              checked' = HS.insert ghcPkgId checked
+          in  go todo' checked'
+  allDumpPkgs = [localDumpPkgs, snapshotDumpPkgs, globalDumpPkgs]
 
 -- | Generate Haddock index and contents for all snapshot packages.
-generateSnapHaddockIndex
-    :: (HasProcessContext env, HasLogFunc env, HasCompiler env)
-    => BaseConfigOpts
-    -> Map GhcPkgId DumpPackage  -- ^ Global package dump
-    -> Map GhcPkgId DumpPackage  -- ^ Snapshot package dump
-    -> RIO env ()
+generateSnapHaddockIndex ::
+     (HasCompiler env, HasProcessContext env, HasTerm env)
+  => BaseConfigOpts
+  -> Map GhcPkgId DumpPackage  -- ^ Global package dump
+  -> Map GhcPkgId DumpPackage  -- ^ Snapshot package dump
+  -> RIO env ()
 generateSnapHaddockIndex bco globalDumpPkgs snapshotDumpPkgs =
-    generateHaddockIndex
-        "snapshot packages"
-        bco
-        (Map.elems snapshotDumpPkgs ++ Map.elems globalDumpPkgs)
-        "."
-        (snapDocDir bco)
+  generateHaddockIndex
+    "snapshot packages"
+    bco
+    (Map.elems snapshotDumpPkgs ++ Map.elems globalDumpPkgs)
+    "."
+    (snapDocDir bco)
 
 -- | Generate Haddock index and contents for specified packages.
-generateHaddockIndex
-    :: (HasProcessContext env, HasLogFunc env, HasCompiler env)
-    => Text
-    -> BaseConfigOpts
-    -> [DumpPackage]
-    -> FilePath
-    -> Path Abs Dir
-    -> RIO env ()
+generateHaddockIndex ::
+     (HasCompiler env, HasProcessContext env, HasTerm env)
+  => Text
+  -> BaseConfigOpts
+  -> [DumpPackage]
+  -> FilePath
+  -> Path Abs Dir
+  -> RIO env ()
 generateHaddockIndex descr bco dumpPackages docRelFP destDir = do
-    ensureDir destDir
-    interfaceOpts <- (liftIO . fmap nubOrd . mapMaybeM toInterfaceOpt) dumpPackages
-    unless (null interfaceOpts) $ do
-        let destIndexFile = haddockIndexFile destDir
-        eindexModTime <- liftIO (tryGetModificationTime destIndexFile)
-        let needUpdate =
-                case eindexModTime of
-                    Left _ -> True
-                    Right indexModTime ->
-                        or [mt > indexModTime | (_,mt,_,_) <- interfaceOpts]
-        if needUpdate
-            then do
-                logInfo $
-                  "Updating Haddock index for " <>
-                  Stack.Prelude.display descr <>
-                  " in\n" <>
-                  fromString (toFilePath destIndexFile)
-                liftIO (mapM_ copyPkgDocs interfaceOpts)
-                haddockExeName <- view $ compilerPathsL.to (toFilePath . cpHaddock)
-                withWorkingDir (toFilePath destDir) $ readProcessNull
-                    haddockExeName
-                    (map (("--optghc=-package-db=" ++ ) . toFilePathNoTrailingSep)
-                        [bcoSnapDB bco, bcoLocalDB bco] ++
-                     hoAdditionalArgs (boptsHaddockOpts (bcoBuildOpts bco)) ++
-                     ["--gen-contents", "--gen-index"] ++
-                     [x | (xs,_,_,_) <- interfaceOpts, x <- xs])
-            else
-              logInfo $
-                "Haddock index for " <>
-                Stack.Prelude.display descr <>
-                " already up to date at:\n" <>
-                fromString (toFilePath destIndexFile)
-  where
-    toInterfaceOpt :: DumpPackage -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File))
-    toInterfaceOpt DumpPackage {dpHaddockInterfaces, dpPackageIdent, dpHaddockHtml} =
-        case dpHaddockInterfaces of
-            [] -> pure Nothing
-            srcInterfaceFP:_ -> do
-                srcInterfaceAbsFile <- parseCollapsedAbsFile srcInterfaceFP
-                let (PackageIdentifier name _) = dpPackageIdent
-                    destInterfaceRelFP =
-                        docRelFP FP.</>
-                        packageIdentifierString dpPackageIdent FP.</>
-                        (packageNameString name FP.<.> "haddock")
-                    docPathRelFP =
-                        fmap ((docRelFP FP.</>) . FP.takeFileName) dpHaddockHtml
-                    interfaces = intercalate "," $
-                        maybeToList docPathRelFP ++ [srcInterfaceFP]
+  ensureDir destDir
+  interfaceOpts <-
+    (liftIO . fmap nubOrd . mapMaybeM toInterfaceOpt) dumpPackages
+  unless (null interfaceOpts) $ do
+    let destIndexFile = haddockIndexFile destDir
+    eindexModTime <- liftIO (tryGetModificationTime destIndexFile)
+    let needUpdate =
+          case eindexModTime of
+            Left _ -> True
+            Right indexModTime ->
+              or [mt > indexModTime | (_, mt, _, _) <- interfaceOpts]
+    if needUpdate
+      then do
+        prettyInfoL
+          [ flow "Updating Haddock index for"
+          , style Current (fromString $ T.unpack descr)
+          , "in"
+          , pretty destIndexFile <> "."
+          ]
+        liftIO (mapM_ copyPkgDocs interfaceOpts)
+        haddockExeName <- view $ compilerPathsL.to (toFilePath . cpHaddock)
+        withWorkingDir (toFilePath destDir) $ readProcessNull
+          haddockExeName
+          ( map
+              (("--optghc=-package-db=" ++ ) . toFilePathNoTrailingSep)
+                 [bcoSnapDB bco, bcoLocalDB bco]
+              ++ hoAdditionalArgs (boptsHaddockOpts (bcoBuildOpts bco))
+              ++ ["--gen-contents", "--gen-index"]
+              ++ [x | (xs, _, _, _) <- interfaceOpts, x <- xs]
+          )
+      else
+        prettyInfoL
+          [ flow "Haddock index for"
+          , style Current (fromString $ T.unpack descr)
+          , flow "already up to date at"
+          , pretty destIndexFile <> "."
+          ]
+ where
+  toInterfaceOpt ::
+       DumpPackage
+    -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File))
+  toInterfaceOpt DumpPackage {dpHaddockInterfaces, dpPackageIdent, dpHaddockHtml} =
+    case dpHaddockInterfaces of
+      [] -> pure Nothing
+      srcInterfaceFP:_ -> do
+        srcInterfaceAbsFile <- parseCollapsedAbsFile srcInterfaceFP
+        let (PackageIdentifier name _) = dpPackageIdent
+            destInterfaceRelFP =
+              docRelFP FP.</>
+              packageIdentifierString dpPackageIdent FP.</>
+              (packageNameString name FP.<.> "haddock")
+            docPathRelFP =
+              fmap ((docRelFP FP.</>) . FP.takeFileName) dpHaddockHtml
+            interfaces = intercalate "," $ mcons docPathRelFP [srcInterfaceFP]
 
-                destInterfaceAbsFile <- parseCollapsedAbsFile (toFilePath destDir FP.</> destInterfaceRelFP)
-                esrcInterfaceModTime <- tryGetModificationTime srcInterfaceAbsFile
-                pure $
-                    case esrcInterfaceModTime of
-                        Left _ -> Nothing
-                        Right srcInterfaceModTime ->
-                            Just
-                                ( [ "-i", interfaces ]
-                                , srcInterfaceModTime
-                                , srcInterfaceAbsFile
-                                , destInterfaceAbsFile )
-    copyPkgDocs :: (a, UTCTime, Path Abs File, Path Abs File) -> IO ()
-    copyPkgDocs (_,srcInterfaceModTime,srcInterfaceAbsFile,destInterfaceAbsFile) = do
-        -- Copy dependencies' haddocks to documentation directory.  This way, relative @../$pkg-$ver@
-        -- links work and it's easy to upload docs to a web server or otherwise view them in a
-        -- non-local-filesystem context. We copy instead of symlink for two reasons: (1) symlinks
-        -- aren't reliably supported on Windows, and (2) the filesystem containing dependencies'
-        -- docs may not be available where viewing the docs (e.g. if building in a Docker
-        -- container).
-        edestInterfaceModTime <- tryGetModificationTime destInterfaceAbsFile
-        case edestInterfaceModTime of
-            Left _ -> doCopy
-            Right destInterfaceModTime
-                | destInterfaceModTime < srcInterfaceModTime -> doCopy
-                | otherwise -> pure ()
-      where
-        doCopy = do
-            ignoringAbsence (removeDirRecur destHtmlAbsDir)
-            ensureDir destHtmlAbsDir
-            onException
-                (copyDirRecur' (parent srcInterfaceAbsFile) destHtmlAbsDir)
-                (ignoringAbsence (removeDirRecur destHtmlAbsDir))
-        destHtmlAbsDir = parent destInterfaceAbsFile
+        destInterfaceAbsFile <-
+          parseCollapsedAbsFile (toFilePath destDir FP.</> destInterfaceRelFP)
+        esrcInterfaceModTime <- tryGetModificationTime srcInterfaceAbsFile
+        pure $
+          case esrcInterfaceModTime of
+            Left _ -> Nothing
+            Right srcInterfaceModTime ->
+              Just
+                ( [ "-i", interfaces ]
+                , srcInterfaceModTime
+                , srcInterfaceAbsFile
+                , destInterfaceAbsFile
+                )
+  copyPkgDocs :: (a, UTCTime, Path Abs File, Path Abs File) -> IO ()
+  copyPkgDocs (_, srcInterfaceModTime, srcInterfaceAbsFile, destInterfaceAbsFile) = do
+  -- Copy dependencies' haddocks to documentation directory.  This way,
+  -- relative @../$pkg-$ver@ links work and it's easy to upload docs to a web
+  -- server or otherwise view them in a non-local-filesystem context. We copy
+  -- instead of symlink for two reasons: (1) symlinks aren't reliably supported
+  -- on Windows, and (2) the filesystem containing dependencies' docs may not be
+  -- available where viewing the docs (e.g. if building in a Docker container).
+    edestInterfaceModTime <- tryGetModificationTime destInterfaceAbsFile
+    case edestInterfaceModTime of
+      Left _ -> doCopy
+      Right destInterfaceModTime
+        | destInterfaceModTime < srcInterfaceModTime -> doCopy
+        | otherwise -> pure ()
+   where
+    doCopy = do
+      ignoringAbsence (removeDirRecur destHtmlAbsDir)
+      ensureDir destHtmlAbsDir
+      onException
+        (copyDirRecur' (parent srcInterfaceAbsFile) destHtmlAbsDir)
+        (ignoringAbsence (removeDirRecur destHtmlAbsDir))
+    destHtmlAbsDir = parent destInterfaceAbsFile
 
 -- | Find first DumpPackage matching the GhcPkgId
 lookupDumpPackage :: GhcPkgId
                   -> [Map GhcPkgId DumpPackage]
                   -> Maybe DumpPackage
 lookupDumpPackage ghcPkgId dumpPkgs =
-    listToMaybe $ mapMaybe (Map.lookup ghcPkgId) dumpPkgs
+  listToMaybe $ mapMaybe (Map.lookup ghcPkgId) dumpPkgs
 
 -- | Path of haddock index file.
 haddockIndexFile :: Path Abs Dir -> Path Abs File
src/Stack/Build/Installed.hs view
@@ -1,48 +1,53 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 
 -- Determine which packages are already installed
 module Stack.Build.Installed
-    ( InstalledMap
-    , Installed (..)
-    , getInstalled
-    , InstallMap
-    , toInstallMap
-    ) where
+  ( InstalledMap
+  , Installed (..)
+  , getInstalled
+  , InstallMap
+  , toInstallMap
+  ) where
 
-import           Data.Conduit
+import           Data.Conduit ( ZipSink (..), getZipSink )
 import qualified Data.Conduit.List as CL
 import qualified Data.Set as Set
 import qualified Data.Map.Strict as Map
-import           Path
-import           Stack.Build.Cache
-import           Stack.Constants
+import           Stack.Build.Cache ( getInstalledExes )
+import           Stack.Constants ( wiredInPackages )
 import           Stack.PackageDump
+                   ( conduitDumpPackage, ghcPkgDump, pruneDeps )
 import           Stack.Prelude
-import           Stack.SourceMap (getPLIVersion, loadVersion)
-import           Stack.Types.Build
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
+import           Stack.SourceMap ( getPLIVersion, loadVersion )
+import           Stack.Types.CompilerPaths ( getGhcPkgExe )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.EnvConfig
+                    ( HasEnvConfig, packageDatabaseDeps, packageDatabaseExtra
+                    , packageDatabaseLocal
+                    )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
 import           Stack.Types.Package
+                   ( InstallLocation (..), InstallMap, Installed (..)
+                   , InstalledMap, InstalledPackageLocation (..)
+                   )
 import           Stack.Types.SourceMap
+                   ( DepPackage (..), ProjectPackage (..), SourceMap (..) )
 
 toInstallMap :: MonadIO m => SourceMap -> m InstallMap
 toInstallMap sourceMap = do
-    projectInstalls <-
-        for (smProject sourceMap) $ \pp -> do
-            version <- loadVersion (ppCommon pp)
-            pure (Local, version)
-    depInstalls <-
-        for (smDeps sourceMap) $ \dp ->
-            case dpLocation dp of
-                PLImmutable pli -> pure (Snap, getPLIVersion pli)
-                PLMutable _ -> do
-                    version <- loadVersion (dpCommon dp)
-                    pure (Local, version)
-    pure $ projectInstalls <> depInstalls
+  projectInstalls <-
+    for (smProject sourceMap) $ \pp -> do
+      version <- loadVersion (ppCommon pp)
+      pure (Local, version)
+  depInstalls <-
+    for (smDeps sourceMap) $ \dp ->
+      case dpLocation dp of
+        PLImmutable pli -> pure (Snap, getPLIVersion pli)
+        PLMutable _ -> do
+          version <- loadVersion (dpCommon dp)
+          pure (Local, version)
+  pure $ projectInstalls <> depInstalls
 
 -- | Returns the new InstalledMap and all of the locally registered packages.
 getInstalled :: HasEnvConfig env
@@ -54,85 +59,83 @@                   , [DumpPackage] -- locally installed
                   )
 getInstalled {-opts-} installMap = do
-    logDebug "Finding out which packages are already installed"
-    snapDBPath <- packageDatabaseDeps
-    localDBPath <- packageDatabaseLocal
-    extraDBPaths <- packageDatabaseExtra
-
-    let loadDatabase' = loadDatabase {-opts mcache-} installMap
+  logDebug "Finding out which packages are already installed"
+  snapDBPath <- packageDatabaseDeps
+  localDBPath <- packageDatabaseLocal
+  extraDBPaths <- packageDatabaseExtra
 
-    (installedLibs0, globalDumpPkgs) <- loadDatabase' Nothing []
-    (installedLibs1, _extraInstalled) <-
-      foldM (\lhs' pkgdb ->
-        loadDatabase' (Just (ExtraGlobal, pkgdb)) (fst lhs')
-        ) (installedLibs0, globalDumpPkgs) extraDBPaths
-    (installedLibs2, snapshotDumpPkgs) <-
-        loadDatabase' (Just (InstalledTo Snap, snapDBPath)) installedLibs1
-    (installedLibs3, localDumpPkgs) <-
-        loadDatabase' (Just (InstalledTo Local, localDBPath)) installedLibs2
-    let installedLibs = Map.fromList $ map lhPair installedLibs3
+  let loadDatabase' = loadDatabase {-opts mcache-} installMap
 
-    -- Add in the executables that are installed, making sure to only trust a
-    -- listed installation under the right circumstances (see below)
-    let exesToSM loc = Map.unions . map (exeToSM loc)
-        exeToSM loc (PackageIdentifier name version) =
-            case Map.lookup name installMap of
-                -- Doesn't conflict with anything, so that's OK
-                Nothing -> m
-                Just (iLoc, iVersion)
-                    -- Not the version we want, ignore it
-                    | version /= iVersion || mismatchingLoc loc iLoc -> Map.empty
+  (installedLibs0, globalDumpPkgs) <- loadDatabase' Nothing []
+  (installedLibs1, _extraInstalled) <-
+    foldM (\lhs' pkgdb ->
+      loadDatabase' (Just (ExtraGlobal, pkgdb)) (fst lhs')
+      ) (installedLibs0, globalDumpPkgs) extraDBPaths
+  (installedLibs2, snapshotDumpPkgs) <-
+    loadDatabase' (Just (InstalledTo Snap, snapDBPath)) installedLibs1
+  (installedLibs3, localDumpPkgs) <-
+    loadDatabase' (Just (InstalledTo Local, localDBPath)) installedLibs2
+  let installedLibs = Map.fromList $ map lhPair installedLibs3
 
-                    | otherwise -> m
-          where
-            m = Map.singleton name (loc, Executable $ PackageIdentifier name version)
-            mismatchingLoc installed target | target == installed = False
-                                            | installed == Local = False -- snapshot dependency could end up
-                                                                         -- in a local install as being mutable
-                                            | otherwise = True
-    exesSnap <- getInstalledExes Snap
-    exesLocal <- getInstalledExes Local
-    let installedMap = Map.unions
-            [ exesToSM Local exesLocal
-            , exesToSM Snap exesSnap
-            , installedLibs
-            ]
+  -- Add in the executables that are installed, making sure to only trust a
+  -- listed installation under the right circumstances (see below)
+  let exesToSM loc = Map.unions . map (exeToSM loc)
+      exeToSM loc (PackageIdentifier name version) =
+        case Map.lookup name installMap of
+          -- Doesn't conflict with anything, so that's OK
+          Nothing -> m
+          Just (iLoc, iVersion)
+            -- Not the version we want, ignore it
+            | version /= iVersion || mismatchingLoc loc iLoc -> Map.empty
+            | otherwise -> m
+       where
+        m = Map.singleton name (loc, Executable $ PackageIdentifier name version)
+        mismatchingLoc installed target
+          | target == installed = False
+          | installed == Local = False -- snapshot dependency could end up
+                                       -- in a local install as being mutable
+          | otherwise = True
+  exesSnap <- getInstalledExes Snap
+  exesLocal <- getInstalledExes Local
+  let installedMap = Map.unions
+        [ exesToSM Local exesLocal
+        , exesToSM Snap exesSnap
+        , installedLibs
+        ]
 
-    pure ( installedMap
-           , globalDumpPkgs
-           , snapshotDumpPkgs
-           , localDumpPkgs
-           )
+  pure ( installedMap
+       , globalDumpPkgs
+       , snapshotDumpPkgs
+       , localDumpPkgs
+       )
 
--- | Outputs both the modified InstalledMap and the Set of all installed packages in this database
+-- | Outputs both the modified InstalledMap and the Set of all installed
+-- packages in this database
 --
 -- The goal is to ascertain that the dependencies for a package are present,
 -- that it has profiling if necessary, and that it matches the version and
 -- location needed by the SourceMap
-loadDatabase :: HasEnvConfig env
-             => InstallMap -- ^ to determine which installed things we should include
-             -> Maybe (InstalledPackageLocation, Path Abs Dir) -- ^ package database, Nothing for global
-             -> [LoadHelper] -- ^ from parent databases
-             -> RIO env ([LoadHelper], [DumpPackage])
+loadDatabase ::
+     HasEnvConfig env
+  => InstallMap -- ^ to determine which installed things we should include
+  -> Maybe (InstalledPackageLocation, Path Abs Dir)
+     -- ^ package database, Nothing for global
+  -> [LoadHelper] -- ^ from parent databases
+  -> RIO env ([LoadHelper], [DumpPackage])
 loadDatabase installMap mdb lhs0 = do
-    pkgexe <- getGhcPkgExe
-    (lhs1', dps) <- ghcPkgDump pkgexe (fmap snd (maybeToList mdb))
-                $ conduitDumpPackage .| sink
-    lhs1 <- mapMaybeM (processLoadResult mdb) lhs1'
-    let lhs = pruneDeps
-            id
-            lhId
-            lhDeps
-            const
-            (lhs0 ++ lhs1)
-    pure (map (\lh -> lh { lhDeps = [] }) $ Map.elems lhs, dps)
-  where
-    mloc = fmap fst mdb
-    sinkDP =  CL.map (isAllowed installMap mloc &&& toLoadHelper mloc)
-           .| CL.consume
-    sink = getZipSink $ (,)
-        <$> ZipSink sinkDP
-        <*> ZipSink CL.consume
+  pkgexe <- getGhcPkgExe
+  (lhs1', dps) <- ghcPkgDump pkgexe (fmap snd (maybeToList mdb)) $
+                    conduitDumpPackage .| sink
+  lhs1 <- mapMaybeM (processLoadResult mdb) lhs1'
+  let lhs = pruneDeps id lhId lhDeps const (lhs0 ++ lhs1)
+  pure (map (\lh -> lh { lhDeps = [] }) $ Map.elems lhs, dps)
+ where
+  mloc = fmap fst mdb
+  sinkDP =  CL.map (isAllowed installMap mloc &&& toLoadHelper mloc)
+         .| CL.consume
+  sink =   getZipSink $ (,)
+       <$> ZipSink sinkDP
+       <*> ZipSink CL.consume
 
 processLoadResult :: HasLogFunc env
                   => Maybe (InstalledPackageLocation, Path Abs Dir)
@@ -140,27 +143,33 @@                   -> RIO env (Maybe LoadHelper)
 processLoadResult _ (Allowed, lh) = pure (Just lh)
 processLoadResult mdb (reason, lh) = do
-    logDebug $
-        "Ignoring package " <>
-        fromString (packageNameString (fst (lhPair lh))) <>
-        maybe mempty (\db -> ", from " <> displayShow db <> ",") mdb <>
-        " due to" <>
-        case reason of
-            UnknownPkg -> " it being unknown to the resolver / extra-deps."
-            WrongLocation mloc loc -> " wrong location: " <> displayShow (mloc, loc)
-            WrongVersion actual wanted ->
-                " wanting version " <>
-                fromString (versionString wanted) <>
-                " instead of " <>
-                fromString (versionString actual)
-    pure Nothing
+  logDebug $
+       "Ignoring package "
+    <> fromString (packageNameString (fst (lhPair lh)))
+    <> maybe
+         mempty
+         ( \db ->    ", from "
+                  <> displayShow db
+                  <> ","
+         )
+         mdb
+    <> " due to"
+    <> case reason of
+         UnknownPkg -> " it being unknown to the resolver / extra-deps."
+         WrongLocation mloc loc -> " wrong location: " <> displayShow (mloc, loc)
+         WrongVersion actual wanted ->
+              " wanting version "
+          <> fromString (versionString wanted)
+          <> " instead of "
+          <> fromString (versionString actual)
+  pure Nothing
 
 data Allowed
-    = Allowed
-    | UnknownPkg
-    | WrongLocation (Maybe InstalledPackageLocation) InstallLocation
-    | WrongVersion Version Version
-    deriving (Eq, Show)
+  = Allowed
+  | UnknownPkg
+  | WrongLocation (Maybe InstalledPackageLocation) InstallLocation
+  | WrongVersion Version Version
+  deriving (Eq, Show)
 
 -- | Check if a can be included in the set of installed packages or not, based
 -- on the package selections made by the user. This does not perform any
@@ -169,66 +178,66 @@           -> Maybe InstalledPackageLocation
           -> DumpPackage
           -> Allowed
-isAllowed installMap mloc dp =
-        case Map.lookup name installMap of
-            Nothing ->
-                -- If the sourceMap has nothing to say about this package,
-                -- check if it represents a sublibrary first
-                -- See: https://github.com/commercialhaskell/stack/issues/3899
-                case dpParentLibIdent dp of
-                  Just (PackageIdentifier parentLibName version') ->
-                    case Map.lookup parentLibName installMap of
-                      Nothing -> checkNotFound
-                      Just instInfo
-                        | version' == version -> checkFound instInfo
-                        | otherwise -> checkNotFound -- different versions
-                  Nothing -> checkNotFound
-            Just pii -> checkFound pii
-  where
-    PackageIdentifier name version = dpPackageIdent dp
-    -- Ensure that the installed location matches where the sourceMap says it
-    -- should be installed
-    checkLocation Snap = True -- snapshot deps could become mutable after getting any mutable dependency
-    checkLocation Local = mloc == Just (InstalledTo Local) || mloc == Just ExtraGlobal -- 'locally' installed snapshot packages can come from extra dbs
-    -- Check if a package is allowed if it is found in the sourceMap
-    checkFound (installLoc, installVer)
-      | not (checkLocation installLoc) = WrongLocation mloc installLoc
-      | version /= installVer = WrongVersion version installVer
-      | otherwise = Allowed
-    -- check if a package is allowed if it is not found in the sourceMap
-    checkNotFound = case mloc of
-      -- The sourceMap has nothing to say about this global package, so we can use it
-      Nothing -> Allowed
-      Just ExtraGlobal -> Allowed
-      -- For non-global packages, don't include unknown packages.
-      -- See: https://github.com/commercialhaskell/stack/issues/292
-      Just _ -> UnknownPkg
+isAllowed installMap mloc dp = case Map.lookup name installMap of
+  Nothing ->
+    -- If the sourceMap has nothing to say about this package,
+    -- check if it represents a sublibrary first
+    -- See: https://github.com/commercialhaskell/stack/issues/3899
+    case dpParentLibIdent dp of
+      Just (PackageIdentifier parentLibName version') ->
+        case Map.lookup parentLibName installMap of
+          Nothing -> checkNotFound
+          Just instInfo
+            | version' == version -> checkFound instInfo
+            | otherwise -> checkNotFound -- different versions
+      Nothing -> checkNotFound
+  Just pii -> checkFound pii
+ where
+  PackageIdentifier name version = dpPackageIdent dp
+  -- Ensure that the installed location matches where the sourceMap says it
+  -- should be installed
+  checkLocation Snap = True -- snapshot deps could become mutable after getting
+                            -- any mutable dependency
+  checkLocation Local =
+    mloc == Just (InstalledTo Local) || mloc == Just ExtraGlobal -- 'locally' installed snapshot packages can come from extra dbs
+  -- Check if a package is allowed if it is found in the sourceMap
+  checkFound (installLoc, installVer)
+    | not (checkLocation installLoc) = WrongLocation mloc installLoc
+    | version /= installVer = WrongVersion version installVer
+    | otherwise = Allowed
+  -- check if a package is allowed if it is not found in the sourceMap
+  checkNotFound = case mloc of
+    -- The sourceMap has nothing to say about this global package, so we can use it
+    Nothing -> Allowed
+    Just ExtraGlobal -> Allowed
+    -- For non-global packages, don't include unknown packages.
+    -- See: https://github.com/commercialhaskell/stack/issues/292
+    Just _ -> UnknownPkg
 
 data LoadHelper = LoadHelper
-    { lhId   :: !GhcPkgId
-    , lhDeps :: ![GhcPkgId]
-    , lhPair :: !(PackageName, (InstallLocation, Installed))
-    }
-    deriving Show
+  { lhId   :: !GhcPkgId
+  , lhDeps :: ![GhcPkgId]
+  , lhPair :: !(PackageName, (InstallLocation, Installed))
+  }
+  deriving Show
 
 toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage -> LoadHelper
 toLoadHelper mloc dp = LoadHelper
-    { lhId = gid
-    , lhDeps =
-        -- We always want to consider the wired in packages as having all
-        -- of their dependencies installed, since we have no ability to
-        -- reinstall them. This is especially important for using different
-        -- minor versions of GHC, where the dependencies of wired-in
-        -- packages may change slightly and therefore not match the
-        -- snapshot.
-        if name `Set.member` wiredInPackages
-            then []
-            else dpDepends dp
-    , lhPair = (name, (toPackageLocation mloc, Library ident gid (Right <$> dpLicense dp)))
-    }
-  where
-    gid = dpGhcPkgId dp
-    ident@(PackageIdentifier name _) = dpPackageIdent dp
+  { lhId = gid
+  , lhDeps =
+      -- We always want to consider the wired in packages as having all of their
+      -- dependencies installed, since we have no ability to reinstall them.
+      -- This is especially important for using different minor versions of GHC,
+      -- where the dependencies of wired-in packages may change slightly and
+      -- therefore not match the snapshot.
+      if name `Set.member` wiredInPackages
+        then []
+        else dpDepends dp
+  , lhPair = (name, (toPackageLocation mloc, Library ident gid (Right <$> dpLicense dp)))
+  }
+ where
+  gid = dpGhcPkgId dp
+  ident@(PackageIdentifier name _) = dpPackageIdent dp
 
 toPackageLocation :: Maybe InstalledPackageLocation -> InstallLocation
 toPackageLocation Nothing = Snap
src/Stack/Build/Source.hs view
@@ -1,384 +1,438 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
 
 -- Load information on package sources
 module Stack.Build.Source
-    ( projectLocalPackages
-    , localDependencies
-    , loadCommonPackage
-    , loadLocalPackage
-    , loadSourceMap
-    , getLocalFlags
-    , addUnlistedToBuildCache
-    , hashSourceMapData
-    ) where
+  ( projectLocalPackages
+  , localDependencies
+  , loadCommonPackage
+  , loadLocalPackage
+  , loadSourceMap
+  , getLocalFlags
+  , addUnlistedToBuildCache
+  , hashSourceMapData
+  ) where
 
-import              Stack.Prelude
-import qualified    Pantry.SHA256 as SHA256
-import              Data.ByteString.Builder (toLazyByteString)
-import              Conduit (ZipSink (..), withSourceFile)
-import qualified    Distribution.PackageDescription as C
-import qualified    Data.List as L
-import qualified    Data.Map as Map
-import qualified    Data.Map.Strict as M
-import qualified    Data.Set as Set
-import              Stack.Build.Cache
-import              Stack.Build.Haddock (shouldHaddockDeps)
-import              Stack.Build.Target
-import              Stack.Package
-import              Stack.SourceMap
-import              Stack.Types.Build
-import              Stack.Types.Config
-import              Stack.Types.NamedComponent
-import              Stack.Types.Package
-import              Stack.Types.PackageFile
-import              Stack.Types.SourceMap
-import              System.FilePath (takeFileName)
-import              System.IO.Error (isDoesNotExistError)
+import           Conduit ( ZipSink (..), withSourceFile )
+import           Data.ByteString.Builder ( toLazyByteString )
+import qualified Data.List as L
+import qualified Data.Map as Map
+import qualified Data.Map.Merge.Lazy as Map
+import qualified Data.Map.Strict as M
+import qualified Data.Set as Set
+import qualified Distribution.PackageDescription as C
+import qualified Pantry.SHA256 as SHA256
+import           Stack.Build.Cache ( tryGetBuildCache )
+import           Stack.Build.Haddock ( shouldHaddockDeps )
+import           Stack.Package ( resolvePackage )
+import           Stack.Prelude
+import           Stack.SourceMap
+                   ( DumpedGlobalPackage, checkFlagsUsedThrowing
+                   , getCompilerInfo, immutableLocSha, mkProjectPackage
+                   , pruneGlobals
+                   )
+import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
+import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.BuildOpts
+                   ( ApplyCLIFlag (..), BuildOpts (..), BuildOptsCLI (..)
+                   , TestOpts (..), boptsCLIAllProgOptions
+                   )
+import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
+import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
+import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
+import           Stack.Types.Curator ( Curator (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..)
+                   , actualCompilerVersionL
+                   )
+import           Stack.Types.NamedComponent
+                   ( NamedComponent (..), isCInternalLib )
+import           Stack.Types.Package
+                   ( FileCacheInfo (..), LocalPackage (..), Package (..)
+                   , PackageConfig (..), PackageLibraries (..)
+                   , dotCabalGetPath, memoizeRefWith, runMemoizedWith
+                   )
+import           Stack.Types.PackageFile ( PackageWarning, getPackageFiles )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..), ProjectPackage (..)
+                   , SMActual (..), SMTargets (..), SourceMap (..)
+                   , SourceMapHash (..), Target (..), ppGPD, ppRoot
+                   )
+import           Stack.Types.UnusedFlags ( FlagSource (..) )
+import           System.FilePath ( takeFileName )
+import           System.IO.Error ( isDoesNotExistError )
 
 -- | loads and returns project packages
-projectLocalPackages :: HasEnvConfig env
-              => RIO env [LocalPackage]
+projectLocalPackages :: HasEnvConfig env => RIO env [LocalPackage]
 projectLocalPackages = do
-    sm <- view $ envConfigL.to envConfigSourceMap
-    for (toList $ smProject sm) loadLocalPackage
+  sm <- view $ envConfigL.to envConfigSourceMap
+  for (toList $ smProject sm) loadLocalPackage
 
 -- | loads all local dependencies - project packages and local extra-deps
 localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
 localDependencies = do
-    bopts <- view $ configL.to configBuild
-    sourceMap <- view $ envConfigL . to envConfigSourceMap
-    forMaybeM (Map.elems $ smDeps sourceMap) $ \dp ->
-        case dpLocation dp of
-            PLMutable dir -> do
-                pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts)
-                Just <$> loadLocalPackage pp
-            _ -> pure Nothing
+  bopts <- view $ configL.to configBuild
+  sourceMap <- view $ envConfigL . to envConfigSourceMap
+  forMaybeM (Map.elems $ smDeps sourceMap) $ \dp ->
+    case dpLocation dp of
+      PLMutable dir -> do
+        pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts)
+        Just <$> loadLocalPackage pp
+      _ -> pure Nothing
 
--- | Given the parsed targets and build command line options constructs
---   a source map
+-- | Given the parsed targets and build command line options constructs a source
+-- map
 loadSourceMap :: HasBuildConfig env
               => SMTargets
               -> BuildOptsCLI
               -> SMActual DumpedGlobalPackage
               -> RIO env SourceMap
 loadSourceMap smt boptsCli sma = do
-    bconfig <- view buildConfigL
-    let compiler = smaCompiler sma
-        project = M.map applyOptsFlagsPP $ smaProject sma
-        bopts = configBuild (bcConfig bconfig)
-        applyOptsFlagsPP p@ProjectPackage{ppCommon = c} =
-          p{ppCommon = applyOptsFlags (M.member (cpName c) (smtTargets smt)) True c}
-        deps0 = smtDeps smt <> smaDeps sma
-        deps = M.map applyOptsFlagsDep deps0
-        applyOptsFlagsDep d@DepPackage{dpCommon = c} =
-          d{dpCommon = applyOptsFlags (M.member (cpName c) (smtDeps smt)) False c}
-        applyOptsFlags isTarget isProjectPackage common =
-            let name = cpName common
-                flags = getLocalFlags boptsCli name
-                ghcOptions =
-                  generalGhcOptions bconfig boptsCli isTarget isProjectPackage
-                cabalConfigOpts =
-                  loadCabalConfigOpts bconfig (cpName common) isTarget isProjectPackage
-            in common
-               { cpFlags =
-                     if M.null flags
-                         then cpFlags common
-                         else flags
-               , cpGhcOptions =
-                     ghcOptions ++ cpGhcOptions common
-               , cpCabalConfigOpts =
-                     cabalConfigOpts ++ cpCabalConfigOpts common
-               , cpHaddocks =
-                     if isTarget
-                         then boptsHaddock bopts
-                         else shouldHaddockDeps bopts
-               }
-        packageCliFlags = Map.fromList $
-          mapMaybe maybeProjectFlags $
-          Map.toList (boptsCLIFlags boptsCli)
-        maybeProjectFlags (ACFByName name, fs) = Just (name, fs)
-        maybeProjectFlags _ = Nothing
-        globals = pruneGlobals (smaGlobal sma) (Map.keysSet deps)
-    logDebug "Checking flags"
-    checkFlagsUsedThrowing packageCliFlags FSCommandLine project deps
-    logDebug "SourceMap constructed"
-    pure
-        SourceMap
-        { smTargets = smt
-        , smCompiler = compiler
-        , smProject = project
-        , smDeps = deps
-        , smGlobal = globals
-        }
+  bconfig <- view buildConfigL
+  let compiler = smaCompiler sma
+      project = M.map applyOptsFlagsPP $ smaProject sma
+      bopts = configBuild (bcConfig bconfig)
+      applyOptsFlagsPP p@ProjectPackage{ppCommon = c} =
+        p{ppCommon = applyOptsFlags (M.member (cpName c) (smtTargets smt)) True c}
+      deps0 = smtDeps smt <> smaDeps sma
+      deps = M.map applyOptsFlagsDep deps0
+      applyOptsFlagsDep d@DepPackage{dpCommon = c} =
+        d{dpCommon = applyOptsFlags (M.member (cpName c) (smtDeps smt)) False c}
+      applyOptsFlags isTarget isProjectPackage common =
+        let name = cpName common
+            flags = getLocalFlags boptsCli name
+            ghcOptions =
+              generalGhcOptions bconfig boptsCli isTarget isProjectPackage
+            cabalConfigOpts =
+              generalCabalConfigOpts bconfig boptsCli (cpName common) isTarget isProjectPackage
+        in  common
+              { cpFlags =
+                  if M.null flags
+                    then cpFlags common
+                    else flags
+              , cpGhcOptions =
+                  ghcOptions ++ cpGhcOptions common
+              , cpCabalConfigOpts =
+                  cabalConfigOpts ++ cpCabalConfigOpts common
+              , cpHaddocks =
+                  if isTarget
+                    then boptsHaddock bopts
+                    else shouldHaddockDeps bopts
+              }
+      packageCliFlags = Map.fromList $
+        mapMaybe maybeProjectFlags $
+        Map.toList (boptsCLIFlags boptsCli)
+      maybeProjectFlags (ACFByName name, fs) = Just (name, fs)
+      maybeProjectFlags _ = Nothing
+      globals = pruneGlobals (smaGlobal sma) (Map.keysSet deps)
+  logDebug "Checking flags"
+  checkFlagsUsedThrowing packageCliFlags FSCommandLine project deps
+  logDebug "SourceMap constructed"
+  pure
+    SourceMap
+      { smTargets = smt
+      , smCompiler = compiler
+      , smProject = project
+      , smDeps = deps
+      , smGlobal = globals
+      }
 
 -- | Get a 'SourceMapHash' for a given 'SourceMap'
 --
 -- Basic rules:
 --
--- * If someone modifies a GHC installation in any way after Stack
---   looks at it, they voided the warranty. This includes installing a
---   brand new build to the same directory, or registering new
---   packages to the global database.
+-- * If someone modifies a GHC installation in any way after Stack looks at it,
+--   they voided the warranty. This includes installing a brand new build to the
+--   same directory, or registering new packages to the global database.
 --
--- * We should include everything in the hash that would relate to
---   immutable packages and identifying the compiler itself. Mutable
---   packages (both project packages and dependencies) will never make
---   it into the snapshot database, and can be ignored.
+-- * We should include everything in the hash that would relate to immutable
+--   packages and identifying the compiler itself. Mutable packages (both
+--   project packages and dependencies) will never make it into the snapshot
+--   database, and can be ignored.
 --
--- * Target information is only relevant insofar as it effects the
---   dependency map. The actual current targets for this build are
---   irrelevant to the cache mechanism, and can be ignored.
+-- * Target information is only relevant insofar as it effects the dependency
+--   map. The actual current targets for this build are irrelevant to the cache
+--   mechanism, and can be ignored.
 --
 -- * Make sure things like profiling and haddocks are included in the hash
 --
-hashSourceMapData
-    :: (HasBuildConfig env, HasCompiler env)
-    => BuildOptsCLI
-    -> SourceMap
-    -> RIO env SourceMapHash
+hashSourceMapData ::
+     (HasBuildConfig env, HasCompiler env)
+  => BuildOptsCLI
+  -> SourceMap
+  -> RIO env SourceMapHash
 hashSourceMapData boptsCli sm = do
-    compilerPath <- getUtf8Builder . fromString . toFilePath <$> getCompilerPath
-    compilerInfo <- getCompilerInfo
-    immDeps <- forM (Map.elems (smDeps sm)) depPackageHashableContent
-    bc <- view buildConfigL
-    let -- extra bytestring specifying GHC options supposed to be applied to
-        -- GHC boot packages so we'll have different hashes when bare
-        -- resolver 'ghc-X.Y.Z' is used, no extra-deps and e.g. user wants builds
-        -- with profiling or without
-        bootGhcOpts = map display (generalGhcOptions bc boptsCli False False)
-        hashedContent = toLazyByteString $ compilerPath <> compilerInfo <>
-            getUtf8Builder (mconcat bootGhcOpts) <> mconcat immDeps
-    pure $ SourceMapHash (SHA256.hashLazyBytes hashedContent)
+  compilerPath <- getUtf8Builder . fromString . toFilePath <$> getCompilerPath
+  compilerInfo <- getCompilerInfo
+  immDeps <- forM (Map.elems (smDeps sm)) depPackageHashableContent
+  bc <- view buildConfigL
+  let -- extra bytestring specifying GHC options supposed to be applied to GHC
+      -- boot packages so we'll have different hashes when bare resolver
+      -- 'ghc-X.Y.Z' is used, no extra-deps and e.g. user wants builds with
+      -- profiling or without
+      bootGhcOpts = map display (generalGhcOptions bc boptsCli False False)
+      hashedContent =
+           toLazyByteString $ compilerPath
+        <> compilerInfo
+        <> getUtf8Builder (mconcat bootGhcOpts)
+        <> mconcat immDeps
+  pure $ SourceMapHash (SHA256.hashLazyBytes hashedContent)
 
 depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder
-depPackageHashableContent DepPackage {..} = do
-    case dpLocation of
-        PLMutable _ -> pure ""
-        PLImmutable pli -> do
-            let flagToBs (f, enabled) =
-                    if enabled
-                        then ""
-                        else "-" <> fromString (C.unFlagName f)
-                flags = map flagToBs $ Map.toList (cpFlags dpCommon)
-                ghcOptions = map display (cpGhcOptions dpCommon)
-                cabalConfigOpts = map display (cpCabalConfigOpts dpCommon)
-                haddocks = if cpHaddocks dpCommon then "haddocks" else ""
-                hash = immutableLocSha pli
-            pure $ hash <> haddocks <> getUtf8Builder (mconcat flags) <>
-                getUtf8Builder (mconcat ghcOptions) <>
-                getUtf8Builder (mconcat cabalConfigOpts)
+depPackageHashableContent DepPackage {..} =
+  case dpLocation of
+    PLMutable _ -> pure ""
+    PLImmutable pli -> do
+      let flagToBs (f, enabled) =
+            if enabled
+              then ""
+              else "-" <> fromString (C.unFlagName f)
+          flags = map flagToBs $ Map.toList (cpFlags dpCommon)
+          ghcOptions = map display (cpGhcOptions dpCommon)
+          cabalConfigOpts = map display (cpCabalConfigOpts dpCommon)
+          haddocks = if cpHaddocks dpCommon then "haddocks" else ""
+          hash = immutableLocSha pli
+      pure
+        $  hash
+        <> haddocks
+        <> getUtf8Builder (mconcat flags)
+        <> getUtf8Builder (mconcat ghcOptions)
+        <> getUtf8Builder (mconcat cabalConfigOpts)
 
 -- | All flags for a local package.
-getLocalFlags
-    :: BuildOptsCLI
-    -> PackageName
-    -> Map FlagName Bool
+getLocalFlags ::
+     BuildOptsCLI
+  -> PackageName
+  -> Map FlagName Bool
 getLocalFlags boptsCli name = Map.unions
-    [ Map.findWithDefault Map.empty (ACFByName name) cliFlags
-    , Map.findWithDefault Map.empty ACFAllProjectPackages cliFlags
-    ]
-  where
-    cliFlags = boptsCLIFlags boptsCli
+  [ Map.findWithDefault Map.empty (ACFByName name) cliFlags
+  , Map.findWithDefault Map.empty ACFAllProjectPackages cliFlags
+  ]
+ where
+  cliFlags = boptsCLIFlags boptsCli
 
 -- | Get the options to pass to @./Setup.hs configure@
-loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
-loadCabalConfigOpts bconfig name isTarget isLocal = concat
-    [ Map.findWithDefault [] CCKEverything (configCabalConfigOpts config)
-    , if isLocal
-        then Map.findWithDefault [] CCKLocals (configCabalConfigOpts config)
-        else []
-    , if isTarget
-        then Map.findWithDefault [] CCKTargets (configCabalConfigOpts config)
-        else []
-    , Map.findWithDefault [] (CCKPackage name) (configCabalConfigOpts config)
-    ]
-  where
-    config = view configL bconfig
+generalCabalConfigOpts ::
+     BuildConfig
+  -> BuildOptsCLI
+  -> PackageName
+  -> Bool
+  -> Bool
+  -> [Text]
+generalCabalConfigOpts bconfig boptsCli name isTarget isLocal = concat
+  [ Map.findWithDefault [] CCKEverything (configCabalConfigOpts config)
+  , if isLocal
+      then Map.findWithDefault [] CCKLocals (configCabalConfigOpts config)
+      else []
+  , if isTarget
+      then Map.findWithDefault [] CCKTargets (configCabalConfigOpts config)
+      else []
+  , Map.findWithDefault [] (CCKPackage name) (configCabalConfigOpts config)
+  , if includeExtraOptions
+      then boptsCLIAllProgOptions boptsCli
+      else []
+  ]
+ where
+  config = view configL bconfig
+  includeExtraOptions =
+    case configApplyProgOptions config of
+      APOTargets -> isTarget
+      APOLocals -> isLocal
+      APOEverything -> True
 
 -- | Get the configured options to pass from GHC, based on the build
 -- configuration and commandline.
 generalGhcOptions :: BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
 generalGhcOptions bconfig boptsCli isTarget isLocal = concat
-    [ Map.findWithDefault [] AGOEverything (configGhcOptionsByCat config)
-    , if isLocal
-        then Map.findWithDefault [] AGOLocals (configGhcOptionsByCat config)
-        else []
-    , if isTarget
-        then Map.findWithDefault [] AGOTargets (configGhcOptionsByCat config)
-        else []
-    , concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)]
-    , if boptsLibProfile bopts || boptsExeProfile bopts
-         then ["-fprof-auto","-fprof-cafs"]
-         else []
-    , if not $ boptsLibStrip bopts || boptsExeStrip bopts
-         then ["-g"]
-         else []
-    , if includeExtraOptions
-         then boptsCLIGhcOptions boptsCli
-         else []
-    ]
-  where
-    bopts = configBuild config
-    config = view configL bconfig
-    includeExtraOptions =
-        case configApplyGhcOptions config of
-            AGOTargets -> isTarget
-            AGOLocals -> isLocal
-            AGOEverything -> True
+  [ Map.findWithDefault [] AGOEverything (configGhcOptionsByCat config)
+  , if isLocal
+      then Map.findWithDefault [] AGOLocals (configGhcOptionsByCat config)
+      else []
+  , if isTarget
+      then Map.findWithDefault [] AGOTargets (configGhcOptionsByCat config)
+      else []
+  , concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)]
+  , if boptsLibProfile bopts || boptsExeProfile bopts
+      then ["-fprof-auto", "-fprof-cafs"]
+      else []
+  , [ "-g" | not $ boptsLibStrip bopts || boptsExeStrip bopts ]
+  , if includeExtraOptions
+      then boptsCLIGhcOptions boptsCli
+      else []
+  ]
+ where
+  bopts = configBuild config
+  config = view configL bconfig
+  includeExtraOptions =
+    case configApplyGhcOptions config of
+      AGOTargets -> isTarget
+      AGOLocals -> isLocal
+      AGOEverything -> True
 
 splitComponents :: [NamedComponent]
                 -> (Set Text, Set Text, Set Text)
 splitComponents =
-    go id id id
-  where
-    go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c [])
-    go a b c (CLib:xs) = go a b c xs
-    go a b c (CInternalLib x:xs) = go (a . (x:)) b c xs
-    go a b c (CExe x:xs) = go (a . (x:)) b c xs
-    go a b c (CTest x:xs) = go a (b . (x:)) c xs
-    go a b c (CBench x:xs) = go a b (c . (x:)) xs
+  go id id id
+ where
+  go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c [])
+  go a b c (CLib:xs) = go a b c xs
+  go a b c (CInternalLib x:xs) = go (a . (x:)) b c xs
+  go a b c (CExe x:xs) = go (a . (x:)) b c xs
+  go a b c (CTest x:xs) = go a (b . (x:)) c xs
+  go a b c (CBench x:xs) = go a b (c . (x:)) xs
 
 loadCommonPackage ::
-       forall env. (HasBuildConfig env, HasSourceMap env)
-    => CommonPackage
-    -> RIO env Package
+     forall env. (HasBuildConfig env, HasSourceMap env)
+  => CommonPackage
+  -> RIO env Package
 loadCommonPackage common = do
-    config <- getPackageConfig (cpFlags common) (cpGhcOptions common) (cpCabalConfigOpts common)
-    gpkg <- liftIO $ cpGPD common
-    pure $ resolvePackage config gpkg
+  config <-
+    getPackageConfig
+      (cpFlags common)
+      (cpGhcOptions common)
+      (cpCabalConfigOpts common)
+  gpkg <- liftIO $ cpGPD common
+  pure $ resolvePackage config gpkg
 
 -- | Upgrade the initial project package info to a full-blown @LocalPackage@
 -- based on the selected components
 loadLocalPackage ::
-       forall env. (HasBuildConfig env, HasSourceMap env)
-    => ProjectPackage
-    -> RIO env LocalPackage
+     forall env. (HasBuildConfig env, HasSourceMap env)
+  => ProjectPackage
+  -> RIO env LocalPackage
 loadLocalPackage pp = do
-    sm <- view sourceMapL
-    let common = ppCommon pp
-    bopts <- view buildOptsL
-    mcurator <- view $ buildConfigL.to bcCurator
-    config <- getPackageConfig (cpFlags common) (cpGhcOptions common) (cpCabalConfigOpts common)
-    gpkg <- ppGPD pp
-    let name = cpName common
-        mtarget = M.lookup name (smtTargets $ smTargets sm)
-        (exeCandidates, testCandidates, benchCandidates) =
-            case mtarget of
-                Just (TargetComps comps) -> splitComponents $ Set.toList comps
-                Just (TargetAll _packageType) ->
-                    ( packageExes pkg
-                    , if boptsTests bopts && maybe True (Set.notMember name . curatorSkipTest) mcurator
-                        then Map.keysSet (packageTests pkg)
-                        else Set.empty
-                    , if boptsBenchmarks bopts && maybe True (Set.notMember name . curatorSkipBenchmark) mcurator
-                        then packageBenchmarks pkg
-                        else Set.empty
-                    )
-                Nothing -> mempty
+  sm <- view sourceMapL
+  let common = ppCommon pp
+  bopts <- view buildOptsL
+  mcurator <- view $ buildConfigL.to bcCurator
+  config <- getPackageConfig
+              (cpFlags common)
+              (cpGhcOptions common)
+              (cpCabalConfigOpts common)
+  gpkg <- ppGPD pp
+  let name = cpName common
+      mtarget = M.lookup name (smtTargets $ smTargets sm)
+      (exeCandidates, testCandidates, benchCandidates) =
+        case mtarget of
+          Just (TargetComps comps) -> splitComponents $ Set.toList comps
+          Just (TargetAll _packageType) ->
+            ( packageExes pkg
+            , if    boptsTests bopts
+                 && maybe True (Set.notMember name . curatorSkipTest) mcurator
+                then Map.keysSet (packageTests pkg)
+                else Set.empty
+            , if    boptsBenchmarks bopts
+                 && maybe
+                      True
+                      (Set.notMember name . curatorSkipBenchmark)
+                      mcurator
+                then packageBenchmarks pkg
+                else Set.empty
+            )
+          Nothing -> mempty
 
-        -- See https://github.com/commercialhaskell/stack/issues/2862
-        isWanted = case mtarget of
-            Nothing -> False
-            -- FIXME: When issue #1406 ("stack 0.1.8 lost ability to
-            -- build individual executables or library") is resolved,
-            -- 'hasLibrary' is only relevant if the library is
-            -- part of the target spec.
-            Just _ ->
-              let hasLibrary =
-                    case packageLibraries pkg of
-                      NoLibraries -> False
-                      HasLibraries _ -> True
-               in hasLibrary
-               || not (Set.null nonLibComponents)
-               || not (Set.null $ packageInternalLibraries pkg)
+      -- See https://github.com/commercialhaskell/stack/issues/2862
+      isWanted = case mtarget of
+        Nothing -> False
+        -- FIXME: When issue #1406 ("stack 0.1.8 lost ability to build
+        -- individual executables or library") is resolved, 'hasLibrary' is only
+        -- relevant if the library is part of the target spec.
+        Just _ ->
+          let hasLibrary =
+                case packageLibraries pkg of
+                  NoLibraries -> False
+                  HasLibraries _ -> True
+          in     hasLibrary
+              || not (Set.null nonLibComponents)
+              || not (Set.null $ packageInternalLibraries pkg)
 
-        filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts))
+      filterSkippedComponents =
+        Set.filter (not . (`elem` boptsSkipComponents bopts))
 
-        (exes, tests, benches) = (filterSkippedComponents exeCandidates,
-                                  filterSkippedComponents testCandidates,
-                                  filterSkippedComponents benchCandidates)
+      (exes, tests, benches) = ( filterSkippedComponents exeCandidates
+                               , filterSkippedComponents testCandidates
+                               , filterSkippedComponents benchCandidates
+                               )
 
-        nonLibComponents = toComponents exes tests benches
+      nonLibComponents = toComponents exes tests benches
 
-        toComponents e t b = Set.unions
-            [ Set.map CExe e
-            , Set.map CTest t
-            , Set.map CBench b
-            ]
+      toComponents e t b = Set.unions
+        [ Set.map CExe e
+        , Set.map CTest t
+        , Set.map CBench b
+        ]
 
-        btconfig = config
-            { packageConfigEnableTests = not $ Set.null tests
-            , packageConfigEnableBenchmarks = not $ Set.null benches
-            }
+      btconfig = config
+        { packageConfigEnableTests = not $ Set.null tests
+        , packageConfigEnableBenchmarks = not $ Set.null benches
+        }
 
-        -- We resolve the package in 2 different configurations:
-        --
-        -- - pkg doesn't have tests or benchmarks enabled.
-        --
-        -- - btpkg has them enabled if they are present.
-        --
-        -- The latter two configurations are used to compute the deps
-        -- when --enable-benchmarks or --enable-tests are configured.
-        -- This allows us to do an optimization where these are passed
-        -- if the deps are present. This can avoid doing later
-        -- unnecessary reconfigures.
-        pkg = resolvePackage config gpkg
-        btpkg
-            | Set.null tests && Set.null benches = Nothing
-            | otherwise = Just (resolvePackage btconfig gpkg)
+      -- We resolve the package in 2 different configurations:
+      --
+      -- - pkg doesn't have tests or benchmarks enabled.
+      --
+      -- - btpkg has them enabled if they are present.
+      --
+      -- The latter two configurations are used to compute the deps when
+      -- --enable-benchmarks or --enable-tests are configured. This allows us to
+      -- do an optimization where these are passed if the deps are present. This
+      -- can avoid doing later unnecessary reconfigures.
+      pkg = resolvePackage config gpkg
+      btpkg
+        | Set.null tests && Set.null benches = Nothing
+        | otherwise = Just (resolvePackage btconfig gpkg)
 
-    componentFiles <- memoizeRefWith $ fst <$> getPackageFilesForTargets pkg (ppCabalFP pp) nonLibComponents
+  componentFiles <- memoizeRefWith $
+    fst <$> getPackageFilesForTargets pkg (ppCabalFP pp) nonLibComponents
 
-    checkCacheResults <- memoizeRefWith $ do
-      componentFiles' <- runMemoizedWith componentFiles
-      forM (Map.toList componentFiles') $ \(component, files) -> do
-        mbuildCache <- tryGetBuildCache (ppRoot pp) component
-        checkCacheResult <- checkBuildCache
-            (fromMaybe Map.empty mbuildCache)
-            (Set.toList files)
-        pure (component, checkCacheResult)
+  checkCacheResults <- memoizeRefWith $ do
+    componentFiles' <- runMemoizedWith componentFiles
+    forM (Map.toList componentFiles') $ \(component, files) -> do
+      mbuildCache <- tryGetBuildCache (ppRoot pp) component
+      checkCacheResult <- checkBuildCache
+        (fromMaybe Map.empty mbuildCache)
+        (Set.toList files)
+      pure (component, checkCacheResult)
 
-    let dirtyFiles = do
-          checkCacheResults' <- checkCacheResults
-          let allDirtyFiles = Set.unions $ map (\(_, (x, _)) -> x) checkCacheResults'
-          pure $
-            if not (Set.null allDirtyFiles)
-                then let tryStripPrefix y =
-                          fromMaybe y (L.stripPrefix (toFilePath $ ppRoot pp) y)
-                      in Just $ Set.map tryStripPrefix allDirtyFiles
-                else Nothing
-        newBuildCaches =
-            M.fromList . map (\(c, (_, cache)) -> (c, cache))
-            <$> checkCacheResults
+  let dirtyFiles = do
+        checkCacheResults' <- checkCacheResults
+        let allDirtyFiles =
+              Set.unions $ map (\(_, (x, _)) -> x) checkCacheResults'
+        pure $
+          if not (Set.null allDirtyFiles)
+            then let tryStripPrefix y =
+                      fromMaybe y (L.stripPrefix (toFilePath $ ppRoot pp) y)
+                 in  Just $ Set.map tryStripPrefix allDirtyFiles
+            else Nothing
+      newBuildCaches =
+        M.fromList . map (\(c, (_, cache)) -> (c, cache)) <$> checkCacheResults
 
-    pure LocalPackage
-        { lpPackage = pkg
-        , lpTestBench = btpkg
-        , lpComponentFiles = componentFiles
-        , lpBuildHaddocks = cpHaddocks (ppCommon pp)
-        , lpForceDirty = boptsForceDirty bopts
-        , lpDirtyFiles = dirtyFiles
-        , lpNewBuildCaches = newBuildCaches
-        , lpCabalFile = ppCabalFP pp
-        , lpWanted = isWanted
-        , lpComponents = nonLibComponents
-        -- TODO: refactor this so that it's easier to be sure that these
-        -- components are indeed unbuildable.
-        --
-        -- The reasoning here is that if the STLocalComps specification
-        -- made it through component parsing, but the components aren't
-        -- present, then they must not be buildable.
-        , lpUnbuildable = toComponents
-            (exes `Set.difference` packageExes pkg)
-            (tests `Set.difference` Map.keysSet (packageTests pkg))
-            (benches `Set.difference` packageBenchmarks pkg)
-        }
+  pure LocalPackage
+    { lpPackage = pkg
+    , lpTestBench = btpkg
+    , lpComponentFiles = componentFiles
+    , lpBuildHaddocks = cpHaddocks (ppCommon pp)
+    , lpForceDirty = boptsForceDirty bopts
+    , lpDirtyFiles = dirtyFiles
+    , lpNewBuildCaches = newBuildCaches
+    , lpCabalFile = ppCabalFP pp
+    , lpWanted = isWanted
+    , lpComponents = nonLibComponents
+      -- TODO: refactor this so that it's easier to be sure that these
+      -- components are indeed unbuildable.
+      --
+      -- The reasoning here is that if the STLocalComps specification made it
+      -- through component parsing, but the components aren't present, then they
+      -- must not be buildable.
+    , lpUnbuildable = toComponents
+        (exes `Set.difference` packageExes pkg)
+        (tests `Set.difference` Map.keysSet (packageTests pkg))
+        (benches `Set.difference` packageBenchmarks pkg)
+    }
 
 -- | Compare the current filesystem state to the cached information, and
 -- determine (1) if the files are dirty, and (2) the new cache values.
@@ -387,90 +441,99 @@                 -> [Path Abs File] -- ^ files in package
                 -> m (Set FilePath, Map FilePath FileCacheInfo)
 checkBuildCache oldCache files = do
-    fileTimes <- liftM Map.fromList $ forM files $ \fp -> do
-        mdigest <- liftIO (getFileDigestMaybe (toFilePath fp))
-        pure (toFilePath fp, mdigest)
-    liftM (mconcat . Map.elems) $ sequence $
-        Map.mergeWithKey
-            (\fp mdigest fci -> Just (go fp mdigest (Just fci)))
-            (Map.mapWithKey (\fp mdigest -> go fp mdigest Nothing))
-            (Map.mapWithKey (\fp fci -> go fp Nothing (Just fci)))
-            fileTimes
-            oldCache
-  where
-    go :: FilePath -> Maybe SHA256 -> Maybe FileCacheInfo -> m (Set FilePath, Map FilePath FileCacheInfo)
-    -- Filter out the cabal_macros file to avoid spurious recompilations
-    go fp _ _ | takeFileName fp == "cabal_macros.h" = pure (Set.empty, Map.empty)
-    -- Common case where it's in the cache and on the filesystem.
-    go fp (Just digest') (Just fci)
-        | fciHash fci == digest' = pure (Set.empty, Map.singleton fp fci)
-        | otherwise = pure (Set.singleton fp, Map.singleton fp $ FileCacheInfo digest')
-    -- Missing file. Add it to dirty files, but no FileCacheInfo.
-    go fp Nothing _ = pure (Set.singleton fp, Map.empty)
-    -- Missing cache. Add it to dirty files and compute FileCacheInfo.
-    go fp (Just digest') Nothing =
-        pure (Set.singleton fp, Map.singleton fp $ FileCacheInfo digest')
+  fileTimes <- fmap Map.fromList $ forM files $ \fp -> do
+    mdigest <- liftIO (getFileDigestMaybe (toFilePath fp))
+    pure (toFilePath fp, mdigest)
+  fmap (mconcat . Map.elems) $ sequence $
+    Map.merge
+      (Map.mapMissing (\fp mdigest -> go fp mdigest Nothing))
+      (Map.mapMissing (\fp fci -> go fp Nothing (Just fci)))
+      (Map.zipWithMatched (\fp mdigest fci -> go fp mdigest (Just fci)))
+      fileTimes
+      oldCache
+ where
+  go :: FilePath
+     -> Maybe SHA256
+     -> Maybe FileCacheInfo
+     -> m (Set FilePath, Map FilePath FileCacheInfo)
+  -- Filter out the cabal_macros file to avoid spurious recompilations
+  go fp _ _ | takeFileName fp == "cabal_macros.h" = pure (Set.empty, Map.empty)
+  -- Common case where it's in the cache and on the filesystem.
+  go fp (Just digest') (Just fci)
+      | fciHash fci == digest' = pure (Set.empty, Map.singleton fp fci)
+      | otherwise =
+          pure (Set.singleton fp, Map.singleton fp $ FileCacheInfo digest')
+  -- Missing file. Add it to dirty files, but no FileCacheInfo.
+  go fp Nothing _ = pure (Set.singleton fp, Map.empty)
+  -- Missing cache. Add it to dirty files and compute FileCacheInfo.
+  go fp (Just digest') Nothing =
+    pure (Set.singleton fp, Map.singleton fp $ FileCacheInfo digest')
 
--- | Returns entries to add to the build cache for any newly found unlisted modules
-addUnlistedToBuildCache
-    :: HasEnvConfig env
-    => Package
-    -> Path Abs File
-    -> Set NamedComponent
-    -> Map NamedComponent (Map FilePath a)
-    -> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])
+-- | Returns entries to add to the build cache for any newly found unlisted
+-- modules
+addUnlistedToBuildCache ::
+     HasEnvConfig env
+  => Package
+  -> Path Abs File
+  -> Set NamedComponent
+  -> Map NamedComponent (Map FilePath a)
+  -> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])
 addUnlistedToBuildCache pkg cabalFP nonLibComponents buildCaches = do
-    (componentFiles, warnings) <- getPackageFilesForTargets pkg cabalFP nonLibComponents
-    results <- forM (M.toList componentFiles) $ \(component, files) -> do
-        let buildCache = M.findWithDefault M.empty component buildCaches
-            newFiles =
-                Set.toList $
-                Set.map toFilePath files `Set.difference` Map.keysSet buildCache
-        addBuildCache <- mapM addFileToCache newFiles
-        pure ((component, addBuildCache), warnings)
-    pure (M.fromList (map fst results), concatMap snd results)
-  where
-    addFileToCache fp = do
-        mdigest <- getFileDigestMaybe fp
-        case mdigest of
-            Nothing -> pure Map.empty
-            Just digest' -> pure . Map.singleton fp $ FileCacheInfo digest'
+  (componentFiles, warnings) <-
+    getPackageFilesForTargets pkg cabalFP nonLibComponents
+  results <- forM (M.toList componentFiles) $ \(component, files) -> do
+    let buildCache = M.findWithDefault M.empty component buildCaches
+        newFiles =
+            Set.toList $
+            Set.map toFilePath files `Set.difference` Map.keysSet buildCache
+    addBuildCache <- mapM addFileToCache newFiles
+    pure ((component, addBuildCache), warnings)
+  pure (M.fromList (map fst results), concatMap snd results)
+ where
+  addFileToCache fp = do
+    mdigest <- getFileDigestMaybe fp
+    case mdigest of
+      Nothing -> pure Map.empty
+      Just digest' -> pure $ Map.singleton fp $ FileCacheInfo digest'
 
 -- | Gets list of Paths for files relevant to a set of components in a package.
---   Note that the library component, if any, is always automatically added to the
---   set of components.
-getPackageFilesForTargets
-    :: HasEnvConfig env
-    => Package
-    -> Path Abs File
-    -> Set NamedComponent
-    -> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
+-- Note that the library component, if any, is always automatically added to the
+-- set of components.
+getPackageFilesForTargets ::
+     HasEnvConfig env
+  => Package
+  -> Path Abs File
+  -> Set NamedComponent
+  -> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
 getPackageFilesForTargets pkg cabalFP nonLibComponents = do
-    (components',compFiles,otherFiles,warnings) <-
-        getPackageFiles (packageFiles pkg) cabalFP
-    let necessaryComponents = Set.insert CLib $ Set.filter isCInternalLib (M.keysSet components')
-        components = necessaryComponents `Set.union` nonLibComponents
-        componentsFiles =
-            M.map (\files -> Set.union otherFiles (Set.map dotCabalGetPath $ Set.fromList files)) $
-                M.filterWithKey (\component _ -> component `elem` components) compFiles
-    pure (componentsFiles, warnings)
+  (components',compFiles,otherFiles,warnings) <-
+    getPackageFiles (packageFiles pkg) cabalFP
+  let necessaryComponents =
+        Set.insert CLib $ Set.filter isCInternalLib (M.keysSet components')
+      components = necessaryComponents `Set.union` nonLibComponents
+      componentsFiles = M.map
+        (\files ->
+           Set.union otherFiles (Set.map dotCabalGetPath $ Set.fromList files)
+        )
+        $ M.filterWithKey (\component _ -> component `elem` components) compFiles
+  pure (componentsFiles, warnings)
 
 -- | Get file digest, if it exists
 getFileDigestMaybe :: MonadIO m => FilePath -> m (Maybe SHA256)
-getFileDigestMaybe fp = do
-    liftIO
-        (catch
-             (liftM Just . withSourceFile fp $ getDigest)
-             (\e ->
-                   if isDoesNotExistError e
-                       then pure Nothing
-                       else throwM e))
-  where
-    getDigest src = runConduit $ src .| getZipSink (ZipSink SHA256.sinkHash)
+getFileDigestMaybe fp =
+  liftIO $
+    catch
+      (fmap Just . withSourceFile fp $ getDigest)
+      (\e ->
+            if isDoesNotExistError e
+                then pure Nothing
+                else throwM e)
+ where
+  getDigest src = runConduit $ src .| getZipSink (ZipSink SHA256.sinkHash)
 
 -- | Get 'PackageConfig' for package given its name.
-getPackageConfig
-  :: (HasBuildConfig env, HasSourceMap env)
+getPackageConfig ::
+     (HasBuildConfig env, HasSourceMap env)
   => Map FlagName Bool
   -> [Text] -- ^ GHC options
   -> [Text] -- ^ cabal config opts
src/Stack/Build/Target.hs view
@@ -1,62 +1,56 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
+{-# LANGUAGE MultiWayIf          #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE ViewPatterns        #-}
 
 -- | Parsing command line targets
 --
--- There are two relevant data sources for performing this parsing:
--- the project configuration, and command line arguments. Project
--- configurations includes the resolver (defining a LoadedSnapshot of
--- global and snapshot packages), local dependencies, and project
--- packages. It also defines local flag overrides.
+-- There are two relevant data sources for performing this parsing: the project
+-- configuration, and command line arguments. Project configurations includes
+-- the resolver (defining a LoadedSnapshot of global and snapshot packages),
+-- local dependencies, and project packages. It also defines local flag
+-- overrides.
 --
--- The command line arguments specify both additional local flag
--- overrides and targets in their raw form.
+-- The command line arguments specify both additional local flag overrides and
+-- targets in their raw form.
 --
--- Flags are simple: we just combine CLI flags with config flags and
--- make one big map of flags, preferring CLI flags when present.
+-- Flags are simple: we just combine CLI flags with config flags and make one
+-- big map of flags, preferring CLI flags when present.
 --
--- Raw targets can be a package name, a package name with component,
--- just a component, or a package name and version number. We first
--- must resolve these raw targets into both simple targets and
--- additional dependencies. This works as follows:
+-- Raw targets can be a package name, a package name with component, just a
+-- component, or a package name and version number. We first must resolve these
+-- raw targets into both simple targets and additional dependencies. This works
+-- as follows:
 --
--- * If a component is specified, find a unique project package which
---   defines that component, and convert it into a name+component
---   target.
+-- * If a component is specified, find a unique project package which defines
+--   that component, and convert it into a name+component target.
 --
--- * Ensure that all name+component values refer to valid components
---   in the given project package.
+-- * Ensure that all name+component values refer to valid components in the
+--   given project package.
 --
--- * For names, check if the name is present in the snapshot, local
---   deps, or project packages. If it is not, then look up the most
---   recent version in the package index and convert to a
---   name+version.
+-- * For names, check if the name is present in the snapshot, local deps, or
+--   project packages. If it is not, then look up the most recent version in the
+--   package index and convert to a name+version.
 --
--- * For name+version, first ensure that the name is not used by a
---   project package. Next, if that name+version is present in the
---   snapshot or local deps _and_ its location is PLIndex, we have the
---   package. Otherwise, add to local deps with the appropriate
---   PLIndex.
+-- * For name+version, first ensure that the name is not used by a project
+--   package. Next, if that name+version is present in the snapshot or local
+--   deps _and_ its location is PLIndex, we have the package. Otherwise, add to
+--   local deps with the appropriate PLIndex.
 --
--- If in either of the last two bullets we added a package to local
--- deps, print a warning to the user recommending modifying the
--- extra-deps.
+-- If in either of the last two bullets we added a package to local deps, print
+-- a warning to the user recommending modifying the extra-deps.
 --
--- Combine the various 'ResolveResults's together into 'Target'
--- values, by combining various components for a single package and
--- ensuring that no conflicting statements were made about targets.
+-- Combine the various 'ResolveResults's together into 'Target' values, by
+-- combining various components for a single package and ensuring that no
+-- conflicting statements were made about targets.
 --
--- At this point, we now have a Map from package name to SimpleTarget,
--- and an updated Map of local dependencies. We still have the
--- aggregated flags, and the snapshot and project packages.
+-- At this point, we now have a Map from package name to SimpleTarget, and an
+-- updated Map of local dependencies. We still have the aggregated flags, and
+-- the snapshot and project packages.
 --
--- Finally, we upgrade the snapshot by using
--- calculatePackagePromotion.
+-- Finally, we upgrade the snapshot by using calculatePackagePromotion.
 module Stack.Build.Target
   ( -- * Types
     Target (..)
@@ -74,41 +68,56 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import           Path
-import           Path.Extra ( rejectMissingDir )
-import           Path.IO
+import           Path ( isProperPrefixOf )
+import           Path.Extra ( forgivingResolveDir, rejectMissingDir )
+import           Path.IO ( getCurrentDir )
 import           RIO.Process ( HasProcessContext )
-import           Stack.SourceMap
+import           Stack.SourceMap ( additionalDepPackage )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.BuildOpts ( BuildOptsCLI (..) )
+import           Stack.Types.Config ( Config (..) )
 import           Stack.Types.NamedComponent
-import           Stack.Types.Build
+                   ( NamedComponent (..), renderComponent )
+import           Stack.Types.Build.Exception ( BuildPrettyException (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
 import           Stack.Types.SourceMap
+                   ( DepPackage (..), GlobalPackage (..), PackageType (..)
+                   , ProjectPackage, SMActual (..), SMTargets (..)
+                   , SMWanted (..), Target (..), ppComponents, ppRoot
+                   )
 
 -- | Do we need any targets? For example, `stack build` will fail if
 -- no targets are provided.
-data NeedTargets = NeedTargets | AllowNoTargets
+data NeedTargets
+  = NeedTargets
+  | AllowNoTargets
 
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 -- Get the RawInput
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 
 -- | Raw target information passed on the command line.
 newtype RawInput = RawInput { unRawInput :: Text }
 
-getRawInput :: BuildOptsCLI -> Map PackageName ProjectPackage -> ([Text], [RawInput])
+getRawInput ::
+     BuildOptsCLI
+  -> Map PackageName ProjectPackage
+  -> ([Text], [RawInput])
 getRawInput boptscli locals =
-    let textTargets' = boptsCLITargets boptscli
-        textTargets =
-            -- Handle the no targets case, which means we pass in the names of all project packages
-            if null textTargets'
-                then map (T.pack . packageNameString) (Map.keys locals)
-                else textTargets'
-     in (textTargets', map RawInput textTargets)
+  let textTargets' = boptsCLITargets boptscli
+      textTargets =
+        -- Handle the no targets case, which means we pass in the names of all
+        -- project packages
+        if null textTargets'
+          then map (T.pack . packageNameString) (Map.keys locals)
+          else textTargets'
+  in  (textTargets', map RawInput textTargets)
 
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 -- Turn RawInput into RawTarget
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 
 -- | The name of a component, which applies to executables, test
 -- suites, and benchmarks
@@ -117,326 +126,411 @@ -- | Either a fully resolved component, or a component name that could be
 -- either an executable, test, or benchmark
 data UnresolvedComponent
-    = ResolvedComponent !NamedComponent
-    | UnresolvedComponent !ComponentName
-    deriving (Show, Eq, Ord)
+  = ResolvedComponent !NamedComponent
+  | UnresolvedComponent !ComponentName
+  deriving (Eq, Ord, Show)
 
 -- | Raw command line input, without checking against any databases or list of
 -- locals. Does not deal with directories
 data RawTarget
-    = RTPackageComponent !PackageName !UnresolvedComponent
-    | RTComponent !ComponentName
-    | RTPackage !PackageName
-    -- Explicitly _not_ supporting revisions on the command line. If
-    -- you want that, you should be modifying your stack.yaml! (In
-    -- fact, you should probably do that anyway, we're just letting
-    -- people be lazy, since we're Haskeletors.)
-    | RTPackageIdentifier !PackageIdentifier
-  deriving (Show, Eq)
+  = RTPackageComponent !PackageName !UnresolvedComponent
+  | RTComponent !ComponentName
+  | RTPackage !PackageName
+    -- Explicitly _not_ supporting revisions on the command line. If you want
+    -- that, you should be modifying your stack.yaml! (In fact, you should
+    -- probably do that anyway, we're just letting people be lazy, since we're
+    -- Haskeletors.)
+  | RTPackageIdentifier !PackageIdentifier
+  deriving (Eq, Show)
 
 -- | Same as @parseRawTarget@, but also takes directories into account.
 parseRawTargetDirs :: MonadIO m
                    => Path Abs Dir -- ^ current directory
                    -> Map PackageName ProjectPackage
                    -> RawInput -- ^ raw target information from the commandline
-                   -> m (Either Text [(RawInput, RawTarget)])
+                   -> m (Either StyleDoc [(RawInput, RawTarget)])
 parseRawTargetDirs root locals ri =
-    case parseRawTarget t of
-        Just rt -> pure $ Right [(ri, rt)]
-        Nothing -> do
-            mdir <- liftIO $ forgivingAbsence (resolveDir root (T.unpack t))
-              >>= rejectMissingDir
-            case mdir of
-                Nothing -> pure $ Left $ "Directory not found: " `T.append` t
-                Just dir ->
-                    case mapMaybe (childOf dir) $ Map.toList locals of
-                        [] -> pure $ Left $
-                            "No local directories found as children of " `T.append`
-                            t
-                        names -> pure $ Right $ map ((ri, ) . RTPackage) names
-  where
-    childOf dir (name, pp) =
-        if dir == ppRoot pp || isProperPrefixOf dir (ppRoot pp)
-            then Just name
-            else Nothing
+  case parseRawTarget t of
+    Just rt -> pure $ Right [(ri, rt)]
+    Nothing -> do
+      mdir <- forgivingResolveDir root (T.unpack t) >>= rejectMissingDir
+      case mdir of
+        Nothing -> pure $ Left $
+          if | T.isPrefixOf "stack-yaml=" t -> projectOptionTypo
+             | T.isSuffixOf ".yaml" t -> projectYamlExtTypo
+             | otherwise ->
+                fillSep
+                  [ flow "Directory not found:"
+                  , style Dir (fromString $ T.unpack t) <> "."
+                  ]
+        Just dir ->
+          case mapMaybe (childOf dir) $ Map.toList locals of
+            [] -> pure $ Left $
+              fillSep
+                [ style Dir (fromString $ T.unpack t)
+                , flow "is not a local package directory and it is not a \
+                       \parent directory of any local package directory."
+                ]
+            names -> pure $ Right $ map ((ri, ) . RTPackage) names
+ where
+  childOf dir (name, pp) =
+    if dir == ppRoot pp || isProperPrefixOf dir (ppRoot pp)
+      then Just name
+      else Nothing
 
-    RawInput t = ri
+  RawInput t = ri
 
+  projectOptionTypo :: StyleDoc
+  projectOptionTypo = let o = "stack-yaml=" in projectTypo 2 (length o) o
+
+  projectYamlExtTypo :: StyleDoc
+  projectYamlExtTypo = let o = "stack-yaml " in projectTypo (2 + length o) 0 o
+
+  projectTypo :: Int -> Int -> String -> StyleDoc
+  projectTypo padLength dropLength option =
+    vsep
+      [ style Dir (fromString (replicate padLength ' ') <> fromString (T.unpack t))
+        <> " is not a directory."
+      , style Highlight (fromString $ "--" <> option)
+        <> style Dir (fromString . drop dropLength $ T.unpack t)
+        <> " might work as a project option."
+      ]
+
 -- | If this function returns @Nothing@, the input should be treated as a
 -- directory.
 parseRawTarget :: Text -> Maybe RawTarget
 parseRawTarget t =
-        (RTPackageIdentifier <$> parsePackageIdentifier s)
-    <|> (RTPackage <$> parsePackageName s)
-    <|> (RTComponent <$> T.stripPrefix ":" t)
-    <|> parsePackageComponent
-  where
-    s = T.unpack t
+      (RTPackageIdentifier <$> parsePackageIdentifier s)
+  <|> (RTPackage <$> parsePackageName s)
+  <|> (RTComponent <$> T.stripPrefix ":" t)
+  <|> parsePackageComponent
+ where
+  s = T.unpack t
 
-    parsePackageComponent =
-        case T.splitOn ":" t of
-            [pname, "lib"]
-                | Just pname' <- parsePackageName (T.unpack pname) ->
-                    Just $ RTPackageComponent pname' $ ResolvedComponent CLib
-            [pname, cname]
-                | Just pname' <- parsePackageName (T.unpack pname) ->
-                    Just $ RTPackageComponent pname' $ UnresolvedComponent cname
-            [pname, typ, cname]
-                | Just pname' <- parsePackageName (T.unpack pname)
-                , Just wrapper <- parseCompType typ ->
-                    Just $ RTPackageComponent pname' $ ResolvedComponent $ wrapper cname
-            _ -> Nothing
+  parsePackageComponent =
+    case T.splitOn ":" t of
+      [pname, "lib"]
+        | Just pname' <- parsePackageName (T.unpack pname) ->
+            Just $ RTPackageComponent pname' $ ResolvedComponent CLib
+      [pname, cname]
+        | Just pname' <- parsePackageName (T.unpack pname) ->
+            Just $ RTPackageComponent pname' $ UnresolvedComponent cname
+      [pname, typ, cname]
+        | Just pname' <- parsePackageName (T.unpack pname)
+        , Just wrapper <- parseCompType typ ->
+            Just $ RTPackageComponent pname' $ ResolvedComponent $ wrapper cname
+      _ -> Nothing
 
-    parseCompType t' =
-        case t' of
-            "exe" -> Just CExe
-            "test" -> Just CTest
-            "bench" -> Just CBench
-            _ -> Nothing
+  parseCompType t' =
+    case t' of
+      "exe" -> Just CExe
+      "test" -> Just CTest
+      "bench" -> Just CBench
+      _ -> Nothing
 
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 -- Resolve the raw targets
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 
 data ResolveResult = ResolveResult
   { rrName :: !PackageName
   , rrRaw :: !RawInput
   , rrComponent :: !(Maybe NamedComponent)
-  -- ^ Was a concrete component specified?
+    -- ^ Was a concrete component specified?
   , rrAddedDep :: !(Maybe PackageLocationImmutable)
-  -- ^ Only if we're adding this as a dependency
+    -- ^ Only if we're adding this as a dependency
   , rrPackageType :: !PackageType
   }
 
--- | Convert a 'RawTarget' into a 'ResolveResult' (see description on
--- the module).
+-- | Convert a 'RawTarget' into a 'ResolveResult' (see description on the
+-- module).
 resolveRawTarget ::
-       (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
-    => SMActual GlobalPackage
-    -> Map PackageName PackageLocation
-    -> (RawInput, RawTarget)
-    -> RIO env (Either Text ResolveResult)
+     (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
+  => SMActual GlobalPackage
+  -> Map PackageName PackageLocation
+  -> (RawInput, RawTarget)
+  -> RIO env (Either StyleDoc ResolveResult)
 resolveRawTarget sma allLocs (ri, rt) =
   go rt
-  where
-    locals = smaProject sma
-    deps = smaDeps sma
-    globals = smaGlobal sma
-    -- Helper function: check if a 'NamedComponent' matches the given 'ComponentName'
-    isCompNamed :: ComponentName -> NamedComponent -> Bool
-    isCompNamed _ CLib = False
-    isCompNamed t1 (CInternalLib t2) = t1 == t2
-    isCompNamed t1 (CExe t2) = t1 == t2
-    isCompNamed t1 (CTest t2) = t1 == t2
-    isCompNamed t1 (CBench t2) = t1 == t2
+ where
+  locals = smaProject sma
+  deps = smaDeps sma
+  globals = smaGlobal sma
+  -- Helper function: check if a 'NamedComponent' matches the given
+  -- 'ComponentName'
+  isCompNamed :: ComponentName -> NamedComponent -> Bool
+  isCompNamed _ CLib = False
+  isCompNamed t1 (CInternalLib t2) = t1 == t2
+  isCompNamed t1 (CExe t2) = t1 == t2
+  isCompNamed t1 (CTest t2) = t1 == t2
+  isCompNamed t1 (CBench t2) = t1 == t2
 
-    go (RTComponent cname) = do
-        -- Associated list from component name to package that defines
-        -- it. We use an assoc list and not a Map so we can detect
-        -- duplicates.
-        allPairs <- fmap concat $ flip Map.traverseWithKey locals
-          $ \name pp -> do
-              comps <- ppComponents pp
-              pure $ map (name, ) $ Set.toList comps
-        pure $ case filter (isCompNamed cname . snd) allPairs of
-                [] -> Left $ cname `T.append` " doesn't seem to be a local target. Run 'stack ide targets' for a list of available targets"
-                [(name, comp)] -> Right ResolveResult
-                  { rrName = name
-                  , rrRaw = ri
-                  , rrComponent = Just comp
-                  , rrAddedDep = Nothing
-                  , rrPackageType = PTProject
-                  }
-                matches -> Left $ T.concat
-                    [ "Ambiguous component name "
-                    , cname
-                    , ", matches: "
-                    , T.pack $ show matches
-                    ]
-    go (RTPackageComponent name ucomp) =
-        case Map.lookup name locals of
-            Nothing -> pure $ Left $ T.pack $ "Unknown local package: " ++ packageNameString name
-            Just pp -> do
-                comps <- ppComponents pp
-                pure $ case ucomp of
-                    ResolvedComponent comp
-                        | comp `Set.member` comps -> Right ResolveResult
-                            { rrName = name
-                            , rrRaw = ri
-                            , rrComponent = Just comp
-                            , rrAddedDep = Nothing
-                            , rrPackageType = PTProject
-                            }
-                        | otherwise -> Left $ T.pack $ concat
-                            [ "Component "
-                            , show comp
-                            , " does not exist in package "
-                            , packageNameString name
-                            ]
-                    UnresolvedComponent comp ->
-                        case filter (isCompNamed comp) $ Set.toList comps of
-                            [] -> Left $ T.concat
-                                [ "Component "
-                                , comp
-                                , " does not exist in package "
-                                , T.pack $ packageNameString name
-                                ]
-                            [x] -> Right ResolveResult
-                              { rrName = name
-                              , rrRaw = ri
-                              , rrComponent = Just x
-                              , rrAddedDep = Nothing
-                              , rrPackageType = PTProject
-                              }
-                            matches -> Left $ T.concat
-                                [ "Ambiguous component name "
-                                , comp
-                                , " for package "
-                                , T.pack $ packageNameString name
-                                , ": "
-                                , T.pack $ show matches
-                                ]
+  go (RTComponent cname) = do
+    -- Associated list from component name to package that defines it. We use an
+    -- assoc list and not a Map so we can detect duplicates.
+    allPairs <- fmap concat $ flip Map.traverseWithKey locals
+      $ \name pp -> do
+          comps <- ppComponents pp
+          pure $ map (name, ) $ Set.toList comps
+    pure $ case filter (isCompNamed cname . snd) allPairs of
+      [] -> Left $
+        fillSep
+          [ style Target . fromString . T.unpack $ cname
+          , flow "doesn't seem to be a local target. Run"
+          , style Shell $ flow "stack ide targets"
+          , flow "for a list of available targets."
+          ]
+      [(name, comp)] -> Right ResolveResult
+        { rrName = name
+        , rrRaw = ri
+        , rrComponent = Just comp
+        , rrAddedDep = Nothing
+        , rrPackageType = PTProject
+        }
+      matches -> Left $
+           fillSep
+             [ flow "Ambiguous component name"
+             , style Target (fromString $ T.unpack cname) <> ","
+             , "matches:"
+             ]
+        <> line
+        <> bulletedList
+             ( map
+                 ( \(pn, nc) -> fillSep
+                     [ "component"
+                     , style
+                         PkgComponent
+                         (fromString $ T.unpack $ renderComponent nc)
+                     , flow "of package"
+                     , style PkgComponent (fromString $ packageNameString pn)
+                     ]
+                 )
+                 matches
+             )
 
-    go (RTPackage name)
-      | Map.member name locals = pure $ Right ResolveResult
-          { rrName = name
-          , rrRaw = ri
-          , rrComponent = Nothing
-          , rrAddedDep = Nothing
-          , rrPackageType = PTProject
-          }
-      | Map.member name deps =
-          pure $ deferToConstructPlan name
-      | Just gp <- Map.lookup name globals =
-          case gp of
-              GlobalPackage _ -> pure $ deferToConstructPlan name
-              ReplacedGlobalPackage _ -> hackageLatest name
-      | otherwise = hackageLatest name
+  go (RTPackageComponent name ucomp) =
+    case Map.lookup name locals of
+      Nothing -> pure $ Left $
+        fillSep
+          [ flow "Unknown local package:"
+          , style Target (fromString $ packageNameString name) <> "."
+          ]
+      Just pp -> do
+        comps <- ppComponents pp
+        pure $ case ucomp of
+          ResolvedComponent comp
+            | comp `Set.member` comps -> Right ResolveResult
+                { rrName = name
+                , rrRaw = ri
+                , rrComponent = Just comp
+                , rrAddedDep = Nothing
+                , rrPackageType = PTProject
+                }
+            | otherwise -> Left $
+                fillSep
+                  [ "Component"
+                  , style Target (fromString $ T.unpack $ renderComponent comp)
+                  , flow "does not exist in package"
+                  , style Target (fromString $ packageNameString name) <> "."
+                  ]
+          UnresolvedComponent comp ->
+            case filter (isCompNamed comp) $ Set.toList comps of
+              [] -> Left $
+                fillSep
+                  [ "Component"
+                  , style Target (fromString $ T.unpack comp)
+                  , flow "does not exist in package"
+                  , style Target (fromString $ packageNameString name) <> "."
+                  ]
+              [x] -> Right ResolveResult
+                { rrName = name
+                , rrRaw = ri
+                , rrComponent = Just x
+                , rrAddedDep = Nothing
+                , rrPackageType = PTProject
+                }
+              matches -> Left $
+                fillSep
+                  [ flow "Ambiguous component name"
+                  , style Target (fromString $ T.unpack comp)
+                  , flow "for package"
+                  , style Target (fromString $ packageNameString name)
+                  , flow "matches components:"
+                  , fillSep $
+                      mkNarrativeList (Just PkgComponent) False
+                        (map ncToStyleDoc matches)
+                  ]
+   where
+    ncToStyleDoc :: NamedComponent -> StyleDoc
+    ncToStyleDoc = fromString . T.unpack . renderComponent
 
-    -- Note that we use getLatestHackageRevision below, even though it's
-    -- non-reproducible, to avoid user confusion. In any event,
-    -- reproducible builds should be done by updating your config
-    -- files!
+  go (RTPackage name)
+    | Map.member name locals = pure $ Right ResolveResult
+        { rrName = name
+        , rrRaw = ri
+        , rrComponent = Nothing
+        , rrAddedDep = Nothing
+        , rrPackageType = PTProject
+        }
+    | Map.member name deps =
+        pure $ deferToConstructPlan name
+    | Just gp <- Map.lookup name globals =
+        case gp of
+          GlobalPackage _ -> pure $ deferToConstructPlan name
+          ReplacedGlobalPackage _ -> hackageLatest name
+    | otherwise = hackageLatest name
 
-    go (RTPackageIdentifier ident@(PackageIdentifier name version))
-      | Map.member name locals = pure $ Left $ T.concat
-            [ tshow (packageNameString name)
-            , " target has a specific version number, but it is a local package."
-            , "\nTo avoid confusion, we will not install the specified version or build the local one."
-            , "\nTo build the local package, specify the target without an explicit version."
-            ]
-      | otherwise =
-          case Map.lookup name allLocs of
-            -- Installing it from the package index, so we're cool
-            -- with overriding it if necessary
-            Just (PLImmutable (PLIHackage (PackageIdentifier _name versionLoc) _cfKey _treeKey)) ->
+  -- Note that we use getLatestHackageRevision below, even though it's
+  -- non-reproducible, to avoid user confusion. In any event, reproducible
+  -- builds should be done by updating your config files!
+
+  go (RTPackageIdentifier ident@(PackageIdentifier name version))
+    | Map.member name locals = pure $ Left $
+        fillSep
+          [ style Target (fromString $ packageNameString name)
+          , flow "target has a specific version number, but it is a local \
+                 \package. To avoid confusion, we will not install the \
+                 \specified version or build the local one. To build the \
+                 \local package, specify the target without an explicit \
+                 \version."
+          ]
+    | otherwise =
+        case Map.lookup name allLocs of
+          -- Installing it from the package index, so we're cool with overriding
+          -- it if necessary
+          Just
+            ( PLImmutable
+                ( PLIHackage
+                    (PackageIdentifier _name versionLoc) _cfKey _treeKey
+                )
+            ) ->
               if version == versionLoc
-              then pure $ deferToConstructPlan name
-              else hackageLatestRevision name version
-            -- The package was coming from something besides the
-            -- index, so refuse to do the override
-            Just loc' -> pure $ Left $ T.concat
-              [ "Package with identifier was targeted on the command line: "
-              , T.pack $ packageIdentifierString ident
-              , ", but it was specified from a non-index location: "
-              , T.pack $ show loc'
-              , ".\nRecommendation: add the correctly desired version to extra-deps."
+                then pure $ deferToConstructPlan name
+                else hackageLatestRevision name version
+          -- The package was coming from something besides the index, so refuse
+          -- to do the override
+          Just loc' -> pure $ Left $
+            fillSep
+              [ flow "Package with identifier was targeted on the command \
+                     \line:"
+              , style Target (fromString $ packageIdentifierString ident) <> ","
+              , flow "but it was specified from a non-index location:"
+              , flow $ T.unpack $ textDisplay loc' <> "."
+              , flow "Recommendation: add the correctly desired version to \
+                     \extra-deps."
               ]
-            -- Not present at all, add it from Hackage
-            Nothing -> do
-              mrev <- getLatestHackageRevision YesRequireHackageIndex name version
-              pure $ case mrev of
-                Nothing -> deferToConstructPlan name
-                Just (_rev, cfKey, treeKey) -> Right ResolveResult
-                  { rrName = name
-                  , rrRaw = ri
-                  , rrComponent = Nothing
-                  , rrAddedDep = Just $ PLIHackage (PackageIdentifier name version) cfKey treeKey
-                  , rrPackageType = PTDependency
-                  }
+          -- Not present at all, add it from Hackage
+          Nothing -> do
+            mrev <- getLatestHackageRevision YesRequireHackageIndex name version
+            pure $ case mrev of
+              Nothing -> deferToConstructPlan name
+              Just (_rev, cfKey, treeKey) -> Right ResolveResult
+                { rrName = name
+                , rrRaw = ri
+                , rrComponent = Nothing
+                , rrAddedDep = Just $
+                    PLIHackage (PackageIdentifier name version) cfKey treeKey
+                , rrPackageType = PTDependency
+                }
 
-    hackageLatest name = do
-        mloc <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
-        pure $ case mloc of
-          Nothing -> deferToConstructPlan name
-          Just loc -> do
-            Right ResolveResult
-                  { rrName = name
-                  , rrRaw = ri
-                  , rrComponent = Nothing
-                  , rrAddedDep = Just loc
-                  , rrPackageType = PTDependency
-                  }
+  hackageLatest name = do
+    mloc <-
+      getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
+    pure $ case mloc of
+      Nothing -> deferToConstructPlan name
+      Just loc ->
+        Right ResolveResult
+          { rrName = name
+          , rrRaw = ri
+          , rrComponent = Nothing
+          , rrAddedDep = Just loc
+          , rrPackageType = PTDependency
+          }
 
-    hackageLatestRevision name version = do
-        mrev <- getLatestHackageRevision YesRequireHackageIndex name version
-        pure $ case mrev of
-          Nothing -> deferToConstructPlan name
-          Just (_rev, cfKey, treeKey) -> Right ResolveResult
-            { rrName = name
-            , rrRaw = ri
-            , rrComponent = Nothing
-            , rrAddedDep = Just $ PLIHackage (PackageIdentifier name version) cfKey treeKey
-            , rrPackageType = PTDependency
-            }
+  hackageLatestRevision name version = do
+    mrev <- getLatestHackageRevision YesRequireHackageIndex name version
+    pure $ case mrev of
+      Nothing -> deferToConstructPlan name
+      Just (_rev, cfKey, treeKey) -> Right ResolveResult
+        { rrName = name
+        , rrRaw = ri
+        , rrComponent = Nothing
+        , rrAddedDep =
+            Just $ PLIHackage (PackageIdentifier name version) cfKey treeKey
+        , rrPackageType = PTDependency
+        }
 
-    -- This is actually an error case. We _could_ pure a
-    -- Left value here, but it turns out to be better to defer
-    -- this until the ConstructPlan phase, and let it complain
-    -- about the missing package so that we get more errors
-    -- together, plus the fancy colored output from that
-    -- module.
-    deferToConstructPlan name = Right ResolveResult
-              { rrName = name
-              , rrRaw = ri
-              , rrComponent = Nothing
-              , rrAddedDep = Nothing
-              , rrPackageType = PTDependency
-              }
----------------------------------------------------------------------------------
+  -- This is actually an error case. We _could_ pure a Left value here, but it
+  -- turns out to be better to defer this until the ConstructPlan phase, and let
+  -- it complain about the missing package so that we get more errors together,
+  -- plus the fancy colored output from that module.
+  deferToConstructPlan name = Right ResolveResult
+    { rrName = name
+    , rrRaw = ri
+    , rrComponent = Nothing
+    , rrAddedDep = Nothing
+    , rrPackageType = PTDependency
+    }
+--------------------------------------------------------------------------------
 -- Combine the ResolveResults
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 
-combineResolveResults
-  :: forall env. HasLogFunc env
+combineResolveResults ::
+     forall env. HasLogFunc env
   => [ResolveResult]
-  -> RIO env ([Text], Map PackageName Target, Map PackageName PackageLocationImmutable)
+  -> RIO
+       env
+       ( [StyleDoc]
+       , Map PackageName Target
+       , Map PackageName PackageLocationImmutable
+       )
 combineResolveResults results = do
-    addedDeps <- fmap Map.unions $ forM results $ \result ->
-      case rrAddedDep result of
-        Nothing -> pure Map.empty
-        Just pl -> do
-          pure $ Map.singleton (rrName result) pl
-
-    let m0 = Map.unionsWith (++) $ map (\rr -> Map.singleton (rrName rr) [rr]) results
-        (errs, ms) = partitionEithers $ flip map (Map.toList m0) $ \(name, rrs) ->
-            let mcomps = map rrComponent rrs in
-            -- Confirm that there is either exactly 1 with no component, or
-            -- that all rrs are components
-            case rrs of
-                [] -> assert False $ Left "Somehow got no rrComponent values, that can't happen"
-                [rr] | isNothing (rrComponent rr) -> Right $ Map.singleton name $ TargetAll $ rrPackageType rr
-                _
-                  | all isJust mcomps -> Right $ Map.singleton name $ TargetComps $ Set.fromList $ catMaybes mcomps
-                  | otherwise -> Left $ T.concat
-                      [ "The package "
-                      , T.pack $ packageNameString name
-                      , " was specified in multiple, incompatible ways: "
-                      , T.unwords $ map (unRawInput . rrRaw) rrs
-                      ]
+  addedDeps <- fmap Map.unions $ forM results $ \result ->
+    case rrAddedDep result of
+      Nothing -> pure Map.empty
+      Just pl -> pure $ Map.singleton (rrName result) pl
 
-    pure (errs, Map.unions ms, addedDeps)
+  let m0 = Map.unionsWith (++) $
+        map (\rr -> Map.singleton (rrName rr) [rr]) results
+      (errs, ms) = partitionEithers $ flip map (Map.toList m0) $
+        \(name, rrs) ->
+          let mcomps = map rrComponent rrs in
+          -- Confirm that there is either exactly 1 with no component, or that
+          -- all rrs are components
+          case rrs of
+            [] -> assert False $
+              Left $
+                flow "Somehow got no rrComponent values, that can't happen."
+            [rr] | isNothing (rrComponent rr) ->
+              Right $ Map.singleton name $ TargetAll $ rrPackageType rr
+            _
+              | all isJust mcomps ->
+                  Right $ Map.singleton name $ TargetComps $ Set.fromList $
+                    catMaybes mcomps
+              | otherwise -> Left $ fillSep
+                  [ flow "The package"
+                  , style Target $ fromString $ packageNameString name
+                  , flow "was specified in multiple, incompatible ways:"
+                  , fillSep $
+                      mkNarrativeList (Just Target) False
+                        (map rrToStyleDoc rrs)
+                  ]
+  pure (errs, Map.unions ms, addedDeps)
+ where
+  rrToStyleDoc :: ResolveResult -> StyleDoc
+  rrToStyleDoc = fromString . T.unpack . unRawInput . rrRaw
 
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 -- OK, let's do it!
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 
-parseTargets :: HasBuildConfig env
-    => NeedTargets
-    -> Bool
-    -> BuildOptsCLI
-    -> SMActual GlobalPackage
-    -> RIO env SMTargets
+parseTargets ::
+     HasBuildConfig env
+  => NeedTargets
+  -> Bool
+  -> BuildOptsCLI
+  -> SMActual GlobalPackage
+  -> RIO env SMTargets
 parseTargets needTargets haddockDeps boptscli smActual = do
   logDebug "Parsing the targets"
   bconfig <- view buildConfigL
@@ -456,18 +550,27 @@ 
   case concat [errs1, errs2, errs3] of
     [] -> pure ()
-    errs -> throwIO $ TargetParseException errs
+    errs -> prettyThrowIO $ TargetParseException errs
 
   case (Map.null targets, needTargets) of
     (False, _) -> pure ()
     (True, AllowNoTargets) -> pure ()
     (True, NeedTargets)
-      | null textTargets' && bcImplicitGlobal bconfig -> throwIO $ TargetParseException
-          ["The specified targets matched no packages.\nPerhaps you need to run 'stack init'?"]
-      | null textTargets' && Map.null locals -> throwIO $ TargetParseException
-          ["The project contains no local packages (packages not marked with 'extra-dep')"]
-      | otherwise -> throwIO $ TargetParseException
-          ["The specified targets matched no packages"]
+      | null textTargets' && bcImplicitGlobal bconfig ->
+          prettyThrowIO $ TargetParseException
+            [ fillSep
+                [ flow "The specified targets matched no packages. Perhaps you \
+                       \need to run"
+                , style Shell (flow "stack init") <> "?"
+                ]
+            ]
+      | null textTargets' && Map.null locals ->
+          prettyThrowIO $ TargetParseException
+            [ flow "The project contains no local packages (packages not \
+                   \marked with 'extra-dep')."
+            ]
+      | otherwise -> prettyThrowIO $ TargetParseException
+          [ flow "The specified targets matched no packages." ]
 
   addedDeps' <- mapM (additionalDepPackage haddockDeps . PLImmutable) addedDeps
 
@@ -475,9 +578,9 @@     { smtTargets = targets
     , smtDeps = addedDeps'
     }
-  where
-    bcImplicitGlobal bconfig =
-      case configProject $ bcConfig bconfig of
-        PCProject _ -> False
-        PCGlobalProject -> True
-        PCNoProject _ -> False
+ where
+  bcImplicitGlobal bconfig =
+    case configProject $ bcConfig bconfig of
+      PCProject _ -> False
+      PCGlobalProject -> True
+      PCNoProject _ -> False
src/Stack/BuildPlan.hs view
@@ -1,11 +1,7 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
 {-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Resolving a build plan for a set of packages in a given Stackage
 -- snapshot.
@@ -21,29 +17,44 @@     , showItems
     ) where
 
-import           Stack.Prelude hiding (Display (..))
 import qualified Data.Foldable as F
-import qualified Data.Set as Set
 import           Data.List (intercalate)
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Distribution.Package as C
-import           Distribution.PackageDescription (GenericPackageDescription,
-                                                  flagDefault, flagManual,
-                                                  flagName, genPackageFlags)
+import           Distribution.PackageDescription
+                   ( GenericPackageDescription, flagDefault, flagName
+                   , flagManual, genPackageFlags
+                   )
 import qualified Distribution.PackageDescription as C
-import           Distribution.System (Platform)
-import           Distribution.Text (display)
-import           Distribution.Types.UnqualComponentName (unUnqualComponentName)
+import           Distribution.System ( Platform )
+import           Distribution.Text ( display )
+import           Distribution.Types.UnqualComponentName
+                   ( unUnqualComponentName )
 import qualified Distribution.Version as C
-import           Stack.Constants
+import           Stack.Constants ( wiredInPackages )
 import           Stack.Package
+                   ( PackageConfig (..), packageDependencies
+                   , pdpModifiedBuildable, resolvePackageDescription
+                   )
+import           Stack.Prelude hiding ( Display (..) )
 import           Stack.SourceMap
-import           Stack.Types.SourceMap
-import           Stack.Types.Version
-import           Stack.Types.Config
+                   ( SnapshotCandidate, loadProjectSnapshotCandidate )
 import           Stack.Types.Compiler
+                   ( ActualCompiler, WhichCompiler (..), compilerVersionText
+                   , whichCompiler
+                   )
+import           Stack.Types.Config ( HasConfig )
+import           Stack.Types.GHCVariant ( HasGHCVariant )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..)
+                   , GlobalPackageVersion (..), ProjectPackage (..)
+                   , SMActual (..)
+                   )
+import           Stack.Types.Version ( VersionRange, withinRange )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.BuildPlan" module.
@@ -64,7 +75,8 @@         , "Non existing resolver: " ++ snapName' ++ "."
         , "For a complete list of available snapshots see https://www.stackage.org/snapshots"
         ]
-      where snapName' = show snapName
+      where
+        snapName' = show snapName
     displayException (UnknownPackages stackYaml unknown shadowed) =
         "Error: [S-7571]\n"
         ++ unlines (unknown' ++ shadowed')
@@ -147,8 +159,8 @@     where
         toPair (C.PackageIdentifier name version) = (name, version)
 
-gpdPackageDeps
-    :: GenericPackageDescription
+gpdPackageDeps ::
+       GenericPackageDescription
     -> ActualCompiler
     -> Platform
     -> Map FlagName Bool
@@ -188,11 +200,11 @@     where
         removeSame f1 f2 =
             let diff v v' = if v == v' then Nothing else Just v
-            in Just $ Map.differenceWith diff f1 f2
+            in  Just $ Map.differenceWith diff f1 f2
 
         gpdDefaultFlags gpd =
             let tuples = map getDefault (C.genPackageFlags gpd)
-            in Map.singleton (gpdPackageName gpd) (Map.fromList tuples)
+            in  Map.singleton (gpdPackageName gpd) (Map.fromList tuples)
 
         getDefault f
             | C.flagDefault f = (C.flagName f, True)
@@ -202,8 +214,8 @@ -- @GenericPackageDescription@ to compile against the given @BuildPlan@. Will
 -- only modify non-manual flags, and will prefer default values for flags.
 -- Returns the plan which produces least number of dep errors
-selectPackageBuildPlan
-    :: Platform
+selectPackageBuildPlan ::
+       Platform
     -> ActualCompiler
     -> Map PackageName Version
     -> GenericPackageDescription
@@ -218,13 +230,15 @@             | nErrors p1 == 0 = p1
             | nErrors p1 <= nErrors p2 = p1
             | otherwise = p2
-          where nErrors = Map.size . snd
+          where
+            nErrors = Map.size . snd
 
     -- Avoid exponential complexity in flag combinations making us sad pandas.
     -- See: https://github.com/commercialhaskell/stack/issues/543
     limitSearchSpace :: NonEmpty a -> NonEmpty a
     limitSearchSpace (x :| xs) = x :| take (maxFlagCombinations - 1) xs
-      where maxFlagCombinations = 128
+     where
+      maxFlagCombinations = 128
 
     makePlan :: [(FlagName, Bool)] -> (Map PackageName (Map FlagName Bool), DepErrors)
     makePlan flags = checkPackageBuildPlan platform compiler pool (Map.fromList flags) gpd
@@ -237,12 +251,13 @@             | flagManual f = (fname, flagDefault f) :| []
             | flagDefault f = (fname, True) :| [(fname, False)]
             | otherwise = (fname, False) :| [(fname, True)]
-          where fname = flagName f
+          where
+            fname = flagName f
 
 -- | Check whether with the given set of flags a package's dependency
 -- constraints can be satisfied against a given build plan or pool of packages.
-checkPackageBuildPlan
-    :: Platform
+checkPackageBuildPlan ::
+       Platform
     -> ActualCompiler
     -> Map PackageName Version
     -> Map FlagName Bool
@@ -258,8 +273,8 @@ -- | Checks if the given package dependencies can be satisfied by the given set
 -- of packages. Will fail if a package is either missing or has a version
 -- outside of the version range.
-checkPackageDeps
-    :: PackageName -- ^ package using dependencies, for constructing DepErrors
+checkPackageDeps ::
+       PackageName -- ^ package using dependencies, for constructing DepErrors
     -> Map PackageName VersionRange -- ^ dependency constraints
     -> Map PackageName Version -- ^ Available package pool or index
     -> DepErrors
@@ -284,7 +299,8 @@ data DepError = DepError
     { deVersion :: !(Maybe Version)
     , deNeededBy :: !(Map PackageName VersionRange)
-    } deriving Show
+    }
+    deriving Show
 
 -- | Combine two 'DepError's for the same 'Version'.
 combineDepError :: DepError -> DepError -> DepError
@@ -295,8 +311,8 @@ -- build and an available package pool (snapshot) check whether the bundle's
 -- dependencies can be satisfied. If flags is passed as Nothing flag settings
 -- will be chosen automatically.
-checkBundleBuildPlan
-    :: Platform
+checkBundleBuildPlan ::
+       Platform
     -> ActualCompiler
     -> Map PackageName Version
     -> Maybe (Map PackageName (Map FlagName Bool))
@@ -330,7 +346,7 @@     compare (Map.size e2) (Map.size e1)
 compareBuildPlanCheck (BuildPlanCheckFail _ e1 _) (BuildPlanCheckFail _ e2 _) =
     let numUserPkgs e = Map.size $ Map.unions (Map.elems (fmap deNeededBy e))
-    in compare (numUserPkgs e2) (numUserPkgs e1)
+    in  compare (numUserPkgs e2) (numUserPkgs e1)
 compareBuildPlanCheck BuildPlanCheckOk{}      BuildPlanCheckOk{}      = EQ
 compareBuildPlanCheck BuildPlanCheckOk{}      BuildPlanCheckPartial{} = GT
 compareBuildPlanCheck BuildPlanCheckOk{}      BuildPlanCheckFail{}    = GT
@@ -345,8 +361,8 @@ -- | Check a set of 'GenericPackageDescription's and a set of flags against a
 -- given snapshot. Returns how well the snapshot satisfies the dependencies of
 -- the packages.
-checkSnapBuildPlan
-    :: (HasConfig env, HasGHCVariant env)
+checkSnapBuildPlan ::
+       (HasConfig env, HasGHCVariant env)
     => [ResolvedPath Dir]
     -> Maybe (Map PackageName (Map FlagName Bool))
     -> SnapshotCandidate env
@@ -371,7 +387,7 @@ 
     if Map.null errs then
         pure $ BuildPlanCheckOk f
-    else if Map.null cerrs then do
+    else if Map.null cerrs then
             pure $ BuildPlanCheckPartial f errs
         else
             pure $ BuildPlanCheckFail f cerrs compiler
@@ -385,8 +401,8 @@ 
 -- | Find a snapshot and set of flags that is compatible with and matches as
 -- best as possible with the given 'GenericPackageDescription's.
-selectBestSnapshot
-    :: (HasConfig env, HasGHCVariant env)
+selectBestSnapshot ::
+       (HasConfig env, HasGHCVariant env)
     => [ResolvedPath Dir]
     -> NonEmpty SnapName
     -> RIO env (SnapshotCandidate env, RawSnapshotLocation, BuildPlanCheck)
@@ -469,8 +485,8 @@ showMapPackages :: Map PackageName a -> Text
 showMapPackages mp = showItems $ map packageNameString $ Map.keys mp
 
-showCompilerErrors
-    :: Map PackageName (Map FlagName Bool)
+showCompilerErrors ::
+       Map PackageName (Map FlagName Bool)
     -> DepErrors
     -> ActualCompiler
     -> Text
src/Stack/Clean.hs view
@@ -1,14 +1,12 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE ConstraintKinds    #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts   #-}
 {-# LANGUAGE OverloadedStrings  #-}
 
--- | Clean a project.
+-- | Types and functions related to Stack's @clean@ and @purge@ commands.
 module Stack.Clean
-  ( clean
-  , CleanOpts (..)
+  ( CleanOpts (..)
   , CleanCommand (..)
+  , cleanCmd
+  , clean
   ) where
 
 import           Data.List ( (\\), intercalate )
@@ -17,75 +15,83 @@ import           Stack.Config ( withBuildConfig )
 import           Stack.Constants.Config ( rootDistDirFromDir, workDirFromDir )
 import           Stack.Prelude
-import           Stack.Types.Config
-import           Stack.Types.SourceMap
+import           Stack.Runners ( ShouldReexec (..), withConfig )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), getProjectWorkDir )
+import           Stack.Types.Config ( Config )
+import           Stack.Types.Runner ( Runner )
+import           Stack.Types.SourceMap ( SMWanted (..), ppRoot )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Clean" module.
 data CleanException
-    = NonLocalPackages [PackageName]
-    | DeletionFailures [(Path Abs Dir, SomeException)]
-    deriving (Show, Typeable)
+  = NonLocalPackages [PackageName]
+  | DeletionFailures [(Path Abs Dir, SomeException)]
+  deriving (Show, Typeable)
 
 instance Exception CleanException where
-    displayException (NonLocalPackages pkgs) = concat
-        [ "Error: [S-9463]\n"
-        , "The following packages are not part of this project: "
-        , intercalate ", " (map show pkgs)
-        ]
-    displayException (DeletionFailures failures) = concat
-        [ "Error: [S-6321]\n"
-        , "Exception while recursively deleting:\n"
-        , concatMap (\(dir, e) ->
-            toFilePath dir <> "\n" <> displayException e <> "\n") failures
-        , "Perhaps you do not have permission to delete these files or they \
-          \are in use?"
-        ]
+  displayException (NonLocalPackages pkgs) = concat
+    [ "Error: [S-9463]\n"
+    , "The following packages are not part of this project: "
+    , intercalate ", " (map show pkgs)
+    ]
+  displayException (DeletionFailures failures) = concat
+    [ "Error: [S-6321]\n"
+    , "Exception while recursively deleting:\n"
+    , concatMap (\(dir, e) ->
+        toFilePath dir <> "\n" <> displayException e <> "\n") failures
+    , "Perhaps you do not have permission to delete these files or they are in \
+      \use?"
+    ]
 
+-- | Type representing command line options for the @stack clean@ command.
+data CleanOpts
+  = CleanShallow [PackageName]
+    -- ^ Delete the "dist directories" as defined in
+    -- 'Stack.Constants.Config.distRelativeDir' for the given local packages. If
+    -- no packages are given, all project packages should be cleaned.
+  | CleanFull
+    -- ^ Delete all work directories in the project.
+
+-- | Type representing Stack's cleaning commands.
+data CleanCommand
+    = Clean
+    | Purge
+
+-- | Function underlying the @stack clean@ command.
+cleanCmd :: CleanOpts -> RIO Runner ()
+cleanCmd = withConfig NoReexec . clean
+
 -- | Deletes build artifacts in the current project.
 clean :: CleanOpts -> RIO Config ()
 clean cleanOpts = do
-    toDelete <- withBuildConfig $ dirsToDelete cleanOpts
-    logDebug $ "Need to delete: " <> fromString (show (map toFilePath toDelete))
-    failures <- catMaybes <$> mapM cleanDir toDelete
-    case failures of
-        [] -> pure ()
-        _  -> throwIO $ DeletionFailures failures
+  toDelete <- withBuildConfig $ dirsToDelete cleanOpts
+  logDebug $ "Need to delete: " <> fromString (show (map toFilePath toDelete))
+  failures <- catMaybes <$> mapM cleanDir toDelete
+  case failures of
+    [] -> pure ()
+    _  -> throwIO $ DeletionFailures failures
 
 cleanDir :: Path Abs Dir -> RIO Config (Maybe (Path Abs Dir, SomeException))
 cleanDir dir = do
-    logDebug $ "Deleting directory: " <> fromString (toFilePath dir)
-    liftIO (ignoringAbsence (removeDirRecur dir) >> pure Nothing) `catchAny` \ex ->
-      pure $ Just (dir, ex)
+  logDebug $ "Deleting directory: " <> fromString (toFilePath dir)
+  liftIO (ignoringAbsence (removeDirRecur dir) >> pure Nothing) `catchAny` \ex ->
+    pure $ Just (dir, ex)
 
 dirsToDelete :: CleanOpts -> RIO BuildConfig [Path Abs Dir]
 dirsToDelete cleanOpts = do
-    packages <- view $ buildConfigL.to (smwProject . bcSMWanted)
-    case cleanOpts of
-        CleanShallow [] ->
-            -- Filter out packages listed as extra-deps
-            mapM (rootDistDirFromDir . ppRoot) $ Map.elems packages
-        CleanShallow targets -> do
-            let localPkgNames = Map.keys packages
-                getPkgDir pkgName' = fmap ppRoot (Map.lookup pkgName' packages)
-            case targets \\ localPkgNames of
-                [] -> mapM rootDistDirFromDir (mapMaybe getPkgDir targets)
-                xs -> throwM (NonLocalPackages xs)
-        CleanFull -> do
-            pkgWorkDirs <- mapM (workDirFromDir . ppRoot) $ Map.elems packages
-            projectWorkDir <- getProjectWorkDir
-            pure (projectWorkDir : pkgWorkDirs)
-
--- | Options for @stack clean@.
-data CleanOpts
-    = CleanShallow [PackageName]
-    -- ^ Delete the "dist directories" as defined in 'Stack.Constants.Config.distRelativeDir'
-    -- for the given local packages. If no packages are given, all project packages
-    -- should be cleaned.
-    | CleanFull
-    -- ^ Delete all work directories in the project.
-
--- | Clean commands
-data CleanCommand
-    = Clean
-    | Purge
+  packages <- view $ buildConfigL.to (smwProject . bcSMWanted)
+  case cleanOpts of
+    CleanShallow [] ->
+      -- Filter out packages listed as extra-deps
+      mapM (rootDistDirFromDir . ppRoot) $ Map.elems packages
+    CleanShallow targets -> do
+      let localPkgNames = Map.keys packages
+          getPkgDir pkgName' = fmap ppRoot (Map.lookup pkgName' packages)
+      case targets \\ localPkgNames of
+        [] -> mapM rootDistDirFromDir (mapMaybe getPkgDir targets)
+        xs -> throwM (NonLocalPackages xs)
+    CleanFull -> do
+      pkgWorkDirs <- mapM (workDirFromDir . ppRoot) $ Map.elems packages
+      projectWorkDir <- getProjectWorkDir
+      pure (projectWorkDir : pkgWorkDirs)
src/Stack/ComponentFile.hs view
@@ -1,10 +1,6 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
 
 -- | A module which exports all component-level file-gathering logic. It also
 -- includes utility functions for handling paths and directories.
@@ -29,24 +25,34 @@ import qualified Data.Text as T
 import           Distribution.ModuleName ( ModuleName )
 import qualified Distribution.ModuleName as Cabal
-import           Distribution.Package
-                   hiding
-                     ( Module, Package, PackageIdentifier, packageName
-                     , packageVersion
-                     )
-import           Distribution.PackageDescription hiding ( FlagName )
+import           Distribution.PackageDescription
+                   ( Benchmark (..), BenchmarkInterface (..), BuildInfo (..)
+                   , Executable (..), Library (..), TestSuite (..)
+                   , TestSuiteInterface (..)
+                   )
 import           Distribution.Text ( display )
 import           Distribution.Utils.Path ( getSymbolicPath )
 import           Distribution.Version ( mkVersion )
 import qualified HiFileParser as Iface
-import           Path as FL hiding ( replaceExtension )
+import           Path
+                   ( (</>), filename, isProperPrefixOf, parent, parseRelDir
+                   , stripProperPrefix
+                   )
 import           Path.Extra
-import           Path.IO hiding ( findFiles )
+                   ( forgivingResolveDir, forgivingResolveFile
+                   , parseCollapsedAbsFile, rejectMissingDir, rejectMissingFile
+                   )
+import           Path.IO
+                   ( doesDirExist, doesFileExist, getCurrentDir, listDir )
 import           Stack.Constants
+                   ( haskellDefaultPreprocessorExts, haskellFileExts
+                   , relDirAutogen, relDirBuild, relDirGlobalAutogen
+                   )
 import           Stack.Prelude hiding ( Display (..) )
 import           Stack.Types.Config
-import           Stack.Types.NamedComponent
-import           Stack.Types.Package
+                   ( Config (..), HasConfig (..), prettyStackDevL )
+import           Stack.Types.NamedComponent ( NamedComponent (..) )
+import           Stack.Types.Package ( PackageException (..), dotCabalModule )
 import           Stack.Types.PackageFile
                    ( GetPackageFileContext (..), DotCabalDescriptor (..)
                    , DotCabalPath (..), PackageWarning (..)
@@ -55,13 +61,13 @@ import qualified System.FilePath as FilePath
 
 -- | Get all files referenced by the benchmark.
-benchmarkFiles
-  :: NamedComponent
+benchmarkFiles ::
+     NamedComponent
   -> Benchmark
   -> RIO
        GetPackageFileContext
        (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-benchmarkFiles component bench = do
+benchmarkFiles component bench =
   resolveComponentFiles component build names
  where
   names = bnames <> exposed
@@ -73,13 +79,13 @@   build = benchmarkBuildInfo bench
 
 -- | Get all files referenced by the test.
-testFiles
-  :: NamedComponent
+testFiles ::
+     NamedComponent
   -> TestSuite
   -> RIO
        GetPackageFileContext
        (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-testFiles component test = do
+testFiles component test =
   resolveComponentFiles component build names
  where
   names = bnames <> exposed
@@ -92,13 +98,13 @@   build = testBuildInfo test
 
 -- | Get all files referenced by the executable.
-executableFiles
-  :: NamedComponent
+executableFiles ::
+     NamedComponent
   -> Executable
   -> RIO
        GetPackageFileContext
        (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-executableFiles component exe = do
+executableFiles component exe =
   resolveComponentFiles component build names
  where
   build = buildInfo exe
@@ -107,13 +113,13 @@     [DotCabalMain (modulePath exe)]
 
 -- | Get all files referenced by the library.
-libraryFiles
-  :: NamedComponent
+libraryFiles ::
+     NamedComponent
   -> Library
   -> RIO
        GetPackageFileContext
        (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-libraryFiles component lib = do
+libraryFiles component lib =
   resolveComponentFiles component build names
  where
   build = libBuildInfo lib
@@ -122,8 +128,8 @@   bnames = map DotCabalModule (otherModules build)
 
 -- | Get all files referenced by the component.
-resolveComponentFiles
-  :: NamedComponent
+resolveComponentFiles ::
+     NamedComponent
   -> BuildInfo
   -> [DotCabalDescriptor]
   -> RIO
@@ -152,8 +158,8 @@ -- looking for unique instances of base names applied with the given
 -- extensions, plus find any of their module and TemplateHaskell
 -- dependencies.
-resolveFilesAndDeps
-  :: NamedComponent       -- ^ Package component name
+resolveFilesAndDeps ::
+     NamedComponent       -- ^ Package component name
   -> [Path Abs Dir]       -- ^ Directories to look in.
   -> [DotCabalDescriptor] -- ^ Base names.
   -> RIO
@@ -194,13 +200,12 @@           foundModules `M.difference`
           M.fromList (mapMaybe (fmap (, ()) . dotCabalModule) names0)
     pure $
-      if M.null unlistedModules
-        then []
-        else [ UnlistedModulesWarning
-                   component
-                   (map fst (M.toList unlistedModules))
-             ]
-  warnMissing _missingModules = do
+      [ UnlistedModulesWarning
+          component
+          (map fst (M.toList unlistedModules))
+      | not (M.null unlistedModules)
+      ]
+  warnMissing _missingModules =
     pure []
       -- TODO: bring this back - see
       -- https://github.com/commercialhaskell/stack/issues/2649
@@ -216,15 +221,15 @@       -}
   -- TODO: In usages of toResolvedModule / toMissingModule, some sort
   -- of map + partition would probably be better.
-  toResolvedModule
-    :: (DotCabalDescriptor, Maybe DotCabalPath)
+  toResolvedModule ::
+       (DotCabalDescriptor, Maybe DotCabalPath)
     -> Maybe (ModuleName, Path Abs File)
   toResolvedModule (DotCabalModule mn, Just (DotCabalModulePath fp)) =
     Just (mn, fp)
   toResolvedModule _ =
     Nothing
-  toMissingModule
-    :: (DotCabalDescriptor, Maybe DotCabalPath)
+  toMissingModule ::
+       (DotCabalDescriptor, Maybe DotCabalPath)
     -> Maybe ModuleName
   toMissingModule (DotCabalModule mn, Nothing) =
     Just mn
@@ -232,8 +237,8 @@     Nothing
 
 -- | Get the dependencies of a Haskell module file.
-getDependencies
-  :: NamedComponent
+getDependencies ::
+     NamedComponent
   -> [Path Abs Dir]
   -> DotCabalPath
   -> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
@@ -261,14 +266,15 @@           else pure (S.empty, [])
 
 -- | Parse a .hi file into a set of modules and files.
-parseHI
-  :: FilePath -> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
+parseHI ::
+     FilePath
+  -> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
 parseHI hiPath = do
   dir <- asks (parent . ctxFile)
   result <-
     liftIO $ catchAnyDeep
       (Iface.fromFile hiPath)
-      (\e -> pure (Left (displayException e)))
+      (pure . Left . displayException)
   case result of
     Left msg -> do
       prettyStackDevL
@@ -282,9 +288,7 @@       let moduleNames = fmap (fromString . T.unpack . decodeUtf8Lenient . fst) .
                         Iface.unList . Iface.dmods . Iface.deps
           resolveFileDependency file = do
-            resolved <-
-              liftIO (forgivingAbsence (resolveFile dir file)) >>=
-                rejectMissingFile
+            resolved <- forgivingResolveFile dir file >>= rejectMissingFile
             when (isNothing resolved) $
               prettyWarnL
               [ flow "Dependent file listed in:"
@@ -314,17 +318,17 @@ -- | Try to resolve the list of base names in the given directory by
 -- looking for unique instances of base names applied with the given
 -- extensions.
-resolveFiles
-  :: [Path Abs Dir] -- ^ Directories to look in.
+resolveFiles ::
+     [Path Abs Dir] -- ^ Directories to look in.
   -> [DotCabalDescriptor] -- ^ Base names.
   -> RIO GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
 resolveFiles dirs names =
-  forM names (\name -> liftM (name, ) (findCandidate dirs name))
+  forM names (\name -> fmap (name, ) (findCandidate dirs name))
 
 -- | Find a candidate for the given module-or-filename from the list
 -- of directories and given extensions.
-findCandidate
-  :: [Path Abs Dir]
+findCandidate ::
+     [Path Abs Dir]
   -> DotCabalDescriptor
   -> RIO GetPackageFileContext (Maybe DotCabalPath)
 findCandidate dirs name = do
@@ -353,7 +357,7 @@       DotCabalCFile{} -> DotCabalCFilePath
   paths_pkg pkg = "Paths_" ++ packageNameString pkg
   makeNameCandidates haskellPreprocessorExts =
-    liftM
+    fmap
       (nubOrd . concat)
       (mapM (makeDirCandidates haskellPreprocessorExts) dirs)
   makeDirCandidates :: [Text]
@@ -388,13 +392,9 @@ --
 -- For example: .erb for a Ruby file might exist in one of the
 -- directories.
-logPossibilities
-  :: HasTerm env
-  => [Path Abs Dir]
-  -> ModuleName
-  -> RIO env ()
+logPossibilities :: HasTerm env => [Path Abs Dir] -> ModuleName -> RIO env ()
 logPossibilities dirs mn = do
-  possibilities <- liftM concat (makePossibilities mn)
+  possibilities <- fmap concat (makePossibilities mn)
   unless (null possibilities) $ prettyWarnL
     [ flow "Unable to find a known candidate for the Cabal entry"
     , (style Module . fromString $ display mn) <> ","
@@ -444,8 +444,8 @@ 
 -- | Resolve file as a child of a specified directory, symlinks
 -- don't get followed.
-resolveDirFile
-  :: (MonadIO m, MonadThrow m)
+resolveDirFile ::
+     (MonadIO m, MonadThrow m)
   => Path Abs Dir -> FilePath.FilePath -> m (Maybe (Path Abs File))
 resolveDirFile x y = do
   -- The standard canonicalizePath does not work for this case
@@ -455,8 +455,8 @@ 
 -- | Warn the user that multiple candidates are available for an
 -- entry, but that we picked one anyway and continued.
-warnMultiple
-  :: DotCabalDescriptor
+warnMultiple ::
+     DotCabalDescriptor
   -> Path b t
   -> [Path b t]
   -> RIO GetPackageFileContext ()
@@ -486,7 +486,7 @@     Nothing -> throwM $ CabalFileNameInvalidPackageName $ toFilePath fp
     Just x -> pure x
  where
-  clean = liftM reverse . strip . reverse
+  clean = fmap reverse . strip . reverse
   strip ('l':'a':'b':'a':'c':'.':xs) = pure xs
   strip _ = throwM (CabalFileNameParseFail (toFilePath fp))
 
@@ -496,7 +496,7 @@                  -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
 resolveDirOrWarn = resolveOrWarn "Directory" f
  where
-  f p x = liftIO (forgivingAbsence (resolveDir p x)) >>= rejectMissingDir
+  f p x = forgivingResolveDir p x >>= rejectMissingDir
 
 -- | Make the global autogen dir if Cabal version is new enough.
 packageAutogenDir :: Version -> Path Abs Dir -> Maybe (Path Abs Dir)
@@ -545,8 +545,8 @@   when (isNothing result) $ warnMissingFile subject cwd path file
   pure result
 
-warnMissingFile
-  :: Text
+warnMissingFile ::
+     Text
   -> Path Abs Dir
   -> FilePath
   -> Path Abs File
src/Stack/Config.hs view
@@ -1,984 +1,1086 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-
--- | The general Stack configuration that starts everything off. This should
--- be smart to fallback if there is no stack.yaml, instead relying on
--- whatever files are available.
---
--- If there is no stack.yaml, and there is a cabal.config, we
--- read in those constraints, and if there's a cabal.sandbox.config,
--- we read any constraints from there and also find the package
--- database from there, etc. And if there's nothing, we should
--- probably default to behaving like cabal, possibly with spitting out
--- a warning that "you should run `stk init` to make things better".
-module Stack.Config
-  ( loadConfig
-  , loadConfigYaml
-  , packagesParser
-  , getImplicitGlobalProjectDir
-  , getSnapshots
-  , makeConcreteResolver
-  , checkOwnership
-  , getInContainer
-  , getInNixShell
-  , defaultConfigYaml
-  , getProjectConfig
-  , withBuildConfig
-  , withNewLogFunc
-  ) where
-
-import           Control.Monad.Extra ( firstJustM )
-import           Data.Array.IArray ( (!), (//) )
-import qualified Data.ByteString as S
-import           Data.ByteString.Builder ( byteString )
-import           Data.Coerce ( coerce )
-import qualified Data.IntMap as IntMap
-import qualified Data.Map as Map
-import qualified Data.Map.Merge.Strict as MS
-import qualified Data.Monoid
-import           Data.Monoid.Map ( MonoidMap (..) )
-import qualified Data.Text as T
-import qualified Data.Yaml as Yaml
-import           Distribution.System
-                   ( Arch (OtherArch), OS (..), Platform (..), buildPlatform )
-import qualified Distribution.Text
-import           Distribution.Version ( simplifyVersionRange )
-import           GHC.Conc ( getNumProcessors )
-import           Network.HTTP.StackClient
-                   ( httpJSON, parseUrlThrow, getResponseBody )
-import           Options.Applicative ( Parser, help, long, metavar, strOption )
-import           Pantry.Internal.AesonExtended
-import           Path
-import           Path.Extra ( toFilePathNoTrailingSep )
-import           Path.Find ( findInParents )
-import           Path.IO
-import           RIO.List ( unzip )
-import           RIO.Process
-import           RIO.Time ( toGregorian )
-import           Stack.Build.Haddock ( shouldHaddockDeps )
-import           Stack.Config.Build
-import           Stack.Config.Docker
-import           Stack.Config.Nix
-import           Stack.Constants
-import           Stack.Lock ( lockCachedWanted )
-import           Stack.Prelude
-import           Stack.SourceMap
-import           Stack.Storage.Project ( initProjectStorage )
-import           Stack.Storage.User ( initUserStorage )
-import           Stack.Storage.Util ( handleMigrationException )
-import           Stack.Types.Build
-import           Stack.Types.Compiler
-import           Stack.Types.Config
-import           Stack.Types.Docker
-import           Stack.Types.Nix
-import           Stack.Types.Resolver
-import           Stack.Types.SourceMap
-import           Stack.Types.Version
-                   ( IntersectingVersionRange (..), VersionCheck (..)
-                   , stackVersion, withinRange
-                   )
-import           System.Console.ANSI
-                   ( hSupportsANSIWithoutEmulation, setSGRCode )
-import           System.Environment
-import           System.Info.ShortPathName ( getShortPathName )
-import           System.PosixCompat.Files ( fileOwner, getFileStatus )
-import           System.Posix.User ( getEffectiveUserID )
-
--- | If deprecated path exists, use it and print a warning.
--- Otherwise, return the new path.
-tryDeprecatedPath ::
-       HasLogFunc env
-    => Maybe T.Text -- ^ Description of file for warning (if Nothing, no deprecation warning is displayed)
-    -> (Path Abs a -> RIO env Bool) -- ^ Test for existence
-    -> Path Abs a -- ^ New path
-    -> Path Abs a -- ^ Deprecated path
-    -> RIO env (Path Abs a, Bool) -- ^ (Path to use, whether it already exists)
-tryDeprecatedPath mWarningDesc exists new old = do
-    newExists <- exists new
-    if newExists
-        then pure (new, True)
-        else do
-            oldExists <- exists old
-            if oldExists
-                then do
-                    case mWarningDesc of
-                        Nothing -> pure ()
-                        Just desc ->
-                            logWarn $
-                                "Warning: Location of " <> display desc <> " at '" <>
-                                fromString (toFilePath old) <>
-                                "' is deprecated; rename it to '" <>
-                                fromString (toFilePath new) <>
-                                "' instead"
-                    pure (old, True)
-                else pure (new, False)
-
--- | Get the location of the implicit global project directory.
--- If the directory already exists at the deprecated location, its location is returned.
--- Otherwise, the new location is returned.
-getImplicitGlobalProjectDir ::
-       HasLogFunc env
-    => Config -> RIO env (Path Abs Dir)
-getImplicitGlobalProjectDir config =
-    --TEST no warning printed
-    liftM fst $ tryDeprecatedPath
-        Nothing
-        doesDirExist
-        (implicitGlobalProjectDir stackRoot)
-        (implicitGlobalProjectDirDeprecated stackRoot)
-  where
-    stackRoot = view stackRootL config
-
--- | Download the 'Snapshots' value from stackage.org.
-getSnapshots :: HasConfig env => RIO env Snapshots
-getSnapshots = do
-    latestUrlText <- askLatestSnapshotUrl
-    latestUrl <- parseUrlThrow (T.unpack latestUrlText)
-    logDebug $ "Downloading snapshot versions file from " <> display latestUrlText
-    result <- httpJSON latestUrl
-    logDebug "Done downloading and parsing snapshot versions file"
-    pure $ getResponseBody result
-
--- | Turn an 'AbstractResolver' into a 'Resolver'.
-makeConcreteResolver ::
-       HasConfig env
-    => AbstractResolver
-    -> RIO env RawSnapshotLocation
-makeConcreteResolver (ARResolver r) = pure r
-makeConcreteResolver ar = do
-    r <-
-        case ar of
-            ARGlobal -> do
-                config <- view configL
-                implicitGlobalDir <- getImplicitGlobalProjectDir config
-                let fp = implicitGlobalDir </> stackDotYaml
-                iopc <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp
-                ProjectAndConfigMonoid project _ <- liftIO iopc
-                pure $ projectResolver project
-            ARLatestNightly -> RSLSynonym . Nightly . snapshotsNightly <$> getSnapshots
-            ARLatestLTSMajor x -> do
-                snapshots <- getSnapshots
-                case IntMap.lookup x $ snapshotsLts snapshots of
-                    Nothing -> throwIO $ NoLTSWithMajorVersion x
-                    Just y -> pure $ RSLSynonym $ LTS x y
-            ARLatestLTS -> do
-                snapshots <- getSnapshots
-                if IntMap.null $ snapshotsLts snapshots
-                   then throwIO NoLTSFound
-                   else let (x, y) = IntMap.findMax $ snapshotsLts snapshots
-                        in pure $ RSLSynonym $ LTS x y
-    logInfo $ "Selected resolver: " <> display r
-    pure r
-
--- | Get the latest snapshot resolver available.
-getLatestResolver :: HasConfig env => RIO env RawSnapshotLocation
-getLatestResolver = do
-    snapshots <- getSnapshots
-    let mlts = uncurry LTS <$>
-               listToMaybe (reverse (IntMap.toList (snapshotsLts snapshots)))
-    pure $ RSLSynonym $ fromMaybe (Nightly (snapshotsNightly snapshots)) mlts
-
--- Interprets ConfigMonoid options.
-configFromConfigMonoid ::
-       HasRunner env
-    => Path Abs Dir -- ^ Stack root, e.g. ~/.stack
-    -> Path Abs File -- ^ user config file path, e.g. ~/.stack/config.yaml
-    -> Maybe AbstractResolver
-    -> ProjectConfig (Project, Path Abs File)
-    -> ConfigMonoid
-    -> (Config -> RIO env a)
-    -> RIO env a
-configFromConfigMonoid
-    configStackRoot configUserConfigPath configResolver
-    configProject ConfigMonoid{..} inner = do
-     -- If --stack-work is passed, prefer it. Otherwise, if STACK_WORK
-     -- is set, use that. If neither, use the default ".stack-work"
-     mstackWorkEnv <- liftIO $ lookupEnv stackWorkEnvVar
-     let mproject =
-           case configProject of
-             PCProject pair -> Just pair
-             PCGlobalProject -> Nothing
-             PCNoProject _deps -> Nothing
-         configAllowLocals =
-           case configProject of
-             PCProject _ -> True
-             PCGlobalProject -> True
-             PCNoProject _ -> False
-     configWorkDir0 <- maybe (pure relDirStackWork) (liftIO . parseRelDir) mstackWorkEnv
-     let configWorkDir = fromFirst configWorkDir0 configMonoidWorkDir
-         configLatestSnapshot = fromFirst
-           "https://s3.amazonaws.com/haddock.stackage.org/snapshots.json"
-           configMonoidLatestSnapshot
-         clConnectionCount = fromFirst 8 configMonoidConnectionCount
-         configHideTHLoading = fromFirstTrue configMonoidHideTHLoading
-         configPrefixTimestamps = fromFirst False configMonoidPrefixTimestamps
-
-         configGHCVariant = getFirst configMonoidGHCVariant
-         configCompilerRepository = fromFirst
-            defaultCompilerRepository
-            configMonoidCompilerRepository
-         configGHCBuild = getFirst configMonoidGHCBuild
-         configInstallGHC = fromFirstTrue configMonoidInstallGHC
-         configSkipGHCCheck = fromFirstFalse configMonoidSkipGHCCheck
-         configSkipMsys = fromFirstFalse configMonoidSkipMsys
-
-         configExtraIncludeDirs = configMonoidExtraIncludeDirs
-         configExtraLibDirs = configMonoidExtraLibDirs
-         configCustomPreprocessorExts = configMonoidCustomPreprocessorExts
-         configOverrideGccPath = getFirst configMonoidOverrideGccPath
-
-         -- Only place in the codebase where platform is hard-coded. In theory
-         -- in the future, allow it to be configured.
-         (Platform defArch defOS) = buildPlatform
-         arch = fromMaybe defArch
-              $ getFirst configMonoidArch >>= Distribution.Text.simpleParse
-         os = defOS
-         configPlatform = Platform arch os
-
-         configRequireStackVersion = simplifyVersionRange (getIntersectingVersionRange configMonoidRequireStackVersion)
-
-         configCompilerCheck = fromFirst MatchMinor configMonoidCompilerCheck
-
-     case arch of
-         OtherArch "aarch64" -> pure ()
-         OtherArch unk -> logWarn $ "Warning: Unknown value for architecture setting: " <> displayShow unk
-         _ -> pure ()
-
-     configPlatformVariant <- liftIO $
-         maybe PlatformVariantNone PlatformVariant <$> lookupEnv platformVariantEnvVar
-
-     let configBuild = buildOptsFromMonoid configMonoidBuildOpts
-     configDocker <-
-         dockerOptsFromMonoid (fmap fst mproject) configResolver configMonoidDockerOpts
-     configNix <- nixOptsFromMonoid configMonoidNixOpts os
-
-     configSystemGHC <-
-         case (getFirst configMonoidSystemGHC, nixEnable configNix) of
-             (Just False, True) ->
-                 throwM NixRequiresSystemGhc
-             _ ->
-                 pure
-                     (fromFirst
-                         (dockerEnable configDocker || nixEnable configNix)
-                         configMonoidSystemGHC)
-
-     when (isJust configGHCVariant && configSystemGHC) $
-         throwM ManualGHCVariantSettingsAreIncompatibleWithSystemGHC
-
-     rawEnv <- liftIO getEnvironment
-     pathsEnv <- either throwM pure
-               $ augmentPathMap (map toFilePath configMonoidExtraPath)
-                                (Map.fromList (map (T.pack *** T.pack) rawEnv))
-     origEnv <- mkProcessContext pathsEnv
-     let configProcessContextSettings _ = pure origEnv
-
-     configLocalProgramsBase <- case getFirst configMonoidLocalProgramsBase of
-       Nothing -> getDefaultLocalProgramsBase configStackRoot configPlatform origEnv
-       Just path -> pure path
-     let localProgramsFilePath = toFilePath configLocalProgramsBase
-     when (osIsWindows && ' ' `elem` localProgramsFilePath) $ do
-       ensureDir configLocalProgramsBase
-       -- getShortPathName returns the long path name when a short name does not
-       -- exist.
-       shortLocalProgramsFilePath <-
-         liftIO $ getShortPathName localProgramsFilePath
-       when (' ' `elem` shortLocalProgramsFilePath) $ do
-         logError $ "Error: [S-8432]\n"<>
-           "Stack's 'programs' path contains a space character and has no " <>
-           "alternative short ('8 dot 3') name. This will cause problems " <>
-           "with packages that use the GNU project's 'configure' shell " <>
-           "script. Use the 'local-programs-path' configuration option to " <>
-           "specify an alternative path. The current path is: " <>
-           display (T.pack localProgramsFilePath)
-     platformOnlyDir <- runReaderT platformOnlyRelDir (configPlatform, configPlatformVariant)
-     let configLocalPrograms = configLocalProgramsBase </> platformOnlyDir
-
-     configLocalBin <-
-         case getFirst configMonoidLocalBinPath of
-             Nothing -> do
-                 localDir <- getAppUserDataDir "local"
-                 pure $ localDir </> relDirBin
-             Just userPath ->
-                 (case mproject of
-                     -- Not in a project
-                     Nothing -> resolveDir' userPath
-                     -- Resolves to the project dir and appends the user path if it is relative
-                     Just (_, configYaml) -> resolveDir (parent configYaml) userPath)
-                 -- TODO: Either catch specific exceptions or add a
-                 -- parseRelAsAbsDirMaybe utility and use it along with
-                 -- resolveDirMaybe.
-                 `catchAny`
-                 const (throwIO (NoSuchDirectory userPath))
-
-     configJobs <-
-        case getFirst configMonoidJobs of
-            Nothing -> liftIO getNumProcessors
-            Just i -> pure i
-     let configConcurrentTests = fromFirst True configMonoidConcurrentTests
-
-     let configTemplateParams = configMonoidTemplateParameters
-         configScmInit = getFirst configMonoidScmInit
-         configCabalConfigOpts = coerce configMonoidCabalConfigOpts
-         configGhcOptionsByName = coerce configMonoidGhcOptionsByName
-         configGhcOptionsByCat = coerce configMonoidGhcOptionsByCat
-         configSetupInfoLocations = configMonoidSetupInfoLocations
-         configSetupInfoInline = configMonoidSetupInfoInline
-         configPvpBounds = fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds
-         configModifyCodePage = fromFirstTrue configMonoidModifyCodePage
-         configRebuildGhcOptions = fromFirstFalse configMonoidRebuildGhcOptions
-         configApplyGhcOptions = fromFirst AGOLocals configMonoidApplyGhcOptions
-         configAllowNewer = fromFirst False configMonoidAllowNewer
-         configAllowNewerDeps = coerce configMonoidAllowNewerDeps
-         configDefaultTemplate = getFirst configMonoidDefaultTemplate
-         configDumpLogs = fromFirst DumpWarningLogs configMonoidDumpLogs
-         configSaveHackageCreds = fromFirst True configMonoidSaveHackageCreds
-         configHackageBaseUrl = fromFirst "https://hackage.haskell.org/" configMonoidHackageBaseUrl
-         configHideSourcePaths = fromFirstTrue configMonoidHideSourcePaths
-         configRecommendUpgrade = fromFirstTrue configMonoidRecommendUpgrade
-         configNoRunCompile = fromFirstFalse configMonoidNoRunCompile
-
-     configAllowDifferentUser <-
-        case getFirst configMonoidAllowDifferentUser of
-            Just True -> pure True
-            _ -> getInContainer
-
-     configRunner' <- view runnerL
-
-     useAnsi <- liftIO $ fromMaybe True <$>
-                         hSupportsANSIWithoutEmulation stderr
-
-     let stylesUpdate' = (configRunner' ^. stylesUpdateL) <>
-           configMonoidStyles
-         useColor' = runnerUseColor configRunner'
-         mUseColor = do
-            colorWhen <- getFirst configMonoidColorWhen
-            pure $ case colorWhen of
-                ColorNever  -> False
-                ColorAlways -> True
-                ColorAuto  -> useAnsi
-         useColor'' = fromMaybe useColor' mUseColor
-         configRunner'' = configRunner'
-               & processContextL .~ origEnv
-               & stylesUpdateL .~ stylesUpdate'
-               & useColorL .~ useColor''
-         go = runnerGlobalOpts configRunner'
-
-     pic <-
-         case getFirst configMonoidPackageIndex of
-             Nothing ->
-                 case getFirst configMonoidPackageIndices of
-                     Nothing -> pure defaultPackageIndexConfig
-                     Just [pic] -> do
-                         logWarn $ fromString packageIndicesWarning
-                         pure pic
-                     Just x -> throwIO $ MultiplePackageIndices x
-             Just pic -> pure pic
-     mpantryRoot <- liftIO $ lookupEnv pantryRootEnvVar
-     pantryRoot <-
-       case mpantryRoot of
-         Just dir ->
-           case parseAbsDir dir of
-             Nothing -> throwIO $ ParseAbsolutePathException pantryRootEnvVar dir
-             Just x -> pure x
-         Nothing -> pure $ configStackRoot </> relDirPantry
-
-     let snapLoc =
-            case getFirst configMonoidSnapshotLocation of
-                Nothing -> defaultSnapshotLocation
-                Just addr -> customSnapshotLocation
-                                where
-                    customSnapshotLocation (LTS x y) =
-                        mkRSLUrl $ addr'
-                            <> "/lts/" <> display x
-                            <> "/" <> display y <> ".yaml"
-                    customSnapshotLocation (Nightly date) =
-                        let (year, month, day) = toGregorian date
-                        in mkRSLUrl $ addr'
-                            <> "/nightly/"
-                            <> display year
-                            <> "/" <> display month
-                            <> "/" <> display day <> ".yaml"
-                    mkRSLUrl builder = RSLUrl (utf8BuilderToText builder) Nothing
-                    addr' = display $ T.dropWhileEnd (=='/') addr
-
-     let configStackDeveloperMode = fromFirst stackDeveloperModeDefault configMonoidStackDeveloperMode
-
-     withNewLogFunc go useColor'' stylesUpdate' $ \logFunc -> do
-       let configRunner = configRunner'' & logFuncL .~ logFunc
-       withLocalLogFunc logFunc $ handleMigrationException $
-         withPantryConfig
-           pantryRoot
-           pic
-           (maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack)
-           clConnectionCount
-           (fromFirst defaultCasaRepoPrefix configMonoidCasaRepoPrefix)
-           defaultCasaMaxPerRequest
-           snapLoc
-           (\configPantryConfig -> initUserStorage
-             (configStackRoot </> relFileStorage)
-             (\configUserStorage -> inner Config {..}))
-
--- | Runs the provided action with the given 'LogFunc' in the environment
-withLocalLogFunc :: HasLogFunc env => LogFunc -> RIO env a -> RIO env a
-withLocalLogFunc logFunc = local (set logFuncL logFunc)
-
--- | Runs the provided action with a new 'LogFunc', given a 'StylesUpdate'.
-withNewLogFunc :: MonadUnliftIO m
-               => GlobalOpts
-               -> Bool  -- ^ Use color
-               -> StylesUpdate
-               -> (LogFunc -> m a)
-               -> m a
-withNewLogFunc go useColor (StylesUpdate update) inner = do
-  logOptions0 <- logOptionsHandle stderr False
-  let logOptions
-        = setLogUseColor useColor
-        $ setLogLevelColors logLevelColors
-        $ setLogSecondaryColor secondaryColor
-        $ setLogAccentColors (const highlightColor)
-        $ setLogUseTime (globalTimeInLog go)
-        $ setLogMinLevel (globalLogLevel go)
-        $ setLogVerboseFormat (globalLogLevel go <= LevelDebug)
-        $ setLogTerminal (globalTerminal go)
-          logOptions0
-  withLogFunc logOptions inner
- where
-  styles = defaultStyles // update
-  logLevelColors :: LogLevel -> Utf8Builder
-  logLevelColors level =
-    fromString $ setSGRCode $ snd $ styles ! logLevelToStyle level
-  secondaryColor = fromString $ setSGRCode $ snd $ styles ! Secondary
-  highlightColor = fromString $ setSGRCode $ snd $ styles ! Highlight
-
--- | Get the default location of the local programs directory.
-getDefaultLocalProgramsBase :: MonadThrow m
-                            => Path Abs Dir
-                            -> Platform
-                            -> ProcessContext
-                            -> m (Path Abs Dir)
-getDefaultLocalProgramsBase configStackRoot configPlatform override =
-    case configPlatform of
-      -- For historical reasons, on Windows a subdirectory of LOCALAPPDATA is
-      -- used instead of a subdirectory of STACK_ROOT. Unifying the defaults would
-      -- mean that Windows users would manually have to move data from the old
-      -- location to the new one, which is undesirable.
-        Platform _ Windows -> do
-            let envVars = view envVarsL override
-            case T.unpack <$> Map.lookup "LOCALAPPDATA" envVars of
-                Just t -> case parseAbsDir t of
-                    Nothing ->
-                        throwM $ ParseAbsolutePathException "LOCALAPPDATA" t
-                    Just lad ->
-                        pure $ lad </> relDirUpperPrograms </>
-                               relDirStackProgName
-                Nothing -> pure defaultBase
-        _ -> pure defaultBase
-  where
-    defaultBase = configStackRoot </> relDirPrograms
-
--- | Load the configuration, using current directory, environment variables,
--- and defaults as necessary.
-loadConfig :: HasRunner env => (Config -> RIO env a) -> RIO env a
-loadConfig inner = do
-    mstackYaml <- view $ globalOptsL.to globalStackYaml
-    mproject <- loadProjectConfig mstackYaml
-    mresolver <- view $ globalOptsL.to globalResolver
-    configArgs <- view $ globalOptsL.to globalConfigMonoid
-    (configRoot, stackRoot, userOwnsStackRoot) <- determineStackRootAndOwnership configArgs
-
-    let (mproject', addConfigMonoid) =
-          case mproject of
-            PCProject (proj, fp, cm) -> (PCProject (proj, fp), (cm:))
-            PCGlobalProject -> (PCGlobalProject, id)
-            PCNoProject deps -> (PCNoProject deps, id)
-
-    userConfigPath <- getDefaultUserConfigPath configRoot
-    extraConfigs0 <- getExtraConfigs userConfigPath >>=
-        mapM (\file -> loadConfigYaml (parseConfigMonoid (parent file)) file)
-    let extraConfigs =
-          -- non-project config files' existence of a docker section should never default docker
-          -- to enabled, so make it look like they didn't exist
-          map (\c -> c {configMonoidDockerOpts =
-                            (configMonoidDockerOpts c) {dockerMonoidDefaultEnable = Any False}})
-              extraConfigs0
-
-    let withConfig =
-          configFromConfigMonoid
-            stackRoot
-            userConfigPath
-            mresolver
-            mproject'
-            (mconcat $ configArgs : addConfigMonoid extraConfigs)
-
-    withConfig $ \config -> do
-      unless (stackVersion `withinRange` configRequireStackVersion config)
-          (throwM (BadStackVersionException (configRequireStackVersion config)))
-      unless (configAllowDifferentUser config) $ do
-          unless userOwnsStackRoot $
-              throwM (UserDoesn'tOwnDirectory stackRoot)
-          forM_ (configProjectRoot config) $ \dir ->
-              checkOwnership (dir </> configWorkDir config)
-      inner config
-
--- | Load the build configuration, adds build-specific values to config loaded by @loadConfig@.
--- values.
-withBuildConfig ::
-     RIO BuildConfig a
-  -> RIO Config a
-withBuildConfig inner = do
-    config <- ask
-
-    -- If provided, turn the AbstractResolver from the command line
-    -- into a Resolver that can be used below.
-
-    -- The configResolver and mcompiler are provided on the command
-    -- line. In order to properly deal with an AbstractResolver, we
-    -- need a base directory (to deal with custom snapshot relative
-    -- paths). We consider the current working directory to be the
-    -- correct base. Let's calculate the mresolver first.
-    mresolver <- forM (configResolver config) $ \aresolver -> do
-      logDebug ("Using resolver: " <> display aresolver <> " specified on command line")
-      makeConcreteResolver aresolver
-
-    (project', stackYamlFP) <- case configProject config of
-      PCProject (project, fp) -> do
-          forM_ (projectUserMsg project) (logWarn . fromString)
-          pure (project, fp)
-      PCNoProject extraDeps -> do
-          p <-
-            case mresolver of
-              Nothing -> throwIO NoResolverWhenUsingNoProject
-              Just _ -> getEmptyProject mresolver extraDeps
-          pure (p, configUserConfigPath config)
-      PCGlobalProject -> do
-            logDebug "Run from outside a project, using implicit global project config"
-            destDir <- getImplicitGlobalProjectDir config
-            let dest :: Path Abs File
-                dest = destDir </> stackDotYaml
-                dest' :: FilePath
-                dest' = toFilePath dest
-            ensureDir destDir
-            exists <- doesFileExist dest
-            if exists
-               then do
-                   iopc <- loadConfigYaml (parseProjectAndConfigMonoid destDir) dest
-                   ProjectAndConfigMonoid project _ <- liftIO iopc
-                   when (view terminalL config) $
-                       case configResolver config of
-                           Nothing ->
-                               logDebug $
-                                 "Using resolver: " <>
-                                 display (projectResolver project) <>
-                                 " from implicit global project's config file: " <>
-                                 fromString dest'
-                           Just _ -> pure ()
-                   pure (project, dest)
-               else do
-                   logInfo ("Writing implicit global project config file to: " <> fromString dest')
-                   logInfo "Note: You can change the snapshot via the resolver field there."
-                   p <- getEmptyProject mresolver []
-                   liftIO $ do
-                       writeBinaryFileAtomic dest $ byteString $ S.concat
-                           [ "# This is the implicit global project's config file, which is only used when\n"
-                           , "# 'stack' is run outside of a real project. Settings here do _not_ act as\n"
-                           , "# defaults for all projects. To change Stack's default settings, edit\n"
-                           , "# '", encodeUtf8 (T.pack $ toFilePath $ configUserConfigPath config), "' instead.\n"
-                           , "#\n"
-                           , "# For more information about Stack's configuration, see\n"
-                           , "# http://docs.haskellstack.org/en/stable/yaml_configuration/\n"
-                           , "#\n"
-                           , Yaml.encode p]
-                       writeBinaryFileAtomic (parent dest </> relFileReadmeTxt) $
-                           "This is the implicit global project, which is " <>
-                           "used only when 'stack' is run\noutside of a " <>
-                           "real project.\n"
-                   pure (p, dest)
-    mcompiler <- view $ globalOptsL.to globalCompiler
-    let project = project'
-            { projectCompiler = mcompiler <|> projectCompiler project'
-            , projectResolver = fromMaybe (projectResolver project') mresolver
-            }
-    extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project)
-
-    wanted <- lockCachedWanted stackYamlFP (projectResolver project) $
-        fillProjectWanted stackYamlFP config project
-
-    -- Unfortunately redoes getProjectWorkDir, since we don't have a BuildConfig yet
-    workDir <- view workDirL
-    let projectStorageFile = parent stackYamlFP </> workDir </> relFileStorage
-
-    initProjectStorage projectStorageFile $ \projectStorage -> do
-      let bc = BuildConfig
-            { bcConfig = config
-            , bcSMWanted = wanted
-            , bcExtraPackageDBs = extraPackageDBs
-            , bcStackYaml = stackYamlFP
-            , bcCurator = projectCurator project
-            , bcProjectStorage = projectStorage
-            }
-      runRIO bc inner
-  where
-    getEmptyProject :: Maybe RawSnapshotLocation -> [PackageIdentifierRevision] -> RIO Config Project
-    getEmptyProject mresolver extraDeps = do
-      r <- case mresolver of
-            Just resolver -> do
-                logInfo ("Using resolver: " <> display resolver <> " specified on command line")
-                pure resolver
-            Nothing -> do
-                r'' <- getLatestResolver
-                logInfo ("Using latest snapshot resolver: " <> display r'')
-                pure r''
-      pure Project
-        { projectUserMsg = Nothing
-        , projectPackages = []
-        , projectDependencies = map (RPLImmutable . flip RPLIHackage Nothing) extraDeps
-        , projectFlags = mempty
-        , projectResolver = r
-        , projectCompiler = Nothing
-        , projectExtraPackageDBs = []
-        , projectCurator = Nothing
-        , projectDropPackages = mempty
-        }
-
-fillProjectWanted ::
-       (HasProcessContext env, HasLogFunc env, HasPantryConfig env)
-    => Path Abs t
-    -> Config
-    -> Project
-    -> Map RawPackageLocationImmutable PackageLocationImmutable
-    -> WantedCompiler
-    -> Map PackageName (Bool -> RIO env DepPackage)
-    -> RIO env (SMWanted, [CompletedPLI])
-fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages = do
-    let bopts = configBuild config
-
-    packages0 <- for (projectPackages project) $ \fp@(RelFilePath t) -> do
-      abs' <- resolveDir (parent stackYamlFP) (T.unpack t)
-      let resolved = ResolvedPath fp abs'
-      pp <- mkProjectPackage YesPrintWarnings resolved (boptsHaddock bopts)
-      pure (cpName $ ppCommon pp, pp)
-
-    -- prefetch git repos to avoid cloning per subdirectory
-    -- see https://github.com/commercialhaskell/stack/issues/5411
-    let gitRepos = mapMaybe (\case
-                              (RPLImmutable (RPLIRepo repo rpm)) -> Just (repo, rpm)
-                              _ -> Nothing) (projectDependencies project)
-    logDebug ("Prefetching git repos: " <> display (T.pack (show gitRepos)))
-    fetchReposRaw gitRepos
-
-    (deps0, mcompleted) <- fmap unzip . forM (projectDependencies project) $ \rpl -> do
-      (pl, mCompleted) <- case rpl of
-         RPLImmutable rpli -> do
-           (compl, mcompl) <-
-             case Map.lookup rpli locCache of
-               Just compl -> pure (compl, Just compl)
-               Nothing -> do
-                 cpl <- completePackageLocation rpli
-                 if cplHasCabalFile cpl
-                   then pure (cplComplete cpl, Just $ cplComplete cpl)
-                   else do
-                     warnMissingCabalFile rpli
-                     pure (cplComplete cpl, Nothing)
-           pure (PLImmutable compl, CompletedPLI rpli <$> mcompl)
-         RPLMutable p ->
-           pure (PLMutable p, Nothing)
-      dp <- additionalDepPackage (shouldHaddockDeps bopts) pl
-      pure ((cpName $ dpCommon dp, dp), mCompleted)
-
-    checkDuplicateNames $
-      map (second (PLMutable . ppResolvedDir)) packages0 ++
-      map (second dpLocation) deps0
-
-    let packages1 = Map.fromList packages0
-        snPackages = snapPackages
-          `Map.difference` packages1
-          `Map.difference` Map.fromList deps0
-          `Map.withoutKeys` projectDropPackages project
-
-    snDeps <- for snPackages $ \getDep -> getDep (shouldHaddockDeps bopts)
-
-    let deps1 = Map.fromList deps0 `Map.union` snDeps
-
-    let mergeApply m1 m2 f =
-          MS.merge MS.preserveMissing MS.dropMissing (MS.zipWithMatched f) m1 m2
-        pFlags = projectFlags project
-        packages2 = mergeApply packages1 pFlags $
-          \_ p flags -> p{ppCommon=(ppCommon p){cpFlags=flags}}
-        deps2 = mergeApply deps1 pFlags $
-          \_ d flags -> d{dpCommon=(dpCommon d){cpFlags=flags}}
-
-    checkFlagsUsedThrowing pFlags FSStackYaml packages1 deps1
-
-    let pkgGhcOptions = configGhcOptionsByName config
-        deps = mergeApply deps2 pkgGhcOptions $
-          \_ d options -> d{dpCommon=(dpCommon d){cpGhcOptions=options}}
-        packages = mergeApply packages2 pkgGhcOptions $
-          \_ p options -> p{ppCommon=(ppCommon p){cpGhcOptions=options}}
-        unusedPkgGhcOptions = pkgGhcOptions `Map.restrictKeys` Map.keysSet packages2
-          `Map.restrictKeys` Map.keysSet deps2
-
-    unless (Map.null unusedPkgGhcOptions) $
-      throwM $ InvalidGhcOptionsSpecification (Map.keys unusedPkgGhcOptions)
-
-    let wanted = SMWanted
-          { smwCompiler = fromMaybe snapCompiler (projectCompiler project)
-          , smwProject = packages
-          , smwDeps = deps
-          , smwSnapshotLocation = projectResolver project
-          }
-
-    pure (wanted, catMaybes mcompleted)
-
-
--- | Check if there are any duplicate package names and, if so, throw an
--- exception.
-checkDuplicateNames :: MonadThrow m => [(PackageName, PackageLocation)] -> m ()
-checkDuplicateNames locals =
-    case filter hasMultiples $ Map.toList $ Map.fromListWith (++) $ map (second pure) locals of
-        [] -> pure ()
-        x -> throwM $ DuplicateLocalPackageNames x
-  where
-    hasMultiples (_, _:_:_) = True
-    hasMultiples _ = False
-
-
--- | Get the Stack root, e.g. @~/.stack@, and determine whether the user owns it.
---
--- On Windows, the second value is always 'True'.
-determineStackRootAndOwnership
-    :: (MonadIO m)
-    => ConfigMonoid
-    -- ^ Parsed command-line arguments
-    -> m (Path Abs Dir, Path Abs Dir, Bool)
-determineStackRootAndOwnership clArgs = liftIO $ do
-    (configRoot, stackRoot) <- do
-        case getFirst (configMonoidStackRoot clArgs) of
-            Just x -> pure (x, x)
-            Nothing -> do
-                mstackRoot <- lookupEnv stackRootEnvVar
-                case mstackRoot of
-                    Nothing -> do
-                      wantXdg <- fromMaybe "" <$> lookupEnv stackXdgEnvVar
-                      if not (null wantXdg)
-                        then do
-                          xdgRelDir <- parseRelDir stackProgName
-                          (,)
-                            <$> getXdgDir XdgConfig (Just xdgRelDir)
-                            <*> getXdgDir XdgData (Just xdgRelDir)
-                        else do
-                          oldStyleRoot <- getAppUserDataDir stackProgName
-                          pure (oldStyleRoot, oldStyleRoot)
-                    Just x -> case parseAbsDir x of
-                        Nothing ->
-                            throwIO $ ParseAbsolutePathException stackRootEnvVar x
-                        Just parsed -> pure (parsed, parsed)
-
-    (existingStackRootOrParentDir, userOwnsIt) <- do
-        mdirAndOwnership <- findInParents getDirAndOwnership stackRoot
-        case mdirAndOwnership of
-            Just x -> pure x
-            Nothing -> throwIO (BadStackRoot stackRoot)
-
-    when (existingStackRootOrParentDir /= stackRoot) $
-        if userOwnsIt
-            then ensureDir stackRoot
-            else throwIO $
-                Won'tCreateStackRootInDirectoryOwnedByDifferentUser
-                    stackRoot
-                    existingStackRootOrParentDir
-
-    configRoot' <- canonicalizePath configRoot
-    stackRoot' <- canonicalizePath stackRoot
-    pure (configRoot', stackRoot', userOwnsIt)
-
--- | @'checkOwnership' dir@ throws 'UserDoesn'tOwnDirectory' if @dir@
--- isn't owned by the current user.
---
--- If @dir@ doesn't exist, its parent directory is checked instead.
--- If the parent directory doesn't exist either, @'NoSuchDirectory' ('parent' dir)@
--- is thrown.
-checkOwnership :: (MonadIO m) => Path Abs Dir -> m ()
-checkOwnership dir = do
-    mdirAndOwnership <- firstJustM getDirAndOwnership [dir, parent dir]
-    case mdirAndOwnership of
-        Just (_, True) -> pure ()
-        Just (dir', False) -> throwIO (UserDoesn'tOwnDirectory dir')
-        Nothing ->
-            (throwIO . NoSuchDirectory) $ (toFilePathNoTrailingSep . parent) dir
-
--- | @'getDirAndOwnership' dir@ returns @'Just' (dir, 'True')@ when @dir@
--- exists and the current user owns it in the sense of 'isOwnedByUser'.
-getDirAndOwnership ::
-       (MonadIO m)
-    => Path Abs Dir
-    -> m (Maybe (Path Abs Dir, Bool))
-getDirAndOwnership dir = liftIO $ forgivingAbsence $ do
-    ownership <- isOwnedByUser dir
-    pure (dir, ownership)
-
--- | Check whether the current user (determined with 'getEffectiveUserId') is
--- the owner for the given path.
---
--- Will always pure 'True' on Windows.
-isOwnedByUser :: MonadIO m => Path Abs t -> m Bool
-isOwnedByUser path = liftIO $ do
-    if osIsWindows
-        then pure True
-        else do
-            fileStatus <- getFileStatus (toFilePath path)
-            user <- getEffectiveUserID
-            pure (user == fileOwner fileStatus)
-
--- | 'True' if we are currently running inside a Docker container.
-getInContainer :: (MonadIO m) => m Bool
-getInContainer = liftIO (isJust <$> lookupEnv inContainerEnvVar)
-
--- | 'True' if we are currently running inside a Nix.
-getInNixShell :: (MonadIO m) => m Bool
-getInNixShell = liftIO (isJust <$> lookupEnv inNixShellEnvVar)
-
--- | Determine the extra config file locations which exist.
---
--- Returns most local first
-getExtraConfigs :: HasLogFunc env
-                => Path Abs File -- ^ use config path
-                -> RIO env [Path Abs File]
-getExtraConfigs userConfigPath = do
-  defaultStackGlobalConfigPath <- getDefaultGlobalConfigPath
-  liftIO $ do
-    env <- getEnvironment
-    mstackConfig <-
-        maybe (pure Nothing) (fmap Just . parseAbsFile)
-      $ lookup "STACK_CONFIG" env
-    mstackGlobalConfig <-
-        maybe (pure Nothing) (fmap Just . parseAbsFile)
-      $ lookup "STACK_GLOBAL_CONFIG" env
-    filterM doesFileExist
-        $ fromMaybe userConfigPath mstackConfig
-        : maybe [] pure (mstackGlobalConfig <|> defaultStackGlobalConfigPath)
-
--- | Load and parse YAML from the given config file. Throws
--- 'ParseConfigFileException' when there's a decoding error.
-loadConfigYaml ::
-       HasLogFunc env
-    => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env a
-loadConfigYaml parser path = do
-    eres <- loadYaml parser path
-    case eres of
-        Left err -> liftIO $
-            throwM $ PrettyException (ParseConfigFileException path err)
-        Right res -> pure res
-
--- | Load and parse YAML from the given file.
-loadYaml ::
-       HasLogFunc env
-    => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env (Either Yaml.ParseException a)
-loadYaml parser path = do
-    eres <- liftIO $ Yaml.decodeFileEither (toFilePath path)
-    case eres  of
-        Left err -> pure (Left err)
-        Right val ->
-            case Yaml.parseEither parser val of
-                Left err -> pure (Left (Yaml.AesonException err))
-                Right (WithJSONWarnings res warnings) -> do
-                    logJSONWarnings (toFilePath path) warnings
-                    pure (Right res)
-
--- | Get the location of the project config file, if it exists.
-getProjectConfig :: HasLogFunc env
-                 => StackYamlLoc
-                 -- ^ Override stack.yaml
-                 -> RIO env (ProjectConfig (Path Abs File))
-getProjectConfig (SYLOverride stackYaml) = pure $ PCProject stackYaml
-getProjectConfig SYLGlobalProject = pure PCGlobalProject
-getProjectConfig SYLDefault = do
-    env <- liftIO getEnvironment
-    case lookup "STACK_YAML" env of
-        Just fp -> do
-            logInfo "Getting project config file from STACK_YAML environment"
-            liftM PCProject $ resolveFile' fp
-        Nothing -> do
-            currDir <- getCurrentDir
-            maybe PCGlobalProject PCProject <$> findInParents getStackDotYaml currDir
-  where
-    getStackDotYaml dir = do
-        let fp = dir </> stackDotYaml
-            fp' = toFilePath fp
-        logDebug $ "Checking for project config at: " <> fromString fp'
-        exists <- doesFileExist fp
-        if exists
-            then pure $ Just fp
-            else pure Nothing
-getProjectConfig (SYLNoProject extraDeps) = pure $ PCNoProject extraDeps
-
--- | Find the project config file location, respecting environment variables
--- and otherwise traversing parents. If no config is found, we supply a default
--- based on current directory.
-loadProjectConfig :: HasLogFunc env
-                  => StackYamlLoc
-                  -- ^ Override stack.yaml
-                  -> RIO env (ProjectConfig (Project, Path Abs File, ConfigMonoid))
-loadProjectConfig mstackYaml = do
-    mfp <- getProjectConfig mstackYaml
-    case mfp of
-        PCProject fp -> do
-            currDir <- getCurrentDir
-            logDebug $ "Loading project config file " <>
-                        fromString (maybe (toFilePath fp) toFilePath (stripProperPrefix currDir fp))
-            PCProject <$> load fp
-        PCGlobalProject -> do
-            logDebug "No project config file found, using defaults."
-            pure PCGlobalProject
-        PCNoProject extraDeps -> do
-            logDebug "Ignoring config files"
-            pure $ PCNoProject extraDeps
-  where
-    load fp = do
-        iopc <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp
-        ProjectAndConfigMonoid project config <- liftIO iopc
-        pure (project, fp, config)
-
--- | Get the location of the default Stack configuration file.
--- If a file already exists at the deprecated location, its location is returned.
--- Otherwise, the new location is returned.
-getDefaultGlobalConfigPath ::
-       HasLogFunc env
-    => RIO env (Maybe (Path Abs File))
-getDefaultGlobalConfigPath =
-    case (defaultGlobalConfigPath, defaultGlobalConfigPathDeprecated) of
-        (Just new,Just old) ->
-            liftM (Just . fst ) $
-            tryDeprecatedPath
-                (Just "non-project global configuration file")
-                doesFileExist
-                new
-                old
-        (Just new,Nothing) -> pure (Just new)
-        _ -> pure Nothing
-
--- | Get the location of the default user configuration file.
--- If a file already exists at the deprecated location, its location is returned.
--- Otherwise, the new location is returned.
-getDefaultUserConfigPath ::
-       HasLogFunc env
-    => Path Abs Dir -> RIO env (Path Abs File)
-getDefaultUserConfigPath stackRoot = do
-    (path, exists) <- tryDeprecatedPath
-        (Just "non-project configuration file")
-        doesFileExist
-        (defaultUserConfigPath stackRoot)
-        (defaultUserConfigPathDeprecated stackRoot)
-    unless exists $ do
-        ensureDir (parent path)
-        liftIO $ writeBinaryFileAtomic path defaultConfigYaml
-    pure path
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE TypeFamilies        #-}
+
+-- | The general Stack configuration that starts everything off. This should
+-- be smart to fallback if there is no stack.yaml, instead relying on
+-- whatever files are available.
+--
+-- If there is no stack.yaml, and there is a cabal.config, we
+-- read in those constraints, and if there's a cabal.sandbox.config,
+-- we read any constraints from there and also find the package
+-- database from there, etc. And if there's nothing, we should
+-- probably default to behaving like cabal, possibly with spitting out
+-- a warning that "you should run `stk init` to make things better".
+module Stack.Config
+  ( loadConfig
+  , loadConfigYaml
+  , packagesParser
+  , getImplicitGlobalProjectDir
+  , getSnapshots
+  , makeConcreteResolver
+  , checkOwnership
+  , getInContainer
+  , getInNixShell
+  , defaultConfigYaml
+  , getProjectConfig
+  , withBuildConfig
+  , withNewLogFunc
+  ) where
+
+import           Control.Monad.Extra ( firstJustM )
+import           Data.Array.IArray ( (!), (//) )
+import qualified Data.ByteString as S
+import           Data.ByteString.Builder ( byteString )
+import           Data.Coerce ( coerce )
+import qualified Data.IntMap as IntMap
+import qualified Data.Map as Map
+import qualified Data.Map.Merge.Strict as MS
+import qualified Data.Monoid
+import           Data.Monoid.Map ( MonoidMap (..) )
+import qualified Data.Text as T
+import qualified Data.Yaml as Yaml
+import           Distribution.System
+                   ( Arch (OtherArch), OS (..), Platform (..), buildPlatform )
+import qualified Distribution.Text ( simpleParse )
+import           Distribution.Version ( simplifyVersionRange )
+import           GHC.Conc ( getNumProcessors )
+import           Network.HTTP.StackClient
+                   ( httpJSON, parseUrlThrow, getResponseBody )
+import           Options.Applicative ( Parser, help, long, metavar, strOption )
+import           Pantry.Internal.AesonExtended
+                    ( Value, WithJSONWarnings (..), logJSONWarnings )
+import           Path
+                   ( PathException (..), (</>), parent, parseAbsDir
+                   , parseAbsFile, parseRelDir, stripProperPrefix
+                   )
+import           Path.Extra ( toFilePathNoTrailingSep )
+import           Path.Find ( findInParents )
+import           Path.IO
+                   ( XdgDirectory (..), canonicalizePath, doesDirExist
+                   , doesFileExist, ensureDir, forgivingAbsence
+                   , getAppUserDataDir, getCurrentDir, getXdgDir, resolveDir
+                   , resolveDir', resolveFile'
+                   )
+import           RIO.List ( unzip )
+import           RIO.Process
+                   ( HasProcessContext (..), ProcessContext, augmentPathMap
+                   , envVarsL
+                   , mkProcessContext
+                   )
+import           RIO.Time ( toGregorian )
+import           Stack.Build.Haddock ( shouldHaddockDeps )
+import           Stack.Config.Build ( buildOptsFromMonoid )
+import           Stack.Config.Docker ( dockerOptsFromMonoid )
+import           Stack.Config.Nix ( nixOptsFromMonoid )
+import           Stack.Constants
+                   ( defaultGlobalConfigPath, defaultGlobalConfigPathDeprecated
+                   , defaultUserConfigPath, defaultUserConfigPathDeprecated
+                   , implicitGlobalProjectDir
+                   , implicitGlobalProjectDirDeprecated, inContainerEnvVar
+                   , inNixShellEnvVar, osIsWindows, pantryRootEnvVar
+                   , platformVariantEnvVar, relDirBin, relDirStackWork
+                   , relFileReadmeTxt, relFileStorage, relDirPantry
+                   , relDirPrograms, relDirStackProgName, relDirUpperPrograms
+                   , stackDeveloperModeDefault, stackDotYaml, stackProgName
+                   , stackRootEnvVar, stackWorkEnvVar, stackXdgEnvVar
+                   )
+import           Stack.Lock ( lockCachedWanted )
+import           Stack.Prelude
+import           Stack.SourceMap
+                   ( additionalDepPackage, checkFlagsUsedThrowing
+                   , mkProjectPackage
+                   )
+import           Stack.Storage.Project ( initProjectStorage )
+import           Stack.Storage.User ( initUserStorage )
+import           Stack.Storage.Util ( handleMigrationException )
+import           Stack.Types.AllowNewerDeps ( AllowNewerDeps (..) )
+import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
+import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
+import           Stack.Types.Build.Exception ( BuildException (..) )
+import           Stack.Types.BuildConfig ( BuildConfig (..) )
+import           Stack.Types.BuildOpts ( BuildOpts (..) )
+import           Stack.Types.ColorWhen ( ColorWhen (..) )
+import           Stack.Types.Compiler ( defaultCompilerRepository )
+import           Stack.Types.Config
+                   ( Config (..), HasConfig (..), askLatestSnapshotUrl
+                   , configProjectRoot, stackRootL, workDirL
+                   )
+import           Stack.Types.Config.Exception
+                   ( ConfigException (..), ConfigPrettyException (..)
+                   , ParseAbsolutePathException (..), packageIndicesWarning )
+import           Stack.Types.ConfigMonoid
+                   ( ConfigMonoid (..), parseConfigMonoid )
+import           Stack.Types.Docker ( DockerOptsMonoid (..), dockerEnable )
+import           Stack.Types.DumpLogs ( DumpLogs (..) )
+import           Stack.Types.GlobalOpts (  GlobalOpts (..) )
+import           Stack.Types.Nix ( nixEnable )
+import           Stack.Types.Platform
+                   ( PlatformVariant (..), platformOnlyRelDir )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectAndConfigMonoid
+                   ( ProjectAndConfigMonoid (..), parseProjectAndConfigMonoid )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
+import           Stack.Types.PvpBounds ( PvpBounds (..), PvpBoundsType (..) )
+import           Stack.Types.Resolver ( AbstractResolver (..), Snapshots (..) )
+import           Stack.Types.Runner
+                   ( HasRunner (..), Runner (..), globalOptsL, terminalL )
+import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..), ProjectPackage (..)
+                   , SMWanted (..)
+                   )
+import           Stack.Types.StackYamlLoc ( StackYamlLoc (..) )
+import           Stack.Types.UnusedFlags ( FlagSource (..) )
+import           Stack.Types.Version
+                   ( IntersectingVersionRange (..), VersionCheck (..)
+                   , stackVersion, withinRange
+                   )
+import           System.Console.ANSI ( hSupportsANSI, setSGRCode )
+import           System.Environment ( getEnvironment, lookupEnv )
+import           System.Info.ShortPathName ( getShortPathName )
+import           System.PosixCompat.Files ( fileOwner, getFileStatus )
+import           System.Posix.User ( getEffectiveUserID )
+
+-- | If deprecated path exists, use it and print a warning. Otherwise, return
+-- the new path.
+tryDeprecatedPath ::
+     HasTerm env
+  => Maybe T.Text
+     -- ^ Description of file for warning (if Nothing, no deprecation warning is
+     -- displayed)
+  -> (Path Abs a -> RIO env Bool)
+     -- ^ Test for existence
+  -> Path Abs a
+     -- ^ New path
+  -> Path Abs a
+     -- ^ Deprecated path
+  -> RIO env (Path Abs a, Bool)
+     -- ^ (Path to use, whether it already exists)
+tryDeprecatedPath mWarningDesc exists new old = do
+  newExists <- exists new
+  if newExists
+    then pure (new, True)
+    else do
+      oldExists <- exists old
+      if oldExists
+        then do
+          case mWarningDesc of
+            Nothing -> pure ()
+            Just desc ->
+              prettyWarnL
+                [ flow "Location of"
+                , flow (T.unpack desc)
+                , "at"
+                , style Dir (fromString $ toFilePath old)
+                , flow "is deprecated; rename it to"
+                , style Dir (fromString $ toFilePath new)
+                , "instead."
+                ]
+          pure (old, True)
+        else pure (new, False)
+
+-- | Get the location of the implicit global project directory. If the directory
+-- already exists at the deprecated location, its location is returned.
+-- Otherwise, the new location is returned.
+getImplicitGlobalProjectDir ::HasTerm env => Config -> RIO env (Path Abs Dir)
+getImplicitGlobalProjectDir config =
+  --TEST no warning printed
+  fst <$> tryDeprecatedPath
+    Nothing
+    doesDirExist
+    (implicitGlobalProjectDir stackRoot)
+    (implicitGlobalProjectDirDeprecated stackRoot)
+ where
+  stackRoot = view stackRootL config
+
+-- | Download the 'Snapshots' value from stackage.org.
+getSnapshots :: HasConfig env => RIO env Snapshots
+getSnapshots = do
+  latestUrlText <- askLatestSnapshotUrl
+  latestUrl <- parseUrlThrow (T.unpack latestUrlText)
+  logDebug $ "Downloading snapshot versions file from " <> display latestUrlText
+  result <- httpJSON latestUrl
+  logDebug "Done downloading and parsing snapshot versions file"
+  pure $ getResponseBody result
+
+-- | Turn an 'AbstractResolver' into a 'Resolver'.
+makeConcreteResolver ::
+     HasConfig env
+  => AbstractResolver
+  -> RIO env RawSnapshotLocation
+makeConcreteResolver (ARResolver r) = pure r
+makeConcreteResolver ar = do
+  r <-
+    case ar of
+      ARGlobal -> do
+        config <- view configL
+        implicitGlobalDir <- getImplicitGlobalProjectDir config
+        let fp = implicitGlobalDir </> stackDotYaml
+        iopc <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp
+        ProjectAndConfigMonoid project _ <- liftIO iopc
+        pure $ projectResolver project
+      ARLatestNightly ->
+        RSLSynonym . Nightly . snapshotsNightly <$> getSnapshots
+      ARLatestLTSMajor x -> do
+        snapshots <- getSnapshots
+        case IntMap.lookup x $ snapshotsLts snapshots of
+          Nothing -> throwIO $ NoLTSWithMajorVersion x
+          Just y -> pure $ RSLSynonym $ LTS x y
+      ARLatestLTS -> do
+        snapshots <- getSnapshots
+        if IntMap.null $ snapshotsLts snapshots
+          then throwIO NoLTSFound
+          else let (x, y) = IntMap.findMax $ snapshotsLts snapshots
+               in  pure $ RSLSynonym $ LTS x y
+  prettyInfoL
+    [ flow "Selected resolver:"
+    , style Current (fromString $ T.unpack $ textDisplay r) <> "."
+    ]
+  pure r
+
+-- | Get the latest snapshot resolver available.
+getLatestResolver :: HasConfig env => RIO env RawSnapshotLocation
+getLatestResolver = do
+  snapshots <- getSnapshots
+  let mlts = uncurry LTS <$>
+             listToMaybe (reverse (IntMap.toList (snapshotsLts snapshots)))
+  pure $ RSLSynonym $ fromMaybe (Nightly (snapshotsNightly snapshots)) mlts
+
+-- Interprets ConfigMonoid options.
+configFromConfigMonoid ::
+     (HasRunner env, HasTerm env)
+  => Path Abs Dir -- ^ Stack root, e.g. ~/.stack
+  -> Path Abs File -- ^ user config file path, e.g. ~/.stack/config.yaml
+  -> Maybe AbstractResolver
+  -> ProjectConfig (Project, Path Abs File)
+  -> ConfigMonoid
+  -> (Config -> RIO env a)
+  -> RIO env a
+configFromConfigMonoid
+  configStackRoot
+  configUserConfigPath
+  configResolver
+  configProject
+  ConfigMonoid{..}
+  inner
+  = do
+    -- If --stack-work is passed, prefer it. Otherwise, if STACK_WORK
+    -- is set, use that. If neither, use the default ".stack-work"
+    mstackWorkEnv <- liftIO $ lookupEnv stackWorkEnvVar
+    let mproject =
+          case configProject of
+            PCProject pair -> Just pair
+            PCGlobalProject -> Nothing
+            PCNoProject _deps -> Nothing
+        configAllowLocals =
+          case configProject of
+            PCProject _ -> True
+            PCGlobalProject -> True
+            PCNoProject _ -> False
+    configWorkDir0 <-
+      let parseStackWorkEnv x =
+            catch
+              (parseRelDir x)
+              ( \e -> case e of
+                  InvalidRelDir _ ->
+                    prettyThrowIO $ StackWorkEnvNotRelativeDir x
+                  _ -> throwIO e
+              )
+      in  maybe (pure relDirStackWork) (liftIO . parseStackWorkEnv) mstackWorkEnv
+    let configWorkDir = fromFirst configWorkDir0 configMonoidWorkDir
+        configLatestSnapshot = fromFirst
+          "https://s3.amazonaws.com/haddock.stackage.org/snapshots.json"
+          configMonoidLatestSnapshot
+        clConnectionCount = fromFirst 8 configMonoidConnectionCount
+        configHideTHLoading = fromFirstTrue configMonoidHideTHLoading
+        configPrefixTimestamps = fromFirst False configMonoidPrefixTimestamps
+        configGHCVariant = getFirst configMonoidGHCVariant
+        configCompilerRepository = fromFirst
+          defaultCompilerRepository
+          configMonoidCompilerRepository
+        configGHCBuild = getFirst configMonoidGHCBuild
+        configInstallGHC = fromFirstTrue configMonoidInstallGHC
+        configSkipGHCCheck = fromFirstFalse configMonoidSkipGHCCheck
+        configSkipMsys = fromFirstFalse configMonoidSkipMsys
+        configExtraIncludeDirs = configMonoidExtraIncludeDirs
+        configExtraLibDirs = configMonoidExtraLibDirs
+        configCustomPreprocessorExts = configMonoidCustomPreprocessorExts
+        configOverrideGccPath = getFirst configMonoidOverrideGccPath
+        -- Only place in the codebase where platform is hard-coded. In theory in
+        -- the future, allow it to be configured.
+        (Platform defArch defOS) = buildPlatform
+        arch = fromMaybe defArch
+          $ getFirst configMonoidArch >>= Distribution.Text.simpleParse
+        os = defOS
+        configPlatform = Platform arch os
+        configRequireStackVersion = simplifyVersionRange
+          (getIntersectingVersionRange configMonoidRequireStackVersion)
+        configCompilerCheck = fromFirst MatchMinor configMonoidCompilerCheck
+    case arch of
+      OtherArch "aarch64" -> pure ()
+      OtherArch unk ->
+        prettyWarnL
+          [ flow "Unknown value for architecture setting:"
+          , style Shell (fromString unk) <> "."
+          ]
+      _ -> pure ()
+    configPlatformVariant <- liftIO $
+      maybe PlatformVariantNone PlatformVariant <$> lookupEnv platformVariantEnvVar
+    let configBuild = buildOptsFromMonoid configMonoidBuildOpts
+    configDocker <-
+      dockerOptsFromMonoid (fmap fst mproject) configResolver configMonoidDockerOpts
+    configNix <- nixOptsFromMonoid configMonoidNixOpts os
+    configSystemGHC <-
+      case (getFirst configMonoidSystemGHC, nixEnable configNix) of
+        (Just False, True) ->
+          throwM NixRequiresSystemGhc
+        _ ->
+          pure
+            (fromFirst
+              (dockerEnable configDocker || nixEnable configNix)
+              configMonoidSystemGHC)
+    when (isJust configGHCVariant && configSystemGHC) $
+      throwM ManualGHCVariantSettingsAreIncompatibleWithSystemGHC
+    rawEnv <- liftIO getEnvironment
+    pathsEnv <- either throwM pure
+      $ augmentPathMap (map toFilePath configMonoidExtraPath)
+                       (Map.fromList (map (T.pack *** T.pack) rawEnv))
+    origEnv <- mkProcessContext pathsEnv
+    let configProcessContextSettings _ = pure origEnv
+    configLocalProgramsBase <- case getFirst configMonoidLocalProgramsBase of
+      Nothing -> getDefaultLocalProgramsBase configStackRoot configPlatform origEnv
+      Just path -> pure path
+    let localProgramsFilePath = toFilePath configLocalProgramsBase
+    when (osIsWindows && ' ' `elem` localProgramsFilePath) $ do
+      ensureDir configLocalProgramsBase
+      -- getShortPathName returns the long path name when a short name does not
+      -- exist.
+      shortLocalProgramsFilePath <-
+        liftIO $ getShortPathName localProgramsFilePath
+      when (' ' `elem` shortLocalProgramsFilePath) $
+        prettyError $
+          "[S-8432]"
+          <> line
+          <> fillSep
+               [ flow "Stack's 'programs' path contains a space character and \
+                      \has no alternative short ('8 dot 3') name. This will \
+                      \cause problems with packages that use the GNU project's \
+                      \'configure' shell script. Use the"
+               , style Shell "local-programs-path"
+               , flow "configuration option to specify an alternative path. \
+                      \The current path is:"
+               , style File (fromString localProgramsFilePath) <> "."
+               ]
+    platformOnlyDir <-
+      runReaderT platformOnlyRelDir (configPlatform, configPlatformVariant)
+    let configLocalPrograms = configLocalProgramsBase </> platformOnlyDir
+    configLocalBin <-
+      case getFirst configMonoidLocalBinPath of
+        Nothing -> do
+          localDir <- getAppUserDataDir "local"
+          pure $ localDir </> relDirBin
+        Just userPath ->
+          (case mproject of
+            -- Not in a project
+            Nothing -> resolveDir' userPath
+            -- Resolves to the project dir and appends the user path if it is
+            -- relative
+            Just (_, configYaml) -> resolveDir (parent configYaml) userPath)
+          -- TODO: Either catch specific exceptions or add a
+          -- parseRelAsAbsDirMaybe utility and use it along with
+          -- resolveDirMaybe.
+          `catchAny`
+          const (throwIO (NoSuchDirectory userPath))
+    configJobs <-
+      case getFirst configMonoidJobs of
+        Nothing -> liftIO getNumProcessors
+        Just i -> pure i
+    let configConcurrentTests = fromFirst True configMonoidConcurrentTests
+    let configTemplateParams = configMonoidTemplateParameters
+        configScmInit = getFirst configMonoidScmInit
+        configCabalConfigOpts = coerce configMonoidCabalConfigOpts
+        configGhcOptionsByName = coerce configMonoidGhcOptionsByName
+        configGhcOptionsByCat = coerce configMonoidGhcOptionsByCat
+        configSetupInfoLocations = configMonoidSetupInfoLocations
+        configSetupInfoInline = configMonoidSetupInfoInline
+        configPvpBounds =
+          fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds
+        configModifyCodePage = fromFirstTrue configMonoidModifyCodePage
+        configRebuildGhcOptions = fromFirstFalse configMonoidRebuildGhcOptions
+        configApplyGhcOptions = fromFirst AGOLocals configMonoidApplyGhcOptions
+        configApplyProgOptions = fromFirst APOLocals configMonoidApplyProgOptions
+        configAllowNewer = fromFirst False configMonoidAllowNewer
+        configAllowNewerDeps = coerce configMonoidAllowNewerDeps
+        configDefaultTemplate = getFirst configMonoidDefaultTemplate
+        configDumpLogs = fromFirst DumpWarningLogs configMonoidDumpLogs
+        configSaveHackageCreds = fromFirst True configMonoidSaveHackageCreds
+        configHackageBaseUrl =
+          fromFirst "https://hackage.haskell.org/" configMonoidHackageBaseUrl
+        configHideSourcePaths = fromFirstTrue configMonoidHideSourcePaths
+        configRecommendUpgrade = fromFirstTrue configMonoidRecommendUpgrade
+        configNoRunCompile = fromFirstFalse configMonoidNoRunCompile
+    configAllowDifferentUser <-
+      case getFirst configMonoidAllowDifferentUser of
+        Just True -> pure True
+        _ -> getInContainer
+    configRunner' <- view runnerL
+    useAnsi <- liftIO $ hSupportsANSI stderr
+    let stylesUpdate' = (configRunner' ^. stylesUpdateL) <>
+          configMonoidStyles
+        useColor' = runnerUseColor configRunner'
+        mUseColor = do
+          colorWhen <- getFirst configMonoidColorWhen
+          pure $ case colorWhen of
+            ColorNever  -> False
+            ColorAlways -> True
+            ColorAuto  -> useAnsi
+        useColor'' = fromMaybe useColor' mUseColor
+        configRunner'' = configRunner'
+          & processContextL .~ origEnv
+          & stylesUpdateL .~ stylesUpdate'
+          & useColorL .~ useColor''
+        go = runnerGlobalOpts configRunner'
+    pic <-
+      case getFirst configMonoidPackageIndex of
+        Nothing ->
+          case getFirst configMonoidPackageIndices of
+            Nothing -> pure defaultPackageIndexConfig
+            Just [pic] -> do
+              prettyWarn packageIndicesWarning
+              pure pic
+            Just x -> prettyThrowIO $ MultiplePackageIndices x
+        Just pic -> pure pic
+    mpantryRoot <- liftIO $ lookupEnv pantryRootEnvVar
+    pantryRoot <-
+      case mpantryRoot of
+        Just dir ->
+          case parseAbsDir dir of
+            Nothing -> throwIO $ ParseAbsolutePathException pantryRootEnvVar dir
+            Just x -> pure x
+        Nothing -> pure $ configStackRoot </> relDirPantry
+    let snapLoc =
+          case getFirst configMonoidSnapshotLocation of
+            Nothing -> defaultSnapshotLocation
+            Just addr ->
+              customSnapshotLocation
+               where
+                customSnapshotLocation (LTS x y) =
+                  mkRSLUrl $ addr'
+                    <> "/lts/" <> display x
+                    <> "/" <> display y <> ".yaml"
+                customSnapshotLocation (Nightly date) =
+                  let (year, month, day) = toGregorian date
+                  in  mkRSLUrl $ addr'
+                        <> "/nightly/"
+                        <> display year
+                        <> "/" <> display month
+                        <> "/" <> display day <> ".yaml"
+                mkRSLUrl builder = RSLUrl (utf8BuilderToText builder) Nothing
+                addr' = display $ T.dropWhileEnd (=='/') addr
+    let configStackDeveloperMode =
+          fromFirst stackDeveloperModeDefault configMonoidStackDeveloperMode
+    withNewLogFunc go useColor'' stylesUpdate' $ \logFunc -> do
+      let configRunner = configRunner'' & logFuncL .~ logFunc
+      withLocalLogFunc logFunc $ handleMigrationException $
+        withPantryConfig
+          pantryRoot
+          pic
+          (maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack)
+          clConnectionCount
+          (fromFirst defaultCasaRepoPrefix configMonoidCasaRepoPrefix)
+          defaultCasaMaxPerRequest
+          snapLoc
+          (\configPantryConfig -> initUserStorage
+            (configStackRoot </> relFileStorage)
+            (\configUserStorage -> inner Config {..}))
+
+-- | Runs the provided action with the given 'LogFunc' in the environment
+withLocalLogFunc :: HasLogFunc env => LogFunc -> RIO env a -> RIO env a
+withLocalLogFunc logFunc = local (set logFuncL logFunc)
+
+-- | Runs the provided action with a new 'LogFunc', given a 'StylesUpdate'.
+withNewLogFunc :: MonadUnliftIO m
+               => GlobalOpts
+               -> Bool  -- ^ Use color
+               -> StylesUpdate
+               -> (LogFunc -> m a)
+               -> m a
+withNewLogFunc go useColor (StylesUpdate update) inner = do
+  logOptions0 <- logOptionsHandle stderr False
+  let logOptions
+        = setLogUseColor useColor
+        $ setLogLevelColors logLevelColors
+        $ setLogSecondaryColor secondaryColor
+        $ setLogAccentColors (const highlightColor)
+        $ setLogUseTime (globalTimeInLog go)
+        $ setLogMinLevel (globalLogLevel go)
+        $ setLogVerboseFormat (globalLogLevel go <= LevelDebug)
+        $ setLogTerminal (globalTerminal go)
+          logOptions0
+  withLogFunc logOptions inner
+ where
+  styles = defaultStyles // update
+  logLevelColors :: LogLevel -> Utf8Builder
+  logLevelColors level =
+    fromString $ setSGRCode $ snd $ styles ! logLevelToStyle level
+  secondaryColor = fromString $ setSGRCode $ snd $ styles ! Secondary
+  highlightColor = fromString $ setSGRCode $ snd $ styles ! Highlight
+
+-- | Get the default location of the local programs directory.
+getDefaultLocalProgramsBase :: MonadThrow m
+                            => Path Abs Dir
+                            -> Platform
+                            -> ProcessContext
+                            -> m (Path Abs Dir)
+getDefaultLocalProgramsBase configStackRoot configPlatform override =
+  case configPlatform of
+    -- For historical reasons, on Windows a subdirectory of LOCALAPPDATA is
+    -- used instead of a subdirectory of STACK_ROOT. Unifying the defaults would
+    -- mean that Windows users would manually have to move data from the old
+    -- location to the new one, which is undesirable.
+    Platform _ Windows -> do
+      let envVars = view envVarsL override
+      case T.unpack <$> Map.lookup "LOCALAPPDATA" envVars of
+        Just t -> case parseAbsDir t of
+          Nothing ->
+            throwM $ ParseAbsolutePathException "LOCALAPPDATA" t
+          Just lad ->
+            pure $ lad </> relDirUpperPrograms </>
+                   relDirStackProgName
+        Nothing -> pure defaultBase
+    _ -> pure defaultBase
+ where
+  defaultBase = configStackRoot </> relDirPrograms
+
+-- | Load the configuration, using current directory, environment variables,
+-- and defaults as necessary.
+loadConfig ::
+     (HasRunner env, HasTerm env)
+  => (Config -> RIO env a)
+  -> RIO env a
+loadConfig inner = do
+  mstackYaml <- view $ globalOptsL.to globalStackYaml
+  mproject <- loadProjectConfig mstackYaml
+  mresolver <- view $ globalOptsL.to globalResolver
+  configArgs <- view $ globalOptsL.to globalConfigMonoid
+  (configRoot, stackRoot, userOwnsStackRoot) <-
+    determineStackRootAndOwnership configArgs
+
+  let (mproject', addConfigMonoid) =
+        case mproject of
+          PCProject (proj, fp, cm) -> (PCProject (proj, fp), (cm:))
+          PCGlobalProject -> (PCGlobalProject, id)
+          PCNoProject deps -> (PCNoProject deps, id)
+
+  userConfigPath <- getDefaultUserConfigPath configRoot
+  extraConfigs0 <- getExtraConfigs userConfigPath >>=
+    mapM (\file -> loadConfigYaml (parseConfigMonoid (parent file)) file)
+  let extraConfigs =
+        -- non-project config files' existence of a docker section should never
+        -- default docker to enabled, so make it look like they didn't exist
+        map
+          ( \c -> c {configMonoidDockerOpts =
+              (configMonoidDockerOpts c) {dockerMonoidDefaultEnable = Any False}}
+          )
+          extraConfigs0
+
+  let withConfig =
+        configFromConfigMonoid
+          stackRoot
+          userConfigPath
+          mresolver
+          mproject'
+          (mconcat $ configArgs : addConfigMonoid extraConfigs)
+
+  withConfig $ \config -> do
+    unless (stackVersion `withinRange` configRequireStackVersion config)
+      (throwM (BadStackVersionException (configRequireStackVersion config)))
+    unless (configAllowDifferentUser config) $ do
+      unless userOwnsStackRoot $
+        throwM (UserDoesn'tOwnDirectory stackRoot)
+      forM_ (configProjectRoot config) $ \dir ->
+        checkOwnership (dir </> configWorkDir config)
+    inner config
+
+-- | Load the build configuration, adds build-specific values to config loaded
+-- by @loadConfig@. values.
+withBuildConfig :: RIO BuildConfig a -> RIO Config a
+withBuildConfig inner = do
+  config <- ask
+
+  -- If provided, turn the AbstractResolver from the command line into a
+  -- Resolver that can be used below.
+
+  -- The configResolver and mcompiler are provided on the command line. In order
+  -- to properly deal with an AbstractResolver, we need a base directory (to
+  -- deal with custom snapshot relative paths). We consider the current working
+  -- directory to be the correct base. Let's calculate the mresolver first.
+  mresolver <- forM (configResolver config) $ \aresolver -> do
+    logDebug ("Using resolver: " <> display aresolver <> " specified on command line")
+    makeConcreteResolver aresolver
+
+  (project', stackYamlFP) <- case configProject config of
+    PCProject (project, fp) -> do
+      forM_ (projectUserMsg project) prettyWarnS
+      pure (project, fp)
+    PCNoProject extraDeps -> do
+      p <-
+        case mresolver of
+          Nothing -> throwIO NoResolverWhenUsingNoProject
+          Just _ -> getEmptyProject mresolver extraDeps
+      pure (p, configUserConfigPath config)
+    PCGlobalProject -> do
+      logDebug "Run from outside a project, using implicit global project config"
+      destDir <- getImplicitGlobalProjectDir config
+      let dest :: Path Abs File
+          dest = destDir </> stackDotYaml
+          dest' :: FilePath
+          dest' = toFilePath dest
+      ensureDir destDir
+      exists <- doesFileExist dest
+      if exists
+        then do
+          iopc <- loadConfigYaml (parseProjectAndConfigMonoid destDir) dest
+          ProjectAndConfigMonoid project _ <- liftIO iopc
+          when (view terminalL config) $
+            case configResolver config of
+              Nothing ->
+                logDebug $
+                  "Using resolver: " <>
+                  display (projectResolver project) <>
+                  " from implicit global project's config file: " <>
+                  fromString dest'
+              Just _ -> pure ()
+          pure (project, dest)
+        else do
+          prettyInfoL
+            [ flow "Writing the configuration file for the implicit \
+                   \global project to:"
+            , pretty dest <> "."
+            , flow "Note: You can change the snapshot via the"
+            , style Shell "resolver"
+            , flow "field there."
+            ]
+          p <- getEmptyProject mresolver []
+          liftIO $ do
+            writeBinaryFileAtomic dest $ byteString $ S.concat
+              [ "# This is the implicit global project's config file, which is only used when\n"
+              , "# 'stack' is run outside of a real project. Settings here do _not_ act as\n"
+              , "# defaults for all projects. To change Stack's default settings, edit\n"
+              , "# '", encodeUtf8 (T.pack $ toFilePath $ configUserConfigPath config), "' instead.\n"
+              , "#\n"
+              , "# For more information about Stack's configuration, see\n"
+              , "# http://docs.haskellstack.org/en/stable/yaml_configuration/\n"
+              , "#\n"
+              , Yaml.encode p]
+            writeBinaryFileAtomic (parent dest </> relFileReadmeTxt) $
+              "This is the implicit global project, which is " <>
+              "used only when 'stack' is run\noutside of a " <>
+              "real project.\n"
+          pure (p, dest)
+  mcompiler <- view $ globalOptsL.to globalCompiler
+  let project = project'
+        { projectCompiler = mcompiler <|> projectCompiler project'
+        , projectResolver = fromMaybe (projectResolver project') mresolver
+        }
+  extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project)
+
+  wanted <- lockCachedWanted stackYamlFP (projectResolver project) $
+    fillProjectWanted stackYamlFP config project
+
+  -- Unfortunately redoes getProjectWorkDir, since we don't have a BuildConfig
+  -- yet
+  workDir <- view workDirL
+  let projectStorageFile = parent stackYamlFP </> workDir </> relFileStorage
+
+  initProjectStorage projectStorageFile $ \projectStorage -> do
+    let bc = BuildConfig
+          { bcConfig = config
+          , bcSMWanted = wanted
+          , bcExtraPackageDBs = extraPackageDBs
+          , bcStackYaml = stackYamlFP
+          , bcCurator = projectCurator project
+          , bcProjectStorage = projectStorage
+          }
+    runRIO bc inner
+ where
+  getEmptyProject ::
+       Maybe RawSnapshotLocation
+    -> [PackageIdentifierRevision]
+    -> RIO Config Project
+  getEmptyProject mresolver extraDeps = do
+    r <- case mresolver of
+      Just resolver -> do
+        prettyInfoL
+          [ flow "Using the snapshot"
+          , style Current (fromString $ T.unpack $ textDisplay resolver)
+          , flow "specified on the command line."
+          ]
+        pure resolver
+      Nothing -> do
+        r'' <- getLatestResolver
+        prettyInfoL
+          [ flow "Using the latest snapshot"
+          , style Current (fromString $ T.unpack $ textDisplay r'') <> "."
+          ]
+        pure r''
+    pure Project
+      { projectUserMsg = Nothing
+      , projectPackages = []
+      , projectDependencies =
+          map (RPLImmutable . flip RPLIHackage Nothing) extraDeps
+      , projectFlags = mempty
+      , projectResolver = r
+      , projectCompiler = Nothing
+      , projectExtraPackageDBs = []
+      , projectCurator = Nothing
+      , projectDropPackages = mempty
+      }
+
+fillProjectWanted ::
+     (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
+  => Path Abs t
+  -> Config
+  -> Project
+  -> Map RawPackageLocationImmutable PackageLocationImmutable
+  -> WantedCompiler
+  -> Map PackageName (Bool -> RIO env DepPackage)
+  -> RIO env (SMWanted, [CompletedPLI])
+fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages = do
+  let bopts = configBuild config
+
+  packages0 <- for (projectPackages project) $ \fp@(RelFilePath t) -> do
+    abs' <- resolveDir (parent stackYamlFP) (T.unpack t)
+    let resolved = ResolvedPath fp abs'
+    pp <- mkProjectPackage YesPrintWarnings resolved (boptsHaddock bopts)
+    pure (cpName $ ppCommon pp, pp)
+
+  -- prefetch git repos to avoid cloning per subdirectory
+  -- see https://github.com/commercialhaskell/stack/issues/5411
+  let gitRepos = mapMaybe
+        ( \case
+            (RPLImmutable (RPLIRepo repo rpm)) -> Just (repo, rpm)
+            _ -> Nothing
+        )
+        (projectDependencies project)
+  logDebug ("Prefetching git repos: " <> display (T.pack (show gitRepos)))
+  fetchReposRaw gitRepos
+
+  (deps0, mcompleted) <- fmap unzip . forM (projectDependencies project) $ \rpl -> do
+    (pl, mCompleted) <- case rpl of
+       RPLImmutable rpli -> do
+         (compl, mcompl) <-
+           case Map.lookup rpli locCache of
+             Just compl -> pure (compl, Just compl)
+             Nothing -> do
+               cpl <- completePackageLocation rpli
+               if cplHasCabalFile cpl
+                 then pure (cplComplete cpl, Just $ cplComplete cpl)
+                 else do
+                   warnMissingCabalFile rpli
+                   pure (cplComplete cpl, Nothing)
+         pure (PLImmutable compl, CompletedPLI rpli <$> mcompl)
+       RPLMutable p ->
+         pure (PLMutable p, Nothing)
+    dp <- additionalDepPackage (shouldHaddockDeps bopts) pl
+    pure ((cpName $ dpCommon dp, dp), mCompleted)
+
+  checkDuplicateNames $
+    map (second (PLMutable . ppResolvedDir)) packages0 ++
+    map (second dpLocation) deps0
+
+  let packages1 = Map.fromList packages0
+      snPackages = snapPackages
+        `Map.difference` packages1
+        `Map.difference` Map.fromList deps0
+        `Map.withoutKeys` projectDropPackages project
+
+  snDeps <- for snPackages $ \getDep -> getDep (shouldHaddockDeps bopts)
+
+  let deps1 = Map.fromList deps0 `Map.union` snDeps
+
+  let mergeApply m1 m2 f =
+        MS.merge MS.preserveMissing MS.dropMissing (MS.zipWithMatched f) m1 m2
+      pFlags = projectFlags project
+      packages2 = mergeApply packages1 pFlags $
+        \_ p flags -> p{ppCommon=(ppCommon p){cpFlags=flags}}
+      deps2 = mergeApply deps1 pFlags $
+        \_ d flags -> d{dpCommon=(dpCommon d){cpFlags=flags}}
+
+  checkFlagsUsedThrowing pFlags FSStackYaml packages1 deps1
+
+  let pkgGhcOptions = configGhcOptionsByName config
+      deps = mergeApply deps2 pkgGhcOptions $
+        \_ d options -> d{dpCommon=(dpCommon d){cpGhcOptions=options}}
+      packages = mergeApply packages2 pkgGhcOptions $
+        \_ p options -> p{ppCommon=(ppCommon p){cpGhcOptions=options}}
+      unusedPkgGhcOptions =
+        pkgGhcOptions `Map.restrictKeys` Map.keysSet packages2
+          `Map.restrictKeys` Map.keysSet deps2
+
+  unless (Map.null unusedPkgGhcOptions) $
+    throwM $ InvalidGhcOptionsSpecification (Map.keys unusedPkgGhcOptions)
+
+  let wanted = SMWanted
+        { smwCompiler = fromMaybe snapCompiler (projectCompiler project)
+        , smwProject = packages
+        , smwDeps = deps
+        , smwSnapshotLocation = projectResolver project
+        }
+
+  pure (wanted, catMaybes mcompleted)
+
+
+-- | Check if there are any duplicate package names and, if so, throw an
+-- exception.
+checkDuplicateNames :: MonadThrow m => [(PackageName, PackageLocation)] -> m ()
+checkDuplicateNames locals =
+  case filter hasMultiples $ Map.toList $ Map.fromListWith (++) $ map (second pure) locals of
+    [] -> pure ()
+    x -> prettyThrowM $ DuplicateLocalPackageNames x
+ where
+  hasMultiples (_, _:_:_) = True
+  hasMultiples _ = False
+
+
+-- | Get the Stack root, e.g. @~/.stack@, and determine whether the user owns it.
+--
+-- On Windows, the second value is always 'True'.
+determineStackRootAndOwnership ::
+     MonadIO m
+  => ConfigMonoid
+  -- ^ Parsed command-line arguments
+  -> m (Path Abs Dir, Path Abs Dir, Bool)
+determineStackRootAndOwnership clArgs = liftIO $ do
+  (configRoot, stackRoot) <- do
+    case getFirst (configMonoidStackRoot clArgs) of
+      Just x -> pure (x, x)
+      Nothing -> do
+        mstackRoot <- lookupEnv stackRootEnvVar
+        case mstackRoot of
+          Nothing -> do
+            wantXdg <- fromMaybe "" <$> lookupEnv stackXdgEnvVar
+            if not (null wantXdg)
+              then do
+                xdgRelDir <- parseRelDir stackProgName
+                (,)
+                  <$> getXdgDir XdgConfig (Just xdgRelDir)
+                  <*> getXdgDir XdgData (Just xdgRelDir)
+              else do
+                oldStyleRoot <- getAppUserDataDir stackProgName
+                pure (oldStyleRoot, oldStyleRoot)
+          Just x -> case parseAbsDir x of
+            Nothing ->
+              throwIO $ ParseAbsolutePathException stackRootEnvVar x
+            Just parsed -> pure (parsed, parsed)
+
+  (existingStackRootOrParentDir, userOwnsIt) <- do
+    mdirAndOwnership <- findInParents getDirAndOwnership stackRoot
+    case mdirAndOwnership of
+      Just x -> pure x
+      Nothing -> throwIO (BadStackRoot stackRoot)
+
+  when (existingStackRootOrParentDir /= stackRoot) $
+    if userOwnsIt
+      then ensureDir stackRoot
+      else throwIO $
+        Won'tCreateStackRootInDirectoryOwnedByDifferentUser
+          stackRoot
+          existingStackRootOrParentDir
+
+  configRoot' <- canonicalizePath configRoot
+  stackRoot' <- canonicalizePath stackRoot
+  pure (configRoot', stackRoot', userOwnsIt)
+
+-- | @'checkOwnership' dir@ throws 'UserDoesn'tOwnDirectory' if @dir@ isn't
+-- owned by the current user.
+--
+-- If @dir@ doesn't exist, its parent directory is checked instead.
+-- If the parent directory doesn't exist either,
+-- @'NoSuchDirectory' ('parent' dir)@ is thrown.
+checkOwnership :: MonadIO m => Path Abs Dir -> m ()
+checkOwnership dir = do
+  mdirAndOwnership <- firstJustM getDirAndOwnership [dir, parent dir]
+  case mdirAndOwnership of
+    Just (_, True) -> pure ()
+    Just (dir', False) -> throwIO (UserDoesn'tOwnDirectory dir')
+    Nothing ->
+      throwIO . NoSuchDirectory $ (toFilePathNoTrailingSep . parent) dir
+
+-- | @'getDirAndOwnership' dir@ returns @'Just' (dir, 'True')@ when @dir@
+-- exists and the current user owns it in the sense of 'isOwnedByUser'.
+getDirAndOwnership ::
+     MonadIO m
+  => Path Abs Dir
+  -> m (Maybe (Path Abs Dir, Bool))
+getDirAndOwnership dir = liftIO $ forgivingAbsence $ do
+    ownership <- isOwnedByUser dir
+    pure (dir, ownership)
+
+-- | Check whether the current user (determined with 'getEffectiveUserId') is
+-- the owner for the given path.
+--
+-- Will always pure 'True' on Windows.
+isOwnedByUser :: MonadIO m => Path Abs t -> m Bool
+isOwnedByUser path = liftIO $
+  if osIsWindows
+    then pure True
+    else do
+      fileStatus <- getFileStatus (toFilePath path)
+      user <- getEffectiveUserID
+      pure (user == fileOwner fileStatus)
+
+-- | 'True' if we are currently running inside a Docker container.
+getInContainer :: MonadIO m => m Bool
+getInContainer = liftIO (isJust <$> lookupEnv inContainerEnvVar)
+
+-- | 'True' if we are currently running inside a Nix.
+getInNixShell :: MonadIO m => m Bool
+getInNixShell = liftIO (isJust <$> lookupEnv inNixShellEnvVar)
+
+-- | Determine the extra config file locations which exist.
+--
+-- Returns most local first
+getExtraConfigs :: HasTerm env
+                => Path Abs File -- ^ use config path
+                -> RIO env [Path Abs File]
+getExtraConfigs userConfigPath = do
+  defaultStackGlobalConfigPath <- getDefaultGlobalConfigPath
+  liftIO $ do
+    env <- getEnvironment
+    mstackConfig <-
+        maybe (pure Nothing) (fmap Just . parseAbsFile)
+      $ lookup "STACK_CONFIG" env
+    mstackGlobalConfig <-
+        maybe (pure Nothing) (fmap Just . parseAbsFile)
+      $ lookup "STACK_GLOBAL_CONFIG" env
+    filterM doesFileExist
+        $ fromMaybe userConfigPath mstackConfig
+        : maybe [] pure (mstackGlobalConfig <|> defaultStackGlobalConfigPath)
+
+-- | Load and parse YAML from the given config file. Throws
+-- 'ParseConfigFileException' when there's a decoding error.
+loadConfigYaml ::
+     HasLogFunc env
+  => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env a
+loadConfigYaml parser path = do
+  eres <- loadYaml parser path
+  case eres of
+    Left err -> prettyThrowM (ParseConfigFileException path err)
+    Right res -> pure res
+
+-- | Load and parse YAML from the given file.
+loadYaml ::
+     HasLogFunc env
+  => (Value -> Yaml.Parser (WithJSONWarnings a))
+  -> Path Abs File
+  -> RIO env (Either Yaml.ParseException a)
+loadYaml parser path = do
+  eres <- liftIO $ Yaml.decodeFileEither (toFilePath path)
+  case eres  of
+    Left err -> pure (Left err)
+    Right val ->
+      case Yaml.parseEither parser val of
+        Left err -> pure (Left (Yaml.AesonException err))
+        Right (WithJSONWarnings res warnings) -> do
+          logJSONWarnings (toFilePath path) warnings
+          pure (Right res)
+
+-- | Get the location of the project config file, if it exists.
+getProjectConfig :: HasTerm env
+                 => StackYamlLoc
+                 -- ^ Override stack.yaml
+                 -> RIO env (ProjectConfig (Path Abs File))
+getProjectConfig (SYLOverride stackYaml) = pure $ PCProject stackYaml
+getProjectConfig SYLGlobalProject = pure PCGlobalProject
+getProjectConfig SYLDefault = do
+  env <- liftIO getEnvironment
+  case lookup "STACK_YAML" env of
+    Just fp -> do
+      prettyInfoS
+        "Getting the project-level configuration file from the \
+        \STACK_YAML environment variable."
+      PCProject <$> resolveFile' fp
+    Nothing -> do
+      currDir <- getCurrentDir
+      maybe PCGlobalProject PCProject <$> findInParents getStackDotYaml currDir
+ where
+  getStackDotYaml dir = do
+    let fp = dir </> stackDotYaml
+        fp' = toFilePath fp
+    logDebug $ "Checking for project config at: " <> fromString fp'
+    exists <- doesFileExist fp
+    if exists
+      then pure $ Just fp
+      else pure Nothing
+getProjectConfig (SYLNoProject extraDeps) = pure $ PCNoProject extraDeps
+
+-- | Find the project config file location, respecting environment variables
+-- and otherwise traversing parents. If no config is found, we supply a default
+-- based on current directory.
+loadProjectConfig ::
+     HasTerm env
+  => StackYamlLoc
+     -- ^ Override stack.yaml
+  -> RIO env (ProjectConfig (Project, Path Abs File, ConfigMonoid))
+loadProjectConfig mstackYaml = do
+  mfp <- getProjectConfig mstackYaml
+  case mfp of
+    PCProject fp -> do
+      currDir <- getCurrentDir
+      logDebug $ "Loading project config file " <>
+                  fromString (maybe (toFilePath fp) toFilePath (stripProperPrefix currDir fp))
+      PCProject <$> load fp
+    PCGlobalProject -> do
+      logDebug "No project config file found, using defaults."
+      pure PCGlobalProject
+    PCNoProject extraDeps -> do
+      logDebug "Ignoring config files"
+      pure $ PCNoProject extraDeps
+ where
+  load fp = do
+    iopc <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp
+    ProjectAndConfigMonoid project config <- liftIO iopc
+    pure (project, fp, config)
+
+-- | Get the location of the default Stack configuration file. If a file already
+-- exists at the deprecated location, its location is returned. Otherwise, the
+-- new location is returned.
+getDefaultGlobalConfigPath ::
+     HasTerm env
+  => RIO env (Maybe (Path Abs File))
+getDefaultGlobalConfigPath =
+  case (defaultGlobalConfigPath, defaultGlobalConfigPathDeprecated) of
+    (Just new, Just old) ->
+      Just . fst <$>
+        tryDeprecatedPath
+          (Just "non-project global configuration file")
+          doesFileExist
+          new
+          old
+    (Just new,Nothing) -> pure (Just new)
+    _ -> pure Nothing
+
+-- | Get the location of the default user configuration file. If a file already
+-- exists at the deprecated location, its location is returned. Otherwise, the
+-- new location is returned.
+getDefaultUserConfigPath ::
+     HasTerm env
+  => Path Abs Dir
+  -> RIO env (Path Abs File)
+getDefaultUserConfigPath stackRoot = do
+  (path, exists) <- tryDeprecatedPath
+    (Just "non-project configuration file")
+    doesFileExist
+    (defaultUserConfigPath stackRoot)
+    (defaultUserConfigPathDeprecated stackRoot)
+  unless exists $ do
+    ensureDir (parent path)
+    liftIO $ writeBinaryFileAtomic path defaultConfigYaml
+  pure path
 
 packagesParser :: Parser [String]
 packagesParser = many (strOption
src/Stack/Config/Build.hs view
@@ -11,29 +11,36 @@ 
 import           Distribution.Verbosity ( normal )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.BuildOpts
+                   ( BenchmarkOpts (..), BenchmarkOptsMonoid (..)
+                   , BuildOpts (..), BuildOptsMonoid (..), CabalVerbosity (..)
+                   , HaddockOpts (..), HaddockOptsMonoid (..), TestOpts (..)
+                   , TestOptsMonoid (..), defaultBenchmarkOpts
+                   , defaultHaddockOpts, defaultTestOpts
+                   )
 
 -- | Interprets BuildOptsMonoid options.
 buildOptsFromMonoid :: BuildOptsMonoid -> BuildOpts
 buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
   { boptsLibProfile = fromFirstFalse
-        (buildMonoidLibProfile <>
-         FirstFalse (if tracing || profiling then Just True else Nothing))
+      (buildMonoidLibProfile <>
+       FirstFalse (if tracing || profiling then Just True else Nothing))
   , boptsExeProfile = fromFirstFalse
-        (buildMonoidExeProfile <>
-         FirstFalse (if tracing || profiling then Just True else Nothing))
+      (buildMonoidExeProfile <>
+       FirstFalse (if tracing || profiling then Just True else Nothing))
   , boptsLibStrip = fromFirstTrue
-        (buildMonoidLibStrip <>
-         FirstTrue (if noStripping then Just False else Nothing))
+      (buildMonoidLibStrip <>
+       FirstTrue (if noStripping then Just False else Nothing))
   , boptsExeStrip = fromFirstTrue
-        (buildMonoidExeStrip <>
-         FirstTrue (if noStripping then Just False else Nothing))
+      (buildMonoidExeStrip <>
+       FirstTrue (if noStripping then Just False else Nothing))
   , boptsHaddock = fromFirstFalse buildMonoidHaddock
   , boptsHaddockOpts = haddockOptsFromMonoid buildMonoidHaddockOpts
   , boptsOpenHaddocks = fromFirstFalse buildMonoidOpenHaddocks
   , boptsHaddockDeps = getFirst buildMonoidHaddockDeps
   , boptsHaddockInternal = fromFirstFalse buildMonoidHaddockInternal
-  , boptsHaddockHyperlinkSource = fromFirstTrue buildMonoidHaddockHyperlinkSource
+  , boptsHaddockHyperlinkSource =
+      fromFirstTrue buildMonoidHaddockHyperlinkSource
   , boptsInstallExes = fromFirstFalse buildMonoidInstallExes
   , boptsInstallCompilerTool = fromFirstFalse buildMonoidInstallCompilerTool
   , boptsPreFetch = fromFirstFalse buildMonoidPreFetch
@@ -42,12 +49,13 @@   , boptsForceDirty = fromFirstFalse buildMonoidForceDirty
   , boptsTests = fromFirstFalse buildMonoidTests
   , boptsTestOpts =
-        testOptsFromMonoid buildMonoidTestOpts additionalArgs
+      testOptsFromMonoid buildMonoidTestOpts additionalArgs
   , boptsBenchmarks = fromFirstFalse buildMonoidBenchmarks
   , boptsBenchmarkOpts =
-        benchmarkOptsFromMonoid buildMonoidBenchmarkOpts additionalArgs
+      benchmarkOptsFromMonoid buildMonoidBenchmarkOpts additionalArgs
   , boptsReconfigure = fromFirstFalse buildMonoidReconfigure
-  , boptsCabalVerbose = fromFirst (CabalVerbosity normal) buildMonoidCabalVerbose
+  , boptsCabalVerbose =
+      fromFirst (CabalVerbosity normal) buildMonoidCabalVerbose
   , boptsSplitObjs = fromFirstFalse buildMonoidSplitObjs
   , boptsSkipComponents = buildMonoidSkipComponents
   , boptsInterleavedOutput = fromFirstTrue buildMonoidInterleavedOutput
src/Stack/Config/Docker.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE RecordWildCards    #-}
 
@@ -14,30 +13,35 @@ import qualified Data.Text as T
 import           Distribution.Version ( simplifyVersionRange )
 import           Stack.Prelude
-import           Stack.Types.Version
-import           Stack.Types.Config
+import           Stack.Types.Project ( Project (..) )
 import           Stack.Types.Docker
-import           Stack.Types.Resolver
+                   ( DockerOpts (..), DockerMonoidRepoOrImage (..)
+                   , DockerOptsMonoid (..), dockerImageArgName
+                   )
+import           Stack.Types.Resolver ( AbstractResolver (..) )
+import           Stack.Types.Version ( getIntersectingVersionRange )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Config.Docker" module.
 data ConfigDockerException
-    = ResolverNotSupportedException !(Maybe Project) !(Maybe AbstractResolver)
-    -- ^ Only LTS resolvers are supported for default image tag.
-    deriving (Show, Typeable)
+  = ResolverNotSupportedException !(Maybe Project) !(Maybe AbstractResolver)
+  -- ^ Only LTS resolvers are supported for default image tag.
+  deriving (Show, Typeable)
 
 instance Exception ConfigDockerException where
-    displayException (ResolverNotSupportedException mproject maresolver) =
-        concat
-            [ "Error: [S-8575]\n"
-            , "Resolver not supported for Docker images:\n    "
-            , case (mproject, maresolver) of
-                (Nothing, Nothing) -> "no resolver specified"
-                (_, Just aresolver) -> T.unpack $ utf8BuilderToText $ display aresolver
-                (Just project, Nothing) -> T.unpack $ utf8BuilderToText $ display $ projectResolver project
-            , "\nUse an LTS resolver, or set the '"
-            , T.unpack dockerImageArgName
-            , "' explicitly, in your configuration file."]
+  displayException (ResolverNotSupportedException mproject maresolver) =
+    concat
+      [ "Error: [S-8575]\n"
+      , "Resolver not supported for Docker images:\n    "
+      , case (mproject, maresolver) of
+          (Nothing, Nothing) -> "no resolver specified"
+          (_, Just aresolver) ->
+            T.unpack $ utf8BuilderToText $ display aresolver
+          (Just project, Nothing) ->
+            T.unpack $ utf8BuilderToText $ display $ projectResolver project
+      , "\nUse an LTS resolver, or set the '"
+      , T.unpack dockerImageArgName
+      , "' explicitly, in your configuration file."]
 
 -- | Add a default Docker tag name to a given base image.
 addDefaultTag ::
src/Stack/Config/Nix.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE RecordWildCards    #-}
 
@@ -16,7 +15,7 @@ import           Distribution.System ( OS (..) )
 import           Stack.Constants ( osIsWindows )
 import           Stack.Prelude
-import           Stack.Types.Config ( HasRunner )
+import           Stack.Types.Runner ( HasRunner )
 import           Stack.Types.Nix ( NixOpts (..), NixOptsMonoid (..) )
 import           System.Directory ( doesFileExist )
 
@@ -43,7 +42,7 @@ 
 -- | Interprets NixOptsMonoid options.
 nixOptsFromMonoid ::
-     HasRunner env
+     (HasRunner env, HasTerm env)
   => NixOptsMonoid
   -> OS
   -> RIO env NixOpts
@@ -62,13 +61,13 @@   osIsNixOS <- isNixOS
   let nixEnable0 = fromFirst osIsNixOS nixMonoidEnable
 
-  nixEnable <- case () of
-    _
-      | nixEnable0 && osIsWindows -> do
-          logInfo
-            "Note: Disabling nix integration, since this is being run in Windows"
-          pure False
-      | otherwise -> pure nixEnable0
+  nixEnable <-
+    if nixEnable0 && osIsWindows
+      then do
+        prettyNoteS
+          "Disabling Nix integration, since this is being run in Windows."
+        pure False
+      else pure nixEnable0
 
   when (not (null nixPackages) && isJust nixInitFile) $
     throwIO NixCannotUseShellFileAndPackagesException
src/Stack/ConfigCmd.hs view
@@ -1,10 +1,7 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE OverloadedLists     #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Make changes to project or global configuration.
 module Stack.ConfigCmd
@@ -32,42 +29,50 @@ import           Options.Applicative.Builder.Extra
 import qualified Options.Applicative.Types as OA
 import           Pantry ( loadSnapshot )
-import           Path
+import           Path ( (</>), parent )
 import qualified RIO.Map as Map
 import           RIO.Process ( envVarsL )
 import           Stack.Config
                    ( makeConcreteResolver, getProjectConfig
                    , getImplicitGlobalProjectDir
                    )
-import           Stack.Constants
+import           Stack.Constants ( stackDotYaml )
 import           Stack.Prelude
-import           Stack.Types.Config
-import           Stack.Types.Resolver
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.ConfigMonoid
+                   ( configMonoidInstallGHCName, configMonoidSystemGHCName )
+import           Stack.Types.EnvConfig ( EnvConfig )
+import           Stack.Types.EnvSettings ( EnvSettings (..) )
+import           Stack.Types.GHCVariant ( HasGHCVariant )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
+import           Stack.Types.Resolver ( AbstractResolver, readAbstractResolver )
+import           Stack.Types.Runner ( globalOptsL )
 import           System.Environment ( getEnvironment )
 
 -- | Type repesenting exceptions thrown by functions exported by the
 -- "Stack.ConfigCmd" module.
 data ConfigCmdException
-    = NoProjectConfigAvailable
-    deriving (Show, Typeable)
+  = NoProjectConfigAvailable
+  deriving (Show, Typeable)
 
 instance Exception ConfigCmdException where
-    displayException NoProjectConfigAvailable =
-        "Error: [S-3136]\n"
-        ++ "'config' command used when no project configuration available."
+  displayException NoProjectConfigAvailable =
+    "Error: [S-3136]\n"
+    ++ "'config' command used when no project configuration available."
 
 data ConfigCmdSet
-    = ConfigCmdSetResolver !(Unresolved AbstractResolver)
-    | ConfigCmdSetSystemGhc !CommandScope !Bool
-    | ConfigCmdSetInstallGhc !CommandScope !Bool
-    | ConfigCmdSetDownloadPrefix !CommandScope !Text
+  = ConfigCmdSetResolver !(Unresolved AbstractResolver)
+  | ConfigCmdSetSystemGhc !CommandScope !Bool
+  | ConfigCmdSetInstallGhc !CommandScope !Bool
+  | ConfigCmdSetDownloadPrefix !CommandScope !Text
 
 data CommandScope
-    = CommandScopeGlobal
-      -- ^ Apply changes to the global configuration,
-      --   typically at @~/.stack/config.yaml@.
-    | CommandScopeProject
-      -- ^ Apply changes to the project @stack.yaml@.
+  = CommandScopeGlobal
+    -- ^ Apply changes to the global configuration,
+    --   typically at @~/.stack/config.yaml@.
+  | CommandScopeProject
+    -- ^ Apply changes to the project @stack.yaml@.
 
 configCmdSetScope :: ConfigCmdSet -> CommandScope
 configCmdSetScope (ConfigCmdSetResolver _) = CommandScopeProject
@@ -75,139 +80,152 @@ configCmdSetScope (ConfigCmdSetInstallGhc scope _) = scope
 configCmdSetScope (ConfigCmdSetDownloadPrefix scope _) = scope
 
-cfgCmdSet
-    :: (HasConfig env, HasGHCVariant env)
-    => ConfigCmdSet -> RIO env ()
+cfgCmdSet ::
+     (HasConfig env, HasGHCVariant env)
+  => ConfigCmdSet -> RIO env ()
 cfgCmdSet cmd = do
-    conf <- view configL
-    configFilePath <-
-             case configCmdSetScope cmd of
-                 CommandScopeProject -> do
-                     mstackYamlOption <- view $ globalOptsL.to globalStackYaml
-                     mstackYaml <- getProjectConfig mstackYamlOption
-                     case mstackYaml of
-                         PCProject stackYaml -> pure stackYaml
-                         PCGlobalProject -> liftM (</> stackDotYaml) (getImplicitGlobalProjectDir conf)
-                         PCNoProject _extraDeps -> throwIO NoProjectConfigAvailable
-                         -- maybe modify the ~/.stack/config.yaml file instead?
-                 CommandScopeGlobal -> pure (configUserConfigPath conf)
-    rawConfig <- liftIO (readFileUtf8 (toFilePath configFilePath))
-    config <- either throwM pure (Yaml.decodeEither' $ encodeUtf8 rawConfig)
-    newValue <- cfgCmdSetValue (parent configFilePath) cmd
-    let yamlLines = T.lines rawConfig
-        cmdKeys = cfgCmdSetKeys cmd  -- Text
-        newValue' = T.stripEnd $
-            decodeUtf8With lenientDecode $ Yaml.encode newValue  -- Text
-        file = toFilePath configFilePath  -- String
-        file' = display $ T.pack file     -- Utf8Builder
-    newYamlLines <- case inConfig config cmdKeys of
-        Nothing -> do
-            logInfo $ file' <> " has been extended."
-            pure $ writeLines yamlLines "" cmdKeys newValue'
-        Just oldValue -> if oldValue == newValue
-            then do
-                logInfo $ file' <> " already contained the intended \
-                    \configuration and remains unchanged."
-                pure yamlLines
-            else switchLine file' (NE.last cmdKeys) newValue' [] yamlLines
-    liftIO $ writeFileUtf8 file (T.unlines newYamlLines)
-  where
-    -- This assumes that if the key does not exist, the lines that can be
-    -- appended to include it are of a form like:
-    --
-    -- key1:
-    --   key2:
-    --     key3: value
-    --
-    writeLines yamlLines spaces cmdKeys value = case NE.tail cmdKeys of
-      [] -> yamlLines <> [spaces <> NE.head cmdKeys <> ": " <> value]
-      ks -> writeLines (yamlLines <> [spaces <> NE.head cmdKeys <> ":"])
-                       (spaces <> "  ")
-                       (NE.fromList ks)
-                       value
+  conf <- view configL
+  configFilePath <-
+    case configCmdSetScope cmd of
+      CommandScopeProject -> do
+        mstackYamlOption <- view $ globalOptsL.to globalStackYaml
+        mstackYaml <- getProjectConfig mstackYamlOption
+        case mstackYaml of
+          PCProject stackYaml -> pure stackYaml
+          PCGlobalProject ->
+            fmap (</> stackDotYaml) (getImplicitGlobalProjectDir conf)
+          PCNoProject _extraDeps -> throwIO NoProjectConfigAvailable
+          -- maybe modify the ~/.stack/config.yaml file instead?
+      CommandScopeGlobal -> pure (configUserConfigPath conf)
+  rawConfig <- liftIO (readFileUtf8 (toFilePath configFilePath))
+  config <- either throwM pure (Yaml.decodeEither' $ encodeUtf8 rawConfig)
+  newValue <- cfgCmdSetValue (parent configFilePath) cmd
+  let yamlLines = T.lines rawConfig
+      cmdKeys = cfgCmdSetKeys cmd  -- Text
+      newValue' = T.stripEnd $
+        decodeUtf8With lenientDecode $ Yaml.encode newValue  -- Text
+      file = toFilePath configFilePath  -- String
+  newYamlLines <- case inConfig config cmdKeys of
+    Nothing -> do
+      prettyInfoL
+        [ pretty configFilePath
+        , flow "has been extended."
+        ]
+      pure $ writeLines yamlLines "" cmdKeys newValue'
+    Just oldValue -> if oldValue == newValue
+      then do
+        prettyInfoL
+          [ pretty configFilePath
+          , flow "already contained the intended configuration and remains \
+                 \unchanged."
+          ]
+        pure yamlLines
+      else switchLine configFilePath (NE.last cmdKeys) newValue' [] yamlLines
+  liftIO $ writeFileUtf8 file (T.unlines newYamlLines)
+ where
+  -- This assumes that if the key does not exist, the lines that can be
+  -- appended to include it are of a form like:
+  --
+  -- key1:
+  --   key2:
+  --     key3: value
+  --
+  writeLines yamlLines spaces cmdKeys value = case NE.tail cmdKeys of
+    [] -> yamlLines <> [spaces <> NE.head cmdKeys <> ": " <> value]
+    ks -> writeLines (yamlLines <> [spaces <> NE.head cmdKeys <> ":"])
+                     (spaces <> "  ")
+                     (NE.fromList ks)
+                     value
 
-    inConfig v cmdKeys = case v of
-        Yaml.Object obj ->
-            case KeyMap.lookup (Key.fromText (NE.head cmdKeys)) obj of
-                Nothing -> Nothing
-                Just v' -> case NE.tail cmdKeys of
-                    [] -> Just v'
-                    ks -> inConfig v' (NE.fromList ks)
-        _ -> Nothing
+  inConfig v cmdKeys = case v of
+    Yaml.Object obj ->
+      case KeyMap.lookup (Key.fromText (NE.head cmdKeys)) obj of
+        Nothing -> Nothing
+        Just v' -> case NE.tail cmdKeys of
+          [] -> Just v'
+          ks -> inConfig v' (NE.fromList ks)
+    _ -> Nothing
 
-    switchLine file cmdKey _ searched [] = do
-        logWarn $ display cmdKey <> " not found in YAML file " <> file <>
-            " as a single line. Multi-line key:value formats are not supported."
-        pure $ reverse searched
-    switchLine file cmdKey newValue searched (oldLine:rest) =
-        case parseOnly (parseLine cmdKey) oldLine of
-            Left _ ->
-                switchLine file cmdKey newValue (oldLine:searched) rest
-            Right (kt, spaces1, spaces2, spaces3, comment) -> do
-                let newLine = spaces1 <> renderKey cmdKey kt <> spaces2 <>
-                        ":" <> spaces3 <> newValue <> comment
-                logInfo $ file <> " has been updated."
-                pure $ reverse searched <> (newLine:rest)
+  switchLine file cmdKey _ searched [] = do
+    prettyWarnL
+      [ style Current (fromString $ T.unpack cmdKey)
+      , flow "not found in YAML file"
+      , pretty file
+      , flow "as a single line. Multi-line key:value formats are not \
+             \supported."
+      ]
+    pure $ reverse searched
+  switchLine file cmdKey newValue searched (oldLine:rest) =
+    case parseOnly (parseLine cmdKey) oldLine of
+      Left _ -> switchLine file cmdKey newValue (oldLine:searched) rest
+      Right (kt, spaces1, spaces2, spaces3, comment) -> do
+        let newLine = spaces1 <> renderKey cmdKey kt <> spaces2 <>
+                ":" <> spaces3 <> newValue <> comment
+        prettyInfoL
+          [ pretty file
+          , flow "has been updated."
+          ]
+        pure $ reverse searched <> (newLine:rest)
 
-    parseLine :: Text -> Parser (KeyType, Text, Text, Text, Text)
-    parseLine key = do
-        spaces1 <- P.takeWhile (== ' ')
-        kt <- parseKey key
-        spaces2 <- P.takeWhile (== ' ')
-        skip (== ':')
-        spaces3 <- P.takeWhile (== ' ')
-        skipWhile (/= ' ')
-        comment <- takeText
-        pure (kt, spaces1, spaces2, spaces3, comment)
+  parseLine :: Text -> Parser (KeyType, Text, Text, Text, Text)
+  parseLine key = do
+    spaces1 <- P.takeWhile (== ' ')
+    kt <- parseKey key
+    spaces2 <- P.takeWhile (== ' ')
+    skip (== ':')
+    spaces3 <- P.takeWhile (== ' ')
+    skipWhile (/= ' ')
+    comment <- takeText
+    pure (kt, spaces1, spaces2, spaces3, comment)
 
-    -- If the key is, for example, install-ghc, this recognises install-ghc,
-    -- 'install-ghc' or "install-ghc".
-    parseKey :: Text -> Parser KeyType
-    parseKey k =   parsePlainKey k
-               <|> parseSingleQuotedKey k
-               <|> parseDoubleQuotedKey k
+  -- If the key is, for example, install-ghc, this recognises install-ghc,
+  -- 'install-ghc' or "install-ghc".
+  parseKey :: Text -> Parser KeyType
+  parseKey k =   parsePlainKey k
+    <|> parseSingleQuotedKey k
+    <|> parseDoubleQuotedKey k
 
-    parsePlainKey :: Text -> Parser KeyType
-    parsePlainKey key = do
-      _ <- P.string key
-      pure PlainKey
+  parsePlainKey :: Text -> Parser KeyType
+  parsePlainKey key = do
+    _ <- P.string key
+    pure PlainKey
 
-    parseSingleQuotedKey :: Text -> Parser KeyType
-    parseSingleQuotedKey = parseQuotedKey SingleQuotedKey '\''
+  parseSingleQuotedKey :: Text -> Parser KeyType
+  parseSingleQuotedKey = parseQuotedKey SingleQuotedKey '\''
 
-    parseDoubleQuotedKey :: Text -> Parser KeyType
-    parseDoubleQuotedKey = parseQuotedKey DoubleQuotedKey '"'
+  parseDoubleQuotedKey :: Text -> Parser KeyType
+  parseDoubleQuotedKey = parseQuotedKey DoubleQuotedKey '"'
 
-    parseQuotedKey :: KeyType -> Char -> Text -> Parser KeyType
-    parseQuotedKey kt c key = do
-        skip (==c)
-        _ <- P.string key
-        skip (==c)
-        pure kt
+  parseQuotedKey :: KeyType -> Char -> Text -> Parser KeyType
+  parseQuotedKey kt c key = do
+    skip (==c)
+    _ <- P.string key
+    skip (==c)
+    pure kt
 
-    renderKey :: Text -> KeyType -> Text
-    renderKey key kt = case kt of
-        PlainKey -> key
-        SingleQuotedKey -> '\'' `T.cons` key `T.snoc` '\''
-        DoubleQuotedKey -> '"' `T.cons` key `T.snoc` '"'
+  renderKey :: Text -> KeyType -> Text
+  renderKey key kt = case kt of
+    PlainKey -> key
+    SingleQuotedKey -> '\'' `T.cons` key `T.snoc` '\''
+    DoubleQuotedKey -> '"' `T.cons` key `T.snoc` '"'
 
 -- |Type representing types of representations of keys in YAML files.
 data KeyType
-    = PlainKey  -- ^ For example: install-ghc
-    | SingleQuotedKey  -- ^ For example: 'install-ghc'
-    | DoubleQuotedKey  -- ^ For example: "install-ghc"
-    deriving (Eq, Show)
+  = PlainKey  -- ^ For example: install-ghc
+  | SingleQuotedKey  -- ^ For example: 'install-ghc'
+  | DoubleQuotedKey  -- ^ For example: "install-ghc"
+  deriving (Eq, Show)
 
-cfgCmdSetValue
-    :: (HasConfig env, HasGHCVariant env)
-    => Path Abs Dir -- ^ root directory of project
-    -> ConfigCmdSet -> RIO env Yaml.Value
+cfgCmdSetValue ::
+     (HasConfig env, HasGHCVariant env)
+  => Path Abs Dir -- ^ root directory of project
+  -> ConfigCmdSet -> RIO env Yaml.Value
 cfgCmdSetValue root (ConfigCmdSetResolver newResolver) = do
-    newResolver' <- resolvePaths (Just root) newResolver
-    concreteResolver <- makeConcreteResolver newResolver'
-    -- Check that the snapshot actually exists
-    void $ loadSnapshot =<< completeSnapshotLocation concreteResolver
-    pure (Yaml.toJSON concreteResolver)
+  newResolver' <- resolvePaths (Just root) newResolver
+  concreteResolver <- makeConcreteResolver newResolver'
+  -- Check that the snapshot actually exists
+  void $ loadSnapshot =<< completeSnapshotLocation concreteResolver
+  pure (Yaml.toJSON concreteResolver)
 cfgCmdSetValue _ (ConfigCmdSetSystemGhc _ bool') = pure $ Yaml.Bool bool'
 cfgCmdSetValue _ (ConfigCmdSetInstallGhc _ bool') = pure $ Yaml.Bool bool'
 cfgCmdSetValue _ (ConfigCmdSetDownloadPrefix _ url) = pure $ Yaml.String url
@@ -218,7 +236,7 @@ cfgCmdSetKeys (ConfigCmdSetSystemGhc _ _) = [configMonoidSystemGHCName]
 cfgCmdSetKeys (ConfigCmdSetInstallGhc _ _) = [configMonoidInstallGHCName]
 cfgCmdSetKeys (ConfigCmdSetDownloadPrefix _ _) =
-    ["package-index", "download-prefix"]
+  ["package-index", "download-prefix"]
 
 cfgCmdName :: String
 cfgCmdName = "config"
@@ -231,47 +249,47 @@ 
 configCmdSetParser :: OA.Parser ConfigCmdSet
 configCmdSetParser =
-      OA.hsubparser $
-        mconcat
-          [ OA.command "resolver"
-              ( OA.info
-                  (   ConfigCmdSetResolver
-                  <$> OA.argument
-                        readAbstractResolver
-                        (  OA.metavar "SNAPSHOT"
-                        <> OA.help "E.g. \"nightly\" or \"lts-7.2\"" ))
-                  ( OA.progDesc
-                      "Change the resolver of the current project." ))
-          , OA.command (T.unpack configMonoidSystemGHCName)
-              ( OA.info
-                  (   ConfigCmdSetSystemGhc
-                  <$> scopeFlag
-                  <*> boolArgument )
-                  ( OA.progDesc
-                      "Configure whether Stack should use a system GHC \
-                      \installation or not." ))
-          , OA.command (T.unpack configMonoidInstallGHCName)
-              ( OA.info
-                  (   ConfigCmdSetInstallGhc
-                  <$> scopeFlag
-                  <*> boolArgument )
-                  ( OA.progDesc
-                      "Configure whether Stack should automatically install \
-                      \GHC when necessary." ))
-          , OA.command "package-index"
-              ( OA.info
-                  ( OA.hsubparser $
-                      OA.command "download-prefix"
-                        ( OA.info
-                            (   ConfigCmdSetDownloadPrefix
-                            <$> scopeFlag
-                            <*> urlArgument )
-                            ( OA.progDesc
-                                "Configure download prefix for Stack's package \
-                                \index." )))
-                  ( OA.progDesc
-                      "Configure Stack's package index" ))
-          ]
+  OA.hsubparser $
+    mconcat
+      [ OA.command "resolver"
+          ( OA.info
+              (   ConfigCmdSetResolver
+              <$> OA.argument
+                    readAbstractResolver
+                    (  OA.metavar "SNAPSHOT"
+                    <> OA.help "E.g. \"nightly\" or \"lts-7.2\"" ))
+              ( OA.progDesc
+                  "Change the resolver of the current project." ))
+      , OA.command (T.unpack configMonoidSystemGHCName)
+          ( OA.info
+              (   ConfigCmdSetSystemGhc
+              <$> scopeFlag
+              <*> boolArgument )
+              ( OA.progDesc
+                  "Configure whether Stack should use a system GHC \
+                  \installation or not." ))
+      , OA.command (T.unpack configMonoidInstallGHCName)
+          ( OA.info
+              (   ConfigCmdSetInstallGhc
+              <$> scopeFlag
+              <*> boolArgument )
+              ( OA.progDesc
+                  "Configure whether Stack should automatically install \
+                  \GHC when necessary." ))
+      , OA.command "package-index"
+          ( OA.info
+              ( OA.hsubparser $
+                  OA.command "download-prefix"
+                    ( OA.info
+                        (   ConfigCmdSetDownloadPrefix
+                        <$> scopeFlag
+                        <*> urlArgument )
+                        ( OA.progDesc
+                            "Configure download prefix for Stack's package \
+                            \index." )))
+              ( OA.progDesc
+                  "Configure Stack's package index" ))
+      ]
 
 scopeFlag :: OA.Parser CommandScope
 scopeFlag = OA.flag
src/Stack/Constants.hs view
@@ -10,6 +10,8 @@   , buildPlanCacheDir
   , haskellFileExts
   , haskellDefaultPreprocessorExts
+  , stackProgName
+  , stackProgName'
   , stackDotYaml
   , stackWorkEnvVar
   , stackRootEnvVar
@@ -17,7 +19,6 @@   , stackRootOptionName
   , stackGlobalConfigOptionName
   , pantryRootEnvVar
-  , deprecatedStackRootOptionName
   , inContainerEnvVar
   , inNixShellEnvVar
   , stackProgNameUpper
@@ -45,6 +46,8 @@   , relFileCabalMacrosH
   , relDirBuild
   , relDirBin
+  , relDirGhci
+  , relDirGhciScript
   , relDirPantry
   , relDirPrograms
   , relDirUpperPrograms
@@ -52,6 +55,7 @@   , relDirStackWork
   , relFileReadmeTxt
   , relDirScript
+  , relDirScripts
   , relFileConfigYaml
   , relDirSnapshots
   , relDirGlobalHints
@@ -88,7 +92,6 @@   , relDirAll
   , relFilePackageCache
   , relFileDockerfile
-  , relDirHaskellStackGhci
   , relFileGhciScript
   , relDirCombined
   , relFileHpcIndexHtml
@@ -125,16 +128,22 @@   , relFileBuildLock
   , stackDeveloperModeDefault
   , globalFooter
+  , gitHubBasicAuthType
+  , gitHubTokenEnvVar
+  , altGitHubTokenEnvVar
   ) where
 
 import           Data.ByteString.Builder ( byteString )
 import           Data.Char ( toUpper )
 import           Data.FileEmbed ( embedFile, makeRelativeToProject )
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import           Distribution.Package ( mkPackageName )
 import           Hpack.Config ( packageConfig )
 import qualified Language.Haskell.TH.Syntax as TH ( runIO, lift )
-import           Path as FL
+import           Path ( (</>), mkRelDir, mkRelFile, parseAbsFile )
+import           Stack.Constants.StackProgName ( stackProgName )
+import           Stack.Constants.UsrLibDirs ( usrLibDirs )
 import           Stack.Prelude
 import           Stack.Types.Compiler ( WhichCompiler (..) )
 import           System.Permissions ( osIsWindows )
@@ -150,6 +159,10 @@   displayException WiredInPackagesNotParsedBug = bugReport "[S-6057]"
     "Parse error in wiredInPackages."
 
+-- | Name of the Stack program.
+stackProgName' :: Text
+stackProgName' = T.pack stackProgName
+
 -- | Extensions used for Haskell modules. Excludes preprocessor ones.
 haskellFileExts :: [Text]
 haskellFileExts = ["hs", "hsc", "lhs"]
@@ -190,15 +203,6 @@ pantryRootEnvVar :: String
 pantryRootEnvVar = "PANTRY_ROOT"
 
--- | Deprecated option name for the global Stack root.
---
--- Deprecated since stack-1.1.0.
---
--- TODO: Remove occurrences of this variable and use 'stackRootOptionName' only
--- after an appropriate deprecation period.
-deprecatedStackRootOptionName :: String
-deprecatedStackRootOptionName = "global-stack-root"
-
 -- | Environment variable used to indicate Stack is running in container.
 inContainerEnvVar :: String
 inContainerEnvVar = stackProgNameUpper ++ "_IN_CONTAINER"
@@ -230,7 +234,7 @@     [ "ghc-prim"
       -- A magic package
     , "integer-gmp"
-      -- No longer magic > 1.0.3.0. With GHC 9.2.5 at least, there seems to be
+      -- No longer magic > 1.0.3.0. With GHC 9.2.7 at least, there seems to be
       -- no problem in using it.
     , "integer-simple"
       -- A magic package
@@ -242,16 +246,16 @@       -- A magic package
     , "dph-seq"
       -- Deprecated in favour of dph-prim-seq, which does not appear to be
-      -- magic. With GHC 9.2.5 at least, there seems to be no problem in using
+      -- magic. With GHC 9.2.7 at least, there seems to be no problem in using
       -- it.
     , "dph-par"
       --  Deprecated in favour of dph-prim-par, which does not appear to be
-      -- magic. With GHC 9.2.5 at least, there seems to be no problem in using
+      -- magic. With GHC 9.2.7 at least, there seems to be no problem in using
       -- it.
     , "ghc"
       -- A magic package
     , "interactive"
-      -- Could not identify information about this package name. With GHC 9.2.5
+      -- Could not identify information about this package name. With GHC 9.2.7
       -- at least, there seems to be no problem in using it.
     , "ghc-bignum"
       -- A magic package
@@ -303,8 +307,8 @@ buildPlanDir = (</> $(mkRelDir "build-plan"))
 
 -- | Path where binary caches of the build plans are stored.
-buildPlanCacheDir
-  :: Path Abs Dir -- ^ Stack root
+buildPlanCacheDir ::
+     Path Abs Dir -- ^ Stack root
   -> Path Abs Dir
 buildPlanCacheDir = (</> $(mkRelDir "build-plan-cache"))
 
@@ -362,6 +366,12 @@ relDirBin :: Path Rel Dir
 relDirBin = $(mkRelDir "bin")
 
+relDirGhci :: Path Rel Dir
+relDirGhci = $(mkRelDir "ghci")
+
+relDirGhciScript :: Path Rel Dir
+relDirGhciScript = $(mkRelDir "ghci-script")
+
 relDirPantry :: Path Rel Dir
 relDirPantry = $(mkRelDir "pantry")
 
@@ -383,6 +393,9 @@ relDirScript :: Path Rel Dir
 relDirScript = $(mkRelDir "script")
 
+relDirScripts :: Path Rel Dir
+relDirScripts = $(mkRelDir "scripts")
+
 relFileConfigYaml :: Path Rel File
 relFileConfigYaml = $(mkRelFile "config.yaml")
 
@@ -495,9 +508,6 @@ relFileDockerfile :: Path Rel File
 relFileDockerfile = $(mkRelFile "Dockerfile")
 
-relDirHaskellStackGhci :: Path Rel Dir
-relDirHaskellStackGhci = $(mkRelDir "haskell-stack-ghci")
-
 relFileGhciScript :: Path Rel File
 relFileGhciScript = $(mkRelFile "ghci-script")
 
@@ -598,14 +608,6 @@ hadrianScriptsPosix :: [Path Rel File]
 hadrianScriptsPosix = [$(mkRelFile "hadrian/build-stack"), $(mkRelFile "hadrian/build.stack.sh")]
 
--- | Used in Stack.Setup for detecting libtinfo, see comments at use site
-usrLibDirs :: [Path Abs Dir]
-#if WINDOWS
-usrLibDirs = []
-#else
-usrLibDirs = [$(mkAbsDir "/usr/lib"),$(mkAbsDir "/usr/lib64")]
-#endif
-
 -- | Relative file path for a temporary GHC environment file for tests
 testGhcEnvRelFile :: Path Rel File
 testGhcEnvRelFile = $(mkRelFile "test-ghc-env")
@@ -622,3 +624,17 @@ globalFooter :: String
 globalFooter =
   "Command 'stack --help' for global options that apply to all subcommands."
+
+-- | The type for GitHub REST API HTTP \'Basic\' authentication.
+gitHubBasicAuthType :: ByteString
+gitHubBasicAuthType = "Bearer"
+
+-- | Environment variable to hold credentials for GitHub REST API HTTP \'Basic\'
+-- authentication.
+gitHubTokenEnvVar :: String
+gitHubTokenEnvVar = "GH_TOKEN"
+
+-- | Alternate environment variable to hold credentials for GitHub REST API HTTP
+-- \'Basic\' authentication.
+altGitHubTokenEnvVar :: String
+altGitHubTokenEnvVar = "GITHUB_TOKEN"
src/Stack/Constants/Config.hs view
@@ -23,92 +23,97 @@   , templatesDir
   ) where
 
-import           Path
+import           Path ( (</>), mkRelDir, mkRelFile, parseRelDir )
 import           Stack.Constants
+                   ( cabalPackageName, relDirDist, relDirGhci, relDirHpc )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.BuildConfig ( HasBuildConfig, projectRootL )
+import           Stack.Types.CompilerPaths ( cabalVersionL )
+import           Stack.Types.Config ( Config, HasConfig, stackRootL, workDirL )
+import           Stack.Types.EnvConfig
+                   ( HasEnvConfig, platformGhcRelDir, useShaPathOnWindows )
 
 -- | Output .o/.hi directory.
 objectInterfaceDirL :: HasBuildConfig env => Getting r env (Path Abs Dir)
 objectInterfaceDirL = to $ \env -> -- FIXME is this idiomatic lens code?
   let workDir = view workDirL env
       root = view projectRootL env
-   in root </> workDir </> $(mkRelDir "odir/")
+  in  root </> workDir </> $(mkRelDir "odir/")
 
 -- | GHCi files directory.
 ghciDirL :: HasBuildConfig env => Getting r env (Path Abs Dir)
 ghciDirL = to $ \env -> -- FIXME is this idiomatic lens code?
   let workDir = view workDirL env
       root = view projectRootL env
-   in root </> workDir </> $(mkRelDir "ghci/")
+  in  root </> workDir </> relDirGhci
 
 -- | The directory containing the files used for dirtiness check of source files.
 buildCachesDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                => Path Abs Dir      -- ^ Package directory.
                -> m (Path Abs Dir)
 buildCachesDir dir =
-    liftM
-        (</> $(mkRelDir "stack-build-caches"))
-        (distDirFromDir dir)
+  fmap
+    (</> $(mkRelDir "stack-build-caches"))
+    (distDirFromDir dir)
 
 -- | The filename used to mark tests as having succeeded
 testSuccessFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                 => Path Abs Dir -- ^ Package directory
                 -> m (Path Abs File)
 testSuccessFile dir =
-    liftM
-        (</> $(mkRelFile "stack-test-success"))
-        (distDirFromDir dir)
+  fmap
+    (</> $(mkRelFile "stack-test-success"))
+    (distDirFromDir dir)
 
 -- | The filename used to mark tests as having built
 testBuiltFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
               => Path Abs Dir -- ^ Package directory
               -> m (Path Abs File)
 testBuiltFile dir =
-    liftM
-        (</> $(mkRelFile "stack-test-built"))
-        (distDirFromDir dir)
+  fmap
+    (</> $(mkRelFile "stack-test-built"))
+    (distDirFromDir dir)
 
 -- | The filename used for modification check of .cabal
 configCabalMod :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                => Path Abs Dir      -- ^ Package directory.
                -> m (Path Abs File)
 configCabalMod dir =
-    liftM
-        (</> $(mkRelFile "stack-cabal-mod"))
-        (distDirFromDir dir)
+  fmap
+    (</> $(mkRelFile "stack-cabal-mod"))
+    (distDirFromDir dir)
 
 -- | The filename used for modification check of setup-config
 configSetupConfigMod :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                      => Path Abs Dir      -- ^ Package directory.
                      -> m (Path Abs File)
 configSetupConfigMod dir =
-    liftM
-        (</> $(mkRelFile "stack-setup-config-mod"))
-        (distDirFromDir dir)
+  fmap
+    (</> $(mkRelFile "stack-setup-config-mod"))
+    (distDirFromDir dir)
 
 -- | The filename used for the project root from the last build of a package
 configPackageProjectRoot :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                      => Path Abs Dir      -- ^ Package directory.
                      -> m (Path Abs File)
 configPackageProjectRoot dir =
-    liftM
-        (</> $(mkRelFile "stack-project-root"))
-        (distDirFromDir dir)
+  fmap
+    (</> $(mkRelFile "stack-project-root"))
+    (distDirFromDir dir)
 
 -- | Directory for HPC work.
-hpcDirFromDir
-    :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
+hpcDirFromDir ::
+       (MonadThrow m, MonadReader env m, HasEnvConfig env)
     => Path Abs Dir  -- ^ Package directory.
     -> m (Path Abs Dir)
 hpcDirFromDir fp =
-    liftM (fp </>) hpcRelativeDir
+  fmap (fp </>) hpcRelativeDir
 
 -- | Relative location of directory for HPC work.
 hpcRelativeDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
                => m (Path Rel Dir)
 hpcRelativeDir =
-    liftM (</> $(mkRelDir "hpc")) distRelativeDir
+  fmap (</> relDirHpc) distRelativeDir
 
 -- | Package's setup-config storing Cabal configuration
 setupConfigFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
@@ -123,25 +128,25 @@                => Path Abs Dir
                -> m (Path Abs Dir)
 distDirFromDir fp =
-    liftM (fp </>) distRelativeDir
+  fmap (fp </>) distRelativeDir
 
 -- | The directory containing all dist directories, including all
 -- different GHC/Cabal combos.
-rootDistDirFromDir
-  :: (MonadReader env m, HasConfig env)
+rootDistDirFromDir ::
+     (MonadReader env m, HasConfig env)
   => Path Abs Dir
   -> m (Path Abs Dir)
 rootDistDirFromDir fp =
-    liftM (fp </>) rootDistRelativeDir
+  fmap (fp </>) rootDistRelativeDir
 
 -- | Relative directory to the top dist directory, containing
 -- individual GHC/Cabal combo as subdirs.
-rootDistRelativeDir
-  :: (MonadReader env m, HasConfig env)
+rootDistRelativeDir ::
+     (MonadReader env m, HasConfig env)
   => m (Path Rel Dir)
 rootDistRelativeDir = do
     workDir <- view workDirL
-    pure $ workDir </> $(mkRelDir "dist")
+    pure $ workDir </> relDirDist
 
 -- | Package's working directory.
 workDirFromDir :: (MonadReader env m, HasConfig env)
+ src/Stack/Constants/StackProgName.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Constants.StackProgName
+  ( stackProgName
+  ) where
+
+import           Stack.Prelude ( String )
+
+-- | Name of the Stack program.
+
+-- NOTE: Defined in this module rather than in "Stack.Constants", due to
+-- GHC stage restrictions and the use of Template Haskell.
+stackProgName :: String
+stackProgName = "stack"
src/Stack/Coverage.hs view
@@ -1,18 +1,14 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TupleSections         #-}
 
 -- | Generate HPC (Haskell Program Coverage) reports
 module Stack.Coverage
-  ( deleteHpcReports
+  ( HpcReportOpts (..)
+  , hpcReportCmd
+  , deleteHpcReports
   , updateTixFile
   , generateHpcReport
-  , HpcReportOpts (..)
   , generateHpcReportForTargets
   , generateHpcUnifiedReport
   , generateHpcMarkupIndex
@@ -27,54 +23,104 @@ import qualified Data.Text.Lazy as LT
 import           Distribution.Version ( mkVersion )
 import           Path
+                   ( (</>), dirname, filename, parent, parseAbsFile, parseRelDir
+                   , parseRelFile, stripProperPrefix
+                   )
 import           Path.Extra ( toFilePathNoTrailingSep )
 import           Path.IO
-import           RIO.Process
-import           Stack.Build.Target
+                   ( copyFile, doesDirExist, doesFileExist, ensureDir
+                   , ignoringAbsence, listDir, removeDirRecur, removeFile
+                   , resolveDir', resolveFile'
+                   )
+import           RIO.Process ( ProcessException, proc, readProcess_ )
+import           Stack.Build.Target ( NeedTargets (..) )
 import           Stack.Constants
-import           Stack.Constants.Config
-import           Stack.Package
+                   ( relDirAll, relDirCombined, relDirCustom
+                   , relDirExtraTixFiles, relDirPackageConfInplace
+                   , relFileHpcIndexHtml, relFileIndexHtml
+                   )
+import           Stack.Constants.Config ( distDirFromDir, hpcRelativeDir )
 import           Stack.Prelude
-import           Stack.Types.Compiler
-import           Stack.Types.Config
-import           Stack.Types.NamedComponent
+import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.Compiler ( getGhcVersion )
+import           Stack.Types.CompilerPaths ( cabalVersionL )
+import           Stack.Types.BuildOpts ( BuildOptsCLI (..), defaultBuildOptsCLI )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL
+                   , hpcReportDir
+                   )
+import           Stack.Types.NamedComponent ( NamedComponent (..) )
 import           Stack.Types.Package
+                   ( Package (..), PackageLibraries (..), packageIdentifier )
+import           Stack.Types.Runner ( Runner )
 import           Stack.Types.SourceMap
+                   ( PackageType (..), SMTargets (..), SMWanted (..)
+                   , SourceMap (..), Target (..), ppRoot
+                   )
 import           System.FilePath ( isPathSeparator )
-import           Trace.Hpc.Tix
-import           Web.Browser (openBrowser)
+import           Trace.Hpc.Tix ( Tix (..), TixModule (..), readTix, writeTix )
+import           Web.Browser ( openBrowser )
 
--- | Type representing exceptions thrown by functions exported by the
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
 -- "Stack.Coverage" module.
-data CoverageException
-    = NonTestSuiteTarget PackageName
-    | NoTargetsOrTixSpecified
-    | NotLocalPackage PackageName
-    deriving (Show, Typeable)
+data CoveragePrettyException
+  = NonTestSuiteTarget PackageName
+  | NoTargetsOrTixSpecified
+  | NotLocalPackage PackageName
+  deriving (Show, Typeable)
 
-instance Exception CoverageException where
-    displayException (NonTestSuiteTarget name) = concat
-        [ "Error: [S-6361]\n"
-        , "Can't specify anything except test-suites as hpc report targets ("
-        , packageNameString name
-        , ") is used with a non test-suite target."
-        ]
-    displayException NoTargetsOrTixSpecified =
-        "Error: [S-2321]\n"
-        ++ "Not generating combined report, because no targets or tix files \
-           \are specified."
-    displayException (NotLocalPackage name) = concat
-        [ "Error: [S-9975]"
-        , "Expected a local package, but "
-        , packageNameString name
-        , " is either an extra-dep or in the snapshot."
-        ]
+instance Pretty CoveragePrettyException where
+  pretty (NonTestSuiteTarget name) =
+    "[S-6361]"
+    <> line
+    <> fillSep
+         [ flow "Can't specify anything except test-suites as hpc report \
+                \targets"
+         , parens (style Target . fromString . packageNameString $ name)
+         , flow "is used with a non test-suite target."
+         ]
+  pretty NoTargetsOrTixSpecified =
+    "[S-2321]"
+    <> line
+    <> flow "Not generating combined report, because no targets or tix files \
+            \are specified."
+  pretty (NotLocalPackage name) =
+    "[S-9975]"
+    <> line
+    <> fillSep
+         [ flow "Expected a local package, but"
+         , style Target . fromString . packageNameString $ name
+         , flow "is either an extra-dep or in the snapshot."
+         ]
 
+instance Exception CoveragePrettyException
+
+-- | Type representing command line options for the @stack hpc report@ command.
+data HpcReportOpts = HpcReportOpts
+  { hroptsInputs :: [Text]
+  , hroptsAll :: Bool
+  , hroptsDestDir :: Maybe String
+  , hroptsOpenBrowser :: Bool
+  }
+  deriving Show
+
+-- | Function underlying the @stack hpc report@ command.
+hpcReportCmd :: HpcReportOpts -> RIO Runner ()
+hpcReportCmd hropts = do
+  let (tixFiles, targetNames) =
+        L.partition (".tix" `T.isSuffixOf`) (hroptsInputs hropts)
+      boptsCLI = defaultBuildOptsCLI
+        { boptsCLITargets = if hroptsAll hropts then [] else targetNames }
+  withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $
+    generateHpcReportForTargets hropts tixFiles targetNames
+
 -- | Invoked at the beginning of running with "--coverage"
 deleteHpcReports :: HasEnvConfig env => RIO env ()
 deleteHpcReports = do
-    hpcDir <- hpcReportDir
-    liftIO $ ignoringAbsence (removeDirRecur hpcDir)
+  hpcDir <- hpcReportDir
+  liftIO $ ignoringAbsence (removeDirRecur hpcDir)
 
 -- | Move a tix file into a sub-directory of the hpc report directory. Deletes
 -- the old one if one is present.
@@ -85,294 +131,355 @@   -> String
   -> RIO env ()
 updateTixFile pkgName' tixSrc testName = do
-    exists <- doesFileExist tixSrc
-    when exists $ do
-        tixDest <- tixFilePath pkgName' testName
-        liftIO $ ignoringAbsence (removeFile tixDest)
-        ensureDir (parent tixDest)
-        -- Remove exe modules because they are problematic. This could be
-        -- revisited if there's a GHC version that fixes
-        -- https://ghc.haskell.org/trac/ghc/ticket/1853
-        mtix <- readTixOrLog tixSrc
-        case mtix of
-            Nothing -> logError $
-                "Error: [S-2887]\n" <>
-                "Failed to read " <>
-                fromString (toFilePath tixSrc)
-            Just tix -> do
-                liftIO $ writeTix (toFilePath tixDest) (removeExeModules tix)
-                -- TODO: ideally we'd do a file move, but IIRC this can
-                -- have problems. Something about moving between drives
-                -- on windows?
-                copyFile tixSrc =<< parseAbsFile (toFilePath tixDest ++ ".premunging")
-                liftIO $ ignoringAbsence (removeFile tixSrc)
+  exists <- doesFileExist tixSrc
+  when exists $ do
+    tixDest <- tixFilePath pkgName' testName
+    liftIO $ ignoringAbsence (removeFile tixDest)
+    ensureDir (parent tixDest)
+    -- Remove exe modules because they are problematic. This could be
+    -- revisited if there's a GHC version that fixes
+    -- https://ghc.haskell.org/trac/ghc/ticket/1853
+    mtix <- readTixOrLog tixSrc
+    case mtix of
+      Nothing -> prettyError $
+        "[S-2887]"
+        <> line
+        <> fillSep
+             [ flow "Failed to read"
+             , pretty tixSrc <> "."
+             ]
+      Just tix -> do
+        liftIO $ writeTix (toFilePath tixDest) (removeExeModules tix)
+        -- TODO: ideally we'd do a file move, but IIRC this can
+        -- have problems. Something about moving between drives
+        -- on windows?
+        copyFile tixSrc =<< parseAbsFile (toFilePath tixDest ++ ".premunging")
+        liftIO $ ignoringAbsence (removeFile tixSrc)
 
 -- | Get the directory used for hpc reports for the given pkgId.
 hpcPkgPath :: HasEnvConfig env => PackageName -> RIO env (Path Abs Dir)
 hpcPkgPath pkgName' = do
-    outputDir <- hpcReportDir
-    pkgNameRel <- parseRelDir (packageNameString pkgName')
-    pure (outputDir </> pkgNameRel)
+  outputDir <- hpcReportDir
+  pkgNameRel <- parseRelDir (packageNameString pkgName')
+  pure (outputDir </> pkgNameRel)
 
 -- | Get the tix file location, given the name of the file (without extension),
 -- and the package identifier string.
 tixFilePath :: HasEnvConfig env
             => PackageName -> String -> RIO env (Path Abs File)
 tixFilePath pkgName' testName = do
-    pkgPath <- hpcPkgPath pkgName'
-    tixRel <- parseRelFile (testName ++ "/" ++ testName ++ ".tix")
-    pure (pkgPath </> tixRel)
+  pkgPath <- hpcPkgPath pkgName'
+  tixRel <- parseRelFile (testName ++ "/" ++ testName ++ ".tix")
+  pure (pkgPath </> tixRel)
 
 -- | Generates the HTML coverage report and shows a textual coverage summary for a package.
 generateHpcReport :: HasEnvConfig env
                   => Path Abs Dir -> Package -> [Text] -> RIO env ()
 generateHpcReport pkgDir package tests = do
-    compilerVersion <- view actualCompilerVersionL
-    -- If we're using > GHC 7.10, the hpc 'include' parameter must specify a ghc package key. See
-    -- https://github.com/commercialhaskell/stack/issues/785
-    let pkgName' = T.pack $ packageNameString (packageName package)
-        pkgId = packageIdentifierString (packageIdentifier package)
-        ghcVersion = getGhcVersion compilerVersion
-        hasLibrary =
-          case packageLibraries package of
-            NoLibraries -> False
-            HasLibraries _ -> True
-        internalLibs = packageInternalLibraries package
-    eincludeName <-
-        -- Pre-7.8 uses plain PKG-version in tix files.
-        if ghcVersion < mkVersion [7, 10] then pure $ Right $ Just [pkgId]
-        -- We don't expect to find a package key if there is no library.
-        else if not hasLibrary && Set.null internalLibs then pure $ Right Nothing
-        -- Look in the inplace DB for the package key.
-        -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986
-        else do
-            -- GHC 8.0 uses package id instead of package key.
-            -- See https://github.com/commercialhaskell/stack/issues/2424
-            let hpcNameField = if ghcVersion >= mkVersion [8, 0] then "id" else "key"
-            eincludeName <- findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) internalLibs hpcNameField
-            case eincludeName of
-                Left err -> do
-                    logError $ display err
-                    pure $ Left err
-                Right includeNames -> pure $ Right $ Just $ map T.unpack includeNames
-    forM_ tests $ \testName -> do
-        tixSrc <- tixFilePath (packageName package) (T.unpack testName)
-        let report = "coverage report for " <> pkgName' <> "'s test-suite \"" <> testName <> "\""
-            reportDir = parent tixSrc
-        case eincludeName of
-            Left err -> generateHpcErrorReport reportDir (display (sanitize (T.unpack err)))
-            -- Restrict to just the current library code, if there is a library in the package (see
-            -- #634 - this will likely be customizable in the future)
-            Right mincludeName -> do
-                let extraArgs = case mincludeName of
-                        Nothing -> []
-                        Just includeNames ->
-                            "--include" : L.intersperse "--include" (map (\n -> n ++ ":") includeNames)
-                mreportPath <- generateHpcReportInternal tixSrc reportDir report extraArgs extraArgs
-                forM_ mreportPath (displayReportPath "The" report . pretty)
+  compilerVersion <- view actualCompilerVersionL
+  -- If we're using > GHC 7.10, the hpc 'include' parameter must specify a ghc package key. See
+  -- https://github.com/commercialhaskell/stack/issues/785
+  let pkgId = packageIdentifierString (packageIdentifier package)
+      pkgName' = packageNameString $ packageName package
+      ghcVersion = getGhcVersion compilerVersion
+      hasLibrary =
+        case packageLibraries package of
+          NoLibraries -> False
+          HasLibraries _ -> True
+      internalLibs = packageInternalLibraries package
+  eincludeName <-
+    -- Pre-7.8 uses plain PKG-version in tix files.
+    if ghcVersion < mkVersion [7, 10] then pure $ Right $ Just [pkgId]
+    -- We don't expect to find a package key if there is no library.
+    else if not hasLibrary && Set.null internalLibs then pure $ Right Nothing
+    -- Look in the inplace DB for the package key.
+    -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986
+    else do
+      -- GHC 8.0 uses package id instead of package key.
+      -- See https://github.com/commercialhaskell/stack/issues/2424
+      let hpcNameField = if ghcVersion >= mkVersion [8, 0] then "id" else "key"
+      eincludeName <-
+        findPackageFieldForBuiltPackage
+          pkgDir
+          (packageIdentifier package)
+          internalLibs
+          hpcNameField
+      case eincludeName of
+        Left err -> do
+          logError $ display err
+          pure $ Left err
+        Right includeNames -> pure $ Right $ Just $ map T.unpack includeNames
+  forM_ tests $ \testName -> do
+    tixSrc <- tixFilePath (packageName package) (T.unpack testName)
+    let report = fillSep
+          [ flow "coverage report for"
+          , fromString pkgName' <> "'s"
+          , "test-suite"
+          , fromString $ "\"" <> T.unpack testName <> "\""
+          ]
+        reportHtml =
+             "coverage report for"
+          <> T.pack pkgName'
+          <> "'s test-suite \""
+          <> testName
+          <> "\""
+        reportDir = parent tixSrc
+    case eincludeName of
+      Left err -> generateHpcErrorReport reportDir (display (sanitize (T.unpack err)))
+      -- Restrict to just the current library code, if there is a library in the package (see
+      -- #634 - this will likely be customizable in the future)
+      Right mincludeName -> do
+        let extraArgs = case mincludeName of
+              Nothing -> []
+              Just includeNames ->
+                  "--include"
+                : L.intersperse "--include" (map (++ ":") includeNames)
+        mreportPath <-
+          generateHpcReportInternal tixSrc reportDir report reportHtml extraArgs extraArgs
+        forM_ mreportPath (displayReportPath "The" report . pretty)
 
-generateHpcReportInternal :: HasEnvConfig env
-                          => Path Abs File -> Path Abs Dir -> Text -> [String] -> [String]
-                          -> RIO env (Maybe (Path Abs File))
-generateHpcReportInternal tixSrc reportDir report extraMarkupArgs extraReportArgs = do
-    -- If a .tix file exists, move it to the HPC output directory and generate a
-    -- report for it.
-    tixFileExists <- doesFileExist tixSrc
-    if not tixFileExists
+generateHpcReportInternal ::
+     HasEnvConfig env
+  => Path Abs File
+  -> Path Abs Dir
+  -> StyleDoc
+     -- ^ The pretty name for the report
+  -> Text
+     -- ^ The plain name for the report, used in HTML output
+  -> [String]
+  -> [String]
+  -> RIO env (Maybe (Path Abs File))
+generateHpcReportInternal tixSrc reportDir report reportHtml extraMarkupArgs extraReportArgs = do
+  -- If a .tix file exists, move it to the HPC output directory and generate a
+  -- report for it.
+  tixFileExists <- doesFileExist tixSrc
+  if not tixFileExists
+    then do
+      prettyError $
+        "[S-4634]"
+        <> line
+        <> flow "Didn't find"
+        <> style File ".tix"
+        <> "for"
+        <> report
+        <> flow "- expected to find it at"
+        <> pretty tixSrc <> "."
+      pure Nothing
+    else (`catch` \(err :: ProcessException) -> do
+           logError $ displayShow err
+           generateHpcErrorReport reportDir $ display $ sanitize $
+               displayException err
+           pure Nothing) $
+       (`onException`
+           prettyError
+             ( "[S-8215]"
+               <> line
+               <> flow "Error occurred while producing"
+               <> report <> "."
+             )) $ do
+      -- Directories for .mix files.
+      hpcRelDir <- hpcRelativeDir
+      -- Compute arguments used for both "hpc markup" and "hpc report".
+      pkgDirs <- view $ buildConfigL.to (map ppRoot . Map.elems . smwProject . bcSMWanted)
+      let args =
+            -- Use index files from all packages (allows cross-package coverage results).
+            concatMap (\x -> ["--srcdir", toFilePathNoTrailingSep x]) pkgDirs ++
+            -- Look for index files in the correct dir (relative to each pkgdir).
+            ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"]
+      prettyInfoL
+        [ "Generating"
+        , report <> "."
+        ]
+      outputLines <- map (S8.filter (/= '\r')) . S8.lines . BL.toStrict . fst <$>
+        proc "hpc"
+        ( "report"
+        : toFilePath tixSrc
+        : (args ++ extraReportArgs)
+        )
+        readProcess_
+      if all ("(0/0)" `S8.isSuffixOf`) outputLines
         then do
-            logError $
-                 "Error: [S-4634]\n" <>
-                 "Didn't find .tix for " <>
-                 display report <>
-                 " - expected to find it at " <>
-                 fromString (toFilePath tixSrc) <>
-                 "."
-            pure Nothing
-        else (`catch` \(err :: ProcessException) -> do
-                 logError $ displayShow err
-                 generateHpcErrorReport reportDir $ display $ sanitize $
-                     displayException err
-                 pure Nothing) $
-             (`onException`
-                 logError
-                   ("Error: [S-8215]\n" <>
-                    "Error occurred while producing " <>
-                    display report)) $ do
-            -- Directories for .mix files.
-            hpcRelDir <- hpcRelativeDir
-            -- Compute arguments used for both "hpc markup" and "hpc report".
-            pkgDirs <- view $ buildConfigL.to (map ppRoot . Map.elems . smwProject . bcSMWanted)
-            let args =
-                    -- Use index files from all packages (allows cross-package coverage results).
-                    concatMap (\x -> ["--srcdir", toFilePathNoTrailingSep x]) pkgDirs ++
-                    -- Look for index files in the correct dir (relative to each pkgdir).
-                    ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"]
-            logInfo $ "Generating " <> display report
-            outputLines <- liftM (map (S8.filter (/= '\r')) . S8.lines . BL.toStrict . fst) $
-                proc "hpc"
-                ( "report"
-                : toFilePath tixSrc
-                : (args ++ extraReportArgs)
-                )
-                readProcess_
-            if all ("(0/0)" `S8.isSuffixOf`) outputLines
-                then do
-                    let msg html =
-                            "Error: [S-6829]\n"<>
-                            "The " <>
-                            display report <>
-                            " did not consider any code. One possible cause of this is" <>
-                            " if your test-suite builds the library code (see Stack " <>
-                            (if html then "<a href='https://github.com/commercialhaskell/stack/issues/1008'>" else "") <>
-                            "issue #1008" <>
-                            (if html then "</a>" else "") <>
-                            "). It may also indicate a bug in Stack or" <>
-                            " the hpc program. Please report this issue if you think" <>
-                            " your coverage report should have meaningful results."
-                    logError (msg False)
-                    generateHpcErrorReport reportDir (msg True)
-                    pure Nothing
-                else do
-                    let reportPath = reportDir </> relFileHpcIndexHtml
-                    -- Print output, stripping @\r@ characters because Windows.
-                    forM_ outputLines (logInfo . displayBytesUtf8)
-                    -- Generate the markup.
-                    void $ proc "hpc"
-                        ( "markup"
-                        : toFilePath tixSrc
-                        : ("--destdir=" ++ toFilePathNoTrailingSep reportDir)
-                        : (args ++ extraMarkupArgs)
-                        )
-                        readProcess_
-                    pure (Just reportPath)
-
-data HpcReportOpts = HpcReportOpts
-    { hroptsInputs :: [Text]
-    , hroptsAll :: Bool
-    , hroptsDestDir :: Maybe String
-    , hroptsOpenBrowser :: Bool
-    } deriving (Show)
+          let msgHtml =
+                   "Error: [S-6829]\n\
+                   \The "
+                <> display reportHtml
+                <> " did not consider any code. One possible cause of this is \
+                   \if your test-suite builds the library code (see Stack \
+                   \<a href='https://github.com/commercialhaskell/stack/issues/1008'>\
+                   \issue #1008\
+                   \</a>\
+                   \). It may also indicate a bug in Stack or the hpc program. \
+                   \Please report this issue if you think your coverage report \
+                   \should have meaningful results."
+          prettyError $
+            "[S-6829]"
+            <> line
+            <> fillSep
+                 [ "The"
+                 , report
+                 , flow "did not consider any code. One possible cause of this \
+                        \is if your test-suite builds the library code (see \
+                        \Stack issue #1008). It may also indicate a bug in \
+                        \Stack or the hpc program. Please report this issue if \
+                        \you think your coverage report should have meaningful \
+                        \results."
+                 ]
+          generateHpcErrorReport reportDir msgHtml
+          pure Nothing
+        else do
+          let reportPath = reportDir </> relFileHpcIndexHtml
+          -- Print output, stripping @\r@ characters because Windows.
+          forM_ outputLines (logInfo . displayBytesUtf8)
+          -- Generate the markup.
+          void $ proc "hpc"
+            ( "markup"
+            : toFilePath tixSrc
+            : ("--destdir=" ++ toFilePathNoTrailingSep reportDir)
+            : (args ++ extraMarkupArgs)
+            )
+            readProcess_
+          pure (Just reportPath)
 
 generateHpcReportForTargets :: HasEnvConfig env
                             => HpcReportOpts -> [Text] -> [Text] -> RIO env ()
 generateHpcReportForTargets opts tixFiles targetNames = do
-    targetTixFiles <-
-         -- When there aren't any package component arguments, and --all
-         -- isn't passed, default to not considering any targets.
-         if not (hroptsAll opts) && null targetNames
-         then pure []
-         else do
-             when (hroptsAll opts && not (null targetNames)) $
-                 logWarn $ "Since --all is used, it is redundant to specify these targets: " <> displayShow targetNames
-             targets <- view $ envConfigL.to envConfigSourceMap.to smTargets.to smtTargets
-             liftM concat $ forM (Map.toList targets) $ \(name, target) ->
-                 case target of
-                     TargetAll PTDependency -> throwIO $ NotLocalPackage name
-                     TargetComps comps -> do
-                         pkgPath <- hpcPkgPath name
-                         forM (toList comps) $ \nc ->
-                             case nc of
-                                 CTest testName ->
-                                     liftM (pkgPath </>) $ parseRelFile (T.unpack testName ++ "/" ++ T.unpack testName ++ ".tix")
-                                 _ -> throwIO $ NonTestSuiteTarget name
-
-                     TargetAll PTProject -> do
-                         pkgPath <- hpcPkgPath name
-                         exists <- doesDirExist pkgPath
-                         if exists
-                             then do
-                                 (dirs, _) <- listDir pkgPath
-                                 liftM concat $ forM dirs $ \dir -> do
-                                     (_, files) <- listDir dir
-                                     pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
-                             else pure []
-    tixPaths <- liftM (\xs -> xs ++ targetTixFiles) $ mapM (resolveFile' . T.unpack) tixFiles
-    when (null tixPaths) $ throwIO NoTargetsOrTixSpecified
-    outputDir <- hpcReportDir
-    reportDir <- case hroptsDestDir opts of
-        Nothing -> pure (outputDir </> relDirCombined </> relDirCustom)
-        Just destDir -> do
-            dest <- resolveDir' destDir
-            ensureDir dest
-            pure dest
-    let report = "combined report"
-    mreportPath <- generateUnionReport report reportDir tixPaths
-    forM_ mreportPath $ \reportPath ->
-        if hroptsOpenBrowser opts
-            then do
-                prettyInfo $ "Opening" <+> pretty reportPath <+> "in the browser."
-                void $ liftIO $ openBrowser (toFilePath reportPath)
-            else displayReportPath "The" report (pretty reportPath)
+  targetTixFiles <-
+    -- When there aren't any package component arguments, and --all
+    -- isn't passed, default to not considering any targets.
+    if not (hroptsAll opts) && null targetNames
+    then pure []
+    else do
+      when (hroptsAll opts && not (null targetNames)) $
+        prettyWarnL
+          $ "Since"
+          : style Shell "--all"
+          : flow "is used, it is redundant to specify these targets:"
+          : mkNarrativeList (Just Target) False
+              (map (fromString . T.unpack) targetNames :: [StyleDoc])
+      targets <-
+        view $ envConfigL.to envConfigSourceMap.to smTargets.to smtTargets
+      fmap concat $ forM (Map.toList targets) $ \(name, target) ->
+        case target of
+          TargetAll PTDependency -> prettyThrowIO $ NotLocalPackage name
+          TargetComps comps -> do
+            pkgPath <- hpcPkgPath name
+            forM (toList comps) $
+              \case
+                CTest testName -> (pkgPath </>) <$>
+                  parseRelFile
+                    (  T.unpack testName
+                    ++ "/"
+                    ++ T.unpack testName
+                    ++ ".tix"
+                    )
+                _ -> prettyThrowIO $ NonTestSuiteTarget name
+          TargetAll PTProject -> do
+            pkgPath <- hpcPkgPath name
+            exists <- doesDirExist pkgPath
+            if exists
+              then do
+                (dirs, _) <- listDir pkgPath
+                fmap concat $ forM dirs $ \dir -> do
+                  (_, files) <- listDir dir
+                  pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
+              else pure []
+  tixPaths <- (++ targetTixFiles) <$>
+    mapM (resolveFile' . T.unpack) tixFiles
+  when (null tixPaths) $ prettyThrowIO NoTargetsOrTixSpecified
+  outputDir <- hpcReportDir
+  reportDir <- case hroptsDestDir opts of
+    Nothing -> pure (outputDir </> relDirCombined </> relDirCustom)
+    Just destDir -> do
+      dest <- resolveDir' destDir
+      ensureDir dest
+      pure dest
+  let report = flow "combined report"
+      reportHtml = "combined report"
+  mreportPath <- generateUnionReport report reportHtml reportDir tixPaths
+  forM_ mreportPath $ \reportPath ->
+    if hroptsOpenBrowser opts
+      then do
+        prettyInfo $ "Opening" <+> pretty reportPath <+> "in the browser."
+        void $ liftIO $ openBrowser (toFilePath reportPath)
+      else displayReportPath "The" report (pretty reportPath)
 
 generateHpcUnifiedReport :: HasEnvConfig env => RIO env ()
 generateHpcUnifiedReport = do
-    outputDir <- hpcReportDir
-    ensureDir outputDir
-    (dirs, _) <- listDir outputDir
-    tixFiles0 <- liftM (concat . concat) $ forM (filter (("combined" /=) . dirnameString) dirs) $ \dir -> do
-        (dirs', _) <- listDir dir
-        forM dirs' $ \dir' -> do
-            (_, files) <- listDir dir'
-            pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
-    extraTixFiles <- findExtraTixFiles
-    let tixFiles = tixFiles0  ++ extraTixFiles
-        reportDir = outputDir </> relDirCombined </> relDirAll
--- Previously, the test below was:
---
---  if length tixFiles < 2
---      then logInfo $
---          (if null tixFiles then "No tix files" else "Only one tix file") <>
---          " found in " <>
---          fromString (toFilePath outputDir) <>
---          ", so not generating a unified coverage report."
---      else ...
---
--- However, a single *.tix file does not necessarily mean that a unified
--- coverage report is redundant. For example, one package may test the library
--- of another package that does not test its own library. See
+  outputDir <- hpcReportDir
+  ensureDir outputDir
+  (dirs, _) <- listDir outputDir
+  tixFiles0 <- fmap (concat . concat) $ forM (filter (("combined" /=) . dirnameString) dirs) $ \dir -> do
+    (dirs', _) <- listDir dir
+    forM dirs' $ \dir' -> do
+      (_, files) <- listDir dir'
+      pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
+  extraTixFiles <- findExtraTixFiles
+  let tixFiles = tixFiles0  ++ extraTixFiles
+      reportDir = outputDir </> relDirCombined </> relDirAll
+-- A single *.tix file does not necessarily mean that a unified coverage report
+-- is redundant. For example, one package may test the library of another
+-- package that does not test its own library. See
 -- https://github.com/commercialhaskell/stack/issues/5713
 --
 -- As an interim solution, a unified coverage report will always be produced
 -- even if may be redundant in some circumstances.
-    if null tixFiles
-        then logInfo $ "No tix files found in " <>
-            fromString (toFilePath outputDir) <>
-            ", so not generating a unified coverage report."
-        else do
-            let report = "unified report"
-            mreportPath <- generateUnionReport report reportDir tixFiles
-            forM_ mreportPath (displayReportPath "The" report . pretty)
+  if null tixFiles
+    then prettyInfoL
+      [ flow "No tix files found in"
+      , pretty outputDir <> ","
+      , flow "so not generating a unified coverage report."
+      ]
+    else do
+      let report = flow "unified report"
+          reportHtml = "unified report"
+      mreportPath <- generateUnionReport report reportHtml reportDir tixFiles
+      forM_ mreportPath (displayReportPath "The" report . pretty)
 
-generateUnionReport :: HasEnvConfig env
-                    => Text -> Path Abs Dir -> [Path Abs File]
-                    -> RIO env (Maybe (Path Abs File))
-generateUnionReport report reportDir tixFiles = do
-    (errs, tix) <- fmap (unionTixes . map removeExeModules) (mapMaybeM readTixOrLog tixFiles)
-    logDebug $ "Using the following tix files: " <> fromString (show tixFiles)
-    unless (null errs) $ logWarn $
-        "The following modules are left out of the " <>
-        display report <>
-        " due to version mismatches: " <>
-        mconcat (L.intersperse ", " (map fromString errs))
-    tixDest <- liftM (reportDir </>) $ parseRelFile (dirnameString reportDir ++ ".tix")
-    ensureDir (parent tixDest)
-    liftIO $ writeTix (toFilePath tixDest) tix
-    generateHpcReportInternal tixDest reportDir report [] []
+generateUnionReport ::
+     HasEnvConfig env
+  => StyleDoc
+     -- ^ Pretty description of the report.
+  -> Text
+     -- ^ Plain description of the report, used in HTML reporting.
+  -> Path Abs Dir
+  -> [Path Abs File]
+  -> RIO env (Maybe (Path Abs File))
+generateUnionReport report reportHtml reportDir tixFiles = do
+  (errs, tix) <- fmap (unionTixes . map removeExeModules) (mapMaybeM readTixOrLog tixFiles)
+  logDebug $ "Using the following tix files: " <> fromString (show tixFiles)
+  unless (null errs) $
+    prettyWarn $
+      fillSep
+         [ flow "The following modules are left out of the"
+         , report
+         , flow "due to version mismatches:"
+         ]
+    <> line
+    <> bulletedList (map fromString errs :: [StyleDoc])
+  tixDest <- (reportDir </>) <$> parseRelFile (dirnameString reportDir ++ ".tix")
+  ensureDir (parent tixDest)
+  liftIO $ writeTix (toFilePath tixDest) tix
+  generateHpcReportInternal tixDest reportDir report reportHtml [] []
 
-readTixOrLog :: HasLogFunc env => Path b File -> RIO env (Maybe Tix)
+readTixOrLog :: HasTerm env => Path b File -> RIO env (Maybe Tix)
 readTixOrLog path = do
-    mtix <- liftIO (readTix (toFilePath path)) `catchAny` \errorCall -> do
-        logError $
-            "Error: [S-3521]\n" <>
-            "Error while reading tix: " <>
-            fromString (displayException errorCall)
-        pure Nothing
-    when (isNothing mtix) $
-        logError $
-            "Error: [S-7786]\n" <>
-            "Failed to read tix file " <>
-            fromString (toFilePath path)
-    pure mtix
+  mtix <- liftIO (readTix (toFilePath path)) `catchAny` \errorCall -> do
+    prettyError $
+      "[S-3521]"
+      <> line
+      <> flow "Error while reading tix:"
+      <> line
+      <> string (displayException errorCall)
+    pure Nothing
+  when (isNothing mtix) $
+    prettyError $
+      "[S-7786]"
+      <> line
+      <> fillSep
+           [ flow "Failed to read tix file"
+           , pretty path <> "."
+           ]
+  pure mtix
 
 -- | Module names which contain '/' have a package name, and so they weren't built into the
 -- executable.
@@ -381,75 +488,78 @@ 
 unionTixes :: [Tix] -> ([String], Tix)
 unionTixes tixes = (Map.keys errs, Tix (Map.elems outputs))
-  where
-    (errs, outputs) = Map.mapEither id $ Map.unionsWith merge $ map toMap tixes
-    toMap (Tix ms) = Map.fromList (map (\x@(TixModule k _ _ _) -> (k, Right x)) ms)
-    merge (Right (TixModule k hash1 len1 tix1))
-          (Right (TixModule _ hash2 len2 tix2))
-        | hash1 == hash2 && len1 == len2 = Right (TixModule k hash1 len1 (zipWith (+) tix1 tix2))
-    merge _ _ = Left ()
+ where
+  (errs, outputs) = Map.mapEither id $ Map.unionsWith merge $ map toMap tixes
+  toMap (Tix ms) = Map.fromList (map (\x@(TixModule k _ _ _) -> (k, Right x)) ms)
+  merge (Right (TixModule k hash1 len1 tix1))
+      (Right (TixModule _ hash2 len2 tix2))
+    | hash1 == hash2 && len1 == len2 = Right (TixModule k hash1 len1 (zipWith (+) tix1 tix2))
+  merge _ _ = Left ()
 
 generateHpcMarkupIndex :: HasEnvConfig env => RIO env ()
 generateHpcMarkupIndex = do
-    outputDir <- hpcReportDir
-    let outputFile = outputDir </> relFileIndexHtml
-    ensureDir outputDir
-    (dirs, _) <- listDir outputDir
-    rows <- liftM (catMaybes . concat) $ forM dirs $ \dir -> do
-        (subdirs, _) <- listDir dir
-        forM subdirs $ \subdir -> do
-            let indexPath = subdir </> relFileHpcIndexHtml
-            exists' <- doesFileExist indexPath
-            if not exists' then pure Nothing else do
-                relPath <- stripProperPrefix outputDir indexPath
-                let package = dirname dir
-                    testsuite = dirname subdir
-                pure $ Just $ T.concat
-                  [ "<tr><td>"
-                  , pathToHtml package
-                  , "</td><td><a href=\""
-                  , pathToHtml relPath
-                  , "\">"
-                  , pathToHtml testsuite
-                  , "</a></td></tr>"
-                  ]
-    writeBinaryFileAtomic outputFile $
-        "<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">" <>
-        -- Part of the css from HPC's output HTML
-        "<style type=\"text/css\">" <>
-        "table.dashboard { border-collapse: collapse; border: solid 1px black }" <>
-        ".dashboard td { border: solid 1px black }" <>
-        ".dashboard th { border: solid 1px black }" <>
-        "</style>" <>
-        "</head>" <>
-        "<body>" <>
-        (if null rows
-            then
-                "<b>No hpc_index.html files found in \"" <>
-                encodeUtf8Builder (pathToHtml outputDir) <>
-                "\".</b>"
-            else
-                "<table class=\"dashboard\" width=\"100%\" border=\"1\"><tbody>" <>
-                "<p><b>NOTE: This is merely a listing of the html files found in the coverage reports directory.  Some of these reports may be old.</b></p>" <>
-                "<tr><th>Package</th><th>TestSuite</th><th>Modification Time</th></tr>" <>
-                foldMap encodeUtf8Builder rows <>
-                "</tbody></table>") <>
-        "</body></html>"
-    unless (null rows) $
-        displayReportPath "\nAn" "index of the generated HTML coverage reports"
-            (pretty outputFile)
+  outputDir <- hpcReportDir
+  let outputFile = outputDir </> relFileIndexHtml
+  ensureDir outputDir
+  (dirs, _) <- listDir outputDir
+  rows <- fmap (catMaybes . concat) $ forM dirs $ \dir -> do
+    (subdirs, _) <- listDir dir
+    forM subdirs $ \subdir -> do
+      let indexPath = subdir </> relFileHpcIndexHtml
+      exists' <- doesFileExist indexPath
+      if not exists' then pure Nothing else do
+        relPath <- stripProperPrefix outputDir indexPath
+        let package = dirname dir
+            testsuite = dirname subdir
+        pure $ Just $ T.concat
+          [ "<tr><td>"
+          , pathToHtml package
+          , "</td><td><a href=\""
+          , pathToHtml relPath
+          , "\">"
+          , pathToHtml testsuite
+          , "</a></td></tr>"
+          ]
+  writeBinaryFileAtomic outputFile $
+       "<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">"
+    <>
+    -- Part of the css from HPC's output HTML
+       "<style type=\"text/css\">"
+    <> "table.dashboard { border-collapse: collapse; border: solid 1px black }"
+    <> ".dashboard td { border: solid 1px black }"
+    <> ".dashboard th { border: solid 1px black }"
+    <> "</style>"
+    <> "</head>"
+    <> "<body>"
+    <> ( if null rows
+           then
+                "<b>No hpc_index.html files found in \""
+             <> encodeUtf8Builder (pathToHtml outputDir)
+             <> "\".</b>"
+           else
+                "<table class=\"dashboard\" width=\"100%\" border=\"1\"><tbody>"
+             <> "<p><b>NOTE: This is merely a listing of the html files found in the coverage reports directory.  Some of these reports may be old.</b></p>"
+             <> "<tr><th>Package</th><th>TestSuite</th><th>Modification Time</th></tr>"
+             <> foldMap encodeUtf8Builder rows
+             <> "</tbody></table>"
+       )
+    <> "</body></html>"
+  unless (null rows) $
+    displayReportPath
+      "\nAn" "index of the generated HTML coverage reports"
+      (pretty outputFile)
 
 generateHpcErrorReport :: MonadIO m => Path Abs Dir -> Utf8Builder -> m ()
 generateHpcErrorReport dir err = do
-    ensureDir dir
-    let fp = toFilePath (dir </> relFileHpcIndexHtml)
-    writeFileUtf8Builder fp $
-        "<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\"></head><body>" <>
-        "<h1>HPC Report Generation Error</h1>" <>
-        "<p>" <>
-        err <>
-        "</p>" <>
-        "</body></html>"
+  ensureDir dir
+  let fp = toFilePath (dir </> relFileHpcIndexHtml)
+  writeFileUtf8Builder fp $
+       "<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\"></head><body>"
+    <> "<h1>HPC Report Generation Error</h1>"
+    <> "<p>"
+    <> err
+    <> "</p>"
+    <> "</body></html>"
 
 pathToHtml :: Path b t -> Text
 pathToHtml = T.dropWhileEnd (=='/') . sanitize . toFilePath
@@ -457,14 +567,14 @@ -- | Escape HTML symbols (copied from Text.Hastache)
 htmlEscape :: LT.Text -> LT.Text
 htmlEscape = LT.concatMap proc_
-  where
-    proc_ '&'  = "&amp;"
-    proc_ '\\' = "&#92;"
-    proc_ '"'  = "&quot;"
-    proc_ '\'' = "&#39;"
-    proc_ '<'  = "&lt;"
-    proc_ '>'  = "&gt;"
-    proc_ h    = LT.singleton h
+ where
+  proc_ '&'  = "&amp;"
+  proc_ '\\' = "&#92;"
+  proc_ '"'  = "&quot;"
+  proc_ '\'' = "&#39;"
+  proc_ '<'  = "&lt;"
+  proc_ '>'  = "&gt;"
+  proc_ h    = LT.singleton h
 
 sanitize :: String -> Text
 sanitize = LT.toStrict . htmlEscape . LT.pack
@@ -472,74 +582,90 @@ dirnameString :: Path r Dir -> String
 dirnameString = L.dropWhileEnd isPathSeparator . toFilePath . dirname
 
-findPackageFieldForBuiltPackage
-    :: HasEnvConfig env
-    => Path Abs Dir -> PackageIdentifier -> Set.Set Text -> Text
-    -> RIO env (Either Text [Text])
+findPackageFieldForBuiltPackage ::
+     HasEnvConfig env
+  => Path Abs Dir -> PackageIdentifier -> Set.Set Text -> Text
+  -> RIO env (Either Text [Text])
 findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do
-    distDir <- distDirFromDir pkgDir
-    let inplaceDir = distDir </> relDirPackageConfInplace
-        pkgIdStr = packageIdentifierString pkgId
-        notFoundErr = pure $ Left $ "Failed to find package key for " <> T.pack pkgIdStr
-        extractField path = do
-            contents <- readFileUtf8 (toFilePath path)
-            case asum (map (T.stripPrefix (field <> ": ")) (T.lines contents)) of
-                Just result -> pure $ Right $ T.strip result
-                Nothing -> notFoundErr
-    cabalVer <- view cabalVersionL
-    if cabalVer < mkVersion [1, 24]
-        then do
-            -- here we don't need to handle internal libs
-            path <- liftM (inplaceDir </>) $ parseRelFile (pkgIdStr ++ "-inplace.conf")
-            logDebug $ "Parsing config in Cabal < 1.24 location: " <> fromString (toFilePath path)
-            exists <- doesFileExist path
-            if exists then fmap (:[]) <$> extractField path else notFoundErr
-        else do
-            -- With Cabal-1.24, it's in a different location.
-            logDebug $ "Scanning " <> fromString (toFilePath inplaceDir) <> " for files matching " <> fromString pkgIdStr
-            (_, files) <- handleIO (const $ pure ([], [])) $ listDir inplaceDir
-            logDebug $ displayShow files
-            -- From all the files obtained from the scanning process above, we
-            -- need to identify which are .conf files and then ensure that
-            -- there is at most one .conf file for each library and internal
-            -- library (some might be missing if that component has not been
-            -- built yet). We should error if there are more than one .conf
-            -- file for a component or if there are no .conf files at all in
-            -- the searched location.
-            let toFilename = T.pack . toFilePath . filename
-                -- strip known prefix and suffix from the found files to determine only the conf files
-                stripKnown =  T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-"))
-                stripped = mapMaybe (\file -> fmap (,file) . stripKnown . toFilename $ file) files
-                -- which component could have generated each of these conf files
-                stripHash n = let z = T.dropWhile (/= '-') n in if T.null z then "" else T.tail z
-                matchedComponents = map (\(n, f) -> (stripHash n, [f])) stripped
-                byComponents = Map.restrictKeys (Map.fromListWith (++) matchedComponents) $ Set.insert "" internalLibs
-            logDebug $ displayShow byComponents
-            if Map.null $ Map.filter (\fs -> length fs > 1) byComponents
-            then case concat $ Map.elems byComponents of
-                [] -> notFoundErr
-                -- for each of these files, we need to extract the requested field
-                paths -> do
-                  (errors, keys) <-  partitionEithers <$> traverse extractField paths
-                  case errors of
-                    (a:_) -> pure $ Left a -- the first error only, since they're repeated anyway
-                    [] -> pure $ Right keys
-            else pure $ Left $ "Multiple files matching " <> T.pack (pkgIdStr ++ "-*.conf") <> " found in " <>
-                    T.pack (toFilePath inplaceDir) <> ". Maybe try 'stack clean' on this package?"
+  distDir <- distDirFromDir pkgDir
+  let inplaceDir = distDir </> relDirPackageConfInplace
+      pkgIdStr = packageIdentifierString pkgId
+      notFoundErr = pure $ Left $ "Failed to find package key for " <> T.pack pkgIdStr
+      extractField path = do
+        contents <- readFileUtf8 (toFilePath path)
+        case asum (map (T.stripPrefix (field <> ": ")) (T.lines contents)) of
+          Just result -> pure $ Right $ T.strip result
+          Nothing -> notFoundErr
+  cabalVer <- view cabalVersionL
+  if cabalVer < mkVersion [1, 24]
+    then do
+      -- here we don't need to handle internal libs
+      path <- (inplaceDir </>) <$> parseRelFile (pkgIdStr ++ "-inplace.conf")
+      logDebug $
+           "Parsing config in Cabal < 1.24 location: "
+        <> fromString (toFilePath path)
+      exists <- doesFileExist path
+      if exists then fmap (:[]) <$> extractField path else notFoundErr
+    else do
+      -- With Cabal-1.24, it's in a different location.
+      logDebug $ "Scanning " <> fromString (toFilePath inplaceDir) <> " for files matching " <> fromString pkgIdStr
+      (_, files) <- handleIO (const $ pure ([], [])) $ listDir inplaceDir
+      logDebug $ displayShow files
+      -- From all the files obtained from the scanning process above, we
+      -- need to identify which are .conf files and then ensure that
+      -- there is at most one .conf file for each library and internal
+      -- library (some might be missing if that component has not been
+      -- built yet). We should error if there are more than one .conf
+      -- file for a component or if there are no .conf files at all in
+      -- the searched location.
+      let toFilename = T.pack . toFilePath . filename
+          -- strip known prefix and suffix from the found files to determine only the conf files
+          stripKnown =  T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-"))
+          stripped = mapMaybe (\file -> fmap (,file) . stripKnown . toFilename $ file) files
+          -- which component could have generated each of these conf files
+          stripHash n = let z = T.dropWhile (/= '-') n in if T.null z then "" else T.tail z
+          matchedComponents = map (\(n, f) -> (stripHash n, [f])) stripped
+          byComponents = Map.restrictKeys (Map.fromListWith (++) matchedComponents) $ Set.insert "" internalLibs
+      logDebug $ displayShow byComponents
+      if Map.null $ Map.filter (\fs -> length fs > 1) byComponents
+      then case concat $ Map.elems byComponents of
+        [] -> notFoundErr
+        -- for each of these files, we need to extract the requested field
+        paths -> do
+          (errors, keys) <-  partitionEithers <$> traverse extractField paths
+          case errors of
+            (a:_) -> pure $ Left a -- the first error only, since they're repeated anyway
+            [] -> pure $ Right keys
+      else
+        pure
+          $ Left
+          $    "Multiple files matching "
+            <> T.pack (pkgIdStr ++ "-*.conf")
+            <> " found in "
+            <> T.pack (toFilePath inplaceDir)
+            <> ". Maybe try 'stack clean' on this package?"
 
-displayReportPath :: (HasTerm env)
-                  => StyleDoc -> Text -> StyleDoc -> RIO env ()
+displayReportPath ::
+     HasTerm env
+  => StyleDoc
+  -> StyleDoc
+  -> StyleDoc
+  -> RIO env ()
 displayReportPath prefix report reportPath =
-     prettyInfo $ prefix <+> fromString (T.unpack report) <+>
-                  "is available at" <+> reportPath
+  prettyInfoL
+    [ prefix
+    , report
+    , flow "is available at"
+    , reportPath <> "."
+    ]
 
 findExtraTixFiles :: HasEnvConfig env => RIO env [Path Abs File]
 findExtraTixFiles = do
-    outputDir <- hpcReportDir
-    let dir = outputDir </> relDirExtraTixFiles
-    dirExists <- doesDirExist dir
-    if dirExists
-        then do
-            (_, files) <- listDir dir
-            pure $ filter ((".tix" `L.isSuffixOf`) . toFilePath) files
-        else pure []
+  outputDir <- hpcReportDir
+  let dir = outputDir </> relDirExtraTixFiles
+  dirExists <- doesDirExist dir
+  if dirExists
+    then do
+      (_, files) <- listDir dir
+      pure $ filter ((".tix" `L.isSuffixOf`) . toFilePath) files
+    else pure []
src/Stack/DefaultColorWhen.hs view
@@ -1,26 +1,20 @@+{-# LANGUAGE LambdaCase #-}
+
 module Stack.DefaultColorWhen
   ( defaultColorWhen
   ) where
 
 import           Stack.Prelude ( stdout )
-import           Stack.Types.Config ( ColorWhen (ColorAuto, ColorNever) )
-import           System.Console.ANSI ( hSupportsANSIWithoutEmulation )
+import           Stack.Types.ColorWhen ( ColorWhen (..) )
+import           System.Console.ANSI ( hSupportsANSI )
 import           System.Environment ( lookupEnv )
 
 -- | The default adopts the standard proposed at http://no-color.org/, that
 -- color should not be added by default if the @NO_COLOR@ environment variable
 -- is present.
 defaultColorWhen :: IO ColorWhen
-defaultColorWhen = do
-  -- On Windows, 'hSupportsANSIWithoutEmulation' has the side effect of enabling
-  -- ANSI for ANSI-capable native (ConHost) terminals, if not already
-  -- ANSI-enabled. Consequently, it is actioned even if @NO_COLOR@ might exist,
-  -- as @NO_COLOR@ might be overridden in a yaml configuration file or at the
-  -- command line.
-  supportsANSI <- hSupportsANSIWithoutEmulation stdout
-  mIsNoColor <- lookupEnv "NO_COLOR"
-  pure $ case mIsNoColor of
-    Just _ -> ColorNever
-    _      -> case supportsANSI of
-      Just False -> ColorNever
-      _          -> ColorAuto
+defaultColorWhen = lookupEnv "NO_COLOR" >>= \case
+  Just _ -> pure ColorNever
+  _ -> hSupportsANSI stdout >>= \case
+    False -> pure ColorNever
+    _ -> pure ColorAuto
src/Stack/Docker.hs view
@@ -1,12 +1,6 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Run commands in Docker containers
 module Stack.Docker
@@ -41,19 +35,40 @@ import           Pantry.Internal.AesonExtended
                    ( FromJSON (..), (.:), (.:?), (.!=), eitherDecode )
 import           Path
+                   ( (</>), dirname, filename, parent, parseAbsDir
+                   , splitExtension
+                   )
 import           Path.Extra ( toFilePathNoTrailingSep )
 import           Path.IO hiding ( canonicalizePath )
-import qualified RIO.Directory
+import qualified RIO.Directory ( makeAbsolute )
 import           RIO.Process
+                   ( HasProcessContext, augmentPath, doesExecutableExist, proc
+                   , processContextL, withWorkingDir
+                   )
 import           Stack.Config ( getInContainer )
 import           Stack.Constants
-import           Stack.Constants.Config
+                   ( buildPlanDir, inContainerEnvVar, platformVariantEnvVar
+                   , relDirBin, relDirDotLocal, relDirDotSsh
+                   , relDirDotStackProgName, relDirUnderHome, stackRootEnvVar
+                   )
+import           Stack.Constants.Config ( projectDockerSandboxDir )
+import           Stack.Docker.Handlers ( handleSetGroups, handleSignals )
 import           Stack.Prelude
 import           Stack.Setup ( ensureDockerStackExe )
 import           Stack.Storage.User
                    ( loadDockerImageExeCache, saveDockerImageExeCache )
 import           Stack.Types.Config
+                   ( Config (..), HasConfig (..), configProjectRoot, stackRootL
+                   )
 import           Stack.Types.Docker
+                  ( DockerException (..), DockerOpts (..), DockerStackExe (..)
+                  , Mount (..), dockerCmdName, dockerContainerPlatform
+                  , dockerEntrypointArgName, dockerHelpOptName
+                  , dockerPullCmdName, reExecArgName
+                  )
+import           Stack.Types.DockerEntrypoint
+                   ( DockerEntrypoint (..), DockerUser (..) )
+import           Stack.Types.Runner ( terminalL )
 import           Stack.Types.Version ( showStackVersion, withinRange )
 import           System.Environment
                    ( getArgs, getEnv, getEnvironment, getExecutablePath
@@ -62,11 +77,7 @@ import qualified System.FilePath as FP
 import           System.IO.Error ( isDoesNotExistError )
 import           System.IO.Unsafe ( unsafePerformIO )
-#ifndef WINDOWS
-import           System.Posix.Signals
-import qualified System.Posix.User as PosixUser
-#endif
-import           System.Posix.User as User
+import qualified System.Posix.User as User
 import qualified System.PosixCompat.Files as Files
 import           System.Terminal ( hIsTerminalDeviceOrMinTTY )
 import           Text.ParserCombinators.ReadP ( readP_to_S )
@@ -106,8 +117,7 @@         Just DockerStackExeImage -> do
             progName <- liftIO getProgName
             pure (FP.takeBaseName progName, args, [], [])
-        Just (DockerStackExePath path) -> do
-            cmdArgs args path
+        Just (DockerStackExePath path) -> cmdArgs args path
         Just DockerStackExeDownload -> exeDownload args
         Nothing
           | configPlatform config == dockerContainerPlatform -> do
@@ -175,161 +185,157 @@ -- | Run a command in a new Docker container, then exit the process.
 runContainerAndExit :: HasConfig env => RIO env void
 runContainerAndExit = do
-     config <- view configL
-     let docker = configDocker config
-     checkDockerVersion docker
-     (env,isStdinTerminal,isStderrTerminal,homeDir) <- liftIO $
-       (,,,)
-       <$> getEnvironment
-       <*> hIsTerminalDeviceOrMinTTY stdin
-       <*> hIsTerminalDeviceOrMinTTY stderr
-       <*> getHomeDir
-     isStdoutTerminal <- view terminalL
-     let dockerHost = lookup "DOCKER_HOST" env
-         dockerCertPath = lookup "DOCKER_CERT_PATH" env
-         bamboo = lookup "bamboo_buildKey" env
-         jenkins = lookup "JENKINS_HOME" env
-         msshAuthSock = lookup "SSH_AUTH_SOCK" env
-         muserEnv = lookup "USER" env
-         isRemoteDocker = maybe False (isPrefixOf "tcp://") dockerHost
-     mstackYaml <- for (lookup "STACK_YAML" env) RIO.Directory.makeAbsolute
-     image <- either throwIO pure (dockerImage docker)
-     when (isRemoteDocker &&
-           maybe False (isInfixOf "boot2docker") dockerCertPath)
-          (logWarn "Warning: Using boot2docker is NOT supported, and not likely to perform well.")
-     maybeImageInfo <- inspect image
-     imageInfo@Inspect{..} <- case maybeImageInfo of
-       Just ii -> pure ii
-       Nothing
-         | dockerAutoPull docker ->
-             do pullImage docker image
-                mii2 <- inspect image
-                case mii2 of
-                  Just ii2 -> pure ii2
-                  Nothing -> throwM (InspectFailedException image)
-         | otherwise -> throwM (NotPulledException image)
-     projectRoot <- getProjectRoot
-     sandboxDir <- projectDockerSandboxDir projectRoot
-     let ImageConfig {..} = iiConfig
-         imageEnvVars = map (break (== '=')) icEnv
-         platformVariant = show $ hashRepoName image
-         stackRoot = view stackRootL config
-         sandboxHomeDir = sandboxDir </> homeDirName
-         isTerm = not (dockerDetach docker) &&
-                  isStdinTerminal &&
-                  isStdoutTerminal &&
-                  isStderrTerminal
-         keepStdinOpen = not (dockerDetach docker) &&
-                         -- Workaround for https://github.com/docker/docker/issues/12319
-                         -- This is fixed in Docker 1.9.1, but will leave the workaround
-                         -- in place for now, for users who haven't upgraded yet.
-                         (isTerm || (isNothing bamboo && isNothing jenkins))
-     let mpath = T.pack <$> lookupImageEnv "PATH" imageEnvVars
-     when (isNothing mpath) $ do
-       logWarn "The Docker image does not set the PATH env var"
-       logWarn "This will likely fail, see https://github.com/commercialhaskell/stack/issues/2742"
-     newPathEnv <- either throwM pure $ augmentPath
-                      [ hostBinDir
-                      , toFilePath (sandboxHomeDir </> relDirDotLocal </> relDirBin)]
-                      mpath
-     (cmnd,args,envVars,extraMount) <- getCmdArgs docker imageInfo isRemoteDocker
-     pwd <- getCurrentDir
-     liftIO $ mapM_ ensureDir [sandboxHomeDir, stackRoot]
-     -- Since $HOME is now mounted in the same place in the container we can
-     -- just symlink $HOME/.ssh to the right place for the stack docker user
-     let sshDir = homeDir </> sshRelDir
-     sshDirExists <- doesDirExist sshDir
-     sshSandboxDirExists <-
-         liftIO
-             (Files.fileExist
-                 (toFilePathNoTrailingSep (sandboxHomeDir </> sshRelDir)))
-     when (sshDirExists && not sshSandboxDirExists)
-         (liftIO
-             (Files.createSymbolicLink
-                 (toFilePathNoTrailingSep sshDir)
-                 (toFilePathNoTrailingSep (sandboxHomeDir </> sshRelDir))))
-     let mountSuffix = maybe "" (":" ++) (dockerMountMode docker)
-     containerID <- withWorkingDir (toFilePath projectRoot) $ trim . decodeUtf8 <$> readDockerProcess
-       (concat
-         [["create"
-          ,"-e",inContainerEnvVar ++ "=1"
-          ,"-e",stackRootEnvVar ++ "=" ++ toFilePathNoTrailingSep stackRoot
-          ,"-e",platformVariantEnvVar ++ "=dk" ++ platformVariant
-          ,"-e","HOME=" ++ toFilePathNoTrailingSep sandboxHomeDir
-          ,"-e","PATH=" ++ T.unpack newPathEnv
-          ,"-e","PWD=" ++ toFilePathNoTrailingSep pwd
-          ,"-v",toFilePathNoTrailingSep homeDir ++ ":" ++ toFilePathNoTrailingSep homeDir ++ mountSuffix
-          ,"-v",toFilePathNoTrailingSep stackRoot ++ ":" ++ toFilePathNoTrailingSep stackRoot ++ mountSuffix
-          ,"-v",toFilePathNoTrailingSep projectRoot ++ ":" ++ toFilePathNoTrailingSep projectRoot ++ mountSuffix
-          ,"-v",toFilePathNoTrailingSep sandboxHomeDir ++ ":" ++ toFilePathNoTrailingSep sandboxHomeDir ++ mountSuffix
-          ,"-w",toFilePathNoTrailingSep pwd]
-         ,case dockerNetwork docker of
+  config <- view configL
+  let docker = configDocker config
+  checkDockerVersion docker
+  (env,isStdinTerminal,isStderrTerminal,homeDir) <- liftIO $
+    (,,,)
+    <$> getEnvironment
+    <*> hIsTerminalDeviceOrMinTTY stdin
+    <*> hIsTerminalDeviceOrMinTTY stderr
+    <*> getHomeDir
+  isStdoutTerminal <- view terminalL
+  let dockerHost = lookup "DOCKER_HOST" env
+      dockerCertPath = lookup "DOCKER_CERT_PATH" env
+      bamboo = lookup "bamboo_buildKey" env
+      jenkins = lookup "JENKINS_HOME" env
+      msshAuthSock = lookup "SSH_AUTH_SOCK" env
+      muserEnv = lookup "USER" env
+      isRemoteDocker = maybe False (isPrefixOf "tcp://") dockerHost
+  mstackYaml <- for (lookup "STACK_YAML" env) RIO.Directory.makeAbsolute
+  image <- either throwIO pure (dockerImage docker)
+  when
+    ( isRemoteDocker && maybe False (isInfixOf "boot2docker") dockerCertPath )
+    ( prettyWarnS
+        "Using boot2docker is NOT supported, and not likely to perform well."
+    )
+  maybeImageInfo <- inspect image
+  imageInfo@Inspect{..} <- case maybeImageInfo of
+    Just ii -> pure ii
+    Nothing
+      | dockerAutoPull docker -> do
+          pullImage docker image
+          mii2 <- inspect image
+          case mii2 of
+            Just ii2 -> pure ii2
+            Nothing -> throwM (InspectFailedException image)
+      | otherwise -> throwM (NotPulledException image)
+  projectRoot <- getProjectRoot
+  sandboxDir <- projectDockerSandboxDir projectRoot
+  let ImageConfig {..} = iiConfig
+      imageEnvVars = map (break (== '=')) icEnv
+      platformVariant = show $ hashRepoName image
+      stackRoot = view stackRootL config
+      sandboxHomeDir = sandboxDir </> homeDirName
+      isTerm = not (dockerDetach docker) &&
+               isStdinTerminal &&
+               isStdoutTerminal &&
+               isStderrTerminal
+      keepStdinOpen = not (dockerDetach docker) &&
+                      -- Workaround for https://github.com/docker/docker/issues/12319
+                      -- This is fixed in Docker 1.9.1, but will leave the workaround
+                      -- in place for now, for users who haven't upgraded yet.
+                      (isTerm || (isNothing bamboo && isNothing jenkins))
+  let mpath = T.pack <$> lookupImageEnv "PATH" imageEnvVars
+  when (isNothing mpath) $ do
+    prettyWarnL
+      [ flow "The Docker image does not set the PATH environment variable. \
+             \This will likely fail. For further information, see"
+      , style Url "https://github.com/commercialhaskell/stack/issues/2742" <> "."
+      ]
+  newPathEnv <- either throwM pure $ augmentPath
+    [ hostBinDir
+    , toFilePath (sandboxHomeDir </> relDirDotLocal </> relDirBin)
+    ]
+    mpath
+  (cmnd,args,envVars,extraMount) <- getCmdArgs docker imageInfo isRemoteDocker
+  pwd <- getCurrentDir
+  liftIO $ mapM_ ensureDir [sandboxHomeDir, stackRoot]
+  -- Since $HOME is now mounted in the same place in the container we can
+  -- just symlink $HOME/.ssh to the right place for the stack docker user
+  let sshDir = homeDir </> sshRelDir
+  sshDirExists <- doesDirExist sshDir
+  sshSandboxDirExists <-
+    liftIO
+      (Files.fileExist
+        (toFilePathNoTrailingSep (sandboxHomeDir </> sshRelDir)))
+  when (sshDirExists && not sshSandboxDirExists)
+    (liftIO
+      (Files.createSymbolicLink
+        (toFilePathNoTrailingSep sshDir)
+        (toFilePathNoTrailingSep (sandboxHomeDir </> sshRelDir))))
+  let mountSuffix = maybe "" (":" ++) (dockerMountMode docker)
+  containerID <- withWorkingDir (toFilePath projectRoot) $
+    trim . decodeUtf8 <$> readDockerProcess
+      ( concat
+        [ [ "create"
+          , "-e", inContainerEnvVar ++ "=1"
+          , "-e", stackRootEnvVar ++ "=" ++ toFilePathNoTrailingSep stackRoot
+          , "-e", platformVariantEnvVar ++ "=dk" ++ platformVariant
+          , "-e", "HOME=" ++ toFilePathNoTrailingSep sandboxHomeDir
+          , "-e", "PATH=" ++ T.unpack newPathEnv
+          , "-e", "PWD=" ++ toFilePathNoTrailingSep pwd
+          , "-v"
+          , toFilePathNoTrailingSep homeDir ++ ":" ++
+              toFilePathNoTrailingSep homeDir ++ mountSuffix
+          , "-v"
+          , toFilePathNoTrailingSep stackRoot ++ ":" ++
+              toFilePathNoTrailingSep stackRoot ++ mountSuffix
+          , "-v"
+          , toFilePathNoTrailingSep projectRoot ++ ":" ++
+              toFilePathNoTrailingSep projectRoot ++ mountSuffix
+          , "-v"
+          , toFilePathNoTrailingSep sandboxHomeDir ++ ":" ++
+              toFilePathNoTrailingSep sandboxHomeDir ++ mountSuffix
+          , "-w", toFilePathNoTrailingSep pwd
+          ]
+        , case dockerNetwork docker of
             Nothing -> ["--net=host"]
             Just name -> ["--net=" ++ name]
-         ,case muserEnv of
+        , case muserEnv of
             Nothing -> []
             Just userEnv -> ["-e","USER=" ++ userEnv]
-         ,case msshAuthSock of
+        , case msshAuthSock of
             Nothing -> []
             Just sshAuthSock ->
-              ["-e","SSH_AUTH_SOCK=" ++ sshAuthSock
-              ,"-v",sshAuthSock ++ ":" ++ sshAuthSock]
-         ,case mstackYaml of
+              [ "-e","SSH_AUTH_SOCK=" ++ sshAuthSock
+              , "-v",sshAuthSock ++ ":" ++ sshAuthSock
+              ]
+        , case mstackYaml of
             Nothing -> []
             Just stackYaml ->
-              ["-e","STACK_YAML=" ++ stackYaml
-              ,"-v",stackYaml++ ":" ++ stackYaml ++ ":ro"]
+              [ "-e","STACK_YAML=" ++ stackYaml
+              , "-v",stackYaml++ ":" ++ stackYaml ++ ":ro"
+              ]
            -- Disable the deprecated entrypoint in FP Complete-generated images
-         ,["--entrypoint=/usr/bin/env"
-             | isJust (lookupImageEnv oldSandboxIdEnvVar imageEnvVars) &&
-               (icEntrypoint == ["/usr/local/sbin/docker-entrypoint"] ||
-                 icEntrypoint == ["/root/entrypoint.sh"])]
-         ,concatMap (\(k,v) -> ["-e", k ++ "=" ++ v]) envVars
-         ,concatMap (mountArg mountSuffix) (extraMount ++ dockerMount docker)
-         ,concatMap (\nv -> ["-e", nv]) (dockerEnv docker)
-         ,case dockerContainerName docker of
+        , [ "--entrypoint=/usr/bin/env"
+          |  isJust (lookupImageEnv oldSandboxIdEnvVar imageEnvVars)
+          && (  icEntrypoint == ["/usr/local/sbin/docker-entrypoint"]
+             || icEntrypoint == ["/root/entrypoint.sh"]
+             )
+          ]
+        , concatMap (\(k,v) -> ["-e", k ++ "=" ++ v]) envVars
+        , concatMap (mountArg mountSuffix) (extraMount ++ dockerMount docker)
+        , concatMap (\nv -> ["-e", nv]) (dockerEnv docker)
+        , case dockerContainerName docker of
             Just name -> ["--name=" ++ name]
             Nothing -> []
-         ,["-t" | isTerm]
-         ,["-i" | keepStdinOpen]
-         ,dockerRunArgs docker
-         ,[image]
-         ,[cmnd]
-         ,args])
--- MSS 2018-08-30 can the CPP below be removed entirely, and instead exec the
--- `docker` process so that it can handle the signals directly?
-#ifndef WINDOWS
-     run <- askRunInIO
-     oldHandlers <- forM [sigINT,sigABRT,sigHUP,sigPIPE,sigTERM,sigUSR1,sigUSR2] $ \sig -> do
-       let sigHandler = run $ do
-             readProcessNull "docker" ["kill","--signal=" ++ show sig,containerID]
-             when (sig `elem` [sigTERM,sigABRT]) $ do
-               -- Give the container 30 seconds to exit gracefully, then send a sigKILL to force it
-               threadDelay 30000000
-               readProcessNull "docker" ["kill",containerID]
-       oldHandler <- liftIO $ installHandler sig (Catch sigHandler) Nothing
-       pure (sig, oldHandler)
-#endif
-     let args' = concat [["start"]
-                        ,["-a" | not (dockerDetach docker)]
-                        ,["-i" | keepStdinOpen]
-                        ,[containerID]]
-     e <- try (proc "docker" args' $ runProcess_ . setDelegateCtlc False)
-         `finally`
-         (do unless (dockerPersist docker || dockerDetach docker) $
-                 readProcessNull "docker" ["rm","-f",containerID]
-                 `catch` (\(_::ExitCodeException) -> pure ())
-#ifndef WINDOWS
-             forM_ oldHandlers $ \(sig,oldHandler) ->
-               liftIO $ installHandler sig oldHandler Nothing
-#endif
-         )
-     case e of
-       Left ExitCodeException{eceExitCode} -> exitWith eceExitCode
-       Right () -> exitSuccess
+        , ["-t" | isTerm]
+        , ["-i" | keepStdinOpen]
+        , dockerRunArgs docker
+        , [image]
+        , [cmnd]
+        , args
+        ]
+      )
+  e <- handleSignals docker keepStdinOpen containerID
+  case e of
+    Left ExitCodeException{eceExitCode} -> exitWith eceExitCode
+    Right () -> exitSuccess
   where
-    -- This is using a hash of the Docker repository (without tag or digest) to ensure
-    -- binaries/libraries aren't shared between Docker and host (or incompatible Docker images)
+    -- This is using a hash of the Docker repository (without tag or digest) to
+    -- ensure binaries/libraries aren't shared between Docker and host (or
+    -- incompatible Docker images)
     hashRepoName :: String -> Hash.Digest Hash.MD5
     hashRepoName = Hash.hash . BS.pack . takeWhile (\c -> c /= ':' && c /= '@')
     lookupImageEnv name vars =
@@ -342,98 +348,113 @@ 
 -- | Inspect Docker image or container.
 inspect :: (HasProcessContext env, HasLogFunc env)
-        => String -> RIO env (Maybe Inspect)
-inspect image =
-  do results <- inspects [image]
-     case Map.toList results of
-       [] -> pure Nothing
-       [(_,i)] -> pure (Just i)
-       _ -> throwIO (InvalidInspectOutputException "expect a single result")
+        => String
+        -> RIO env (Maybe Inspect)
+inspect image = do
+  results <- inspects [image]
+  case Map.toList results of
+    [] -> pure Nothing
+    [(_,i)] -> pure (Just i)
+    _ -> throwIO (InvalidInspectOutputException "expect a single result")
 
 -- | Inspect multiple Docker images and/or containers.
 inspects :: (HasProcessContext env, HasLogFunc env)
-         => [String] -> RIO env (Map Text Inspect)
+         => [String]
+         -> RIO env (Map Text Inspect)
 inspects [] = pure Map.empty
-inspects images =
-  do maybeInspectOut <-
-       -- not using 'readDockerProcess' as the error from a missing image
-       -- needs to be recovered.
-       try (BL.toStrict . fst <$> proc "docker" ("inspect" : images) readProcess_)
-     case maybeInspectOut of
-       Right inspectOut ->
-         -- filtering with 'isAscii' to workaround @docker inspect@ output containing invalid UTF-8
-         case eitherDecode (LBS.pack (filter isAscii (decodeUtf8 inspectOut))) of
-           Left msg -> throwIO (InvalidInspectOutputException msg)
-           Right results -> pure (Map.fromList (map (\r -> (iiId r,r)) results))
-       Left ece
-         |  any (`LBS.isPrefixOf` eceStderr ece) missingImagePrefixes -> pure Map.empty
-       Left e -> throwIO e
-  where missingImagePrefixes = ["Error: No such image", "Error: No such object:"]
+inspects images = do
+  maybeInspectOut <-
+    -- not using 'readDockerProcess' as the error from a missing image
+    -- needs to be recovered.
+    try (BL.toStrict . fst <$> proc "docker" ("inspect" : images) readProcess_)
+  case maybeInspectOut of
+    Right inspectOut ->
+      -- filtering with 'isAscii' to workaround @docker inspect@ output
+      -- containing invalid UTF-8
+      case eitherDecode (LBS.pack (filter isAscii (decodeUtf8 inspectOut))) of
+        Left msg -> throwIO (InvalidInspectOutputException msg)
+        Right results -> pure (Map.fromList (map (\r -> (iiId r,r)) results))
+    Left ece
+      | any (`LBS.isPrefixOf` eceStderr ece) missingImagePrefixes ->
+          pure Map.empty
+    Left e -> throwIO e
+ where
+  missingImagePrefixes = ["Error: No such image", "Error: No such object:"]
 
 -- | Pull latest version of configured Docker image from registry.
 pull :: HasConfig env => RIO env ()
-pull =
-  do config <- view configL
-     let docker = configDocker config
-     checkDockerVersion docker
-     either throwIO (pullImage docker) (dockerImage docker)
+pull = do
+  config <- view configL
+  let docker = configDocker config
+  checkDockerVersion docker
+  either throwIO (pullImage docker) (dockerImage docker)
 
 -- | Pull Docker image from registry.
-pullImage :: (HasProcessContext env, HasLogFunc env)
-          => DockerOpts -> String -> RIO env ()
-pullImage docker image =
-  do logInfo ("Pulling image from registry: '" <> fromString image <> "'")
-     when (dockerRegistryLogin docker)
-          (do logInfo "You may need to log in."
-              proc
-                "docker"
-                (concat
-                   [["login"]
-                   ,maybe [] (\n -> ["--username=" ++ n]) (dockerRegistryUsername docker)
-                   ,maybe [] (\p -> ["--password=" ++ p]) (dockerRegistryPassword docker)
-                   ,[takeWhile (/= '/') image]])
-                runProcess_)
-     -- We redirect the stdout of the process to stderr so that the output
-     -- of @docker pull@ will not interfere with the output of other
-     -- commands when using --auto-docker-pull. See issue #2733.
-     ec <- proc "docker" ["pull", image] $ \pc0 -> do
-       let pc = setStdout (useHandleOpen stderr)
-              $ setStderr (useHandleOpen stderr)
-              $ setStdin closed
-                pc0
-       runProcess pc
-     case ec of
-       ExitSuccess -> pure ()
-       ExitFailure _ -> throwIO (PullFailedException image)
+pullImage :: (HasProcessContext env, HasTerm env)
+          => DockerOpts
+          -> String
+          -> RIO env ()
+pullImage docker image = do
+  prettyInfoL
+    [ flow "Pulling image from registry:"
+    , style Current (fromString image) <> "."
+    ]
+  when (dockerRegistryLogin docker) $ do
+    prettyInfoS "You may need to log in."
+    proc
+      "docker"
+      ( concat
+          [ ["login"]
+          , maybe [] (\n -> ["--username=" ++ n]) (dockerRegistryUsername docker)
+          , maybe [] (\p -> ["--password=" ++ p]) (dockerRegistryPassword docker)
+          , [takeWhile (/= '/') image]
+          ]
+      )
+      runProcess_
+  -- We redirect the stdout of the process to stderr so that the output
+  -- of @docker pull@ will not interfere with the output of other
+  -- commands when using --auto-docker-pull. See issue #2733.
+  ec <- proc "docker" ["pull", image] $ \pc0 -> do
+    let pc = setStdout (useHandleOpen stderr)
+           $ setStderr (useHandleOpen stderr)
+           $ setStdin closed
+             pc0
+    runProcess pc
+  case ec of
+    ExitSuccess -> pure ()
+    ExitFailure _ -> throwIO (PullFailedException image)
 
 -- | Check docker version (throws exception if incorrect)
 checkDockerVersion ::
-       (HasProcessContext env, HasLogFunc env)
-    => DockerOpts -> RIO env ()
-checkDockerVersion docker =
-  do dockerExists <- doesExecutableExist "docker"
-     unless dockerExists (throwIO DockerNotInstalledException)
-     dockerVersionOut <- readDockerProcess ["--version"]
-     case words (decodeUtf8 dockerVersionOut) of
-       (_:_:v:_) ->
-         case fmap mkVersion' $ parseVersion' $ stripVersion v of
-           Just v'
-             | v' < minimumDockerVersion ->
-               throwIO (DockerTooOldException minimumDockerVersion v')
-             | v' `elem` prohibitedDockerVersions ->
-               throwIO (DockerVersionProhibitedException prohibitedDockerVersions v')
-             | not (v' `withinRange` dockerRequireDockerVersion docker) ->
-               throwIO (BadDockerVersionException (dockerRequireDockerVersion docker) v')
-             | otherwise ->
-               pure ()
-           _ -> throwIO InvalidVersionOutputException
-       _ -> throwIO InvalidVersionOutputException
-  where minimumDockerVersion = mkVersion [1, 6, 0]
-        prohibitedDockerVersions = []
-        stripVersion v = takeWhile (/= '-') (dropWhileEnd (not . isDigit) v)
-        -- version is parsed by Data.Version provided code to avoid
-        -- Cabal's Distribution.Version lack of support for leading zeros in version
-        parseVersion' = fmap fst . listToMaybe . reverse . readP_to_S Data.Version.parseVersion
+     (HasProcessContext env, HasLogFunc env)
+  => DockerOpts
+  -> RIO env ()
+checkDockerVersion docker = do
+  dockerExists <- doesExecutableExist "docker"
+  unless dockerExists (throwIO DockerNotInstalledException)
+  dockerVersionOut <- readDockerProcess ["--version"]
+  case words (decodeUtf8 dockerVersionOut) of
+    (_:_:v:_) ->
+      case fmap mkVersion' $ parseVersion' $ stripVersion v of
+        Just v'
+          | v' < minimumDockerVersion ->
+            throwIO (DockerTooOldException minimumDockerVersion v')
+          | v' `elem` prohibitedDockerVersions ->
+            throwIO (DockerVersionProhibitedException prohibitedDockerVersions v')
+          | not (v' `withinRange` dockerRequireDockerVersion docker) ->
+            throwIO (BadDockerVersionException (dockerRequireDockerVersion docker) v')
+          | otherwise ->
+            pure ()
+        _ -> throwIO InvalidVersionOutputException
+    _ -> throwIO InvalidVersionOutputException
+ where
+  minimumDockerVersion = mkVersion [1, 6, 0]
+  prohibitedDockerVersions = []
+  stripVersion v = takeWhile (/= '-') (dropWhileEnd (not . isDigit) v)
+  -- version is parsed by Data.Version provided code to avoid
+  -- Cabal's Distribution.Version lack of support for leading zeros in version
+  parseVersion' =
+    fmap fst . listToMaybe . reverse . readP_to_S Data.Version.parseVersion
 
 -- | Remove the project's Docker sandbox.
 reset :: HasConfig env => Bool -> RIO env ()
@@ -445,10 +466,13 @@             [homeDirName | keepHome]
             [])
 
--- | The Docker container "entrypoint": special actions performed when first entering
--- a container, such as switching the UID/GID to the "outside-Docker" user's.
+-- | The Docker container "entrypoint": special actions performed when first
+-- entering a container, such as switching the UID/GID to the "outside-Docker"
+-- user's.
 entrypoint :: (HasProcessContext env, HasLogFunc env)
-           => Config -> DockerEntrypoint -> RIO env ()
+           => Config
+           -> DockerEntrypoint
+           -> RIO env ()
 entrypoint config@Config{} DockerEntrypoint{..} =
   modifyMVar_ entrypointMVar $ \alreadyRan -> do
     -- Only run the entrypoint once
@@ -462,65 +486,68 @@       case deUser of
         Nothing -> pure ()
         Just (DockerUser 0 _ _ _) -> pure ()
-        Just du -> withProcessContext envOverride $ updateOrCreateStackUser estackUserEntry0 homeDir du
+        Just du -> withProcessContext envOverride $
+          updateOrCreateStackUser estackUserEntry0 homeDir du
       case estackUserEntry0 of
         Left _ -> pure ()
         Right ue -> do
-          -- If the 'stack' user exists in the image, copy any build plans and package indices from
-          -- its original home directory to the host's Stack root, to avoid needing to download them
+          -- If the 'stack' user exists in the image, copy any build plans and
+          -- package indices from its original home directory to the host's
+          -- Stack root, to avoid needing to download them
           origStackHomeDir <- liftIO $ parseAbsDir (User.homeDirectory ue)
           let origStackRoot = origStackHomeDir </> relDirDotStackProgName
           buildPlanDirExists <- doesDirExist (buildPlanDir origStackRoot)
           when buildPlanDirExists $ do
             (_, buildPlans) <- listDir (buildPlanDir origStackRoot)
             forM_ buildPlans $ \srcBuildPlan -> do
-              let destBuildPlan = buildPlanDir (view stackRootL config) </> filename srcBuildPlan
+              let destBuildPlan =
+                    buildPlanDir (view stackRootL config) </> filename srcBuildPlan
               exists <- doesFileExist destBuildPlan
               unless exists $ do
                 ensureDir (parent destBuildPlan)
                 copyFile srcBuildPlan destBuildPlan
     pure True
-  where
-    updateOrCreateStackUser estackUserEntry homeDir DockerUser{..} = do
-      case estackUserEntry of
-        Left _ -> do
-          -- If no 'stack' user in image, create one with correct UID/GID and home directory
-          readProcessNull "groupadd"
-            ["-o"
-            ,"--gid",show duGid
-            ,stackUserName]
-          readProcessNull "useradd"
-            ["-oN"
-            ,"--uid",show duUid
-            ,"--gid",show duGid
-            ,"--home",toFilePathNoTrailingSep homeDir
-            ,stackUserName]
-        Right _ -> do
-          -- If there is already a 'stack' user in the image, adjust its UID/GID and home directory
-          readProcessNull "usermod"
-            ["-o"
-            ,"--uid",show duUid
-            ,"--home",toFilePathNoTrailingSep homeDir
-            ,stackUserName]
-          readProcessNull "groupmod"
-            ["-o"
-            ,"--gid",show duGid
-            ,stackUserName]
-      forM_ duGroups $ \gid -> do
+ where
+  updateOrCreateStackUser estackUserEntry homeDir DockerUser{..} = do
+    case estackUserEntry of
+      Left _ -> do
+        -- If no 'stack' user in image, create one with correct UID/GID and home
+        -- directory
         readProcessNull "groupadd"
           ["-o"
-          ,"--gid",show gid
-          ,"group" ++ show gid]
-      -- 'setuid' to the wanted UID and GID
-      liftIO $ do
-        User.setGroupID duGid
-#ifndef WINDOWS
-        PosixUser.setGroups duGroups
-#endif
-        User.setUserID duUid
-        _ <- Files.setFileCreationMask duUmask
-        pure ()
-    stackUserName = "stack"::String
+          ,"--gid",show duGid
+          ,stackUserName]
+        readProcessNull "useradd"
+          ["-oN"
+          ,"--uid",show duUid
+          ,"--gid",show duGid
+          ,"--home",toFilePathNoTrailingSep homeDir
+          ,stackUserName]
+      Right _ -> do
+        -- If there is already a 'stack' user in the image, adjust its UID/GID
+        -- and home directory
+        readProcessNull "usermod"
+          ["-o"
+          ,"--uid",show duUid
+          ,"--home",toFilePathNoTrailingSep homeDir
+          ,stackUserName]
+        readProcessNull "groupmod"
+          ["-o"
+          ,"--gid",show duGid
+          ,stackUserName]
+    forM_ duGroups $ \gid ->
+      readProcessNull "groupadd"
+        ["-o"
+        ,"--gid",show gid
+        ,"group" ++ show gid]
+    -- 'setuid' to the wanted UID and GID
+    liftIO $ do
+      User.setGroupID duGid
+      handleSetGroups duGroups
+      User.setUserID duUid
+      _ <- Files.setFileCreationMask duUmask
+      pure ()
+  stackUserName = "stack" :: String
 
 -- | MVar used to ensure the Docker entrypoint is performed exactly once
 entrypointMVar :: MVar Bool
@@ -528,34 +555,34 @@ entrypointMVar = unsafePerformIO (newMVar False)
 
 -- | Remove the contents of a directory, without removing the directory itself.
--- This is used instead of 'FS.removeTree' to clear bind-mounted directories, since
--- removing the root of the bind-mount won't work.
-removeDirectoryContents :: Path Abs Dir -- ^ Directory to remove contents of
-                        -> [Path Rel Dir] -- ^ Top-level directory names to exclude from removal
-                        -> [Path Rel File] -- ^ Top-level file names to exclude from removal
-                        -> IO ()
-removeDirectoryContents path excludeDirs excludeFiles =
-  do isRootDir <- doesDirExist path
-     when isRootDir
-          (do (lsd,lsf) <- listDir path
-              forM_ lsd
-                    (\d -> unless (dirname d `elem` excludeDirs)
-                                  (removeDirRecur d))
-              forM_ lsf
-                    (\f -> unless (filename f `elem` excludeFiles)
-                                  (removeFile f)))
+-- This is used instead of 'FS.removeTree' to clear bind-mounted directories,
+-- since removing the root of the bind-mount won't work.
+removeDirectoryContents ::
+     Path Abs Dir -- ^ Directory to remove contents of
+  -> [Path Rel Dir] -- ^ Top-level directory names to exclude from removal
+  -> [Path Rel File] -- ^ Top-level file names to exclude from removal
+  -> IO ()
+removeDirectoryContents path excludeDirs excludeFiles = do
+  isRootDir <- doesDirExist path
+  when isRootDir $ do
+    (lsd,lsf) <- listDir path
+    forM_ lsd
+          (\d -> unless (dirname d `elem` excludeDirs)
+                        (removeDirRecur d))
+    forM_ lsf
+          (\f -> unless (filename f `elem` excludeFiles)
+                        (removeFile f))
 
--- | Produce a strict 'S.ByteString' from the stdout of a
--- process. Throws a 'ReadProcessException' exception if the
--- process fails.
+-- | Produce a strict 'S.ByteString' from the stdout of a process. Throws a
+-- 'ReadProcessException' exception if the process fails.
 --
--- The stderr output is passed straight through, which is desirable for some cases
--- e.g. docker pull, in which docker uses stderr for progress output.
+-- The stderr output is passed straight through, which is desirable for some
+-- cases e.g. docker pull, in which docker uses stderr for progress output.
 --
 -- Use 'readProcess_' directly to customize this.
 readDockerProcess ::
-       (HasProcessContext env, HasLogFunc env)
-    => [String] -> RIO env BS.ByteString
+     (HasProcessContext env, HasLogFunc env)
+  => [String] -> RIO env BS.ByteString
 readDockerProcess args = BL.toStrict <$> proc "docker" args readProcessStdout_
 
 -- | Name of home directory within docker sandbox.
@@ -585,31 +612,34 @@ 
 -- | Parsed result of @docker inspect@.
 data Inspect = Inspect
-  {iiConfig      :: ImageConfig
-  ,iiCreated     :: UTCTime
-  ,iiId          :: Text
-  ,iiVirtualSize :: Maybe Integer}
-  deriving (Show)
+  { iiConfig      :: ImageConfig
+  , iiCreated     :: UTCTime
+  , iiId          :: Text
+  , iiVirtualSize :: Maybe Integer
+  }
+  deriving Show
 
 -- | Parse @docker inspect@ output.
 instance FromJSON Inspect where
-  parseJSON v =
-    do o <- parseJSON v
-       Inspect <$> o .: "Config"
-               <*> o .: "Created"
-               <*> o .: "Id"
-               <*> o .:? "VirtualSize"
+  parseJSON v = do
+    o <- parseJSON v
+    Inspect
+      <$> o .: "Config"
+      <*> o .: "Created"
+      <*> o .: "Id"
+      <*> o .:? "VirtualSize"
 
 -- | Parsed @Config@ section of @docker inspect@ output.
 data ImageConfig = ImageConfig
-  {icEnv :: [String]
-  ,icEntrypoint :: [String]}
-  deriving (Show)
+  { icEnv :: [String]
+  , icEntrypoint :: [String]
+  }
+  deriving Show
 
 -- | Parse @Config@ section of @docker inspect@ output.
 instance FromJSON ImageConfig where
-  parseJSON v =
-    do o <- parseJSON v
-       ImageConfig
-         <$> fmap join (o .:? "Env") .!= []
-         <*> fmap join (o .:? "Entrypoint") .!= []
+  parseJSON v = do
+    o <- parseJSON v
+    ImageConfig
+      <$> fmap join (o .:? "Env") .!= []
+      <*> fmap join (o .:? "Entrypoint") .!= []
+ src/Stack/DockerCmd.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Functions related to Stack's @docker pull@ and @docker reset@ commands.
+module Stack.DockerCmd
+  ( dockerPullCmd
+  , dockerResetCmd
+  ) where
+
+import           Stack.Docker ( preventInContainer, pull, reset )
+import           Stack.Prelude
+import           Stack.Runners ( ShouldReexec (..), withConfig )
+import           Stack.Types.Runner ( Runner )
+
+-- | Function underlying the @stack docker pull@ command. Pull the current
+-- Docker image.
+dockerPullCmd :: () -> RIO Runner ()
+dockerPullCmd () = withConfig NoReexec $ preventInContainer pull
+
+-- | Function underlying the @stack docker reset@ command. Reset the Docker
+-- sandbox.
+dockerResetCmd ::
+     Bool
+     -- ^ Delete the sandbox's home directory?
+  -> RIO Runner ()
+dockerResetCmd = withConfig NoReexec . preventInContainer . reset
src/Stack/Dot.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ConstraintKinds   #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
 
 module Stack.Dot
   ( dot
@@ -17,7 +14,7 @@   , pruneGraph
   ) where
 
-import           Data.Aeson
+import           Data.Aeson ( ToJSON (..), Value, (.=), encode, object )
 import qualified Data.ByteString.Lazy.Char8 as LBC8
 import qualified Data.Foldable as F
 import qualified Data.Sequence as Seq
@@ -31,23 +28,44 @@ import qualified Distribution.SPDX.License as SPDX
 import           Distribution.Text ( display )
 import           Distribution.Types.PackageName ( mkPackageName )
-import qualified Path
+import           Path ( parent )
 import           RIO.Process ( HasProcessContext (..) )
 import           Stack.Build ( loadPackage )
 import           Stack.Build.Installed ( getInstalled, toInstallMap )
 import           Stack.Build.Source
+                   ( loadCommonPackage, loadLocalPackage, loadSourceMap )
 import           Stack.Build.Target( NeedTargets (..), parseTargets )
-import           Stack.Constants
-import           Stack.Package
+import           Stack.Constants ( wiredInPackages )
+import           Stack.Package ( Package (..) )
 import           Stack.Prelude hiding ( Display (..), pkgName, loadPackage )
 import qualified Stack.Prelude ( pkgName )
 import           Stack.Runners
+                   ( ShouldReexec (..), withBuildConfig, withConfig
+                   , withEnvConfig
+                   )
 import           Stack.SourceMap
-import           Stack.Types.Build
+                   ( globalsFromHints, mkProjectPackage, pruneGlobals )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.BuildOpts
+                   ( ApplyCLIFlag, BuildOptsCLI (..), buildOptsMonoidBenchmarksL
+                   , buildOptsMonoidTestsL, defaultBuildOptsCLI
+                   )
 import           Stack.Types.Compiler ( wantedToActual )
-import           Stack.Types.Config
+import           Stack.Types.Config ( HasConfig (..) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.EnvConfig ( EnvConfig (..), HasSourceMap (..) )
+import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
 import           Stack.Types.GhcPkgId
+                   ( GhcPkgId, ghcPkgIdString, parseGhcPkgId )
+import           Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
+import           Stack.Types.Package ( LocalPackage (..) )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( HasRunner (..), Runner, globalOptsL )
 import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..), ProjectPackage (..)
+                   , SMActual (..), SMWanted (..), SourceMap (..)
+                   )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Dot" module.
@@ -71,43 +89,44 @@ -- | Options record for @stack dot@
 data DotOpts = DotOpts
   { dotIncludeExternal :: !Bool
-  -- ^ Include external dependencies
+    -- ^ Include external dependencies
   , dotIncludeBase :: !Bool
-  -- ^ Include dependencies on base
+    -- ^ Include dependencies on base
   , dotDependencyDepth :: !(Maybe Int)
-  -- ^ Limit the depth of dependency resolution to (Just n) or continue until
-  -- fixpoint
+    -- ^ Limit the depth of dependency resolution to (Just n) or continue until
+    -- fixpoint
   , dotPrune :: !(Set PackageName)
-  -- ^ Package names to prune from the graph
+    -- ^ Package names to prune from the graph
   , dotTargets :: [Text]
-  -- ^ Stack TARGETs to trace dependencies for
+    -- ^ Stack TARGETs to trace dependencies for
   , dotFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
-  -- ^ Flags to apply when calculating dependencies
+    -- ^ Flags to apply when calculating dependencies
   , dotTestTargets :: Bool
-  -- ^ Like the "--test" flag for build, affects the meaning of 'dotTargets'.
+    -- ^ Like the "--test" flag for build, affects the meaning of 'dotTargets'.
   , dotBenchTargets :: Bool
-  -- ^ Like the "--bench" flag for build, affects the meaning of 'dotTargets'.
+    -- ^ Like the "--bench" flag for build, affects the meaning of 'dotTargets'.
   , dotGlobalHints :: Bool
-  -- ^ Use global hints instead of relying on an actual GHC installation.
+    -- ^ Use global hints instead of relying on an actual GHC installation.
   }
 
 data ListDepsFormatOpts = ListDepsFormatOpts
   { listDepsSep :: !Text
-  -- ^ Separator between the package name and details.
+    -- ^ Separator between the package name and details.
   , listDepsLicense :: !Bool
-  -- ^ Print dependency licenses instead of versions.
+    -- ^ Print dependency licenses instead of versions.
   }
 
-data ListDepsFormat = ListDepsText ListDepsFormatOpts
-                    | ListDepsTree ListDepsFormatOpts
-                    | ListDepsJSON
-                    | ListDepsConstraints
+data ListDepsFormat
+  = ListDepsText ListDepsFormatOpts
+  | ListDepsTree ListDepsFormatOpts
+  | ListDepsJSON
+  | ListDepsConstraints
 
 data ListDepsOpts = ListDepsOpts
   { listDepsFormat :: !ListDepsFormat
-  -- ^ Format of printing dependencies
+    -- ^ Format of printing dependencies
   , listDepsDotOpts :: !DotOpts
-  -- ^ The normal dot options.
+    -- ^ The normal dot options.
   }
 
 -- | Visualize the project's dependencies as a graphviz graph
@@ -119,19 +138,22 @@ -- | Information about a package in the dependency graph, when available.
 data DotPayload = DotPayload
   { payloadVersion :: Maybe Version
-  -- ^ The package version.
+    -- ^ The package version.
   , payloadLicense :: Maybe (Either SPDX.License License)
-  -- ^ The license the package was released under.
+    -- ^ The license the package was released under.
   , payloadLocation :: Maybe PackageLocation
-  -- ^ The location of the package.
-  } deriving (Eq, Show)
+    -- ^ The location of the package.
+  }
+  deriving (Eq, Show)
 
 -- | Create the dependency graph and also prune it as specified in the dot
 -- options. Returns a set of local names and a map from package names to
 -- dependencies.
-createPrunedDependencyGraph
-  :: DotOpts
-  -> RIO Runner (Set PackageName, Map PackageName (Set PackageName, DotPayload))
+createPrunedDependencyGraph ::
+     DotOpts
+  -> RIO
+       Runner
+       (Set PackageName, Map PackageName (Set PackageName, DotPayload))
 createPrunedDependencyGraph dotOpts = withDotConfig dotOpts $ do
   localNames <- view $ buildConfigL.to (Map.keysSet . smwProject . bcSMWanted)
   logDebug "Creating dependency graph"
@@ -147,8 +169,8 @@ -- name to a tuple of dependencies and payload if available. This
 -- function mainly gathers the required arguments for
 -- @resolveDependencies@.
-createDependencyGraph
-  :: DotOpts
+createDependencyGraph ::
+     DotOpts
   -> RIO DotConfig (Map PackageName (Set PackageName, DotPayload))
 createDependencyGraph dotOpts = do
   sourceMap <- view sourceMapL
@@ -158,7 +180,7 @@   -- TODO: Can there be multiple entries for wired-in-packages? If so,
   -- this will choose one arbitrarily..
   let globalDumpMap = Map.fromList $ map (\dp -> (Stack.Prelude.pkgName (dpPackageIdent dp), dp)) globalDump
-      globalIdMap = Map.fromList $ map (\dp -> (dpGhcPkgId dp, dpPackageIdent dp)) globalDump
+      globalIdMap = Map.fromList $ map (dpGhcPkgId &&& dpPackageIdent) globalDump
   let depLoader = createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps
       loadPackageDeps name version loc flags ghcOptions cabalConfigOpts
         -- Skip packages that can't be loaded - see
@@ -175,9 +197,7 @@                                    (Just $ packageLicense pkg)
                                    (Just $ PLImmutable loc)
 
-listDependencies
-  :: ListDepsOpts
-  -> RIO Runner ()
+listDependencies :: ListDepsOpts -> RIO Runner ()
 listDependencies opts = do
   let dotOpts = listDepsDotOpts opts
   (pkgs, resultGraph) <- createPrunedDependencyGraph dotOpts
@@ -217,12 +237,12 @@                             ]
       loc = catMaybes
               [("location" .=) . pkgLocToJSON <$> payloadLocation payload]
-  in object $ fieldsAlwaysPresent ++ loc
+  in  object $ fieldsAlwaysPresent ++ loc
 
 pkgLocToJSON :: PackageLocation -> Value
 pkgLocToJSON (PLMutable (ResolvedPath _ dir)) = object
   [ "type" .= ("project package" :: Text)
-  , "url" .= ("file://" ++ Path.toFilePath dir)
+  , "url" .= ("file://" ++ toFilePath dir)
   ]
 pkgLocToJSON (PLImmutable (PLIHackage pkgid _ _)) = object
   [ "type" .= ("hackage" :: Text)
@@ -232,13 +252,13 @@   let url = case archiveLocation archive of
               ALUrl u -> u
               ALFilePath (ResolvedPath _ path) ->
-                Text.pack $ "file://" ++ Path.toFilePath path
-  in object
-       [ "type" .= ("archive" :: Text)
-       , "url" .= url
-       , "sha256" .= archiveHash archive
-       , "size" .= archiveSize archive
-       ]
+                Text.pack $ "file://" ++ toFilePath path
+  in  object
+        [ "type" .= ("archive" :: Text)
+        , "url" .= url
+        , "sha256" .= archiveHash archive
+        , "size" .= archiveSize archive
+        ]
 pkgLocToJSON (PLImmutable (PLIRepo repo _)) = object
   [ "type" .= case repoType repo of
                 RepoGit -> "git" :: Text
@@ -248,26 +268,28 @@   , "subdir" .= repoSubdir repo
   ]
 
-printJSON :: Set PackageName
-          -> Map PackageName (Set PackageName, DotPayload)
-          -> IO ()
+printJSON ::
+     Set PackageName
+  -> Map PackageName (Set PackageName, DotPayload)
+  -> IO ()
 printJSON pkgs dependencyMap =
   LBC8.putStrLn $ encode $ DependencyTree pkgs dependencyMap
 
 treeRoots :: ListDepsOpts -> Set PackageName -> Set PackageName
 treeRoots opts projectPackages' =
   let targets = dotTargets $ listDepsDotOpts opts
-   in if null targets
+  in  if null targets
         then projectPackages'
         else Set.fromList $ map (mkPackageName . Text.unpack) targets
 
-printTree :: ListDepsFormatOpts
-          -> DotOpts
-          -> Int
-          -> [Int]
-          -> Set PackageName
-          -> Map PackageName (Set PackageName, DotPayload)
-          -> IO ()
+printTree ::
+     ListDepsFormatOpts
+  -> DotOpts
+  -> Int
+  -> [Int]
+  -> Set PackageName
+  -> Map PackageName (Set PackageName, DotPayload)
+  -> IO ()
 printTree opts dotOpts depth remainingDepsCounts packages dependencyMap =
   F.sequence_ $ Seq.mapWithIndex go (toSeq packages)
  where
@@ -284,20 +306,21 @@           -- TODO: Define this behaviour, maybe pure an error?
           Nothing -> pure ()
 
-printTreeNode :: ListDepsFormatOpts
-              -> DotOpts
-              -> Int
-              -> [Int]
-              -> Set PackageName
-              -> DotPayload
-              -> PackageName
-              -> IO ()
+printTreeNode ::
+     ListDepsFormatOpts
+  -> DotOpts
+  -> Int
+  -> [Int]
+  -> Set PackageName
+  -> DotPayload
+  -> PackageName
+  -> IO ()
 printTreeNode opts dotOpts depth remainingDepsCounts deps payload name =
   let remainingDepth = fromMaybe 999 (dotDependencyDepth dotOpts) - depth
       hasDeps = not $ null deps
-  in Text.putStrLn $
-       treeNodePrefix "" remainingDepsCounts hasDeps remainingDepth <> " " <>
-       listDepsLine opts name payload
+  in  Text.putStrLn $
+        treeNodePrefix "" remainingDepsCounts hasDeps remainingDepth <> " " <>
+        listDepsLine opts name payload
 
 treeNodePrefix :: Text -> [Int] -> Bool -> Int -> Text
 treeNodePrefix t [] _ _      = t
@@ -333,25 +356,27 @@ -- | @pruneGraph dontPrune toPrune graph@ prunes all packages in
 -- @graph@ with a name in @toPrune@ and removes resulting orphans
 -- unless they are in @dontPrune@
-pruneGraph :: (F.Foldable f, F.Foldable g, Eq a)
-           => f PackageName
-           -> g PackageName
-           -> Map PackageName (Set PackageName, a)
-           -> Map PackageName (Set PackageName, a)
+pruneGraph ::
+     (F.Foldable f, F.Foldable g, Eq a)
+  => f PackageName
+  -> g PackageName
+  -> Map PackageName (Set PackageName, a)
+  -> Map PackageName (Set PackageName, a)
 pruneGraph dontPrune names =
   pruneUnreachable dontPrune . Map.mapMaybeWithKey (\pkg (pkgDeps,x) ->
     if pkg `F.elem` names
       then Nothing
-      else let filtered = Set.filter (\n -> n `F.notElem` names) pkgDeps
-           in if Set.null filtered && not (Set.null pkgDeps)
-                then Nothing
-                else Just (filtered,x))
+      else let filtered = Set.filter (`F.notElem` names) pkgDeps
+           in  if Set.null filtered && not (Set.null pkgDeps)
+                 then Nothing
+                 else Just (filtered,x))
 
 -- | Make sure that all unreachable nodes (orphans) are pruned
-pruneUnreachable :: (Eq a, F.Foldable f)
-                 => f PackageName
-                 -> Map PackageName (Set PackageName, a)
-                 -> Map PackageName (Set PackageName, a)
+pruneUnreachable ::
+     (Eq a, F.Foldable f)
+  => f PackageName
+  -> Map PackageName (Set PackageName, a)
+  -> Map PackageName (Set PackageName, a)
 pruneUnreachable dontPrune = fixpoint prune
  where
   fixpoint :: Eq a => (a -> a) -> a -> a
@@ -363,8 +388,8 @@ 
 
 -- | Resolve the dependency graph up to (Just depth) or until fixpoint is reached
-resolveDependencies
-  :: (Applicative m, Monad m)
+resolveDependencies ::
+     (Applicative m, Monad m)
   => Maybe Int
   -> Map PackageName (Set PackageName, DotPayload)
   -> (PackageName -> m (Set PackageName, DotPayload))
@@ -386,16 +411,21 @@ 
 -- | Given a SourceMap and a dependency loader, load the set of dependencies for
 -- a package
-createDepLoader
-  :: SourceMap
+createDepLoader ::
+     SourceMap
   -> Map PackageName DumpPackage
   -> Map GhcPkgId PackageIdentifier
-  -> (PackageName -> Version -> PackageLocationImmutable ->
-      Map FlagName Bool -> [Text] -> [Text] ->
-      RIO DotConfig (Set PackageName, DotPayload))
+  -> (  PackageName
+     -> Version
+     -> PackageLocationImmutable
+     -> Map FlagName Bool
+     -> [Text]
+     -> [Text]
+     -> RIO DotConfig (Set PackageName, DotPayload)
+     )
   -> PackageName
   -> RIO DotConfig (Set PackageName, DotPayload)
-createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = do
+createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName =
   fromMaybe (throwIO $ PackageNotFoundBug pkgName)
     (projectPackageDeps <|> dependencyDeps <|> globalDeps)
  where
@@ -436,10 +466,9 @@               Stack.Prelude.pkgName
               (Map.lookup depId globalIdMap)
 
-  payloadFromLocal pkg loc =
-    DotPayload (Just $ packageVersion pkg)
-               (Just $ packageLicense pkg)
-               loc
+  payloadFromLocal pkg =
+    DotPayload (Just $ packageVersion pkg) (Just $ packageLicense pkg)
+
   payloadFromDump dp =
     DotPayload (Just $ pkgVersion $ dpPackageIdent dp)
                (Right <$> dpLicense dp)
@@ -447,13 +476,13 @@ 
 -- | Resolve the direct (depth 0) external dependencies of the given local
 -- packages (assumed to come from project packages)
-projectPackageDependencies
-  :: DotOpts
+projectPackageDependencies ::
+     DotOpts
   -> [LocalPackage]
   -> [(PackageName, (Set PackageName, DotPayload))]
 projectPackageDependencies dotOpts locals =
   map (\lp -> let pkg = localPackageToPackage lp
-                  pkgDir = Path.parent $ lpCabalFile lp
+                  pkgDir = parent $ lpCabalFile lp
                   loc = PLMutable $ ResolvedPath (RelFilePath "N/A") pkgDir
               in  (packageName pkg, (deps pkg, lpPayload pkg loc)))
       locals
@@ -469,11 +498,12 @@ 
 -- | Print a graphviz graph of the edges in the Map and highlight the given
 -- local packages
-printGraph :: (Applicative m, MonadIO m)
-           => DotOpts
-           -> Set PackageName -- ^ all locals
-           -> Map PackageName (Set PackageName, DotPayload)
-           -> m ()
+printGraph ::
+     (Applicative m, MonadIO m)
+  => DotOpts
+  -> Set PackageName -- ^ all locals
+  -> Map PackageName (Set PackageName, DotPayload)
+  -> m ()
 printGraph dotOpts locals graph = do
   liftIO $ Text.putStrLn "strict digraph deps {"
   printLocalNodes dotOpts filteredLocals
@@ -485,10 +515,11 @@     Set.filter (\local' -> local' `Set.notMember` dotPrune dotOpts) locals
 
 -- | Print the local nodes with a different style depending on options
-printLocalNodes :: (F.Foldable t, MonadIO m)
-                => DotOpts
-                -> t PackageName
-                -> m ()
+printLocalNodes ::
+     (F.Foldable t, MonadIO m)
+  => DotOpts
+  -> t PackageName
+  -> m ()
 printLocalNodes dotOpts locals =
   liftIO $ Text.putStrLn (Text.intercalate "\n" lpNodes)
  where
@@ -500,9 +531,10 @@   lpNodes = map (applyStyle . nodeName) (F.toList locals)
 
 -- | Print nodes without dependencies
-printLeaves :: MonadIO m
-            => Map PackageName (Set PackageName, DotPayload)
-            -> m ()
+printLeaves ::
+     MonadIO m
+  => Map PackageName (Set PackageName, DotPayload)
+  -> m ()
 printLeaves = F.mapM_ printLeaf . Map.keysSet . Map.filter Set.null . fmap fst
 
 -- | @printDedges p ps@ prints an edge from p to every ps
@@ -537,10 +569,10 @@   fromMaybe (lpPackage lp) (lpTestBench lp)
 
 -- Plumbing for --test and --bench flags
-withDotConfig
-    :: DotOpts
-    -> RIO DotConfig a
-    -> RIO Runner a
+withDotConfig ::
+     DotOpts
+  -> RIO DotConfig a
+  -> RIO Runner a
 withDotConfig opts inner =
   local (over globalOptsL modifyGO) $
     if dotGlobalHints opts
@@ -618,23 +650,42 @@   , dcSourceMap :: !SourceMap
   , dcGlobalDump :: ![DumpPackage]
   }
+
 instance HasLogFunc DotConfig where
   logFuncL = runnerL.logFuncL
+
 instance HasPantryConfig DotConfig where
   pantryConfigL = configL.pantryConfigL
+
 instance HasTerm DotConfig where
   useColorL = runnerL.useColorL
   termWidthL = runnerL.termWidthL
+
 instance HasStylesUpdate DotConfig where
   stylesUpdateL = runnerL.stylesUpdateL
-instance HasGHCVariant DotConfig
-instance HasPlatform DotConfig
+
+instance HasGHCVariant DotConfig where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
+instance HasPlatform DotConfig where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
 instance HasRunner DotConfig where
   runnerL = configL.runnerL
+
 instance HasProcessContext DotConfig where
   processContextL = runnerL.processContextL
-instance HasConfig DotConfig
+
+instance HasConfig DotConfig where
+  configL = buildConfigL.lens bcConfig (\x y -> x { bcConfig = y })
+  {-# INLINE configL #-}
+
 instance HasBuildConfig DotConfig where
   buildConfigL = lens dcBuildConfig (\x y -> x { dcBuildConfig = y })
+
 instance HasSourceMap DotConfig where
   sourceMapL = lens dcSourceMap (\x y -> x { dcSourceMap = y })
+ src/Stack/Eval.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+-- | Types and functions related to Stack's @eval@ command.
+module Stack.Eval
+  ( EvalOpts (..)
+  , evalCmd
+  ) where
+
+import           Stack.Exec
+                   ( ExecOpts (..), ExecOptsExtra, SpecialExecCmd (..)
+                   , execCmd
+                   )
+import           Stack.Prelude
+import           Stack.Types.Runner ( Runner )
+
+-- Type representing command line options for the @stack eval@ command.
+data EvalOpts = EvalOpts
+  { evalArg :: !String
+  , evalExtra :: !ExecOptsExtra
+  }
+  deriving Show
+
+-- | Function underlying the @stack eval@ command. Evaluate some Haskell code
+-- inline.
+evalCmd :: EvalOpts -> RIO Runner ()
+evalCmd EvalOpts {..} = execCmd execOpts
+ where
+  execOpts =
+    ExecOpts { eoCmd = ExecGhc
+             , eoArgs = ["-e", evalArg]
+             , eoExtra = evalExtra
+             }
+ src/Stack/Exec.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+-- | Types and function related to Stack's @exec@, @ghc@, @run@, @runghc@ and
+-- @runhaskell@ commands.
+module Stack.Exec
+  ( ExecOpts (..)
+  , SpecialExecCmd (..)
+  , ExecOptsExtra (..)
+  , execCmd
+  ) where
+
+import qualified Data.List as L
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import           RIO.Process ( exec )
+import           Stack.Build ( build )
+import           Stack.Build.Target ( NeedTargets (..) )
+import           Stack.GhcPkg ( findGhcPkgField )
+import           Stack.Setup ( withNewLocalBuildTargets )
+import           Stack.Types.NamedComponent ( NamedComponent (..), isCExe )
+import           Stack.Prelude
+import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.BuildOpts
+                   ( BuildOptsCLI (..), defaultBuildOptsCLI )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), HasCompiler (..), getGhcPkgExe )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.EnvConfig ( EnvConfig )
+import           Stack.Types.EnvSettings ( EnvSettings (..) )
+import           Stack.Types.Runner ( Runner )
+import           Stack.Types.SourceMap ( SMWanted (..), ppComponents )
+import           System.Directory ( withCurrentDirectory )
+import           System.FilePath ( isValid )
+
+-- | Type representing exceptions thrown by functions in the "Stack.Exec"
+-- module.
+newtype ExecException
+  = InvalidPathForExec FilePath
+  deriving (Show, Typeable)
+
+instance Exception ExecException where
+  displayException (InvalidPathForExec path) = concat
+    [ "Error: [S-1541]\n"
+    , "Got an invalid '--cwd' argument for 'stack exec' ("
+    , path
+    , ")."
+    ]
+
+-- | Type representing \'pretty\' exceptions thrown by functions in the
+-- "Stack.Exec" module.
+data ExecPrettyException
+  = PackageIdNotFoundBug !String
+  | ExecutableToRunNotFound
+  deriving (Show, Typeable)
+
+instance Pretty ExecPrettyException where
+  pretty (PackageIdNotFoundBug name) = bugPrettyReport "[S-8251]" $
+    "Could not find the package id of the package" <+>
+      style Target (fromString name)
+    <> "."
+  pretty ExecutableToRunNotFound =
+       "[S-2483]"
+    <> line
+    <> flow "No executables found."
+
+instance Exception ExecPrettyException
+
+-- Type representing Stack's execution commands.
+data SpecialExecCmd
+  = ExecCmd String
+  | ExecRun
+  | ExecGhc
+  | ExecRunGhc
+  deriving (Eq, Show)
+
+data ExecOptsExtra = ExecOptsExtra
+  { eoEnvSettings :: !EnvSettings
+  , eoPackages :: ![String]
+  , eoRtsOptions :: ![String]
+  , eoCwd :: !(Maybe FilePath)
+  }
+  deriving Show
+
+-- Type representing options for Stack's execution commands.
+data ExecOpts = ExecOpts
+  { eoCmd :: !SpecialExecCmd
+  , eoArgs :: ![String]
+  , eoExtra :: !ExecOptsExtra
+  }
+  deriving Show
+
+-- | The function underlying Stack's @exec@, @ghc@, @run@, @runghc@ and
+-- @runhaskell@ commands. Execute a command.
+execCmd :: ExecOpts -> RIO Runner ()
+execCmd ExecOpts {..} =
+  withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $ do
+    unless (null targets) $ build Nothing
+
+    config <- view configL
+    menv <- liftIO $ configProcessContextSettings config eoEnvSettings
+    withProcessContext menv $ do
+      -- Add RTS options to arguments
+      let argsWithRts args = if null eoRtsOptions
+                  then args :: [String]
+                  else args ++ ["+RTS"] ++ eoRtsOptions ++ ["-RTS"]
+      (cmd, args) <- case (eoCmd, argsWithRts eoArgs) of
+        (ExecCmd cmd, args) -> pure (cmd, args)
+        (ExecRun, args) -> getRunCmd args
+        (ExecGhc, args) -> getGhcCmd eoPackages args
+        (ExecRunGhc, args) -> getRunGhcCmd eoPackages args
+
+      runWithPath eoCwd $ exec cmd args
+ where
+  ExecOptsExtra {..} = eoExtra
+
+  targets = concatMap words eoPackages
+  boptsCLI = defaultBuildOptsCLI
+             { boptsCLITargets = map T.pack targets
+             }
+
+  -- return the package-id of the first package in GHC_PACKAGE_PATH
+  getPkgId name = do
+    pkg <- getGhcPkgExe
+    mId <- findGhcPkgField pkg [] name "id"
+    case mId of
+      Just i -> pure (L.head $ words (T.unpack i))
+      -- should never happen as we have already installed the packages
+      _      -> prettyThrowIO (PackageIdNotFoundBug name)
+
+  getPkgOpts pkgs =
+    map ("-package-id=" ++) <$> mapM getPkgId pkgs
+
+  getRunCmd args = do
+    packages <- view $ buildConfigL.to (smwProject . bcSMWanted)
+    pkgComponents <- for (Map.elems packages) ppComponents
+    let executables = filter isCExe $ concatMap Set.toList pkgComponents
+    let (exe, args') = case args of
+                       []   -> (firstExe, args)
+                       x:xs -> case L.find (\y -> y == CExe (T.pack x)) executables of
+                               Nothing -> (firstExe, args)
+                               argExe -> (argExe, xs)
+                       where
+                          firstExe = listToMaybe executables
+    case exe of
+      Just (CExe exe') -> do
+        withNewLocalBuildTargets [T.cons ':' exe'] $ build Nothing
+        pure (T.unpack exe', args')
+      _ -> prettyThrowIO ExecutableToRunNotFound
+
+  getGhcCmd pkgs args = do
+    pkgopts <- getPkgOpts pkgs
+    compiler <- view $ compilerPathsL.to cpCompiler
+    pure (toFilePath compiler, pkgopts ++ args)
+
+  getRunGhcCmd pkgs args = do
+    pkgopts <- getPkgOpts pkgs
+    interpret <- view $ compilerPathsL.to cpInterpreter
+    pure (toFilePath interpret, pkgopts ++ args)
+
+  runWithPath :: Maybe FilePath -> RIO EnvConfig () -> RIO EnvConfig ()
+  runWithPath path callback = case path of
+    Nothing -> callback
+    Just p | not (isValid p) -> throwIO $ InvalidPathForExec p
+    Just p -> withUnliftIO $ \ul -> withCurrentDirectory p $ unliftIO ul callback
src/Stack/FileWatch.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
 
 module Stack.FileWatch
   ( WatchMode (WatchModePoll)
@@ -9,22 +8,27 @@   ) where
 
 import           Control.Concurrent.STM ( check )
+import qualified Data.Map.Merge.Strict as Map
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import           GHC.IO.Exception
-import           Path
+                   ( IOErrorType (InvalidArgument), IOException (..) )
+import           Path ( parent )
 import           Stack.Prelude
 import           System.FSNotify
+                   ( WatchConfig, WatchMode (..), confWatchMode, defaultConfig
+                   , eventPath, watchDir, withManagerConf
+                   )
 import           System.IO ( getLine )
 
-fileWatch
-  :: (HasLogFunc env, HasTerm env)
+fileWatch ::
+     HasTerm env
   => ((Set (Path Abs File) -> IO ()) -> RIO env ())
   -> RIO env ()
 fileWatch = fileWatchConf defaultConfig
 
-fileWatchPoll
-  :: (HasLogFunc env, HasTerm env)
+fileWatchPoll ::
+     HasTerm env
   => ((Set (Path Abs File) -> IO ()) -> RIO env ())
   -> RIO env ()
 fileWatchPoll =
@@ -34,100 +38,124 @@ --
 -- The action provided takes a callback that is used to set the files to be
 -- watched. When any of those files are changed, we rerun the action again.
-fileWatchConf
-  :: (HasLogFunc env, HasTerm env)
+fileWatchConf ::
+     HasTerm env
   => WatchConfig
   -> ((Set (Path Abs File) -> IO ()) -> RIO env ())
   -> RIO env ()
-fileWatchConf cfg inner = withRunInIO $ \run -> withManagerConf cfg $ \manager -> do
+fileWatchConf cfg inner =
+  withRunInIO $ \run -> withManagerConf cfg $ \manager -> do
     allFiles <- newTVarIO Set.empty
     dirtyVar <- newTVarIO True
     watchVar <- newTVarIO Map.empty
 
     let onChange event = atomically $ do
-            files <- readTVar allFiles
-            when (eventPath event `Set.member` files) (writeTVar dirtyVar True)
+          files <- readTVar allFiles
+          when (eventPath event `Set.member` files) (writeTVar dirtyVar True)
 
         setWatched :: Set (Path Abs File) -> IO ()
         setWatched files = do
-            atomically $ writeTVar allFiles $ Set.map toFilePath files
-            watch0 <- readTVarIO watchVar
-            let actions = Map.mergeWithKey
-                    keepListening
-                    stopListening
-                    startListening
-                    watch0
-                    newDirs
-            watch1 <- forM (Map.toList actions) $ \(k, mmv) -> do
-                mv <- mmv
-                pure $
-                    case mv of
-                        Nothing -> Map.empty
-                        Just v -> Map.singleton k v
-            atomically $ writeTVar watchVar $ Map.unions watch1
-          where
-            newDirs = Map.fromList $ map (, ())
-                    $ Set.toList
-                    $ Set.map parent files
+          atomically $ writeTVar allFiles $ Set.map toFilePath files
+          watch0 <- readTVarIO watchVar
+          let actions = Map.merge
+                (Map.mapMissing stopListening)
+                (Map.mapMissing startListening)
+                (Map.zipWithMatched keepListening)
+                watch0
+                newDirs
+          watch1 <- forM (Map.toList actions) $ \(k, mmv) -> do
+            mv <- mmv
+            pure $
+              case mv of
+                Nothing -> Map.empty
+                Just v -> Map.singleton k v
+          atomically $ writeTVar watchVar $ Map.unions watch1
+         where
+          newDirs = Map.fromList $ map (, ())
+                  $ Set.toList
+                  $ Set.map parent files
 
-            keepListening _dir listen () = Just $ pure $ Just listen
-            stopListening = Map.map $ \f -> do
-                () <- f `catch` \ioe ->
-                    -- Ignore invalid argument error - it can happen if
-                    -- the directory is removed.
-                    case ioe_type ioe of
-                        InvalidArgument -> pure ()
-                        _ -> throwIO ioe
-                pure Nothing
-            startListening = Map.mapWithKey $ \dir () -> do
-                let dir' = fromString $ toFilePath dir
-                listen <- watchDir manager dir' (const True) onChange
-                pure $ Just listen
+          keepListening _dir listen () = pure $ Just listen
+          stopListening _ f = do
+            () <- f `catch` \ioe ->
+              -- Ignore invalid argument error - it can happen if
+              -- the directory is removed.
+              case ioe_type ioe of
+                InvalidArgument -> pure ()
+                _ -> throwIO ioe
+            pure Nothing
+          startListening dir () = do
+            let dir' = fromString $ toFilePath dir
+            listen <- watchDir manager dir' (const True) onChange
+            pure $ Just listen
 
     let watchInput = do
-            l <- getLine
-            unless (l == "quit") $ do
-                run $ case l of
-                    "help" -> do
-                        logInfo ""
-                        logInfo "help: display this help"
-                        logInfo "quit: exit"
-                        logInfo "build: force a rebuild"
-                        logInfo "watched: display watched files"
-                    "build" -> atomically $ writeTVar dirtyVar True
-                    "watched" -> do
-                        watch <- readTVarIO allFiles
-                        mapM_ (logInfo . fromString) (Set.toList watch)
-                    "" -> atomically $ writeTVar dirtyVar True
-                    _ -> logInfo $
-                        "Unknown command: " <>
-                        displayShow l <>
-                        ". Try 'help'"
+          l <- getLine
+          unless (l == "quit") $ do
+            run $ case l of
+              "help" -> do
+                prettyInfo $
+                     line
+                  <> fillSep
+                       [ style Shell "help" <> ":"
+                       , flow "display this help."
+                       ]
+                  <> line
+                  <> fillSep
+                       [ style Shell "quit" <> ":"
+                       , "exit."
+                       ]
+                  <> line
+                  <> fillSep
+                       [ style Shell "build" <> ":"
+                       , flow "force a rebuild."
+                       ]
+                  <> line
+                  <> fillSep
+                       [ style Shell "watched" <> ":"
+                       , flow "display watched files."
+                       ]
+              "build" -> atomically $ writeTVar dirtyVar True
+              "watched" -> do
+                watch <- readTVarIO allFiles
+                mapM_ (prettyInfo . style File . fromString) (Set.toList watch)
+              "" -> atomically $ writeTVar dirtyVar True
+              _ -> prettyInfoL
+                     [ flow "Unknown command:"
+                     , style Shell (fromString l) <> "."
+                     , "Try"
+                     , style Shell "help" <> "."
+                     ]
 
-                watchInput
+            watchInput
 
     race_ watchInput $ run $ forever $ do
-        atomically $ do
-            dirty <- readTVar dirtyVar
-            check dirty
+      atomically $ do
+        dirty <- readTVar dirtyVar
+        check dirty
 
-        eres <- tryAny $ inner setWatched
+      eres <- tryAny $ inner setWatched
 
-        -- Clear dirtiness flag after the build to avoid an infinite
-        -- loop caused by the build itself triggering dirtiness. This
-        -- could be viewed as a bug, since files changed during the
-        -- build will not trigger an extra rebuild, but overall seems
-        -- like better behavior. See
-        -- https://github.com/commercialhaskell/stack/issues/822
-        atomically $ writeTVar dirtyVar False
+      -- Clear dirtiness flag after the build to avoid an infinite loop caused
+      -- by the build itself triggering dirtiness. This could be viewed as a
+      -- bug, since files changed during the build will not trigger an extra
+      -- rebuild, but overall seems like better behavior. See
+      -- https://github.com/commercialhaskell/stack/issues/822
+      atomically $ writeTVar dirtyVar False
 
-        prettyInfo $
-          case eres of
-            Left e ->
-                let theStyle = case fromException e of
-                        Just ExitSuccess -> Good
-                        _ -> Error
-                 in style theStyle $ fromString $ displayException e
-            _ -> style Good "Success! Waiting for next file change."
+      case eres of
+        Left e ->
+          case fromException e of
+            Just ExitSuccess ->
+              prettyInfo $ style Good $ fromString $ displayException e
+            _ -> case fromException e :: Maybe PrettyException of
+              Just pe -> prettyError $ pretty pe
+              _ -> prettyInfo $ style Error $ fromString $ displayException e
+        _ -> prettyInfo $
+               style Good (flow "Success! Waiting for next file change.")
 
-        logInfo "Type help for available commands. Press enter to force a rebuild."
+      prettyInfoL
+        [ "Type"
+        , style Shell "help"
+        , flow "for the available commands. Press enter to force a rebuild."
+        ]
src/Stack/GhcPkg.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Functions for the GHC package database.
@@ -26,14 +25,14 @@ import           RIO.Process ( HasProcessContext, proc, readProcess_ )
 import           Stack.Constants ( relFilePackageCache )
 import           Stack.Prelude
-import           Stack.Types.Config ( GhcPkgExe (..) )
-import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
 import           Stack.Types.Compiler ( WhichCompiler (..) )
+import           Stack.Types.CompilerPaths ( GhcPkgExe (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
 import           System.FilePath ( searchPathSeparator )
 
 -- | Get the global package database
 getGlobalDB ::
-     (HasProcessContext env, HasLogFunc env)
+     (HasProcessContext env, HasTerm env)
   => GhcPkgExe
   -> RIO env (Path Abs Dir)
 getGlobalDB pkgexe = do
@@ -52,7 +51,7 @@ 
 -- | Run the ghc-pkg executable
 ghcPkg ::
-     (HasProcessContext env, HasLogFunc env)
+     (HasProcessContext env, HasTerm env)
   => GhcPkgExe
   -> [Path Abs Dir]
   -> [String]
@@ -71,7 +70,7 @@ 
 -- | Create a package database in the given directory, if it doesn't exist.
 createDatabase ::
-     (HasProcessContext env, HasLogFunc env)
+     (HasProcessContext env, HasTerm env)
   => GhcPkgExe
   -> Path Abs Dir
   -> RIO env ()
@@ -84,11 +83,13 @@     dirExists <- doesDirExist db
     args <- if dirExists
       then do
-        logWarn $
-          "The package database located at " <>
-          fromString (toFilePath db) <>
-          " is corrupted (missing its package.cache file)."
-        logWarn "Proceeding with a recache"
+        prettyWarnL
+          [ flow "The package database located at"
+          , pretty db
+          , flow "is corrupted. It is missing its"
+          , style File "package.cache"
+          , flow "file. Stack is proceeding with a recache."
+          ]
         pure ["--package-db", toFilePath db, "recache"]
       else do
         -- Creating the parent doesn't seem necessary, as ghc-pkg
@@ -115,7 +116,7 @@ 
 -- | Get the value of a field of the package.
 findGhcPkgField ::
-     (HasProcessContext env, HasLogFunc env)
+     (HasProcessContext env, HasTerm env)
   => GhcPkgExe
   -> [Path Abs Dir] -- ^ package databases
   -> String -- ^ package identifier, or GhcPkgId
@@ -137,7 +138,7 @@ -- see https://github.com/commercialhaskell/stack/issues/2662#issuecomment-460342402
 -- using GHC package id where available (from GHC 7.9)
 unregisterGhcPkgIds ::
-     (HasProcessContext env, HasLogFunc env)
+     (HasProcessContext env, HasTerm env)
   => GhcPkgExe
   -> Path Abs Dir -- ^ package database
   -> NonEmpty (Either PackageIdentifier GhcPkgId)
@@ -145,7 +146,7 @@ unregisterGhcPkgIds pkgexe pkgDb epgids = do
   eres <- ghcPkg pkgexe [pkgDb] args
   case eres of
-    Left e -> logWarn $ displayShow e
+    Left e -> prettyWarn $ string $ displayException e
     Right _ -> pure ()
  where
   (idents, gids) = partitionEithers $ toList epgids
src/Stack/Ghci.hs view
@@ -1,995 +1,1192 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE ConstraintKinds    #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RecordWildCards    #-}
-{-# LANGUAGE TupleSections      #-}
-
--- | Run a GHCi configured with the user's package(s).
-
-module Stack.Ghci
-  ( GhciOpts (..)
-  , GhciPkgInfo (..)
-  , GhciException (..)
-  , ghci
-  ) where
-
-import           Control.Monad.State.Strict ( State, execState, get, modify )
-import           Data.ByteString.Builder ( byteString )
-import qualified Data.ByteString.Char8 as S8
-import qualified Data.ByteString.Lazy as LBS
-import           Data.Foldable ( foldl )
-import qualified Data.List as L
-import qualified Data.List.NonEmpty as NE
-import qualified Data.Map.Strict as M
-import qualified Data.Set as S
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Encoding as TLE
-import qualified Distribution.PackageDescription as C
-import           Path
-import           Path.Extra ( toFilePathNoTrailingSep )
-import           Path.IO hiding ( withSystemTempDir )
-import           RIO.Process
-                   ( HasProcessContext, exec, proc, readProcess_
-                   , withWorkingDir
-                   )
-import           Stack.Build
-import           Stack.Build.Installed
-import           Stack.Build.Source
-import           Stack.Build.Target
-import           Stack.Constants
-import           Stack.Constants.Config
-import           Stack.Ghci.Script
-import           Stack.Package
-import           Stack.Prelude
-import           Stack.Types.Build
-import           Stack.Types.Config
-import           Stack.Types.NamedComponent
-import           Stack.Types.Package
-import           Stack.Types.PackageFile
-import           Stack.Types.SourceMap
-import           System.IO ( putStrLn )
-import           System.IO.Temp ( getCanonicalTemporaryDirectory )
-import           System.Permissions ( setScriptPerms )
-
--- | Type representing exceptions thrown by functions exported by the
--- "Stack.Ghci" module.
-data GhciException
-    = InvalidPackageOption String
-    | LoadingDuplicateModules
-    | MissingFileTarget String
-    | Can'tSpecifyFilesAndTargets
-    | Can'tSpecifyFilesAndMainIs
-    | GhciTargetParseException [Text]
-    deriving (Show, Typeable)
-
-instance Exception GhciException where
-    displayException (InvalidPackageOption name) =
-        "Error: [S-6716]\n"
-        ++ "Failed to parse '--package' option " ++ name ++ "."
-    displayException LoadingDuplicateModules = unlines
-        [ "Error: [S-9632]"
-        , "Not attempting to start ghci due to these duplicate modules."
-        , "Use '--no-load' to try to start it anyway, without loading any \
-          \modules (but these are still likely to cause errors)."
-        ]
-    displayException (MissingFileTarget name) =
-        "Error: [S-3600]\n"
-        ++ "Cannot find file target " ++ name ++ "."
-    displayException Can'tSpecifyFilesAndTargets =
-        "Error: [S-9906]\n"
-        ++ "Cannot use 'stack ghci' with both file targets and package targets."
-    displayException Can'tSpecifyFilesAndMainIs =
-        "Error: [S-5188]\n"
-        ++ "Cannot use 'stack ghci' with both file targets and '--main-is' \
-           \flag."
-    displayException (GhciTargetParseException xs) =
-        "Error: [S-6948]\n"
-        ++ show (TargetParseException xs)
-        ++ "\nNote that to specify options to be passed to GHCi, use the \
-           \'--ghci-options' flag."
-
--- | Command-line options for GHC.
-data GhciOpts = GhciOpts
-    { ghciTargets            :: ![Text]
-    , ghciArgs               :: ![String]
-    , ghciGhcOptions         :: ![String]
-    , ghciFlags              :: !(Map ApplyCLIFlag (Map FlagName Bool))
-    , ghciGhcCommand         :: !(Maybe FilePath)
-    , ghciNoLoadModules      :: !Bool
-    , ghciAdditionalPackages :: ![String]
-    , ghciMainIs             :: !(Maybe Text)
-    , ghciLoadLocalDeps      :: !Bool
-    , ghciSkipIntermediate   :: !Bool
-    , ghciHidePackages       :: !(Maybe Bool)
-    , ghciNoBuild            :: !Bool
-    , ghciOnlyMain           :: !Bool
-    } deriving Show
-
--- | Necessary information to load a package or its components.
---
--- NOTE: GhciPkgInfo has paths as list instead of a Set to preserve files order
--- as a workaround for bug https://ghc.haskell.org/trac/ghc/ticket/13786
-data GhciPkgInfo = GhciPkgInfo
-    { ghciPkgName :: !PackageName
-    , ghciPkgOpts :: ![(NamedComponent, BuildInfoOpts)]
-    , ghciPkgDir :: !(Path Abs Dir)
-    , ghciPkgModules :: !ModuleMap
-    , ghciPkgCFiles :: ![Path Abs File] -- ^ C files.
-    , ghciPkgMainIs :: !(Map NamedComponent [Path Abs File])
-    , ghciPkgTargetFiles :: !(Maybe [Path Abs File])
-    , ghciPkgPackage :: !Package
-    } deriving Show
-
--- | Loaded package description and related info.
-data GhciPkgDesc = GhciPkgDesc
-    { ghciDescPkg :: !Package
-    , ghciDescCabalFp :: !(Path Abs File)
-    , ghciDescTarget :: !Target
-    }
-
--- Mapping from a module name to a map with all of the paths that use
--- that name. Each of those paths is associated with a set of components
--- that contain it. Purpose of this complex structure is for use in
--- 'checkForDuplicateModules'.
-type ModuleMap = Map ModuleName (Map (Path Abs File) (Set (PackageName, NamedComponent)))
-
-unionModuleMaps :: [ModuleMap] -> ModuleMap
-unionModuleMaps = M.unionsWith (M.unionWith S.union)
-
--- | Launch a GHCi session for the given local package targets with the
--- given options and configure it with the load paths and extensions
--- of those targets.
-ghci :: HasEnvConfig env => GhciOpts -> RIO env ()
-ghci opts@GhciOpts{..} = do
-    let buildOptsCLI = defaultBuildOptsCLI
-            { boptsCLITargets = []
-            , boptsCLIFlags = ghciFlags
-            }
-    sourceMap <- view $ envConfigL.to envConfigSourceMap
-    installMap <- toInstallMap sourceMap
-    locals <- projectLocalPackages
-    depLocals <- localDependencies
-    let localMap =
-          M.fromList [(packageName $ lpPackage lp, lp) | lp <- locals ++ depLocals]
-        -- FIXME:qrilka this looks wrong to go back to SMActual
-        sma = SMActual
-             { smaCompiler = smCompiler sourceMap
-             , smaProject = smProject sourceMap
-             , smaDeps = smDeps sourceMap
-             , smaGlobal = smGlobal sourceMap
-             }
-    -- Parse --main-is argument.
-    mainIsTargets <- parseMainIsTargets buildOptsCLI sma ghciMainIs
-    -- Parse to either file targets or build targets
-    etargets <- preprocessTargets buildOptsCLI sma ghciTargets
-    (inputTargets, mfileTargets) <- case etargets of
-        Right packageTargets -> pure (packageTargets, Nothing)
-        Left rawFileTargets -> do
-            case mainIsTargets of
-                Nothing -> pure ()
-                Just _ -> throwM Can'tSpecifyFilesAndMainIs
-            -- Figure out targets based on filepath targets
-            (targetMap, fileInfo, extraFiles) <- findFileTargets locals rawFileTargets
-            pure (targetMap, Just (fileInfo, extraFiles))
-    -- Get a list of all the local target packages.
-    localTargets <- getAllLocalTargets opts inputTargets mainIsTargets localMap
-    -- Get a list of all the non-local target packages.
-    nonLocalTargets <- getAllNonLocalTargets inputTargets
-    -- Check if additional package arguments are sensible.
-    addPkgs <- checkAdditionalPackages ghciAdditionalPackages
-    -- Load package descriptions.
-    pkgDescs <- loadGhciPkgDescs buildOptsCLI localTargets
-    -- If necessary, ask user about which main module to load.
-    bopts <- view buildOptsL
-    mainFile <-
-        if ghciNoLoadModules
-            then pure Nothing
-            else do
-              -- Figure out package files, in order to ask the user
-              -- about which main module to load. See the note below for
-              -- why this is done again after the build. This could
-              -- potentially be done more efficiently, because all we
-              -- need is the location of main modules, not the rest.
-              pkgs0 <- getGhciPkgInfos installMap addPkgs (fmap fst mfileTargets) pkgDescs
-              figureOutMainFile bopts mainIsTargets localTargets pkgs0
-    let pkgTargets pn targets =
-          case targets of
-            TargetAll _  -> [T.pack (packageNameString pn)]
-            TargetComps comps -> [renderPkgComponent (pn, c) | c <- toList comps]
-    -- Build required dependencies and setup local packages.
-    buildDepsAndInitialSteps opts $
-      concatMap (\(pn, (_, t)) -> pkgTargets pn t) localTargets
-    targetWarnings localTargets nonLocalTargets mfileTargets
-    -- Load the list of modules _after_ building, to catch changes in
-    -- unlisted dependencies (#1180)
-    pkgs <- getGhciPkgInfos installMap addPkgs (fmap fst mfileTargets) pkgDescs
-    checkForIssues pkgs
-    -- Finally, do the invocation of ghci
-    runGhci opts localTargets mainFile pkgs (maybe [] snd mfileTargets) (nonLocalTargets ++ addPkgs)
-
-preprocessTargets ::
-       HasEnvConfig env
-    => BuildOptsCLI
-    -> SMActual GlobalPackage
-    -> [Text]
-    -> RIO env (Either [Path Abs File] (Map PackageName Target))
-preprocessTargets buildOptsCLI sma rawTargets = do
-    let (fileTargetsRaw, normalTargetsRaw) =
-            L.partition (\t -> ".hs" `T.isSuffixOf` t || ".lhs" `T.isSuffixOf` t)
-                      rawTargets
-    -- Only use file targets if we have no normal targets.
-    if not (null fileTargetsRaw) && null normalTargetsRaw
-        then do
-            fileTargets <- forM fileTargetsRaw $ \fp0 -> do
-                let fp = T.unpack fp0
-                mpath <- liftIO $ forgivingAbsence (resolveFile' fp)
-                case mpath of
-                    Nothing -> throwM (MissingFileTarget fp)
-                    Just path -> pure path
-            pure (Left fileTargets)
-        else do
-            -- Try parsing targets before checking if both file and
-            -- module targets are specified (see issue#3342).
-            let boptsCLI = buildOptsCLI { boptsCLITargets = normalTargetsRaw }
-            normalTargets <- parseTargets AllowNoTargets False boptsCLI sma
-                `catch` \ex -> case ex of
-                    TargetParseException xs -> throwM (GhciTargetParseException xs)
-                    _ -> throwM ex
-            unless (null fileTargetsRaw) $ throwM Can'tSpecifyFilesAndTargets
-            pure (Right $ smtTargets normalTargets)
-
-parseMainIsTargets ::
-        HasEnvConfig env
-     => BuildOptsCLI
-     -> SMActual GlobalPackage
-     -> Maybe Text
-     -> RIO env (Maybe (Map PackageName Target))
-parseMainIsTargets buildOptsCLI sma mtarget = forM mtarget $ \target -> do
-     let boptsCLI = buildOptsCLI { boptsCLITargets = [target] }
-     targets <- parseTargets AllowNoTargets False boptsCLI sma
-     pure $ smtTargets targets
-
--- | Display PackageName + NamedComponent
-displayPkgComponent :: (PackageName, NamedComponent) -> StyleDoc
-displayPkgComponent = style PkgComponent . fromString . T.unpack . renderPkgComponent
-
-findFileTargets ::
-       HasEnvConfig env
-    => [LocalPackage]
-    -> [Path Abs File]
-    -> RIO env (Map PackageName Target, Map PackageName [Path Abs File], [Path Abs File])
-findFileTargets locals fileTargets = do
-    filePackages <- forM locals $ \lp -> do
-        (_,compFiles,_,_) <- getPackageFiles (packageFiles (lpPackage lp)) (lpCabalFile lp)
-        pure (lp, M.map (map dotCabalGetPath) compFiles)
-    let foundFileTargetComponents :: [(Path Abs File, [(PackageName, NamedComponent)])]
-        foundFileTargetComponents =
-            map (\fp -> (fp, ) $ L.sort $
-                        concatMap (\(lp, files) -> map ((packageName (lpPackage lp), ) . fst)
-                                                       (filter (elem fp . snd) (M.toList files))
-                                  ) filePackages
-                ) fileTargets
-    results <- forM foundFileTargetComponents $ \(fp, xs) ->
-        case xs of
-            [] -> do
-                prettyWarn $ vsep
-                    [ "Couldn't find a component for file target" <+>
-                      pretty fp <>
-                      ". This means that the correct ghc options might not be used."
-                    , "Attempting to load the file anyway."
-                    ]
-                pure $ Left fp
-            [x] -> do
-                prettyInfo $
-                    "Using configuration for" <+> displayPkgComponent x <+>
-                    "to load" <+> pretty fp
-                pure $ Right (fp, x)
-            (x:_) -> do
-                prettyWarn $
-                    "Multiple components contain file target" <+>
-                    pretty fp <> ":" <+>
-                    mconcat (L.intersperse ", " (map displayPkgComponent xs)) <> line <>
-                    "Guessing the first one," <+> displayPkgComponent x <> "."
-                pure $ Right (fp, x)
-    let (extraFiles, associatedFiles) = partitionEithers results
-        targetMap =
-            foldl unionTargets M.empty $
-            map (\(_, (name, comp)) -> M.singleton name (TargetComps (S.singleton comp)))
-                associatedFiles
-        infoMap =
-            foldl (M.unionWith (<>)) M.empty $
-            map (\(fp, (name, _)) -> M.singleton name [fp])
-                associatedFiles
-    pure (targetMap, infoMap, extraFiles)
-
-getAllLocalTargets ::
-       HasEnvConfig env
-    => GhciOpts
-    -> Map PackageName Target
-    -> Maybe (Map PackageName Target)
-    -> Map PackageName LocalPackage
-    -> RIO env [(PackageName, (Path Abs File, Target))]
-getAllLocalTargets GhciOpts{..} targets0 mainIsTargets localMap = do
-    -- Use the 'mainIsTargets' as normal targets, for CLI concision. See
-    -- #1845. This is a little subtle - we need to do the target parsing
-    -- independently in order to handle the case where no targets are
-    -- specified.
-    let targets = maybe targets0 (unionTargets targets0) mainIsTargets
-    packages <- view $ envConfigL.to envConfigSourceMap.to smProject
-    -- Find all of the packages that are directly demanded by the
-    -- targets.
-    let directlyWanted = flip mapMaybe (M.toList packages) $
-          \(name, pp) ->
-                case M.lookup name targets of
-                  Just simpleTargets -> Just (name, (ppCabalFP pp, simpleTargets))
-                  Nothing -> Nothing
-    -- Figure out
-    let extraLoadDeps = getExtraLoadDeps ghciLoadLocalDeps localMap directlyWanted
-    if (ghciSkipIntermediate && not ghciLoadLocalDeps) || null extraLoadDeps
-        then pure directlyWanted
-        else do
-            let extraList =
-                  mconcat $ L.intersperse ", " (map (fromString . packageNameString . fst) extraLoadDeps)
-            if ghciLoadLocalDeps
-                then logInfo $
-                  "The following libraries will also be loaded into GHCi because " <>
-                  "they are local dependencies of your targets, and you specified --load-local-deps:\n    " <>
-                  extraList
-                else logInfo $
-                  "The following libraries will also be loaded into GHCi because " <>
-                  "they are intermediate dependencies of your targets:\n    " <>
-                  extraList <>
-                  "\n(Use --skip-intermediate-deps to omit these)"
-            pure (directlyWanted ++ extraLoadDeps)
-
-getAllNonLocalTargets ::
-     Map PackageName Target
-  -> RIO env [PackageName]
-getAllNonLocalTargets targets = do
-  let isNonLocal (TargetAll PTDependency) = True
-      isNonLocal _ = False
-  pure $ map fst $ filter (isNonLocal . snd) (M.toList targets)
-
-buildDepsAndInitialSteps :: HasEnvConfig env => GhciOpts -> [Text] -> RIO env ()
-buildDepsAndInitialSteps GhciOpts{..} localTargets = do
-    let targets = localTargets ++ map T.pack ghciAdditionalPackages
-    -- If necessary, do the build, for local packagee targets, only do
-    -- 'initialBuildSteps'.
-    case NE.nonEmpty targets of
-      -- only new local targets could appear here
-      Just nonEmptyTargets | not ghciNoBuild -> do
-        eres <- buildLocalTargets nonEmptyTargets
-        case eres of
-            Right () -> pure ()
-            Left err -> do
-                prettyError $ fromString (displayException err)
-                prettyWarn "Build failed, but trying to launch GHCi anyway"
-      _ ->
-        pure ()
-
-checkAdditionalPackages :: MonadThrow m => [String] -> m [PackageName]
-checkAdditionalPackages pkgs = forM pkgs $ \name -> do
-    let mres = (pkgName <$> parsePackageIdentifier name)
-            <|> parsePackageNameThrowing name
-    maybe (throwM $ InvalidPackageOption name) pure mres
-
-runGhci ::
-       HasEnvConfig env
-    => GhciOpts
-    -> [(PackageName, (Path Abs File, Target))]
-    -> Maybe (Path Abs File)
-    -> [GhciPkgInfo]
-    -> [Path Abs File]
-    -> [PackageName]
-    -> RIO env ()
-runGhci GhciOpts{..} targets mainFile pkgs extraFiles exposePackages = do
-    config <- view configL
-    let pkgopts = hidePkgOpts ++ genOpts ++ ghcOpts
-        shouldHidePackages =
-          fromMaybe (not (null pkgs && null exposePackages)) ghciHidePackages
-        hidePkgOpts =
-          if shouldHidePackages
-            then
-              ["-hide-all-packages"] ++
-              -- This is necessary, because current versions of ghci
-              -- will entirely fail to start if base isn't visible. This
-              -- is because it tries to use the interpreter to set
-              -- buffering options on standard IO.
-              (if null targets then ["-package", "base"] else []) ++
-              concatMap (\n -> ["-package", packageNameString n]) exposePackages
-            else []
-        oneWordOpts bio
-            | shouldHidePackages = bioOneWordOpts bio ++ bioPackageFlags bio
-            | otherwise = bioOneWordOpts bio
-        genOpts = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs)
-        (omittedOpts, ghcOpts) = L.partition badForGhci $
-            concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++ map T.unpack
-              ( fold (configGhcOptionsByCat config) -- include everything, locals, and targets
-             ++ concatMap (getUserOptions . ghciPkgName) pkgs
-              )
-        getUserOptions pkg = M.findWithDefault [] pkg (configGhcOptionsByName config)
-        badForGhci x =
-            L.isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky -static -Werror")
-    unless (null omittedOpts) $
-        logWarn
-            ("The following GHC options are incompatible with GHCi and have not been passed to it: " <>
-             mconcat (L.intersperse " " (fromString <$> nubOrd omittedOpts)))
-    oiDir <- view objectInterfaceDirL
-    let odir =
-            [ "-odir=" <> toFilePathNoTrailingSep oiDir
-            , "-hidir=" <> toFilePathNoTrailingSep oiDir ]
-    logInfo $
-      "Configuring GHCi with the following packages: " <>
-      mconcat (L.intersperse ", " (map (fromString . packageNameString . ghciPkgName) pkgs))
-    compilerExeName <- view $ compilerPathsL.to cpCompiler.to toFilePath
-    let execGhci extras = do
-            menv <- liftIO $ configProcessContextSettings config defaultEnvSettings
-            withPackageWorkingDir $ withProcessContext menv $ exec
-                 (fromMaybe compilerExeName ghciGhcCommand)
-                 (("--interactive" : ) $
-                 -- This initial "-i" resets the include directories to
-                 -- not include CWD. If there aren't any packages, CWD
-                 -- is included.
-                  (if null pkgs then id else ("-i" : )) $
-                  odir <> pkgopts <> extras <> ghciGhcOptions <> ghciArgs)
-        withPackageWorkingDir =
-            case pkgs of
-              [pkg] -> withWorkingDir (toFilePath $ ghciPkgDir pkg)
-              _ -> id
-        -- TODO: Consider optimizing this check. Perhaps if no
-        -- "with-ghc" is specified, assume that it is not using intero.
-        checkIsIntero =
-            -- Optimization dependent on the behavior of renderScript -
-            -- it doesn't matter if it's intero or ghci when loading
-            -- multiple packages.
-            case pkgs of
-                [_] -> do
-                    menv <- liftIO $ configProcessContextSettings config defaultEnvSettings
-                    output <- withProcessContext menv
-                            $ runGrabFirstLine (fromMaybe compilerExeName ghciGhcCommand) ["--version"]
-                    pure $ "Intero" `L.isPrefixOf` output
-                _ -> pure False
-    -- Since usage of 'exec' does not pure, we cannot do any cleanup
-    -- on ghci exit. So, instead leave the generated files. To make this
-    -- more efficient and avoid gratuitous generation of garbage, the
-    -- file names are determined by hashing. This also has the nice side
-    -- effect of making it possible to copy the ghci invocation out of
-    -- the log and have it still work.
-    tmpDirectory <-
-        (</> relDirHaskellStackGhci) <$>
-        (parseAbsDir =<< liftIO getCanonicalTemporaryDirectory)
-    ghciDir <- view ghciDirL
-    ensureDir ghciDir
-    ensureDir tmpDirectory
-    macrosOptions <- writeMacrosFile ghciDir pkgs
-    if ghciNoLoadModules
-        then execGhci macrosOptions
-        else do
-            checkForDuplicateModules pkgs
-            isIntero <- checkIsIntero
-            scriptOptions <- writeGhciScript tmpDirectory (renderScript isIntero pkgs mainFile ghciOnlyMain extraFiles)
-            execGhci (macrosOptions ++ scriptOptions)
-
-writeMacrosFile ::
-     HasTerm env
-  => Path Abs Dir
-  -> [GhciPkgInfo]
-  -> RIO env [String]
-writeMacrosFile outputDirectory pkgs = do
-    fps <- fmap (nubOrd . catMaybes . concat) $
-        forM pkgs $ \pkg -> forM (ghciPkgOpts pkg) $ \(_, bio) -> do
-            let cabalMacros = bioCabalMacros bio
-            exists <- liftIO $ doesFileExist cabalMacros
-            if exists
-                then pure $ Just cabalMacros
-                else do
-                    prettyWarnL ["Didn't find expected autogen file:", pretty cabalMacros]
-                    pure Nothing
-    files <- liftIO $ mapM (S8.readFile . toFilePath) fps
-    if null files then pure [] else do
-        out <- liftIO $ writeHashedFile outputDirectory relFileCabalMacrosH $
-            S8.concat $ map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files
-        pure ["-optP-include", "-optP" <> toFilePath out]
-
-writeGhciScript :: (MonadIO m) => Path Abs Dir -> GhciScript -> m [String]
-writeGhciScript outputDirectory script = do
-    scriptPath <- liftIO $ writeHashedFile outputDirectory relFileGhciScript $
-        LBS.toStrict $ scriptToLazyByteString script
-    let scriptFilePath = toFilePath scriptPath
-    setScriptPerms scriptFilePath
-    pure ["-ghci-script=" <> scriptFilePath]
-
-writeHashedFile ::
-     Path Abs Dir
-  -> Path Rel File
-  -> ByteString
-  -> IO (Path Abs File)
-writeHashedFile outputDirectory relFile contents = do
-    relSha <- shaPathForBytes contents
-    let outDir = outputDirectory </> relSha
-        outFile = outDir </> relFile
-    alreadyExists <- doesFileExist outFile
-    unless alreadyExists $ do
-        ensureDir outDir
-        writeBinaryFileAtomic outFile $ byteString contents
-    pure outFile
-
-renderScript ::
-     Bool
-  -> [GhciPkgInfo]
-  -> Maybe (Path Abs File)
-  -> Bool
-  -> [Path Abs File]
-  -> GhciScript
-renderScript isIntero pkgs mainFile onlyMain extraFiles = do
-    let cdPhase = case (isIntero, pkgs) of
-          -- If only loading one package, set the cwd properly.
-          -- Otherwise don't try. See
-          -- https://github.com/commercialhaskell/stack/issues/3309
-          (True, [pkg]) -> cmdCdGhc (ghciPkgDir pkg)
-          _ -> mempty
-        addPhase = cmdAdd $ S.fromList (map Left allModules ++ addMain)
-        addMain = case mainFile of
-            Just path -> [Right path]
-            _ -> []
-        modulePhase = cmdModule $ S.fromList allModules
-        allModules = nubOrd $ concatMap (M.keys . ghciPkgModules) pkgs
-    case getFileTargets pkgs <> extraFiles of
-        [] ->
-          if onlyMain
-            then cdPhase <> if isJust mainFile then cmdAdd (S.fromList addMain) else mempty
-            else cdPhase <> addPhase <> modulePhase
-        fileTargets -> cmdAdd (S.fromList (map Right fileTargets))
-
--- Hacky check if module / main phase should be omitted. This should be
--- improved if / when we have a better per-component load.
-getFileTargets :: [GhciPkgInfo] -> [Path Abs File]
-getFileTargets = concatMap (concat . maybeToList . ghciPkgTargetFiles)
-
--- | Figure out the main-is file to load based on the targets. Asks the
--- user for input if there is more than one candidate main-is file.
-figureOutMainFile ::
-       HasRunner env
-    => BuildOpts
-    -> Maybe (Map PackageName Target)
-    -> [(PackageName, (Path Abs File, Target))]
-    -> [GhciPkgInfo]
-    -> RIO env (Maybe (Path Abs File))
-figureOutMainFile bopts mainIsTargets targets0 packages = do
-    case candidates of
-        [] -> pure Nothing
-        [c@(_,_,fp)] -> do logInfo ("Using main module: " <> display (renderCandidate c))
-                           pure (Just fp)
-        candidate:_ -> do
-          borderedWarning $ do
-            logWarn "The main module to load is ambiguous. Candidates are: "
-            forM_ (map renderCandidate candidates) (logWarn . display)
-            logWarn
-                "You can specify which one to pick by: "
-            logWarn
-                (" * Specifying targets to stack ghci e.g. stack ghci " <>
-                display ( sampleTargetArg candidate))
-            logWarn
-                (" * Specifying what the main is e.g. stack ghci " <>
-                 display (sampleMainIsArg candidate))
-            logWarn
-                (" * Choosing from the candidate above [1.." <>
-                display (length candidates) <> "]")
-          liftIO userOption
-  where
-    targets = fromMaybe (M.fromList $ map (\(k, (_, x)) -> (k, x)) targets0)
-                        mainIsTargets
-    candidates = do
-        pkg <- packages
-        case M.lookup (ghciPkgName pkg) targets of
-            Nothing -> []
-            Just target -> do
-                (component,mains) <-
-                    M.toList $
-                    M.filterWithKey (\k _ -> k `S.member` wantedComponents)
-                                    (ghciPkgMainIs pkg)
-                main <- mains
-                pure (ghciPkgName pkg, component, main)
-              where
-                wantedComponents =
-                    wantedPackageComponents bopts target (ghciPkgPackage pkg)
-    renderCandidate c@(pkgName,namedComponent,mainIs) =
-        let candidateIndex = T.pack . show . (+1) . fromMaybe 0 . L.elemIndex c
-            pkgNameText = T.pack (packageNameString pkgName)
-        in  candidateIndex candidates <> ". Package `" <>
-            pkgNameText <>
-            "' component " <>
-            -- This is the format that can be directly copy-pasted as
-            -- an argument to `stack ghci`.
-            pkgNameText <> ":" <> renderComp namedComponent <>
-            " with main-is file: " <>
-            T.pack (toFilePath mainIs)
-    candidateIndices = take (length candidates) [1 :: Int ..]
-    userOption = do
-      option <- prompt "Specify main module to use (press enter to load none): "
-      let selected = fromMaybe
-                      ((+1) $ length candidateIndices)
-                      (readMaybe (T.unpack option) :: Maybe Int)
-      case L.elemIndex selected candidateIndices  of
-        Nothing -> do
-            putStrLn
-              "Not loading any main modules, as no valid module selected"
-            putStrLn ""
-            pure Nothing
-        Just op -> do
-            let (_,_,fp) = candidates L.!! op
-            putStrLn
-              ("Loading main module from candidate " <>
-              show (op + 1) <> ", --main-is " <>
-              toFilePath fp)
-            putStrLn ""
-            pure $ Just fp
-    renderComp c =
-        case c of
-            CLib -> "lib"
-            CInternalLib name -> "internal-lib:" <> name
-            CExe name -> "exe:" <> name
-            CTest name -> "test:" <> name
-            CBench name -> "bench:" <> name
-    sampleTargetArg (pkg,comp,_) =
-        T.pack (packageNameString pkg) <> ":" <> renderComp comp
-    sampleMainIsArg (pkg,comp,_) =
-        "--main-is " <> T.pack (packageNameString pkg) <> ":" <> renderComp comp
-
-loadGhciPkgDescs ::
-       HasEnvConfig env
-    => BuildOptsCLI
-    -> [(PackageName, (Path Abs File, Target))]
-    -> RIO env [GhciPkgDesc]
-loadGhciPkgDescs buildOptsCLI localTargets =
-    forM localTargets $ \(name, (cabalfp, target)) ->
-        loadGhciPkgDesc buildOptsCLI name cabalfp target
-
--- | Load package description information for a ghci target.
-loadGhciPkgDesc ::
-       HasEnvConfig env
-    => BuildOptsCLI
-    -> PackageName
-    -> Path Abs File
-    -> Target
-    -> RIO env GhciPkgDesc
-loadGhciPkgDesc buildOptsCLI name cabalfp target = do
-    econfig <- view envConfigL
-    compilerVersion <- view actualCompilerVersionL
-    let SourceMap{..} = envConfigSourceMap econfig
-        -- Currently this source map is being build with
-        -- the default targets
-        sourceMapGhcOptions = fromMaybe [] $
-          (cpGhcOptions . ppCommon <$> M.lookup name smProject)
-          <|>
-          (cpGhcOptions . dpCommon <$> M.lookup name smDeps)
-        sourceMapCabalConfigOpts = fromMaybe [] $
-          (cpCabalConfigOpts . ppCommon <$> M.lookup name smProject)
-          <|>
-          (cpCabalConfigOpts . dpCommon <$> M.lookup name smDeps)
-        sourceMapFlags = maybe mempty (cpFlags . ppCommon) $ M.lookup name smProject
-        config =
-            PackageConfig
-            { packageConfigEnableTests = True
-            , packageConfigEnableBenchmarks = True
-            , packageConfigFlags = getLocalFlags buildOptsCLI name `M.union` sourceMapFlags
-            , packageConfigGhcOptions = sourceMapGhcOptions
-            , packageConfigCabalConfigOpts = sourceMapCabalConfigOpts
-            , packageConfigCompilerVersion = compilerVersion
-            , packageConfigPlatform = view platformL econfig
-            }
-    -- TODO we've already parsed this information, otherwise we
-    -- wouldn't have figured out the cabalfp already. In the future:
-    -- retain that GenericPackageDescription in the relevant data
-    -- structures to avoid reparsing.
-    (gpdio, _name, _cabalfp) <-
-        loadCabalFilePath (Just stackProgName') (parent cabalfp)
-    gpkgdesc <- liftIO $ gpdio YesPrintWarnings
-
-    -- Source the package's *.buildinfo file created by configure if any. See
-    -- https://www.haskell.org/cabal/users-guide/developing-packages.html#system-dependent-parameters
-    buildinfofp <- parseRelFile (packageNameString name ++ ".buildinfo")
-    hasDotBuildinfo <- doesFileExist (parent cabalfp </> buildinfofp)
-    let mbuildinfofp
-          | hasDotBuildinfo = Just (parent cabalfp </> buildinfofp)
-          | otherwise = Nothing
-    mbuildinfo <- forM mbuildinfofp readDotBuildinfo
-    let pdp = resolvePackageDescription config gpkgdesc
-        pkg =
-            packageFromPackageDescription config (C.genPackageFlags gpkgdesc) $
-            maybe
-              pdp
-              (\bi ->
-               let PackageDescriptionPair x y = pdp
-                in PackageDescriptionPair
-                    (C.updatePackageDescription bi x)
-                    (C.updatePackageDescription bi y))
-              mbuildinfo
-    pure GhciPkgDesc
-      { ghciDescPkg = pkg
-      , ghciDescCabalFp = cabalfp
-      , ghciDescTarget = target
-      }
-
-getGhciPkgInfos ::
-       HasEnvConfig env
-    => InstallMap
-    -> [PackageName]
-    -> Maybe (Map PackageName [Path Abs File])
-    -> [GhciPkgDesc]
-    -> RIO env [GhciPkgInfo]
-getGhciPkgInfos installMap addPkgs mfileTargets localTargets = do
-    (installedMap, _, _, _) <- getInstalled installMap
-    let localLibs =
-            [ packageName (ghciDescPkg desc)
-            | desc <- localTargets
-            , hasLocalComp isCLib (ghciDescTarget desc)
-            ]
-    forM localTargets $ \pkgDesc ->
-      makeGhciPkgInfo installMap installedMap localLibs addPkgs mfileTargets pkgDesc
-
--- | Make information necessary to load the given package in GHCi.
-makeGhciPkgInfo ::
-       HasEnvConfig env
-    => InstallMap
-    -> InstalledMap
-    -> [PackageName]
-    -> [PackageName]
-    -> Maybe (Map PackageName [Path Abs File])
-    -> GhciPkgDesc
-    -> RIO env GhciPkgInfo
-makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do
-    bopts <- view buildOptsL
-    let pkg = ghciDescPkg pkgDesc
-        cabalfp = ghciDescCabalFp pkgDesc
-        target = ghciDescTarget pkgDesc
-        name = packageName pkg
-    (mods,files,opts) <- getPackageOpts (packageOpts pkg) installMap installedMap locals addPkgs cabalfp
-    let filteredOpts = filterWanted opts
-        filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted)
-        allWanted = wantedPackageComponents bopts target pkg
-    pure
-        GhciPkgInfo
-        { ghciPkgName = name
-        , ghciPkgOpts = M.toList filteredOpts
-        , ghciPkgDir = parent cabalfp
-        , ghciPkgModules = unionModuleMaps $
-          map (\(comp, mp) -> M.map (\fp -> M.singleton fp (S.singleton (packageName pkg, comp))) mp)
-              (M.toList (filterWanted mods))
-        , ghciPkgMainIs = M.map (mapMaybe dotCabalMainPath) files
-        , ghciPkgCFiles = mconcat (M.elems (filterWanted (M.map (mapMaybe dotCabalCFilePath) files)))
-        , ghciPkgTargetFiles = mfileTargets >>= M.lookup name
-        , ghciPkgPackage = pkg
-        }
-
--- NOTE: this should make the same choices as the components code in
--- 'loadLocalPackage'. Unfortunately for now we reiterate this logic
--- (differently).
-wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent
-wantedPackageComponents _ (TargetComps cs) _ = cs
-wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $
-    (case packageLibraries pkg of
-       NoLibraries -> []
-       HasLibraries names -> CLib : map CInternalLib (S.toList names)) ++
-    map CExe (S.toList (packageExes pkg)) <>
-    map CInternalLib (S.toList $ packageInternalLibraries pkg) <>
-    (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <>
-    (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else [])
-wantedPackageComponents _ _ _ = S.empty
-
-checkForIssues :: HasLogFunc env => [GhciPkgInfo] -> RIO env ()
-checkForIssues pkgs = do
-    when (length pkgs > 1) $ borderedWarning $ do
-        -- Cabal flag issues could arise only when there are at least 2 packages
-        unless (null cabalFlagIssues) $ borderedWarning $ do
-            logWarn "Warning: There are cabal flags for this project which may prevent GHCi from loading your code properly."
-            logWarn "In some cases it can also load some projects which would otherwise fail to build."
-            logWarn ""
-            mapM_ (logWarn . display) $ L.intercalate [""] cabalFlagIssues
-            logWarn ""
-            logWarn "To resolve, remove the flag(s) from the Cabal file(s) and instead put them at the top of the haskell files."
-            logWarn ""
-        logWarn "It isn't yet possible to load multiple packages into GHCi in all cases - see"
-        logWarn "https://ghc.haskell.org/trac/ghc/ticket/10827"
-  where
-    cabalFlagIssues = concatMap mixedFlag
-        [ ( "-XNoImplicitPrelude"
-          , [ "-XNoImplicitPrelude will be used, but GHCi will likely fail to build things which depend on the implicit prelude."]
-          )
-        , ( "-XCPP"
-          , [ "-XCPP will be used, but it can cause issues with multiline strings."
-            , "See https://downloads.haskell.org/~ghc/7.10.2/docs/html/users_guide/options-phases.html#cpp-string-gaps"
-            ]
-          )
-        , ( "-XNoTraditionalRecordSyntax"
-          , [ "-XNoTraditionalRecordSyntax will be used, but it break modules which use record syntax." ]
-          )
-        , ( "-XTemplateHaskell"
-          , [ "-XTemplateHaskell will be used, but it may cause compilation issues due to different parsing of '$' when there's no space after it." ]
-          )
-        , ( "-XQuasiQuotes"
-          , [ "-XQuasiQuotes will be used, but it may cause parse failures due to a different meaning for list comprehension syntax like [x| ... ]" ]
-          )
-        , ( "-XSafe"
-          , [ "-XSafe will be used, but it will fail to compile unsafe modules." ]
-          )
-        , ( "-XArrows"
-          , [ "-XArrows will be used, but it will cause non-arrow usages of proc, (-<), (-<<) to fail" ]
-          )
-        , ( "-XOverloadedStrings"
-          , [ "-XOverloadedStrings will be used, but it can cause type ambiguity in code not usually compiled with it." ]
-          )
-        , ( "-XOverloadedLists"
-          , [ "-XOverloadedLists will be used, but it can cause type ambiguity in code not usually compiled with it." ]
-          )
-        , ( "-XMonoLocalBinds"
-          , [ "-XMonoLocalBinds will be used, but it can cause type errors in code which expects generalized local bindings." ]
-          )
-        , ( "-XTypeFamilies"
-          , [ "-XTypeFamilies will be used, but it implies -XMonoLocalBinds, and so can cause type errors in code which expects generalized local bindings." ]
-          )
-        , ( "-XGADTs"
-          , [ "-XGADTs will be used, but it implies -XMonoLocalBinds, and so can cause type errors in code which expects generalized local bindings." ]
-          )
-        , ( "-XNewQualifiedOperators"
-          , [ "-XNewQualifiedOperators will be used, but this will break usages of the old qualified operator syntax." ]
-          )
-        ]
-    mixedFlag (flag, msgs) =
-        let x = partitionComps (== flag) in
-        [ msgs ++ showWhich x | mixedSettings x ]
-    mixedSettings (xs, ys) = xs /= [] && ys /= []
-    showWhich (haveIt, don'tHaveIt) =
-        [ "It is specified for:"
-        , "    " <> renderPkgComponents haveIt
-        , "But not for: "
-        , "    " <> renderPkgComponents don'tHaveIt
-        ]
-    partitionComps f = (map fst xs, map fst ys)
-      where
-        (xs, ys) = L.partition (any f . snd) compsWithOpts
-    compsWithOpts = map (\(k, bio) -> (k, bioOneWordOpts bio ++ bioOpts bio)) compsWithBios
-    compsWithBios =
-        [ ((ghciPkgName pkg, c), bio)
-        | pkg <- pkgs
-        , (c, bio) <- ghciPkgOpts pkg
-        ]
-
-borderedWarning :: HasLogFunc env => RIO env a -> RIO env a
-borderedWarning f = do
-    logWarn ""
-    logWarn "* * * * * * * *"
-    x <- f
-    logWarn "* * * * * * * *"
-    logWarn ""
-    pure x
-
--- TODO: Should this also tell the user the filepaths, not just the
--- module name?
-checkForDuplicateModules :: HasTerm env => [GhciPkgInfo] -> RIO env ()
-checkForDuplicateModules pkgs = do
-    unless (null duplicates) $ do
-        borderedWarning $ do
-            prettyWarn $ "Multiple files use the same module name:" <>
-              line <> bulletedList (map prettyDuplicate duplicates)
-        -- MSS 2020-10-13 Disabling, may remove entirely in the future
-        -- See: https://github.com/commercialhaskell/stack/issues/5407#issuecomment-707339928
-        -- throwM LoadingDuplicateModules
-  where
-    duplicates :: [(ModuleName, Map (Path Abs File) (Set (PackageName, NamedComponent)))]
-    duplicates =
-      filter (\(_, mp) -> M.size mp > 1) $
-      M.toList $
-      unionModuleMaps (map ghciPkgModules pkgs)
-    prettyDuplicate :: (ModuleName, Map (Path Abs File) (Set (PackageName, NamedComponent))) -> StyleDoc
-    prettyDuplicate (mn, mp) =
-      style Error (pretty mn) <+> "found at the following paths" <> line <>
-      bulletedList (map fileDuplicate (M.toList mp))
-    fileDuplicate :: (Path Abs File, Set (PackageName, NamedComponent)) -> StyleDoc
-    fileDuplicate (fp, comps) =
-      pretty fp <+> parens (fillSep (punctuate "," (map displayPkgComponent (S.toList comps))))
-
-targetWarnings ::
-     HasBuildConfig env
-  => [(PackageName, (Path Abs File, Target))]
-  -> [PackageName]
-  -> Maybe (Map PackageName [Path Abs File], [Path Abs File])
-  -> RIO env ()
-targetWarnings localTargets nonLocalTargets mfileTargets = do
-  unless (null nonLocalTargets) $
-    prettyWarnL
-      [ flow "Some targets"
-      , parens $ fillSep $ punctuate "," $ map (style Good . fromString . packageNameString) nonLocalTargets
-      , flow "are not local packages, and so cannot be directly loaded."
-      , flow "In future versions of Stack, this might be supported - see"
-      , style Url "https://github.com/commercialhaskell/stack/issues/1441"
-      , "."
-      , flow "It can still be useful to specify these, as they will be passed to ghci via -package flags."
-      ]
-  when (null localTargets && isNothing mfileTargets) $ do
-      smWanted <- view $ buildConfigL.to bcSMWanted
-      stackYaml <- view stackYamlL
-      prettyNote $ vsep
-          [ flow "No local targets specified, so a plain ghci will be started with no package hiding or package options."
-          , ""
-          , flow $ T.unpack $ utf8BuilderToText $
-                   "You are using snapshot: " <>
-                   display (smwSnapshotLocation smWanted)
-          , ""
-          , flow "If you want to use package hiding and options, then you can try one of the following:"
-          , ""
-          , bulletedList
-              [ fillSep
-                  [ flow "If you want to start a different project configuration than" <+> pretty stackYaml <> ", then you can use"
-                  , style Shell "stack init"
-                  , flow "to create a new stack.yaml for the packages in the current directory."
-                  , line
-                  ]
-              , flow "If you want to use the project configuration at" <+> pretty stackYaml <> ", then you can add to its 'packages' field."
-              ]
-          , ""
-          ]
-
--- Adds in intermediate dependencies between ghci targets. Note that it
--- will return a Lib component for these intermediate dependencies even
--- if they don't have a library (but that's fine for the usage within
--- this module).
---
--- If 'True' is passed for loadAllDeps, this loads all local deps, even
--- if they aren't intermediate.
-getExtraLoadDeps ::
-       Bool
-    -> Map PackageName LocalPackage
-    -> [(PackageName, (Path Abs File, Target))]
-    -> [(PackageName, (Path Abs File, Target))]
-getExtraLoadDeps loadAllDeps localMap targets =
-    M.toList $
-    (\mp -> foldl' (flip M.delete) mp (map fst targets)) $
-    M.mapMaybe id $
-    execState (mapM_ (mapM_ go . getDeps . fst) targets)
-              (M.fromList (map (second Just) targets))
-  where
-    getDeps :: PackageName -> [PackageName]
-    getDeps name =
-        case M.lookup name localMap of
-            Just lp -> M.keys (packageDeps (lpPackage lp)) -- FIXME just Local?
-            _ -> []
-    go :: PackageName -> State (Map PackageName (Maybe (Path Abs File, Target))) Bool
-    go name = do
-        cache <- get
-        case (M.lookup name cache, M.lookup name localMap) of
-            (Just (Just _), _) -> pure True
-            (Just Nothing, _) | not loadAllDeps -> pure False
-            (_, Just lp) -> do
-                let deps = M.keys (packageDeps (lpPackage lp))
-                shouldLoad <- liftM or $ mapM go deps
-                if shouldLoad
-                    then do
-                        modify (M.insert name (Just (lpCabalFile lp, TargetComps (S.singleton CLib))))
-                        pure True
-                    else do
-                        modify (M.insert name Nothing)
-                        pure False
-            (_, _) -> pure False
-
-unionTargets :: Ord k => Map k Target -> Map k Target -> Map k Target
-unionTargets = M.unionWith $ \l r ->
-    case (l, r) of
-        (TargetAll PTDependency, _) -> r
-        (TargetComps sl, TargetComps sr) -> TargetComps (S.union sl sr)
-        (TargetComps _, TargetAll PTProject) -> TargetAll PTProject
-        (TargetComps _, _) -> l
-        (TargetAll PTProject, _) -> TargetAll PTProject
-
-hasLocalComp :: (NamedComponent -> Bool) -> Target -> Bool
-hasLocalComp p t =
-    case t of
-        TargetComps s -> any p (S.toList s)
-        TargetAll PTProject -> True
-        _ -> False
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
+
+-- | Types and functions related to Stack's @ghci@ and @repl@ commands.
+module Stack.Ghci
+  ( GhciOpts (..)
+  , GhciPkgInfo (..)
+  , GhciException (..)
+  , GhciPrettyException (..)
+  , ghciCmd
+  , ghci
+  ) where
+
+import           Control.Monad.State.Strict ( State, execState, get, modify )
+import           Data.ByteString.Builder ( byteString )
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.ByteString.Lazy as LBS
+import           Data.Foldable ( foldl )
+import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import qualified Distribution.PackageDescription as C
+import           Path ((</>), parent, parseRelFile )
+import           Path.Extra ( forgivingResolveFile', toFilePathNoTrailingSep )
+import           Path.IO
+                   ( XdgDirectory (..), doesFileExist, ensureDir, getXdgDir )
+import           RIO.Process
+                   ( HasProcessContext, exec, proc, readProcess_
+                   , withWorkingDir
+                   )
+import           Stack.Build ( buildLocalTargets )
+import           Stack.Build.Installed ( getInstalled, toInstallMap )
+import           Stack.Build.Source
+                   ( getLocalFlags, localDependencies, projectLocalPackages )
+import           Stack.Build.Target ( NeedTargets (..), parseTargets )
+import           Stack.Constants
+                   ( relDirGhciScript, relDirStackProgName, relFileCabalMacrosH
+                   , relFileGhciScript, stackProgName'
+                   )
+import           Stack.Constants.Config ( ghciDirL, objectInterfaceDirL )
+import           Stack.Ghci.Script
+                   ( GhciScript, ModuleName, cmdAdd, cmdCdGhc, cmdModule
+                   , scriptToLazyByteString
+                   )
+import           Stack.Package
+                   ( PackageDescriptionPair (..), packageFromPackageDescription
+                   , readDotBuildinfo, resolvePackageDescription
+                   )
+import           Stack.Prelude
+import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
+import           Stack.Types.Build.Exception
+                   ( BuildPrettyException (..), pprintTargetParseErrors )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), stackYamlL )
+import           Stack.Types.BuildOpts
+                   ( ApplyCLIFlag, BenchmarkOpts (..), BuildOpts (..)
+                   , BuildOptsCLI (..), TestOpts (..), defaultBuildOptsCLI
+                   )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), HasCompiler (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL
+                   , shaPathForBytes
+                   )
+import           Stack.Types.EnvSettings ( defaultEnvSettings )
+import           Stack.Types.NamedComponent
+                   ( NamedComponent (..), isCLib, renderPkgComponent )
+import           Stack.Types.Package
+                   ( BuildInfoOpts (..), InstallMap, InstalledMap
+                   , LocalPackage (..), Package (..), PackageConfig (..)
+                   , PackageLibraries (..), dotCabalCFilePath, dotCabalGetPath
+                   , dotCabalMainPath, getPackageOpts
+                   )
+import           Stack.Types.PackageFile ( getPackageFiles )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( HasRunner, Runner )
+import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..), GlobalPackage
+                   , PackageType (..), ProjectPackage (..), SMActual (..)
+                   , SMTargets (..), SMWanted (..), SourceMap (..), Target (..)
+                   )
+import           System.IO ( putStrLn )
+import           System.Permissions ( setScriptPerms )
+
+-- | Type representing exceptions thrown by functions exported by the
+-- "Stack.Ghci" module.
+data GhciException
+  = InvalidPackageOption String
+  | LoadingDuplicateModules
+  | MissingFileTarget String
+  | Can'tSpecifyFilesAndTargets
+  | Can'tSpecifyFilesAndMainIs
+  deriving (Show, Typeable)
+
+instance Exception GhciException where
+  displayException (InvalidPackageOption name) =
+    "Error: [S-6716]\n"
+    ++ "Failed to parse '--package' option " ++ name ++ "."
+  displayException LoadingDuplicateModules = unlines
+    [ "Error: [S-9632]"
+    , "Not attempting to start ghci due to these duplicate modules."
+    , "Use '--no-load' to try to start it anyway, without loading any \
+      \modules (but these are still likely to cause errors)."
+    ]
+  displayException (MissingFileTarget name) =
+    "Error: [S-3600]\n"
+    ++ "Cannot find file target " ++ name ++ "."
+  displayException Can'tSpecifyFilesAndTargets =
+    "Error: [S-9906]\n"
+    ++ "Cannot use 'stack ghci' with both file targets and package targets."
+  displayException Can'tSpecifyFilesAndMainIs =
+    "Error: [S-5188]\n"
+    ++ "Cannot use 'stack ghci' with both file targets and '--main-is' \
+       \flag."
+
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.Ghci" module.
+newtype GhciPrettyException
+  = GhciTargetParseException [StyleDoc]
+  deriving (Show, Typeable)
+
+instance Pretty GhciPrettyException where
+  pretty (GhciTargetParseException errs) =
+       "[S-6948]"
+    <> pprintTargetParseErrors errs
+    <> blankLine
+    <> fillSep
+         [ flow "Note that to specify options to be passed to GHCi, use the"
+         , style Shell "--ghci-options"
+         , "option."
+         ]
+
+instance Exception GhciPrettyException
+
+-- | Typre respresenting command line options for the @stack ghci@ and
+-- @stack repl@ commands.
+data GhciOpts = GhciOpts
+  { ghciTargets            :: ![Text]
+  , ghciArgs               :: ![String]
+  , ghciGhcOptions         :: ![String]
+  , ghciFlags              :: !(Map ApplyCLIFlag (Map FlagName Bool))
+  , ghciGhcCommand         :: !(Maybe FilePath)
+  , ghciNoLoadModules      :: !Bool
+  , ghciAdditionalPackages :: ![String]
+  , ghciMainIs             :: !(Maybe Text)
+  , ghciLoadLocalDeps      :: !Bool
+  , ghciSkipIntermediate   :: !Bool
+  , ghciHidePackages       :: !(Maybe Bool)
+  , ghciNoBuild            :: !Bool
+  , ghciOnlyMain           :: !Bool
+  }
+  deriving Show
+
+-- | Type representing information required to load a package or its components.
+--
+-- NOTE: GhciPkgInfo has paths as list instead of a Set to preserve files order
+-- as a workaround for bug https://ghc.haskell.org/trac/ghc/ticket/13786
+data GhciPkgInfo = GhciPkgInfo
+  { ghciPkgName :: !PackageName
+  , ghciPkgOpts :: ![(NamedComponent, BuildInfoOpts)]
+  , ghciPkgDir :: !(Path Abs Dir)
+  , ghciPkgModules :: !ModuleMap
+  , ghciPkgCFiles :: ![Path Abs File] -- ^ C files.
+  , ghciPkgMainIs :: !(Map NamedComponent [Path Abs File])
+  , ghciPkgTargetFiles :: !(Maybe [Path Abs File])
+  , ghciPkgPackage :: !Package
+  }
+  deriving Show
+
+-- | Type representing loaded package description and related information.
+data GhciPkgDesc = GhciPkgDesc
+  { ghciDescPkg :: !Package
+  , ghciDescCabalFp :: !(Path Abs File)
+  , ghciDescTarget :: !Target
+  }
+
+-- Mapping from a module name to a map with all of the paths that use
+-- that name. Each of those paths is associated with a set of components
+-- that contain it. Purpose of this complex structure is for use in
+-- 'checkForDuplicateModules'.
+type ModuleMap = Map ModuleName (Map (Path Abs File) (Set (PackageName, NamedComponent)))
+
+unionModuleMaps :: [ModuleMap] -> ModuleMap
+unionModuleMaps = M.unionsWith (M.unionWith S.union)
+
+-- | Function underlying the @stack ghci@ and @stack repl@ commands. Run GHCi in
+-- the context of a project.
+ghciCmd :: GhciOpts -> RIO Runner ()
+ghciCmd ghciOpts =
+  let boptsCLI = defaultBuildOptsCLI
+        -- using only additional packages, targets then get overridden in `ghci`
+        { boptsCLITargets = map T.pack (ghciAdditionalPackages  ghciOpts)
+        , boptsCLIInitialBuildSteps = True
+        , boptsCLIFlags = ghciFlags ghciOpts
+        , boptsCLIGhcOptions = map T.pack (ghciGhcOptions ghciOpts)
+        }
+  in  withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $ do
+        bopts <- view buildOptsL
+        -- override env so running of tests and benchmarks is disabled
+        let boptsLocal = bopts
+              { boptsTestOpts = (boptsTestOpts bopts) { toDisableRun = True }
+              , boptsBenchmarkOpts =
+                  (boptsBenchmarkOpts bopts) { beoDisableRun = True }
+              }
+        local (set buildOptsL boptsLocal) (ghci ghciOpts)
+
+-- | Launch a GHCi session for the given local package targets with the
+-- given options and configure it with the load paths and extensions
+-- of those targets.
+ghci :: HasEnvConfig env => GhciOpts -> RIO env ()
+ghci opts@GhciOpts{..} = do
+  let buildOptsCLI = defaultBuildOptsCLI
+        { boptsCLITargets = []
+        , boptsCLIFlags = ghciFlags
+        }
+  sourceMap <- view $ envConfigL.to envConfigSourceMap
+  installMap <- toInstallMap sourceMap
+  locals <- projectLocalPackages
+  depLocals <- localDependencies
+  let localMap =
+        M.fromList [(packageName $ lpPackage lp, lp) | lp <- locals ++ depLocals]
+      -- FIXME:qrilka this looks wrong to go back to SMActual
+      sma = SMActual
+        { smaCompiler = smCompiler sourceMap
+        , smaProject = smProject sourceMap
+        , smaDeps = smDeps sourceMap
+        , smaGlobal = smGlobal sourceMap
+        }
+  -- Parse --main-is argument.
+  mainIsTargets <- parseMainIsTargets buildOptsCLI sma ghciMainIs
+  -- Parse to either file targets or build targets
+  etargets <- preprocessTargets buildOptsCLI sma ghciTargets
+  (inputTargets, mfileTargets) <- case etargets of
+    Right packageTargets -> pure (packageTargets, Nothing)
+    Left rawFileTargets -> do
+      case mainIsTargets of
+        Nothing -> pure ()
+        Just _ -> throwM Can'tSpecifyFilesAndMainIs
+      -- Figure out targets based on filepath targets
+      (targetMap, fileInfo, extraFiles) <- findFileTargets locals rawFileTargets
+      pure (targetMap, Just (fileInfo, extraFiles))
+  -- Get a list of all the local target packages.
+  localTargets <- getAllLocalTargets opts inputTargets mainIsTargets localMap
+  -- Get a list of all the non-local target packages.
+  nonLocalTargets <- getAllNonLocalTargets inputTargets
+  -- Check if additional package arguments are sensible.
+  addPkgs <- checkAdditionalPackages ghciAdditionalPackages
+  -- Load package descriptions.
+  pkgDescs <- loadGhciPkgDescs buildOptsCLI localTargets
+  -- If necessary, ask user about which main module to load.
+  bopts <- view buildOptsL
+  mainFile <- if ghciNoLoadModules
+    then pure Nothing
+    else do
+      -- Figure out package files, in order to ask the user about which main
+      -- module to load. See the note below for why this is done again after the
+      -- build. This could potentially be done more efficiently, because all we
+      -- need is the location of main modules, not the rest.
+      pkgs0 <- getGhciPkgInfos installMap addPkgs (fmap fst mfileTargets) pkgDescs
+      figureOutMainFile bopts mainIsTargets localTargets pkgs0
+  let pkgTargets pn targets =
+        case targets of
+          TargetAll _  -> [T.pack (packageNameString pn)]
+          TargetComps comps -> [renderPkgComponent (pn, c) | c <- toList comps]
+  -- Build required dependencies and setup local packages.
+  buildDepsAndInitialSteps opts $
+    concatMap (\(pn, (_, t)) -> pkgTargets pn t) localTargets
+  targetWarnings localTargets nonLocalTargets mfileTargets
+  -- Load the list of modules _after_ building, to catch changes in
+  -- unlisted dependencies (#1180)
+  pkgs <- getGhciPkgInfos installMap addPkgs (fmap fst mfileTargets) pkgDescs
+  checkForIssues pkgs
+  -- Finally, do the invocation of ghci
+  runGhci
+    opts
+    localTargets
+    mainFile
+    pkgs
+    (maybe [] snd mfileTargets)
+    (nonLocalTargets ++ addPkgs)
+
+preprocessTargets ::
+     HasEnvConfig env
+  => BuildOptsCLI
+  -> SMActual GlobalPackage
+  -> [Text]
+  -> RIO env (Either [Path Abs File] (Map PackageName Target))
+preprocessTargets buildOptsCLI sma rawTargets = do
+  let (fileTargetsRaw, normalTargetsRaw) =
+        L.partition
+          (\t -> ".hs" `T.isSuffixOf` t || ".lhs" `T.isSuffixOf` t)
+          rawTargets
+  -- Only use file targets if we have no normal targets.
+  if not (null fileTargetsRaw) && null normalTargetsRaw
+    then do
+      fileTargets <- forM fileTargetsRaw $ \fp0 -> do
+        let fp = T.unpack fp0
+        mpath <- forgivingResolveFile' fp
+        case mpath of
+          Nothing -> throwM (MissingFileTarget fp)
+          Just path -> pure path
+      pure (Left fileTargets)
+    else do
+      -- Try parsing targets before checking if both file and
+      -- module targets are specified (see issue#3342).
+      let boptsCLI = buildOptsCLI { boptsCLITargets = normalTargetsRaw }
+      normalTargets <- parseTargets AllowNoTargets False boptsCLI sma
+        `catch` \pex@(PrettyException ex) ->
+          case fromException $ toException ex of
+            Just (TargetParseException xs) ->
+              prettyThrowM $ GhciTargetParseException xs
+            _ -> throwM pex
+      unless (null fileTargetsRaw) $ throwM Can'tSpecifyFilesAndTargets
+      pure (Right $ smtTargets normalTargets)
+
+parseMainIsTargets ::
+     HasEnvConfig env
+  => BuildOptsCLI
+  -> SMActual GlobalPackage
+  -> Maybe Text
+  -> RIO env (Maybe (Map PackageName Target))
+parseMainIsTargets buildOptsCLI sma mtarget = forM mtarget $ \target -> do
+  let boptsCLI = buildOptsCLI { boptsCLITargets = [target] }
+  targets <- parseTargets AllowNoTargets False boptsCLI sma
+  pure $ smtTargets targets
+
+-- | Display PackageName + NamedComponent
+displayPkgComponent :: (PackageName, NamedComponent) -> StyleDoc
+displayPkgComponent =
+  style PkgComponent . fromString . T.unpack . renderPkgComponent
+
+findFileTargets ::
+     HasEnvConfig env
+  => [LocalPackage]
+  -> [Path Abs File]
+  -> RIO env (Map PackageName Target, Map PackageName [Path Abs File], [Path Abs File])
+findFileTargets locals fileTargets = do
+  filePackages <- forM locals $ \lp -> do
+    (_,compFiles,_,_) <- getPackageFiles (packageFiles (lpPackage lp)) (lpCabalFile lp)
+    pure (lp, M.map (map dotCabalGetPath) compFiles)
+  let foundFileTargetComponents :: [(Path Abs File, [(PackageName, NamedComponent)])]
+      foundFileTargetComponents =
+        map (\fp -> (fp, ) $ L.sort $
+                    concatMap (\(lp, files) -> map ((packageName (lpPackage lp), ) . fst)
+                                                   (filter (elem fp . snd) (M.toList files))
+                              ) filePackages
+            ) fileTargets
+  results <- forM foundFileTargetComponents $ \(fp, xs) ->
+    case xs of
+      [] -> do
+        prettyWarnL
+          [ flow "Couldn't find a component for file target"
+          , pretty fp <> "."
+          , flow "This means that the correct GHC options might not be used. \
+                 \Attempting to load the file anyway."
+          ]
+        pure $ Left fp
+      [x] -> do
+        prettyInfoL
+          [ flow "Using configuration for"
+          , displayPkgComponent x
+          , flow "to load"
+          , pretty fp
+          ]
+        pure $ Right (fp, x)
+      (x:_) -> do
+        prettyWarn $
+             fillSep
+               [ flow "Multiple components contain file target"
+               , pretty fp <> ":"
+               , fillSep $ punctuate "," (map displayPkgComponent xs)
+               ]
+          <> line
+          <> fillSep
+               [ flow "Guessing the first one,"
+               , displayPkgComponent x <> "."
+               ]
+        pure $ Right (fp, x)
+  let (extraFiles, associatedFiles) = partitionEithers results
+      targetMap =
+          foldl unionTargets M.empty $
+          map (\(_, (name, comp)) -> M.singleton name (TargetComps (S.singleton comp)))
+              associatedFiles
+      infoMap =
+          foldl (M.unionWith (<>)) M.empty $
+          map (\(fp, (name, _)) -> M.singleton name [fp])
+              associatedFiles
+  pure (targetMap, infoMap, extraFiles)
+
+getAllLocalTargets ::
+     HasEnvConfig env
+  => GhciOpts
+  -> Map PackageName Target
+  -> Maybe (Map PackageName Target)
+  -> Map PackageName LocalPackage
+  -> RIO env [(PackageName, (Path Abs File, Target))]
+getAllLocalTargets GhciOpts{..} targets0 mainIsTargets localMap = do
+  -- Use the 'mainIsTargets' as normal targets, for CLI concision. See
+  -- #1845. This is a little subtle - we need to do the target parsing
+  -- independently in order to handle the case where no targets are
+  -- specified.
+  let targets = maybe targets0 (unionTargets targets0) mainIsTargets
+  packages <- view $ envConfigL.to envConfigSourceMap.to smProject
+  -- Find all of the packages that are directly demanded by the
+  -- targets.
+  let directlyWanted = flip mapMaybe (M.toList packages) $
+        \(name, pp) ->
+              case M.lookup name targets of
+                Just simpleTargets -> Just (name, (ppCabalFP pp, simpleTargets))
+                Nothing -> Nothing
+  -- Figure out
+  let extraLoadDeps = getExtraLoadDeps ghciLoadLocalDeps localMap directlyWanted
+  if (ghciSkipIntermediate && not ghciLoadLocalDeps) || null extraLoadDeps
+    then pure directlyWanted
+    else do
+      let extraList' =
+            map (fromString . packageNameString . fst) extraLoadDeps :: [StyleDoc]
+          extraList = mkNarrativeList (Just Current) False extraList'
+      if ghciLoadLocalDeps
+        then prettyInfo $
+          fillSep $
+                [ flow "The following libraries will also be loaded into \
+                       \GHCi because they are local dependencies of your \
+                       \targets, and you specified"
+                , style Shell "--load-local-deps" <> ":"
+                ]
+            <> extraList
+        else prettyInfo $
+             fillSep
+               ( flow "The following libraries will also be loaded into \
+                      \GHCi because they are intermediate dependencies of \
+                      \your targets:"
+               : extraList
+               )
+          <> line
+          <> fillSep
+               [ "(Use"
+               , style Shell "--skip-intermediate-deps"
+               , flow "to omit these.)"
+               ]
+      pure (directlyWanted ++ extraLoadDeps)
+
+getAllNonLocalTargets ::
+     Map PackageName Target
+  -> RIO env [PackageName]
+getAllNonLocalTargets targets = do
+  let isNonLocal (TargetAll PTDependency) = True
+      isNonLocal _ = False
+  pure $ map fst $ filter (isNonLocal . snd) (M.toList targets)
+
+buildDepsAndInitialSteps :: HasEnvConfig env => GhciOpts -> [Text] -> RIO env ()
+buildDepsAndInitialSteps GhciOpts{..} localTargets = do
+  let targets = localTargets ++ map T.pack ghciAdditionalPackages
+  -- If necessary, do the build, for local packagee targets, only do
+  -- 'initialBuildSteps'.
+  case NE.nonEmpty targets of
+    -- only new local targets could appear here
+    Just nonEmptyTargets | not ghciNoBuild -> do
+      eres <- buildLocalTargets nonEmptyTargets
+      case eres of
+        Right () -> pure ()
+        Left err -> do
+          case fromException err of
+            Just (PrettyException prettyErr) -> prettyError $ pretty prettyErr
+            Nothing -> prettyError $ fromString (displayException err)
+          prettyWarn "Build failed, but trying to launch GHCi anyway"
+    _ ->
+      pure ()
+
+checkAdditionalPackages :: MonadThrow m => [String] -> m [PackageName]
+checkAdditionalPackages pkgs = forM pkgs $ \name -> do
+  let mres = (pkgName <$> parsePackageIdentifier name)
+        <|> parsePackageNameThrowing name
+  maybe (throwM $ InvalidPackageOption name) pure mres
+
+runGhci ::
+     HasEnvConfig env
+  => GhciOpts
+  -> [(PackageName, (Path Abs File, Target))]
+  -> Maybe (Path Abs File)
+  -> [GhciPkgInfo]
+  -> [Path Abs File]
+  -> [PackageName]
+  -> RIO env ()
+runGhci GhciOpts{..} targets mainFile pkgs extraFiles exposePackages = do
+    config <- view configL
+    let pkgopts = hidePkgOpts ++ genOpts ++ ghcOpts
+        shouldHidePackages =
+          fromMaybe (not (null pkgs && null exposePackages)) ghciHidePackages
+        hidePkgOpts =
+          if shouldHidePackages
+            then
+              ["-hide-all-packages"] ++
+              -- This is necessary, because current versions of ghci
+              -- will entirely fail to start if base isn't visible. This
+              -- is because it tries to use the interpreter to set
+              -- buffering options on standard IO.
+              (if null targets then ["-package", "base"] else []) ++
+              concatMap (\n -> ["-package", packageNameString n]) exposePackages
+            else []
+        oneWordOpts bio
+            | shouldHidePackages = bioOneWordOpts bio ++ bioPackageFlags bio
+            | otherwise = bioOneWordOpts bio
+        genOpts = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs)
+        (omittedOpts, ghcOpts) = L.partition badForGhci $
+            concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++ map T.unpack
+              ( fold (configGhcOptionsByCat config) -- include everything, locals, and targets
+             ++ concatMap (getUserOptions . ghciPkgName) pkgs
+              )
+        getUserOptions pkg = M.findWithDefault [] pkg (configGhcOptionsByName config)
+        badForGhci x =
+            L.isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky -static -Werror")
+    unless (null omittedOpts) $
+      prettyWarn $
+           fillSep
+             ( flow "The following GHC options are incompatible with GHCi and \
+                    \have not been passed to it:"
+             : mkNarrativeList (Just Current) False
+                 (map fromString (nubOrd omittedOpts) :: [StyleDoc])
+             )
+        <> line
+    oiDir <- view objectInterfaceDirL
+    let odir =
+            [ "-odir=" <> toFilePathNoTrailingSep oiDir
+            , "-hidir=" <> toFilePathNoTrailingSep oiDir ]
+    prettyInfoL
+      ( flow "Configuring GHCi with the following packages:"
+      : mkNarrativeList (Just Current) False
+          (map (fromString . packageNameString . ghciPkgName) pkgs :: [StyleDoc])
+      )
+    compilerExeName <- view $ compilerPathsL.to cpCompiler.to toFilePath
+    let execGhci extras = do
+            menv <- liftIO $ configProcessContextSettings config defaultEnvSettings
+            withPackageWorkingDir $ withProcessContext menv $ exec
+                 (fromMaybe compilerExeName ghciGhcCommand)
+                 (("--interactive" : ) $
+                 -- This initial "-i" resets the include directories to
+                 -- not include CWD. If there aren't any packages, CWD
+                 -- is included.
+                  (if null pkgs then id else ("-i" : )) $
+                  odir <> pkgopts <> extras <> ghciGhcOptions <> ghciArgs)
+        withPackageWorkingDir =
+            case pkgs of
+              [pkg] -> withWorkingDir (toFilePath $ ghciPkgDir pkg)
+              _ -> id
+        -- TODO: Consider optimizing this check. Perhaps if no
+        -- "with-ghc" is specified, assume that it is not using intero.
+        checkIsIntero =
+            -- Optimization dependent on the behavior of renderScript -
+            -- it doesn't matter if it's intero or ghci when loading
+            -- multiple packages.
+            case pkgs of
+                [_] -> do
+                    menv <- liftIO $ configProcessContextSettings config defaultEnvSettings
+                    output <- withProcessContext menv
+                            $ runGrabFirstLine (fromMaybe compilerExeName ghciGhcCommand) ["--version"]
+                    pure $ "Intero" `L.isPrefixOf` output
+                _ -> pure False
+    -- Since usage of 'exec' does not pure, we cannot do any cleanup
+    -- on ghci exit. So, instead leave the generated files. To make this
+    -- more efficient and avoid gratuitous generation of garbage, the
+    -- file names are determined by hashing. This also has the nice side
+    -- effect of making it possible to copy the ghci invocation out of
+    -- the log and have it still work.
+    tmpDirectory <- getXdgDir XdgCache $
+      Just (relDirStackProgName </> relDirGhciScript)
+    ghciDir <- view ghciDirL
+    ensureDir ghciDir
+    ensureDir tmpDirectory
+    macrosOptions <- writeMacrosFile ghciDir pkgs
+    if ghciNoLoadModules
+        then execGhci macrosOptions
+        else do
+            checkForDuplicateModules pkgs
+            isIntero <- checkIsIntero
+            scriptOptions <- writeGhciScript tmpDirectory (renderScript isIntero pkgs mainFile ghciOnlyMain extraFiles)
+            execGhci (macrosOptions ++ scriptOptions)
+
+writeMacrosFile ::
+     HasTerm env
+  => Path Abs Dir
+  -> [GhciPkgInfo]
+  -> RIO env [String]
+writeMacrosFile outputDirectory pkgs = do
+  fps <- fmap (nubOrd . catMaybes . concat) $
+    forM pkgs $ \pkg -> forM (ghciPkgOpts pkg) $ \(_, bio) -> do
+      let cabalMacros = bioCabalMacros bio
+      exists <- liftIO $ doesFileExist cabalMacros
+      if exists
+        then pure $ Just cabalMacros
+        else do
+          prettyWarnL ["Didn't find expected autogen file:", pretty cabalMacros]
+          pure Nothing
+  files <- liftIO $ mapM (S8.readFile . toFilePath) fps
+  if null files then pure [] else do
+    out <- liftIO $ writeHashedFile outputDirectory relFileCabalMacrosH $
+      S8.concat $ map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files
+    pure ["-optP-include", "-optP" <> toFilePath out]
+
+writeGhciScript :: (MonadIO m) => Path Abs Dir -> GhciScript -> m [String]
+writeGhciScript outputDirectory script = do
+  scriptPath <- liftIO $ writeHashedFile outputDirectory relFileGhciScript $
+    LBS.toStrict $ scriptToLazyByteString script
+  let scriptFilePath = toFilePath scriptPath
+  setScriptPerms scriptFilePath
+  pure ["-ghci-script=" <> scriptFilePath]
+
+writeHashedFile ::
+     Path Abs Dir
+  -> Path Rel File
+  -> ByteString
+  -> IO (Path Abs File)
+writeHashedFile outputDirectory relFile contents = do
+  relSha <- shaPathForBytes contents
+  let outDir = outputDirectory </> relSha
+      outFile = outDir </> relFile
+  alreadyExists <- doesFileExist outFile
+  unless alreadyExists $ do
+    ensureDir outDir
+    writeBinaryFileAtomic outFile $ byteString contents
+  pure outFile
+
+renderScript ::
+     Bool
+  -> [GhciPkgInfo]
+  -> Maybe (Path Abs File)
+  -> Bool
+  -> [Path Abs File]
+  -> GhciScript
+renderScript isIntero pkgs mainFile onlyMain extraFiles = do
+  let cdPhase = case (isIntero, pkgs) of
+        -- If only loading one package, set the cwd properly.
+        -- Otherwise don't try. See
+        -- https://github.com/commercialhaskell/stack/issues/3309
+        (True, [pkg]) -> cmdCdGhc (ghciPkgDir pkg)
+        _ -> mempty
+      addPhase = cmdAdd $ S.fromList (map Left allModules ++ addMain)
+      addMain = case mainFile of
+          Just path -> [Right path]
+          _ -> []
+      modulePhase = cmdModule $ S.fromList allModules
+      allModules = nubOrd $ concatMap (M.keys . ghciPkgModules) pkgs
+  case getFileTargets pkgs <> extraFiles of
+    [] ->
+      if onlyMain
+        then cdPhase <> if isJust mainFile then cmdAdd (S.fromList addMain) else mempty
+        else cdPhase <> addPhase <> modulePhase
+    fileTargets -> cmdAdd (S.fromList (map Right fileTargets))
+
+-- Hacky check if module / main phase should be omitted. This should be
+-- improved if / when we have a better per-component load.
+getFileTargets :: [GhciPkgInfo] -> [Path Abs File]
+getFileTargets = concatMap (concat . maybeToList . ghciPkgTargetFiles)
+
+-- | Figure out the main-is file to load based on the targets. Asks the
+-- user for input if there is more than one candidate main-is file.
+figureOutMainFile ::
+     (HasRunner env, HasTerm env)
+  => BuildOpts
+  -> Maybe (Map PackageName Target)
+  -> [(PackageName, (Path Abs File, Target))]
+  -> [GhciPkgInfo]
+  -> RIO env (Maybe (Path Abs File))
+figureOutMainFile bopts mainIsTargets targets0 packages =
+    case candidates of
+      [] -> pure Nothing
+      [c@(_,_,fp)] -> do
+        prettyInfo $
+             fillSep
+               [ "Using"
+               , style Current "main"
+               , "module:"
+               ]
+          <> line
+          <> renderCandidate c
+          <> line
+        pure (Just fp)
+      candidate:_ -> do
+        prettyWarn $
+             fillSep
+               [ "The"
+               , style Current "main"
+               , flow "module to load is ambiguous. Candidates are:"
+               ]
+          <> line
+          <> mconcat (L.intersperse line (map renderCandidate candidates))
+          <> blankLine
+          <> flow "You can specify which one to pick by:"
+          <> line
+          <> bulletedList
+               [ fillSep
+                   [ flow "Specifying targets to"
+                   , style Shell (flow "stack ghci")
+                   , "e.g."
+                   , style Shell ( fillSep
+                                     [ flow "stack ghci"
+                                     , sampleTargetArg candidate
+                                     ]
+                                 ) <> "."
+                   ]
+               , fillSep
+                   [ flow "Specifying what the"
+                   , style Current "main"
+                   , flow "is e.g."
+                   , style Shell ( fillSep
+                                     [ flow "stack ghci"
+                                     , sampleMainIsArg candidate
+                                     ]
+                                 ) <> "."
+                   ]
+                , flow
+                    $  "Choosing from the candidate above [1.."
+                    <> show (length candidates)
+                    <> "]."
+               ]
+          <> line
+        liftIO userOption
+ where
+  targets = fromMaybe (M.fromList $ map (\(k, (_, x)) -> (k, x)) targets0)
+                      mainIsTargets
+  candidates = do
+    pkg <- packages
+    case M.lookup (ghciPkgName pkg) targets of
+      Nothing -> []
+      Just target -> do
+        (component,mains) <-
+            M.toList $
+            M.filterWithKey (\k _ -> k `S.member` wantedComponents)
+                            (ghciPkgMainIs pkg)
+        main <- mains
+        pure (ghciPkgName pkg, component, main)
+       where
+        wantedComponents =
+          wantedPackageComponents bopts target (ghciPkgPackage pkg)
+  renderCandidate c@(pkgName, namedComponent, mainIs) =
+    let candidateIndex =
+          fromString . show . (+1) . fromMaybe 0 . L.elemIndex c
+        pkgNameText = fromString $ packageNameString pkgName
+    in  hang 4
+          $  fill 4 ( candidateIndex candidates <> ".")
+          <> fillSep
+               [ "Package"
+               , style Current pkgNameText <> ","
+               , "component"
+        --       This is the format that can be directly copy-pasted as
+        --       an argument to `stack ghci`.
+               , style
+                   PkgComponent
+                   (  pkgNameText
+                   <> ":"
+                   <> renderComp namedComponent
+                   )
+                 <> ","
+               , "with"
+               , style Shell "main-is"
+               , "file:"
+               , pretty mainIs <> "."
+               ]
+  candidateIndices = take (length candidates) [1 :: Int ..]
+  userOption = do
+    option <- prompt "Specify main module to use (press enter to load none): "
+    let selected = fromMaybe
+                    ((+1) $ length candidateIndices)
+                    (readMaybe (T.unpack option) :: Maybe Int)
+    case L.elemIndex selected candidateIndices  of
+      Nothing -> do
+        putStrLn
+          "Not loading any main modules, as no valid module selected"
+        putStrLn ""
+        pure Nothing
+      Just op -> do
+        let (_,_,fp) = candidates L.!! op
+        putStrLn
+          ("Loading main module from candidate " <>
+          show (op + 1) <> ", --main-is " <>
+          toFilePath fp)
+        putStrLn ""
+        pure $ Just fp
+  renderComp c =
+    case c of
+      CLib -> "lib"
+      CInternalLib name -> "internal-lib:" <> fromString (T.unpack name)
+      CExe name -> "exe:" <> fromString (T.unpack name)
+      CTest name -> "test:" <> fromString ( T.unpack name)
+      CBench name -> "bench:" <> fromString (T.unpack name)
+  sampleTargetArg (pkg, comp, _) =
+       fromString (packageNameString pkg)
+    <> ":"
+    <> renderComp comp
+  sampleMainIsArg (pkg, comp, _) =
+    fillSep
+      [ "--main-is"
+      , fromString (packageNameString pkg) <> ":" <> renderComp comp
+      ]
+
+loadGhciPkgDescs ::
+     HasEnvConfig env
+  => BuildOptsCLI
+  -> [(PackageName, (Path Abs File, Target))]
+  -> RIO env [GhciPkgDesc]
+loadGhciPkgDescs buildOptsCLI localTargets =
+  forM localTargets $ \(name, (cabalfp, target)) ->
+    loadGhciPkgDesc buildOptsCLI name cabalfp target
+
+-- | Load package description information for a ghci target.
+loadGhciPkgDesc ::
+     HasEnvConfig env
+  => BuildOptsCLI
+  -> PackageName
+  -> Path Abs File
+  -> Target
+  -> RIO env GhciPkgDesc
+loadGhciPkgDesc buildOptsCLI name cabalfp target = do
+  econfig <- view envConfigL
+  compilerVersion <- view actualCompilerVersionL
+  let SourceMap{..} = envConfigSourceMap econfig
+      -- Currently this source map is being build with
+      -- the default targets
+      sourceMapGhcOptions = fromMaybe [] $
+        (cpGhcOptions . ppCommon <$> M.lookup name smProject)
+        <|>
+        (cpGhcOptions . dpCommon <$> M.lookup name smDeps)
+      sourceMapCabalConfigOpts = fromMaybe [] $
+        (cpCabalConfigOpts . ppCommon <$> M.lookup name smProject)
+        <|>
+        (cpCabalConfigOpts . dpCommon <$> M.lookup name smDeps)
+      sourceMapFlags =
+        maybe mempty (cpFlags . ppCommon) $ M.lookup name smProject
+      config = PackageConfig
+        { packageConfigEnableTests = True
+        , packageConfigEnableBenchmarks = True
+        , packageConfigFlags =
+            getLocalFlags buildOptsCLI name `M.union` sourceMapFlags
+        , packageConfigGhcOptions = sourceMapGhcOptions
+        , packageConfigCabalConfigOpts = sourceMapCabalConfigOpts
+        , packageConfigCompilerVersion = compilerVersion
+        , packageConfigPlatform = view platformL econfig
+        }
+  -- TODO we've already parsed this information, otherwise we
+  -- wouldn't have figured out the cabalfp already. In the future:
+  -- retain that GenericPackageDescription in the relevant data
+  -- structures to avoid reparsing.
+  (gpdio, _name, _cabalfp) <-
+      loadCabalFilePath (Just stackProgName') (parent cabalfp)
+  gpkgdesc <- liftIO $ gpdio YesPrintWarnings
+
+  -- Source the package's *.buildinfo file created by configure if any. See
+  -- https://www.haskell.org/cabal/users-guide/developing-packages.html#system-dependent-parameters
+  buildinfofp <- parseRelFile (packageNameString name ++ ".buildinfo")
+  hasDotBuildinfo <- doesFileExist (parent cabalfp </> buildinfofp)
+  let mbuildinfofp
+        | hasDotBuildinfo = Just (parent cabalfp </> buildinfofp)
+        | otherwise = Nothing
+  mbuildinfo <- forM mbuildinfofp readDotBuildinfo
+  let pdp = resolvePackageDescription config gpkgdesc
+      pkg =
+        packageFromPackageDescription config (C.genPackageFlags gpkgdesc) $
+        maybe
+          pdp
+          (\bi ->
+           let PackageDescriptionPair x y = pdp
+           in  PackageDescriptionPair
+                 (C.updatePackageDescription bi x)
+                 (C.updatePackageDescription bi y))
+          mbuildinfo
+  pure GhciPkgDesc
+    { ghciDescPkg = pkg
+    , ghciDescCabalFp = cabalfp
+    , ghciDescTarget = target
+    }
+
+getGhciPkgInfos ::
+     HasEnvConfig env
+  => InstallMap
+  -> [PackageName]
+  -> Maybe (Map PackageName [Path Abs File])
+  -> [GhciPkgDesc]
+  -> RIO env [GhciPkgInfo]
+getGhciPkgInfos installMap addPkgs mfileTargets localTargets = do
+  (installedMap, _, _, _) <- getInstalled installMap
+  let localLibs =
+        [ packageName (ghciDescPkg desc)
+        | desc <- localTargets
+        , hasLocalComp isCLib (ghciDescTarget desc)
+        ]
+  forM localTargets $ \pkgDesc ->
+    makeGhciPkgInfo installMap installedMap localLibs addPkgs mfileTargets pkgDesc
+
+-- | Make information necessary to load the given package in GHCi.
+makeGhciPkgInfo ::
+     HasEnvConfig env
+  => InstallMap
+  -> InstalledMap
+  -> [PackageName]
+  -> [PackageName]
+  -> Maybe (Map PackageName [Path Abs File])
+  -> GhciPkgDesc
+  -> RIO env GhciPkgInfo
+makeGhciPkgInfo installMap installedMap locals addPkgs mfileTargets pkgDesc = do
+  bopts <- view buildOptsL
+  let pkg = ghciDescPkg pkgDesc
+      cabalfp = ghciDescCabalFp pkgDesc
+      target = ghciDescTarget pkgDesc
+      name = packageName pkg
+  (mods,files,opts) <- getPackageOpts (packageOpts pkg) installMap installedMap locals addPkgs cabalfp
+  let filteredOpts = filterWanted opts
+      filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted)
+      allWanted = wantedPackageComponents bopts target pkg
+  pure GhciPkgInfo
+    { ghciPkgName = name
+    , ghciPkgOpts = M.toList filteredOpts
+    , ghciPkgDir = parent cabalfp
+    , ghciPkgModules = unionModuleMaps $
+      map (\(comp, mp) -> M.map (\fp -> M.singleton fp (S.singleton (packageName pkg, comp))) mp)
+          (M.toList (filterWanted mods))
+    , ghciPkgMainIs = M.map (mapMaybe dotCabalMainPath) files
+    , ghciPkgCFiles = mconcat (M.elems (filterWanted (M.map (mapMaybe dotCabalCFilePath) files)))
+    , ghciPkgTargetFiles = mfileTargets >>= M.lookup name
+    , ghciPkgPackage = pkg
+    }
+
+-- NOTE: this should make the same choices as the components code in
+-- 'loadLocalPackage'. Unfortunately for now we reiterate this logic
+-- (differently).
+wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent
+wantedPackageComponents _ (TargetComps cs) _ = cs
+wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $
+  (case packageLibraries pkg of
+    NoLibraries -> []
+    HasLibraries names -> CLib : map CInternalLib (S.toList names)) ++
+  map CExe (S.toList (packageExes pkg)) <>
+  map CInternalLib (S.toList $ packageInternalLibraries pkg) <>
+  (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <>
+  (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else [])
+wantedPackageComponents _ _ _ = S.empty
+
+checkForIssues :: HasTerm env => [GhciPkgInfo] -> RIO env ()
+checkForIssues pkgs =
+  when (length pkgs > 1) $ do
+    -- Cabal flag issues could arise only when there are at least 2 packages
+    unless (null cabalFlagIssues) $ do
+      prettyWarn $
+           flow "There are Cabal flags for this project which may prevent \
+                \GHCi from loading your code properly. In some cases it \
+                \can also load some projects which would otherwise fail to \
+                \build."
+        <> blankLine
+        <> mconcat (L.intersperse blankLine cabalFlagIssues)
+        <> blankLine
+        <> flow "To resolve, remove the flag(s) from the Cabal file(s) and \
+                \instead put them at the top of the Haskell files."
+        <> blankLine
+    prettyWarnL
+      [ flow "It isn't yet possible to load multiple packages into GHCi in \
+             \all cases. For further information, see"
+      , style Url "https://ghc.haskell.org/trac/ghc/ticket/10827" <> "."
+      ]
+ where
+  cabalFlagIssues = concatMap mixedFlag
+    [ ( "-XNoImplicitPrelude"
+      , [ flow "-XNoImplicitPrelude will be used, but GHCi will likely fail to \
+               \build things which depend on the implicit prelude."
+        ]
+      )
+    , ( "-XCPP"
+      , [ flow "-XCPP will be used, but it can cause issues with multiline \
+               \strings. For further information, see"
+        , style Url "https://downloads.haskell.org/~ghc/7.10.2/docs/html/users_guide/options-phases.html#cpp-string-gaps" <> "."
+        ]
+      )
+    , ( "-XNoTraditionalRecordSyntax"
+      , [ flow "-XNoTraditionalRecordSyntax will be used, but it break modules \
+               \which use record syntax."
+        ]
+      )
+    , ( "-XTemplateHaskell"
+      , [ flow "-XTemplateHaskell will be used, but it may cause compilation \
+               \issues due to different parsing of '$' when there's no space \
+               \after it."
+        ]
+      )
+    , ( "-XQuasiQuotes"
+      , [ flow "-XQuasiQuotes will be used, but it may cause parse failures \
+               \due to a different meaning for list comprehension syntax like \
+               \[x| ... ]"
+          ]
+      )
+    , ( "-XSafe"
+      , [ flow "-XSafe will be used, but it will fail to compile unsafe \
+               \modules."
+        ]
+      )
+    , ( "-XArrows"
+      , [ flow "-XArrows will be used, but it will cause non-arrow usages of \
+               \proc, (-<), (-<<) to fail"
+        ]
+      )
+    , ( "-XOverloadedStrings"
+      , [ flow "-XOverloadedStrings will be used, but it can cause type \
+               \ambiguity in code not usually compiled with it."
+        ]
+      )
+    , ( "-XOverloadedLists"
+      , [ flow "-XOverloadedLists will be used, but it can cause type \
+               \ambiguity in code not usually compiled with it."
+        ]
+      )
+    , ( "-XMonoLocalBinds"
+      , [ flow "-XMonoLocalBinds will be used, but it can cause type errors in \
+               \code which expects generalized local bindings." ]
+      )
+    , ( "-XTypeFamilies"
+      , [ flow "-XTypeFamilies will be used, but it implies -XMonoLocalBinds, \
+               \and so can cause type errors in code which expects generalized \
+               \local bindings." ]
+      )
+    , ( "-XGADTs"
+      , [ flow "-XGADTs will be used, but it implies -XMonoLocalBinds, and so \
+               \can cause type errors in code which expects generalized local \
+               \bindings." ]
+      )
+    , ( "-XNewQualifiedOperators"
+      , [ flow "-XNewQualifiedOperators will be used, but this will break \
+               \usages of the old qualified operator syntax." ]
+      )
+    ]
+  mixedFlag (flag, msgs) =
+    let x = partitionComps (== flag) in
+    [ fillSep $ msgs ++ showWhich x | mixedSettings x ]
+  mixedSettings (xs, ys) = xs /= [] && ys /= []
+  showWhich (haveIt, don'tHaveIt) =
+       [ flow "It is specified for:" ]
+    <> mkNarrativeList (Just PkgComponent) False
+         (map (fromString . T.unpack . renderPkgComponent) haveIt :: [StyleDoc])
+    <> [ flow "But not for:" ]
+    <> mkNarrativeList (Just PkgComponent) False
+         (map (fromString . T.unpack . renderPkgComponent) don'tHaveIt :: [StyleDoc])
+  partitionComps f = (map fst xs, map fst ys)
+   where
+    (xs, ys) = L.partition (any f . snd) compsWithOpts
+  compsWithOpts = map (\(k, bio) ->
+    (k, bioOneWordOpts bio ++ bioOpts bio)) compsWithBios
+  compsWithBios =
+    [ ((ghciPkgName pkg, c), bio)
+    | pkg <- pkgs
+    , (c, bio) <- ghciPkgOpts pkg
+    ]
+
+-- TODO: Should this also tell the user the filepaths, not just the
+-- module name?
+checkForDuplicateModules :: HasTerm env => [GhciPkgInfo] -> RIO env ()
+checkForDuplicateModules pkgs =
+  unless (null duplicates) $
+    prettyWarn $
+         flow "Multiple files use the same module name:"
+      <> line
+      <> bulletedList (map prettyDuplicate duplicates)
+      <> line
+    -- MSS 2020-10-13 Disabling, may remove entirely in the future
+    -- See: https://github.com/commercialhaskell/stack/issues/5407#issuecomment-707339928
+    -- throwM LoadingDuplicateModules
+ where
+  duplicates ::
+    [(ModuleName, Map (Path Abs File) (Set (PackageName, NamedComponent)))]
+  duplicates =
+    filter (\(_, mp) -> M.size mp > 1) $
+    M.toList $
+    unionModuleMaps (map ghciPkgModules pkgs)
+  prettyDuplicate ::
+       (ModuleName, Map (Path Abs File) (Set (PackageName, NamedComponent)))
+    -> StyleDoc
+  prettyDuplicate (mn, mp) =
+       fillSep
+         [ style Error (pretty mn)
+         , flow "found at the following paths"
+         ]
+    <> line
+    <> bulletedList (map fileDuplicate (M.toList mp))
+  fileDuplicate ::
+    (Path Abs File, Set (PackageName, NamedComponent)) -> StyleDoc
+  fileDuplicate (fp, comps) =
+    fillSep
+      [ pretty fp
+      , parens $
+          fillSep $ punctuate "," (map displayPkgComponent (S.toList comps))
+      ]
+
+targetWarnings ::
+     HasBuildConfig env
+  => [(PackageName, (Path Abs File, Target))]
+  -> [PackageName]
+  -> Maybe (Map PackageName [Path Abs File], [Path Abs File])
+  -> RIO env ()
+targetWarnings localTargets nonLocalTargets mfileTargets = do
+  unless (null nonLocalTargets) $
+    prettyWarnL
+      [ flow "Some targets"
+      , parens $ fillSep $ punctuate "," $ map (style Good . fromString . packageNameString) nonLocalTargets
+      , flow "are not local packages, and so cannot be directly loaded."
+      , flow "In future versions of Stack, this might be supported - see"
+      , style Url "https://github.com/commercialhaskell/stack/issues/1441"
+      , "."
+      , flow "It can still be useful to specify these, as they will be passed to ghci via -package flags."
+      ]
+  when (null localTargets && isNothing mfileTargets) $ do
+      smWanted <- view $ buildConfigL.to bcSMWanted
+      stackYaml <- view stackYamlL
+      prettyNote $ vsep
+          [ flow "No local targets specified, so a plain ghci will be started with no package hiding or package options."
+          , ""
+          , flow $ T.unpack $ utf8BuilderToText $
+                   "You are using snapshot: " <>
+                   display (smwSnapshotLocation smWanted)
+          , ""
+          , flow "If you want to use package hiding and options, then you can try one of the following:"
+          , ""
+          , bulletedList
+              [ fillSep
+                  [ flow "If you want to start a different project configuration than" <+> pretty stackYaml <> ", then you can use"
+                  , style Shell "stack init"
+                  , flow "to create a new stack.yaml for the packages in the current directory."
+                  , line
+                  ]
+              , flow "If you want to use the project configuration at" <+> pretty stackYaml <> ", then you can add to its 'packages' field."
+              ]
+          , ""
+          ]
+
+-- Adds in intermediate dependencies between ghci targets. Note that it
+-- will return a Lib component for these intermediate dependencies even
+-- if they don't have a library (but that's fine for the usage within
+-- this module).
+--
+-- If 'True' is passed for loadAllDeps, this loads all local deps, even
+-- if they aren't intermediate.
+getExtraLoadDeps ::
+     Bool
+  -> Map PackageName LocalPackage
+  -> [(PackageName, (Path Abs File, Target))]
+  -> [(PackageName, (Path Abs File, Target))]
+getExtraLoadDeps loadAllDeps localMap targets =
+    M.toList $
+    (\mp -> foldl' (flip M.delete) mp (map fst targets)) $
+    M.mapMaybe id $
+    execState (mapM_ (mapM_ go . getDeps . fst) targets)
+              (M.fromList (map (second Just) targets))
+  where
+    getDeps :: PackageName -> [PackageName]
+    getDeps name =
+        case M.lookup name localMap of
+            Just lp -> M.keys (packageDeps (lpPackage lp)) -- FIXME just Local?
+            _ -> []
+    go :: PackageName -> State (Map PackageName (Maybe (Path Abs File, Target))) Bool
+    go name = do
+        cache <- get
+        case (M.lookup name cache, M.lookup name localMap) of
+            (Just (Just _), _) -> pure True
+            (Just Nothing, _) | not loadAllDeps -> pure False
+            (_, Just lp) -> do
+                let deps = M.keys (packageDeps (lpPackage lp))
+                shouldLoad <- or <$> mapM go deps
+                if shouldLoad
+                    then do
+                        modify (M.insert name (Just (lpCabalFile lp, TargetComps (S.singleton CLib))))
+                        pure True
+                    else do
+                        modify (M.insert name Nothing)
+                        pure False
+            (_, _) -> pure False
+
+unionTargets :: Ord k => Map k Target -> Map k Target -> Map k Target
+unionTargets = M.unionWith $ \l r -> case (l, r) of
+  (TargetAll PTDependency, _) -> r
+  (TargetComps sl, TargetComps sr) -> TargetComps (S.union sl sr)
+  (TargetComps _, TargetAll PTProject) -> TargetAll PTProject
+  (TargetComps _, _) -> l
+  (TargetAll PTProject, _) -> TargetAll PTProject
+
+hasLocalComp :: (NamedComponent -> Bool) -> Target -> Bool
+hasLocalComp p t = case t of
+  TargetComps s -> any p (S.toList s)
+  TargetAll PTProject -> True
+  _ -> False
 
 -- | Run a command and grab the first line of stdout, dropping
 -- stderr's contexts completely.
src/Stack/Ghci/Script.hs view
@@ -4,11 +4,9 @@ module Stack.Ghci.Script
   ( GhciScript
   , ModuleName
-
   , cmdAdd
   , cmdCdGhc
   , cmdModule
-
   , scriptToLazyByteString
   , scriptToBuilder
   , scriptToFile
@@ -17,42 +15,41 @@ import           Data.ByteString.Builder ( toLazyByteString )
 import qualified Data.List as L
 import qualified Data.Set as S
-import           Distribution.ModuleName hiding ( toFilePath )
-import           Path
-import           Stack.Prelude hiding ( Module )
+import           Distribution.ModuleName ( ModuleName, components )
+import           Stack.Prelude
 import           System.IO ( hSetBinaryMode )
 
-
 newtype GhciScript = GhciScript { unGhciScript :: [GhciCommand] }
 
 instance Semigroup GhciScript where
   GhciScript xs <> GhciScript ys = GhciScript (ys <> xs)
+
 instance Monoid GhciScript where
   mempty = GhciScript []
   mappend = (<>)
 
 data GhciCommand
-  = Add (Set (Either ModuleName (Path Abs File)))
-  | CdGhc (Path Abs Dir)
-  | Module (Set ModuleName)
-  deriving (Show)
+  = AddCmd (Set (Either ModuleName (Path Abs File)))
+  | CdGhcCmd (Path Abs Dir)
+  | ModuleCmd (Set ModuleName)
+  deriving Show
 
 cmdAdd :: Set (Either ModuleName (Path Abs File)) -> GhciScript
-cmdAdd = GhciScript . (:[]) . Add
+cmdAdd = GhciScript . (:[]) . AddCmd
 
 cmdCdGhc :: Path Abs Dir -> GhciScript
-cmdCdGhc = GhciScript . (:[]) . CdGhc
+cmdCdGhc = GhciScript . (:[]) . CdGhcCmd
 
 cmdModule :: Set ModuleName -> GhciScript
-cmdModule = GhciScript . (:[]) . Module
+cmdModule = GhciScript . (:[]) . ModuleCmd
 
 scriptToLazyByteString :: GhciScript -> LByteString
 scriptToLazyByteString = toLazyByteString . scriptToBuilder
 
 scriptToBuilder :: GhciScript -> Builder
 scriptToBuilder backwardScript = mconcat $ fmap commandToBuilder script
-  where
-    script = reverse $ unGhciScript backwardScript
+ where
+  script = reverse $ unGhciScript backwardScript
 
 scriptToFile :: Path Abs File -> GhciScript -> IO ()
 scriptToFile path script =
@@ -60,31 +57,43 @@     $ \hdl -> do hSetBuffering hdl (BlockBuffering Nothing)
                  hSetBinaryMode hdl True
                  hPutBuilder hdl (scriptToBuilder script)
-  where
-    filepath = toFilePath path
+ where
+  filepath = toFilePath path
 
 -- Command conversion
 
 commandToBuilder :: GhciCommand -> Builder
 
-commandToBuilder (Add modules)
+commandToBuilder (AddCmd modules)
   | S.null modules = mempty
   | otherwise      =
        ":add "
-    <> mconcat (L.intersperse " " $
-         fmap (fromString . quoteFileName . either (mconcat . L.intersperse "." . components) toFilePath)
-              (S.toAscList modules))
+    <> mconcat
+         ( L.intersperse " "
+             $ fmap
+                 ( fromString
+                 . quoteFileName
+                 . either (mconcat . L.intersperse "." . components) toFilePath
+                 )
+                 (S.toAscList modules)
+         )
     <> "\n"
 
-commandToBuilder (CdGhc path) =
+commandToBuilder (CdGhcCmd path) =
   ":cd-ghc " <> fromString (quoteFileName (toFilePath path)) <> "\n"
 
-commandToBuilder (Module modules)
+commandToBuilder (ModuleCmd modules)
   | S.null modules = ":module +\n"
   | otherwise      =
        ":module + "
-    <> mconcat (L.intersperse " "
-        $ fromString . quoteFileName . mconcat . L.intersperse "." . components <$> S.toAscList modules)
+    <> mconcat
+         ( L.intersperse " "
+             $ fromString
+             . quoteFileName
+             . mconcat
+             . L.intersperse "."
+             . components <$> S.toAscList modules
+         )
     <> "\n"
 
 -- | Make sure that a filename with spaces in it gets the proper quotes.
src/Stack/Hoogle.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | A wrapper around hoogle.
 module Stack.Hoogle
@@ -15,21 +14,37 @@ import           Distribution.Version ( mkVersion )
 import           Lens.Micro ( (?~) )
 import           Path ( parseAbsFile )
-import           Path.IO hiding ( findExecutable )
-import qualified Stack.Build
+import           Path.IO ( createDirIfMissing, doesFileExist )
+import qualified RIO.Map as Map
+import           RIO.Process ( findExecutable, proc, readProcess_, runProcess_)
+import qualified Stack.Build ( build )
 import           Stack.Build.Target ( NeedTargets (NeedTargets) )
+import           Stack.Constants ( stackProgName' )
 import           Stack.Prelude
 import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig
+                   , withEnvConfig
+                   )
+import           Stack.Types.BuildOpts
+                   ( BuildOptsCLI (..), buildOptsMonoidHaddockL
+                   , defaultBuildOptsCLI
+                   )
 import           Stack.Types.Config
-import           Stack.Types.SourceMap
-import qualified RIO.Map as Map
-import           RIO.Process
+                   ( Config (..), HasConfig (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig, HasSourceMap (..), hoogleDatabasePath
+                   , hoogleRoot
+                   )
+import           Stack.Types.EnvSettings ( EnvSettings (..) )
+import           Stack.Types.GlobalOpts
+                   ( GlobalOpts (..), globalOptsBuildOptsMonoidL )
+import           Stack.Types.Runner ( Runner, globalOptsL )
+import           Stack.Types.SourceMap ( DepPackage (..), SourceMap (..) )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Hoogle" module.
 data HoogleException
   = HoogleDatabaseNotFound
-  | HoogleNotFound !Text
   | HoogleOnPathNotFoundBug
   deriving (Show, Typeable)
 
@@ -37,181 +52,229 @@   displayException HoogleDatabaseNotFound =
     "Error: [S-3025]\n"
     ++ "No Hoogle database. Not building one due to '--no-setup'."
-  displayException (HoogleNotFound e) =
-    "Error: [S-1329]\n"
-    ++ T.unpack e
-    ++ "\n"
-    ++ "Not installing Hoogle due to '--no-setup'."
   displayException HoogleOnPathNotFoundBug = bugReport "[S-9669]"
     "Cannot find Hoogle executable on PATH, after installing."
 
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.Hoogle" module.
+newtype HooglePrettyException
+  = HoogleNotFound StyleDoc
+  deriving (Show, Typeable)
+
+instance Pretty HooglePrettyException where
+  pretty (HoogleNotFound e) =
+    "[S-1329]"
+    <> line
+    <> e
+    <> line
+    <> fillSep
+         [ flow "Not installing Hoogle due to"
+         , style Shell "--no-setup" <> "."
+         ]
+
+instance Exception HooglePrettyException
+
 -- | Helper type to duplicate log messages
 data Muted = Muted | NotMuted
 
 -- | Hoogle command.
-hoogleCmd :: ([String],Bool,Bool,Bool) -> RIO Runner ()
-hoogleCmd (args,setup,rebuild,startServer) =
+hoogleCmd :: ([String], Bool, Bool, Bool) -> RIO Runner ()
+hoogleCmd (args, setup, rebuild, startServer) =
   local (over globalOptsL modifyGO) $
-  withConfig YesReexec $
-  withDefaultEnvConfig $ do
-    hooglePath <- ensureHoogleInPath
-    generateDbIfNeeded hooglePath
-    runHoogle hooglePath args'
-  where
-    modifyGO :: GlobalOpts -> GlobalOpts
-    modifyGO = globalOptsBuildOptsMonoidL . buildOptsMonoidHaddockL ?~ True
+    withConfig YesReexec $
+      withDefaultEnvConfig $ do
+        hooglePath <- ensureHoogleInPath
+        generateDbIfNeeded hooglePath
+        runHoogle hooglePath args'
+ where
+  modifyGO :: GlobalOpts -> GlobalOpts
+  modifyGO = globalOptsBuildOptsMonoidL . buildOptsMonoidHaddockL ?~ True
 
-    args' :: [String]
-    args' = if startServer
-                 then ["server", "--local", "--port", "8080"]
-                 else []
-            ++ args
-    generateDbIfNeeded :: Path Abs File -> RIO EnvConfig ()
-    generateDbIfNeeded hooglePath = do
-        databaseExists <- checkDatabaseExists
-        if databaseExists && not rebuild
-            then pure ()
-            else if setup || rebuild
-                     then do
-                         logWarn
-                             (if rebuild
-                                  then "Rebuilding database ..."
-                                  else "No Hoogle database yet. Automatically building haddocks and hoogle database (use --no-setup to disable) ...")
-                         buildHaddocks
-                         logInfo "Built docs."
-                         generateDb hooglePath
-                         logInfo "Generated DB."
-                     else throwIO HoogleDatabaseNotFound
-    generateDb :: Path Abs File -> RIO EnvConfig ()
-    generateDb hooglePath = do
-        do dir <- hoogleRoot
-           createDirIfMissing True dir
-           runHoogle hooglePath ["generate", "--local"]
-    buildHaddocks :: RIO EnvConfig ()
-    buildHaddocks = do
-      config <- view configL
-      runRIO config $ -- a bit weird that we have to drop down like this
-        catch (withDefaultEnvConfig $ Stack.Build.build Nothing)
-              (\(_ :: ExitCode) -> pure ())
-    hooglePackageName = mkPackageName "hoogle"
-    hoogleMinVersion = mkVersion [5, 0]
-    hoogleMinIdent =
-        PackageIdentifier hooglePackageName hoogleMinVersion
-    installHoogle :: RIO EnvConfig (Path Abs File)
-    installHoogle = requiringHoogle Muted $ do
-        Stack.Build.build Nothing
-        mhooglePath' <- findExecutable "hoogle"
-        case mhooglePath' of
-            Right hooglePath -> parseAbsFile hooglePath
-            Left _ -> throwIO HoogleOnPathNotFoundBug
-    requiringHoogle :: Muted -> RIO EnvConfig x -> RIO EnvConfig x
-    requiringHoogle muted f = do
-        hoogleTarget <- do
-          sourceMap <- view $ sourceMapL . to smDeps
-          case Map.lookup hooglePackageName sourceMap of
-            Just hoogleDep ->
-              case dpLocation hoogleDep of
-                PLImmutable pli ->
-                  T.pack . packageIdentifierString <$>
-                      restrictMinHoogleVersion muted (packageLocationIdent pli)
-                plm@(PLMutable _) -> do
-                  T.pack . packageIdentifierString . package . packageDescription
-                      <$> loadCabalFile (Just stackProgName') plm
-            Nothing -> do
-              -- not muted because this should happen only once
-              logWarn "No hoogle version was found, trying to install the latest version"
-              mpir <- getLatestHackageVersion YesRequireHackageIndex hooglePackageName UsePreferredVersions
-              let hoogleIdent = case mpir of
-                      Nothing -> hoogleMinIdent
-                      Just (PackageIdentifierRevision _ ver _) ->
-                          PackageIdentifier hooglePackageName ver
+  args' :: [String]
+  args' = if startServer
+    then ["server", "--local", "--port", "8080"] ++ args
+    else args
+
+  generateDbIfNeeded :: Path Abs File -> RIO EnvConfig ()
+  generateDbIfNeeded hooglePath = do
+    databaseExists <- checkDatabaseExists
+    if databaseExists && not rebuild
+      then pure ()
+      else
+        if setup || rebuild
+          then do
+            prettyWarn $
+              if rebuild
+                 then flow "Rebuilding database ..."
+                 else
+                   fillSep
+                     [ flow "No Hoogle database yet. Automatically building \
+                            \Haddock documentation and Hoogle database (use"
+                     , style Shell "--no-setup"
+                     , flow "to disable) ..."
+                     ]
+            buildHaddocks
+            prettyInfoS "Built Haddock documentation."
+            generateDb hooglePath
+            prettyInfoS "Generated Hoogle database."
+          else throwIO HoogleDatabaseNotFound
+
+  generateDb :: Path Abs File -> RIO EnvConfig ()
+  generateDb hooglePath = do
+    dir <- hoogleRoot
+    createDirIfMissing True dir
+    runHoogle hooglePath ["generate", "--local"]
+
+  buildHaddocks :: RIO EnvConfig ()
+  buildHaddocks = do
+    config <- view configL
+    runRIO config $ -- a bit weird that we have to drop down like this
+      catch (withDefaultEnvConfig $ Stack.Build.build Nothing)
+            (\(_ :: ExitCode) -> pure ())
+
+  hooglePackageName = mkPackageName "hoogle"
+  hoogleMinVersion = mkVersion [5, 0]
+  hoogleMinIdent =
+    PackageIdentifier hooglePackageName hoogleMinVersion
+
+  installHoogle :: RIO EnvConfig (Path Abs File)
+  installHoogle = requiringHoogle Muted $ do
+    Stack.Build.build Nothing
+    mhooglePath' <- findExecutable "hoogle"
+    case mhooglePath' of
+      Right hooglePath -> parseAbsFile hooglePath
+      Left _ -> throwIO HoogleOnPathNotFoundBug
+
+  requiringHoogle :: Muted -> RIO EnvConfig x -> RIO EnvConfig x
+  requiringHoogle muted f = do
+    hoogleTarget <- do
+      sourceMap <- view $ sourceMapL . to smDeps
+      case Map.lookup hooglePackageName sourceMap of
+        Just hoogleDep ->
+          case dpLocation hoogleDep of
+            PLImmutable pli ->
               T.pack . packageIdentifierString <$>
-                  restrictMinHoogleVersion muted hoogleIdent
-        config <- view configL
-        let boptsCLI = defaultBuildOptsCLI
-                { boptsCLITargets =  [hoogleTarget]
-                }
-        runRIO config $ withEnvConfig NeedTargets boptsCLI f
-    restrictMinHoogleVersion
-      :: HasLogFunc env
-      => Muted -> PackageIdentifier -> RIO env PackageIdentifier
-    restrictMinHoogleVersion muted ident = do
-      if ident < hoogleMinIdent
+                  restrictMinHoogleVersion muted (packageLocationIdent pli)
+            plm@(PLMutable _) ->
+              T.pack . packageIdentifierString . package . packageDescription
+                  <$> loadCabalFile (Just stackProgName') plm
+        Nothing -> do
+          -- not muted because this should happen only once
+          prettyWarnS
+            "No hoogle version was found, trying to install the latest version"
+          mpir <- getLatestHackageVersion YesRequireHackageIndex hooglePackageName UsePreferredVersions
+          let hoogleIdent = case mpir of
+                  Nothing -> hoogleMinIdent
+                  Just (PackageIdentifierRevision _ ver _) ->
+                      PackageIdentifier hooglePackageName ver
+          T.pack . packageIdentifierString <$>
+              restrictMinHoogleVersion muted hoogleIdent
+    config <- view configL
+    let boptsCLI = defaultBuildOptsCLI
+            { boptsCLITargets =  [hoogleTarget]
+            }
+    runRIO config $ withEnvConfig NeedTargets boptsCLI f
+
+  restrictMinHoogleVersion ::
+       HasLogFunc env
+    => Muted
+    -> PackageIdentifier
+    -> RIO env PackageIdentifier
+  restrictMinHoogleVersion muted ident =
+    if ident < hoogleMinIdent
       then do
-          muteableLog LevelWarn muted $
-               "Minimum " <>
-               fromString (packageIdentifierString hoogleMinIdent) <>
-               " is not in your index. Installing the minimum version."
-          pure hoogleMinIdent
+        muteableLog LevelWarn muted $
+          "Minimum " <>
+          fromString (packageIdentifierString hoogleMinIdent) <>
+          " is not in your index. Installing the minimum version."
+        pure hoogleMinIdent
       else do
-          muteableLog LevelInfo muted $
-              "Minimum version is " <>
-              fromString (packageIdentifierString hoogleMinIdent) <>
-              ". Found acceptable " <>
-              fromString (packageIdentifierString ident) <>
-              " in your index, requiring its installation."
-          pure ident
-    muteableLog :: HasLogFunc env => LogLevel -> Muted -> Utf8Builder -> RIO env ()
-    muteableLog logLevel muted msg =
-        case muted of
-            Muted -> pure ()
-            NotMuted -> logGeneric "" logLevel msg
-    runHoogle :: Path Abs File -> [String] -> RIO EnvConfig ()
-    runHoogle hooglePath hoogleArgs = do
-        config <- view configL
-        menv <- liftIO $ configProcessContextSettings config envSettings
-        dbpath <- hoogleDatabasePath
-        let databaseArg = ["--database=" ++ toFilePath dbpath]
-        withProcessContext menv $ proc
-          (toFilePath hooglePath)
-          (hoogleArgs ++ databaseArg)
-          runProcess_
-    checkDatabaseExists = do
-        path <- hoogleDatabasePath
-        liftIO (doesFileExist path)
-    ensureHoogleInPath :: RIO EnvConfig (Path Abs File)
-    ensureHoogleInPath = do
-        config <- view configL
-        menv <- liftIO $ configProcessContextSettings config envSettings
-        mhooglePath <- runRIO menv (findExecutable "hoogle") <>
-          requiringHoogle NotMuted (findExecutable "hoogle")
-        eres <- case mhooglePath of
-            Left _ -> pure $ Left "Hoogle isn't installed."
-            Right hooglePath -> do
-                result <- withProcessContext menv
-                        $ proc hooglePath ["--numeric-version"]
-                        $ tryAny . fmap fst . readProcess_
-                let unexpectedResult got = Left $ T.concat
-                        [ "'"
-                        , T.pack hooglePath
-                        , " --numeric-version' did not respond with expected value. Got: "
-                        , got
-                        ]
-                pure $ case result of
-                    Left err -> unexpectedResult $ T.pack (displayException err)
-                    Right bs -> case parseVersion (takeWhile (not . isSpace) (BL8.unpack bs)) of
-                        Nothing -> unexpectedResult $ T.pack (BL8.unpack bs)
-                        Just ver
-                            | ver >= hoogleMinVersion -> Right hooglePath
-                            | otherwise -> Left $ T.concat
-                                [ "Installed Hoogle is too old, "
-                                , T.pack hooglePath
-                                , " is version "
-                                , T.pack $ versionString ver
-                                , " but >= 5.0 is required."
-                                ]
-        case eres of
-            Right hooglePath -> parseAbsFile hooglePath
-            Left err
-                | setup -> do
-                    logWarn $ display err <> " Automatically installing (use --no-setup to disable) ..."
-                    installHoogle
-                | otherwise -> throwIO $ HoogleNotFound err
-    envSettings =
-        EnvSettings
-        { esIncludeLocals = True
-        , esIncludeGhcPackagePath = True
-        , esStackExe = True
-        , esLocaleUtf8 = False
-        , esKeepGhcRts = False
-        }
+        muteableLog LevelInfo muted $
+          "Minimum version is " <>
+          fromString (packageIdentifierString hoogleMinIdent) <>
+          ". Found acceptable " <>
+          fromString (packageIdentifierString ident) <>
+          " in your index, requiring its installation."
+        pure ident
+  muteableLog ::
+       HasLogFunc env
+    => LogLevel
+    -> Muted
+    -> Utf8Builder
+    -> RIO env ()
+  muteableLog logLevel muted msg =
+    case muted of
+      Muted -> pure ()
+      NotMuted -> logGeneric "" logLevel msg
+
+  runHoogle :: Path Abs File -> [String] -> RIO EnvConfig ()
+  runHoogle hooglePath hoogleArgs = do
+    config <- view configL
+    menv <- liftIO $ configProcessContextSettings config envSettings
+    dbpath <- hoogleDatabasePath
+    let databaseArg = ["--database=" ++ toFilePath dbpath]
+    withProcessContext menv $ proc
+      (toFilePath hooglePath)
+      (hoogleArgs ++ databaseArg)
+      runProcess_
+
+  checkDatabaseExists = do
+    path <- hoogleDatabasePath
+    liftIO (doesFileExist path)
+
+  ensureHoogleInPath :: RIO EnvConfig (Path Abs File)
+  ensureHoogleInPath = do
+    config <- view configL
+    menv <- liftIO $ configProcessContextSettings config envSettings
+    mhooglePath <- runRIO menv (findExecutable "hoogle") <>
+      requiringHoogle NotMuted (findExecutable "hoogle")
+    eres <- case mhooglePath of
+      Left _ -> pure $ Left (flow "Hoogle isn't installed.")
+      Right hooglePath -> do
+        result <- withProcessContext menv
+          $ proc hooglePath ["--numeric-version"]
+          $ tryAny . fmap fst . readProcess_
+        let unexpectedResult got = Left $
+                 fillSep
+                   [ style Shell (fromString hooglePath)
+                   , style Shell "--numeric-version"
+                   , flow "did not respond with expected value. Got:"
+                   ]
+              <> blankLine
+              <> got
+        pure $ case result of
+          Left err -> unexpectedResult $ string (displayException err)
+          Right bs ->
+            case parseVersion (takeWhile (not . isSpace) (BL8.unpack bs)) of
+              Nothing -> unexpectedResult $ fromString (BL8.unpack bs)
+              Just ver
+                | ver >= hoogleMinVersion -> Right hooglePath
+                | otherwise -> Left $
+                    fillSep
+                      [ flow "Installed Hoogle is too old, "
+                      , style Shell (fromString hooglePath)
+                      , flow "is version"
+                      , fromString (versionString ver)
+                      , flow "but >= 5.0 is required."
+                      ]
+    case eres of
+      Right hooglePath -> parseAbsFile hooglePath
+      Left err
+        | setup -> do
+            prettyWarnL
+              [ err
+              , flow "Automatically installing (use"
+              , style Shell "--no-setup"
+              , flow "to disable) ..."
+              ]
+            installHoogle
+        | otherwise -> prettyThrowIO $ HoogleNotFound err
+
+  envSettings =
+    EnvSettings
+      { esIncludeLocals = True
+      , esIncludeGhcPackagePath = True
+      , esStackExe = True
+      , esLocaleUtf8 = False
+      , esKeepGhcRts = False
+      }
src/Stack/IDE.hs view
@@ -1,39 +1,67 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
 
--- | Functions for IDEs.
+-- | Types and functions related to Stack's @ide@ command.
 module Stack.IDE
-    ( OutputStream (..)
-    , ListPackagesCmd (..)
-    , listPackages
-    , listTargets
-    ) where
+  ( OutputStream (..)
+  , ListPackagesCmd (..)
+  , idePackagesCmd
+  , ideTargetsCmd
+  , listPackages
+  , listTargets
+  ) where
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Runners
+                   ( ShouldReexec (..), withBuildConfig, withConfig )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
 import           Stack.Types.NamedComponent
+                   ( NamedComponent, renderPkgComponent )
+import           Stack.Types.Runner ( Runner )
 import           Stack.Types.SourceMap
-import           System.IO (putStrLn)
+                   ( ProjectPackage (..), SMWanted (..), ppComponents )
+import           System.IO ( putStrLn )
 
-data OutputStream = OutputLogInfo
-                  | OutputStdout
+-- Type representing output channel choices for the @stack ide packages@ and
+-- @stack ide targets@ commands.
+data OutputStream
+  = OutputLogInfo
+    -- ^ To the same output channel as other log information.
+  | OutputStdout
+    -- ^ To the standard output channel.
 
-data ListPackagesCmd = ListPackageNames
-                     | ListPackageCabalFiles
+-- Type representing output choices for the @stack ide packages@ command.
+data ListPackagesCmd
+  = ListPackageNames
+    -- ^ Package names.
+  | ListPackageCabalFiles
+    -- ^ Paths to Cabal files.
 
-outputFunc :: HasLogFunc env => OutputStream -> String -> RIO env ()
-outputFunc OutputLogInfo = logInfo . fromString
+-- | Function underlying the @stack ide packages@ command. List packages in the
+-- project.
+idePackagesCmd :: (OutputStream, ListPackagesCmd) -> RIO Runner ()
+idePackagesCmd =
+  withConfig NoReexec . withBuildConfig . uncurry listPackages
+
+-- | Function underlying the @stack ide targets@ command. List targets in the
+-- project.
+ideTargetsCmd :: OutputStream -> RIO Runner ()
+ideTargetsCmd = withConfig NoReexec . withBuildConfig . listTargets
+
+outputFunc :: HasTerm env => OutputStream -> String -> RIO env ()
+outputFunc OutputLogInfo = prettyInfo . fromString
 outputFunc OutputStdout  = liftIO . putStrLn
 
 -- | List the packages inside the current project.
-listPackages :: HasBuildConfig env => OutputStream -> ListPackagesCmd -> RIO env ()
+listPackages ::
+     HasBuildConfig env
+  => OutputStream
+  -> ListPackagesCmd
+  -> RIO env ()
 listPackages stream flag = do
   packages <- view $ buildConfigL.to (smwProject . bcSMWanted)
   let strs = case flag of
@@ -50,10 +78,10 @@   pairs <- concat <$> Map.traverseWithKey toNameAndComponent packages
   outputFunc stream $ T.unpack $ T.intercalate "\n" $
     map renderPkgComponent pairs
-  where
-    toNameAndComponent
-      :: PackageName
-      -> ProjectPackage
-      -> RIO env [(PackageName, NamedComponent)]
-    toNameAndComponent pkgName' =
-        fmap (map (pkgName', ) . Set.toList) . ppComponents
+ where
+  toNameAndComponent ::
+       PackageName
+    -> ProjectPackage
+    -> RIO env [(PackageName, NamedComponent)]
+  toNameAndComponent pkgName' =
+    fmap (map (pkgName', ) . Set.toList) . ppComponents
src/Stack/Init.hs view
@@ -1,700 +1,740 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
-
-module Stack.Init
-  ( initProject
-  , InitOpts (..)
-  ) where
-
-import qualified Data.Aeson.KeyMap as KeyMap
-import qualified Data.ByteString.Builder as B
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.Foldable as F
-import qualified Data.IntMap as IntMap
-import           Data.List.Extra ( groupSortOn )
-import qualified Data.List.NonEmpty as NonEmpty
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import qualified Data.Yaml as Yaml
-import qualified Distribution.PackageDescription as C
-import qualified Distribution.Text as C
-import qualified Distribution.Version as C
-import           Path
-import           Path.Extra ( toFilePathNoTrailingSep )
-import           Path.Find ( findFiles )
-import           Path.IO hiding ( findFiles )
-import qualified RIO.FilePath as FP
-import           RIO.List ( (\\), intercalate, isSuffixOf, isPrefixOf )
-import           RIO.List.Partial ( minimumBy )
-import           Stack.BuildPlan
-import           Stack.Config ( getSnapshots, makeConcreteResolver )
-import           Stack.Constants
-import           Stack.Prelude
-import           Stack.SourceMap
-import           Stack.Types.Config
-import           Stack.Types.Resolver
-import           Stack.Types.Version ( stackMajorVersion )
-
--- | Type representing exceptions thrown by functions exported by the
--- "Stack.Init" module.
-data InitException
-    = NoPackagesToIgnoreBug
-    deriving (Show, Typeable)
-
-instance Exception InitException where
-    displayException NoPackagesToIgnoreBug = bugReport "[S-2747]"
-        "No packages to ignore."
-
-data InitPrettyException
-    = SnapshotDownloadFailure SomeException
-    | ConfigFileAlreadyExists FilePath
-    | PackageNameInvalid [(Path Abs File, PackageName)]
-    deriving (Show, Typeable)
-
-instance Pretty InitPrettyException where
-    pretty (ConfigFileAlreadyExists reldest) =
-        "[S-8009]"
-        <> line
-        <> flow "Stack declined to create a project-level YAML configuration \
-                \file."
-        <> blankLine
-        <> fillSep
-             [ flow "The file"
-             , style File (fromString reldest)
-             , "already exists. To overwrite it, pass the flag"
-             , style Shell "--force" <> "."
-             ]
-    pretty (PackageNameInvalid rels) =
-        "[S-5267]"
-        <> line
-        <> flow "Stack did not create project-level YAML configuration, as \
-                \(like Hackage) it requires a Cabal file name to match the \
-                \package it defines."
-        <> blankLine
-        <> flow "Please rename the following Cabal files:"
-        <> line
-        <> bulletedList
-             ( map
-                 ( \(fp, name) -> fillSep
-                     [ style File (pretty fp)
-                     , "as"
-                     , style
-                         File
-                         (fromString (packageNameString name) <> ".cabal")
-                     ]
-                 )
-                 rels
-             )
-    pretty (SnapshotDownloadFailure e) =
-        "[S-8332]"
-        <> line
-        <> flow "Stack failed to create project-level YAML configuration, as \
-                \it was unable to download the index of available snapshots."
-        <> blankLine
-        <> fillSep
-             [ flow "This sometimes happens because Certificate Authorities \
-                    \are missing on your system. You can try the Stack command \
-                    \again or manually create the configuration file. For help \
-                    \about the content of Stack's YAML configuration files, \
-                    \see (for the most recent release of Stack)"
-             , style
-                 Url
-                 "http://docs.haskellstack.org/en/stable/yaml_configuration/"
-               <> "."
-             ]
-        <> blankLine
-        <> flow "While downloading the snapshot index, Stack encountered the \
-                \following error:"
-        <> blankLine
-        <> string (displayException e)
-
-instance Exception InitPrettyException
-
--- | Generate stack.yaml
-initProject
-    :: (HasConfig env, HasGHCVariant env)
-    => Path Abs Dir
-    -> InitOpts
-    -> Maybe AbstractResolver
-    -> RIO env ()
-initProject currDir initOpts mresolver = do
-    let dest = currDir </> stackDotYaml
-
-    reldest <- toFilePath `liftM` makeRelativeToCurrentDir dest
-
-    exists <- doesFileExist dest
-    when (not (forceOverwrite initOpts) && exists) $
-        throwIO $ PrettyException $ ConfigFileAlreadyExists reldest
-
-    dirs <- mapM (resolveDir' . T.unpack) (searchDirs initOpts)
-    let find  = findCabalDirs (includeSubDirs initOpts)
-        dirs' = if null dirs then [currDir] else dirs
-    prettyInfo $
-           fillSep
-             [ flow "Looking for Cabal or"
-             , style File "package.yaml"
-             , flow "files to use to initialise Stack's project-level YAML \
-                    \configuration file."
-             ]
-        <> line
-    cabaldirs <- Set.toList . Set.unions <$> mapM find dirs'
-    (bundle, dupPkgs)  <- cabalPackagesCheck cabaldirs
-    let makeRelDir dir =
-            case stripProperPrefix currDir dir of
-                Nothing
-                    | currDir == dir -> "."
-                    | otherwise -> assert False $ toFilePathNoTrailingSep dir
-                Just rel -> toFilePathNoTrailingSep rel
-        fpToPkgDir fp =
-            let absDir = parent fp
-            in ResolvedPath (RelFilePath $ T.pack $ makeRelDir absDir) absDir
-        pkgDirs = Map.map (fpToPkgDir . fst) bundle
-    (snapshotLoc, flags, extraDeps, rbundle) <- getDefaultResolver initOpts mresolver pkgDirs
-
-    let ignored = Map.difference bundle rbundle
-        dupPkgMsg
-            | dupPkgs /= [] =
-                "Warning (added by new or init): Some packages were found to " <>
-                "have names conflicting with others and have been commented " <>
-                "out in the packages section.\n"
-            | otherwise = ""
-
-        missingPkgMsg
-            | Map.size ignored > 0 =
-                "Warning (added by new or init): Some packages were found to " <>
-                "be incompatible with the resolver and have been left commented " <>
-                "out in the packages section.\n"
-            | otherwise = ""
-
-        extraDepMsg
-            | Map.size extraDeps > 0 =
-                "Warning (added by new or init): Specified resolver could not " <>
-                "satisfy all dependencies. Some external packages have been " <>
-                "added as dependencies.\n"
-            | otherwise = ""
-        makeUserMsg msgs =
-            let msg = concat msgs
-            in if msg /= "" then
-                  msg <> "You can omit this message by removing it from " <>
-                         "stack.yaml\n"
-                 else ""
-
-        userMsg = makeUserMsg [dupPkgMsg, missingPkgMsg, extraDepMsg]
-
-        gpdByDir = Map.fromList [ (parent fp, gpd) | (fp, gpd) <- Map.elems bundle]
-        gpds = Map.elems $
-          Map.mapMaybe (flip Map.lookup gpdByDir . resolvedAbsolute) rbundle
-
-    deps <- for (Map.toList extraDeps) $ \(n, v) ->
-      PLImmutable . cplComplete <$>
-      completePackageLocation (RPLIHackage (PackageIdentifierRevision n v CFILatest) Nothing)
-
-    let p = Project
-            { projectUserMsg = if userMsg == "" then Nothing else Just userMsg
-            , projectPackages = resolvedRelative <$> Map.elems rbundle
-            , projectDependencies = map toRawPL deps
-            , projectFlags = removeSrcPkgDefaultFlags gpds flags
-            , projectResolver = snapshotLoc
-            , projectCompiler = Nothing
-            , projectExtraPackageDBs = []
-            , projectCurator = Nothing
-            , projectDropPackages = mempty
-            }
-
-        makeRel = fmap toFilePath . makeRelativeToCurrentDir
-
-    prettyInfo $
-        fillSep
-          [ flow "Initialising Stack's project-level YAML configuration file \
-                 \using snapshot"
-          , pretty (PrettyRawSnapshotLocation snapshotLoc) <> "."
-          ]
-    prettyInfo $
-        let n = Map.size bundle + length dupPkgs
-        in  fillSep
-              [ "Considered"
-              , fromString $ show n
-              , "user"
-              , if n == 1 then "package." else "packages."
-              ]
-
-    when (dupPkgs /= []) $ do
-        rels <- mapM makeRel dupPkgs
-        prettyWarn $
-               fillSep
-                 [ flow "Ignoring these"
-                 , fromString $ show (length dupPkgs)
-                 , flow "duplicate packages:"
-                 ]
-            <> line
-            <> bulletedList (map (style File . fromString) rels)
-
-    when (Map.size ignored > 0) $ do
-        rels <- mapM makeRel (Map.elems (fmap fst ignored))
-        prettyWarn $
-               fillSep
-                 [ flow "Ignoring these"
-                 , fromString $ show (Map.size ignored)
-                 , flow "packages due to dependency conflicts:"
-                 ]
-            <> line
-            <> bulletedList (map (style File . fromString) rels)
-
-    when (Map.size extraDeps > 0) $ do
-        prettyWarn $
-            fillSep
-              [ fromString $ show (Map.size extraDeps)
-              , flow "external dependencies were added."
-              ]
-    prettyInfo $
-        fillSep
-          [ flow $ if exists
-                then "Overwriting existing configuration file"
-                else "Writing configuration to"
-          , style File (fromString reldest) <> "."
-          ]
-    writeBinaryFileAtomic dest
-           $ renderStackYaml p
-               (Map.elems $ fmap (makeRelDir . parent . fst) ignored)
-               (map (makeRelDir . parent) dupPkgs)
-    prettyInfo $
-        flow "Stack's project-level YAML configuration file has been \
-             \initialised."
-
--- | Render a stack.yaml file with comments, see:
--- https://github.com/commercialhaskell/stack/issues/226
-renderStackYaml :: Project -> [FilePath] -> [FilePath] -> B.Builder
-renderStackYaml p ignoredPackages dupPackages =
-    case Yaml.toJSON p of
-        Yaml.Object o -> renderObject o
-        _ -> assert False $ B.byteString $ Yaml.encode p
-  where
-    renderObject o =
-           B.byteString headerHelp
-        <> B.byteString "\n\n"
-        <> F.foldMap (goComment o) comments
-        <> goOthers (o `KeyMap.difference` KeyMap.fromList comments)
-        <> B.byteString footerHelp
-        <> "\n"
-
-    goComment o (name, comment) =
-        case (convert <$> KeyMap.lookup name o) <|> nonPresentValue name of
-            Nothing -> assert (name == "user-message") mempty
-            Just v ->
-                B.byteString comment <>
-                B.byteString "\n" <>
-                v <>
-                if name == "packages" then commentedPackages else "" <>
-                B.byteString "\n"
-      where
-        convert v = B.byteString (Yaml.encode $ Yaml.object [(name, v)])
-
-        -- Some fields in stack.yaml are optional and may not be
-        -- generated. For these, we provided commented out dummy
-        -- values to go along with the comments.
-        nonPresentValue "extra-deps" = Just "# extra-deps: []\n"
-        nonPresentValue "flags" = Just "# flags: {}\n"
-        nonPresentValue "extra-package-dbs" = Just "# extra-package-dbs: []\n"
-        nonPresentValue _ = Nothing
-
-    commentLine l | null l = "#"
-                  | otherwise = "# " ++ l
-    commentHelp = BC.pack .  intercalate "\n" . map commentLine
-    commentedPackages =
-        let ignoredComment = commentHelp
-                [ "The following packages have been ignored due to incompatibility with the"
-                , "resolver compiler, dependency conflicts with other packages"
-                , "or unsatisfied dependencies."
-                ]
-            dupComment = commentHelp
-                [ "The following packages have been ignored due to package name conflict "
-                , "with other packages."
-                ]
-        in commentPackages ignoredComment ignoredPackages
-           <> commentPackages dupComment dupPackages
-
-    commentPackages comment pkgs
-        | pkgs /= [] =
-               B.byteString comment
-            <> B.byteString "\n"
-            <> B.byteString (BC.pack $ concat
-                 $ map (\x -> "#- " ++ x ++ "\n") pkgs ++ ["\n"])
-        | otherwise = ""
-
-    goOthers o
-        | KeyMap.null o = mempty
-        | otherwise = assert False $ B.byteString $ Yaml.encode o
-
-    -- Per Section Help
-    comments =
-        [ ("user-message"     , userMsgHelp)
-        , ("resolver"         , resolverHelp)
-        , ("packages"         , packageHelp)
-        , ("extra-deps"       , extraDepsHelp)
-        , ("flags"            , "# Override default flag values for local packages and extra-deps")
-        , ("extra-package-dbs", "# Extra package databases containing global packages")
-        ]
-
-    -- Help strings
-    headerHelp = commentHelp
-        [ "This file was automatically generated by 'stack init'"
-        , ""
-        , "Some commonly used options have been documented as comments in this file."
-        , "For advanced use and comprehensive documentation of the format, please see:"
-        , "https://docs.haskellstack.org/en/stable/yaml_configuration/"
-        ]
-
-    resolverHelp = commentHelp
-        [ "Resolver to choose a 'specific' stackage snapshot or a compiler version."
-        , "A snapshot resolver dictates the compiler version and the set of packages"
-        , "to be used for project dependencies. For example:"
-        , ""
-        , "resolver: lts-3.5"
-        , "resolver: nightly-2015-09-21"
-        , "resolver: ghc-7.10.2"
-        , ""
-        , "The location of a snapshot can be provided as a file or url. Stack assumes"
-        , "a snapshot provided as a file might change, whereas a url resource does not."
-        , ""
-        , "resolver: ./custom-snapshot.yaml"
-        , "resolver: https://example.com/snapshots/2018-01-01.yaml"
-        ]
-
-    userMsgHelp = commentHelp
-        [ "A warning or info to be displayed to the user on config load." ]
-
-    packageHelp = commentHelp
-        [ "User packages to be built."
-        , "Various formats can be used as shown in the example below."
-        , ""
-        , "packages:"
-        , "- some-directory"
-        , "- https://example.com/foo/bar/baz-0.0.2.tar.gz"
-        , "  subdirs:"
-        , "  - auto-update"
-        , "  - wai"
-        ]
-
-    extraDepsHelp = commentHelp
-        [ "Dependency packages to be pulled from upstream that are not in the resolver."
-        , "These entries can reference officially published versions as well as"
-        , "forks / in-progress versions pinned to a git hash. For example:"
-        , ""
-        , "extra-deps:"
-        , "- acme-missiles-0.3"
-        , "- git: https://github.com/commercialhaskell/stack.git"
-        , "  commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a"
-        , ""
-        ]
-
-    footerHelp = commentHelp
-        [ "Control whether we use the GHC we find on the path"
-        , "system-ghc: true"
-        , ""
-        , "Require a specific version of Stack, using version ranges"
-        , "require-stack-version: -any # Default"
-        , "require-stack-version: \""
-          ++ C.display (C.orLaterVersion stackMajorVersion) ++ "\""
-        , ""
-        , "Override the architecture used by Stack, especially useful on Windows"
-        , "arch: i386"
-        , "arch: x86_64"
-        , ""
-        , "Extra directories used by Stack for building"
-        , "extra-include-dirs: [/path/to/dir]"
-        , "extra-lib-dirs: [/path/to/dir]"
-        , ""
-        , "Allow a newer minor version of GHC than the snapshot specifies"
-        , "compiler-check: newer-minor"
-        ]
-
-getSnapshots' :: HasConfig env => RIO env Snapshots
-getSnapshots' = catchAny
-    getSnapshots
-    (\e -> throwIO $ PrettyException $ SnapshotDownloadFailure e)
-
--- | Get the default resolver value
-getDefaultResolver
-    :: (HasConfig env, HasGHCVariant env)
-    => InitOpts
-    -> Maybe AbstractResolver
-    -> Map PackageName (ResolvedPath Dir)
-    -- ^ Src package name: cabal dir
-    -> RIO env
-         ( RawSnapshotLocation
-         , Map PackageName (Map FlagName Bool)
-         , Map PackageName Version
-         , Map PackageName (ResolvedPath Dir))
-       -- ^ ( Resolver
-       --   , Flags for src packages and extra deps
-       --   , Extra dependencies
-       --   , Src packages actually considered)
-getDefaultResolver initOpts mresolver pkgDirs = do
-    (candidate, loc) <- case mresolver of
-      Nothing -> selectSnapResolver
-      Just ar -> do
-        sl <- makeConcreteResolver ar
-        c <- loadProjectSnapshotCandidate sl NoPrintWarnings False
-        pure (c, sl)
-    getWorkingResolverPlan initOpts pkgDirs candidate loc
-    where
-        -- TODO support selecting best across regular and custom snapshots
-        selectSnapResolver = do
-            snaps <- fmap getRecommendedSnapshots getSnapshots'
-            (c, l, r) <- selectBestSnapshot (Map.elems pkgDirs) snaps
-            case r of
-                BuildPlanCheckFail {} | not (omitPackages initOpts)
-                        -> throwM $ PrettyException $
-                               NoMatchingSnapshot snaps
-                _ -> pure (c, l)
-
-getWorkingResolverPlan
-    :: (HasConfig env, HasGHCVariant env)
-    => InitOpts
-    -> Map PackageName (ResolvedPath Dir)
-    -- ^ Src packages: cabal dir
-    -> SnapshotCandidate env
-    -> RawSnapshotLocation
-    -> RIO env
-         ( RawSnapshotLocation
-         , Map PackageName (Map FlagName Bool)
-         , Map PackageName Version
-         , Map PackageName (ResolvedPath Dir))
-       -- ^ ( SnapshotDef
-       --   , Flags for src packages and extra deps
-       --   , Extra dependencies
-       --   , Src packages actually considered)
-getWorkingResolverPlan initOpts pkgDirs0 snapCandidate snapLoc = do
-    prettyInfo $
-        fillSep
-          [ flow "Selected the snapshot"
-          , pretty (PrettyRawSnapshotLocation snapLoc) <> "."
-          ]
-    go pkgDirs0
-    where
-        go pkgDirs = do
-            eres <- checkBundleResolver initOpts snapLoc snapCandidate (Map.elems pkgDirs)
-            -- if some packages failed try again using the rest
-            case eres of
-                Right (f, edeps)-> pure (snapLoc, f, edeps, pkgDirs)
-                Left ignored
-                    | Map.null available -> do
-                        prettyWarn $
-                            flow "Could not find a working plan for any of the \
-                                 \user packages. Proceeding to create a YAML \
-                                 \configuration file anyway."
-                        pure (snapLoc, Map.empty, Map.empty, Map.empty)
-                    | otherwise -> do
-                        when (Map.size available == Map.size pkgDirs) $
-                            throwM NoPackagesToIgnoreBug
-
-                        if length ignored > 1
-                          then
-                            prettyWarn
-                              (    flow "Ignoring the following packages:"
-                                <> line
-                                <> bulletedList
-                                     ( map
-                                           (fromString . packageNameString)
-                                           ignored
-                                     )
-                              )
-                          else
-                            prettyWarn
-                              ( fillSep
-                                  [ flow "Ignoring package:"
-                                  , fromString
-                                        ( case ignored of
-                                              [] -> throwM NoPackagesToIgnoreBug
-                                              x:_ -> packageNameString x
-                                        )
-                                  ]
-                              )
-                        go available
-                    where
-                      isAvailable k _ = k `notElem` ignored
-                      available       = Map.filterWithKey isAvailable pkgDirs
-
-checkBundleResolver
-    :: (HasConfig env, HasGHCVariant env)
-    => InitOpts
-    -> RawSnapshotLocation
-    -> SnapshotCandidate env
-    -> [ResolvedPath Dir]
-    -- ^ Src package dirs
-    -> RIO env
-         (Either [PackageName] ( Map PackageName (Map FlagName Bool)
-                               , Map PackageName Version))
-checkBundleResolver initOpts snapshotLoc snapCandidate pkgDirs = do
-    result <- checkSnapBuildPlan pkgDirs Nothing snapCandidate
-    case result of
-        BuildPlanCheckOk f -> pure $ Right (f, Map.empty)
-        BuildPlanCheckPartial _f e -> do -- FIXME:qrilka unused f
-            if omitPackages initOpts
-                then do
-                    warnPartial result
-                    logWarn "*** Omitting packages with unsatisfied dependencies"
-                    pure $ Left $ failedUserPkgs e
-                else throwM $ PrettyException $
-                         ResolverPartial snapshotLoc (show result)
-        BuildPlanCheckFail _ e _
-            | omitPackages initOpts -> do
-                logWarn $ "*** Resolver compiler mismatch: "
-                           <> display snapshotLoc
-                logWarn $ display $ ind $ T.pack $ show result
-                pure $ Left $ failedUserPkgs e
-            | otherwise -> throwM $ PrettyException $
-                               ResolverMismatch snapshotLoc (show result)
-    where
-      ind t  = T.unlines $ fmap ("    " <>) (T.lines t)
-      warnPartial res = do
-          logWarn $ "*** Resolver " <> display snapshotLoc
-                      <> " will need external packages: "
-          logWarn $ display $ ind $ T.pack $ show res
-
-      failedUserPkgs e = Map.keys $ Map.unions (Map.elems (fmap deNeededBy e))
-
-getRecommendedSnapshots :: Snapshots -> NonEmpty SnapName
-getRecommendedSnapshots snapshots =
-    -- in order - Latest LTS, Latest Nightly, all LTS most recent first
-    case NonEmpty.nonEmpty supportedLtss of
-        Just (mostRecent :| older)
-            -> mostRecent :| (nightly : older)
-        Nothing
-            -> nightly :| []
-  where
-    ltss = map (uncurry LTS) (IntMap.toDescList $ snapshotsLts snapshots)
-    supportedLtss = filter (>= minSupportedLts) ltss
-    nightly = Nightly (snapshotsNightly snapshots)
-
--- |Yields the minimum LTS supported by Stack.
-minSupportedLts :: SnapName
-minSupportedLts = LTS 3 0 -- See https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md
-                          -- under Stack version 2.1.1.
-
-data InitOpts = InitOpts
-    { searchDirs     :: ![T.Text]
-    -- ^ List of sub directories to search for .cabal files
-    , omitPackages   :: Bool
-    -- ^ Exclude conflicting or incompatible user packages
-    , forceOverwrite :: Bool
-    -- ^ Overwrite existing stack.yaml
-    , includeSubDirs :: Bool
-    -- ^ If True, include all .cabal files found in any sub directories
-    }
-
-findCabalDirs
-  :: HasConfig env
-  => Bool -> Path Abs Dir -> RIO env (Set (Path Abs Dir))
-findCabalDirs recurse dir =
-    Set.fromList . map parent
-    <$> liftIO (findFiles dir isHpackOrCabal subdirFilter)
-  where
-    subdirFilter subdir = recurse && not (isIgnored subdir)
-    isHpack = (== "package.yaml")     . toFilePath . filename
-    isCabal = (".cabal" `isSuffixOf`) . toFilePath
-    isHpackOrCabal x = isHpack x || isCabal x
-
-    isIgnored path = "." `isPrefixOf` dirName || dirName `Set.member` ignoredDirs
-      where
-        dirName = FP.dropTrailingPathSeparator (toFilePath (dirname path))
-
--- | Special directories that we don't want to traverse for .cabal files
-ignoredDirs :: Set FilePath
-ignoredDirs = Set.fromList
-    [ "dist"
-    ]
-
-cabalPackagesCheck
-    :: (HasConfig env, HasGHCVariant env)
-     => [Path Abs Dir]
-     -> RIO env
-          ( Map PackageName (Path Abs File, C.GenericPackageDescription)
-          , [Path Abs File])
-cabalPackagesCheck cabaldirs = do
-    when (null cabaldirs) $
-      prettyWarn $
-             fillSep
-               [ flow "Stack did not find any local package directories. You may \
-                      \want to create a package with"
-               , style Shell (flow "stack new")
-               , flow "instead."
-               ]
-          <> blankLine
-          <> fillSep
-               [ flow "Stack will create an empty project. If this is not what \
-                      \you want, please delete the generated"
-               , style File "stack.yaml"
-               , "file."
-               ]
-    relpaths <- mapM prettyPath cabaldirs
-    unless (null relpaths) $
-        prettyInfo $
-               flow "Using the Cabal packages:"
-            <> line
-            <> bulletedList (map (style File . fromString) relpaths)
-            <> line
-
-    -- A package name cannot be empty or missing otherwise it will result in
-    -- Cabal solver failure. Stack requires packages name to match the Cabal
-    -- file name. Just the latter check is enough to cover both the cases.
-    ePackages <- for cabaldirs $ \dir -> do
-        -- Pantry's 'loadCabalFilePath' throws 'MismatchedCabalName' (error
-        -- [S-910]) if the Cabal file name does not match the package it
-        -- defines.
-        (gpdio, _name, cabalfp) <- loadCabalFilePath (Just stackProgName') dir
-        eres <- liftIO $ try (gpdio YesPrintWarnings)
-        case eres :: Either PantryException C.GenericPackageDescription of
-            Right gpd -> pure $ Right (cabalfp, gpd)
-            Left (MismatchedCabalName fp name) -> pure $ Left (fp, name)
-            Left e -> throwIO e
-    let (nameMismatchPkgs, packages) = partitionEithers ePackages
-    when (nameMismatchPkgs /= []) $
-        throwIO $ PrettyException $ PackageNameInvalid nameMismatchPkgs
-
-    let dupGroups = filter ((> 1) . length)
-                            . groupSortOn (gpdPackageName . snd)
-        dupAll    = concat $ dupGroups packages
-
-        -- Among duplicates prefer to include the ones in upper level dirs
-        pathlen     = length . FP.splitPath . toFilePath . fst
-        getmin      = minimumBy (compare `on` pathlen)
-        dupSelected = map getmin (dupGroups packages)
-        dupIgnored  = dupAll \\ dupSelected
-        unique      = packages \\ dupIgnored
-
-    when (dupIgnored /= []) $ do
-        dups <- mapM (mapM (prettyPath. fst)) (dupGroups packages)
-        prettyWarn $
-               flow "The following packages have duplicate package names:"
-            <> line
-            <> foldMap
-                   ( \dup ->    bulletedList (map fromString dup)
-                             <> line
-                   )
-                   dups
-            <> line
-            <> flow "Packages with duplicate names will be ignored. Packages \
-                    \in upper level directories will be preferred."
-            <> line
-
-    pure (Map.fromList
-            $ map (\(file, gpd) -> (gpdPackageName gpd,(file, gpd))) unique
-           , map fst dupIgnored)
-
-prettyPath ::
-       (MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t))
-    => Path r t
-    -> m FilePath
-prettyPath path = do
-    eres <- liftIO $ try $ makeRelativeToCurrentDir path
-    pure $ case eres of
-        Left (_ :: PathException) -> toFilePath path
-        Right res -> toFilePath res
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+-- | Types and functions related to Stack's @init@ command.
+module Stack.Init
+  ( InitOpts (..)
+  , initCmd
+  , initProject
+  ) where
+
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.Foldable as F
+import qualified Data.IntMap as IntMap
+import           Data.List.Extra ( groupSortOn )
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import qualified Data.Yaml as Yaml
+import qualified Distribution.PackageDescription as C
+import qualified Distribution.Text as C
+import qualified Distribution.Version as C
+import           Path
+                   ( PathException, (</>), dirname, filename, parent
+                   , stripProperPrefix
+                   )
+import           Path.Extra ( toFilePathNoTrailingSep )
+import           Path.Find ( findFiles )
+import           Path.IO
+                   ( AnyPath, RelPath, doesFileExist, getCurrentDir
+                   ,  makeRelativeToCurrentDir, resolveDir'
+                   )
+import qualified RIO.FilePath as FP
+import           RIO.List ( (\\), intercalate, isSuffixOf, isPrefixOf )
+import           RIO.List.Partial ( minimumBy )
+import           Stack.BuildPlan
+                   ( BuildPlanCheck (..), checkSnapBuildPlan, deNeededBy
+                   , removeSrcPkgDefaultFlags, selectBestSnapshot
+                   )
+import           Stack.Config ( getSnapshots, makeConcreteResolver )
+import           Stack.Constants ( stackDotYaml, stackProgName' )
+import           Stack.Prelude
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withGlobalProject )
+import           Stack.SourceMap
+                   ( SnapshotCandidate, loadProjectSnapshotCandidate )
+import           Stack.Types.Config ( HasConfig )
+import           Stack.Types.GHCVariant ( HasGHCVariant )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.Runner (Runner, globalOptsL )
+import           Stack.Types.Resolver ( AbstractResolver, Snapshots (..) )
+import           Stack.Types.Version ( stackMajorVersion )
+
+-- | Type representing exceptions thrown by functions exported by the
+-- "Stack.Init" module.
+data InitException
+  = NoPackagesToIgnoreBug
+  deriving (Show, Typeable)
+
+instance Exception InitException where
+  displayException NoPackagesToIgnoreBug = bugReport "[S-2747]"
+    "No packages to ignore."
+
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.Init" module.
+data InitPrettyException
+  = SnapshotDownloadFailure SomeException
+  | ConfigFileAlreadyExists FilePath
+  | PackageNameInvalid [(Path Abs File, PackageName)]
+  | NoMatchingSnapshot !(NonEmpty SnapName)
+  | ResolverMismatch !RawSnapshotLocation String
+  | ResolverPartial !RawSnapshotLocation !String
+  deriving (Show, Typeable)
+
+instance Pretty InitPrettyException where
+  pretty (ConfigFileAlreadyExists reldest) =
+    "[S-8009]"
+    <> line
+    <> flow "Stack declined to create a project-level YAML configuration file."
+    <> blankLine
+    <> fillSep
+         [ flow "The file"
+         , style File (fromString reldest)
+         , "already exists. To overwrite it, pass the flag"
+         , style Shell "--force" <> "."
+         ]
+  pretty (PackageNameInvalid rels) =
+    "[S-5267]"
+    <> line
+    <> flow "Stack did not create project-level YAML configuration, as (like \
+            \Hackage) it requires a Cabal file name to match the package it \
+            \defines."
+    <> blankLine
+    <> flow "Please rename the following Cabal files:"
+    <> line
+    <> bulletedList
+         ( map
+             ( \(fp, name) -> fillSep
+                 [ pretty fp
+                 , "as"
+                 , style
+                     File
+                     (fromString (packageNameString name) <> ".cabal")
+                 ]
+             )
+             rels
+         )
+  pretty (SnapshotDownloadFailure e) =
+    "[S-8332]"
+    <> line
+    <> flow "Stack failed to create project-level YAML configuration, as it \
+            \was unable to download the index of available snapshots."
+    <> blankLine
+    <> fillSep
+         [ flow "This sometimes happens because Certificate Authorities are \
+                \missing on your system. You can try the Stack command again \
+                \or manually create the configuration file. For help about the \
+                \content of Stack's YAML configuration files, see (for the \
+                \most recent release of Stack)"
+         , style
+             Url
+             "http://docs.haskellstack.org/en/stable/yaml_configuration/"
+           <> "."
+         ]
+    <> blankLine
+    <> flow "While downloading the snapshot index, Stack encountered the \
+            \following error:"
+    <> blankLine
+    <> string (displayException e)
+  pretty (NoMatchingSnapshot names) =
+    "[S-1833]"
+    <> line
+    <> flow "None of the following snapshots provides a compiler matching \
+            \your package(s):"
+    <> line
+    <> bulletedList (map (fromString . show) (NonEmpty.toList names))
+    <> blankLine
+    <> resolveOptions
+  pretty (ResolverMismatch resolver errDesc) =
+    "[S-6395]"
+    <> line
+    <> fillSep
+         [ "Snapshot"
+         , style Url (pretty $ PrettyRawSnapshotLocation resolver)
+         , flow "does not have a matching compiler to build some or all of \
+                \your package(s)."
+         ]
+    <> blankLine
+    <> indent 4 (string errDesc)
+    <> line
+    <> resolveOptions
+  pretty (ResolverPartial resolver errDesc) =
+    "[S-2422]"
+    <> line
+    <> fillSep
+         [ "Snapshot"
+         , style Url (pretty $ PrettyRawSnapshotLocation resolver)
+         , flow "does not have all the packages to match your requirements."
+         ]
+    <> blankLine
+    <> indent 4 (string errDesc)
+    <> line
+    <> resolveOptions
+
+resolveOptions :: StyleDoc
+resolveOptions =
+     flow "This may be resolved by:"
+  <> line
+  <> bulletedList
+       [ fillSep
+           [ "Using"
+           , style Shell "--omit-packages"
+           , "to exclude mismatching package(s)."
+           ]
+       , fillSep
+           [ "Using"
+           , style Shell "--resolver"
+           , "to specify a matching snapshot/resolver."
+           ]
+       ]
+
+instance Exception InitPrettyException
+
+-- | Type representing command line options for the @stack init@ command.
+data InitOpts = InitOpts
+  { searchDirs     :: ![T.Text]
+    -- ^ List of sub directories to search for .cabal files
+  , omitPackages   :: Bool
+    -- ^ Exclude conflicting or incompatible user packages
+  , forceOverwrite :: Bool
+    -- ^ Overwrite existing stack.yaml
+  , includeSubDirs :: Bool
+    -- ^ If True, include all .cabal files found in any sub directories
+  }
+
+-- | Function underlying the @stack init@ command. Project initialization.
+initCmd :: InitOpts -> RIO Runner ()
+initCmd initOpts = do
+  pwd <- getCurrentDir
+  go <- view globalOptsL
+  withGlobalProject $
+    withConfig YesReexec (initProject pwd initOpts (globalResolver go))
+
+-- | Generate a @stack.yaml@ file.
+initProject ::
+     (HasConfig env, HasGHCVariant env)
+  => Path Abs Dir
+  -> InitOpts
+  -> Maybe AbstractResolver
+  -> RIO env ()
+initProject currDir initOpts mresolver = do
+  let dest = currDir </> stackDotYaml
+  reldest <- toFilePath <$> makeRelativeToCurrentDir dest
+  exists <- doesFileExist dest
+  when (not (forceOverwrite initOpts) && exists) $
+    prettyThrowIO $ ConfigFileAlreadyExists reldest
+  dirs <- mapM (resolveDir' . T.unpack) (searchDirs initOpts)
+  let find  = findCabalDirs (includeSubDirs initOpts)
+      dirs' = if null dirs then [currDir] else dirs
+  prettyInfo $
+       fillSep
+         [ flow "Looking for Cabal or"
+         , style File "package.yaml"
+         , flow "files to use to initialise Stack's project-level YAML \
+                \configuration file."
+         ]
+    <> line
+  cabaldirs <- Set.toList . Set.unions <$> mapM find dirs'
+  (bundle, dupPkgs)  <- cabalPackagesCheck cabaldirs
+  let makeRelDir dir =
+        case stripProperPrefix currDir dir of
+          Nothing
+              | currDir == dir -> "."
+              | otherwise -> assert False $ toFilePathNoTrailingSep dir
+          Just rel -> toFilePathNoTrailingSep rel
+      fpToPkgDir fp =
+        let absDir = parent fp
+        in  ResolvedPath (RelFilePath $ T.pack $ makeRelDir absDir) absDir
+      pkgDirs = Map.map (fpToPkgDir . fst) bundle
+  (snapshotLoc, flags, extraDeps, rbundle) <-
+    getDefaultResolver initOpts mresolver pkgDirs
+  let ignored = Map.difference bundle rbundle
+      dupPkgMsg
+        | dupPkgs /= [] =
+            "Warning (added by new or init): Some packages were found to have \
+            \names conflicting with others and have been commented out in the \
+            \packages section.\n"
+        | otherwise = ""
+      missingPkgMsg
+        | Map.size ignored > 0 =
+            "Warning (added by new or init): Some packages were found to be \
+            \incompatible with the resolver and have been left commented out \
+            \in the packages section.\n"
+        | otherwise = ""
+      extraDepMsg
+        | Map.size extraDeps > 0 =
+            "Warning (added by new or init): Specified resolver could not \
+            \satisfy all dependencies. Some external packages have been added \
+            \as dependencies.\n"
+        | otherwise = ""
+      makeUserMsg msgs =
+        let msg = concat msgs
+        in  if msg /= ""
+              then
+                   msg
+                <> "You can omit this message by removing it from stack.yaml\n"
+              else ""
+      userMsg = makeUserMsg [dupPkgMsg, missingPkgMsg, extraDepMsg]
+      gpdByDir =
+        Map.fromList [ (parent fp, gpd) | (fp, gpd) <- Map.elems bundle]
+      gpds = Map.elems $
+        Map.mapMaybe (flip Map.lookup gpdByDir . resolvedAbsolute) rbundle
+  deps <- for (Map.toList extraDeps) $ \(n, v) ->
+    PLImmutable . cplComplete <$>
+      completePackageLocation
+        (RPLIHackage (PackageIdentifierRevision n v CFILatest) Nothing)
+  let p = Project
+        { projectUserMsg = if userMsg == "" then Nothing else Just userMsg
+        , projectPackages = resolvedRelative <$> Map.elems rbundle
+        , projectDependencies = map toRawPL deps
+        , projectFlags = removeSrcPkgDefaultFlags gpds flags
+        , projectResolver = snapshotLoc
+        , projectCompiler = Nothing
+        , projectExtraPackageDBs = []
+        , projectCurator = Nothing
+        , projectDropPackages = mempty
+        }
+      makeRel = fmap toFilePath . makeRelativeToCurrentDir
+  prettyInfoL
+    [ flow "Initialising Stack's project-level YAML configuration file \
+           \using snapshot"
+    , pretty (PrettyRawSnapshotLocation snapshotLoc) <> "."
+    ]
+  prettyInfoL $
+    let n = Map.size bundle + length dupPkgs
+    in  [ "Considered"
+        , fromString $ show n
+        , "user"
+        , if n == 1 then "package." else "packages."
+        ]
+  when (dupPkgs /= []) $ do
+    rels <- mapM makeRel dupPkgs
+    prettyWarn $
+         fillSep
+           [ flow "Ignoring these"
+           , fromString $ show (length dupPkgs)
+           , flow "duplicate packages:"
+           ]
+      <> line
+      <> bulletedList (map (style File . fromString) rels)
+  when (Map.size ignored > 0) $ do
+    rels <- mapM makeRel (Map.elems (fmap fst ignored))
+    prettyWarn $
+         fillSep
+           [ flow "Ignoring these"
+           , fromString $ show (Map.size ignored)
+           , flow "packages due to dependency conflicts:"
+           ]
+      <> line
+      <> bulletedList (map (style File . fromString) rels)
+  when (Map.size extraDeps > 0) $
+    prettyWarnL
+      [ fromString $ show (Map.size extraDeps)
+      , flow "external dependencies were added."
+      ]
+  prettyInfoL
+    [ flow $ if exists
+        then "Overwriting existing configuration file"
+        else "Writing configuration to"
+    , style File (fromString reldest) <> "."
+    ]
+  writeBinaryFileAtomic dest $ renderStackYaml p
+    (Map.elems $ fmap (makeRelDir . parent . fst) ignored)
+    (map (makeRelDir . parent) dupPkgs)
+  prettyInfoS
+    "Stack's project-level YAML configuration file has been initialised."
+
+-- | Render a stack.yaml file with comments, see:
+-- https://github.com/commercialhaskell/stack/issues/226
+renderStackYaml :: Project -> [FilePath] -> [FilePath] -> B.Builder
+renderStackYaml p ignoredPackages dupPackages =
+  case Yaml.toJSON p of
+    Yaml.Object o -> renderObject o
+    _ -> assert False $ B.byteString $ Yaml.encode p
+ where
+  renderObject o =
+       B.byteString headerHelp
+    <> B.byteString "\n\n"
+    <> F.foldMap (goComment o) comments
+    <> goOthers (o `KeyMap.difference` KeyMap.fromList comments)
+    <> B.byteString footerHelp
+    <> "\n"
+  goComment o (name, comment) =
+    case (convert <$> KeyMap.lookup name o) <|> nonPresentValue name of
+      Nothing -> assert (name == "user-message") mempty
+      Just v ->
+        B.byteString comment <>
+        B.byteString "\n" <>
+        v <>
+        if name == "packages" then commentedPackages else "" <>
+        B.byteString "\n"
+   where
+    convert v = B.byteString (Yaml.encode $ Yaml.object [(name, v)])
+
+    -- Some fields in stack.yaml are optional and may not be
+    -- generated. For these, we provided commented out dummy
+    -- values to go along with the comments.
+    nonPresentValue "extra-deps" = Just "# extra-deps: []\n"
+    nonPresentValue "flags" = Just "# flags: {}\n"
+    nonPresentValue "extra-package-dbs" = Just "# extra-package-dbs: []\n"
+    nonPresentValue _ = Nothing
+
+  commentLine l | null l = "#"
+                | otherwise = "# " ++ l
+  commentHelp = BC.pack .  intercalate "\n" . map commentLine
+  commentedPackages =
+    let ignoredComment = commentHelp
+          [ "The following packages have been ignored due to incompatibility with the"
+          , "resolver compiler, dependency conflicts with other packages"
+          , "or unsatisfied dependencies."
+          ]
+        dupComment = commentHelp
+          [ "The following packages have been ignored due to package name conflict "
+          , "with other packages."
+          ]
+    in  commentPackages ignoredComment ignoredPackages
+        <> commentPackages dupComment dupPackages
+  commentPackages comment pkgs
+    | pkgs /= [] =
+           B.byteString comment
+        <> B.byteString "\n"
+        <> B.byteString (BC.pack $ concat
+             $ map (\x -> "#- " ++ x ++ "\n") pkgs ++ ["\n"])
+    | otherwise = ""
+  goOthers o
+    | KeyMap.null o = mempty
+    | otherwise = assert False $ B.byteString $ Yaml.encode o
+  -- Per Section Help
+  comments =
+    [ ("user-message"     , userMsgHelp)
+    , ("resolver"         , resolverHelp)
+    , ("packages"         , packageHelp)
+    , ("extra-deps"       , extraDepsHelp)
+    , ("flags"            , "# Override default flag values for local packages and extra-deps")
+    , ("extra-package-dbs", "# Extra package databases containing global packages")
+    ]
+  -- Help strings
+  headerHelp = commentHelp
+    [ "This file was automatically generated by 'stack init'"
+    , ""
+    , "Some commonly used options have been documented as comments in this file."
+    , "For advanced use and comprehensive documentation of the format, please see:"
+    , "https://docs.haskellstack.org/en/stable/yaml_configuration/"
+    ]
+  resolverHelp = commentHelp
+    [ "Resolver to choose a 'specific' stackage snapshot or a compiler version."
+    , "A snapshot resolver dictates the compiler version and the set of packages"
+    , "to be used for project dependencies. For example:"
+    , ""
+    , "resolver: lts-3.5"
+    , "resolver: nightly-2015-09-21"
+    , "resolver: ghc-7.10.2"
+    , ""
+    , "The location of a snapshot can be provided as a file or url. Stack assumes"
+    , "a snapshot provided as a file might change, whereas a url resource does not."
+    , ""
+    , "resolver: ./custom-snapshot.yaml"
+    , "resolver: https://example.com/snapshots/2018-01-01.yaml"
+    ]
+  userMsgHelp = commentHelp
+    [ "A warning or info to be displayed to the user on config load." ]
+  packageHelp = commentHelp
+    [ "User packages to be built."
+    , "Various formats can be used as shown in the example below."
+    , ""
+    , "packages:"
+    , "- some-directory"
+    , "- https://example.com/foo/bar/baz-0.0.2.tar.gz"
+    , "  subdirs:"
+    , "  - auto-update"
+    , "  - wai"
+    ]
+  extraDepsHelp = commentHelp
+    [ "Dependency packages to be pulled from upstream that are not in the resolver."
+    , "These entries can reference officially published versions as well as"
+    , "forks / in-progress versions pinned to a git hash. For example:"
+    , ""
+    , "extra-deps:"
+    , "- acme-missiles-0.3"
+    , "- git: https://github.com/commercialhaskell/stack.git"
+    , "  commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a"
+    , ""
+    ]
+  footerHelp = commentHelp
+    [ "Control whether we use the GHC we find on the path"
+    , "system-ghc: true"
+    , ""
+    , "Require a specific version of Stack, using version ranges"
+    , "require-stack-version: -any # Default"
+    , "require-stack-version: \""
+      ++ C.display (C.orLaterVersion stackMajorVersion) ++ "\""
+    , ""
+    , "Override the architecture used by Stack, especially useful on Windows"
+    , "arch: i386"
+    , "arch: x86_64"
+    , ""
+    , "Extra directories used by Stack for building"
+    , "extra-include-dirs: [/path/to/dir]"
+    , "extra-lib-dirs: [/path/to/dir]"
+    , ""
+    , "Allow a newer minor version of GHC than the snapshot specifies"
+    , "compiler-check: newer-minor"
+    ]
+
+getSnapshots' :: HasConfig env => RIO env Snapshots
+getSnapshots' = catchAny
+  getSnapshots
+  (prettyThrowIO . SnapshotDownloadFailure)
+
+-- | Get the default resolver value
+getDefaultResolver ::
+     (HasConfig env, HasGHCVariant env)
+  => InitOpts
+  -> Maybe AbstractResolver
+  -> Map PackageName (ResolvedPath Dir)
+  -- ^ Src package name: cabal dir
+  -> RIO env
+       ( RawSnapshotLocation
+       , Map PackageName (Map FlagName Bool)
+       , Map PackageName Version
+       , Map PackageName (ResolvedPath Dir))
+     -- ^ ( Resolver
+     --   , Flags for src packages and extra deps
+     --   , Extra dependencies
+     --   , Src packages actually considered)
+getDefaultResolver initOpts mresolver pkgDirs = do
+  (candidate, loc) <- case mresolver of
+    Nothing -> selectSnapResolver
+    Just ar -> do
+      sl <- makeConcreteResolver ar
+      c <- loadProjectSnapshotCandidate sl NoPrintWarnings False
+      pure (c, sl)
+  getWorkingResolverPlan initOpts pkgDirs candidate loc
+ where
+  -- TODO support selecting best across regular and custom snapshots
+  selectSnapResolver = do
+    snaps <- fmap getRecommendedSnapshots getSnapshots'
+    (c, l, r) <- selectBestSnapshot (Map.elems pkgDirs) snaps
+    case r of
+      BuildPlanCheckFail {} | not (omitPackages initOpts)
+              -> prettyThrowM $ NoMatchingSnapshot snaps
+      _ -> pure (c, l)
+
+getWorkingResolverPlan ::
+     (HasConfig env, HasGHCVariant env)
+  => InitOpts
+  -> Map PackageName (ResolvedPath Dir)
+  -- ^ Src packages: cabal dir
+  -> SnapshotCandidate env
+  -> RawSnapshotLocation
+  -> RIO env
+       ( RawSnapshotLocation
+       , Map PackageName (Map FlagName Bool)
+       , Map PackageName Version
+       , Map PackageName (ResolvedPath Dir))
+     -- ^ ( SnapshotDef
+     --   , Flags for src packages and extra deps
+     --   , Extra dependencies
+     --   , Src packages actually considered)
+getWorkingResolverPlan initOpts pkgDirs0 snapCandidate snapLoc = do
+  prettyInfoL
+    [ flow "Selected the snapshot"
+    , pretty (PrettyRawSnapshotLocation snapLoc) <> "."
+    ]
+  go pkgDirs0
+ where
+  go pkgDirs = do
+    eres <- checkBundleResolver initOpts snapLoc snapCandidate (Map.elems pkgDirs)
+    -- if some packages failed try again using the rest
+    case eres of
+      Right (f, edeps)-> pure (snapLoc, f, edeps, pkgDirs)
+      Left ignored
+        | Map.null available -> do
+            prettyWarnS
+              "Could not find a working plan for any of the user packages. \
+              \Proceeding to create a YAML configuration file anyway."
+            pure (snapLoc, Map.empty, Map.empty, Map.empty)
+        | otherwise -> do
+            when (Map.size available == Map.size pkgDirs) $
+              throwM NoPackagesToIgnoreBug
+            if length ignored > 1
+              then
+                prettyWarn
+                  (  flow "Ignoring the following packages:"
+                  <> line
+                  <> bulletedList
+                       (map (fromString . packageNameString) ignored)
+                  )
+              else
+                prettyWarnL
+                  [ flow "Ignoring package:"
+                  , fromString
+                      ( case ignored of
+                          [] -> throwM NoPackagesToIgnoreBug
+                          x:_ -> packageNameString x
+                      )
+                  ]
+            go available
+       where
+        isAvailable k _ = k `notElem` ignored
+        available       = Map.filterWithKey isAvailable pkgDirs
+
+checkBundleResolver ::
+     (HasConfig env, HasGHCVariant env)
+  => InitOpts
+  -> RawSnapshotLocation
+  -> SnapshotCandidate env
+  -> [ResolvedPath Dir]
+  -- ^ Src package dirs
+  -> RIO env
+       (Either [PackageName] ( Map PackageName (Map FlagName Bool)
+                             , Map PackageName Version))
+checkBundleResolver initOpts snapshotLoc snapCandidate pkgDirs = do
+  result <- checkSnapBuildPlan pkgDirs Nothing snapCandidate
+  case result of
+    BuildPlanCheckOk f -> pure $ Right (f, Map.empty)
+    BuildPlanCheckPartial _f e -> do -- FIXME:qrilka unused f
+      if omitPackages initOpts
+        then do
+          warnPartial result
+          prettyWarnS "Omitting packages with unsatisfied dependencies"
+          pure $ Left $ failedUserPkgs e
+        else
+          prettyThrowM $ ResolverPartial snapshotLoc (show result)
+    BuildPlanCheckFail _ e _
+      | omitPackages initOpts -> do
+          prettyWarn $
+               fillSep
+                 [ "Resolver compiler mismatch:"
+                 , style Current (fromString . T.unpack $ textDisplay snapshotLoc)
+                 ]
+            <> line
+            <> indent 4 (string $ show result)
+          pure $ Left $ failedUserPkgs e
+      | otherwise -> prettyThrowM $ ResolverMismatch snapshotLoc (show result)
+ where
+  warnPartial res = do
+    prettyWarn $
+         fillSep
+           [ "Resolver"
+           , style Current (fromString . T.unpack $ textDisplay snapshotLoc)
+           , flow "will need external packages:"
+           ]
+      <> line
+      <> indent 4 (string $ show res)
+
+  failedUserPkgs e = Map.keys $ Map.unions (Map.elems (fmap deNeededBy e))
+
+getRecommendedSnapshots :: Snapshots -> NonEmpty SnapName
+getRecommendedSnapshots snapshots =
+  -- in order - Latest LTS, Latest Nightly, all LTS most recent first
+  case NonEmpty.nonEmpty supportedLtss of
+    Just (mostRecent :| older) -> mostRecent :| (nightly : older)
+    Nothing -> nightly :| []
+ where
+  ltss = map (uncurry LTS) (IntMap.toDescList $ snapshotsLts snapshots)
+  supportedLtss = filter (>= minSupportedLts) ltss
+  nightly = Nightly (snapshotsNightly snapshots)
+
+-- |Yields the minimum LTS supported by Stack.
+minSupportedLts :: SnapName
+-- See https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md
+-- under Stack version 2.1.1.
+minSupportedLts = LTS 3 0
+
+findCabalDirs ::
+     HasConfig env
+  => Bool -> Path Abs Dir -> RIO env (Set (Path Abs Dir))
+findCabalDirs recurse dir =
+  Set.fromList . map parent
+  <$> liftIO (findFiles dir isHpackOrCabal subdirFilter)
+ where
+  subdirFilter subdir = recurse && not (isIgnored subdir)
+  isHpack = (== "package.yaml")     . toFilePath . filename
+  isCabal = (".cabal" `isSuffixOf`) . toFilePath
+  isHpackOrCabal x = isHpack x || isCabal x
+  isIgnored path = "." `isPrefixOf` dirName || dirName `Set.member` ignoredDirs
+   where
+    dirName = FP.dropTrailingPathSeparator (toFilePath (dirname path))
+
+-- | Special directories that we don't want to traverse for .cabal files
+ignoredDirs :: Set FilePath
+ignoredDirs = Set.fromList ["dist"]
+
+cabalPackagesCheck ::
+     (HasConfig env, HasGHCVariant env)
+  => [Path Abs Dir]
+  -> RIO env
+       ( Map PackageName (Path Abs File, C.GenericPackageDescription)
+       , [Path Abs File]
+       )
+cabalPackagesCheck cabaldirs = do
+  when (null cabaldirs) $
+    prettyWarn $
+         fillSep
+           [ flow "Stack did not find any local package directories. You may \
+                  \want to create a package with"
+           , style Shell (flow "stack new")
+           , flow "instead."
+           ]
+      <> blankLine
+      <> fillSep
+           [ flow "Stack will create an empty project. If this is not what \
+                  \you want, please delete the generated"
+           , style File "stack.yaml"
+           , "file."
+           ]
+  relpaths <- mapM prettyPath cabaldirs
+  unless (null relpaths) $
+    prettyInfo $
+         flow "Using the Cabal packages:"
+      <> line
+      <> bulletedList (map (style File . fromString) relpaths)
+      <> line
+  -- A package name cannot be empty or missing otherwise it will result in
+  -- Cabal solver failure. Stack requires packages name to match the Cabal
+  -- file name. Just the latter check is enough to cover both the cases.
+  ePackages <- for cabaldirs $ \dir -> do
+    -- Pantry's 'loadCabalFilePath' throws 'MismatchedCabalName' (error
+    -- [S-910]) if the Cabal file name does not match the package it
+    -- defines.
+    (gpdio, _name, cabalfp) <- loadCabalFilePath (Just stackProgName') dir
+    eres <- liftIO $ try (gpdio YesPrintWarnings)
+    case eres :: Either PantryException C.GenericPackageDescription of
+      Right gpd -> pure $ Right (cabalfp, gpd)
+      Left (MismatchedCabalName fp name) -> pure $ Left (fp, name)
+      Left e -> throwIO e
+  let (nameMismatchPkgs, packages) = partitionEithers ePackages
+  when (nameMismatchPkgs /= []) $
+    prettyThrowIO $ PackageNameInvalid nameMismatchPkgs
+  let dupGroups = filter ((> 1) . length)
+                          . groupSortOn (gpdPackageName . snd)
+      dupAll    = concat $ dupGroups packages
+      -- Among duplicates prefer to include the ones in upper level dirs
+      pathlen     = length . FP.splitPath . toFilePath . fst
+      getmin      = minimumBy (compare `on` pathlen)
+      dupSelected = map getmin (dupGroups packages)
+      dupIgnored  = dupAll \\ dupSelected
+      unique      = packages \\ dupIgnored
+  when (dupIgnored /= []) $ do
+    dups <- mapM (mapM (prettyPath. fst)) (dupGroups packages)
+    prettyWarn $
+         flow "The following packages have duplicate package names:"
+      <> line
+      <> foldMap
+           ( \dup ->    bulletedList (map fromString dup)
+                     <> line
+           )
+           dups
+      <> line
+      <> flow "Packages with duplicate names will be ignored. Packages \
+              \in upper level directories will be preferred."
+      <> line
+  pure (Map.fromList
+          $ map (\(file, gpd) -> (gpdPackageName gpd,(file, gpd))) unique
+         , map fst dupIgnored)
+
+prettyPath ::
+     (MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t))
+  => Path r t
+  -> m FilePath
+prettyPath path = do
+  eres <- liftIO $ try $ makeRelativeToCurrentDir path
+  pure $ case eres of
+    Left (_ :: PathException) -> toFilePath path
+    Right res -> toFilePath res
+ src/Stack/Internal/BuildInfo.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE CPP               #-}
+
+#ifdef USE_GIT_INFO
+{-# LANGUAGE TemplateHaskell   #-}
+#endif
+
+module Stack.Internal.BuildInfo
+  ( maybeGitHash
+  ) where
+
+#ifdef USE_GIT_INFO
+import           GitHash ( giHash, tGitInfoCwdTry )
+#endif
+import           Stack.Prelude
+
+-- | If USE_GIT_INFO is enabled, the Git hash in the build directory, otherwise
+-- Nothing.
+maybeGitHash :: Maybe String
+maybeGitHash =
+#ifdef USE_GIT_INFO
+  (either (const Nothing) (Just . giHash) $$tGitInfoCwdTry)
+#else
+  Nothing
+#endif
src/Stack/List.hs view
@@ -1,81 +1,112 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
+-- | Types and functions related to Stack's @list@ command.
 module Stack.List
-  ( listPackages
+  ( listCmd
+  , listPackages
   ) where
 
+import           Pantry ( loadSnapshot )
 import           RIO.List ( intercalate )
 import qualified RIO.Map as Map
 import           RIO.Process ( HasProcessContext )
+import           Stack.Config ( makeConcreteResolver )
 import           Stack.Prelude
+import           Stack.Runners ( ShouldReexec (..), withConfig )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Runner ( Runner, globalOptsL )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.List" module.
 newtype ListException
   = CouldNotParsePackageSelectors [String]
-    deriving (Show, Typeable)
+  deriving (Show, Typeable)
 
 instance Exception ListException where
-    displayException (CouldNotParsePackageSelectors strs) = unlines $
-        "Error: [S-4926]"
-        : map ("- " ++) strs
+  displayException (CouldNotParsePackageSelectors strs) = unlines $
+    "Error: [S-4926]"
+    : map ("- " ++) strs
 
+-- | Function underlying the @stack list@ command. List packages.
+listCmd :: [String] -> RIO Runner ()
+listCmd names = withConfig NoReexec $ do
+  mresolver <- view $ globalOptsL.to globalResolver
+  mSnapshot <- forM mresolver $ \resolver -> do
+    concrete <- makeConcreteResolver resolver
+    loc <- completeSnapshotLocation concrete
+    loadSnapshot loc
+  listPackages mSnapshot names
+
 -- | Intended to work for the command line command.
-listPackages
-  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => Maybe RawSnapshot -- ^ when looking up by name, take from this build plan
-  -> [String] -- ^ names or identifiers
+listPackages ::
+     forall env. (HasPantryConfig env, HasProcessContext env, HasTerm env)
+  => Maybe RawSnapshot
+     -- ^ When looking up by name, take from this build plan.
+  -> [String]
+     -- ^ Names or identifiers.
   -> RIO env ()
 listPackages mSnapshot input = do
-    let (errs1, names) = case mSnapshot of
-                   Just snapshot | null input ->
-                                     ([], Map.keys (rsPackages snapshot))
-                   _ -> partitionEithers $ map parse input
-    (errs2, locs) <- partitionEithers <$> traverse toLoc names
-    case errs1 ++ errs2 of
-      [] -> pure ()
-      errs -> throwM $ CouldNotParsePackageSelectors errs
-    mapM_ (logInfo . fromString . packageIdentifierString) locs
-  where
-    toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot
-          | otherwise = toLocNoSnapshot
+  let (errs1, names) = case mSnapshot of
+        Just snapshot | null input -> ([], Map.keys (rsPackages snapshot))
+        _ -> partitionEithers $ map parse input
+  (errs2, locs) <- partitionEithers <$> traverse toLoc names
+  case errs1 ++ errs2 of
+    [] -> pure ()
+    errs -> throwM $ CouldNotParsePackageSelectors errs
+  mapM_ (prettyInfo . fromString . packageIdentifierString) locs
+ where
+  toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot
+        | otherwise = toLocNoSnapshot
 
-    toLocNoSnapshot :: PackageName -> RIO env (Either String PackageIdentifier)
-    toLocNoSnapshot name = do
-      mloc1 <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
-      mloc <-
-        case mloc1 of
-          Just _ -> pure mloc1
-          Nothing -> do
-            updated <- updateHackageIndex $ Just $ "Could not find package " <> fromString (packageNameString name) <> ", updating"
-            case updated of
-              UpdateOccurred -> getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
-              NoUpdateOccurred -> pure Nothing
-      case mloc of
+  toLocNoSnapshot :: PackageName -> RIO env (Either String PackageIdentifier)
+  toLocNoSnapshot name = do
+    mloc1 <-
+      getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
+    mloc <-
+      case mloc1 of
+        Just _ -> pure mloc1
         Nothing -> do
-          candidates <- getHackageTypoCorrections name
-          pure $ Left $ concat
-            [ "Could not find package "
-            , packageNameString name
-            , " on Hackage"
-            , if null candidates
-                then ""
-                else ". Perhaps you meant: " ++ intercalate ", " (map packageNameString candidates)
-            ]
-        Just loc -> pure $ Right (packageLocationIdent loc)
+          updated <-
+            updateHackageIndex $ Just $
+                 "Could not find package "
+              <> fromString (packageNameString name)
+              <> ", updating"
+          case updated of
+            UpdateOccurred ->
+              getLatestHackageLocation
+                YesRequireHackageIndex
+                name
+                UsePreferredVersions
+            NoUpdateOccurred -> pure Nothing
+    case mloc of
+      Nothing -> do
+        candidates <- getHackageTypoCorrections name
+        pure $ Left $ concat
+          [ "Could not find package "
+          , packageNameString name
+          , " on Hackage"
+          , if null candidates
+              then ""
+              else ". Perhaps you meant: " ++
+                     intercalate ", " (map packageNameString candidates)
+          ]
+      Just loc -> pure $ Right (packageLocationIdent loc)
 
-    toLocSnapshot :: RawSnapshot -> PackageName -> RIO env (Either String PackageIdentifier)
-    toLocSnapshot snapshot name =
-        case Map.lookup name (rsPackages snapshot) of
-          Nothing ->
-            pure $ Left $ "Package does not appear in snapshot: " ++ packageNameString name
-          Just sp -> do
-            loc <- cplComplete <$> completePackageLocation (rspLocation sp)
-            pure $ Right (packageLocationIdent loc)
+  toLocSnapshot ::
+       RawSnapshot
+    -> PackageName
+    -> RIO env (Either String PackageIdentifier)
+  toLocSnapshot snapshot name =
+    case Map.lookup name (rsPackages snapshot) of
+      Nothing ->
+        pure $ Left $
+          "Package does not appear in snapshot: " ++ packageNameString name
+      Just sp -> do
+        loc <- cplComplete <$> completePackageLocation (rspLocation sp)
+        pure $ Right (packageLocationIdent loc)
 
-    parse s =
-        case parsePackageName s of
-            Just x -> Right x
-            Nothing -> Left $ "Could not parse as package name or identifier: " ++ s
+  parse s =
+    case parsePackageName s of
+      Just x -> Right x
+      Nothing -> Left $ "Could not parse as package name or identifier: " ++ s
src/Stack/Lock.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
@@ -16,152 +14,177 @@ import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), ToJSON, Value, WithJSONWarnings (..), (.=)
+                   , (..:), jsonSubWarnings, jsonSubWarningsT, logJSONWarnings
+                   , object
+                   , withObjectWarnings
+                   )
 import           Path ( parent )
 import           Path.Extended ( addExtension )
 import           Path.IO ( doesFileExist )
 import           Stack.Prelude
-import           Stack.SourceMap
-import           Stack.Types.Config
-import           Stack.Types.SourceMap
+import           Stack.SourceMap ( snapToDepPackage )
+import           Stack.Types.Config.Exception ( ConfigPrettyException (..) )
+import           Stack.Types.LockFileBehavior ( LockFileBehavior (..) )
+import           Stack.Types.Runner ( HasRunner, lockFileBehaviorL, rslInLogL )
+import           Stack.Types.SourceMap ( DepPackage, SMWanted )
 
--- | Type representing exceptions thrown by functions exported by the
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
 -- "Stack.Lock" module.
-data LockException
-    = WritingLockFileError (Path Abs File) Locked
-    deriving (Show, Typeable)
+data LockPrettyException
+  = WritingLockFileError (Path Abs File) Locked
+  deriving (Show, Typeable)
 
-instance Exception LockException where
-    displayException (WritingLockFileError lockFile newLocked) = unlines
-        [ "Error: [S-1353]"
-        , "You indicated that Stack should error out on writing a lock file"
-        , "Stack just tried to write the following lock file contents to "
-          ++ toFilePath lockFile
-        , T.unpack $ decodeUtf8With lenientDecode $ Yaml.encode newLocked
-        ]
+instance Pretty LockPrettyException where
+  pretty (WritingLockFileError lockFile newLocked) =
+    "[S-1353]"
+    <> line
+    <> flow "Stack is configured to report an error on writing a lock file."
+    <> blankLine
+    <> fillSep
+         [ flow "Stack just tried to write the following lock file content to"
+         , pretty lockFile <> ":"
+         ]
+    <> blankLine
+    <> string newLocked'
+   where
+    newLocked' = T.unpack . decodeUtf8With lenientDecode $ Yaml.encode newLocked
 
+instance Exception LockPrettyException
+
 data LockedLocation a b = LockedLocation
-    { llOriginal :: a
-    , llCompleted :: b
-    } deriving (Eq, Show)
+  { llOriginal :: a
+  , llCompleted :: b
+  }
+  deriving (Eq, Show)
 
 instance (ToJSON a, ToJSON b) => ToJSON (LockedLocation a b) where
-    toJSON ll =
-        object [ "original" .= llOriginal ll, "completed" .= llCompleted ll ]
+  toJSON ll =
+      object [ "original" .= llOriginal ll, "completed" .= llCompleted ll ]
 
 instance ( FromJSON (WithJSONWarnings (Unresolved a))
          , FromJSON (WithJSONWarnings (Unresolved b))
          ) =>
          FromJSON (WithJSONWarnings (Unresolved (LockedLocation a b))) where
-    parseJSON =
-        withObjectWarnings "LockedLocation" $ \o -> do
-            original <- jsonSubWarnings $ o ..: "original"
-            completed <- jsonSubWarnings $ o ..: "completed"
-            pure $ LockedLocation <$> original <*> completed
+  parseJSON =
+    withObjectWarnings "LockedLocation" $ \o -> do
+      original <- jsonSubWarnings $ o ..: "original"
+      completed <- jsonSubWarnings $ o ..: "completed"
+      pure $ LockedLocation <$> original <*> completed
 
 -- Special wrapper extracting only 1 RawPackageLocationImmutable
 -- serialization should not produce locations with multiple subdirs
 -- so we should be OK using just a head element
-newtype SingleRPLI = SingleRPLI { unSingleRPLI :: RawPackageLocationImmutable}
+newtype SingleRPLI
+  = SingleRPLI { unSingleRPLI :: RawPackageLocationImmutable}
 
 instance FromJSON (WithJSONWarnings (Unresolved SingleRPLI)) where
-   parseJSON v =
-     do
-       WithJSONWarnings unresolvedRPLIs ws <- parseJSON v
-       let withWarnings x = WithJSONWarnings x ws
-       pure $ withWarnings $ SingleRPLI . NE.head <$> unresolvedRPLIs
+  parseJSON v =
+    do
+      WithJSONWarnings unresolvedRPLIs ws <- parseJSON v
+      let withWarnings x = WithJSONWarnings x ws
+      pure $ withWarnings $ SingleRPLI . NE.head <$> unresolvedRPLIs
 
 data Locked = Locked
-    { lckSnapshotLocations :: [LockedLocation RawSnapshotLocation SnapshotLocation]
-    , lckPkgImmutableLocations :: [LockedLocation RawPackageLocationImmutable PackageLocationImmutable]
-    } deriving (Eq, Show)
+  { lckSnapshotLocations :: [LockedLocation RawSnapshotLocation SnapshotLocation]
+  , lckPkgImmutableLocations :: [LockedLocation RawPackageLocationImmutable PackageLocationImmutable]
+  }
+  deriving (Eq, Show)
 
 instance ToJSON Locked where
-    toJSON Locked {..} =
-        object
-            [ "snapshots" .= lckSnapshotLocations
-            , "packages" .= lckPkgImmutableLocations
-            ]
+  toJSON Locked {..} =
+    object
+      [ "snapshots" .= lckSnapshotLocations
+      , "packages" .= lckPkgImmutableLocations
+      ]
 
 instance FromJSON (WithJSONWarnings (Unresolved Locked)) where
-    parseJSON = withObjectWarnings "Locked" $ \o -> do
-      snapshots <- jsonSubWarningsT $ o ..: "snapshots"
-      packages <- jsonSubWarningsT $ o ..: "packages"
-      let unwrap ll = ll { llOriginal = unSingleRPLI (llOriginal ll) }
-      pure $ Locked <$> sequenceA snapshots <*> (map unwrap <$> sequenceA packages)
+  parseJSON = withObjectWarnings "Locked" $ \o -> do
+    snapshots <- jsonSubWarningsT $ o ..: "snapshots"
+    packages <- jsonSubWarningsT $ o ..: "packages"
+    let unwrap ll = ll { llOriginal = unSingleRPLI (llOriginal ll) }
+    pure $ Locked <$> sequenceA snapshots <*> (map unwrap <$> sequenceA packages)
 
-loadYamlThrow
-    :: HasLogFunc env
-    => (Value -> Yaml.Parser (WithJSONWarnings a)) -> Path Abs File -> RIO env a
+loadYamlThrow ::
+     HasLogFunc env
+  => (Value -> Yaml.Parser (WithJSONWarnings a))
+  -> Path Abs File
+  -> RIO env a
 loadYamlThrow parser path = do
-    eVal <- liftIO $ Yaml.decodeFileEither (toFilePath path)
-    case eVal of
-        Left parseException -> throwIO $
-            ParseConfigFileException path parseException
-        Right val -> case Yaml.parseEither parser val of
-            Left err -> throwIO $ Yaml.AesonException err
-            Right (WithJSONWarnings res warnings) -> do
-                logJSONWarnings (toFilePath path) warnings
-                pure res
+  eVal <- liftIO $ Yaml.decodeFileEither (toFilePath path)
+  case eVal of
+    Left parseException -> throwIO $
+      ParseConfigFileException path parseException
+    Right val -> case Yaml.parseEither parser val of
+      Left err -> throwIO $ Yaml.AesonException err
+      Right (WithJSONWarnings res warnings) -> do
+        logJSONWarnings (toFilePath path) warnings
+        pure res
 
 lockCachedWanted ::
-       (HasPantryConfig env, HasRunner env)
-    => Path Abs File
-    -> RawSnapshotLocation
-    -> (Map RawPackageLocationImmutable PackageLocationImmutable
-        -> WantedCompiler
-        -> Map PackageName (Bool -> RIO env DepPackage)
-        -> RIO env ( SMWanted, [CompletedPLI]))
-    -> RIO env SMWanted
+     (HasPantryConfig env, HasRunner env)
+  => Path Abs File
+  -> RawSnapshotLocation
+  -> (  Map RawPackageLocationImmutable PackageLocationImmutable
+     -> WantedCompiler
+     -> Map PackageName (Bool -> RIO env DepPackage)
+     -> RIO env ( SMWanted, [CompletedPLI])
+     )
+  -> RIO env SMWanted
 lockCachedWanted stackFile resolver fillWanted = do
-    lockFile <- liftIO $ addExtension ".lock" stackFile
-    let getLockExists = doesFileExist lockFile
-    lfb <- view lockFileBehaviorL
-    readLockFile <-
-      case lfb of
-        LFBIgnore -> pure False
-        LFBReadWrite -> getLockExists
-        LFBReadOnly -> getLockExists
-        LFBErrorOnWrite -> getLockExists
-    locked <-
-        if readLockFile
-        then do
-            logDebug "Using package location completions from a lock file"
-            unresolvedLocked <- loadYamlThrow parseJSON lockFile
-            resolvePaths (Just $ parent stackFile) unresolvedLocked
-        else do
-            logDebug "Not reading lock file"
-            pure $ Locked [] []
-    let toMap :: Ord a => [LockedLocation a b] -> Map a b
-        toMap =  Map.fromList . map (\ll -> (llOriginal ll, llCompleted ll))
-        slocCache = toMap $ lckSnapshotLocations locked
-        pkgLocCache = toMap $ lckPkgImmutableLocations locked
-    debugRSL <- view rslInLogL
-    (snap, slocCompleted, pliCompleted) <-
-        loadAndCompleteSnapshotRaw' debugRSL resolver slocCache pkgLocCache
-    let compiler = snapshotCompiler snap
-        snPkgs = Map.mapWithKey (\n p h -> snapToDepPackage h n p) (snapshotPackages snap)
-    (wanted, prjCompleted) <- fillWanted pkgLocCache compiler snPkgs
-    let lockLocations = map (\(CompletedPLI r c) -> LockedLocation r c)
-        differentSnapLocs (CompletedSL raw complete)
-          | raw == toRawSL complete = Nothing
-          | otherwise = Just $ LockedLocation raw complete
-        newLocked = Locked { lckSnapshotLocations = mapMaybe differentSnapLocs slocCompleted
-                           , lckPkgImmutableLocations =
-                             lockLocations $ pliCompleted <> prjCompleted
-                           }
-    when (newLocked /= locked) $ do
-      case lfb of
-        LFBReadWrite ->
-          writeBinaryFileAtomic lockFile $
-            header <>
-            byteString (Yaml.encode newLocked)
-        LFBErrorOnWrite -> throwIO $ WritingLockFileError lockFile newLocked
-        LFBIgnore -> pure ()
-        LFBReadOnly -> pure ()
-    pure wanted
-  where
-    header =
-      "# This file was autogenerated by Stack.\n\
-      \# You should not edit this file by hand.\n\
-      \# For more information, please see the documentation at:\n\
-      \#   https://docs.haskellstack.org/en/stable/lock_files\n\n"
+  lockFile <- liftIO $ addExtension ".lock" stackFile
+  let getLockExists = doesFileExist lockFile
+  lfb <- view lockFileBehaviorL
+  readLockFile <-
+    case lfb of
+      LFBIgnore -> pure False
+      LFBReadWrite -> getLockExists
+      LFBReadOnly -> getLockExists
+      LFBErrorOnWrite -> getLockExists
+  locked <-
+    if readLockFile
+    then do
+      logDebug "Using package location completions from a lock file"
+      unresolvedLocked <- loadYamlThrow parseJSON lockFile
+      resolvePaths (Just $ parent stackFile) unresolvedLocked
+    else do
+      logDebug "Not reading lock file"
+      pure $ Locked [] []
+  let toMap :: Ord a => [LockedLocation a b] -> Map a b
+      toMap =  Map.fromList . map (llOriginal &&& llCompleted)
+      slocCache = toMap $ lckSnapshotLocations locked
+      pkgLocCache = toMap $ lckPkgImmutableLocations locked
+  debugRSL <- view rslInLogL
+  (snap, slocCompleted, pliCompleted) <-
+    loadAndCompleteSnapshotRaw' debugRSL resolver slocCache pkgLocCache
+  let compiler = snapshotCompiler snap
+      snPkgs = Map.mapWithKey
+                 (\n p h -> snapToDepPackage h n p)
+                 (snapshotPackages snap)
+  (wanted, prjCompleted) <- fillWanted pkgLocCache compiler snPkgs
+  let lockLocations = map (\(CompletedPLI r c) -> LockedLocation r c)
+      differentSnapLocs (CompletedSL raw complete)
+        | raw == toRawSL complete = Nothing
+        | otherwise = Just $ LockedLocation raw complete
+      newLocked = Locked
+        { lckSnapshotLocations = mapMaybe differentSnapLocs slocCompleted
+        , lckPkgImmutableLocations =
+          lockLocations $ pliCompleted <> prjCompleted
+        }
+  when (newLocked /= locked) $
+    case lfb of
+      LFBReadWrite ->
+        writeBinaryFileAtomic lockFile $
+          header <>
+          byteString (Yaml.encode newLocked)
+      LFBErrorOnWrite ->
+        prettyThrowIO $ WritingLockFileError lockFile newLocked
+      LFBIgnore -> pure ()
+      LFBReadOnly -> pure ()
+  pure wanted
+ where
+  header =
+    "# This file was autogenerated by Stack.\n\
+    \# You should not edit this file by hand.\n\
+    \# For more information, please see the documentation at:\n\
+    \#   https://docs.haskellstack.org/en/stable/lock_files\n\n"
src/Stack/Ls.hs view
@@ -1,14 +1,19 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
+-- | Types and functions related to Stack's @ls@ command.
 module Stack.Ls
-  ( lsCmd
-  , lsParser
+  ( LsCmdOpts (..)
+  , LsCmds (..)
+  , SnapshotOpts (..)
+  , ListStylesOpts (..)
+  , ListToolsOpts (..)
+  , LsView (..)
+  , lsCmd
   ) where
 
-import           Data.Aeson
+import           Data.Aeson ( FromJSON, Value (..), (.:) )
 import           Data.Array.IArray ( (//), elems )
 import           Distribution.Package ( mkPackageName )
 import qualified Data.Aeson.Types as A
@@ -18,22 +23,21 @@ import qualified Data.Text.IO as T
 import qualified Data.Vector as V
 import           Network.HTTP.StackClient
-                   ( httpJSON, addRequestHeader, getResponseBody, parseRequest
-                   , hAccept
+                   ( addRequestHeader, hAccept, httpJSON, getResponseBody
+                   , parseRequest
                    )
-import qualified Options.Applicative as OA
-import           Options.Applicative ( idm )
-import           Options.Applicative.Builder.Extra ( boolFlags )
-import           Path
+import           Path ( parent )
 import           RIO.List ( sort )
-import           Stack.Constants ( osIsWindows, globalFooter )
-import           Stack.Dot
-import           Stack.Prelude hiding ( Snapshot (..), SnapName (..) )
+import           Stack.Constants ( osIsWindows )
+import           Stack.Dot ( ListDepsOpts, listDependencies )
+import           Stack.Prelude hiding ( Nightly, Snapshot )
 import           Stack.Runners
-import           Stack.Options.DotParser ( listDepsOptsParser )
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
 import           Stack.Setup.Installed
                    ( Tool (..), filterTools, listInstalled, toolString )
-import           Stack.Types.Config
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.EnvConfig ( installationRootDeps )
+import           Stack.Types.Runner ( HasRunner, Runner, terminalL )
 import           System.Console.ANSI.Codes
                    ( SGR (Reset), setSGRCode, sgrToCode )
 import           System.Process.Pager ( pageText )
@@ -43,160 +47,87 @@ -- | Type representing exceptions thrown by functions exported by the "Stack.Ls"
 -- module.
 newtype LsException
-    = ParseFailure [Value]
-    deriving (Show, Typeable)
+  = ParseFailure [Value]
+  deriving (Show, Typeable)
 
 instance Exception LsException where
-    displayException (ParseFailure val) =
-        "Error: [S-3421]\n"
-        ++ "Failure to parse values as a snapshot: "
-        ++ show val
+  displayException (ParseFailure val) =
+    "Error: [S-3421]\n"
+    ++ "Failure to parse values as a snapshot: "
+    ++ show val
 
+-- | Type representing subcommands for the @stack ls snapshots@ command.
 data LsView
-    = Local
-    | Remote
-    deriving (Show, Eq, Ord)
+  = Local
+  | Remote
+  deriving (Eq, Ord, Show)
 
+-- | Type representing Stackage snapshot types.
 data SnapshotType
-    = Lts
-    | Nightly
-    deriving (Show, Eq, Ord)
-
-data LsCmds
-    = LsSnapshot SnapshotOpts
-    | LsDependencies ListDepsOpts
-    | LsStyles ListStylesOpts
-    | LsTools ListToolsOpts
+  = Lts
+    -- ^ Stackage LTS Haskell
+  | Nightly
+    -- ^ Stackage Nightly
+  deriving (Eq, Ord, Show)
 
+-- | Type representing command line options for the @stack ls snapshots@
+-- command.
 data SnapshotOpts = SnapshotOpts
-    { soptViewType :: LsView
-    , soptLtsSnapView :: Bool
-    , soptNightlySnapView :: Bool
-    } deriving (Eq, Show, Ord)
+  { soptViewType :: LsView
+  , soptLtsSnapView :: Bool
+  , soptNightlySnapView :: Bool
+  }
+  deriving (Eq, Ord, Show)
 
+-- | Type representing command line options for the @stack ls stack-colors@ and
+-- @stack ls stack-colours@ commands.
 data ListStylesOpts = ListStylesOpts
-    { coptBasic   :: Bool
-    , coptSGR     :: Bool
-    , coptExample :: Bool
-    } deriving (Eq, Ord, Show)
-
-newtype ListToolsOpts = ListToolsOpts
-    { toptFilter  :: String
-    }
-
-newtype LsCmdOpts = LsCmdOpts
-    { lsView :: LsCmds
-    }
-
-lsParser :: OA.Parser LsCmdOpts
-lsParser = LsCmdOpts
-    <$> OA.hsubparser (lsSnapCmd <> lsDepsCmd <> lsStylesCmd <> lsToolsCmd)
-
-lsCmdOptsParser :: OA.Parser LsCmds
-lsCmdOptsParser = LsSnapshot <$> lsViewSnapCmd
-
-lsDepOptsParser :: OA.Parser LsCmds
-lsDepOptsParser = LsDependencies <$> listDepsOptsParser
-
-lsStylesOptsParser :: OA.Parser LsCmds
-lsStylesOptsParser = LsStyles <$> listStylesOptsParser
-
-lsToolsOptsParser :: OA.Parser LsCmds
-lsToolsOptsParser = LsTools <$> listToolsOptsParser
-
-listStylesOptsParser :: OA.Parser ListStylesOpts
-listStylesOptsParser = ListStylesOpts
-    <$> boolFlags False
-                  "basic"
-                  "a basic report of the styles used. The default is a fuller \
-                  \one"
-                  idm
-    <*> boolFlags True
-                  "sgr"
-                  "the provision of the equivalent SGR instructions (provided \
-                  \by default). Flag ignored for a basic report"
-                  idm
-    <*> boolFlags True
-                  "example"
-                  "the provision of an example of the applied style (provided \
-                  \by default for colored output). Flag ignored for a basic \
-                  \report"
-                  idm
-
-listToolsOptsParser :: OA.Parser ListToolsOpts
-listToolsOptsParser = ListToolsOpts
-    <$> OA.strOption
-            ( OA.long "filter"
-           <> OA.metavar "TOOL_NAME"
-           <> OA.value ""
-           <> OA.help "Filter by a tool name (eg 'ghc', 'ghc-git' or 'msys2') \
-                      \- case sensitive. The default is no filter"
-            )
-
-lsViewSnapCmd :: OA.Parser SnapshotOpts
-lsViewSnapCmd =
-    SnapshotOpts <$>
-    (OA.hsubparser (lsViewRemoteCmd <> lsViewLocalCmd) <|> pure Local) <*>
-    OA.switch
-        (OA.long "lts" <> OA.short 'l' <> OA.help "Only show lts snapshots") <*>
-    OA.switch
-        (OA.long "nightly" <> OA.short 'n' <>
-         OA.help "Only show nightly snapshots")
-
-lsSnapCmd :: OA.Mod OA.CommandFields LsCmds
-lsSnapCmd = OA.command "snapshots" $
-  OA.info lsCmdOptsParser $
-       OA.progDesc "View snapshots (local by default)"
-    <> OA.footer localSnapshotMsg
+  { coptBasic   :: Bool
+  , coptSGR     :: Bool
+  , coptExample :: Bool
+  }
+  deriving (Eq, Ord, Show)
 
-lsDepsCmd :: OA.Mod OA.CommandFields LsCmds
-lsDepsCmd = OA.command "dependencies" $
-    OA.info lsDepOptsParser $
-         OA.progDesc "View the dependencies"
-      <> OA.footer globalFooter
+-- | Type representing command line options for the @stack ls tools@ command.
+newtype ListToolsOpts
+  = ListToolsOpts { toptFilter  :: String }
 
-lsStylesCmd :: OA.Mod OA.CommandFields LsCmds
-lsStylesCmd =
-    OA.command
-        "stack-colors"
-        (OA.info lsStylesOptsParser
-                 (OA.progDesc "View Stack's output styles"))
-    <>
-    OA.command
-        "stack-colours"
-        (OA.info lsStylesOptsParser
-                 (OA.progDesc "View Stack's output styles (alias for \
-                              \'stack-colors')"))
+-- | Type representing subcommands for the @stack ls@ command.
+data LsCmds
+  = LsSnapshot SnapshotOpts
+  | LsDependencies ListDepsOpts
+  | LsStyles ListStylesOpts
+  | LsTools ListToolsOpts
 
-lsToolsCmd :: OA.Mod OA.CommandFields LsCmds
-lsToolsCmd =
-    OA.command
-        "tools"
-        (OA.info lsToolsOptsParser (OA.progDesc "View Stack's installed tools"))
+-- | Type representing command line options for the @stack ls@ command.
+newtype LsCmdOpts
+  = LsCmdOpts { lsView :: LsCmds }
 
 data Snapshot = Snapshot
-    { snapId :: Text
-    , snapTitle :: Text
-    , snapTime :: Text
-    } deriving (Show, Eq, Ord)
+  { snapId :: Text
+  , snapTitle :: Text
+  , snapTime :: Text
+  }
+  deriving (Eq, Ord, Show)
 
 data SnapshotData = SnapshotData
-    { _snapTotalCounts :: Integer
-    , snaps :: [[Snapshot]]
-    } deriving (Show, Eq, Ord)
+  { _snapTotalCounts :: Integer
+  , snaps :: [[Snapshot]]
+  }
+  deriving (Eq, Ord, Show)
 
 instance FromJSON Snapshot where
-    parseJSON o@(Array _) = parseSnapshot o
-    parseJSON _ = mempty
+  parseJSON o@(Array _) = parseSnapshot o
+  parseJSON _ = mempty
 
 instance FromJSON SnapshotData where
-    parseJSON (Object s) =
-        SnapshotData <$> s .: "totalCount" <*> s .: "snapshots"
-    parseJSON _ = mempty
+  parseJSON (Object s) =
+    SnapshotData <$> s .: "totalCount" <*> s .: "snapshots"
+  parseJSON _ = mempty
 
 toSnapshot :: [Value] -> Snapshot
 toSnapshot [String sid, String stitle, String stime] =
-    Snapshot
+  Snapshot
     { snapId = sid
     , snapTitle = stitle
     , snapTime = stime
@@ -211,17 +142,17 @@ 
 displaySnap :: Snapshot -> [Text]
 displaySnap Snapshot {..} =
-    ["Resolver name: " <> snapId, "\n" <> snapTitle <> "\n\n"]
+  ["Resolver name: " <> snapId, "\n" <> snapTitle <> "\n\n"]
 
 displaySingleSnap :: [Snapshot] -> Text
 displaySingleSnap snapshots =
-    case snapshots of
-        [] -> mempty
-        (x:xs) ->
-            let snaps =
-                    displayTime x <> ["\n\n"] <> displaySnap x <>
-                    L.concatMap displaySnap xs
-            in T.concat snaps
+  case snapshots of
+    [] -> mempty
+    (x:xs) ->
+      let snaps =
+            displayTime x <> ["\n\n"] <> displaySnap x <>
+            L.concatMap displaySnap xs
+      in  T.concat snaps
 
 renderData :: Bool -> Text -> IO ()
 renderData True content = pageText content
@@ -229,24 +160,22 @@ 
 displaySnapshotData :: Bool -> SnapshotData -> IO ()
 displaySnapshotData term sdata =
-    case L.reverse $ snaps sdata of
-        [] -> pure ()
-        xs ->
-            let snaps = T.concat $ L.map displaySingleSnap xs
-            in renderData term snaps
+  case L.reverse $ snaps sdata of
+    [] -> pure ()
+    xs ->
+      let snaps = T.concat $ L.map displaySingleSnap xs
+      in  renderData term snaps
 
 filterSnapshotData :: SnapshotData -> SnapshotType -> SnapshotData
 filterSnapshotData sdata stype =
-    sdata
-    { snaps = filterSnapData
-    }
-  where
-    snapdata = snaps sdata
-    filterSnapData =
-        case stype of
-            Lts -> L.map (L.filter (\x -> "lts" `isPrefixOf` snapId x)) snapdata
-            Nightly ->
-                L.map (L.filter (\x -> "nightly" `isPrefixOf` snapId x)) snapdata
+  sdata { snaps = filterSnapData }
+ where
+  snapdata = snaps sdata
+  filterSnapData =
+    case stype of
+      Lts -> L.map (L.filter (\x -> "lts" `isPrefixOf` snapId x)) snapdata
+      Nightly ->
+        L.map (L.filter (\x -> "nightly" `isPrefixOf` snapId x)) snapdata
 
 displayLocalSnapshot :: Bool -> [String] -> IO ()
 displayLocalSnapshot term xs = renderData term (localSnaptoText xs)
@@ -256,125 +185,104 @@ 
 handleLocal :: LsCmdOpts -> RIO Runner ()
 handleLocal lsOpts = do
-    (instRoot :: Path Abs Dir) <- withConfig YesReexec $ withDefaultEnvConfig installationRootDeps
-    isStdoutTerminal <- view terminalL
-    let parentInstRoot = parent instRoot
-        snapRootDir
-          | osIsWindows = parentInstRoot
-          | otherwise   = parent parentInstRoot
-    snapData' <- liftIO $ listDirectory $ toFilePath snapRootDir
-    let snapData = L.sort snapData'
-    case lsView lsOpts of
-        LsSnapshot SnapshotOpts {..} ->
-            case (soptLtsSnapView, soptNightlySnapView) of
-                (True, False) ->
-                    liftIO $
-                    displayLocalSnapshot isStdoutTerminal $
-                    L.filter (L.isPrefixOf "lts") snapData
-                (False, True) ->
-                    liftIO $
-                    displayLocalSnapshot isStdoutTerminal $
-                    L.filter (L.isPrefixOf "night") snapData
-                _ -> liftIO $ displayLocalSnapshot isStdoutTerminal snapData
-        LsDependencies _ -> pure ()
-        LsStyles _ -> pure ()
-        LsTools _ -> pure ()
+  (instRoot :: Path Abs Dir) <-
+    withConfig YesReexec $ withDefaultEnvConfig installationRootDeps
+  isStdoutTerminal <- view terminalL
+  let parentInstRoot = parent instRoot
+      snapRootDir
+        | osIsWindows = parentInstRoot
+        | otherwise   = parent parentInstRoot
+  snapData' <- liftIO $ listDirectory $ toFilePath snapRootDir
+  let snapData = L.sort snapData'
+  case lsView lsOpts of
+    LsSnapshot SnapshotOpts {..} ->
+      case (soptLtsSnapView, soptNightlySnapView) of
+        (True, False) ->
+          liftIO $
+          displayLocalSnapshot isStdoutTerminal $
+          L.filter (L.isPrefixOf "lts") snapData
+        (False, True) ->
+          liftIO $
+          displayLocalSnapshot isStdoutTerminal $
+          L.filter (L.isPrefixOf "night") snapData
+        _ -> liftIO $ displayLocalSnapshot isStdoutTerminal snapData
+    LsDependencies _ -> pure ()
+    LsStyles _ -> pure ()
+    LsTools _ -> pure ()
 
-handleRemote
-    :: HasRunner env
-    => LsCmdOpts -> RIO env ()
+handleRemote :: HasRunner env => LsCmdOpts -> RIO env ()
 handleRemote lsOpts = do
-    req <- liftIO $ parseRequest urlInfo
-    isStdoutTerminal <- view terminalL
-    let req' = addRequestHeader hAccept "application/json" req
-    result <- httpJSON req'
-    let snapData = getResponseBody result
-    case lsView lsOpts of
-        LsSnapshot SnapshotOpts {..} ->
-            case (soptLtsSnapView, soptNightlySnapView) of
-                (True, False) ->
-                    liftIO $
-                    displaySnapshotData isStdoutTerminal $
-                    filterSnapshotData snapData Lts
-                (False, True) ->
-                    liftIO $
-                    displaySnapshotData isStdoutTerminal $
-                    filterSnapshotData snapData Nightly
-                _ -> liftIO $ displaySnapshotData isStdoutTerminal snapData
-        LsDependencies _ -> pure ()
-        LsStyles _ -> pure ()
-        LsTools _ -> pure ()
-  where
-    urlInfo = "https://www.stackage.org/snapshots"
+  req <- liftIO $ parseRequest urlInfo
+  isStdoutTerminal <- view terminalL
+  let req' = addRequestHeader hAccept "application/json" req
+  result <- httpJSON req'
+  let snapData = getResponseBody result
+  case lsView lsOpts of
+    LsSnapshot SnapshotOpts {..} ->
+      case (soptLtsSnapView, soptNightlySnapView) of
+        (True, False) ->
+          liftIO $
+          displaySnapshotData isStdoutTerminal $
+          filterSnapshotData snapData Lts
+        (False, True) ->
+          liftIO $
+          displaySnapshotData isStdoutTerminal $
+          filterSnapshotData snapData Nightly
+        _ -> liftIO $ displaySnapshotData isStdoutTerminal snapData
+    LsDependencies _ -> pure ()
+    LsStyles _ -> pure ()
+    LsTools _ -> pure ()
+ where
+  urlInfo = "https://www.stackage.org/snapshots"
 
 lsCmd :: LsCmdOpts -> RIO Runner ()
 lsCmd lsOpts =
-    case lsView lsOpts of
-        LsSnapshot SnapshotOpts {..} ->
-            case soptViewType of
-                Local -> handleLocal lsOpts
-                Remote -> handleRemote lsOpts
-        LsDependencies depOpts -> listDependencies depOpts
-        LsStyles stylesOpts -> withConfig NoReexec $ listStylesCmd stylesOpts
-        LsTools toolsOpts -> withConfig NoReexec $ listToolsCmd toolsOpts
-
-lsViewLocalCmd :: OA.Mod OA.CommandFields LsView
-lsViewLocalCmd = OA.command "local" $
-  OA.info (pure Local) $
-       OA.progDesc "View local snapshots"
-    <> OA.footer localSnapshotMsg
-
-lsViewRemoteCmd :: OA.Mod OA.CommandFields LsView
-lsViewRemoteCmd = OA.command "remote" $
-  OA.info (pure Remote) $
-       OA.progDesc "View remote snapshots"
-    <> OA.footer pagerMsg
-
-pagerMsg :: String
-pagerMsg =
-  "On a terminal, uses a pager, if one is available. Respects the PAGER \
-  \environment variable (subject to that, prefers pager 'less' to 'more')."
-
-localSnapshotMsg :: String
-localSnapshotMsg =
-  "A local snapshot is identified by a hash code. " <> pagerMsg
+  case lsView lsOpts of
+    LsSnapshot SnapshotOpts {..} ->
+      case soptViewType of
+        Local -> handleLocal lsOpts
+        Remote -> handleRemote lsOpts
+    LsDependencies depOpts -> listDependencies depOpts
+    LsStyles stylesOpts -> withConfig NoReexec $ listStylesCmd stylesOpts
+    LsTools toolsOpts -> withConfig NoReexec $ listToolsCmd toolsOpts
 
 -- | List Stack's output styles
 listStylesCmd :: ListStylesOpts -> RIO Config ()
 listStylesCmd opts = do
-    lc <- ask
-    -- This is the same test as is used in Stack.Types.Runner.withRunner
-    let useColor = view useColorL lc
-        styles = elems $ defaultStyles // stylesUpdate (view stylesUpdateL lc)
-        isComplex = not (coptBasic opts)
-        showSGR = isComplex && coptSGR opts
-        showExample = isComplex && coptExample opts && useColor
-        styleReports = L.map (styleReport showSGR showExample) styles
-    liftIO $ T.putStrLn $ T.intercalate (if isComplex then "\n" else ":") styleReports
-  where
-    styleReport :: Bool -> Bool -> StyleSpec -> Text
-    styleReport showSGR showExample (k, sgrs) = k <> "=" <> codes
-        <> (if showSGR then sgrsList else mempty)
-        <> (if showExample then example else mempty)
-      where
-        codes = T.intercalate ";" (L.map (fromString . show) $
-                    L.concatMap sgrToCode sgrs)
-        sgrsList = " [" <> T.intercalate ", " (L.map (fromString . show) sgrs)
-                   <> "]"
-        example = " " <> ansi <> "Example" <> reset
-        ansi = fromString $ setSGRCode sgrs
-        reset = fromString $ setSGRCode [Reset]
+  lc <- ask
+  -- This is the same test as is used in Stack.Types.Runner.withRunner
+  let useColor = view useColorL lc
+      styles = elems $ defaultStyles // stylesUpdate (view stylesUpdateL lc)
+      isComplex = not (coptBasic opts)
+      showSGR = isComplex && coptSGR opts
+      showExample = isComplex && coptExample opts && useColor
+      styleReports = L.map (styleReport showSGR showExample) styles
+  liftIO $
+    T.putStrLn $ T.intercalate (if isComplex then "\n" else ":") styleReports
+ where
+  styleReport :: Bool -> Bool -> StyleSpec -> Text
+  styleReport showSGR showExample (k, sgrs) = k <> "=" <> codes
+    <> (if showSGR then sgrsList else mempty)
+    <> (if showExample then example else mempty)
+   where
+    codes = T.intercalate ";" (L.map (fromString . show) $
+              L.concatMap sgrToCode sgrs)
+    sgrsList = " [" <> T.intercalate ", " (L.map (fromString . show) sgrs)
+               <> "]"
+    example = " " <> ansi <> "Example" <> reset
+    ansi = fromString $ setSGRCode sgrs
+    reset = fromString $ setSGRCode [Reset]
 
 -- | List Stack's installed tools, sorted (see instance of 'Ord' for 'Tool').
 listToolsCmd :: ListToolsOpts -> RIO Config ()
 listToolsCmd opts = do
-    localPrograms <- view $ configL.to configLocalPrograms
-    installed <- sort <$> listInstalled localPrograms
-    let wanted = case toptFilter opts of
-            [] -> installed
-            "ghc-git" -> [t | t@(ToolGhcGit _ _) <- installed]
-            pkgName -> filtered pkgName installed
-    liftIO $ mapM_ (putStrLn . toolString) wanted
-  where
-    filtered pkgName installed = Tool <$>
-        filterTools (mkPackageName pkgName) (const True) installed
+  localPrograms <- view $ configL.to configLocalPrograms
+  installed <- sort <$> listInstalled localPrograms
+  let wanted = case toptFilter opts of
+        [] -> installed
+        "ghc-git" -> [t | t@(ToolGhcGit _ _) <- installed]
+        pkgName -> filtered pkgName installed
+  liftIO $ mapM_ (putStrLn . toolString) wanted
+ where
+  filtered pkgName installed = Tool <$>
+      filterTools (mkPackageName pkgName) (const True) installed
src/Stack/New.hs view
@@ -1,678 +1,678 @@ {-# LANGUAGE NoImplicitPrelude         #-}
-{-# LANGUAGE ConstraintKinds           #-}
-{-# LANGUAGE DeriveDataTypeable        #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts          #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE ScopedTypeVariables       #-}
-{-# LANGUAGE StandaloneDeriving        #-}
-
--- | Create new a new project directory populated with a basic working
--- project.
-
-module Stack.New
-    ( new
-    , NewOpts (..)
-    , TemplateName
-    , templatesHelp
-    ) where
-
-import           Control.Monad.Trans.Writer.Strict
-import           Data.Aeson as A
-import qualified Data.Aeson.KeyMap as KeyMap
-import qualified Data.ByteString.Base64 as B64
-import           Data.ByteString.Builder ( lazyByteString )
-import qualified Data.ByteString.Lazy as LB
-import           Data.Conduit
-import qualified Data.List as L
-import qualified Data.Map.Strict as M
-import qualified Data.Set as S
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Encoding as TLE
-import           Data.Time.Calendar
-import           Data.Time.Clock
-import           Network.HTTP.StackClient
-                   ( HttpException (..), HttpExceptionContent (..)
-                   , Response (..), VerifiedDownloadException (..)
-                   , getResponseBody, httpLbs, mkDownloadRequest, notFound404
-                   , parseRequest, parseUrlThrow, setForceDownload
-                   , setGitHubHeaders, setRequestCheckStatus
-                   , verifiedDownloadWithProgress
-                   )
-import           Path
-import           Path.IO
-import           RIO.Process
-import           Stack.Constants
-import           Stack.Constants.Config
-import           Stack.Prelude
-import           Stack.Types.Config
-import           Stack.Types.TemplateName
-import qualified Text.Mustache as Mustache
-import qualified Text.Mustache.Render as Mustache
-import           Text.ProjectTemplate
-
---------------------------------------------------------------------------------
--- Exceptions
-
--- | Type representing \'pretty\' exceptions thrown by functions exported by the
--- "Stack.New" module.
-data NewPrettyException
-    = ProjectDirAlreadyExists !String !(Path Abs Dir)
-    | DownloadTemplateFailed !Text !String !VerifiedDownloadException
-    | forall b. LoadTemplateFailed !TemplateName !(Path b File)
-    | forall b. ExtractTemplateFailed !TemplateName !(Path b File) !String
-    | TemplateInvalid !TemplateName !StyleDoc
-    | MagicPackageNameInvalid !String
-    | AttemptedOverwrites !Text ![Path Abs File]
-    | DownloadTemplatesHelpFailed !HttpException
-    | TemplatesHelpEncodingInvalid !String !UnicodeException
-    deriving Typeable
-
-deriving instance Show NewPrettyException
-
-instance Pretty NewPrettyException where
-    pretty (ProjectDirAlreadyExists name path) =
-        "[S-2135]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to create a new directory for project"
-             , style Current (fromString name) <> ","
-             , flow "as the directory"
-             , style Dir (pretty path)
-             , flow "already exists."
-             ]
-    pretty (DownloadTemplateFailed name url err) =
-        "[S-1688]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to download the template"
-             , style Current (fromString . T.unpack $ name)
-             , "from"
-             , style Url (fromString url) <> "."
-             ]
-        <> blankLine
-        <> ( if isNotFound
-                then    flow "Please check that the template exists at that \
-                             \location."
-                     <> blankLine
-                else mempty
-           )
-        <> fillSep
-             [ flow "While downloading, Stack encountered"
-             , msg
-             ]
-      where
-        (msg, isNotFound) = case err of
-            DownloadHttpError (HttpExceptionRequest req content) ->
-              let msg' =    flow "an HTTP error. Stack made the request:"
-                         <> blankLine
-                         <> fromString (show req)
-                         <> blankLine
-                         <> flow "and the content of the error was:"
-                         <> blankLine
-                         <> fromString (show content)
-                  isNotFound404 = case content of
-                                    StatusCodeException res _ ->
-                                      responseStatus res == notFound404
-                                    _ -> False
-              in  (msg', isNotFound404)
-            DownloadHttpError (InvalidUrlException url' reason) ->
-              let msg' = fillSep
-                           [ flow "an HTTP error. The URL"
-                           , style Url (fromString url')
-                           , flow "was considered invalid because"
-                           , fromString reason <> "."
-                           ]
-              in (msg', False)
-            _ -> let msg' =    flow "the following error:"
-                            <> blankLine
-                            <> fromString (displayException err)
-                 in (msg', False)
-    pretty (LoadTemplateFailed name path) =
-        "[S-3650]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to load the downloaded template"
-             , style Current (fromString $ T.unpack $ templateName name)
-             , "from"
-             , style File (pretty path) <> "."
-             ]
-    pretty (ExtractTemplateFailed name path err) =
-        "[S-9582]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to extract the loaded template"
-             , style Current (fromString $ T.unpack $ templateName name)
-             , "at"
-             , style File (pretty path) <> "."
-             ]
-        <> blankLine
-        <> flow "While extracting, Stack encountered the following error:"
-        <> blankLine
-        <> string err
-    pretty (TemplateInvalid name why) =
-        "[S-9490]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to use the template"
-             , style Current (fromString $ T.unpack $ templateName name) <> ","
-             , "as"
-             , why
-             ]
-    pretty (MagicPackageNameInvalid name) =
-        "[S-5682]"
-        <> line
-        <> fillSep
-             [ flow "Stack declined to create a new directory for project"
-             , style Current (fromString name) <> ","
-             , flow "as package"
-             , fromString name
-             , flow "is 'wired-in' to a version of GHC. That can cause build \
-                    \errors."
-             ]
-        <> blankLine
-        <> fillSep
-             ( flow "The names blocked by Stack are:"
-             : mkNarrativeList Nothing False
-                 ( map toStyleDoc (L.sort $ S.toList wiredInPackages)
-                 )
-             )
-      where
-        toStyleDoc :: PackageName -> StyleDoc
-        toStyleDoc = fromString . packageNameString
-    pretty (AttemptedOverwrites name fps) =
-        "[S-3113]"
-        <> line
-        <> fillSep
-             [ flow "Stack declined to apply the template"
-             , style Current (fromString . T.unpack $ name) <> ","
-             , flow "as it would create files that already exist."
-             ]
-        <> blankLine
-        <> flow "The template would create the following existing files:"
-        <> line
-        <> bulletedList (map (style File . pretty) fps)
-        <> blankLine
-        <> fillSep
-             [ "Use the"
-             , style Shell "--force"
-             , "flag to ignore this and overwrite those files."
-             ]
-    pretty (DownloadTemplatesHelpFailed err) =
-        "[S-8143]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to download the help for"
-             , style Shell "stack templates" <> "."
-             ]
-        <> blankLine
-        <> flow "While downloading, Stack encountered the following error:"
-        <> blankLine
-        <> string (displayException err)
-    pretty (TemplatesHelpEncodingInvalid url err) =
-        "[S-6670]"
-        <> line
-        <> fillSep
-             [ flow "Stack failed to decode the help for"
-             , style Shell "stack templates"
-             , flow "downloaded from"
-             , style Url (fromString url) <> "."
-             ]
-        <> blankLine
-        <> flow "While decoding, Stack encountered the following error:"
-        <> blankLine
-        <> string (displayException err)
-
-
-instance Exception NewPrettyException
-
---------------------------------------------------------------------------------
--- Main project creation
-
--- | Options for creating a new project.
-data NewOpts = NewOpts
-    { newOptsProjectName  :: PackageName
-    -- ^ Name of the project to create.
-    , newOptsCreateBare   :: Bool
-    -- ^ Whether to create the project without a directory.
-    , newOptsTemplate     :: Maybe TemplateName
-    -- ^ Name of the template to use.
-    , newOptsNonceParams  :: Map Text Text
-    -- ^ Nonce parameters specified just for this invocation.
-    }
-
--- | Create a new project with the given options.
-new :: HasConfig env => NewOpts -> Bool -> RIO env (Path Abs Dir)
-new opts forceOverwrite = do
-    when (project `elem` wiredInPackages) $
-        throwM $ PrettyException $ MagicPackageNameInvalid projectName
-    pwd <- getCurrentDir
-    absDir <- if bare then pure pwd
-                      else do relDir <- parseRelDir (packageNameString project)
-                              liftM (pwd </>) (pure relDir)
-    exists <- doesDirExist absDir
-    configTemplate <- view $ configL.to configDefaultTemplate
-    let template = fromMaybe defaultTemplateName $ asum [ cliOptionTemplate
-                                                        , configTemplate
-                                                        ]
-    if exists && not bare
-        then throwM $ PrettyException $
-                 ProjectDirAlreadyExists projectName absDir
-        else do
-            templateText <- loadTemplate template (logUsing absDir template)
-            files <-
-                applyTemplate
-                    project
-                    template
-                    (newOptsNonceParams opts)
-                    absDir
-                    templateText
-            when (not forceOverwrite && bare) $
-                checkForOverwrite (templateName template) (M.keys files)
-            writeTemplateFiles files
-            runTemplateInits absDir
-            pure absDir
-  where
-    cliOptionTemplate = newOptsTemplate opts
-    project = newOptsProjectName opts
-    projectName = packageNameString project
-    bare = newOptsCreateBare opts
-    logUsing absDir template templateFrom =
-        let loading = case templateFrom of
-                          LocalTemp -> flow "Loading local"
-                          RemoteTemp -> "Downloading"
-        in  prettyInfo
-              ( fillSep
-                  [ loading
-                  , "template"
-                  , style
-                      Current
-                      (fromString $ T.unpack $ templateName template)
-                  , flow "to create project"
-                  , style Current (fromString projectName)
-                  , "in"
-                  ,    ( if bare
-                           then flow "the current directory"
-                           else fillSep
-                                  [ "directory"
-                                  , style Dir (pretty $ dirname absDir)
-                                  ]
-                       )
-                    <> "..."
-                  ]
-                )
-
-data TemplateFrom = LocalTemp | RemoteTemp
-
--- | Download and read in a template's text content.
-loadTemplate
-    :: forall env. HasConfig env
-    => TemplateName
-    -> (TemplateFrom -> RIO env ())
-    -> RIO env Text
-loadTemplate name logIt = do
-    templateDir <- view $ configL.to templatesDir
-    case templatePath name of
-        AbsPath absFile ->
-            logIt LocalTemp >> loadLocalFile absFile eitherByteStringToText
-        UrlPath s -> do
-            let settings = asIsFromUrl s
-            downloadFromUrl settings templateDir
-        RelPath rawParam relFile ->
-            catch
-                (do f <- loadLocalFile relFile eitherByteStringToText
-                    logIt LocalTemp
-                    pure f)
-                (\(e :: PrettyException) -> do
-                      case relSettings rawParam of
-                        Just settings -> do
-                          let url = tplDownloadUrl settings
-                              extract = tplExtract settings
-                          downloadTemplate url extract (templateDir </> relFile)
-                        Nothing -> throwM e
-                )
-        RepoPath rtp -> do
-            let settings = settingsFromRepoTemplatePath rtp
-            downloadFromUrl settings templateDir
-
-  where
-    loadLocalFile :: Path b File
-                  -> (ByteString -> Either String Text)
-                  -> RIO env Text
-    loadLocalFile path extract = do
-        logDebug ("Opening local template: \"" <> fromString (toFilePath path)
-                                                <> "\"")
-        exists <- doesFileExist path
-        if exists
-            then do
-                bs <- readFileBinary (toFilePath path) --readFileUtf8 (toFilePath path)
-                case extract bs of
-                    Left err -> throwM $ PrettyException $
-                        ExtractTemplateFailed name path err
-                    Right template ->
-                        pure template
-            else throwM $ PrettyException $
-                LoadTemplateFailed name path
-
-    relSettings :: String -> Maybe TemplateDownloadSettings
-    relSettings req = do
-        rtp <- parseRepoPathWithService defaultRepoService (T.pack req)
-        pure (settingsFromRepoTemplatePath rtp)
-
-    downloadFromUrl :: TemplateDownloadSettings -> Path Abs Dir -> RIO env Text
-    downloadFromUrl settings templateDir = do
-        let url = tplDownloadUrl settings
-            rel = fromMaybe backupUrlRelPath (parseRelFile url)
-        downloadTemplate url (tplExtract settings) (templateDir </> rel)
-
-    downloadTemplate :: String
-                     -> (ByteString
-                     -> Either String Text)
-                     -> Path Abs File
-                     -> RIO env Text
-    downloadTemplate url extract path = do
-        req <- parseRequest url
-        let dReq = setForceDownload True $
-                       mkDownloadRequest (setRequestCheckStatus req)
-        logIt RemoteTemp
-        catch
-          ( do let label = T.pack $ toFilePath path
-               res <- verifiedDownloadWithProgress dReq path label Nothing
-               if res
-                 then logStickyDone ("Downloaded " <> display label <> ".")
-                 else logStickyDone "Already downloaded."
-          )
-          (useCachedVersionOrThrow url path)
-        loadLocalFile path extract
-
-    useCachedVersionOrThrow :: String
-                            -> Path Abs File
-                            -> VerifiedDownloadException
-                            -> RIO env ()
-    useCachedVersionOrThrow url path exception = do
-      exists <- doesFileExist path
-
-      if exists
-        then prettyWarn
-                 ( flow "Tried to download the template but an error was \
-                        \found. Using cached local version. It may not be the \
-                        \most recent version though."
-                 )
-        else throwM $ PrettyException $
-                 DownloadTemplateFailed (templateName name) url exception
-
-data TemplateDownloadSettings = TemplateDownloadSettings
-  { tplDownloadUrl :: String
-  , tplExtract :: ByteString -> Either String Text
-  }
-
-eitherByteStringToText :: ByteString -> Either String Text
-eitherByteStringToText = mapLeft show . decodeUtf8'
-
-asIsFromUrl :: String -> TemplateDownloadSettings
-asIsFromUrl url = TemplateDownloadSettings
-  { tplDownloadUrl = url
-  , tplExtract = eitherByteStringToText
-  }
-
--- | Construct a URL for downloading from a repo.
-settingsFromRepoTemplatePath :: RepoTemplatePath -> TemplateDownloadSettings
-settingsFromRepoTemplatePath (RepoTemplatePath GitHub user name) =
-    -- T.concat ["https://raw.githubusercontent.com", "/", user, "/stack-templates/master/", name]
-    TemplateDownloadSettings
-    { tplDownloadUrl = concat
-          [ "https://api.github.com/repos/"
-          , T.unpack user
-          , "/stack-templates/contents/"
-          , T.unpack name
-          ]
-    , tplExtract = \bs -> do
-        decodedJson <- eitherDecode (LB.fromStrict bs)
-        case decodedJson of
-          Object o | Just (String content) <- KeyMap.lookup "content" o -> do
-                       let noNewlines = T.filter (/= '\n')
-                       bsContent <- B64.decode $ T.encodeUtf8 (noNewlines content)
-                       mapLeft show $ decodeUtf8' bsContent
-          _ ->
-            Left "Couldn't parse GitHub response as a JSON object with a \"content\" field"
-    }
-
-settingsFromRepoTemplatePath (RepoTemplatePath GitLab user name) =
-    asIsFromUrl $ concat
-        [ "https://gitlab.com"
-        , "/"
-        , T.unpack user
-        , "/stack-templates/raw/master/"
-        , T.unpack name
-        ]
-settingsFromRepoTemplatePath (RepoTemplatePath Bitbucket user name) =
-    asIsFromUrl $ concat
-        [ "https://bitbucket.org"
-        , "/"
-        , T.unpack user
-        , "/stack-templates/raw/master/"
-        , T.unpack name
-        ]
-
--- | Apply and unpack a template into a directory.
-applyTemplate
-    :: HasConfig env
-    => PackageName
-    -> TemplateName
-    -> Map Text Text
-    -> Path Abs Dir
-    -> Text
-    -> RIO env  (Map (Path Abs File) LB.ByteString)
-applyTemplate project template nonceParams dir templateText = do
-    config <- view configL
-    currentYear <- do
-      now <- liftIO getCurrentTime
-      let (year, _, _) = toGregorian (utctDay now)
-      pure $ T.pack . show $ year
-    let context = M.unions [nonceParams, nameParams, configParams, yearParam]
-          where
-            nameAsVarId = T.replace "-" "_" $ T.pack $ packageNameString project
-            nameAsModule = T.filter (/= ' ') $ T.toTitle $ T.replace "-" " " $
-                               T.pack $ packageNameString project
-            nameParams = M.fromList [ ("name", T.pack $ packageNameString project)
-                                    , ("name-as-varid", nameAsVarId)
-                                    , ("name-as-module", nameAsModule) ]
-            configParams = configTemplateParams config
-            yearParam = M.singleton "year" currentYear
-    files :: Map FilePath LB.ByteString <-
-        catch
-            ( execWriterT $ runConduit $
-                  yield (T.encodeUtf8 templateText) .|
-                  unpackTemplate receiveMem id
-            )
-            ( \(e :: ProjectTemplateException) ->
-                  throwM $ PrettyException $
-                      TemplateInvalid template (string $ displayException e)
-            )
-    when (M.null files) $
-        throwM $ PrettyException $
-            TemplateInvalid
-                template
-                (flow "the template does not contain any files.")
-
-    let isPkgSpec f = ".cabal" `L.isSuffixOf` f || f == "package.yaml"
-    unless (any isPkgSpec . M.keys $ files) $
-         throwM $ PrettyException $
-             TemplateInvalid
-                 template
-                 ( flow "the template does not contain a Cabal or package.yaml \
-                       \file."
-                 )
-
-    -- Apply Mustache templating to a single file within the project template.
-    let applyMustache bytes
-          -- Workaround for performance problems with mustache and
-          -- large files, applies to Yesod templates with large
-          -- bootstrap CSS files. See
-          -- https://github.com/commercialhaskell/stack/issues/4133.
-          | LB.length bytes < 50000
-          , Right text <- TLE.decodeUtf8' bytes = do
-              let etemplateCompiled = Mustache.compileTemplate (T.unpack (templateName template)) $ TL.toStrict text
-              templateCompiled <- case etemplateCompiled of
-                Left e -> throwM $ PrettyException $
-                    TemplateInvalid
-                        template
-                        (    flow "Stack encountered the following error:"
-                          <> blankLine
-                             -- Text.Parsec.Error.ParseError is not an instance
-                             -- of Control.Exception.
-                          <> string (show e)
-                        )
-                Right t -> pure t
-              let (substitutionErrors, applied) = Mustache.checkedSubstitute templateCompiled context
-                  missingKeys = S.fromList $ concatMap onlyMissingKeys substitutionErrors
-              pure (LB.fromStrict $ encodeUtf8 applied, missingKeys)
-
-          -- Too large or too binary
-          | otherwise = pure (bytes, S.empty)
-
-        -- Accumulate any missing keys as the file is processed
-        processFile mks (fpOrig, bytes) = do
-          -- Apply the mustache template to the filenames as well, so that we
-          -- can have file names depend on the project name.
-          (fp, mks1) <- applyMustache $ TLE.encodeUtf8 $ TL.pack fpOrig
-          path <- parseRelFile $ TL.unpack $ TLE.decodeUtf8 fp
-          (bytes', mks2) <- applyMustache bytes
-          pure (mks <> mks1 <> mks2, (dir </> path, bytes'))
-
-    (missingKeys, results) <- mapAccumLM processFile S.empty (M.toList files)
-    unless (S.null missingKeys) $ do
-      prettyNote $
-        missingParameters
-          missingKeys
-          (configUserConfigPath config)
-    pure $ M.fromList results
-  where
-    onlyMissingKeys (Mustache.VariableNotFound ks) = map T.unpack ks
-    onlyMissingKeys _ = []
-
-    mapAccumLM :: Monad m => (a -> b -> m(a, c)) -> a -> [b] -> m(a, [c])
-    mapAccumLM _ a [] = pure (a, [])
-    mapAccumLM f a (x:xs) = do
-      (a', c) <- f a x
-      (a'', cs) <- mapAccumLM f a' xs
-      pure (a'', c:cs)
-
-    missingParameters
-      :: Set String
-      -> Path Abs File
-      -> StyleDoc
-    missingParameters missingKeys userConfigPath =
-           fillSep
-             ( flow "The following parameters were needed by the template but \
-                    \not provided:"
-             : mkNarrativeList
-                 Nothing
-                 False
-                 (map toStyleDoc (S.toList missingKeys))
-             )
-        <> blankLine
-        <> fillSep
-             [ flow "You can provide them in Stack's global YAML configuration \
-                    \file"
-             , "(" <> style File (pretty userConfigPath) <> ")"
-             , "like this:"
-             ]
-        <> blankLine
-        <> "templates:"
-        <> line
-        <> "  params:"
-        <> line
-        <> vsep
-             ( map
-                 (\key -> "    " <> fromString key <> ": value")
-                 (S.toList missingKeys)
-             )
-        <> blankLine
-        <> flow "Or you can pass each one on the command line as parameters \
-                \like this:"
-        <> blankLine
-        <> style Shell
-             ( fillSep
-                 [ flow "stack new"
-                 , fromString (packageNameString project)
-                 , fromString $ T.unpack (templateName template)
-                 , hsep $
-                     map
-                       ( \key ->
-                           fillSep [ "-p"
-                                   , "\"" <> fromString key <> ":value\""
-                                   ]
-                       )
-                       (S.toList missingKeys)
-                 ]
-             )
-        <> line
-      where
-        toStyleDoc :: String -> StyleDoc
-        toStyleDoc = fromString
-
--- | Check if we're going to overwrite any existing files.
-checkForOverwrite :: (MonadIO m, MonadThrow m) => Text -> [Path Abs File] -> m ()
-checkForOverwrite name files = do
-    overwrites <- filterM doesFileExist files
-    unless (null overwrites) $
-        throwM $ PrettyException $ AttemptedOverwrites name overwrites
-
--- | Write files to the new project directory.
-writeTemplateFiles
-    :: MonadIO m
-    => Map (Path Abs File) LB.ByteString -> m ()
-writeTemplateFiles files =
-    liftIO $
-    forM_
-        (M.toList files)
-        (\(fp,bytes) ->
-              do ensureDir (parent fp)
-                 writeBinaryFileAtomic fp $ lazyByteString bytes)
-
--- | Run any initialization functions, such as Git.
-runTemplateInits
-    :: HasConfig env
-    => Path Abs Dir
-    -> RIO env ()
-runTemplateInits dir = do
-    config <- view configL
-    case configScmInit config of
-        Nothing -> pure ()
-        Just Git -> withWorkingDir (toFilePath dir) $
-            catchAny
-                (proc "git" ["init"] runProcess_)
-                ( \_ -> prettyWarn $
-                            fillSep
-                              [ flow "Stack failed to run a"
-                              , style Shell (flow "git init")
-                              , flow "command. Ignoring..."
-                              ]
-                )
-
--- | Display help for the templates command.
-templatesHelp :: HasLogFunc env => RIO env ()
-templatesHelp = do
-  let url = defaultTemplatesHelpUrl
-  req <- liftM setGitHubHeaders (parseUrlThrow url)
-  resp <- catch
-    (httpLbs req)
-    (throwM . PrettyException. DownloadTemplatesHelpFailed)
-  case decodeUtf8' $ LB.toStrict $ getResponseBody resp of
-    Left err -> throwM $ PrettyException $ TemplatesHelpEncodingInvalid url err
-    Right txt -> logInfo $ display txt
-
---------------------------------------------------------------------------------
--- Defaults
-
--- | The default service to use to download templates.
-defaultRepoService :: RepoService
-defaultRepoService = GitHub
-
--- | Default web URL to get the `stack templates` help output.
-defaultTemplatesHelpUrl :: String
-defaultTemplatesHelpUrl =
-    "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master/STACK_HELP.md"
+{-# LANGUAGE OverloadedStrings         #-}
+
+-- | Types and functions related to Stack's @new@ command.
+module Stack.New
+    ( NewOpts (..)
+    , TemplateName
+    , newCmd
+    , new
+    ) where
+
+import           Control.Monad.Trans.Writer.Strict ( execWriterT )
+import           Data.Aeson as A
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString.Base64 as B64
+import           Data.ByteString.Builder ( lazyByteString )
+import qualified Data.ByteString.Lazy as LB
+import           Data.Conduit ( yield )
+import qualified Data.List as L
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import           Data.Time.Calendar ( toGregorian )
+import           Data.Time.Clock ( getCurrentTime, utctDay )
+import           Network.HTTP.Client ( applyBasicAuth )
+import           Network.HTTP.StackClient
+                   ( HttpException (..), HttpExceptionContent (..)
+                   , Response (..), VerifiedDownloadException (..)
+                   , mkDownloadRequest, notFound404, parseRequest
+                   , setForceDownload, setRequestCheckStatus
+                   , verifiedDownloadWithProgress
+                   )
+import           Path ( (</>), dirname, parent, parseRelDir, parseRelFile )
+import           Path.IO
+                   ( doesDirExist, doesFileExist, ensureDir, getCurrentDir )
+import           RIO.Process ( proc, runProcess_, withWorkingDir )
+import           Stack.Constants
+                   ( altGitHubTokenEnvVar, backupUrlRelPath, gitHubBasicAuthType
+                   , gitHubTokenEnvVar, stackDotYaml, wiredInPackages
+                   )
+import           Stack.Constants.Config ( templatesDir )
+import           Stack.Init ( InitOpts (..), initProject )
+import           Stack.Prelude
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withGlobalProject )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Runner ( Runner, globalOptsL )
+import           Stack.Types.SCM ( SCM (..) )
+import           Stack.Types.TemplateName
+                   ( RepoService (..), RepoTemplatePath (..), TemplateName
+                   , TemplatePath (..), defaultTemplateName
+                   , parseRepoPathWithService, templateName, templatePath
+                   )
+import           System.Environment ( lookupEnv )
+import qualified Text.Mustache as Mustache
+import qualified Text.Mustache.Render as Mustache
+import           Text.ProjectTemplate
+                   ( ProjectTemplateException, receiveMem, unpackTemplate )
+
+--------------------------------------------------------------------------------
+-- Exceptions
+
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.New" module.
+data NewPrettyException
+  = ProjectDirAlreadyExists !String !(Path Abs Dir)
+  | DownloadTemplateFailed !Text !String !VerifiedDownloadException
+  | forall b. LoadTemplateFailed !TemplateName !(Path b File)
+  | forall b. ExtractTemplateFailed !TemplateName !(Path b File) !String
+  | TemplateInvalid !TemplateName !StyleDoc
+  | MagicPackageNameInvalid !String
+  | AttemptedOverwrites !Text ![Path Abs File]
+  deriving Typeable
+
+deriving instance Show NewPrettyException
+
+instance Pretty NewPrettyException where
+  pretty (ProjectDirAlreadyExists name path) =
+    "[S-2135]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to create a new directory for project"
+         , style Current (fromString name) <> ","
+         , flow "as the directory"
+         , pretty path
+         , flow "already exists."
+         ]
+  pretty (DownloadTemplateFailed name url err) =
+    "[S-1688]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to download the template"
+         , style Current (fromString . T.unpack $ name)
+         , "from"
+         , style Url (fromString url) <> "."
+         ]
+    <> blankLine
+    <> ( if isNotFound
+            then    flow "Please check that the template exists at that \
+                         \location."
+                 <> blankLine
+            else mempty
+       )
+    <> fillSep
+         [ flow "While downloading, Stack encountered"
+         , msg
+         ]
+   where
+    (msg, isNotFound) = case err of
+      DownloadHttpError (HttpExceptionRequest req content) ->
+        let msg' =    flow "an HTTP error. Stack made the request:"
+                   <> blankLine
+                   <> string (show req)
+                   <> blankLine
+                   <> flow "and the content of the error was:"
+                   <> blankLine
+                   <> string (show content)
+            isNotFound404 = case content of
+                              StatusCodeException res _ ->
+                                responseStatus res == notFound404
+                              _ -> False
+        in  (msg', isNotFound404)
+      DownloadHttpError (InvalidUrlException url' reason) ->
+        let msg' = fillSep
+                     [ flow "an HTTP error. The URL"
+                     , style Url (fromString url')
+                     , flow "was considered invalid because"
+                     , fromString reason <> "."
+                     ]
+        in  (msg', False)
+      _ -> let msg' =    flow "the following error:"
+                      <> blankLine
+                      <> fromString (displayException err)
+           in  (msg', False)
+  pretty (LoadTemplateFailed name path) =
+    "[S-3650]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to load the downloaded template"
+         , style Current (fromString $ T.unpack $ templateName name)
+         , "from"
+         , pretty path <> "."
+         ]
+  pretty (ExtractTemplateFailed name path err) =
+    "[S-9582]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to extract the loaded template"
+         , style Current (fromString $ T.unpack $ templateName name)
+         , "at"
+         , pretty path <> "."
+         ]
+    <> blankLine
+    <> flow "While extracting, Stack encountered the following error:"
+    <> blankLine
+    <> string err
+  pretty (TemplateInvalid name why) =
+    "[S-9490]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to use the template"
+         , style Current (fromString $ T.unpack $ templateName name) <> ","
+         , "as"
+         , why
+         ]
+  pretty (MagicPackageNameInvalid name) =
+    "[S-5682]"
+    <> line
+    <> fillSep
+         [ flow "Stack declined to create a new directory for project"
+         , style Current (fromString name) <> ","
+         , flow "as package"
+         , fromString name
+         , flow "is 'wired-in' to a version of GHC. That can cause build \
+                \errors."
+         ]
+    <> blankLine
+    <> fillSep
+         ( flow "The names blocked by Stack are:"
+         : mkNarrativeList Nothing False
+             (map toStyleDoc (L.sort $ S.toList wiredInPackages))
+         )
+   where
+    toStyleDoc :: PackageName -> StyleDoc
+    toStyleDoc = fromString . packageNameString
+  pretty (AttemptedOverwrites name fps) =
+    "[S-3113]"
+    <> line
+    <> fillSep
+         [ flow "Stack declined to apply the template"
+         , style Current (fromString . T.unpack $ name) <> ","
+         , flow "as it would create files that already exist."
+         ]
+    <> blankLine
+    <> flow "The template would create the following existing files:"
+    <> line
+    <> bulletedList (map (style File . pretty) fps)
+    <> blankLine
+    <> fillSep
+         [ "Use the"
+         , style Shell "--force"
+         , "flag to ignore this and overwrite those files."
+         ]
+
+instance Exception NewPrettyException
+
+--------------------------------------------------------------------------------
+-- Main project creation
+
+-- | Type representing command line options for the @stack new@ command (other
+-- than those applicable also to the @stack init@ command).
+data NewOpts = NewOpts
+  { newOptsProjectName  :: PackageName
+  -- ^ Name of the project to create.
+  , newOptsCreateBare   :: Bool
+  -- ^ Whether to create the project without a directory.
+  , newOptsTemplate     :: Maybe TemplateName
+  -- ^ Name of the template to use.
+  , newOptsNonceParams  :: Map Text Text
+  -- ^ Nonce parameters specified just for this invocation.
+  }
+
+-- | Function underlying the @stack new@ command. Create a project directory
+-- structure and initialize the Stack config.
+newCmd :: (NewOpts, InitOpts) -> RIO Runner ()
+newCmd (newOpts, initOpts) =
+  withGlobalProject $ withConfig YesReexec $ do
+    dir <- new newOpts (forceOverwrite initOpts)
+    exists <- doesFileExist $ dir </> stackDotYaml
+    when (forceOverwrite initOpts || not exists) $ do
+      go <- view globalOptsL
+      initProject dir initOpts (globalResolver go)
+
+-- | Create a new project with the given options.
+new :: HasConfig env => NewOpts -> Bool -> RIO env (Path Abs Dir)
+new opts forceOverwrite = do
+  when (project `elem` wiredInPackages) $
+      prettyThrowM $ MagicPackageNameInvalid projectName
+  pwd <- getCurrentDir
+  absDir <- if bare
+              then pure pwd
+              else do relDir <- parseRelDir (packageNameString project)
+                      pure (pwd </> relDir)
+  exists <- doesDirExist absDir
+  configTemplate <- view $ configL.to configDefaultTemplate
+  let template = fromMaybe defaultTemplateName $ asum [ cliOptionTemplate
+                                                      , configTemplate
+                                                      ]
+  if exists && not bare
+    then prettyThrowM $ ProjectDirAlreadyExists projectName absDir
+    else do
+      templateText <- loadTemplate template (logUsing absDir template)
+      files <-
+        applyTemplate
+          project
+          template
+          (newOptsNonceParams opts)
+          absDir
+          templateText
+      when (not forceOverwrite && bare) $
+        checkForOverwrite (templateName template) (M.keys files)
+      writeTemplateFiles files
+      runTemplateInits absDir
+      pure absDir
+ where
+  cliOptionTemplate = newOptsTemplate opts
+  project = newOptsProjectName opts
+  projectName = packageNameString project
+  bare = newOptsCreateBare opts
+  logUsing absDir template templateFrom =
+    let loading = case templateFrom of
+                    LocalTemp -> flow "Loading local"
+                    RemoteTemp -> "Downloading"
+    in  prettyInfo
+          ( fillSep
+              [ loading
+              , "template"
+              , style
+                  Current
+                  (fromString $ T.unpack $ templateName template)
+              , flow "to create project"
+              , style Current (fromString projectName)
+              , "in"
+              ,    ( if bare
+                       then flow "the current directory"
+                       else fillSep
+                              [ "directory"
+                              , pretty $ dirname absDir
+                              ]
+                   )
+                <> "..."
+              ]
+            )
+
+data TemplateFrom = LocalTemp | RemoteTemp
+
+-- | Download and read in a template's text content.
+loadTemplate ::
+     forall env. HasConfig env
+  => TemplateName
+  -> (TemplateFrom -> RIO env ())
+  -> RIO env Text
+loadTemplate name logIt = do
+  templateDir <- view $ configL.to templatesDir
+  case templatePath name of
+    AbsPath absFile ->
+      logIt LocalTemp >> loadLocalFile absFile eitherByteStringToText
+    UrlPath s -> do
+      let settings = asIsFromUrl s
+      downloadFromUrl settings templateDir
+    RelPath rawParam relFile ->
+      catch
+        (do f <- loadLocalFile relFile eitherByteStringToText
+            logIt LocalTemp
+            pure f)
+        ( \(e :: PrettyException) -> do
+            settings <- fromMaybe (throwM e) (relSettings rawParam)
+            let url = tplDownloadUrl settings
+                mBasicAuth = tplBasicAuth settings
+                extract = tplExtract settings
+            downloadTemplate url mBasicAuth extract (templateDir </> relFile)
+        )
+    RepoPath rtp -> do
+      settings <- settingsFromRepoTemplatePath rtp
+      downloadFromUrl settings templateDir
+
+ where
+  loadLocalFile :: Path b File
+                -> (ByteString -> Either String Text)
+                -> RIO env Text
+  loadLocalFile path extract = do
+    logDebug $
+         "Opening local template: \""
+      <> fromString (toFilePath path)
+      <> "\""
+    exists <- doesFileExist path
+    if exists
+      then do
+        bs <- readFileBinary (toFilePath path) --readFileUtf8 (toFilePath path)
+        case extract bs of
+          Left err -> prettyThrowM $ ExtractTemplateFailed name path err
+          Right template ->
+              pure template
+      else prettyThrowM $ LoadTemplateFailed name path
+
+  relSettings :: String -> Maybe (RIO env TemplateDownloadSettings)
+  relSettings req = do
+    rtp <- parseRepoPathWithService defaultRepoService (T.pack req)
+    pure (settingsFromRepoTemplatePath rtp)
+
+  downloadFromUrl :: TemplateDownloadSettings -> Path Abs Dir -> RIO env Text
+  downloadFromUrl settings templateDir = do
+    let url = tplDownloadUrl settings
+        mBasicAuth = tplBasicAuth settings
+        rel = fromMaybe backupUrlRelPath (parseRelFile url)
+    downloadTemplate url mBasicAuth (tplExtract settings) (templateDir </> rel)
+
+  downloadTemplate ::
+       String
+    -> Maybe (ByteString, ByteString)
+       -- ^ Optional HTTP \'Basic\' authentication (type, credentials)
+    -> (ByteString -> Either String Text)
+    -> Path Abs File
+    -> RIO env Text
+  downloadTemplate url mBasicAuth extract path = do
+    req <- parseRequest url
+    let authReq = maybe id (uncurry applyBasicAuth) mBasicAuth req
+        dReq = setForceDownload True $
+                   mkDownloadRequest (setRequestCheckStatus authReq)
+    logIt RemoteTemp
+    catch
+      ( do let label = T.pack $ toFilePath path
+           res <- verifiedDownloadWithProgress dReq path label Nothing
+           if res
+             then logStickyDone ("Downloaded " <> display label <> ".")
+             else logStickyDone "Already downloaded."
+      )
+      (useCachedVersionOrThrow url path)
+    loadLocalFile path extract
+
+  useCachedVersionOrThrow :: String
+                          -> Path Abs File
+                          -> VerifiedDownloadException
+                          -> RIO env ()
+  useCachedVersionOrThrow url path exception = do
+    exists <- doesFileExist path
+
+    if exists
+      then
+        prettyWarn
+          ( flow "Tried to download the template but an error was \
+                 \found. Using cached local version. It may not be the \
+                 \most recent version though."
+          )
+      else
+        prettyThrowM $ DownloadTemplateFailed (templateName name) url exception
+
+-- | Type representing settings for the download of Stack project templates.
+data TemplateDownloadSettings = TemplateDownloadSettings
+  { tplDownloadUrl :: String
+  , tplBasicAuth :: Maybe (ByteString, ByteString)
+    -- ^ Optional HTTP 'Basic' authentication (type, credentials)
+  , tplExtract :: ByteString -> Either String Text
+  }
+
+eitherByteStringToText :: ByteString -> Either String Text
+eitherByteStringToText = mapLeft show . decodeUtf8'
+
+asIsFromUrl :: String -> TemplateDownloadSettings
+asIsFromUrl url = TemplateDownloadSettings
+  { tplDownloadUrl = url
+  , tplBasicAuth = Nothing
+  , tplExtract = eitherByteStringToText
+  }
+
+-- | Construct settings for downloading a Stack project template from a
+-- repository.
+settingsFromRepoTemplatePath ::
+    HasTerm env
+ => RepoTemplatePath
+ -> RIO env TemplateDownloadSettings
+settingsFromRepoTemplatePath (RepoTemplatePath GitHub user name) = do
+  let basicAuthMsg token = prettyInfoL
+        [ flow "Using content of"
+        , fromString token
+        , flow " environment variable to authenticate GitHub REST API."
+        ]
+  mBasicAuth <- do
+    wantGitHubToken <- liftIO $ fromMaybe "" <$> lookupEnv gitHubTokenEnvVar
+    if not (L.null wantGitHubToken)
+      then do
+         basicAuthMsg gitHubTokenEnvVar
+         pure $ Just (gitHubBasicAuthType, fromString wantGitHubToken)
+      else do
+        wantAltGitHubToken <-
+          liftIO $ fromMaybe "" <$> lookupEnv altGitHubTokenEnvVar
+        if not (L.null wantAltGitHubToken)
+        then do
+          basicAuthMsg altGitHubTokenEnvVar
+          pure $ Just (gitHubBasicAuthType, fromString wantAltGitHubToken)
+        else pure Nothing
+  pure $ TemplateDownloadSettings
+    { tplDownloadUrl = concat
+        [ "https://api.github.com/repos/"
+        , T.unpack user
+        , "/stack-templates/contents/"
+        , T.unpack name
+        ]
+    , tplBasicAuth = mBasicAuth
+    , tplExtract = \bs -> do
+        decodedJson <- eitherDecode (LB.fromStrict bs)
+        case decodedJson of
+          Object o | Just (String content) <- KeyMap.lookup "content" o -> do
+            let noNewlines = T.filter (/= '\n')
+            bsContent <- B64.decode $ T.encodeUtf8 (noNewlines content)
+            mapLeft show $ decodeUtf8' bsContent
+          _ ->
+            Left "Couldn't parse GitHub response as a JSON object with a \
+                 \\"content\" field"
+    }
+settingsFromRepoTemplatePath (RepoTemplatePath GitLab user name) = pure $
+  asIsFromUrl $ concat
+    [ "https://gitlab.com"
+    , "/"
+    , T.unpack user
+    , "/stack-templates/raw/master/"
+    , T.unpack name
+    ]
+settingsFromRepoTemplatePath (RepoTemplatePath Bitbucket user name) = pure $
+  asIsFromUrl $ concat
+    [ "https://bitbucket.org"
+    , "/"
+    , T.unpack user
+    , "/stack-templates/raw/master/"
+    , T.unpack name
+    ]
+
+-- | Apply and unpack a template into a directory.
+applyTemplate ::
+     HasConfig env
+  => PackageName
+  -> TemplateName
+  -> Map Text Text
+  -> Path Abs Dir
+  -> Text
+  -> RIO env (Map (Path Abs File) LB.ByteString)
+applyTemplate project template nonceParams dir templateText = do
+  config <- view configL
+  currentYear <- do
+    now <- liftIO getCurrentTime
+    let (year, _, _) = toGregorian (utctDay now)
+    pure $ T.pack . show $ year
+  let context = M.unions [nonceParams, nameParams, configParams, yearParam]
+       where
+        nameAsVarId = T.replace "-" "_" $ T.pack $ packageNameString project
+        nameAsModule = T.filter (/= ' ') $ T.toTitle $ T.replace "-" " " $
+                           T.pack $ packageNameString project
+        nameParams = M.fromList [ ("name", T.pack $ packageNameString project)
+                                , ("name-as-varid", nameAsVarId)
+                                , ("name-as-module", nameAsModule) ]
+        configParams = configTemplateParams config
+        yearParam = M.singleton "year" currentYear
+  files :: Map FilePath LB.ByteString <-
+    catch
+      ( execWriterT $ runConduit $
+            yield (T.encodeUtf8 templateText) .|
+            unpackTemplate receiveMem id
+      )
+      ( \(e :: ProjectTemplateException) ->
+          prettyThrowM $ TemplateInvalid template (string $ displayException e)
+      )
+  when (M.null files) $
+    prettyThrowM $ TemplateInvalid
+      template
+      (flow "the template does not contain any files.")
+
+  let isPkgSpec f = ".cabal" `L.isSuffixOf` f || f == "package.yaml"
+  unless (any isPkgSpec . M.keys $ files) $
+    prettyThrowM $ TemplateInvalid
+      template
+      (flow "the template does not contain a Cabal or package.yaml file.")
+
+    -- Apply Mustache templating to a single file within the project template.
+  let applyMustache bytes
+        -- Workaround for performance problems with mustache and
+        -- large files, applies to Yesod templates with large
+        -- bootstrap CSS files. See
+        -- https://github.com/commercialhaskell/stack/issues/4133.
+        | LB.length bytes < 50000
+        , Right text <- TLE.decodeUtf8' bytes = do
+            let etemplateCompiled =
+                  Mustache.compileTemplate (T.unpack (templateName template)) $ TL.toStrict text
+            templateCompiled <- case etemplateCompiled of
+              Left e -> prettyThrowM $ TemplateInvalid
+                template
+                (  flow "Stack encountered the following error:"
+                <> blankLine
+                   -- Text.Parsec.Error.ParseError is not an instance
+                   -- of Control.Exception.
+                <> string (show e)
+                )
+              Right t -> pure t
+            let (substitutionErrors, applied) =
+                  Mustache.checkedSubstitute templateCompiled context
+                missingKeys =
+                  S.fromList $ concatMap onlyMissingKeys substitutionErrors
+            pure (LB.fromStrict $ encodeUtf8 applied, missingKeys)
+
+        -- Too large or too binary
+        | otherwise = pure (bytes, S.empty)
+
+      -- Accumulate any missing keys as the file is processed
+      processFile mks (fpOrig, bytes) = do
+        -- Apply the mustache template to the filenames as well, so that we
+        -- can have file names depend on the project name.
+        (fp, mks1) <- applyMustache $ TLE.encodeUtf8 $ TL.pack fpOrig
+        path <- parseRelFile $ TL.unpack $ TLE.decodeUtf8 fp
+        (bytes', mks2) <- applyMustache bytes
+        pure (mks <> mks1 <> mks2, (dir </> path, bytes'))
+
+  (missingKeys, results) <- mapAccumLM processFile S.empty (M.toList files)
+  unless (S.null missingKeys) $
+    prettyNote $
+      missingParameters
+        missingKeys
+        (configUserConfigPath config)
+  pure $ M.fromList results
+ where
+  onlyMissingKeys (Mustache.VariableNotFound ks) = map T.unpack ks
+  onlyMissingKeys _ = []
+
+  mapAccumLM :: Monad m => (a -> b -> m(a, c)) -> a -> [b] -> m(a, [c])
+  mapAccumLM _ a [] = pure (a, [])
+  mapAccumLM f a (x:xs) = do
+    (a', c) <- f a x
+    (a'', cs) <- mapAccumLM f a' xs
+    pure (a'', c:cs)
+
+  missingParameters :: Set String -> Path Abs File -> StyleDoc
+  missingParameters missingKeys userConfigPath =
+       fillSep
+         ( flow "The following parameters were needed by the template but \
+                \not provided:"
+         : mkNarrativeList Nothing False
+             (map toStyleDoc (S.toList missingKeys))
+         )
+    <> blankLine
+    <> fillSep
+         [ flow "You can provide them in Stack's global YAML configuration \
+                \file"
+         , "(" <> pretty userConfigPath <> ")"
+         , "like this:"
+         ]
+    <> blankLine
+    <> "templates:"
+    <> line
+    <> "  params:"
+    <> line
+    <> vsep
+         ( map
+             (\key -> "    " <> fromString key <> ": value")
+             (S.toList missingKeys)
+         )
+    <> blankLine
+    <> flow "Or you can pass each one on the command line as parameters \
+            \like this:"
+    <> blankLine
+    <> style Shell
+         ( fillSep
+             [ flow "stack new"
+             , fromString (packageNameString project)
+             , fromString $ T.unpack (templateName template)
+             , hsep $
+                 map
+                   ( \key ->
+                       fillSep [ "-p"
+                               , "\"" <> fromString key <> ":value\""
+                               ]
+                   )
+                   (S.toList missingKeys)
+             ]
+         )
+    <> line
+   where
+    toStyleDoc :: String -> StyleDoc
+    toStyleDoc = fromString
+
+-- | Check if we're going to overwrite any existing files.
+checkForOverwrite ::
+     (MonadIO m, MonadThrow m)
+  => Text
+  -> [Path Abs File]
+  -> m ()
+checkForOverwrite name files = do
+  overwrites <- filterM doesFileExist files
+  unless (null overwrites) $
+    prettyThrowM $ AttemptedOverwrites name overwrites
+
+-- | Write files to the new project directory.
+writeTemplateFiles ::
+     MonadIO m
+  => Map (Path Abs File) LB.ByteString
+  -> m ()
+writeTemplateFiles files =
+  liftIO $
+  forM_
+    (M.toList files)
+    (\(fp,bytes) ->
+      do ensureDir (parent fp)
+         writeBinaryFileAtomic fp $ lazyByteString bytes)
+
+-- | Run any initialization functions, such as Git.
+runTemplateInits :: HasConfig env => Path Abs Dir -> RIO env ()
+runTemplateInits dir = do
+  config <- view configL
+  case configScmInit config of
+    Nothing -> pure ()
+    Just Git -> withWorkingDir (toFilePath dir) $
+      catchAny
+        (proc "git" ["init"] runProcess_)
+        ( \_ -> prettyWarn $
+                  fillSep
+                    [ flow "Stack failed to run a"
+                    , style Shell (flow "git init")
+                    , flow "command. Ignoring..."
+                    ]
+        )
+
+--------------------------------------------------------------------------------
+-- Defaults
+
+-- | The default service to use to download templates.
+defaultRepoService :: RepoService
+defaultRepoService = GitHub
src/Stack/Nix.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE ConstraintKinds    #-}
 {-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts   #-}
 {-# LANGUAGE OverloadedStrings  #-}
 
 -- | Run commands in a nix-shell
@@ -22,9 +19,11 @@                    , platformVariantEnvVar
                    )
 import           Stack.Prelude
+import           Stack.Types.BuildConfig ( wantedCompilerVersionL )
 import           Stack.Types.Config
-import           Stack.Types.Docker
-import           Stack.Types.Nix
+                   ( Config (..), HasConfig (..), configProjectRoot )
+import           Stack.Types.Docker ( reExecArgName )
+import           Stack.Types.Nix ( NixOpts (..) )
 import           Stack.Types.Version ( showStackVersion )
 import           System.Environment ( getArgs, getExecutablePath, lookupEnv )
 import qualified System.FilePath as F
@@ -117,7 +116,7 @@             ]
 
         fullArgs = concat
-          [ if pureShell then ["--pure"] else []
+          [ [ "--pure" | pureShell ]
           , if addGCRoots
               then [ "--indirect"
                    , "--add-root"
src/Stack/Options/BenchParser.hs view
@@ -10,7 +10,7 @@ import           Options.Applicative.Builder.Extra ( optionalFirst )
 import           Stack.Prelude
 import           Stack.Options.Utils ( hideMods )
-import           Stack.Types.Config ( BenchmarkOptsMonoid (..) )
+import           Stack.Types.BuildOpts ( BenchmarkOptsMonoid (..) )
 
 -- | Parser for bench arguments.
 -- FIXME hiding options
@@ -21,7 +21,7 @@         <> long "ba"
         <> metavar "BENCH_ARGS"
         <> help "Forward BENCH_ARGS to the benchmark suite. Supports templates \
-                \from `cabal bench`"
+                \from 'cabal bench'."
         <> hide
         ))
   <*> optionalFirst (flag' True
src/Stack/Options/BuildMonoidParser.hs view
@@ -23,7 +23,7 @@ import           Stack.Options.TestParser ( testOptsParser )
 import           Stack.Options.HaddockParser ( haddockOptsParser )
 import           Stack.Options.Utils ( GlobalOptsContext (..), hideMods )
-import           Stack.Types.Config.Build
+import           Stack.Types.BuildOpts
                    ( BuildOptsMonoid (..), CabalVerbosity
                    , toFirstCabalVerbosity
                    )
@@ -74,7 +74,7 @@       (  long "trace"
       <> help
              "Enable profiling in libraries, executables, etc. for all \
-             \expressions and generate a backtrace on exception"
+             \expressions and generate a backtrace on exception."
       <> hideExceptGhci
       )
   profile = Any <$>
@@ -85,7 +85,7 @@       <> help
              "Enable profiling in libraries, executables, etc. for all \
              \expressions and generate a profiling report in tests or \
-             \benchmarks"
+             \benchmarks."
       <> hideExceptGhci
       )
   noStrip = Any <$>
@@ -103,81 +103,83 @@       )
   libProfiling = firstBoolFlagsFalse
     "library-profiling"
-    "library profiling for TARGETs and all its dependencies"
+    "library profiling for TARGETs and all its dependencies."
     hide
   exeProfiling = firstBoolFlagsFalse
     "executable-profiling"
-    "executable profiling for TARGETs and all its dependencies"
+    "executable profiling for TARGETs and all its dependencies."
     hide
   libStripping = firstBoolFlagsTrue
     "library-stripping"
-    "library stripping for TARGETs and all its dependencies"
+    "library stripping for TARGETs and all its dependencies."
     hide
   exeStripping = firstBoolFlagsTrue
     "executable-stripping"
-    "executable stripping for TARGETs and all its dependencies"
+    "executable stripping for TARGETs and all its dependencies."
     hide
   haddock = firstBoolFlagsFalse
     "haddock"
-    "generating Haddocks the package(s) in this directory/configuration"
+    "generating Haddock documentation for the package(s) in this \
+    \directory/configuration."
     hide
   openHaddocks = firstBoolFlagsFalse
     "open"
-    "opening the local Haddock documentation in the browser"
+    "opening the local Haddock documentation in the browser."
     hide
   haddockDeps = firstBoolFlagsNoDefault
     "haddock-deps"
-    "building Haddocks for dependencies (default: true if building Haddocks, \
-    \false otherwise)"
+    "building Haddock documentation for dependencies. (default: if building \
+    \Haddock documentation, true; otherwise, false)"
     hide
   haddockInternal = firstBoolFlagsFalse
     "haddock-internal"
-    "building Haddocks for internal modules (like cabal haddock --internal)"
+    "building Haddock documentation for internal modules (like \
+    \'cabal haddock --internal')."
     hide
   haddockHyperlinkSource = firstBoolFlagsTrue
     "haddock-hyperlink-source"
-    "building hyperlinked source for Haddock (like haddock \
-    \--hyperlinked-source)"
+    "building hyperlinked source for Haddock documentation (like \
+    \'haddock --hyperlinked-source')."
     hide
   copyBins = firstBoolFlagsFalse
     "copy-bins"
-    "copying binaries to local-bin (see 'stack path')"
+    "copying binaries to local-bin (see 'stack path')."
     hide
   copyCompilerTool = firstBoolFlagsFalse
     "copy-compiler-tool"
-    "copying binaries of targets to compiler-tools-bin (see 'stack path')"
+    "copying binaries of targets to compiler-tools-bin (see 'stack path')."
     hide
   keepGoing = firstBoolFlagsNoDefault
     "keep-going"
-    "continue running after a step fails (default: false for build, true for \
-    \test/bench)"
+    "continue running after a step fails. (default: for 'build', false; for \
+    \'test' or 'bench', true)"
     hide
   keepTmpFiles = firstBoolFlagsFalse
     "keep-tmp-files"
-    "keep intermediate files and build directories"
+    "keep intermediate files and build directories."
     hide
   preFetch = firstBoolFlagsFalse
     "prefetch"
-    "fetching packages necessary for the build immediately, useful with \
-    \--dry-run"
+    "fetching packages necessary for the build immediately. Useful with \
+    \--dry-run."
     hide
   forceDirty = firstBoolFlagsFalse
     "force-dirty"
-    "forcing the treatment of all local packages as having dirty files, \
-    \useful for cases where Stack can't detect a file change"
+    "forcing the treatment of all local packages as having dirty files. \
+    \Useful for cases where Stack can't detect a file change."
     hide
   tests = firstBoolFlagsFalse
     "test"
-    "testing the package(s) in this directory/configuration"
+    "testing the package(s) in this directory/configuration."
     hideExceptGhci
   benches = firstBoolFlagsFalse
     "bench"
-    "benchmarking the package(s) in this directory/configuration"
+    "benchmarking the package(s) in this directory/configuration."
     hideExceptGhci
   reconfigure = firstBoolFlagsFalse
     "reconfigure"
     "performing the configure step, even if unnecessary. Useful in some \
-    \corner cases with custom Setup.hs files"
+    \corner cases with custom Setup.hs files."
     hide
   cabalVerbose = cabalVerbosityOptsParser hideBool
   splitObjs = firstBoolFlagsFalse
@@ -188,17 +190,17 @@     hide
   skipComponents = many (fmap T.pack (strOption
     (  long "skip"
-    <> help "Skip given component (can be specified multiple times)"
+    <> help "Skip given component (can be specified multiple times)."
     <> hide
     )))
   interleavedOutput = firstBoolFlagsTrue
     "interleaved-output"
     "printing concurrent GHC output to the console with a prefix for the \
-    \package name"
+    \package name."
     hide
   ddumpDir = optionalFirst (strOption
     (  long "ddump-dir"
-    <> help "Specify output ddump-files"
+    <> help "Specify output directory for ddump-files."
     <> hide
     ))
 
@@ -213,7 +215,8 @@   let pCabalVerbosity = option (eitherReader eitherParsec)
         (  long "cabal-verbosity"
         <> metavar "VERBOSITY"
-        <> help "Cabal verbosity (accepts Cabal's numerical and extended syntax)"
+        <> help "Cabal verbosity (accepts Cabal's numerical and extended \
+                \syntax)."
         <> hideMods hide)
   in  First . Just <$> pCabalVerbosity
 
@@ -222,6 +225,6 @@ cabalVerboseParser hide =
   let pVerboseFlag = firstBoolFlagsFalse
                        "cabal-verbose"
-                       "asking Cabal to be verbose in its output"
+                       "asking Cabal to be verbose in its output."
                        (hideMods hide)
   in  toFirstCabalVerbosity <$> pVerboseFlag
src/Stack/Options/BuildParser.hs view
@@ -7,97 +7,107 @@   , targetsParser
   ) where
 
+import qualified Data.List as L
 import qualified Data.Map as Map
+import qualified Data.Text as T
 import           Options.Applicative
-import           Options.Applicative.Args
-import           Options.Applicative.Builder.Extra
+                   ( Parser, completer, flag, flag', help, internal, long
+                   , metavar, option, strOption, switch, value
+                   )
+import           Options.Applicative.Args ( cmdOption )
+import           Options.Applicative.Builder.Extra ( textArgument, textOption )
 import           Stack.Options.Completion
+                   ( flagCompleter, ghcOptsCompleter, targetCompleter )
 import           Stack.Options.PackageParser ( readFlag )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.BuildOpts
+                   ( ApplyCLIFlag, BuildCommand, BuildOptsCLI (..)
+                   , BuildSubset (..), FileWatchOpts (..)
+                   )
 
 -- | Parser for CLI-only build arguments
-buildOptsParser :: BuildCommand
-                -> Parser BuildOptsCLI
+buildOptsParser :: BuildCommand -> Parser BuildOptsCLI
 buildOptsParser cmd = BuildOptsCLI
   <$> targetsParser
   <*> switch
         (  long "dry-run"
-        <> help "Don't build anything, just prepare to"
+        <> help "Don't build anything, just prepare to."
         )
   <*> (   (\x y z -> concat [x, y, z])
       <$> flag
             []
             ["-Wall", "-Werror"]
             (  long "pedantic"
-            <> help "Turn on -Wall and -Werror"
+            <> help "Turn on -Wall and -Werror."
             )
       <*> flag
             []
             ["-O0"]
             (  long "fast"
-            <> help "Turn off optimizations (-O0)"
+            <> help "Turn off optimizations (-O0)."
             )
       <*> many (textOption
             (  long "ghc-options"
             <> metavar "OPTIONS"
             <> completer ghcOptsCompleter
-            <> help "Additional options passed to GHC"
+            <> help "Additional options passed to GHC (can be specified \
+                    \multiple times)."
             ))
       )
+  <*> progsOptionsParser
   <*> flagsParser
   <*> (   flag' BSOnlyDependencies
             (  long "dependencies-only"
-            <> help "A synonym for --only-dependencies"
+            <> help "A synonym for --only-dependencies."
             )
       <|> flag' BSOnlySnapshot
             (  long "only-snapshot"
             <> help "Only build packages for the snapshot database, not the \
-                    \local database"
+                    \local database."
             )
       <|> flag' BSOnlyDependencies
             (  long "only-dependencies"
             <> help "Only build packages that are dependencies of targets on \
-                    \the command line"
+                    \the command line."
             )
       <|> flag' BSOnlyLocals
             (  long "only-locals"
-            <> help "Only build packages in the local database, fail if the \
-                    \build plan includes the snapshot database"
+            <> help "Only build packages in the local database. Fail if the \
+                    \build plan includes the snapshot database."
             )
       <|> pure BSAll
       )
   <*> (   flag' FileWatch
             (  long "file-watch"
             <> help "Watch for changes in local files and automatically \
-                    \rebuild. Ignores files in VCS boring/ignore file"
+                    \rebuild."
             )
       <|> flag' FileWatchPoll
             (  long "file-watch-poll"
             <> help "Like --file-watch, but polling the filesystem instead of \
-                    \using events"
+                    \using events."
             )
       <|> pure NoFileWatch
       )
   <*> switch
         (  long "watch-all"
-        <> help "Watch all local files not taking targets into account"
+        <> help "Watch all local files not taking targets into account."
         )
   <*> many (cmdOption
         (  long "exec"
         <> metavar "COMMAND [ARGUMENT(S)]"
-        <> help "Command and argument(s) to run after a successful build"
+        <> help "Command and argument(s) to run after a successful build."
         ))
   <*> switch
         (  long "only-configure"
         <> help "Only perform the configure step, not any builds. Intended for \
-                \tool usage, may break when used on multiple packages at once!"
+                \tool usage. May break when used on multiple packages at once!"
         )
   <*> pure cmd
   <*> switch
         (  long "initial-build-steps"
         <> help "For target packages, only run initial build steps needed for \
-                \GHCi"
+                \GHCi."
         <> internal
         )
 
@@ -118,5 +128,52 @@        <> completer flagCompleter
        <> metavar "PACKAGE:[-]FLAG"
        <> help "Override flags set in stack.yaml (applies to local packages \
-               \and extra-deps)"
+               \and extra-deps)."
        ))
+
+progsOptionsParser :: Parser [(Text, [Text])]
+progsOptionsParser =
+     dummyProgOptionsParser
+  *> (filter (not . L.null . snd) <$> progsOptionsParser')
+ where
+  -- The purpose of this parser is only to generate the desired help text. The
+  -- actual --PROG-options parsers are all internal.
+  dummyProgOptionsParser :: Parser String
+  dummyProgOptionsParser = strOption
+    ( long "PROG-option"
+    <> help
+         (  "Pass an argument to PROG (can be specified multiple times). PROG \
+            \must be a program recognised by the Cabal library and one of "
+         <> T.unpack (T.intercalate " " progs) <> "."
+         )
+    <> metavar "ARG"
+    <> value ""
+    )
+  progs :: [Text]
+  progs = L.sort
+    [
+      -- configuration
+      "pkg-config"
+      -- preprocessors
+    , "alex"
+    , "c2hs"
+    , "cpphs"
+--  , "doctest -- Not present in Cabal-1.22.5.0.
+    , "greencard"
+    , "happy"
+    , "hsc2hs"
+    , "hscolour"
+      -- platform toolchain (GNU)
+    , "ar"  -- create, modify, and extract from archives
+    , "gcc" -- C/C++ compiler
+    , "ld" -- linker
+    , "strip" -- discards symbols and other data from object files
+    , "tar"
+    ]
+  progsOptionsParser' :: Parser [(Text, [Text])]
+  progsOptionsParser' = traverse mkProgOptionsParser progs
+  mkProgOptionsParser :: Text -> Parser (Text, [Text])
+  mkProgOptionsParser prog = fmap (prog,) $ many $ textOption
+    (  long (T.unpack prog <> "-option")
+    <> internal
+    )
src/Stack/Options/CleanParser.hs view
@@ -17,7 +17,7 @@  where
   packages = many (packageNameArgument
     (  metavar "PACKAGE"
-    <> help "If none specified, clean all project packages"
+    <> help "If none specified, clean all project packages."
     ))
   doFullClean = flag' CleanFull
     (  long "full"
src/Stack/Options/Completion.hs view
@@ -1,56 +1,64 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
 
 module Stack.Options.Completion
-    ( ghcOptsCompleter
-    , targetCompleter
-    , flagCompleter
-    , projectExeCompleter
-    ) where
+  ( ghcOptsCompleter
+  , targetCompleter
+  , flagCompleter
+  , projectExeCompleter
+  ) where
 
 import           Data.Char ( isSpace )
 import           Data.List ( isPrefixOf )
 import qualified Data.Map as Map
-import           Data.Maybe
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Distribution.PackageDescription as C
-import           Options.Applicative
-import           Options.Applicative.Builder.Extra
+import           Options.Applicative ( Completer, mkCompleter )
+import           Options.Applicative.Builder.Extra ( unescapeBashArg )
 import           Stack.Constants ( ghcShowOptionsOutput )
 import           Stack.Options.GlobalParser ( globalOptsFromMonoid )
 import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig
+                   , withRunnerGlobal
+                   )
 import           Stack.Prelude
-import           Stack.Types.Config
-import           Stack.Types.NamedComponent
-import           Stack.Types.SourceMap
+import           Stack.Types.BuildConfig ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.Config ( Config (..) )
+import           Stack.Types.EnvConfig ( EnvConfig )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
+import           Stack.Types.NamedComponent ( renderPkgComponent )
+import           Stack.Types.SourceMap ( SMWanted (..), ppComponents, ppGPD )
 
 ghcOptsCompleter :: Completer
 ghcOptsCompleter = mkCompleter $ \inputRaw -> pure $
-    let input = unescapeBashArg inputRaw
-        (curArgReversed, otherArgsReversed) = break isSpace (reverse input)
-        curArg = reverse curArgReversed
-        otherArgs = reverse otherArgsReversed
-     in if null curArg then [] else
-         map (otherArgs ++) $
-         filter (curArg `isPrefixOf`) ghcShowOptionsOutput
+  let input = unescapeBashArg inputRaw
+      (curArgReversed, otherArgsReversed) = break isSpace (reverse input)
+      curArg = reverse curArgReversed
+      otherArgs = reverse otherArgsReversed
+  in  if null curArg
+        then []
+        else
+          map (otherArgs ++) $
+          filter (curArg `isPrefixOf`) ghcShowOptionsOutput
 
 -- TODO: Ideally this would pay attention to --stack-yaml, may require
 -- changes to optparse-applicative.
 
-buildConfigCompleter
-    :: (String -> RIO EnvConfig [String])
-    -> Completer
+buildConfigCompleter ::
+     (String -> RIO EnvConfig [String])
+  -> Completer
 buildConfigCompleter inner = mkCompleter $ \inputRaw -> do
-    let input = unescapeBashArg inputRaw
-    case input of
-        -- If it looks like a flag, skip this more costly completion.
-        ('-': _) -> pure []
-        _ -> do
-            go' <- globalOptsFromMonoid False mempty
-            let go = go' { globalLogLevel = LevelOther "silent" }
-            withRunnerGlobal go $ withConfig NoReexec $ withDefaultEnvConfig $ inner input
+  let input = unescapeBashArg inputRaw
+  case input of
+    -- If it looks like a flag, skip this more costly completion.
+    ('-': _) -> pure []
+    _ -> do
+      go' <- globalOptsFromMonoid False mempty
+      let go = go' { globalLogLevel = LevelOther "silent" }
+      withRunnerGlobal go $ withConfig NoReexec $ withDefaultEnvConfig $ inner input
 
 targetCompleter :: Completer
 targetCompleter = buildConfigCompleter $ \input -> do
@@ -60,41 +68,41 @@     $ filter (input `isPrefixOf`)
     $ concatMap allComponentNames
     $ Map.toList comps
-  where
-    allComponentNames (name, comps) =
-        map (T.unpack . renderPkgComponent . (name,)) (Set.toList comps)
+ where
+  allComponentNames (name, comps) =
+    map (T.unpack . renderPkgComponent . (name,)) (Set.toList comps)
 
 flagCompleter :: Completer
 flagCompleter = buildConfigCompleter $ \input -> do
-    bconfig <- view buildConfigL
-    gpds <- for (smwProject $ bcSMWanted bconfig) ppGPD
-    let wildcardFlags
-            = nubOrd
-            $ concatMap (\(name, gpd) ->
-                map (\fl -> "*:" ++ flagString name fl) (C.genPackageFlags gpd))
-            $ Map.toList gpds
-        normalFlags
-            = concatMap (\(name, gpd) ->
-                map (\fl -> packageNameString name ++ ":" ++ flagString name fl)
-                    (C.genPackageFlags gpd))
-            $ Map.toList gpds
-        flagString name fl =
-            let flname = C.unFlagName $ C.flagName fl
-             in (if flagEnabled name fl then "-" else "") ++ flname
-        prjFlags =
-          case configProject (bcConfig bconfig) of
-            PCProject (p, _) -> projectFlags p
-            PCGlobalProject -> mempty
-            PCNoProject _ -> mempty
-        flagEnabled name fl =
-            fromMaybe (C.flagDefault fl) $
-            Map.lookup (C.flagName fl) $
-            Map.findWithDefault Map.empty name prjFlags
-    pure $ filter (input `isPrefixOf`) $
-        case input of
-            ('*' : ':' : _) -> wildcardFlags
-            ('*' : _) -> wildcardFlags
-            _ -> normalFlags
+  bconfig <- view buildConfigL
+  gpds <- for (smwProject $ bcSMWanted bconfig) ppGPD
+  let wildcardFlags
+        = nubOrd
+        $ concatMap (\(name, gpd) ->
+            map (\fl -> "*:" ++ flagString name fl) (C.genPackageFlags gpd))
+        $ Map.toList gpds
+      normalFlags
+        = concatMap (\(name, gpd) ->
+            map (\fl -> packageNameString name ++ ":" ++ flagString name fl)
+                (C.genPackageFlags gpd))
+        $ Map.toList gpds
+      flagString name fl =
+        let flname = C.unFlagName $ C.flagName fl
+        in  (if flagEnabled name fl then "-" else "") ++ flname
+      prjFlags =
+        case configProject (bcConfig bconfig) of
+          PCProject (p, _) -> projectFlags p
+          PCGlobalProject -> mempty
+          PCNoProject _ -> mempty
+      flagEnabled name fl =
+        fromMaybe (C.flagDefault fl) $
+        Map.lookup (C.flagName fl) $
+        Map.findWithDefault Map.empty name prjFlags
+  pure $ filter (input `isPrefixOf`) $
+    case input of
+      ('*' : ':' : _) -> wildcardFlags
+      ('*' : _) -> wildcardFlags
+      _ -> normalFlags
 
 projectExeCompleter :: Completer
 projectExeCompleter = buildConfigCompleter $ \input -> do
@@ -104,8 +112,5 @@     $ filter (input `isPrefixOf`)
     $ nubOrd
     $ concatMap
-        (\gpd -> map
-          (C.unUnqualComponentName . fst)
-          (C.condExecutables gpd)
-        )
+        (map (C.unUnqualComponentName . fst) . C.condExecutables)
         gpds
src/Stack/Options/ConfigParser.hs view
@@ -15,7 +15,7 @@                    , firstBoolFlagsNoDefault, firstBoolFlagsTrue, optionalFirst
                    , pathCompleterWith
                    )
-import           Path ( parseRelDir )
+import           Path ( PathException (..), parseRelDir )
 import           Stack.Constants ( stackRootOptionName )
 import           Stack.Options.BuildMonoidParser ( buildOptsMonoidParser )
 import           Stack.Options.DockerParser ( dockerOptsParser )
@@ -24,8 +24,9 @@ import           Stack.Options.NixParser ( nixOptsParser )
 import           Stack.Options.Utils ( GlobalOptsContext (..), hideMods )
 import           Stack.Prelude
-import           Stack.Types.Config
-                   ( ConfigMonoid (..), DumpLogs (..), readColorWhen )
+import           Stack.Types.ColorWhen ( readColorWhen )
+import           Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
+import           Stack.Types.DumpLogs ( DumpLogs (..) )
 import qualified System.FilePath as FilePath
 
 -- | Command-line arguments parser for configuration.
@@ -66,8 +67,8 @@   <$> optionalFirst (absDirOption
         ( long stackRootOptionName
         <> metavar (map toUpper stackRootOptionName)
-        <> help "Absolute path to the global Stack root directory (Overrides \
-                \any STACK_ROOT environment variable)"
+        <> help "Absolute path to the global Stack root directory. Overrides \
+                \any STACK_ROOT environment variable."
         <> hide
         ))
   <*> optionalFirst (option (eitherReader (mapLeft showWorkDirError . parseRelDir))
@@ -79,8 +80,8 @@                    { pcoAbsolute = False, pcoFileFilter = const False }
                )
              )
-        <> help "Relative path of work directory (Overrides any STACK_WORK \
-                \environment variable, default is '.stack-work')"
+        <> help "Relative path to Stack's work directory. Overrides any \
+                \STACK_WORK environment variable. (default: '.stack-work')"
         <> hide
         ))
   <*> buildOptsMonoidParser hide0
@@ -89,17 +90,17 @@   <*> firstBoolFlagsNoDefault
         "system-ghc"
         "using the system installed GHC (on the PATH) if it is available and \
-        \its version matches. Disabled by default."
+        \its version matches. (default: disabled)"
         hide
   <*> firstBoolFlagsTrue
         "install-ghc"
-        "downloading and installing GHC if necessary (can be done manually \
-        \with 'stack setup')"
+        "downloading and installing GHC if necessary. (Can be done manually \
+        \with 'stack setup'.)"
         hide
   <*> optionalFirst (strOption
         (  long "arch"
         <> metavar "ARCH"
-        <> help "System architecture, e.g. i386, x86_64"
+        <> help "System architecture, e.g. i386, x86_64."
         <> hide
         ))
   <*> optionalFirst (ghcVariantParser (hide0 /= OuterGlobalOpts))
@@ -108,75 +109,77 @@         (  long "jobs"
         <> short 'j'
         <> metavar "JOBS"
-        <> help "Number of concurrent jobs to run"
+        <> help "Number of concurrent jobs to run."
         <> hide
         ))
   <*> many ((currentDir FilePath.</>) <$> strOption
         (  long "extra-include-dirs"
         <> metavar "DIR"
         <> completer dirCompleter
-        <> help "Extra directories to check for C header files"
+        <> help "Extra directories to check for C header files."
         <> hide
         ))
   <*> many ((currentDir FilePath.</>) <$> strOption
         (  long "extra-lib-dirs"
         <> metavar "DIR"
         <> completer dirCompleter
-        <> help "Extra directories to check for libraries"
+        <> help "Extra directories to check for libraries."
         <> hide
         ))
   <*> many (strOption
         (  long "custom-preprocessor-extensions"
         <> metavar "EXT"
-        <> help "Extensions used for custom preprocessors"
+        <> help "Extensions used for custom preprocessors."
         <> hide
         ))
   <*> optionalFirst (absFileOption
         (  long "with-gcc"
         <> metavar "PATH-TO-GCC"
-        <> help "Use gcc found at PATH-TO-GCC"
+        <> help "Use gcc found at PATH-TO-GCC."
         <> hide
         ))
   <*> optionalFirst (strOption
         (  long "with-hpack"
         <> metavar "HPACK"
-        <> help "Use HPACK executable (overrides bundled Hpack)"
+        <> help "Use HPACK executable (overrides bundled Hpack)."
         <> hide
         ))
   <*> firstBoolFlagsFalse
         "skip-ghc-check"
-        "skipping the GHC version and architecture check"
+        "skipping the GHC version and architecture check."
         hide
   <*> firstBoolFlagsFalse
         "skip-msys"
-        "skipping the local MSYS installation (Windows only)"
+        "skipping the local MSYS installation (Windows only)."
         hide
   <*> optionalFirst ((currentDir FilePath.</>) <$> strOption
         ( long "local-bin-path"
         <> metavar "DIR"
         <> completer dirCompleter
-        <> help "Install binaries to DIR"
+        <> help "Override the target directory for 'stack build --copy-bins' \
+                \and 'stack install'. DIR can be an absolute path or one \
+                \relative to the current directory."
         <> hide
         ))
   <*> many (strOption
         (  long "setup-info-yaml"
-        <> help "Alternate URL or relative / absolute path for Stack \
-                \dependencies"
+        <> help "Alternate URL or path (relative or absolute) for Stack \
+                \dependencies."
         <> metavar "URL"
         ))
   <*> firstBoolFlagsTrue
         "modify-code-page"
-        "setting the codepage to support UTF-8 (Windows only)"
+        "setting the codepage to support UTF-8 (Windows only)."
         hide
   <*> firstBoolFlagsNoDefault
         "allow-different-user"
         "permission for users other than the owner of the Stack root directory \
-        \to use a Stack installation (POSIX only) (default: true inside \
-        \Docker, otherwise false)"
+        \to use a Stack installation (POSIX only). (default: inside Docker, \
+        \ true; otherwise, false)"
         hide
   <*> fmap toDumpLogs (firstBoolFlagsNoDefault
         "dump-logs"
-        "dump the build output logs for local packages to the console \
+        "dump the build output logs for local packages to the console. \
         \(default: dump warning logs)"
         hide)
   <*> optionalFirst (option readColorWhen
@@ -188,24 +191,33 @@                 \'never', or 'auto'. On Windows versions before Windows \
                 \10, for terminals that do not support color codes, the \
                 \default is 'never'; color may work on terminals that \
-                \support color codes"
+                \support color codes."
         <> hide
         ))
   <*> optionalFirst (strOption
         (  long "snapshot-location-base"
-        <> help "The base location of LTS/Nightly snapshots"
+        <> help "The base location of LTS/Nightly snapshots."
         <> metavar "URL"
         ))
   <*> firstBoolFlagsFalse
         "script-no-run-compile"
-        "the use of options `--no-run --compile` with `stack script`"
+        "the use of options `--no-run --compile` with `stack script`."
         hide
  where
   hide = hideMods (hide0 /= OuterGlobalOpts)
   toDumpLogs (First (Just True)) = First (Just DumpAllLogs)
   toDumpLogs (First (Just False)) = First (Just DumpNoLogs)
   toDumpLogs (First Nothing) = First Nothing
-  showWorkDirError err = show err ++
-    "\nNote that --work-dir must be a relative child directory, because \
-    \work-dirs outside of the package are not supported by Cabal." ++
-    "\nSee https://github.com/commercialhaskell/stack/issues/2954"
+  showWorkDirError err = case fromException err of
+    Just (InvalidRelDir x) ->
+      "Stack failed to interpret the value of the option as a valid\n\
+      \relative path to a directory. Stack will not accept an absolute path. A \
+      \path\n\
+      \containing a .. (parent directory) component is not valid.\n\n\
+      \If set, Stack expects the value to identify the location of Stack's \
+      \work\n\
+      \directory, relative to the root directory of the project or package. \
+      \Stack\n\
+      \encountered the value:\n"
+      ++ x
+    _ -> displayException err
src/Stack/Options/DockerParser.hs view
@@ -17,6 +17,7 @@                    , firstBoolFlagsFalse, firstBoolFlagsNoDefault
                    , firstBoolFlagsTrue, optionalFirst
                    )
+import           Stack.Constants ( stackProgName )
 import           Stack.Docker ( dockerCmdName )
 import           Stack.Prelude
 import           Stack.Options.Utils ( hideMods )
@@ -40,89 +41,89 @@ dockerOptsParser hide0 = DockerOptsMonoid (Any False)
   <$> firstBoolFlagsNoDefault
         dockerCmdName
-        "using a Docker container. --docker implies 'system-ghc: true'"
+        "using a Docker container. --docker implies 'system-ghc: true'."
         hide
   <*> fmap First
         (   Just . DockerMonoidRepo <$> option str
               (  long (dockerOptName dockerRepoArgName)
               <> hide
               <> metavar "NAME"
-              <> help "Docker repository name"
+              <> help "Docker repository name."
               )
         <|> Just . DockerMonoidImage <$> option str
               (  long (dockerOptName dockerImageArgName)
               <> hide
               <> metavar "IMAGE"
-              <> help "Exact Docker image ID (overrides docker-repo)"
+              <> help "Exact Docker image ID (overrides docker-repo)."
               )
         <|> pure Nothing
         )
   <*> firstBoolFlagsNoDefault
         (dockerOptName dockerRegistryLoginArgName)
-        "registry requires login"
+        "registry requires login."
         hide
   <*> firstStrOption
         (  long (dockerOptName dockerRegistryUsernameArgName)
         <> hide
         <> metavar "USERNAME"
-        <> help "Docker registry username"
+        <> help "Docker registry username."
         )
   <*> firstStrOption
         (  long (dockerOptName dockerRegistryPasswordArgName)
         <> hide
         <> metavar "PASSWORD"
-        <> help "Docker registry password"
+        <> help "Docker registry password."
         )
   <*> firstBoolFlagsTrue
         (dockerOptName dockerAutoPullArgName)
-        "automatic pulling latest version of image"
+        "automatic pulling latest version of image."
         hide
   <*> firstBoolFlagsFalse
         (dockerOptName dockerDetachArgName)
-        "running a detached Docker container"
+        "running a detached Docker container."
         hide
   <*> firstBoolFlagsFalse
         (dockerOptName dockerPersistArgName)
-        "not deleting container after it exits"
+        "not deleting container after it exits."
         hide
   <*> firstStrOption
         (  long (dockerOptName dockerContainerNameArgName)
         <> hide
         <> metavar "NAME"
-        <> help "Docker container name"
+        <> help "Docker container name."
         )
   <*> firstStrOption
         (  long (dockerOptName dockerNetworkArgName)
         <> hide
         <> metavar "NETWORK"
-        <> help "Docker network"
+        <> help "Docker network."
         )
   <*> argsOption
         (  long (dockerOptName dockerRunArgsArgName)
         <> hide
         <> value []
         <> metavar "'ARG1 [ARG2 ...]'"
-        <> help "Additional options to pass to 'docker run'")
+        <> help "Additional options to pass to 'docker run'.")
   <*> many (option auto
         (  long (dockerOptName dockerMountArgName)
         <> hide
         <> metavar "(PATH | HOST-PATH:CONTAINER-PATH)"
         <> completer dirCompleter
         <> help "Mount volumes from host in container (can be specified \
-                \multiple times)"
+                \multiple times)."
         ))
   <*> firstStrOption
         (  long (dockerOptName dockerMountModeArgName)
         <> hide
         <> metavar "SUFFIX"
-        <> help "Volume mount mode suffix"
+        <> help "Volume mount mode suffix."
         )
   <*> many (option str
         (  long (dockerOptName dockerEnvArgName)
         <> hide
         <> metavar "NAME=VALUE"
         <> help "Set environment variable in container (can be specified \
-                \multiple times)"
+                \multiple times)."
         ))
   <*> optionalFirst (option (eitherReader' parseDockerStackExe)
         ( let specialOpts = [ dockerStackExeDownloadVal
@@ -136,13 +137,13 @@               <> help ( concat
                           [ "Location of "
                           , stackProgName
-                          , " executable used in container"
+                          , " executable used in container."
                           ]
                       )
         ))
   <*> firstBoolFlagsNoDefault
         (dockerOptName dockerSetUserArgName)
-        "setting user in container to match host"
+        "setting user in container to match host."
         hide
   <*> pure (IntersectingVersionRange anyVersion)
  where
src/Stack/Options/DotParser.hs view
@@ -48,30 +48,30 @@  where
   includeExternal = boolFlags externalDefault
     "external"
-    "inclusion of external dependencies"
+    "inclusion of external dependencies."
     idm
   includeBase = boolFlags True
     "include-base"
-    "inclusion of dependencies on base"
+    "inclusion of dependencies on base."
     idm
   depthLimit = optional (option auto
     (  long "depth"
     <> metavar "DEPTH"
-    <> help "Limit the depth of dependency resolution (Default: No limit)"
+    <> help "Limit the depth of dependency resolution. (default: no limit)"
     ))
   prunedPkgs = optional (strOption
     (  long "prune"
     <> metavar "PACKAGES"
-    <> help "Prune each package name from the comma separated list of package \
-            \names PACKAGES"
+    <> help "Prune specified package(s). PACKAGES is a comma-separated list of \
+            \package names."
     ))
   testTargets = switch
     (  long "test"
-    <> help "Consider dependencies of test components"
+    <> help "Consider dependencies of test components."
     )
   benchTargets = switch
     (  long "bench"
-    <> help "Consider dependencies of benchmark components"
+    <> help "Consider dependencies of benchmark components."
     )
 
   splitNames :: String -> [PackageName]
@@ -85,7 +85,7 @@   globalHints = switch
     (  long "global-hints"
     <> help "Do not require an install GHC; instead, use a hints file for \
-            \global packages"
+            \global packages."
     )
 
 separatorParser :: Parser Text
@@ -105,7 +105,7 @@ licenseParser :: Parser Bool
 licenseParser = boolFlags False
   "license"
-  "printing of dependency licenses instead of versions"
+  "printing of dependency licenses instead of versions."
   idm
 
 listDepsFormatOptsParser :: Parser ListDepsFormatOpts
@@ -143,19 +143,19 @@ listDepsOptsParser = subparser
       (  formatSubCommand
            "text"
-           "Print dependencies as text (default)"
+           "Print dependencies as text (default)."
            listDepsTextParser
       <> formatSubCommand
            "cabal"
-           "Print dependencies as exact Cabal constraints"
+           "Print dependencies as exact Cabal constraints."
            listDepsConstraintsParser
       <> formatSubCommand
            "tree"
-           "Print dependencies as tree"
+           "Print dependencies as tree."
            listDepsTreeParser
       <> formatSubCommand
            "json"
-           "Print dependencies as JSON"
+           "Print dependencies as JSON."
            listDepsJsonParser
       )
   <|> toListDepsOptsParser listDepsTextParser
+ src/Stack/Options/EvalParser.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Functions to parse command line arguments for Stack's @eval@ command.
+module Stack.Options.EvalParser
+  ( evalOptsParser
+  ) where
+
+import           Options.Applicative ( Parser, metavar, strArgument )
+import           Stack.Eval ( EvalOpts (..) )
+import           Stack.Options.ExecParser ( execOptsExtraParser )
+import           Stack.Prelude
+
+-- | Parse command line arguments for Stack's @eval@ command.
+evalOptsParser ::
+     String -- ^ metavar
+  -> Parser EvalOpts
+evalOptsParser meta = EvalOpts
+  <$> eoArgsParser
+  <*> execOptsExtraParser
+ where
+  eoArgsParser :: Parser String
+  eoArgsParser = strArgument (metavar meta)
src/Stack/Options/ExecParser.hs view
@@ -1,19 +1,26 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
+-- | Functions to parse command line arguments for Stack's @exec@, @ghc@, @run@,
+-- @runghc@ and @runhaskell@ commands.
 module Stack.Options.ExecParser
-  ( evalOptsParser
+  ( execOptsParser
   , execOptsExtraParser
-  , execOptsParser
   ) where
 
 import           Options.Applicative
-import           Options.Applicative.Builder.Extra
-import           Options.Applicative.Args
-import           Stack.Options.Completion
+                   ( Parser, completer, help, idm, long, metavar, strArgument
+                   , strOption
+                   )
+import           Options.Applicative.Builder.Extra ( boolFlags, dirCompleter )
+import           Options.Applicative.Args ( argsOption )
+import           Stack.Exec
+                   ( ExecOpts (..), ExecOptsExtra (..), SpecialExecCmd (..) )
+import           Stack.Options.Completion ( projectExeCompleter )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.EnvSettings ( EnvSettings (..) )
 
--- | Parser for exec command
+-- | Parse command line arguments for Stack's @exec@, @ghc@, @run@,
+-- @runghc@ and @runhaskell@ commands.
 execOptsParser :: Maybe SpecialExecCmd -> Parser ExecOpts
 execOptsParser mcmd = ExecOpts
   <$> maybe eoCmdParser pure mcmd
@@ -35,15 +42,6 @@       Just ExecRunGhc -> "-- ARGUMENT(S) (e.g. stack runghc -- X.hs)"
     normalTxt = "-- ARGUMENT(S) (e.g. stack exec ghc-pkg -- describe base)"
 
-evalOptsParser :: String -- ^ metavar
-               -> Parser EvalOpts
-evalOptsParser meta = EvalOpts
-  <$> eoArgsParser
-  <*> execOptsExtraParser
- where
-  eoArgsParser :: Parser String
-  eoArgsParser = strArgument (metavar meta)
-
 -- | Parser for extra options to exec command
 execOptsExtraParser :: Parser ExecOptsExtra
 execOptsExtraParser = ExecOptsExtra
@@ -56,12 +54,12 @@   eoEnvSettingsParser = EnvSettings True
     <$> boolFlags True
           "ghc-package-path"
-          "setting the GHC_PACKAGE_PATH variable for the subprocess"
+          "setting the GHC_PACKAGE_PATH variable for the subprocess."
           idm
     <*> boolFlags True
           "stack-exe"
           "setting the STACK_EXE environment variable to the path for the \
-          \stack executable"
+          \stack executable."
           idm
     <*> pure False
     <*> pure True
@@ -70,20 +68,20 @@   eoPackagesParser = many (strOption
     (  long "package"
     <> metavar "PACKAGE"
-    <> help "Add a package (can be specified multiple times)"
+    <> help "Add a package (can be specified multiple times)."
     ))
 
   eoRtsOptionsParser :: Parser [String]
   eoRtsOptionsParser = concat <$> many (argsOption
     ( long "rts-options"
-    <> help "Explicit RTS options to pass to application"
+    <> help "Explicit RTS options to pass to application."
     <> metavar "RTSFLAG"
     ))
 
   eoCwdParser :: Parser (Maybe FilePath)
   eoCwdParser = optional (strOption
     (  long "cwd"
-    <> help "Sets the working directory before executing"
+    <> help "Sets the working directory before executing."
     <> metavar "DIR"
     <> completer dirCompleter
     ))
src/Stack/Options/GhcBuildParser.hs view
@@ -21,13 +21,14 @@        , "gmp4"
        , "nopie"
        , "tinfo6"
+       , "tinfo6-libc6-pre232"
        , "tinfo6-nopie"
        , "ncurses6"
        , "int-native"
        , "integersimple"
        ]
   <> help "Specialized GHC build, e.g. 'gmp4' or 'standard' (usually \
-          \auto-detected)"
+          \auto-detected)."
   <> hideMods hide
   )
  where
src/Stack/Options/GhcVariantParser.hs view
@@ -9,7 +9,7 @@ import           Options.Applicative.Types ( readerAsk )
 import           Stack.Prelude
 import           Stack.Options.Utils ( hideMods )
-import           Stack.Types.Config ( GHCVariant, parseGHCVariant )
+import           Stack.Types.GHCVariant ( GHCVariant, parseGHCVariant )
 
 -- | GHC variant parser
 ghcVariantParser :: Bool -> Parser GHCVariant
@@ -17,7 +17,7 @@   (  long "ghc-variant"
   <> metavar "VARIANT"
   <> help "Specialized GHC variant, e.g. int-native or integersimple \
-          \(incompatible with --system-ghc)"
+          \(incompatible with --system-ghc)."
   <> hideMods hide
   )
  where
src/Stack/Options/GhciParser.hs view
@@ -37,13 +37,14 @@               []
               ["-Wall", "-Werror"]
               (  long "pedantic"
-              <> help "Turn on -Wall and -Werror"
+              <> help "Turn on -Wall and -Werror."
               )
         <*> many (argsOption
               (  long "ghci-options"
               <> metavar "OPTIONS"
               <> completer ghcOptsCompleter
-              <> help "Additional options passed to GHCi"
+              <> help "Additional options passed to GHCi (can be specified \
+                      \multiple times)."
               ))
       )
   <*> (     concat
@@ -51,19 +52,20 @@               (  long "ghc-options"
               <> metavar "OPTIONS"
               <> completer ghcOptsCompleter
-              <> help "Additional options passed to both GHC and GHCi"
+              <> help "Additional options passed to both GHC and GHCi (can be \
+                      \specified multiple times)."
               ))
       )
   <*> flagsParser
   <*> optional (strOption
         (  long "with-ghc"
         <> metavar "GHC"
-        <> help "Use this GHC to run GHCi"
+        <> help "Use this GHC to run GHCi."
         ))
   <*> (     not
         <$> boolFlags True
               "load"
-              "load modules on start-up"
+              "load modules on start-up."
               idm
       )
   <*> packagesParser
@@ -76,12 +78,12 @@         ))
   <*> switch
         (  long "load-local-deps"
-        <> help "Load all local dependencies of your targets"
+        <> help "Load all local dependencies of your targets."
         )
   -- TODO: deprecate this? probably useless.
   <*> switch
         (  long "skip-intermediate-deps"
-        <> help "Skip loading intermediate target dependencies"
+        <> help "Skip loading intermediate target dependencies."
         <> internal
         )
   <*> optional (boolFlagsNoDefault
@@ -90,7 +92,7 @@         idm)
   <*> switch
         (  long "no-build"
-        <> help "Don't build before launching GHCi"
+        <> help "Don't build before launching GHCi."
         <> internal
         )
   <*> switch
src/Stack/Options/GlobalParser.hs view
@@ -1,44 +1,42 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE RecordWildCards   #-}
 
+-- | Functions to parse Stack's \'global\' command line arguments.
 module Stack.Options.GlobalParser
   ( globalOptsFromMonoid
   , globalOptsParser
-  , initOptsParser
   ) where
 
 import           Options.Applicative
-                   ( Parser, auto, completer, help, hidden, internal, long
-                   , metavar, option, strOption, switch, value
+                   ( Parser, ReadM, auto, completer, help, hidden, internal
+                   , long, metavar, option, strOption, value
                    )
 import           Options.Applicative.Builder.Extra
-                   ( dirCompleter, fileExtCompleter, firstBoolFlagsFalse
+                   ( fileExtCompleter, firstBoolFlagsFalse
                    , firstBoolFlagsNoDefault, firstBoolFlagsTrue, optionalFirst
-                   , textArgument
                    )
+import           Options.Applicative.Types ( readerAsk )
 import           Path.IO ( getCurrentDir, resolveDir', resolveFile' )
 import qualified Stack.Docker as Docker
-import           Stack.Init ( InitOpts (..) )
 import           Stack.Prelude
 import           Stack.Options.ConfigParser ( configOptsParser )
 import           Stack.Options.LogLevelParser ( logLevelOptsParser )
 import           Stack.Options.ResolverParser
                    ( abstractResolverOptsParser, compilerOptsParser )
 import           Stack.Options.Utils ( GlobalOptsContext (..), hideMods )
-import           Stack.Types.Config
-                   ( GlobalOpts (..), GlobalOptsMonoid (..)
-                   , LockFileBehavior (..), StackYamlLoc (..), defaultLogLevel
-                   , readLockFileBehavior, readStyles
-                   )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.GlobalOptsMonoid ( GlobalOptsMonoid (..) )
+import           Stack.Types.LockFileBehavior
+                   ( LockFileBehavior (..), readLockFileBehavior )
+import           Stack.Types.StackYamlLoc ( StackYamlLoc (..) )
 import           Stack.Types.Docker ( dockerEntrypointArgName )
 
 -- | Parser for global command-line options.
 globalOptsParser ::
      FilePath
   -> GlobalOptsContext
-  -> Maybe LogLevel
   -> Parser GlobalOptsMonoid
-globalOptsParser currentDir kind defLogLevel = GlobalOptsMonoid
+globalOptsParser currentDir kind = GlobalOptsMonoid
   <$> optionalFirst (strOption
         (  long Docker.reExecArgName
         <> hidden
@@ -49,14 +47,15 @@         <> hidden
         <> internal
         ))
-  <*> (First <$> logLevelOptsParser hide0 defLogLevel)
+  <*> (First <$> logLevelOptsParser hide0)
   <*> firstBoolFlagsTrue
         "time-in-log"
-        "inclusion of timings in logs, for the purposes of using diff with logs"
+        "inclusion of timings in logs, for the purposes of using diff with \
+        \logs."
         hide
   <*> firstBoolFlagsFalse
         "rsl-in-log"
-        "inclusion of raw snapshot layer (rsl) in logs"
+        "inclusion of raw snapshot layer (rsl) in logs."
         hide
   <*> configOptsParser currentDir kind
   <*> optionalFirst (abstractResolverOptsParser hide0)
@@ -65,7 +64,8 @@       -- resolver root is only set via the script command
   <*> firstBoolFlagsNoDefault
         "terminal"
-        "overriding terminal detection in the case of running in a false terminal"
+        "overriding terminal detection in the case of running in a false \
+        \terminal."
         hide
   <*> option readStyles
         (  long "stack-colors"
@@ -85,23 +85,21 @@         (  long "terminal-width"
         <> metavar "INT"
         <> help "Specify the width of the terminal, used for pretty-print \
-                \messages"
+                \messages."
         <> hide
         ))
   <*> optionalFirst (strOption
         (  long "stack-yaml"
         <> metavar "STACK-YAML"
         <> completer (fileExtCompleter [".yaml"])
-        <> help
-             (  "Override project stack.yaml file "
-             <> "(overrides any STACK_YAML environment variable)"
-             )
+        <> help "Override project stack.yaml file (overrides any STACK_YAML \
+                \environment variable)."
         <> hide
         ))
   <*> optionalFirst (option readLockFileBehavior
         (  long "lock-file"
-        <> help "Specify how to interact with lock files. Default: read/write. \
-                \If resolver is overridden: read-only"
+        <> help "Specify how to interact with lock files. (default: if \
+                \resolver is overridden: read-only; otherwise: read/write)"
         <> hide
         ))
  where
@@ -143,34 +141,12 @@               case getFirst globalMonoidResolver of
                 Nothing -> LFBReadWrite
                 _ -> LFBReadOnly
-         in fromFirst defLFB globalMonoidLockFileBehavior
+        in  fromFirst defLFB globalMonoidLockFileBehavior
     }
 
-initOptsParser :: Parser InitOpts
-initOptsParser = InitOpts
-  <$> searchDirs
-  <*> omitPackages
-  <*> overwrite
-  <*> fmap not ignoreSubDirs
- where
-  searchDirs = many (textArgument
-    (  metavar "DIR(S)"
-    <> completer dirCompleter
-    <> help "Directory, or directories, to include in the search for .cabal \
-            \files, when initialising. The default is the current directory."
-    ))
-  ignoreSubDirs = switch
-    (  long "ignore-subdirs"
-    <> help "Do not search for .cabal files in subdirectories, when \
-            \initialising."
-    )
-  overwrite = switch
-    (  long "force"
-    <> help "Force an initialisation that overwrites any existing stack.yaml \
-            \file."
-    )
-  omitPackages = switch
-    (  long "omit-packages"
-    <> help "Exclude conflicting or incompatible user packages, when \
-            \initialising."
-    )
+-- | Default logging level should be something useful but not crazy.
+defaultLogLevel :: LogLevel
+defaultLogLevel = LevelInfo
+
+readStyles :: ReadM StylesUpdate
+readStyles = parseStylesUpdateFromString <$> readerAsk
src/Stack/Options/HaddockParser.hs view
@@ -8,7 +8,7 @@ import           Options.Applicative.Args ( argsOption )
 import           Stack.Options.Utils ( hideMods )
 import           Stack.Prelude
-import           Stack.Types.Config ( HaddockOptsMonoid (..) )
+import           Stack.Types.BuildOpts ( HaddockOptsMonoid (..) )
 
 -- | Parser for haddock arguments.
 haddockOptsParser :: Bool -> Parser HaddockOptsMonoid
@@ -18,7 +18,7 @@         ( optional (argsOption
             (  long "haddock-arguments"
             <> metavar "HADDOCK_ARGS"
-            <> help "Arguments passed to the haddock program"
+            <> help "Arguments passed to the Haddock program."
             <> hide
             ))
         )
src/Stack/Options/HpcReportParser.hs view
@@ -16,7 +16,7 @@ import           Stack.Coverage ( HpcReportOpts (..) )
 import           Stack.Options.Completion ( targetCompleter )
 import           Stack.Prelude
-import           Stack.Types.Config ( PvpBounds, parsePvpBounds )
+import           Stack.Types.PvpBounds ( PvpBounds, parsePvpBounds )
 
 -- | Parser for @stack hpc report@.
 hpcReportOptsParser :: Parser HpcReportOpts
@@ -28,17 +28,17 @@   <*> switch
         (  long "all"
         <> help "Use results from all packages and components involved in \
-                \previous --coverage run"
+                \previous --coverage run."
         )
   <*> optional (strOption
         (  long "destdir"
         <> metavar "DIR"
         <> completer dirCompleter
-        <> help "Output directory for HTML report"
+        <> help "Output directory for HTML report."
         ))
   <*> switch
         (  long "open"
-        <> help "Open the report in the browser"
+        <> help "Open the report in the browser."
         )
 
 pvpBoundsOption :: Parser PvpBounds
@@ -47,7 +47,7 @@   <> metavar "PVP-BOUNDS"
   <> completeWith ["none", "lower", "upper", "both"]
   <> help "How PVP version bounds should be added to Cabal file: none, lower, \
-          \upper, both"
+          \upper, both."
   )
  where
   readPvpBounds = do
+ src/Stack/Options/InitParser.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Functions to parse command line arguments for Stack's @init@ and @new@
+-- commands.
+module Stack.Options.InitParser
+  ( initOptsParser
+  ) where
+
+import           Options.Applicative
+                   ( Parser, completer, help, long, metavar, switch )
+import           Options.Applicative.Builder.Extra
+                   ( dirCompleter, textArgument )
+import           Stack.Init ( InitOpts (..) )
+import           Stack.Prelude
+
+-- | Parse command line arguments for Stack's @init@ and @new@ commands.
+initOptsParser :: Parser InitOpts
+initOptsParser = InitOpts
+  <$> searchDirs
+  <*> omitPackages
+  <*> overwrite
+  <*> fmap not ignoreSubDirs
+ where
+  searchDirs = many (textArgument
+    (  metavar "DIR(S)"
+    <> completer dirCompleter
+    <> help "Directory, or directories, to include in the search for Cabal \
+            \files, when initialising. The default is the current directory."
+    ))
+  ignoreSubDirs = switch
+    (  long "ignore-subdirs"
+    <> help "Do not search for Cabal files in subdirectories, when \
+            \initialising."
+    )
+  overwrite = switch
+    (  long "force"
+    <> help "Force an initialisation that overwrites any existing stack.yaml \
+            \file."
+    )
+  omitPackages = switch
+    (  long "omit-packages"
+    <> help "Exclude conflicting or incompatible user packages, when \
+            \initialising."
+    )
src/Stack/Options/LogLevelParser.hs view
@@ -14,13 +14,13 @@ import           Stack.Prelude
 
 -- | Parser for a logging level.
-logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel)
-logLevelOptsParser hide defLogLevel = fmap (Just . parse)
+logLevelOptsParser :: Bool -> Parser (Maybe LogLevel)
+logLevelOptsParser hide = fmap (Just . parse)
       (strOption
         (  long "verbosity"
         <> metavar "VERBOSITY"
         <> completeWith ["silent", "error", "warn", "info", "debug"]
-        <> help "Verbosity: silent, error, warn, info, debug"
+        <> help "Set verbosity level: silent, error, warn, info or debug."
         <> hideMods hide
         ))
   <|> flag' (Just verboseLevel)
@@ -29,7 +29,7 @@         <> help
              (  "Enable verbose mode: verbosity level \""
              <> showLevel verboseLevel
-             <> "\""
+             <> "\"."
              )
         <> hideMods hide
         )
@@ -37,11 +37,11 @@         (  long "silent"
         <> help (  "Enable silent mode: verbosity level \""
                 <> showLevel silentLevel
-                <> "\""
+                <> "\"."
                 )
         <> hideMods hide
         )
-  <|> pure defLogLevel
+  <|> pure Nothing
  where
   verboseLevel = LevelDebug
   silentLevel = LevelOther "silent"
+ src/Stack/Options/LsParser.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+
+-- | Functions to parse command line arguments for Stack's @ls@ command.
+module Stack.Options.LsParser
+  ( lsOptsParser
+  ) where
+
+import qualified Options.Applicative as OA
+import           Options.Applicative ( idm )
+import           Options.Applicative.Builder.Extra ( boolFlags )
+import           Stack.Constants ( globalFooter )
+import           Stack.Ls
+                   ( ListStylesOpts (..), ListToolsOpts (..), LsCmdOpts (..)
+                   , LsCmds (..), LsView (..), SnapshotOpts (..)
+                   )
+import           Stack.Options.DotParser ( listDepsOptsParser )
+import           Stack.Prelude
+
+-- | Parse command line arguments for Stack's @ls@ command.
+lsOptsParser :: OA.Parser LsCmdOpts
+lsOptsParser = LsCmdOpts
+  <$> OA.hsubparser (lsSnapCmd <> lsDepsCmd <> lsStylesCmd <> lsToolsCmd)
+
+lsCmdOptsParser :: OA.Parser LsCmds
+lsCmdOptsParser = LsSnapshot <$> lsViewSnapCmd
+
+lsDepOptsParser :: OA.Parser LsCmds
+lsDepOptsParser = LsDependencies <$> listDepsOptsParser
+
+lsStylesOptsParser :: OA.Parser LsCmds
+lsStylesOptsParser = LsStyles <$> listStylesOptsParser
+
+lsToolsOptsParser :: OA.Parser LsCmds
+lsToolsOptsParser = LsTools <$> listToolsOptsParser
+
+listStylesOptsParser :: OA.Parser ListStylesOpts
+listStylesOptsParser = ListStylesOpts
+  <$> boolFlags False
+        "basic"
+        "a basic report of the styles used. The default is a fuller one."
+        idm
+  <*> boolFlags True
+        "sgr"
+        "the provision of the equivalent SGR instructions (provided by \
+        \default). Flag ignored for a basic report."
+        idm
+  <*> boolFlags True
+        "example"
+        "the provision of an example of the applied style (provided by default \
+        \for colored output). Flag ignored for a basic report."
+        idm
+
+listToolsOptsParser :: OA.Parser ListToolsOpts
+listToolsOptsParser = ListToolsOpts
+  <$> OA.strOption
+        (  OA.long "filter"
+        <> OA.metavar "TOOL_NAME"
+        <> OA.value ""
+        <> OA.help "Filter by a tool name (eg 'ghc', 'ghc-git' or 'msys2') \
+                   \- case sensitive. (default: no filter)"
+        )
+
+lsViewSnapCmd :: OA.Parser SnapshotOpts
+lsViewSnapCmd = SnapshotOpts
+  <$> ( OA.hsubparser (lsViewRemoteCmd <> lsViewLocalCmd) <|> pure Local)
+  <*> OA.switch
+        (  OA.long "lts"
+        <> OA.short 'l'
+        <> OA.help "Only show LTS Haskell snapshots."
+        )
+  <*> OA.switch
+        (  OA.long "nightly"
+        <> OA.short 'n'
+        <> OA.help "Only show Nightly snapshots."
+        )
+
+lsSnapCmd :: OA.Mod OA.CommandFields LsCmds
+lsSnapCmd = OA.command "snapshots" $
+  OA.info lsCmdOptsParser $
+       OA.progDesc "View snapshots. (default: local)"
+    <> OA.footer localSnapshotMsg
+
+lsDepsCmd :: OA.Mod OA.CommandFields LsCmds
+lsDepsCmd = OA.command "dependencies" $
+  OA.info lsDepOptsParser $
+       OA.progDesc "View the dependencies."
+    <> OA.footer globalFooter
+
+lsStylesCmd :: OA.Mod OA.CommandFields LsCmds
+lsStylesCmd =
+     OA.command
+       "stack-colors"
+       (OA.info lsStylesOptsParser
+                (OA.progDesc "View Stack's output styles."))
+  <> OA.command
+       "stack-colours"
+       (OA.info lsStylesOptsParser
+                (OA.progDesc "View Stack's output styles (alias for \
+                             \'stack-colors')."))
+
+lsToolsCmd :: OA.Mod OA.CommandFields LsCmds
+lsToolsCmd =
+  OA.command
+    "tools"
+    (OA.info lsToolsOptsParser
+             (OA.progDesc "View Stack's installed tools."))
+
+lsViewLocalCmd :: OA.Mod OA.CommandFields LsView
+lsViewLocalCmd = OA.command "local" $
+  OA.info (pure Local) $
+       OA.progDesc "View local snapshots."
+    <> OA.footer localSnapshotMsg
+
+lsViewRemoteCmd :: OA.Mod OA.CommandFields LsView
+lsViewRemoteCmd = OA.command "remote" $
+  OA.info (pure Remote) $
+       OA.progDesc "View remote snapshots."
+    <> OA.footer pagerMsg
+
+pagerMsg :: String
+pagerMsg =
+  "On a terminal, uses a pager, if one is available. Respects the PAGER \
+  \environment variable (subject to that, prefers pager 'less' to 'more')."
+
+localSnapshotMsg :: String
+localSnapshotMsg =
+  "A local snapshot is identified by a hash code. " <> pagerMsg
src/Stack/Options/NewParser.hs view
@@ -6,15 +6,17 @@ 
 import qualified Data.Map.Strict as M
 import           Options.Applicative
-import           Stack.Init
-import           Stack.New
-import           Stack.Options.GlobalParser
+                   ( Parser, help, long, metavar, short, switch )
+import           Stack.Init ( InitOpts )
+import           Stack.New ( NewOpts (..) )
+import           Stack.Options.InitParser ( initOptsParser )
 import           Stack.Prelude
-import           Stack.Types.PackageName
+import           Stack.Types.PackageName ( packageNameArgument )
 import           Stack.Types.TemplateName
+                   ( templateNameArgument, templateParamArgument )
 
 -- | Parser for @stack new@.
-newOptsParser :: Parser (NewOpts,InitOpts)
+newOptsParser :: Parser (NewOpts, InitOpts)
 newOptsParser = (,) <$> newOpts <*> initOptsParser
  where
   newOpts = NewOpts
@@ -24,7 +26,7 @@           )
     <*> switch
           (  long "bare"
-          <> help "Do not create a subdirectory for the project"
+          <> help "Do not create a subdirectory for the project."
           )
     <*> optional (templateNameArgument
           (  metavar "TEMPLATE_NAME"
@@ -38,5 +40,5 @@           (  short 'p'
           <> long "param"
           <> metavar "KEY:VALUE"
-          <> help "Parameter for the template in the format key:value"
+          <> help "Parameter for the template in the format key:value."
           )))
src/Stack/Options/NixParser.hs view
@@ -6,29 +6,33 @@ 
 import qualified Data.Text as T
 import           Options.Applicative
-import           Options.Applicative.Args
+                   ( Parser, completer, help, long, metavar, option, str )
+import           Options.Applicative.Args ( argsOption )
 import           Options.Applicative.Builder.Extra
-import           Stack.Nix
-import           Stack.Options.Utils
+                   ( fileExtCompleter, firstBoolFlagsFalse
+                   , firstBoolFlagsNoDefault, optionalFirst
+                   )
+import           Stack.Nix ( nixCmdName )
+import           Stack.Options.Utils ( hideMods )
 import           Stack.Prelude
-import           Stack.Types.Nix
+import           Stack.Types.Nix ( NixOptsMonoid (..) )
 
 nixOptsParser :: Bool -> Parser NixOptsMonoid
 nixOptsParser hide0 = overrideActivation <$>
   (   NixOptsMonoid
   <$> firstBoolFlagsNoDefault
         nixCmdName
-        "use of a Nix-shell. Implies 'system-ghc: true'"
+        "use of a Nix-shell. Implies 'system-ghc: true'."
         hide
   <*> firstBoolFlagsNoDefault
         "nix-pure"
-        "use of a pure Nix-shell. Implies '--nix' and 'system-ghc: true'"
+        "use of a pure Nix-shell. Implies '--nix' and 'system-ghc: true'."
         hide
   <*> optionalFirst (textArgsOption
         (  long "nix-packages"
         <> metavar "NAMES"
         <> help "List of packages that should be available in the nix-shell \
-                \(space separated)"
+                \(space separated)."
         <> hide
         ))
   <*> optionalFirst (option str
@@ -36,25 +40,26 @@         <> metavar "FILE"
         <> completer (fileExtCompleter [".nix"])
         <> help "Nix file to be used to launch a nix-shell (for regular Nix \
-                \users)"
+                \users)."
         <> hide
         ))
   <*> optionalFirst (textArgsOption
         (  long "nix-shell-options"
         <> metavar "OPTIONS"
-        <> help "Additional options passed to nix-shell"
+        <> help "Additional options passed to nix-shell."
         <> hide
         ))
   <*> optionalFirst (textArgsOption
         (  long "nix-path"
         <> metavar "PATH_OPTIONS"
         <> help "Additional options to override NIX_PATH parts (notably \
-                \'nixpkgs')"
+                \'nixpkgs')."
         <> hide
         ))
   <*> firstBoolFlagsFalse
         "nix-add-gc-roots"
-        "addition of packages to the nix GC roots so nix-collect-garbage doesn't remove them"
+        "addition of packages to the nix GC roots so nix-collect-garbage does \
+        \not remove them."
         hide
   )
  where
src/Stack/Options/PackageParser.hs view
@@ -8,7 +8,7 @@ import           Options.Applicative ( ReadM, readerError )
 import           Options.Applicative.Types ( readerAsk )
 import           Stack.Prelude
-import           Stack.Types.Config.Build ( ApplyCLIFlag (..) )
+import           Stack.Types.BuildOpts ( ApplyCLIFlag (..) )
 
 -- | Parser for package:[-]flag
 readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
@@ -28,4 +28,4 @@                  Nothing -> readerError $ "Invalid flag name: " ++ flagS
                  Just x -> pure x
       pure $ Map.singleton pn' $ Map.singleton flagN b
-    _ -> readerError "Must have a colon"
+    _ -> readerError "Must have a colon."
+ src/Stack/Options/PathParser.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Functions to parse command line arguments for Stack's @path@ command.
+module Stack.Options.PathParser
+  ( pathParser
+  ) where
+
+import qualified Data.Text as T
+import           Options.Applicative ( Parser, flag, help, long )
+import           Stack.Path ( paths )
+import           Stack.Prelude
+
+-- | Parse command line arguments for Stack's @path@ command.
+pathParser :: Parser [Text]
+pathParser = mapMaybeA
+  ( \(desc, name, _) -> flag Nothing (Just name)
+      (  long (T.unpack name)
+      <> help desc
+      )
+  )
+  paths
src/Stack/Options/ResolverParser.hs view
@@ -20,7 +20,7 @@ abstractResolverOptsParser hide = option readAbstractResolver
   (  long "resolver"
   <> metavar "RESOLVER"
-  <> help "Override resolver in project file"
+  <> help "Override resolver in project file."
   <> hideMods hide
   )
 
@@ -28,7 +28,7 @@ compilerOptsParser hide = option readCompilerVersion
   (  long "compiler"
   <> metavar "COMPILER"
-  <> help "Use the specified compiler"
+  <> help "Use the specified compiler."
   <> hideMods hide
   )
src/Stack/Options/SDistParser.hs view
@@ -1,16 +1,21 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
+-- | Functions to parse command line arguments for Stack's @sdist@ and @upload@
+-- commands.
 module Stack.Options.SDistParser
  ( sdistOptsParser
  ) where
 
 import           Options.Applicative
-import           Options.Applicative.Builder.Extra
+                   ( Parser, completer, help, idm, long, metavar, strArgument
+                   , strOption, switch
+                   )
+import           Options.Applicative.Builder.Extra ( boolFlags, dirCompleter )
 import           Stack.Prelude
-import           Stack.SDist
+import           Stack.SDist ( SDistOpts (..) )
 import           Stack.Options.HpcReportParser ( pvpBoundsOption )
 
--- | Parser for arguments to `stack sdist`
+-- | Parse command line arguments for Stack's @sdist@ and @upload@ commands.
 sdistOptsParser :: Parser SDistOpts
 sdistOptsParser = SDistOpts
   <$> many (strArgument
@@ -22,14 +27,14 @@   <*> buildPackageOption
   <*> optional (strOption
         (  long "tar-dir"
-        <> help "If specified, copy all the tar to this dir"
+        <> help "If specified, copy all the tar to this directory."
         ))
  where
   ignoreCheckSwitch = switch
     (  long "ignore-check"
-    <> help "Do not check package for common mistakes"
+    <> help "Do not check package for common mistakes."
     )
   buildPackageOption = boolFlags False
     "test-tarball"
-    "building of the resulting tarball"
+    "building of the resulting tarball."
     idm
src/Stack/Options/ScriptParser.hs view
@@ -1,46 +1,28 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
+-- | Functions to parse command line arguments for Stack's @script@ command.
 module Stack.Options.ScriptParser
-  ( ScriptExecute (..)
-  , ScriptOpts (..)
-  , ShouldRun (..)
-  , scriptOptsParser
+  ( scriptOptsParser
   ) where
 
 import           Options.Applicative
-                   ( Parser, completer, eitherReader, flag', help, long
-                   , metavar, option, strArgument, strOption
+                   ( Parser, completer, eitherReader, flag', help, long, metavar
+                   , option, strArgument, strOption
                    )
-import           Options.Applicative.Builder.Extra ( fileExtCompleter )
+import           Options.Applicative.Builder.Extra
+                   ( boolFlags, fileExtCompleter )
 import           Stack.Options.Completion ( ghcOptsCompleter )
 import           Stack.Prelude
-
-data ScriptOpts = ScriptOpts
-  { soPackages :: ![String]
-  , soFile :: !FilePath
-  , soArgs :: ![String]
-  , soCompile :: !ScriptExecute
-  , soGhcOptions :: ![String]
-  , soScriptExtraDeps :: ![PackageIdentifierRevision]
-  , soShouldRun :: !ShouldRun
-  }
-  deriving Show
-
-data ScriptExecute
-  = SEInterpret
-  | SECompile
-  | SEOptimize
-  deriving Show
-
-data ShouldRun = YesRun | NoRun
-  deriving Show
+import           Stack.Script
+                   ( ScriptExecute (..), ScriptOpts (..), ShouldRun (..) )
 
+-- | Parse command line arguments for Stack's @script@ command.
 scriptOptsParser :: Parser ScriptOpts
 scriptOptsParser = ScriptOpts
   <$> many (strOption
         (  long "package"
         <> metavar "PACKAGE"
-        <> help "Add a package (can be specified multiple times)"
+        <> help "Add a package (can be specified multiple times)."
         ))
   <*> strArgument
         (  metavar "FILE"
@@ -48,32 +30,40 @@         )
   <*> many (strArgument
         (  metavar "-- ARGUMENT(S) (e.g. stack script X.hs -- argument(s) to \
-                   \program)"
+                   \program)."
         ))
   <*> (   flag' SECompile
             (  long "compile"
-            <> help "Compile the script without optimization and run the executable"
+            <> help "Compile the script without optimization and run the \
+                    \executable."
             )
       <|> flag' SEOptimize
             (  long "optimize"
-            <> help "Compile the script with optimization and run the executable"
+            <> help "Compile the script with optimization and run the \
+                    \executable."
             )
       <|> pure SEInterpret
       )
+  <*> boolFlags False
+        "use-root"
+        "writing of all compilation outputs to a script-specific location in \
+        \the scripts directory of the Stack root."
+        mempty
   <*> many (strOption
         (  long "ghc-options"
         <> metavar "OPTIONS"
         <> completer ghcOptsCompleter
-        <> help "Additional options passed to GHC"
+        <> help "Additional options passed to GHC (can be specified multiple \
+                \times)."
         ))
   <*> many (option extraDepRead
         (  long "extra-dep"
         <> metavar "PACKAGE-VERSION"
-        <> help "Extra dependencies to be added to the snapshot"
+        <> help "Extra dependencies to be added to the snapshot."
         ))
   <*> (   flag' NoRun
             (  long "no-run"
-            <> help "Don't run, just compile."
+            <> help "Do not run, just compile."
             )
       <|> pure YesRun
       )
+ src/Stack/Options/SetupParser.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Functions to parse command line arguments for Stack's @setup@ command.
+module Stack.Options.SetupParser
+  ( setupOptsParser
+  ) where
+
+import qualified Data.Text as T
+import qualified Options.Applicative as OA
+import qualified Options.Applicative.Builder.Extra as OA
+import qualified Options.Applicative.Types as OA
+import           Stack.Prelude
+import           Stack.SetupCmd ( SetupCmdOpts (..) )
+
+-- | Parse command line arguments for Stack's @setup@ command.
+setupOptsParser :: OA.Parser SetupCmdOpts
+setupOptsParser = SetupCmdOpts
+  <$> OA.optional (OA.argument readVersion
+        (  OA.metavar "GHC_VERSION"
+        <> OA.help "Version of GHC to install, e.g. 9.2.7. (default: install \
+                   \the version implied by the resolver)"
+        ))
+  <*> OA.boolFlags False
+        "reinstall"
+        "reinstalling GHC, even if available (incompatible with --system-ghc)."
+        OA.idm
+  <*> OA.optional (OA.strOption
+        (  OA.long "ghc-bindist"
+        <> OA.metavar "URL"
+        <> OA.help "Alternate GHC binary distribution (requires custom \
+                   \--ghc-variant)."
+        ))
+  <*> OA.many (OA.strOption
+        (  OA.long "ghcjs-boot-options"
+        <> OA.metavar "GHCJS_BOOT"
+        <> OA.help "Additional ghcjs-boot options."
+        ))
+  <*> OA.boolFlags True
+        "ghcjs-boot-clean"
+        "Control if ghcjs-boot should have --clean option present."
+        OA.idm
+ where
+  readVersion = do
+    s <- OA.readerAsk
+    case parseWantedCompiler ("ghc-" <> T.pack s) of
+      Left _ ->
+        case parseWantedCompiler (T.pack s) of
+          Left _ -> OA.readerError $ "Invalid version: " ++ s
+          Right x -> pure x
+      Right x -> pure x
src/Stack/Options/TestParser.hs view
@@ -5,11 +5,13 @@   ) where
 
 import           Options.Applicative
-import           Options.Applicative.Args
+                   ( Parser, auto, flag', help, long, metavar, option )
+import           Options.Applicative.Args ( argsOption )
 import           Options.Applicative.Builder.Extra
-import           Stack.Options.Utils
+                   ( firstBoolFlagsTrue, optionalFirst, optionalFirstFalse )
+import           Stack.Options.Utils ( hideMods )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Types.BuildOpts ( TestOptsMonoid (..) )
 
 -- | Parser for test arguments.
 -- FIXME hide args
@@ -17,18 +19,18 @@ testOptsParser hide0 = TestOptsMonoid
   <$> firstBoolFlagsTrue
         "rerun-tests"
-        "running already successful tests"
+        "running already successful tests."
         hide
   <*> fmap concat (many (argsOption
         (  long "test-arguments"
         <> long "ta"
         <> metavar "TEST_ARGS"
-        <> help "Arguments passed in to the test suite program"
+        <> help "Arguments passed in to the test suite program."
         <> hide
         )))
   <*> optionalFirstFalse (flag' True
         (  long "coverage"
-        <> help "Generate a code coverage report"
+        <> help "Generate a code coverage report."
         <> hide
         ))
   <*> optionalFirstFalse (flag' True
@@ -43,7 +45,7 @@         ))
   <*> firstBoolFlagsTrue
         "tests-allow-stdin"
-        "allow standard input in test executables"
+        "allow standard input in test executables."
         hide
  where
   hide = hideMods hide0
+ src/Stack/Options/UpgradeParser.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Functions to parse command line arguments for Stack's @upgrade@ command.
+module Stack.Options.UpgradeParser
+  ( upgradeOptsParser
+  ) where
+
+import         Options.Applicative
+                 ( Parser, flag', help, idm, long, metavar, showDefault
+                 , strOption, switch, value
+                 )
+import         Options.Applicative.Builder.Extra ( boolFlags )
+import         Stack.Prelude
+import         Stack.Upgrade
+                 ( BinaryOpts (..), SourceOpts (..), UpgradeOpts (..) )
+
+-- | Parse command line arguments for Stack's @upgrade@ command.
+upgradeOptsParser ::
+     Bool
+     -- ^ The default for --[no]-only-local-bin
+  -> Parser UpgradeOpts
+upgradeOptsParser onlyLocalBin = UpgradeOpts
+  <$> (sourceOnly <|> optional binaryOpts)
+  <*> (binaryOnly <|> optional sourceOpts)
+ where
+  binaryOnly = flag' Nothing
+    (  long "binary-only"
+    <> help "Do not use a source upgrade path."
+    )
+  sourceOnly = flag' Nothing
+    (  long "source-only"
+    <> help "Do not use a binary upgrade path."
+    )
+
+  binaryOpts = BinaryOpts
+    <$> optional (strOption
+          (  long "binary-platform"
+          <> help "Platform type for archive to download."
+          <> metavar "PLATFORM"
+          ))
+    <*> switch
+          (  long "force-download"
+          <> help "Download the latest available Stack executable, even if not \
+                  \newer."
+          )
+    <*> boolFlags onlyLocalBin
+          "only-local-bin"
+          "downloading only to Stack's local binary directory"
+          idm
+    <*> optional (strOption
+          (  long "binary-version"
+          <> help "Download a specific Stack version, even if already \
+                  \installed."
+          <> metavar "VERSION"
+          ))
+    <*> optional (strOption
+          (  long "github-org"
+          <> help "GitHub organization name."
+          <> metavar "USER"
+          ))
+    <*> optional (strOption
+          (  long "github-repo"
+          <> help "GitHub repository name."
+          <> metavar "REPO"
+          ))
+
+  sourceOpts = SourceOpts
+    <$> (   ( \fromGit repo branch ->
+                if fromGit
+                  then Just (repo, branch)
+                  else Nothing
+            )
+        <$> switch
+              ( long "git"
+              <> help "Clone from Git instead of downloading from Hackage \
+                      \(more dangerous)."
+              )
+        <*> strOption
+              (  long "git-repo"
+              <> help "Clone from specified Git repository."
+              <> metavar "URL"
+              <> value "https://github.com/commercialhaskell/stack"
+              <> showDefault
+              )
+        <*> strOption
+              (  long "git-branch"
+              <> help "Clone from specified Git branch."
+              <> metavar "BRANCH"
+              <> value "master"
+              <> showDefault
+              )
+        )
src/Stack/Options/UploadParser.hs view
@@ -1,36 +1,23 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
+-- | Functions to parse command line arguments for Stack's @upload@ command.
 module Stack.Options.UploadParser
-  ( UploadOpts (..)
-  , UploadVariant (..)
-  , uploadOptsParser
+  ( uploadOptsParser
   ) where
 
-import           Options.Applicative
+import           Options.Applicative ( Parser, flag, help, long )
 import           Stack.Options.SDistParser ( sdistOptsParser )
 import           Stack.Prelude
-import           Stack.SDist ( SDistOpts (..) )
-
-data UploadOpts = UploadOpts
-  { uoptsSDistOpts :: SDistOpts
-  , uoptsUploadVariant :: UploadVariant
-  -- ^ Says whether to publish the package or upload as a release candidate
-  }
-
-data UploadVariant
-  = Publishing
-  -- ^ Publish the package
-  | Candidate
-  -- ^ Create a package candidate
+import           Stack.Upload ( UploadOpts (..), UploadVariant (..) )
 
--- | Parser for arguments to `stack upload`
+-- | Parse command line arguments for Stack's @upload@ command.
 uploadOptsParser :: Parser UploadOpts
 uploadOptsParser =
   UploadOpts
     <$> sdistOptsParser
     <*> uploadVariant
   where
-    uploadVariant =
-      flag Publishing Candidate
-        (long "candidate" <>
-         help "Upload as a package candidate")
+    uploadVariant = flag Publishing Candidate
+      (  long "candidate"
+      <> help "Upload as a package candidate."
+      )
src/Stack/Package.hs view
@@ -1,800 +1,831 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- | Dealing with Cabal.
-
-module Stack.Package
-  ( readDotBuildinfo
-  , resolvePackage
-  , packageFromPackageDescription
-  , Package (..)
-  , PackageDescriptionPair (..)
-  , GetPackageOpts (..)
-  , PackageConfig (..)
-  , buildLogPath
-  , PackageException (..)
-  , resolvePackageDescription
-  , packageDependencies
-  , applyForceCustomBuild
-  ) where
-
-import           Data.List ( unzip )
-import qualified Data.Map.Strict as M
-import qualified Data.Set as S
-import qualified Data.Text as T
-import           Distribution.CabalSpecVersion
-import           Distribution.Compiler
-import           Distribution.Package
-                   hiding
-                     ( Package, packageName, packageVersion, PackageIdentifier )
-import           Distribution.PackageDescription hiding ( FlagName )
-#if !MIN_VERSION_Cabal(3,8,1)
-import           Distribution.PackageDescription.Parsec
-#endif
-import           Distribution.Pretty ( prettyShow )
-#if MIN_VERSION_Cabal(3,8,1)
-import           Distribution.Simple.PackageDescription ( readHookedBuildInfo )
-#endif
-import           Distribution.System ( OS (..), Arch, Platform (..) )
-import           Distribution.Text ( display )
-import qualified Distribution.Types.CondTree as Cabal
-import qualified Distribution.Types.ExeDependency as Cabal
-import qualified Distribution.Types.LegacyExeDependency as Cabal
-import           Distribution.Types.MungedPackageName
-import qualified Distribution.Types.UnqualComponentName as Cabal
-import           Distribution.Utils.Path ( getSymbolicPath )
-import           Distribution.Verbosity ( silent )
-import           Distribution.Version ( mkVersion, orLaterVersion, anyVersion )
-import           Path as FL hiding ( replaceExtension )
-import           Path.Extra
-import           Path.IO hiding ( findFiles )
-import           Stack.Build.Installed
-import           Stack.Constants
-import           Stack.Constants.Config
-import           Stack.Prelude hiding ( Display (..) )
-import           Stack.Types.Compiler
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
-import           Stack.Types.Package
-import           Stack.Types.Version
-import           System.FilePath ( replaceExtension )
-import           Stack.Types.Dependency ( DepValue (..), DepType (..) )
-import           Stack.Types.PackageFile
-                   ( GetPackageFileContext (..), DotCabalPath
-                   , GetPackageFiles (..)
-                   )
-import           Stack.PackageFile ( packageDescModulesAndFiles )
-import           Stack.ComponentFile
--- | Read @<package>.buildinfo@ ancillary files produced by some Setup.hs hooks.
--- The file includes Cabal file syntax to be merged into the package description
--- derived from the package's Cabal file.
---
--- NOTE: not to be confused with BuildInfo, an Stack-internal datatype.
-readDotBuildinfo :: MonadIO m
-                 => Path Abs File
-                 -> m HookedBuildInfo
-readDotBuildinfo buildinfofp =
-    liftIO $ readHookedBuildInfo silent (toFilePath buildinfofp)
-
--- | Resolve a parsed Cabal file into a 'Package', which contains all of
--- the info needed for Stack to build the 'Package' given the current
--- configuration.
-resolvePackage :: PackageConfig
-               -> GenericPackageDescription
-               -> Package
-resolvePackage packageConfig gpkg =
-    packageFromPackageDescription
-        packageConfig
-        (genPackageFlags gpkg)
-        (resolvePackageDescription packageConfig gpkg)
-
-packageFromPackageDescription :: PackageConfig
-                              -> [PackageFlag]
-                              -> PackageDescriptionPair
-                              -> Package
-packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkgNoMod pkg) =
-    Package
-    { packageName = name
-    , packageVersion = pkgVersion pkgId
-    , packageLicense = licenseRaw pkg
-    , packageDeps = deps
-    , packageFiles = pkgFiles
-    , packageUnknownTools = unknownTools
-    , packageGhcOptions = packageConfigGhcOptions packageConfig
-    , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig
-    , packageFlags = packageConfigFlags packageConfig
-    , packageDefaultFlags = M.fromList
-      [(flagName flag, flagDefault flag) | flag <- pkgFlags]
-    , packageAllDeps = M.keysSet deps
-    , packageLibraries =
-        let mlib = do
-              lib <- library pkg
-              guard $ buildable $ libBuildInfo lib
-              Just lib
-         in
-          case mlib of
-            Nothing -> NoLibraries
-            Just _ -> HasLibraries foreignLibNames
-    , packageInternalLibraries = subLibNames
-    , packageTests = M.fromList
-      [(T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t)
-          | t <- testSuites pkgNoMod
-          , buildable (testBuildInfo t)
-      ]
-    , packageBenchmarks = S.fromList
-      [T.pack (Cabal.unUnqualComponentName $ benchmarkName b)
-          | b <- benchmarks pkgNoMod
-          , buildable (benchmarkBuildInfo b)
-      ]
-        -- Same comment about buildable applies here too.
-    , packageExes = S.fromList
-      [T.pack (Cabal.unUnqualComponentName $ exeName biBuildInfo)
-        | biBuildInfo <- executables pkg
-                                    , buildable (buildInfo biBuildInfo)]
-    -- This is an action used to collect info needed for "stack ghci".
-    -- This info isn't usually needed, so computation of it is deferred.
-    , packageOpts = GetPackageOpts $
-      \installMap installedMap omitPkgs addPkgs cabalfp ->
-           do (componentsModules,componentFiles,_,_) <- getPackageFiles pkgFiles cabalfp
-              let internals = S.toList $ internalLibComponents $ M.keysSet componentsModules
-              excludedInternals <- mapM (parsePackageNameThrowing . T.unpack) internals
-              mungedInternals <- mapM (parsePackageNameThrowing . T.unpack .
-                                       toInternalPackageMungedName) internals
-              componentsOpts <-
-                  generatePkgDescOpts installMap installedMap
-                  (excludedInternals ++ omitPkgs) (mungedInternals ++ addPkgs)
-                  cabalfp pkg componentFiles
-              pure (componentsModules,componentFiles,componentsOpts)
-    , packageHasExposedModules = maybe
-          False
-          (not . null . exposedModules)
-          (library pkg)
-    , packageBuildType = buildType pkg
-    , packageSetupDeps = msetupDeps
-    , packageCabalSpec = specVersion pkg
-    }
-  where
-    extraLibNames = S.union subLibNames foreignLibNames
-
-    subLibNames
-      = S.fromList
-      $ map (T.pack . Cabal.unUnqualComponentName)
-      $ mapMaybe (libraryNameString . libName) -- this is a design bug in the Cabal API: this should statically be known to exist
-      $ filter (buildable . libBuildInfo)
-      $ subLibraries pkg
-
-    foreignLibNames
-      = S.fromList
-      $ map (T.pack . Cabal.unUnqualComponentName . foreignLibName)
-      $ filter (buildable . foreignLibBuildInfo)
-      $ foreignLibs pkg
-
-    toInternalPackageMungedName
-      = T.pack . prettyShow . MungedPackageName (pkgName pkgId)
-      . maybeToLibraryName . Just . Cabal.mkUnqualComponentName . T.unpack
-
-    -- Gets all of the modules, files, build files, and data files that
-    -- constitute the package. This is primarily used for dirtiness
-    -- checking during build, as well as use by "stack ghci"
-    pkgFiles = GetPackageFiles $
-        \cabalfp -> debugBracket ("getPackageFiles" <+> pretty cabalfp) $ do
-             let pkgDir = parent cabalfp
-             distDir <- distDirFromDir pkgDir
-             bc <- view buildConfigL
-             cabalVer <- view cabalVersionL
-             (componentModules,componentFiles,dataFiles',warnings) <-
-                 runRIO
-                     (GetPackageFileContext cabalfp distDir bc cabalVer)
-                     (packageDescModulesAndFiles pkg)
-             setupFiles <-
-                 if buildType pkg == Custom
-                 then do
-                     let setupHsPath = pkgDir </> relFileSetupHs
-                         setupLhsPath = pkgDir </> relFileSetupLhs
-                     setupHsExists <- doesFileExist setupHsPath
-                     if setupHsExists then pure (S.singleton setupHsPath) else do
-                         setupLhsExists <- doesFileExist setupLhsPath
-                         if setupLhsExists then pure (S.singleton setupLhsPath) else pure S.empty
-                 else pure S.empty
-             buildFiles <- liftM (S.insert cabalfp . S.union setupFiles) $ do
-                 let hpackPath = pkgDir </> relFileHpackPackageConfig
-                 hpackExists <- doesFileExist hpackPath
-                 pure $ if hpackExists then S.singleton hpackPath else S.empty
-             pure (componentModules, componentFiles, buildFiles <> dataFiles', warnings)
-    pkgId = package pkg
-    name = pkgName pkgId
-
-    (unknownTools, knownTools) = packageDescTools pkg
-
-    deps = M.filterWithKey (const . not . isMe) (M.unionsWith (<>)
-        [ asLibrary <$> packageDependencies packageConfig pkg
-        -- We include all custom-setup deps - if present - in the
-        -- package deps themselves. Stack always works with the
-        -- invariant that there will be a single installed package
-        -- relating to a package name, and this applies at the setup
-        -- dependency level as well.
-        , asLibrary <$> fromMaybe M.empty msetupDeps
-        , knownTools
-        ])
-    msetupDeps = fmap
-        (M.fromList . map (depPkgName &&& depVerRange) . setupDepends)
-        (setupBuildInfo pkg)
-
-    asLibrary range = DepValue
-      { dvVersionRange = range
-      , dvType = AsLibrary
-      }
-
-    -- Is the package dependency mentioned here me: either the package
-    -- name itself, or the name of one of the sub libraries
-    isMe name' = name' == name || fromString (packageNameString name') `S.member` extraLibNames
-
--- | Generate GHC options for the package's components, and a list of
--- options which apply generally to the package, not one specific
--- component.
-generatePkgDescOpts
-    :: (HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m)
-    => InstallMap
-    -> InstalledMap
-    -> [PackageName] -- ^ Packages to omit from the "-package" / "-package-id" flags
-    -> [PackageName] -- ^ Packages to add to the "-package" flags
-    -> Path Abs File
-    -> PackageDescription
-    -> Map NamedComponent [DotCabalPath]
-    -> m (Map NamedComponent BuildInfoOpts)
-generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do
-    config <- view configL
-    cabalVer <- view cabalVersionL
-    distDir <- distDirFromDir cabalDir
-    let generate namedComponent binfo =
-            ( namedComponent
-            , generateBuildInfoOpts BioInput
-                { biInstallMap = installMap
-                , biInstalledMap = installedMap
-                , biCabalDir = cabalDir
-                , biDistDir = distDir
-                , biOmitPackages = omitPkgs
-                , biAddPackages = addPkgs
-                , biBuildInfo = binfo
-                , biDotCabalPaths = fromMaybe [] (M.lookup namedComponent componentPaths)
-                , biConfigLibDirs = configExtraLibDirs config
-                , biConfigIncludeDirs = configExtraIncludeDirs config
-                , biComponentName = namedComponent
-                , biCabalVersion = cabalVer
-                }
-            )
-    pure
-        ( M.fromList
-              (concat
-                   [ maybe
-                         []
-                         (pure . generate CLib . libBuildInfo)
-                         (library pkg)
-                   , mapMaybe
-                         (\sublib -> do
-                            let maybeLib = CInternalLib . T.pack . Cabal.unUnqualComponentName <$> (libraryNameString . libName) sublib
-                            flip generate  (libBuildInfo sublib) <$> maybeLib
-                          )
-                         (subLibraries pkg)
-                   , fmap
-                         (\exe ->
-                               generate
-                                    (CExe (T.pack (Cabal.unUnqualComponentName (exeName exe))))
-                                    (buildInfo exe))
-                         (executables pkg)
-                   , fmap
-                         (\bench ->
-                               generate
-                                    (CBench (T.pack (Cabal.unUnqualComponentName (benchmarkName bench))))
-                                    (benchmarkBuildInfo bench))
-                         (benchmarks pkg)
-                   , fmap
-                         (\test ->
-                               generate
-                                    (CTest (T.pack (Cabal.unUnqualComponentName (testName test))))
-                                    (testBuildInfo test))
-                         (testSuites pkg)]))
-  where
-    cabalDir = parent cabalfp
-
--- | Input to 'generateBuildInfoOpts'
-data BioInput = BioInput
-    { biInstallMap :: !InstallMap
-    , biInstalledMap :: !InstalledMap
-    , biCabalDir :: !(Path Abs Dir)
-    , biDistDir :: !(Path Abs Dir)
-    , biOmitPackages :: ![PackageName]
-    , biAddPackages :: ![PackageName]
-    , biBuildInfo :: !BuildInfo
-    , biDotCabalPaths :: ![DotCabalPath]
-    , biConfigLibDirs :: ![FilePath]
-    , biConfigIncludeDirs :: ![FilePath]
-    , biComponentName :: !NamedComponent
-    , biCabalVersion :: !Version
-    }
-
--- | Generate GHC options for the target. Since Cabal also figures out
--- these options, currently this is only used for invoking GHCI (via
--- stack ghci).
-generateBuildInfoOpts :: BioInput -> BuildInfoOpts
-generateBuildInfoOpts BioInput {..} =
-    BuildInfoOpts
-        { bioOpts = ghcOpts ++ fmap ("-optP" <>) (cppOptions biBuildInfo)
-        -- NOTE for future changes: Due to this use of nubOrd (and other uses
-        -- downstream), these generated options must not rely on multiple
-        -- argument sequences.  For example, ["--main-is", "Foo.hs", "--main-
-        -- is", "Bar.hs"] would potentially break due to the duplicate
-        -- "--main-is" being removed.
-        --
-        -- See https://github.com/commercialhaskell/stack/issues/1255
-        , bioOneWordOpts = nubOrd $ concat
-            [extOpts, srcOpts, includeOpts, libOpts, fworks, cObjectFiles]
-        , bioPackageFlags = deps
-        , bioCabalMacros = componentAutogen </> relFileCabalMacrosH
-        }
-  where
-    cObjectFiles =
-        mapMaybe (fmap toFilePath .
-                  makeObjectFilePathFromC biCabalDir biComponentName biDistDir)
-                 cfiles
-    cfiles = mapMaybe dotCabalCFilePath biDotCabalPaths
-    installVersion = snd
-    -- Generates: -package=base -package=base16-bytestring-0.1.1.6 ...
-    deps =
-        concat
-            [ case M.lookup name biInstalledMap of
-                Just (_, Stack.Types.Package.Library _ident ipid _) -> ["-package-id=" <> ghcPkgIdString ipid]
-                _ -> ["-package=" <> packageNameString name <>
-                 maybe "" -- This empty case applies to e.g. base.
-                     ((("-" <>) . versionString) . installVersion)
-                     (M.lookup name biInstallMap)]
-            | name <- pkgs]
-    pkgs =
-        biAddPackages ++
-        [ name
-        | Dependency name _ _ <- targetBuildDepends biBuildInfo -- TODO: cabal 3 introduced multiple public libraries in a single dependency
-        , name `notElem` biOmitPackages]
-    PerCompilerFlavor ghcOpts _ = options biBuildInfo
-    extOpts = map (("-X" ++) . display) (usedExtensions biBuildInfo)
-    srcOpts =
-        map (("-i" <>) . toFilePathNoTrailingSep)
-            (concat
-              [ [ componentBuildDir biCabalVersion biComponentName biDistDir ]
-              , [ biCabalDir
-                | null (hsSourceDirs biBuildInfo)
-                ]
-              , mapMaybe (toIncludeDir . getSymbolicPath) (hsSourceDirs biBuildInfo)
-              , [ componentAutogen ]
-              , maybeToList (packageAutogenDir biCabalVersion biDistDir)
-              , [ componentOutputDir biComponentName biDistDir ]
-              ]) ++
-        [ "-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir) ]
-    componentAutogen = componentAutogenDir biCabalVersion biComponentName biDistDir
-    toIncludeDir "." = Just biCabalDir
-    toIncludeDir relDir = concatAndCollapseAbsDir biCabalDir relDir
-    includeOpts =
-        map ("-I" <>) (biConfigIncludeDirs <> pkgIncludeOpts)
-    pkgIncludeOpts =
-        [ toFilePathNoTrailingSep absDir
-        | dir <- includeDirs biBuildInfo
-        , absDir <- handleDir dir
-        ]
-    libOpts =
-        map ("-l" <>) (extraLibs biBuildInfo) <>
-        map ("-L" <>) (biConfigLibDirs <> pkgLibDirs)
-    pkgLibDirs =
-        [ toFilePathNoTrailingSep absDir
-        | dir <- extraLibDirs biBuildInfo
-        , absDir <- handleDir dir
-        ]
-    handleDir dir = case (parseAbsDir dir, parseRelDir dir) of
-       (Just ab, _       ) -> [ab]
-       (_      , Just rel) -> [biCabalDir </> rel]
-       (Nothing, Nothing ) -> []
-    fworks = map (\fwk -> "-framework=" <> fwk) (frameworks biBuildInfo)
-
--- | Make the .o path from the .c file path for a component. Example:
---
--- @
--- executable FOO
---   c-sources:        cbits/text_search.c
--- @
---
--- Produces
---
--- <dist-dir>/build/FOO/FOO-tmp/cbits/text_search.o
---
--- Example:
---
--- λ> makeObjectFilePathFromC
---     $(mkAbsDir "/Users/chris/Repos/hoogle")
---     CLib
---     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")
---     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")
--- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/cbits/text_search.o"
--- λ> makeObjectFilePathFromC
---     $(mkAbsDir "/Users/chris/Repos/hoogle")
---     (CExe "hoogle")
---     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")
---     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")
--- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/hoogle/hoogle-tmp/cbits/text_search.o"
--- λ>
-makeObjectFilePathFromC
-    :: MonadThrow m
-    => Path Abs Dir          -- ^ The cabal directory.
-    -> NamedComponent        -- ^ The name of the component.
-    -> Path Abs Dir          -- ^ Dist directory.
-    -> Path Abs File         -- ^ The path to the .c file.
-    -> m (Path Abs File) -- ^ The path to the .o file for the component.
-makeObjectFilePathFromC cabalDir namedComponent distDir cFilePath = do
-    relCFilePath <- stripProperPrefix cabalDir cFilePath
-    relOFilePath <-
-        parseRelFile (replaceExtension (toFilePath relCFilePath) "o")
-    pure (componentOutputDir namedComponent distDir </> relOFilePath)
-
--- | Get all dependencies of the package (buildable targets only).
---
--- Note that for Cabal versions 1.22 and earlier, there is a bug where
--- Cabal requires dependencies for non-buildable components to be
--- present. We're going to use GHC version as a proxy for Cabal
--- library version in this case for simplicity, so we'll check for GHC
--- being 7.10 or earlier. This obviously makes our function a lot more
--- fun to write...
-packageDependencies
-  :: PackageConfig
-  -> PackageDescription
-  -> Map PackageName VersionRange
-packageDependencies pkgConfig pkg' =
-  M.fromListWith intersectVersionRanges $
-  map (depPkgName &&& depVerRange) $
-  concatMap targetBuildDepends (allBuildInfo' pkg) ++
-  maybe [] setupDepends (setupBuildInfo pkg)
-  where
-    pkg
-      | getGhcVersion (packageConfigCompilerVersion pkgConfig) >= mkVersion [8, 0] = pkg'
-      -- Set all components to buildable. Only need to worry about
-      -- library, exe, test, and bench, since others didn't exist in
-      -- older Cabal versions
-      | otherwise = pkg'
-        { library = (\c -> c { libBuildInfo = go (libBuildInfo c) }) <$> library pkg'
-        , executables = (\c -> c { buildInfo = go (buildInfo c) }) <$> executables pkg'
-        , testSuites =
-            if packageConfigEnableTests pkgConfig
-              then (\c -> c { testBuildInfo = go (testBuildInfo c) }) <$> testSuites pkg'
-              else testSuites pkg'
-        , benchmarks =
-            if packageConfigEnableBenchmarks pkgConfig
-              then (\c -> c { benchmarkBuildInfo = go (benchmarkBuildInfo c) }) <$> benchmarks pkg'
-              else benchmarks pkg'
-        }
-
-    go bi = bi { buildable = True }
-
--- | Get all dependencies of the package (buildable targets only).
---
--- This uses both the new 'buildToolDepends' and old 'buildTools'
--- information.
-packageDescTools
-  :: PackageDescription
-  -> (Set ExeName, Map PackageName DepValue)
-packageDescTools pd =
-    (S.fromList $ concat unknowns, M.fromListWith (<>) $ concat knowns)
-  where
-    (unknowns, knowns) = unzip $ map perBI $ allBuildInfo' pd
-
-    perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
-    perBI bi =
-        (unknownTools, tools)
-      where
-        (unknownTools, knownTools) = partitionEithers $ map go1 (buildTools bi)
-
-        tools = mapMaybe go2 (knownTools ++ buildToolDepends bi)
-
-        -- This is similar to desugarBuildTool from Cabal, however it
-        -- uses our own hard-coded map which drops tools shipped with
-        -- GHC (like hsc2hs), and includes some tools from Stackage.
-        go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency
-        go1 (Cabal.LegacyExeDependency name range) =
-          case M.lookup name hardCodedMap of
-            Just pkgName -> Right $ Cabal.ExeDependency pkgName (Cabal.mkUnqualComponentName name) range
-            Nothing -> Left $ ExeName $ T.pack name
-
-        go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue)
-        go2 (Cabal.ExeDependency pkg _name range)
-          | pkg `S.member` preInstalledPackages = Nothing
-          | otherwise = Just
-              ( pkg
-              , DepValue
-                  { dvVersionRange = range
-                  , dvType = AsBuildTool
-                  }
-              )
-
--- | A hard-coded map for tool dependencies
-hardCodedMap :: Map String PackageName
-hardCodedMap = M.fromList
-  [ ("alex", Distribution.Package.mkPackageName "alex")
-  , ("happy", Distribution.Package.mkPackageName "happy")
-  , ("cpphs", Distribution.Package.mkPackageName "cpphs")
-  , ("greencard", Distribution.Package.mkPackageName "greencard")
-  , ("c2hs", Distribution.Package.mkPackageName "c2hs")
-  , ("hscolour", Distribution.Package.mkPackageName "hscolour")
-  , ("hspec-discover", Distribution.Package.mkPackageName "hspec-discover")
-  , ("hsx2hs", Distribution.Package.mkPackageName "hsx2hs")
-  , ("gtk2hsC2hs", Distribution.Package.mkPackageName "gtk2hs-buildtools")
-  , ("gtk2hsHookGenerator", Distribution.Package.mkPackageName "gtk2hs-buildtools")
-  , ("gtk2hsTypeGen", Distribution.Package.mkPackageName "gtk2hs-buildtools")
-  ]
-
--- | Executable-only packages which come pre-installed with GHC and do
--- not need to be built. Without this exception, we would either end
--- up unnecessarily rebuilding these packages, or failing because the
--- packages do not appear in the Stackage snapshot.
-preInstalledPackages :: Set PackageName
-preInstalledPackages = S.fromList
-  [ mkPackageName "hsc2hs"
-  , mkPackageName "haddock"
-  ]
-
--- | Variant of 'allBuildInfo' from Cabal that, like versions before
--- 2.2, only includes buildable components.
-allBuildInfo' :: PackageDescription -> [BuildInfo]
-allBuildInfo' pkg_descr = [ bi | lib <- allLibraries pkg_descr
-                               , let bi = libBuildInfo lib
-                               , buildable bi ]
-                       ++ [ bi | flib <- foreignLibs pkg_descr
-                               , let bi = foreignLibBuildInfo flib
-                               , buildable bi ]
-                       ++ [ bi | exe <- executables pkg_descr
-                               , let bi = buildInfo exe
-                               , buildable bi ]
-                       ++ [ bi | tst <- testSuites pkg_descr
-                               , let bi = testBuildInfo tst
-                               , buildable bi ]
-                       ++ [ bi | tst <- benchmarks pkg_descr
-                               , let bi = benchmarkBuildInfo tst
-                               , buildable bi ]
-
--- | A pair of package descriptions: one which modified the buildable
--- values of test suites and benchmarks depending on whether they are
--- enabled, and one which does not.
---
--- Fields are intentionally lazy, we may only need one or the other
--- value.
---
--- MSS 2017-08-29: The very presence of this data type is terribly
--- ugly, it represents the fact that the Cabal 2.0 upgrade did _not_
--- go well. Specifically, we used to have a field to indicate whether
--- a component was enabled in addition to buildable, but that's gone
--- now, and this is an ugly proxy. We should at some point clean up
--- the mess of Package, LocalPackage, etc, and probably pull in the
--- definition of PackageDescription from Cabal with our additionally
--- needed metadata. But this is a good enough hack for the
--- moment. Odds are, you're reading this in the year 2024 and thinking
--- "wtf?"
-data PackageDescriptionPair = PackageDescriptionPair
-  { pdpOrigBuildable :: PackageDescription
-  , pdpModifiedBuildable :: PackageDescription
-  }
-
--- | Evaluates the conditions of a 'GenericPackageDescription', yielding
--- a resolved 'PackageDescription'.
-resolvePackageDescription :: PackageConfig
-                          -> GenericPackageDescription
-                          -> PackageDescriptionPair
-resolvePackageDescription packageConfig (GenericPackageDescription desc _ defaultFlags mlib subLibs foreignLibs' exes tests benches) =
-    PackageDescriptionPair
-      { pdpOrigBuildable = go False
-      , pdpModifiedBuildable = go True
-      }
-  where
-        go modBuildable =
-          desc {library =
-                  fmap (resolveConditions rc updateLibDeps) mlib
-               ,subLibraries =
-                  map (\(n, v) -> (resolveConditions rc updateLibDeps v){libName=LSubLibName n})
-                      subLibs
-               ,foreignLibs =
-                  map (\(n, v) -> (resolveConditions rc updateForeignLibDeps v){foreignLibName=n})
-                      foreignLibs'
-               ,executables =
-                  map (\(n, v) -> (resolveConditions rc updateExeDeps v){exeName=n})
-                      exes
-               ,testSuites =
-                  map (\(n,v) -> (resolveConditions rc (updateTestDeps modBuildable) v){testName=n})
-                      tests
-               ,benchmarks =
-                  map (\(n,v) -> (resolveConditions rc (updateBenchmarkDeps modBuildable) v){benchmarkName=n})
-                      benches}
-
-        flags =
-          M.union (packageConfigFlags packageConfig)
-                  (flagMap defaultFlags)
-
-        rc = mkResolveConditions
-                (packageConfigCompilerVersion packageConfig)
-                (packageConfigPlatform packageConfig)
-                flags
-
-        updateLibDeps lib deps =
-          lib {libBuildInfo =
-                 (libBuildInfo lib) {targetBuildDepends = deps}}
-        updateForeignLibDeps lib deps =
-          lib {foreignLibBuildInfo =
-                 (foreignLibBuildInfo lib) {targetBuildDepends = deps}}
-        updateExeDeps exe deps =
-          exe {buildInfo =
-                 (buildInfo exe) {targetBuildDepends = deps}}
-
-        -- Note that, prior to moving to Cabal 2.0, we would set
-        -- testEnabled/benchmarkEnabled here. These fields no longer
-        -- exist, so we modify buildable instead here.  The only
-        -- wrinkle in the Cabal 2.0 story is
-        -- https://github.com/haskell/cabal/issues/1725, where older
-        -- versions of Cabal (which may be used for actually building
-        -- code) don't properly exclude build-depends for
-        -- non-buildable components. Testing indicates that everything
-        -- is working fine, and that this comment can be completely
-        -- ignored. I'm leaving the comment anyway in case something
-        -- breaks and you, poor reader, are investigating.
-        updateTestDeps modBuildable test deps =
-          let bi = testBuildInfo test
-              bi' = bi
-                { targetBuildDepends = deps
-                , buildable = buildable bi && (if modBuildable then packageConfigEnableTests packageConfig else True)
-                }
-           in test { testBuildInfo = bi' }
-        updateBenchmarkDeps modBuildable benchmark deps =
-          let bi = benchmarkBuildInfo benchmark
-              bi' = bi
-                { targetBuildDepends = deps
-                , buildable = buildable bi && (if modBuildable then packageConfigEnableBenchmarks packageConfig else True)
-                }
-           in benchmark { benchmarkBuildInfo = bi' }
-
--- | Make a map from a list of flag specifications.
---
--- What is @flagManual@ for?
-flagMap :: [PackageFlag] -> Map FlagName Bool
-flagMap = M.fromList . map pair
-  where pair :: PackageFlag -> (FlagName, Bool)
-        pair = flagName &&& flagDefault
-
-data ResolveConditions = ResolveConditions
-    { rcFlags :: Map FlagName Bool
-    , rcCompilerVersion :: ActualCompiler
-    , rcOS :: OS
-    , rcArch :: Arch
-    }
-
--- | Generic a @ResolveConditions@ using sensible defaults.
-mkResolveConditions :: ActualCompiler -- ^ Compiler version
-                    -> Platform -- ^ installation target platform
-                    -> Map FlagName Bool -- ^ enabled flags
-                    -> ResolveConditions
-mkResolveConditions compilerVersion (Platform arch os) flags = ResolveConditions
-    { rcFlags = flags
-    , rcCompilerVersion = compilerVersion
-    , rcOS = os
-    , rcArch = arch
-    }
-
--- | Resolve the condition tree for the library.
-resolveConditions :: (Semigroup target,Monoid target,Show target)
-                  => ResolveConditions
-                  -> (target -> cs -> target)
-                  -> CondTree ConfVar cs target
-                  -> target
-resolveConditions rc addDeps (CondNode lib deps cs) = basic <> children
-  where basic = addDeps lib deps
-        children = mconcat (map apply cs)
-          where apply (Cabal.CondBranch cond node mcs) =
-                  if condSatisfied cond
-                     then resolveConditions rc addDeps node
-                     else maybe mempty (resolveConditions rc addDeps) mcs
-                condSatisfied c =
-                  case c of
-                    Var v -> varSatisfied v
-                    Lit b -> b
-                    CNot c' ->
-                      not (condSatisfied c')
-                    COr cx cy ->
-                      condSatisfied cx || condSatisfied cy
-                    CAnd cx cy ->
-                      condSatisfied cx && condSatisfied cy
-                varSatisfied v =
-                  case v of
-                    OS os -> os == rcOS rc
-                    Arch arch -> arch == rcArch rc
-                    PackageFlag flag ->
-                      fromMaybe False $ M.lookup flag (rcFlags rc)
-                      -- NOTE:  ^^^^^ This should never happen, as all flags
-                      -- which are used must be declared. Defaulting to
-                      -- False.
-                    Impl flavor range ->
-                      case (flavor, rcCompilerVersion rc) of
-                        (GHC, ACGhc vghc) -> vghc `withinRange` range
-                        _ -> False
-
--- | Path for the package's build log.
-buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m)
-             => Package -> Maybe String -> m (Path Abs File)
-buildLogPath package' msuffix = do
-  env <- ask
-  let stack = getProjectWorkDir env
-  fp <- parseRelFile $ concat $
-    packageIdentifierString (packageIdentifier package') :
-    maybe id (\suffix -> ("-" :) . (suffix :)) msuffix [".log"]
-  pure $ stack </> relDirLogs </> fp
-
-    {- FIXME
--- | Create a 'ProjectPackage' from a directory containing a package.
-mkProjectPackage
-  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => PrintWarnings
-  -> ResolvedPath Dir
-  -> RIO env ProjectPackage
-mkProjectPackage printWarnings dir = do
-  (gpd, name, cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
-  pure ProjectPackage
-    { ppCabalFP = cabalfp
-    , ppGPD' = gpd printWarnings
-    , ppResolvedDir = dir
-    , ppName = name
-    }
-
--- | Create a 'DepPackage' from a 'PackageLocation'
-mkDepPackage
-  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => PackageLocation
-  -> RIO env DepPackage
-mkDepPackage pl = do
-  (name, gpdio) <-
-    case pl of
-      PLMutable dir -> do
-        (gpdio, name, _cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
-        pure (name, gpdio NoPrintWarnings)
-      PLImmutable pli -> do
-        PackageIdentifier name _ <- getPackageLocationIdent pli
-        run <- askRunInIO
-        pure (name, run $ loadCabalFileImmutable pli)
-  pure DepPackage
-    { dpGPD' = gpdio
-    , dpLocation = pl
-    , dpName = name
-    }
-
-    -}
-
--- | Force a package to be treated as a custom build type, see
--- <https://github.com/commercialhaskell/stack/issues/4488>
-applyForceCustomBuild
-  :: Version -- ^ global Cabal version
-  -> Package
-  -> Package
-applyForceCustomBuild cabalVersion package
-    | forceCustomBuild =
-        package
-          { packageBuildType = Custom
-          , packageDeps = M.insertWith (<>) "Cabal" (DepValue cabalVersionRange AsLibrary)
-                        $ packageDeps package
-          , packageSetupDeps = Just $ M.fromList
-              [ ("Cabal", cabalVersionRange)
-              , ("base", anyVersion)
-              ]
-          }
-    | otherwise = package
-  where
-    cabalVersionRange =
-      orLaterVersion $ mkVersion $ cabalSpecToVersionDigits $
-        packageCabalSpec package
-    forceCustomBuild =
-      packageBuildType package == Simple &&
-      not (cabalVersion `withinRange` cabalVersionRange)
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+
+-- | Dealing with Cabal.
+
+module Stack.Package
+  ( readDotBuildinfo
+  , resolvePackage
+  , packageFromPackageDescription
+  , Package (..)
+  , PackageDescriptionPair (..)
+  , GetPackageOpts (..)
+  , PackageConfig (..)
+  , buildLogPath
+  , PackageException (..)
+  , resolvePackageDescription
+  , packageDependencies
+  , applyForceCustomBuild
+  ) where
+
+import           Data.List ( unzip )
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import qualified Data.Text as T
+import           Distribution.CabalSpecVersion ( cabalSpecToVersionDigits )
+import qualified Distribution.Compat.NonEmptySet as NES
+import           Distribution.Compiler
+                   ( CompilerFlavor (..), PerCompilerFlavor (..) )
+import           Distribution.Package ( mkPackageName )
+import           Distribution.PackageDescription
+                   ( Benchmark (..), BuildInfo (..), BuildType (..)
+                   , CondTree (..), Condition (..), ConfVar (..)
+                   , Dependency (..), Executable (..), ForeignLib (..)
+                   , GenericPackageDescription (..), HookedBuildInfo
+                   , Library (..), PackageDescription (..), PackageFlag (..)
+                   , SetupBuildInfo (..), TestSuite (..), allLanguages
+                   , allLibraries, buildType, depPkgName, depVerRange
+                   , libraryNameString, maybeToLibraryName, usedExtensions
+                   )
+import           Distribution.Pretty ( prettyShow )
+import           Distribution.Simple.PackageDescription ( readHookedBuildInfo )
+import           Distribution.System ( OS (..), Arch, Platform (..) )
+import           Distribution.Text ( display )
+import qualified Distribution.Types.CondTree as Cabal
+import qualified Distribution.Types.ExeDependency as Cabal
+import qualified Distribution.Types.LegacyExeDependency as Cabal
+import qualified Distribution.Types.UnqualComponentName as Cabal
+import           Distribution.Utils.Path ( getSymbolicPath )
+import           Distribution.Verbosity ( silent )
+import           Distribution.Version
+                   ( anyVersion, mkVersion, orLaterVersion )
+import           Path as FL hiding ( replaceExtension )
+import           Path.Extra ( concatAndCollapseAbsDir, toFilePathNoTrailingSep )
+import           Stack.Constants (relFileCabalMacrosH, relDirLogs)
+import           Stack.Constants.Config ( distDirFromDir )
+import           Stack.Prelude hiding ( Display (..) )
+import           Stack.ComponentFile
+                   ( buildDir, componentAutogenDir, componentBuildDir
+                   , componentOutputDir, packageAutogenDir
+                   )
+import           Stack.Types.BuildConfig
+                   ( HasBuildConfig (..), getProjectWorkDir )
+import           Stack.Types.Compiler ( ActualCompiler (..), getGhcVersion )
+import           Stack.Types.CompilerPaths ( cabalVersionL )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.EnvConfig ( HasEnvConfig )
+import           Stack.Types.GhcPkgId ( ghcPkgIdString )
+import           Stack.Types.NamedComponent
+                   ( NamedComponent (..), internalLibComponents )
+import           Stack.Types.Package
+                   ( BuildInfoOpts (..), ExeName (..), GetPackageOpts (..)
+                   , InstallMap, Installed (..), InstalledMap, Package (..)
+                   , PackageConfig (..), PackageException (..)
+                   , PackageLibraries (..), dotCabalCFilePath, packageIdentifier
+                   )
+import           Stack.Types.Version
+                   ( VersionRange, intersectVersionRanges, withinRange )
+import           System.FilePath ( replaceExtension )
+import           Stack.Types.Dependency ( DepValue (..), DepType (..) )
+import           Stack.Types.PackageFile ( DotCabalPath , GetPackageFiles (..) )
+import           Stack.PackageFile ( getPackageFile )
+
+-- | Read @<package>.buildinfo@ ancillary files produced by some Setup.hs hooks.
+-- The file includes Cabal file syntax to be merged into the package description
+-- derived from the package's Cabal file.
+--
+-- NOTE: not to be confused with BuildInfo, an Stack-internal datatype.
+readDotBuildinfo :: MonadIO m => Path Abs File -> m HookedBuildInfo
+readDotBuildinfo buildinfofp =
+  liftIO $ readHookedBuildInfo silent (toFilePath buildinfofp)
+
+-- | Resolve a parsed Cabal file into a 'Package', which contains all of the
+-- info needed for Stack to build the 'Package' given the current configuration.
+resolvePackage :: PackageConfig -> GenericPackageDescription -> Package
+resolvePackage packageConfig gpkg =
+  packageFromPackageDescription
+    packageConfig
+    (genPackageFlags gpkg)
+    (resolvePackageDescription packageConfig gpkg)
+
+packageFromPackageDescription ::
+     PackageConfig
+  -> [PackageFlag]
+  -> PackageDescriptionPair
+  -> Package
+packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkgNoMod pkg) =
+  Package
+  { packageName = name
+  , packageVersion = pkgVersion pkgId
+  , packageLicense = licenseRaw pkg
+  , packageDeps = deps
+  , packageFiles = pkgFiles
+  , packageUnknownTools = unknownTools
+  , packageGhcOptions = packageConfigGhcOptions packageConfig
+  , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig
+  , packageFlags = packageConfigFlags packageConfig
+  , packageDefaultFlags = M.fromList
+      [(flagName flag, flagDefault flag) | flag <- pkgFlags]
+  , packageAllDeps = M.keysSet deps
+  , packageSubLibDeps = subLibDeps
+  , packageLibraries =
+      let mlib = do
+            lib <- library pkg
+            guard $ buildable $ libBuildInfo lib
+            Just lib
+       in
+        case mlib of
+          Nothing -> NoLibraries
+          Just _ -> HasLibraries foreignLibNames
+  , packageInternalLibraries = subLibNames
+  , packageTests = M.fromList
+      [ (T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t)
+      | t <- testSuites pkgNoMod
+      , buildable (testBuildInfo t)
+      ]
+  , packageBenchmarks = S.fromList
+      [ T.pack (Cabal.unUnqualComponentName $ benchmarkName b)
+      | b <- benchmarks pkgNoMod
+      , buildable (benchmarkBuildInfo b)
+      ]
+      -- Same comment about buildable applies here too.
+  , packageExes = S.fromList
+      [ T.pack (Cabal.unUnqualComponentName $ exeName biBuildInfo)
+      | biBuildInfo <- executables pkg
+      , buildable (buildInfo biBuildInfo)
+      ]
+  -- This is an action used to collect info needed for "stack ghci".
+  -- This info isn't usually needed, so computation of it is deferred.
+  , packageOpts = GetPackageOpts $
+      \installMap installedMap omitPkgs addPkgs cabalfp -> do
+        (componentsModules,componentFiles, _, _) <- getPackageFiles pkgFiles cabalfp
+        let internals =
+              S.toList $ internalLibComponents $ M.keysSet componentsModules
+        excludedInternals <- mapM (parsePackageNameThrowing . T.unpack) internals
+        mungedInternals <- mapM
+          (parsePackageNameThrowing . T.unpack . toInternalPackageMungedName)
+          internals
+        componentsOpts <- generatePkgDescOpts
+          installMap
+          installedMap
+          (excludedInternals ++ omitPkgs)
+          (mungedInternals ++ addPkgs)
+          cabalfp
+          pkg
+          componentFiles
+        pure (componentsModules, componentFiles, componentsOpts)
+  , packageHasExposedModules = maybe
+      False
+      (not . null . exposedModules)
+      (library pkg)
+  , packageBuildType = buildType pkg
+  , packageSetupDeps = msetupDeps
+  , packageCabalSpec = specVersion pkg
+  }
+ where
+  extraLibNames = S.union subLibNames foreignLibNames
+
+  subLibNames
+    = S.fromList
+    $ map (T.pack . Cabal.unUnqualComponentName)
+    $ mapMaybe (libraryNameString . libName) -- this is a design bug in the
+                                             -- Cabal API: this should
+                                             -- statically be known to exist
+    $ filter (buildable . libBuildInfo)
+    $ subLibraries pkg
+
+  foreignLibNames
+    = S.fromList
+    $ map (T.pack . Cabal.unUnqualComponentName . foreignLibName)
+    $ filter (buildable . foreignLibBuildInfo)
+    $ foreignLibs pkg
+
+  toInternalPackageMungedName
+    = T.pack . prettyShow . MungedPackageName (pkgName pkgId)
+    . maybeToLibraryName . Just . Cabal.mkUnqualComponentName . T.unpack
+
+  -- Gets all of the modules, files, build files, and data files that constitute
+  -- the package. This is primarily used for dirtiness checking during build, as
+  -- well as use by "stack ghci"
+  pkgFiles = GetPackageFiles $ getPackageFile pkg
+  pkgId = package pkg
+  name = pkgName pkgId
+
+  (unknownTools, knownTools) = packageDescTools pkg
+
+  deps = M.filterWithKey (const . not . isMe) (M.unionsWith (<>)
+    [ asLibrary <$> packageDependencies packageConfig pkg
+    -- We include all custom-setup deps - if present - in the package deps
+    -- themselves. Stack always works with the invariant that there will be a
+    -- single installed package relating to a package name, and this applies at
+    -- the setup dependency level as well.
+    , asLibrary <$> fromMaybe M.empty msetupDeps
+    , knownTools
+    ])
+
+  msetupDeps = fmap
+    (M.fromList . map (depPkgName &&& depVerRange) . setupDepends)
+    (setupBuildInfo pkg)
+
+  subLibDeps = M.fromList $ concatMap
+    (\(Dependency n vr libs) -> mapMaybe (getSubLibName n vr) (NES.toList libs))
+    (concatMap targetBuildDepends (allBuildInfo' pkg))
+
+  getSubLibName pn vr lib@(LSubLibName _) =
+    Just (MungedPackageName pn lib, asLibrary vr)
+  getSubLibName _ _ _ = Nothing
+
+  asLibrary range = DepValue
+    { dvVersionRange = range
+    , dvType = AsLibrary
+    }
+
+  -- Is the package dependency mentioned here me: either the package name
+  -- itself, or the name of one of the sub libraries
+  isMe name' =  name' == name
+             || fromString (packageNameString name') `S.member` extraLibNames
+
+-- | Generate GHC options for the package's components, and a list of options
+-- which apply generally to the package, not one specific component.
+generatePkgDescOpts ::
+     (HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m)
+  => InstallMap
+  -> InstalledMap
+  -> [PackageName]
+     -- ^ Packages to omit from the "-package" / "-package-id" flags
+  -> [PackageName]
+     -- ^ Packages to add to the "-package" flags
+  -> Path Abs File
+  -> PackageDescription
+  -> Map NamedComponent [DotCabalPath]
+  -> m (Map NamedComponent BuildInfoOpts)
+generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do
+  config <- view configL
+  cabalVer <- view cabalVersionL
+  distDir <- distDirFromDir cabalDir
+  let generate namedComponent binfo =
+        ( namedComponent
+        , generateBuildInfoOpts BioInput
+            { biInstallMap = installMap
+            , biInstalledMap = installedMap
+            , biCabalDir = cabalDir
+            , biDistDir = distDir
+            , biOmitPackages = omitPkgs
+            , biAddPackages = addPkgs
+            , biBuildInfo = binfo
+            , biDotCabalPaths =
+                fromMaybe [] (M.lookup namedComponent componentPaths)
+            , biConfigLibDirs = configExtraLibDirs config
+            , biConfigIncludeDirs = configExtraIncludeDirs config
+            , biComponentName = namedComponent
+            , biCabalVersion = cabalVer
+            }
+        )
+  pure
+    ( M.fromList
+        ( concat
+            [ maybe
+                []
+                (pure . generate CLib . libBuildInfo)
+                (library pkg)
+            , mapMaybe
+                (\sublib -> do
+                  let maybeLib =
+                        CInternalLib . T.pack . Cabal.unUnqualComponentName <$>
+                          (libraryNameString . libName) sublib
+                  flip generate  (libBuildInfo sublib) <$> maybeLib
+                 )
+                (subLibraries pkg)
+            , fmap
+                (\exe ->
+                  generate
+                    (CExe (T.pack (Cabal.unUnqualComponentName (exeName exe))))
+                    (buildInfo exe)
+                )
+                (executables pkg)
+            , fmap
+                (\bench ->
+                  generate
+                    (CBench
+                      (T.pack (Cabal.unUnqualComponentName (benchmarkName bench)))
+                    )
+                    (benchmarkBuildInfo bench)
+                )
+                (benchmarks pkg)
+            , fmap
+                (\test ->
+                  generate
+                    (CTest (T.pack (Cabal.unUnqualComponentName (testName test))))
+                    (testBuildInfo test)
+                )
+                (testSuites pkg)
+            ]
+        )
+    )
+ where
+  cabalDir = parent cabalfp
+
+-- | Input to 'generateBuildInfoOpts'
+data BioInput = BioInput
+  { biInstallMap :: !InstallMap
+  , biInstalledMap :: !InstalledMap
+  , biCabalDir :: !(Path Abs Dir)
+  , biDistDir :: !(Path Abs Dir)
+  , biOmitPackages :: ![PackageName]
+  , biAddPackages :: ![PackageName]
+  , biBuildInfo :: !BuildInfo
+  , biDotCabalPaths :: ![DotCabalPath]
+  , biConfigLibDirs :: ![FilePath]
+  , biConfigIncludeDirs :: ![FilePath]
+  , biComponentName :: !NamedComponent
+  , biCabalVersion :: !Version
+  }
+
+-- | Generate GHC options for the target. Since Cabal also figures out these
+-- options, currently this is only used for invoking GHCI (via stack ghci).
+generateBuildInfoOpts :: BioInput -> BuildInfoOpts
+generateBuildInfoOpts BioInput {..} =
+  BuildInfoOpts
+    { bioOpts = ghcOpts ++ fmap ("-optP" <>) (cppOptions biBuildInfo)
+    -- NOTE for future changes: Due to this use of nubOrd (and other uses
+    -- downstream), these generated options must not rely on multiple
+    -- argument sequences.  For example, ["--main-is", "Foo.hs", "--main-
+    -- is", "Bar.hs"] would potentially break due to the duplicate
+    -- "--main-is" being removed.
+    --
+    -- See https://github.com/commercialhaskell/stack/issues/1255
+    , bioOneWordOpts = nubOrd $ concat
+        [extOpts, srcOpts, includeOpts, libOpts, fworks, cObjectFiles]
+    , bioPackageFlags = deps
+    , bioCabalMacros = componentAutogen </> relFileCabalMacrosH
+    }
+ where
+  cObjectFiles =
+    mapMaybe (fmap toFilePath .
+              makeObjectFilePathFromC biCabalDir biComponentName biDistDir)
+             cfiles
+  cfiles = mapMaybe dotCabalCFilePath biDotCabalPaths
+  installVersion = snd
+  -- Generates: -package=base -package=base16-bytestring-0.1.1.6 ...
+  deps =
+    concat
+      [ case M.lookup name biInstalledMap of
+          Just (_, Stack.Types.Package.Library _ident ipid _) ->
+            ["-package-id=" <> ghcPkgIdString ipid]
+          _ -> ["-package=" <> packageNameString name <>
+            maybe "" -- This empty case applies to e.g. base.
+              ((("-" <>) . versionString) . installVersion)
+              (M.lookup name biInstallMap)]
+      | name <- pkgs
+      ]
+  pkgs =
+    biAddPackages ++
+    [ name
+    | Dependency name _ _ <- targetBuildDepends biBuildInfo
+      -- TODO: cabal 3 introduced multiple public libraries in a single dependency
+    , name `notElem` biOmitPackages
+    ]
+  PerCompilerFlavor ghcOpts _ = options biBuildInfo
+  extOpts =
+       map (("-X" ++) . display) (allLanguages biBuildInfo)
+    <> map (("-X" ++) . display) (usedExtensions biBuildInfo)
+  srcOpts =
+    map (("-i" <>) . toFilePathNoTrailingSep)
+      (concat
+        [ [ componentBuildDir biCabalVersion biComponentName biDistDir ]
+        , [ biCabalDir
+          | null (hsSourceDirs biBuildInfo)
+          ]
+        , mapMaybe (toIncludeDir . getSymbolicPath) (hsSourceDirs biBuildInfo)
+        , [ componentAutogen ]
+        , maybeToList (packageAutogenDir biCabalVersion biDistDir)
+        , [ componentOutputDir biComponentName biDistDir ]
+        ]) ++
+    [ "-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir) ]
+  componentAutogen = componentAutogenDir biCabalVersion biComponentName biDistDir
+  toIncludeDir "." = Just biCabalDir
+  toIncludeDir relDir = concatAndCollapseAbsDir biCabalDir relDir
+  includeOpts =
+    map ("-I" <>) (biConfigIncludeDirs <> pkgIncludeOpts)
+  pkgIncludeOpts =
+    [ toFilePathNoTrailingSep absDir
+    | dir <- includeDirs biBuildInfo
+    , absDir <- handleDir dir
+    ]
+  libOpts =
+    map ("-l" <>) (extraLibs biBuildInfo) <>
+    map ("-L" <>) (biConfigLibDirs <> pkgLibDirs)
+  pkgLibDirs =
+    [ toFilePathNoTrailingSep absDir
+    | dir <- extraLibDirs biBuildInfo
+    , absDir <- handleDir dir
+    ]
+  handleDir dir = case (parseAbsDir dir, parseRelDir dir) of
+    (Just ab, _       ) -> [ab]
+    (_      , Just rel) -> [biCabalDir </> rel]
+    (Nothing, Nothing ) -> []
+  fworks = map ("-framework=" <>) (frameworks biBuildInfo)
+
+-- | Make the .o path from the .c file path for a component. Example:
+--
+-- @
+-- executable FOO
+--   c-sources:        cbits/text_search.c
+-- @
+--
+-- Produces
+--
+-- <dist-dir>/build/FOO/FOO-tmp/cbits/text_search.o
+--
+-- Example:
+--
+-- λ> makeObjectFilePathFromC
+--     $(mkAbsDir "/Users/chris/Repos/hoogle")
+--     CLib
+--     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")
+--     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")
+-- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/cbits/text_search.o"
+-- λ> makeObjectFilePathFromC
+--     $(mkAbsDir "/Users/chris/Repos/hoogle")
+--     (CExe "hoogle")
+--     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")
+--     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")
+-- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/hoogle/hoogle-tmp/cbits/text_search.o"
+-- λ>
+makeObjectFilePathFromC ::
+     MonadThrow m
+  => Path Abs Dir      -- ^ The cabal directory.
+  -> NamedComponent    -- ^ The name of the component.
+  -> Path Abs Dir      -- ^ Dist directory.
+  -> Path Abs File     -- ^ The path to the .c file.
+  -> m (Path Abs File) -- ^ The path to the .o file for the component.
+makeObjectFilePathFromC cabalDir namedComponent distDir cFilePath = do
+  relCFilePath <- stripProperPrefix cabalDir cFilePath
+  relOFilePath <-
+    parseRelFile (replaceExtension (toFilePath relCFilePath) "o")
+  pure (componentOutputDir namedComponent distDir </> relOFilePath)
+
+-- | Get all dependencies of the package (buildable targets only).
+--
+-- Note that for Cabal versions 1.22 and earlier, there is a bug where Cabal
+-- requires dependencies for non-buildable components to be present. We're going
+-- to use GHC version as a proxy for Cabal library version in this case for
+-- simplicity, so we'll check for GHC being 7.10 or earlier. This obviously
+-- makes our function a lot more fun to write...
+packageDependencies ::
+     PackageConfig
+  -> PackageDescription
+  -> Map PackageName VersionRange
+packageDependencies pkgConfig pkg' =
+  M.fromListWith intersectVersionRanges $
+  map (depPkgName &&& depVerRange) $
+  concatMap targetBuildDepends (allBuildInfo' pkg) ++
+  maybe [] setupDepends (setupBuildInfo pkg)
+ where
+  pkg
+    | getGhcVersion (packageConfigCompilerVersion pkgConfig) >= mkVersion [8, 0] = pkg'
+    -- Set all components to buildable. Only need to worry  library, exe, test,
+    -- and bench, since others didn't exist in older Cabal versions
+    | otherwise = pkg'
+      { library =
+          (\c -> c { libBuildInfo = go (libBuildInfo c) }) <$> library pkg'
+      , executables =
+          (\c -> c { buildInfo = go (buildInfo c) }) <$> executables pkg'
+      , testSuites =
+          if packageConfigEnableTests pkgConfig
+            then (\c -> c { testBuildInfo = go (testBuildInfo c) }) <$>
+                   testSuites pkg'
+            else testSuites pkg'
+      , benchmarks =
+          if packageConfigEnableBenchmarks pkgConfig
+            then (\c -> c { benchmarkBuildInfo = go (benchmarkBuildInfo c) }) <$>
+                   benchmarks pkg'
+            else benchmarks pkg'
+      }
+
+  go bi = bi { buildable = True }
+
+-- | Get all dependencies of the package (buildable targets only).
+--
+-- This uses both the new 'buildToolDepends' and old 'buildTools' information.
+packageDescTools ::
+     PackageDescription
+  -> (Set ExeName, Map PackageName DepValue)
+packageDescTools pd =
+  (S.fromList $ concat unknowns, M.fromListWith (<>) $ concat knowns)
+ where
+  (unknowns, knowns) = unzip $ map perBI $ allBuildInfo' pd
+
+  perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
+  perBI bi =
+    (unknownTools, tools)
+   where
+    (unknownTools, knownTools) = partitionEithers $ map go1 (buildTools bi)
+
+    tools = mapMaybe go2 (knownTools ++ buildToolDepends bi)
+
+    -- This is similar to desugarBuildTool from Cabal, however it
+    -- uses our own hard-coded map which drops tools shipped with
+    -- GHC (like hsc2hs), and includes some tools from Stackage.
+    go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency
+    go1 (Cabal.LegacyExeDependency name range) =
+      case M.lookup name hardCodedMap of
+        Just pkgName ->
+          Right $
+            Cabal.ExeDependency pkgName (Cabal.mkUnqualComponentName name) range
+        Nothing -> Left $ ExeName $ T.pack name
+
+    go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue)
+    go2 (Cabal.ExeDependency pkg _name range)
+      | pkg `S.member` preInstalledPackages = Nothing
+      | otherwise = Just
+          ( pkg
+          , DepValue
+              { dvVersionRange = range
+              , dvType = AsBuildTool
+              }
+          )
+
+-- | A hard-coded map for tool dependencies
+hardCodedMap :: Map String PackageName
+hardCodedMap = M.fromList
+  [ ("alex", Distribution.Package.mkPackageName "alex")
+  , ("happy", Distribution.Package.mkPackageName "happy")
+  , ("cpphs", Distribution.Package.mkPackageName "cpphs")
+  , ("greencard", Distribution.Package.mkPackageName "greencard")
+  , ("c2hs", Distribution.Package.mkPackageName "c2hs")
+  , ("hscolour", Distribution.Package.mkPackageName "hscolour")
+  , ("hspec-discover", Distribution.Package.mkPackageName "hspec-discover")
+  , ("hsx2hs", Distribution.Package.mkPackageName "hsx2hs")
+  , ("gtk2hsC2hs", Distribution.Package.mkPackageName "gtk2hs-buildtools")
+  , ("gtk2hsHookGenerator", Distribution.Package.mkPackageName "gtk2hs-buildtools")
+  , ("gtk2hsTypeGen", Distribution.Package.mkPackageName "gtk2hs-buildtools")
+  ]
+
+-- | Executable-only packages which come pre-installed with GHC and do not need
+-- to be built. Without this exception, we would either end up unnecessarily
+-- rebuilding these packages, or failing because the packages do not appear in
+-- the Stackage snapshot.
+preInstalledPackages :: Set PackageName
+preInstalledPackages = S.fromList
+  [ mkPackageName "hsc2hs"
+  , mkPackageName "haddock"
+  ]
+
+-- | Variant of 'allBuildInfo' from Cabal that, like versions before Cabal 2.2
+-- only includes buildable components.
+allBuildInfo' :: PackageDescription -> [BuildInfo]
+allBuildInfo' pkg_descr = [ bi | lib <- allLibraries pkg_descr
+                               , let bi = libBuildInfo lib
+                               , buildable bi ]
+                       ++ [ bi | flib <- foreignLibs pkg_descr
+                               , let bi = foreignLibBuildInfo flib
+                               , buildable bi ]
+                       ++ [ bi | exe <- executables pkg_descr
+                               , let bi = buildInfo exe
+                               , buildable bi ]
+                       ++ [ bi | tst <- testSuites pkg_descr
+                               , let bi = testBuildInfo tst
+                               , buildable bi ]
+                       ++ [ bi | tst <- benchmarks pkg_descr
+                               , let bi = benchmarkBuildInfo tst
+                               , buildable bi ]
+
+-- | A pair of package descriptions: one which modified the buildable values of
+-- test suites and benchmarks depending on whether they are enabled, and one
+-- which does not.
+--
+-- Fields are intentionally lazy, we may only need one or the other value.
+--
+-- Michael S Snoyman 2017-08-29: The very presence of this data type is terribly
+-- ugly, it represents the fact that the Cabal 2.0 upgrade did _not_ go well.
+-- Specifically, we used to have a field to indicate whether a component was
+-- enabled in addition to buildable, but that's gone now, and this is an ugly
+-- proxy. We should at some point clean up the mess of Package, LocalPackage,
+-- etc, and probably pull in the definition of PackageDescription from Cabal
+-- with our additionally needed metadata. But this is a good enough hack for the
+-- moment. Odds are, you're reading this in the year 2024 and thinking "wtf?"
+data PackageDescriptionPair = PackageDescriptionPair
+  { pdpOrigBuildable :: PackageDescription
+  , pdpModifiedBuildable :: PackageDescription
+  }
+
+-- | Evaluates the conditions of a 'GenericPackageDescription', yielding
+-- a resolved 'PackageDescription'.
+resolvePackageDescription ::
+     PackageConfig
+  -> GenericPackageDescription
+  -> PackageDescriptionPair
+resolvePackageDescription
+  packageConfig
+  ( GenericPackageDescription
+      desc _ defaultFlags mlib subLibs foreignLibs' exes tests benches
+  )
+  =
+  PackageDescriptionPair
+    { pdpOrigBuildable = go False
+    , pdpModifiedBuildable = go True
+    }
+ where
+  go modBuildable = desc
+    { library = fmap (resolveConditions rc updateLibDeps) mlib
+    , subLibraries = map
+        (\(n, v) -> (resolveConditions rc updateLibDeps v){libName=LSubLibName n})
+        subLibs
+    , foreignLibs = map
+        (\(n, v) -> (resolveConditions rc updateForeignLibDeps v){foreignLibName=n})
+        foreignLibs'
+    , executables = map
+        (\(n, v) -> (resolveConditions rc updateExeDeps v){exeName=n})
+        exes
+    , testSuites = map
+        (\(n, v) -> (resolveConditions rc (updateTestDeps modBuildable) v){testName=n})
+        tests
+    , benchmarks = map
+        (\(n, v) -> (resolveConditions rc (updateBenchmarkDeps modBuildable) v){benchmarkName=n})
+        benches
+    }
+
+  flags = M.union (packageConfigFlags packageConfig) (flagMap defaultFlags)
+
+  rc = mkResolveConditions
+         (packageConfigCompilerVersion packageConfig)
+         (packageConfigPlatform packageConfig)
+         flags
+
+  updateLibDeps lib deps = lib
+    { libBuildInfo = (libBuildInfo lib) {targetBuildDepends = deps} }
+  updateForeignLibDeps lib deps = lib
+    { foreignLibBuildInfo =
+        (foreignLibBuildInfo lib) {targetBuildDepends = deps}
+    }
+  updateExeDeps exe deps = exe
+    { buildInfo = (buildInfo exe) {targetBuildDepends = deps} }
+
+  -- Note that, prior to moving to Cabal 2.0, we would set testEnabled or
+  -- benchmarkEnabled here. These fields no longer exist, so we modify buildable
+  -- instead here. The only wrinkle in the Cabal 2.0 story is
+  -- https://github.com/haskell/cabal/issues/1725, where older versions of Cabal
+  -- (which may be used for actually building code) don't properly exclude
+  -- build-depends for non-buildable components. Testing indicates that
+  -- everything is working fine, and that this comment can be completely
+  -- ignored. I'm leaving the comment anyway in case something breaks and you,
+  -- poor reader, are investigating.
+  updateTestDeps modBuildable test deps =
+    let bi = testBuildInfo test
+        bi' = bi
+          { targetBuildDepends = deps
+          , buildable =
+                 buildable bi
+              && (  not modBuildable
+                 || packageConfigEnableTests packageConfig
+                 )
+          }
+    in  test { testBuildInfo = bi' }
+  updateBenchmarkDeps modBuildable benchmark deps =
+    let bi = benchmarkBuildInfo benchmark
+        bi' = bi
+          { targetBuildDepends = deps
+          , buildable =
+                 buildable bi
+              && (  not modBuildable
+                 || packageConfigEnableBenchmarks packageConfig
+                 )
+          }
+    in  benchmark { benchmarkBuildInfo = bi' }
+
+-- | Make a map from a list of flag specifications.
+--
+-- What is @flagManual@ for?
+flagMap :: [PackageFlag] -> Map FlagName Bool
+flagMap = M.fromList . map pair
+ where
+  pair :: PackageFlag -> (FlagName, Bool)
+  pair = flagName &&& flagDefault
+
+data ResolveConditions = ResolveConditions
+  { rcFlags :: Map FlagName Bool
+  , rcCompilerVersion :: ActualCompiler
+  , rcOS :: OS
+  , rcArch :: Arch
+  }
+
+-- | Generic a @ResolveConditions@ using sensible defaults.
+mkResolveConditions ::
+     ActualCompiler -- ^ Compiler version
+  -> Platform -- ^ installation target platform
+  -> Map FlagName Bool -- ^ enabled flags
+  -> ResolveConditions
+mkResolveConditions compilerVersion (Platform arch os) flags = ResolveConditions
+  { rcFlags = flags
+  , rcCompilerVersion = compilerVersion
+  , rcOS = os
+  , rcArch = arch
+  }
+
+-- | Resolve the condition tree for the library.
+resolveConditions ::
+     (Semigroup target, Monoid target, Show target)
+  => ResolveConditions
+  -> (target -> cs -> target)
+  -> CondTree ConfVar cs target
+  -> target
+resolveConditions rc addDeps (CondNode lib deps cs) = basic <> children
+ where
+  basic = addDeps lib deps
+  children = mconcat (map apply cs)
+   where
+    apply (Cabal.CondBranch cond node mcs) =
+      if condSatisfied cond
+         then resolveConditions rc addDeps node
+         else maybe mempty (resolveConditions rc addDeps) mcs
+    condSatisfied c =
+      case c of
+        Var v -> varSatisfied v
+        Lit b -> b
+        CNot c' -> not (condSatisfied c')
+        COr cx cy -> condSatisfied cx || condSatisfied cy
+        CAnd cx cy -> condSatisfied cx && condSatisfied cy
+    varSatisfied v =
+      case v of
+        OS os -> os == rcOS rc
+        Arch arch -> arch == rcArch rc
+        PackageFlag flag -> fromMaybe False $ M.lookup flag (rcFlags rc)
+        -- NOTE:  ^^^^^ This should never happen, as all flags which are used
+        -- must be declared. Defaulting to False.
+        Impl flavor range ->
+          case (flavor, rcCompilerVersion rc) of
+            (GHC, ACGhc vghc) -> vghc `withinRange` range
+            _ -> False
+
+-- | Path for the package's build log.
+buildLogPath ::
+     (MonadReader env m, HasBuildConfig env, MonadThrow m)
+  => Package
+  -> Maybe String
+  -> m (Path Abs File)
+buildLogPath package' msuffix = do
+  env <- ask
+  let stack = getProjectWorkDir env
+  fp <- parseRelFile $ concat $
+    packageIdentifierString (packageIdentifier package') :
+    maybe id (\suffix -> ("-" :) . (suffix :)) msuffix [".log"]
+  pure $ stack </> relDirLogs </> fp
+
+    {- FIXME
+-- | Create a 'ProjectPackage' from a directory containing a package.
+mkProjectPackage
+  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
+  => PrintWarnings
+  -> ResolvedPath Dir
+  -> RIO env ProjectPackage
+mkProjectPackage printWarnings dir = do
+  (gpd, name, cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
+  pure ProjectPackage
+    { ppCabalFP = cabalfp
+    , ppGPD' = gpd printWarnings
+    , ppResolvedDir = dir
+    , ppName = name
+    }
+
+-- | Create a 'DepPackage' from a 'PackageLocation'
+mkDepPackage
+  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
+  => PackageLocation
+  -> RIO env DepPackage
+mkDepPackage pl = do
+  (name, gpdio) <-
+    case pl of
+      PLMutable dir -> do
+        (gpdio, name, _cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
+        pure (name, gpdio NoPrintWarnings)
+      PLImmutable pli -> do
+        PackageIdentifier name _ <- getPackageLocationIdent pli
+        run <- askRunInIO
+        pure (name, run $ loadCabalFileImmutable pli)
+  pure DepPackage
+    { dpGPD' = gpdio
+    , dpLocation = pl
+    , dpName = name
+    }
+
+    -}
+
+-- | Force a package to be treated as a custom build type, see
+-- <https://github.com/commercialhaskell/stack/issues/4488>
+applyForceCustomBuild ::
+     Version -- ^ global Cabal version
+  -> Package
+  -> Package
+applyForceCustomBuild cabalVersion package
+  | forceCustomBuild =
+      package
+        { packageBuildType = Custom
+        , packageDeps =
+            M.insertWith (<>) "Cabal" (DepValue cabalVersionRange AsLibrary) $
+              packageDeps package
+        , packageSetupDeps = Just $ M.fromList
+            [ ("Cabal", cabalVersionRange)
+            , ("base", anyVersion)
+            ]
+        }
+  | otherwise = package
+ where
+  cabalVersionRange =
+    orLaterVersion $ mkVersion $ cabalSpecToVersionDigits $
+      packageCabalSpec package
+  forceCustomBuild =
+       packageBuildType package == Simple
+    && not (cabalVersion `withinRange` cabalVersionRange)
src/Stack/PackageDump.hs view
@@ -1,9 +1,5 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE RankNTypes         #-}
 {-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE TupleSections      #-}
 
 module Stack.PackageDump
   ( Line
@@ -17,131 +13,134 @@   , pruneDeps
   ) where
 
-import           Data.Attoparsec.Args
+import           Data.Attoparsec.Args ( EscapingMode (..), argsParser )
 import           Data.Attoparsec.Text as P
-import           Data.Conduit
+import           Data.Conduit ( await, leftover, toConsumer, yield )
 import qualified Data.Conduit.List as CL
 import qualified Data.Conduit.Text as CT
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Distribution.Text as C
 import           Path.Extra ( toFilePathNoTrailingSep )
-import           RIO.Process hiding ( readProcess )
+import           RIO.Process ( HasProcessContext )
 import qualified RIO.Text as T
-import           Stack.GhcPkg
+import           Stack.GhcPkg ( createDatabase )
 import           Stack.Prelude
-import           Stack.Types.Config
-                   ( HasCompiler (..), GhcPkgExe (..), DumpPackage (..) )
-import           Stack.Types.GhcPkgId
+import           Stack.Types.CompilerPaths ( GhcPkgExe (..), HasCompiler (..) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId, parseGhcPkgId )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.PackageDump" module.
 data PackageDumpException
-    = MissingSingleField Text (Map Text [Line])
-    | Couldn'tParseField Text [Line]
-    deriving (Show, Typeable)
+  = MissingSingleField Text (Map Text [Line])
+  | Couldn'tParseField Text [Line]
+  deriving (Show, Typeable)
 
 instance Exception PackageDumpException where
-    displayException (MissingSingleField name values) = unlines $
-        concat
-            [ "Error: [S-4257]\n"
-            , "Expected single value for field name "
-            , show name
-            , " when parsing ghc-pkg dump output:"
-            ]
-        : map (\(k, v) -> "    " ++ show (k, v)) (Map.toList values)
-    displayException (Couldn'tParseField name ls) = concat
-        [ "Error: [S-2016]\n"
-        , "Couldn't parse the field "
-        , show name
-        , " from lines: "
-        , show ls
-        , "."
-        ]
+  displayException (MissingSingleField name values) = unlines $
+    concat
+      [ "Error: [S-4257]\n"
+      , "Expected single value for field name "
+      , show name
+      , " when parsing ghc-pkg dump output:"
+      ]
+    : map (\(k, v) -> "    " ++ show (k, v)) (Map.toList values)
+  displayException (Couldn'tParseField name ls) = concat
+    [ "Error: [S-2016]\n"
+    , "Couldn't parse the field "
+    , show name
+    , " from lines: "
+    , show ls
+    , "."
+    ]
 
--- | Call ghc-pkg dump with appropriate flags and stream to the given @Sink@, for a single database
-ghcPkgDump
-    :: (HasProcessContext env, HasLogFunc env)
-    => GhcPkgExe
-    -> [Path Abs Dir] -- ^ if empty, use global
-    -> ConduitM Text Void (RIO env) a
-    -> RIO env a
+-- | Call ghc-pkg dump with appropriate flags and stream to the given @Sink@,
+-- for a single database
+ghcPkgDump ::
+     (HasProcessContext env, HasTerm env)
+  => GhcPkgExe
+  -> [Path Abs Dir] -- ^ if empty, use global
+  -> ConduitM Text Void (RIO env) a
+  -> RIO env a
 ghcPkgDump pkgexe = ghcPkgCmdArgs pkgexe ["dump"]
 
--- | Call ghc-pkg describe with appropriate flags and stream to the given @Sink@, for a single database
-ghcPkgDescribe
-    :: (HasProcessContext env, HasLogFunc env, HasCompiler env)
-    => GhcPkgExe
-    -> PackageName
-    -> [Path Abs Dir] -- ^ if empty, use global
-    -> ConduitM Text Void (RIO env) a
-    -> RIO env a
-ghcPkgDescribe pkgexe pkgName' = ghcPkgCmdArgs pkgexe ["describe", "--simple-output", packageNameString pkgName']
+-- | Call ghc-pkg describe with appropriate flags and stream to the given
+-- @Sink@, for a single database
+ghcPkgDescribe ::
+     (HasCompiler env, HasProcessContext env, HasTerm env)
+  => GhcPkgExe
+  -> PackageName
+  -> [Path Abs Dir] -- ^ if empty, use global
+  -> ConduitM Text Void (RIO env) a
+  -> RIO env a
+ghcPkgDescribe pkgexe pkgName' = ghcPkgCmdArgs
+  pkgexe ["describe", "--simple-output", packageNameString pkgName']
 
 -- | Call ghc-pkg and stream to the given @Sink@, for a single database
-ghcPkgCmdArgs
-    :: (HasProcessContext env, HasLogFunc env)
-    => GhcPkgExe
-    -> [String]
-    -> [Path Abs Dir] -- ^ if empty, use global
-    -> ConduitM Text Void (RIO env) a
-    -> RIO env a
+ghcPkgCmdArgs ::
+     (HasProcessContext env, HasTerm env)
+  => GhcPkgExe
+  -> [String]
+  -> [Path Abs Dir] -- ^ if empty, use global
+  -> ConduitM Text Void (RIO env) a
+  -> RIO env a
 ghcPkgCmdArgs pkgexe@(GhcPkgExe pkgPath) cmd mpkgDbs sink = do
-    case reverse mpkgDbs of
-        (pkgDb:_) -> createDatabase pkgexe pkgDb -- TODO maybe use some retry logic instead?
-        _ -> pure ()
-    -- https://github.com/haskell/process/issues/251
-    snd <$> sinkProcessStderrStdout (toFilePath pkgPath) args CL.sinkNull sink'
-  where
-    args = concat
-        [ case mpkgDbs of
-              [] -> ["--global", "--no-user-package-db"]
-              _ -> ["--user", "--no-user-package-db"] ++
-                  concatMap (\pkgDb -> ["--package-db", toFilePathNoTrailingSep pkgDb]) mpkgDbs
-        , cmd
-        , ["--expand-pkgroot"]
-        ]
-    sink' = CT.decodeUtf8 .| sink
+  case reverse mpkgDbs of
+      (pkgDb:_) -> createDatabase pkgexe pkgDb -- TODO maybe use some retry logic instead?
+      _ -> pure ()
+  -- https://github.com/haskell/process/issues/251
+  snd <$> sinkProcessStderrStdout (toFilePath pkgPath) args CL.sinkNull sink'
+ where
+  args = concat
+    [ case mpkgDbs of
+          [] -> ["--global", "--no-user-package-db"]
+          _ -> ["--user", "--no-user-package-db"] ++
+              concatMap (\pkgDb -> ["--package-db", toFilePathNoTrailingSep pkgDb]) mpkgDbs
+    , cmd
+    , ["--expand-pkgroot"]
+    ]
+  sink' = CT.decodeUtf8 .| sink
 
 -- | Prune a list of possible packages down to those whose dependencies are met.
 --
 -- * id uniquely identifies an item
 --
 -- * There can be multiple items per name
-pruneDeps
-    :: (Ord name, Ord id)
-    => (id -> name) -- ^ extract the name from an id
-    -> (item -> id) -- ^ the id of an item
-    -> (item -> [id]) -- ^ get the dependencies of an item
-    -> (item -> item -> item) -- ^ choose the desired of two possible items
-    -> [item] -- ^ input items
-    -> Map name item
+pruneDeps ::
+     (Ord name, Ord id)
+  => (id -> name) -- ^ extract the name from an id
+  -> (item -> id) -- ^ the id of an item
+  -> (item -> [id]) -- ^ get the dependencies of an item
+  -> (item -> item -> item) -- ^ choose the desired of two possible items
+  -> [item] -- ^ input items
+  -> Map name item
 pruneDeps getName getId getDepends chooseBest =
-      Map.fromList
-    . fmap (getName . getId &&& id)
-    . loop Set.empty Set.empty []
-  where
-    loop foundIds usedNames foundItems dps =
-        case partitionEithers $ map depsMet dps of
-            ([], _) -> foundItems
-            (s', dps') ->
-                let foundIds' = Map.fromListWith chooseBest s'
-                    foundIds'' = Set.fromList $ map getId $ Map.elems foundIds'
-                    usedNames' = Map.keysSet foundIds'
-                    foundItems' = Map.elems foundIds'
-                 in loop
-                        (Set.union foundIds foundIds'')
-                        (Set.union usedNames usedNames')
-                        (foundItems ++ foundItems')
-                        (catMaybes dps')
-      where
-        depsMet dp
-            | name `Set.member` usedNames = Right Nothing
-            | all (`Set.member` foundIds) (getDepends dp) = Left (name, dp)
-            | otherwise = Right $ Just dp
-          where
-            id' = getId dp
-            name = getName id'
+    Map.fromList
+  . fmap (getName . getId &&& id)
+  . loop Set.empty Set.empty []
+ where
+  loop foundIds usedNames foundItems dps =
+    case partitionEithers $ map depsMet dps of
+      ([], _) -> foundItems
+      (s', dps') ->
+        let foundIds' = Map.fromListWith chooseBest s'
+            foundIds'' = Set.fromList $ map getId $ Map.elems foundIds'
+            usedNames' = Map.keysSet foundIds'
+            foundItems' = Map.elems foundIds'
+        in  loop
+              (Set.union foundIds foundIds'')
+              (Set.union usedNames usedNames')
+              (foundItems ++ foundItems')
+              (catMaybes dps')
+   where
+    depsMet dp
+      | name `Set.member` usedNames = Right Nothing
+      | all (`Set.member` foundIds) (getDepends dp) = Left (name, dp)
+      | otherwise = Right $ Just dp
+     where
+      id' = getId dp
+      name = getName id'
 
 -- | Find the package IDs matching the given constraints with all dependencies installed.
 -- Packages not mentioned in the provided @Map@ are allowed to be present too.
@@ -149,113 +148,112 @@              => Map PackageName Version -- ^ allowed versions
              -> ConduitM DumpPackage o m (Map PackageName DumpPackage)
 sinkMatching allowed =
-      Map.fromList
-    . map (pkgName . dpPackageIdent &&& id)
-    . Map.elems
-    . pruneDeps
-        id
-        dpGhcPkgId
-        dpDepends
-        const -- Could consider a better comparison in the future
-    <$> (CL.filter (isAllowed . dpPackageIdent) .| CL.consume)
-  where
-    isAllowed (PackageIdentifier name version) =
-        case Map.lookup name allowed of
-            Just version' | version /= version' -> False
-            _ -> True
+    Map.fromList
+  . map (pkgName . dpPackageIdent &&& id)
+  . Map.elems
+  . pruneDeps
+      id
+      dpGhcPkgId
+      dpDepends
+      const -- Could consider a better comparison in the future
+  <$> (CL.filter (isAllowed . dpPackageIdent) .| CL.consume)
+ where
+  isAllowed (PackageIdentifier name version) =
+    case Map.lookup name allowed of
+      Just version' | version /= version' -> False
+      _ -> True
 
 -- | Convert a stream of bytes into a stream of @DumpPackage@s
 conduitDumpPackage :: MonadThrow m
                    => ConduitM Text DumpPackage m ()
 conduitDumpPackage = (.| CL.catMaybes) $ eachSection $ do
-    pairs <- eachPair (\k -> (k, ) <$> CL.consume) .| CL.consume
-    let m = Map.fromList pairs
-    let parseS k =
-            case Map.lookup k m of
-                Just [v] -> pure v
-                _ -> throwM $ MissingSingleField k m
-        -- Can't fail: if not found, same as an empty list. See:
-        -- https://github.com/commercialhaskell/stack/issues/182
-        parseM k = Map.findWithDefault [] k m
+  pairs <- eachPair (\k -> (k, ) <$> CL.consume) .| CL.consume
+  let m = Map.fromList pairs
+  let parseS k =
+        case Map.lookup k m of
+          Just [v] -> pure v
+          _ -> throwM $ MissingSingleField k m
+      -- Can't fail: if not found, same as an empty list. See:
+      -- https://github.com/commercialhaskell/stack/issues/182
+      parseM k = Map.findWithDefault [] k m
 
-        parseDepend :: MonadThrow m => Text -> m (Maybe GhcPkgId)
-        parseDepend "builtin_rts" = pure Nothing
-        parseDepend bs =
-            liftM Just $ parseGhcPkgId bs'
-          where
-            (bs', _builtinRts) =
-                case stripSuffixText " builtin_rts" bs of
-                    Nothing ->
-                        case stripPrefixText "builtin_rts " bs of
-                            Nothing -> (bs, False)
-                            Just x -> (x, True)
-                    Just x -> (x, True)
-    case Map.lookup "id" m of
-        Just ["builtin_rts"] -> pure Nothing
-        _ -> do
-            name <- parseS "name" >>= parsePackageNameThrowing . T.unpack
-            version <- parseS "version" >>= parseVersionThrowing . T.unpack
-            ghcPkgId <- parseS "id" >>= parseGhcPkgId
+      parseDepend :: MonadThrow m => Text -> m (Maybe GhcPkgId)
+      parseDepend "builtin_rts" = pure Nothing
+      parseDepend bs = Just <$> parseGhcPkgId bs'
+       where
+        (bs', _builtinRts) =
+          case stripSuffixText " builtin_rts" bs of
+            Nothing ->
+              case stripPrefixText "builtin_rts " bs of
+                Nothing -> (bs, False)
+                Just x -> (x, True)
+            Just x -> (x, True)
+  case Map.lookup "id" m of
+    Just ["builtin_rts"] -> pure Nothing
+    _ -> do
+      name <- parseS "name" >>= parsePackageNameThrowing . T.unpack
+      version <- parseS "version" >>= parseVersionThrowing . T.unpack
+      ghcPkgId <- parseS "id" >>= parseGhcPkgId
 
-            -- if a package has no modules, these won't exist
-            let libDirKey = "library-dirs"
-                libraries = parseM "hs-libraries"
-                exposedModules = parseM "exposed-modules"
-                exposed = parseM "exposed"
-                license =
-                    case parseM "license" of
-                        [licenseText] -> C.simpleParse (T.unpack licenseText)
-                        _ -> Nothing
-            depends <- mapMaybeM parseDepend $ concatMap T.words $ parseM "depends"
+      -- if a package has no modules, these won't exist
+      let libDirKey = "library-dirs"
+          libraries = parseM "hs-libraries"
+          exposedModules = parseM "exposed-modules"
+          exposed = parseM "exposed"
+          license =
+            case parseM "license" of
+              [licenseText] -> C.simpleParse (T.unpack licenseText)
+              _ -> Nothing
+      depends <- mapMaybeM parseDepend $ concatMap T.words $ parseM "depends"
 
-            -- Handle sublibs by recording the name of the parent library
-            -- If name of parent library is missing, this is not a sublib.
-            let mkParentLib n = PackageIdentifier n version
-                parentLib = mkParentLib <$> (parseS "package-name" >>=
-                                             parsePackageNameThrowing . T.unpack)
+      -- Handle sublibs by recording the name of the parent library
+      -- If name of parent library is missing, this is not a sublib.
+      let mkParentLib n = PackageIdentifier n version
+          parentLib = mkParentLib <$> (parseS "package-name" >>=
+                                       parsePackageNameThrowing . T.unpack)
 
-            let parseQuoted key =
-                    case mapM (P.parseOnly (argsParser NoEscaping)) val of
-                        Left{} -> throwM (Couldn'tParseField key val)
-                        Right dirs -> pure (concat dirs)
-                  where
-                    val = parseM key
-            libDirPaths <- parseQuoted libDirKey
-            haddockInterfaces <- parseQuoted "haddock-interfaces"
-            haddockHtml <- parseQuoted "haddock-html"
+      let parseQuoted key =
+            case mapM (P.parseOnly (argsParser NoEscaping)) val of
+              Left{} -> throwM (Couldn'tParseField key val)
+              Right dirs -> pure (concat dirs)
+           where
+            val = parseM key
+      libDirPaths <- parseQuoted libDirKey
+      haddockInterfaces <- parseQuoted "haddock-interfaces"
+      haddockHtml <- parseQuoted "haddock-html"
 
-            pure $ Just DumpPackage
-                { dpGhcPkgId = ghcPkgId
-                , dpPackageIdent = PackageIdentifier name version
-                , dpParentLibIdent = parentLib
-                , dpLicense = license
-                , dpLibDirs = libDirPaths
-                , dpLibraries = T.words $ T.unwords libraries
-                , dpHasExposedModules = not (null libraries || null exposedModules)
+      pure $ Just DumpPackage
+        { dpGhcPkgId = ghcPkgId
+        , dpPackageIdent = PackageIdentifier name version
+        , dpParentLibIdent = parentLib
+        , dpLicense = license
+        , dpLibDirs = libDirPaths
+        , dpLibraries = T.words $ T.unwords libraries
+        , dpHasExposedModules = not (null libraries || null exposedModules)
 
-                -- Strip trailing commas from ghc package exposed-modules (looks buggy to me...).
-                -- Then try to parse the module names.
-                , dpExposedModules =
-                      Set.fromList
-                    $ mapMaybe (C.simpleParse . T.unpack . T.dropSuffix ",")
-                    $ T.words
-                    $ T.unwords exposedModules
+        -- Strip trailing commas from ghc package exposed-modules (looks buggy to me...).
+        -- Then try to parse the module names.
+        , dpExposedModules =
+              Set.fromList
+            $ mapMaybe (C.simpleParse . T.unpack . T.dropSuffix ",")
+            $ T.words
+            $ T.unwords exposedModules
 
-                , dpDepends = depends
-                , dpHaddockInterfaces = haddockInterfaces
-                , dpHaddockHtml = listToMaybe haddockHtml
-                , dpIsExposed = exposed == ["True"]
-                }
+        , dpDepends = depends
+        , dpHaddockInterfaces = haddockInterfaces
+        , dpHaddockHtml = listToMaybe haddockHtml
+        , dpIsExposed = exposed == ["True"]
+        }
 
 stripPrefixText :: Text -> Text -> Maybe Text
 stripPrefixText x y
-    | x `T.isPrefixOf` y = Just $ T.drop (T.length x) y
-    | otherwise = Nothing
+  | x `T.isPrefixOf` y = Just $ T.drop (T.length x) y
+  | otherwise = Nothing
 
 stripSuffixText :: Text -> Text -> Maybe Text
 stripSuffixText x y
-    | x `T.isSuffixOf` y = Just $ T.take (T.length y - T.length x) y
-    | otherwise = Nothing
+  | x `T.isSuffixOf` y = Just $ T.take (T.length y - T.length x) y
+  | otherwise = Nothing
 
 -- | A single line of input, not including line endings
 type Line = Text
@@ -264,74 +262,68 @@ eachSection :: Monad m
             => ConduitM Line Void m a
             -> ConduitM Text a m ()
-eachSection inner =
-    CL.map (T.filter (/= '\r')) .| CT.lines .| start
-  where
-
-    peekText = await >>= maybe (pure Nothing) (\bs ->
-        if T.null bs
-            then peekText
-            else leftover bs >> pure (Just bs))
+eachSection inner = CL.map (T.filter (/= '\r')) .| CT.lines .| start
+ where
+  peekText = await >>= maybe (pure Nothing) (\bs ->
+    if T.null bs
+      then peekText
+      else leftover bs >> pure (Just bs))
 
-    start = peekText >>= maybe (pure ()) (const go)
+  start = peekText >>= maybe (pure ()) (const go)
 
-    go = do
-        x <- toConsumer $ takeWhileC (/= "---") .| inner
-        yield x
-        CL.drop 1
-        start
+  go = do
+    x <- toConsumer $ takeWhileC (/= "---") .| inner
+    yield x
+    CL.drop 1
+    start
 
 -- | Grab each key/value pair
 eachPair :: Monad m
          => (Text -> ConduitM Line Void m a)
          -> ConduitM Line a m ()
-eachPair inner =
-    start
-  where
-    start = await >>= maybe (pure ()) start'
+eachPair inner = start
+ where
+  start = await >>= maybe (pure ()) start'
 
-    start' bs1 =
-        toConsumer (valSrc .| inner key) >>= yield >> start
-      where
-        (key, bs2) = T.break (== ':') bs1
-        (spaces, bs3) = T.span (== ' ') $ T.drop 1 bs2
-        ind = T.length key + 1 + T.length spaces
+  start' bs1 = toConsumer (valSrc .| inner key) >>= yield >> start
+   where
+    (key, bs2) = T.break (== ':') bs1
+    (spaces, bs3) = T.span (== ' ') $ T.drop 1 bs2
+    ind = T.length key + 1 + T.length spaces
 
-        valSrc
-            | T.null bs3 = noIndent
-            | otherwise = yield bs3 >> loopIndent ind
+    valSrc
+      | T.null bs3 = noIndent
+      | otherwise = yield bs3 >> loopIndent ind
 
-    noIndent = do
-        mx <- await
-        case mx of
-            Nothing -> pure ()
-            Just bs -> do
-                let (spaces, val) = T.span (== ' ') bs
-                if T.length spaces == 0
-                    then leftover val
-                    else do
-                        yield val
-                        loopIndent (T.length spaces)
+  noIndent = do
+    mx <- await
+    case mx of
+      Nothing -> pure ()
+      Just bs -> do
+        let (spaces, val) = T.span (== ' ') bs
+        if T.length spaces == 0
+          then leftover val
+          else do
+            yield val
+            loopIndent (T.length spaces)
 
-    loopIndent i =
-        loop
-      where
-        loop = await >>= maybe (pure ()) go
+  loopIndent i = loop
+   where
+    loop = await >>= maybe (pure ()) go
 
-        go bs
-            | T.length spaces == i && T.all (== ' ') spaces =
-                yield val >> loop
-            | otherwise = leftover bs
-          where
-            (spaces, val) = T.splitAt i bs
+    go bs
+      | T.length spaces == i && T.all (== ' ') spaces =
+          yield val >> loop
+      | otherwise = leftover bs
+     where
+      (spaces, val) = T.splitAt i bs
 
 -- | General purpose utility
 takeWhileC :: Monad m => (a -> Bool) -> ConduitM a a m ()
-takeWhileC f =
-    loop
-  where
-    loop = await >>= maybe (pure ()) go
+takeWhileC f = loop
+ where
+  loop = await >>= maybe (pure ()) go
 
-    go x
-        | f x = yield x >> loop
-        | otherwise = leftover x
+  go x
+    | f x = yield x >> loop
+    | otherwise = leftover x
src/Stack/PackageFile.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
 
 -- | A module which exports all package-level file-gathering logic.
 module Stack.PackageFile
-  ( packageDescModulesAndFiles
+  ( getPackageFile
+  , packageDescModulesAndFiles
   ) where
 
 import qualified Data.Map.Strict as M
@@ -15,12 +15,22 @@ import           Distribution.PackageDescription hiding ( FlagName )
 import           Distribution.Simple.Glob ( matchDirFileGlob )
 import qualified Distribution.Types.UnqualComponentName as Cabal
-import           Path as FL hiding ( replaceExtension )
-import           Path.Extra
-import           Path.IO hiding ( findFiles )
+import           Path ( parent, (</>) )
+import           Path.Extra ( forgivingResolveFile, rejectMissingFile )
+import           Path.IO ( doesFileExist )
 import           Stack.ComponentFile
-import           Stack.Prelude hiding ( Display (..) )
-import           Stack.Types.NamedComponent
+                   ( benchmarkFiles, executableFiles, libraryFiles
+                   , resolveOrWarn, testFiles
+                   )
+import           Stack.Constants
+                   ( relFileHpackPackageConfig, relFileSetupHs, relFileSetupLhs
+                   )
+import           Stack.Constants.Config ( distDirFromDir )
+import           Stack.Prelude
+import           Stack.Types.BuildConfig ( HasBuildConfig (..) )
+import           Stack.Types.CompilerPaths ( cabalVersionL )
+import           Stack.Types.EnvConfig ( HasEnvConfig )
+import           Stack.Types.NamedComponent ( NamedComponent (..) )
 import           Stack.Types.PackageFile
                    ( DotCabalPath (..), GetPackageFileContext (..)
                    , PackageWarning (..)
@@ -34,18 +44,18 @@                   -> RIO GetPackageFileContext (Maybe (Path Abs File))
 resolveFileOrWarn = resolveOrWarn "File" f
  where
-  f p x = liftIO (forgivingAbsence (resolveFile p x)) >>= rejectMissingFile
+  f p x = forgivingResolveFile p x >>= rejectMissingFile
 
 -- | Get all files referenced by the package.
-packageDescModulesAndFiles
-    :: PackageDescription
-    -> RIO
-         GetPackageFileContext
-         ( Map NamedComponent (Map ModuleName (Path Abs File))
-         , Map NamedComponent [DotCabalPath]
-         , Set (Path Abs File)
-         , [PackageWarning]
-         )
+packageDescModulesAndFiles ::
+     PackageDescription
+  -> RIO
+       GetPackageFileContext
+       ( Map NamedComponent (Map ModuleName (Path Abs File))
+       , Map NamedComponent [DotCabalPath]
+       , Set (Path Abs File)
+       , [PackageWarning]
+       )
 packageDescModulesAndFiles pkg = do
   (libraryMods, libDotCabalFiles, libWarnings) <-
     maybe
@@ -53,25 +63,25 @@       (asModuleAndFileMap libComponent libraryFiles)
       (library pkg)
   (subLibrariesMods, subLibDotCabalFiles, subLibWarnings) <-
-    liftM
+    fmap
       foldTuples
       ( mapM
           (asModuleAndFileMap internalLibComponent libraryFiles)
           (subLibraries pkg)
       )
   (executableMods, exeDotCabalFiles, exeWarnings) <-
-    liftM
+    fmap
       foldTuples
       ( mapM
           (asModuleAndFileMap exeComponent executableFiles)
           (executables pkg)
       )
   (testMods, testDotCabalFiles, testWarnings) <-
-    liftM
+    fmap
       foldTuples
       (mapM (asModuleAndFileMap testComponent testFiles) (testSuites pkg))
   (benchModules, benchDotCabalPaths, benchWarnings) <-
-    liftM
+    fmap
       foldTuples
       ( mapM
           (asModuleAndFileMap benchComponent benchmarkFiles)
@@ -104,21 +114,21 @@ 
 
 -- | Resolve globbing of files (e.g. data files) to absolute paths.
-resolveGlobFiles
-  :: CabalSpecVersion -- ^ Cabal file version
+resolveGlobFiles ::
+     CabalSpecVersion -- ^ Cabal file version
   -> [String]
   -> RIO GetPackageFileContext (Set (Path Abs File))
 resolveGlobFiles cabalFileVersion =
-  liftM (S.fromList . catMaybes . concat) .
+  fmap (S.fromList . catMaybes . concat) .
   mapM resolve
  where
   resolve name =
     if '*' `elem` name
       then explode name
-      else liftM pure (resolveFileOrWarn name)
+      else fmap pure (resolveFileOrWarn name)
   explode name = do
     dir <- asks (parent . ctxFile)
-    names <- matchDirFileGlob' (FL.toFilePath dir) name
+    names <- matchDirFileGlob' (toFilePath dir) name
     mapM resolveFileOrWarn names
   matchDirFileGlob' dir glob =
     catch
@@ -134,4 +144,51 @@               ]
             pure []
           else throwIO e
+      )
+
+-- | Gets all of the modules, files, build files, and data files that constitute
+-- the package. This is primarily used for dirtiness checking during build, as
+-- well as use by "stack ghci"
+getPackageFile ::
+     ( HasEnvConfig s, MonadReader s m, MonadThrow m, MonadUnliftIO m )
+  => PackageDescription
+  -> Path Abs File
+  -> m ( Map NamedComponent (Map ModuleName (Path Abs File))
+       , Map NamedComponent [DotCabalPath]
+       , Set (Path Abs File)
+       , [PackageWarning]
+       )
+getPackageFile pkg cabalfp =
+  debugBracket ("getPackageFiles" <+> pretty cabalfp) $ do
+    let pkgDir = parent cabalfp
+    distDir <- distDirFromDir pkgDir
+    bc <- view buildConfigL
+    cabalVer <- view cabalVersionL
+    (componentModules, componentFiles, dataFiles', warnings) <-
+      runRIO
+        (GetPackageFileContext cabalfp distDir bc cabalVer)
+        (packageDescModulesAndFiles pkg)
+    setupFiles <-
+      if buildType pkg == Custom
+      then do
+        let setupHsPath = pkgDir </> relFileSetupHs
+            setupLhsPath = pkgDir </> relFileSetupLhs
+        setupHsExists <- doesFileExist setupHsPath
+        if setupHsExists
+          then pure (S.singleton setupHsPath)
+          else do
+            setupLhsExists <- doesFileExist setupLhsPath
+            if setupLhsExists
+              then pure (S.singleton setupLhsPath)
+              else pure S.empty
+      else pure S.empty
+    buildFiles <- fmap (S.insert cabalfp . S.union setupFiles) $ do
+      let hpackPath = pkgDir </> relFileHpackPackageConfig
+      hpackExists <- doesFileExist hpackPath
+      pure $ if hpackExists then S.singleton hpackPath else S.empty
+    pure
+      ( componentModules
+      , componentFiles
+      , buildFiles <> dataFiles'
+      , warnings
       )
src/Stack/Path.hs view
@@ -1,51 +1,59 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
--- | Handy path information.
+-- | Types and functions related to Stack's @path@ command.
 module Stack.Path
-  ( path
-  , pathParser
+  ( PathInfo
+  , path
+  , paths
   ) where
 
 import           Data.List ( intercalate )
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
-import qualified Options.Applicative as OA
 import           Path ( (</>), parent )
 import           Path.Extra ( toFilePathNoTrailingSep )
 import           RIO.Process ( HasProcessContext (..), exeSearchPathL )
 import           Stack.Constants
-import           Stack.Constants.Config
+                   ( docDirSuffix, stackGlobalConfigOptionName
+                   , stackRootOptionName
+                   )
+import           Stack.Constants.Config ( distRelativeDir )
 import           Stack.GhcPkg as GhcPkg
 import           Stack.Prelude
 import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), projectRootL
+                   , stackYamlL
+                   )
+import           Stack.Types.BuildOpts ( buildOptsMonoidHaddockL )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), HasCompiler (..), getCompilerPath )
 import           Stack.Types.Config
+                   ( Config (..), HasConfig (..), stackGlobalConfigL, stackRootL
+                   )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig, HasEnvConfig (..), bindirCompilerTools
+                   , hoogleRoot, hpcReportDir, installationRootDeps
+                   , installationRootLocal, packageDatabaseDeps
+                   , packageDatabaseExtra, packageDatabaseLocal
+                   )
+import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
+import           Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( HasRunner (..), Runner, globalOptsL )
 import qualified System.FilePath as FP
 
 -- | Print out useful path information in a human-readable format (and
 -- support others later).
 path :: [Text] -> RIO Runner ()
 path keys = do
-  let deprecated = filter ((`elem` keys) . fst) deprecatedPathKeys
-  forM_ deprecated $ \(oldOption, newOption) ->
-    logWarn $
-         "\n"
-      <> "'--"
-      <> display oldOption
-      <> "' will be removed in a future release.\n"
-      <> "Please use '--"
-      <> display newOption
-      <> "' instead.\n"
-      <> "\n"
-  let -- filter the chosen paths in flags (keys),
-      -- or show all of them if no specific paths chosen.
+  let -- filter the chosen paths in flags (keys), or show all of them if no
+      -- specific paths chosen.
       goodPaths = filter
-        ( \(_, key, _) ->
-               (null keys && key /= T.pack deprecatedStackRootOptionName)
-            || elem key keys
-        )
+        ( \(_, key, _) -> null keys || elem key keys )
         paths
       singlePath = length goodPaths == 1
       toEither (_, k, UseHaddocks p) = Left (k, p)
@@ -96,19 +104,7 @@   piCompiler <- getCompilerPath
   pure PathInfo {..}
 
-pathParser :: OA.Parser [Text]
-pathParser =
-  mapMaybeA
-    ( \(desc,name,_) ->
-        OA.flag Nothing
-                (Just name)
-                (  OA.long (T.unpack name)
-                <> OA.help desc
-                )
-    )
-    paths
-
--- | Passed to all the path printers as a source of info.
+-- | Type representing information passed to all the path printers.
 data PathInfo = PathInfo
   { piBuildConfig  :: !BuildConfig
   , piSnapDb       :: !(Path Abs Dir)
@@ -124,37 +120,55 @@   , piCompiler     :: !(Path Abs File)
   }
 
-instance HasPlatform PathInfo
+instance HasPlatform PathInfo where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
 instance HasLogFunc PathInfo where
   logFuncL = configL.logFuncL
+
 instance HasRunner PathInfo where
   runnerL = configL.runnerL
+
 instance HasStylesUpdate PathInfo where
   stylesUpdateL = runnerL.stylesUpdateL
+
 instance HasTerm PathInfo where
   useColorL = runnerL.useColorL
   termWidthL = runnerL.termWidthL
-instance HasGHCVariant PathInfo
-instance HasConfig PathInfo
+
+instance HasGHCVariant PathInfo where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
+instance HasConfig PathInfo where
+  configL = buildConfigL.lens bcConfig (\x y -> x { bcConfig = y })
+  {-# INLINE configL #-}
+
 instance HasPantryConfig PathInfo where
   pantryConfigL = configL.pantryConfigL
+
 instance HasProcessContext PathInfo where
   processContextL = configL.processContextL
+
 instance HasBuildConfig PathInfo where
   buildConfigL = lens piBuildConfig (\x y -> x { piBuildConfig = y })
                  . buildConfigL
 
-data UseHaddocks a = UseHaddocks a | WithoutHaddocks a
+data UseHaddocks a
+  = UseHaddocks a
+  | WithoutHaddocks a
 
--- | The paths of interest to a user. The first tuple string is used
--- for a description that the optparse flag uses, and the second
--- string as a machine-readable key and also for @--foo@ flags. The user
--- can choose a specific path to list like @--stack-root@. But
--- really it's mainly for the documentation aspect.
+-- | The paths of interest to a user. The first tuple string is used for a
+-- description that the optparse flag uses, and the second string as a
+-- machine-readable key and also for @--foo@ flags. The user can choose a
+-- specific path to list like @--stack-root@. But really it's mainly for the
+-- documentation aspect.
 --
--- When printing output we generate @PathInfo@ and pass it to the
--- function to generate an appropriate string.  Trailing slashes are
--- removed, see #506
+-- When printing output we generate @PathInfo@ and pass it to the function to
+-- generate an appropriate string. Trailing slashes are removed, see #506.
 paths :: [(String, Text, UseHaddocks (PathInfo -> Text))]
 paths =
   [ ( "Global Stack root directory"
@@ -243,22 +257,4 @@   , ( "Where HPC reports and tix files are stored"
     , "local-hpc-root"
     , WithoutHaddocks $ T.pack . toFilePathNoTrailingSep . piHpcDir )
-  , ( "DEPRECATED: Use '--local-bin' instead"
-    , "local-bin-path"
-    , WithoutHaddocks $
-        T.pack . toFilePathNoTrailingSep . configLocalBin . view configL )
-  , ( "DEPRECATED: Use '--programs' instead"
-    , "ghc-paths"
-    , WithoutHaddocks $
-        T.pack . toFilePathNoTrailingSep . configLocalPrograms . view configL )
-  , ( "DEPRECATED: Use '--" <> stackRootOptionName <> "' instead"
-    , T.pack deprecatedStackRootOptionName
-    , WithoutHaddocks $ T.pack . toFilePathNoTrailingSep . view stackRootL )
-  ]
-
-deprecatedPathKeys :: [(Text, Text)]
-deprecatedPathKeys =
-  [ (T.pack deprecatedStackRootOptionName, T.pack stackRootOptionName)
-  , ("ghc-paths", "programs")
-  , ("local-bin-path", "local-bin")
   ]
src/Stack/Prelude.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE NoImplicitPrelude         #-}
-{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE ScopedTypeVariables       #-}
 
 module Stack.Prelude
   ( withSystemTempDir
@@ -15,8 +13,6 @@   , prompt
   , promptPassword
   , promptBool
-  , stackProgName
-  , stackProgName'
   , FirstTrue (..)
   , fromFirstTrue
   , defaultFirstTrue
@@ -27,6 +23,13 @@   , bugReport
   , bugPrettyReport
   , blankLine
+  , ppException
+  , prettyThrowIO
+  , prettyThrowM
+  , mcons
+  , MungedPackageId (..)
+  , MungedPackageName (..)
+  , LibraryName (..)
   , module X
   -- * Re-exports from the rio-pretty print package
   , HasStylesUpdate (..)
@@ -44,6 +47,7 @@   , debugBracket
   , defaultStyles
   , encloseSep
+  , fill
   , fillSep
   , flow
   , hang
@@ -55,15 +59,20 @@   , mkNarrativeList
   , parens
   , parseStylesUpdateFromString
+  , prettyDebug
   , prettyDebugL
   , prettyError
   , prettyErrorL
+  , prettyGeneric
   , prettyInfo
   , prettyInfoL
   , prettyInfoS
   , prettyNote
+  , prettyNoteL
+  , prettyNoteS
   , prettyWarn
   , prettyWarnL
+  , prettyWarnNoIndent
   , prettyWarnS
   , punctuate
   , sep
@@ -82,6 +91,9 @@ import           Data.Conduit.Process.Typed
                    ( byteStringInput, createSource, withLoggedProcess_ )
 import qualified Data.Text.IO as T
+import           Distribution.Types.LibraryName ( LibraryName (..) )
+import           Distribution.Types.MungedPackageId ( MungedPackageId (..) )
+import           Distribution.Types.MungedPackageName ( MungedPackageName (..) )
 import           Pantry as X hiding ( Package (..), loadSnapshot )
 import           Path as X
                    ( Abs, Dir, File, Path, Rel, toFilePath )
@@ -91,12 +103,14 @@ import           RIO.PrettyPrint
                    ( HasStylesUpdate (..), HasTerm (..), Pretty (..), Style (..)
                    , StyleDoc, (<+>), align, bulletedList, debugBracket
-                   , encloseSep, fillSep, flow, hang, hcat, hsep, indent, line
-                   , logLevelToStyle, mkNarrativeList, parens, prettyDebugL
-                   , prettyError, prettyErrorL, prettyInfo, prettyInfoL
-                   , prettyInfoS, prettyNote, prettyWarn, prettyWarnL
-                   , prettyWarnS, punctuate, sep, softbreak, softline, string
-                   , style, stylesUpdateL, useColorL, vsep
+                   , displayWithColor, encloseSep, fill, fillSep, flow, hang
+                   , hcat, hsep, indent, line, logLevelToStyle, mkNarrativeList
+                   , parens, prettyDebug, prettyDebugL, prettyError
+                   , prettyErrorL, prettyInfo, prettyInfoL, prettyInfoS
+                   , prettyNote, prettyNoteL, prettyNoteS, prettyWarn
+                   , prettyWarnL, prettyWarnNoIndent, prettyWarnS, punctuate
+                   , sep, softbreak, softline, string, style, stylesUpdateL
+                   , useColorL, vsep
                    )
 import           RIO.PrettyPrint.DefaultStyles (defaultStyles)
 import           RIO.PrettyPrint.PrettyException ( PrettyException (..) )
@@ -132,8 +146,8 @@ --
 -- Throws a 'ReadProcessException' if unsuccessful in launching, or
 -- 'ExitCodeException' if the process itself fails.
-sinkProcessStderrStdout
-  :: forall e o env. (HasProcessContext env, HasLogFunc env, HasCallStack)
+sinkProcessStderrStdout ::
+     forall e o env. (HasProcessContext env, HasLogFunc env, HasCallStack)
   => String -- ^ Command
   -> [String] -- ^ Command line arguments
   -> ConduitM ByteString Void (RIO env) e -- ^ Sink for stderr
@@ -157,27 +171,27 @@ -- lots of output; for that use 'sinkProcessStderrStdout'.
 --
 -- Throws a 'ReadProcessException' if unsuccessful.
-sinkProcessStdout
-    :: (HasProcessContext env, HasLogFunc env, HasCallStack)
-    => String -- ^ Command
-    -> [String] -- ^ Command line arguments
-    -> ConduitM ByteString Void (RIO env) a -- ^ Sink for stdout
-    -> RIO env a
+sinkProcessStdout ::
+     (HasProcessContext env, HasLogFunc env, HasCallStack)
+  => String -- ^ Command
+  -> [String] -- ^ Command line arguments
+  -> ConduitM ByteString Void (RIO env) a -- ^ Sink for stdout
+  -> RIO env a
 sinkProcessStdout name args sinkStdout =
   proc name args $ \pc ->
   withLoggedProcess_ (setStdin closed pc) $ \p -> runConcurrently
     $ Concurrently (runConduit $ getStderr p .| CL.sinkNull)
    *> Concurrently (runConduit $ getStdout p .| sinkStdout)
 
-logProcessStderrStdout
-    :: (HasCallStack, HasProcessContext env, HasLogFunc env)
-    => ProcessConfig stdin stdoutIgnored stderrIgnored
-    -> RIO env ()
+logProcessStderrStdout ::
+     (HasCallStack, HasProcessContext env, HasLogFunc env)
+  => ProcessConfig stdin stdoutIgnored stderrIgnored
+  -> RIO env ()
 logProcessStderrStdout pc = withLoggedProcess_ pc $ \p ->
-    let logLines = CB.lines .| CL.mapM_ (logInfo . displayBytesUtf8)
-     in runConcurrently
-            $ Concurrently (runConduit $ getStdout p .| logLines)
-           *> Concurrently (runConduit $ getStderr p .| logLines)
+  let logLines = CB.lines .| CL.mapM_ (logInfo . displayBytesUtf8)
+  in  runConcurrently
+        $  Concurrently (runConduit $ getStdout p .| logLines)
+        *> Concurrently (runConduit $ getStderr p .| logLines)
 
 -- | Read from the process, ignoring any output.
 --
@@ -243,22 +257,15 @@       T.putStrLn "Please press either 'y' or 'n', and then enter."
       promptBool txt
 
--- | Name of the 'stack' program.
---
--- NOTE: Should be defined in "Stack.Constants", but not doing so due to the
--- GHC stage restrictions.
-stackProgName :: String
-stackProgName = "stack"
-
-stackProgName' :: Text
-stackProgName' = T.pack stackProgName
-
 -- | Like @First Bool@, but the default is @True@.
-newtype FirstTrue = FirstTrue { getFirstTrue :: Maybe Bool }
-  deriving (Show, Eq, Ord)
+newtype FirstTrue
+  = FirstTrue { getFirstTrue :: Maybe Bool }
+  deriving (Eq, Ord, Show)
+
 instance Semigroup FirstTrue where
   FirstTrue (Just x) <> _ = FirstTrue (Just x)
   FirstTrue Nothing <> x = x
+
 instance Monoid FirstTrue where
   mempty = FirstTrue Nothing
   mappend = (<>)
@@ -272,11 +279,14 @@ defaultFirstTrue _ = True
 
 -- | Like @First Bool@, but the default is @False@.
-newtype FirstFalse = FirstFalse { getFirstFalse :: Maybe Bool }
-  deriving (Show, Eq, Ord)
+newtype FirstFalse
+  = FirstFalse { getFirstFalse :: Maybe Bool }
+  deriving (Eq, Ord, Show)
+
 instance Semigroup FirstFalse where
   FirstFalse (Just x) <> _ = FirstFalse (Just x)
   FirstFalse Nothing <> x = x
+
 instance Monoid FirstFalse where
   mempty = FirstFalse Nothing
   mappend = (<>)
@@ -292,38 +302,38 @@ -- | Write a @Builder@ to a file and atomically rename.
 writeBinaryFileAtomic :: MonadIO m => Path absrel File -> Builder -> m ()
 writeBinaryFileAtomic fp builder =
-    liftIO $
-    withBinaryFileAtomic (toFilePath fp) WriteMode (`hPutBuilder` builder)
+  liftIO $
+  withBinaryFileAtomic (toFilePath fp) WriteMode (`hPutBuilder` builder)
 
 newtype PrettyRawSnapshotLocation
-    = PrettyRawSnapshotLocation RawSnapshotLocation
+  = PrettyRawSnapshotLocation RawSnapshotLocation
 
 instance Pretty PrettyRawSnapshotLocation where
-    pretty (PrettyRawSnapshotLocation (RSLCompiler compiler)) =
-        fromString $ T.unpack $ utf8BuilderToText $ display compiler
-    pretty (PrettyRawSnapshotLocation (RSLUrl url Nothing)) =
-        style Url (fromString $ T.unpack url)
-    pretty (PrettyRawSnapshotLocation (RSLUrl url (Just blob))) =
-        fillSep
-        [ style Url (fromString $ T.unpack url)
-        , parens $ fromString $ T.unpack $ utf8BuilderToText $ display blob
-        ]
-    pretty (PrettyRawSnapshotLocation (RSLFilePath resolved)) =
-        style File (fromString $ show $ resolvedRelative resolved)
-    pretty (PrettyRawSnapshotLocation (RSLSynonym syn)) = fromString $ show syn
+  pretty (PrettyRawSnapshotLocation (RSLCompiler compiler)) =
+    fromString $ T.unpack $ utf8BuilderToText $ display compiler
+  pretty (PrettyRawSnapshotLocation (RSLUrl url Nothing)) =
+    style Url (fromString $ T.unpack url)
+  pretty (PrettyRawSnapshotLocation (RSLUrl url (Just blob))) =
+    fillSep
+    [ style Url (fromString $ T.unpack url)
+    , parens $ fromString $ T.unpack $ utf8BuilderToText $ display blob
+    ]
+  pretty (PrettyRawSnapshotLocation (RSLFilePath resolved)) =
+    style File (fromString $ show $ resolvedRelative resolved)
+  pretty (PrettyRawSnapshotLocation (RSLSynonym syn)) = fromString $ show syn
 
 -- | Report a bug in Stack.
 bugReport :: String -> String -> String
 bugReport code msg =
-    "Error: " ++ code ++ "\n" ++
-    bugDeclaration ++ " " ++ msg ++ " " ++ bugRequest
+  "Error: " ++ code ++ "\n" ++
+  bugDeclaration ++ " " ++ msg ++ " " ++ bugRequest
 
 -- | Report a pretty bug in Stack.
 bugPrettyReport :: String -> StyleDoc -> StyleDoc
 bugPrettyReport code msg =
-       "Error:" <+> fromString code
-    <> line
-    <> flow bugDeclaration <+> msg <+> flow bugRequest
+     "Error:" <+> fromString code
+  <> line
+  <> flow bugDeclaration <+> msg <+> flow bugRequest
 
 -- | Bug declaration message.
 bugDeclaration :: String
@@ -336,3 +346,29 @@ -- | A \'pretty\' blank line.
 blankLine :: StyleDoc
 blankLine = line <> line
+
+-- | Provide the prettiest available information about an exception.
+ppException :: SomeException -> StyleDoc
+ppException e = case fromException e of
+  Just (PrettyException e') -> pretty e'
+  Nothing -> (string . displayException) e
+
+-- | Synchronously throw the given exception as a 'PrettyException'.
+prettyThrowIO :: (Exception e, MonadIO m, Pretty e) => e -> m a
+prettyThrowIO = throwIO . PrettyException
+
+-- | Throw the given exception as a 'PrettyException', when the action is run in
+-- the monad @m@.
+prettyThrowM :: (Exception e, MonadThrow m, Pretty e) => e -> m a
+prettyThrowM = throwM . PrettyException
+
+-- | Maybe cons.
+mcons :: Maybe a -> [a] -> [a]
+mcons ma as = maybe as (:as) ma
+
+prettyGeneric ::
+     (HasTerm env, HasCallStack, Pretty b, MonadReader env m, MonadIO m)
+  => LogLevel
+  -> b
+  -> m ()
+prettyGeneric level = logGeneric "" level . display <=< displayWithColor
+ src/Stack/Query.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Types and functions related to Stack's @query@ command.
+module Stack.Query
+  ( queryCmd
+  , queryBuildInfo
+  ) where
+
+import           Data.Aeson ( Value (Object, Array), (.=), object )
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KeyMap
+import           Data.List ( isPrefixOf )
+import qualified Data.Text as T
+import           Data.Text.Encoding ( decodeUtf8 )
+import qualified Data.Text.IO as TIO
+import           Data.Text.Read ( decimal )
+import qualified Data.Vector as V
+import qualified Data.Yaml as Yaml
+import           Path ( parent )
+import           Stack.Build.Source ( projectLocalPackages )
+import           Stack.Prelude
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
+import           Stack.Types.BuildConfig ( wantedCompilerVersionL )
+import           Stack.Types.Compiler ( compilerVersionText )
+import           Stack.Types.EnvConfig ( HasEnvConfig, actualCompilerVersionL )
+import           Stack.Types.Runner ( Runner )
+import           Stack.Types.Package ( LocalPackage (..), Package (..) )
+
+-- | Type representing exceptions thrown by functions exported by the
+-- "Stack.Query"module.
+data QueryException
+  = SelectorNotFound ![Text]
+  | IndexOutOfRange ![Text]
+  | NoNumericSelector ![Text]
+  | CannotApplySelector !Value ![Text]
+  deriving (Show, Typeable)
+
+instance Exception QueryException where
+  displayException (SelectorNotFound sels) =
+    err "[S-4419]" "Selector not found" sels
+  displayException (IndexOutOfRange sels) =
+    err "[S-8422]" "Index out of range" sels
+  displayException (NoNumericSelector sels) =
+    err "[S-4360]" "Encountered array and needed numeric selector" sels
+  displayException (CannotApplySelector value sels) =
+    err "[S-1711]" ("Cannot apply selector to " ++ show value) sels
+
+-- | Helper function for 'QueryException' instance of 'Show'
+err :: String -> String -> [Text] -> String
+err msg code sels = "Error: " ++ code ++ "\n" ++ msg ++ ": " ++ show sels
+
+-- | Function underlying the @stack query@ command.
+queryCmd ::
+     [String]
+     -- ^ Selectors.
+  -> RIO Runner ()
+queryCmd selectors = withConfig YesReexec $
+  withDefaultEnvConfig $ queryBuildInfo $ map T.pack selectors
+
+-- | Query information about the build and print the result to stdout in YAML
+-- format.
+queryBuildInfo ::
+     HasEnvConfig env
+  => [Text] -- ^ Selectors.
+  -> RIO env ()
+queryBuildInfo selectors0 =
+      rawBuildInfo
+  >>= select id selectors0
+  >>= liftIO . TIO.putStrLn . addGlobalHintsComment . decodeUtf8 . Yaml.encode
+ where
+  select _ [] value = pure value
+  select front (sel:sels) value =
+    case value of
+      Object o ->
+        case KeyMap.lookup (Key.fromText sel) o of
+          Nothing -> throwIO $ SelectorNotFound sels'
+          Just value' -> cont value'
+      Array v ->
+        case decimal sel of
+          Right (i, "")
+            | i >= 0 && i < V.length v -> cont $ v V.! i
+            | otherwise -> throwIO $ IndexOutOfRange sels'
+          _ -> throwIO $ NoNumericSelector sels'
+      _ -> throwIO $ CannotApplySelector value sels'
+   where
+    cont = select (front . (sel:)) sels
+    sels' = front [sel]
+  -- Include comments to indicate that this portion of the "stack
+  -- query" API is not necessarily stable.
+  addGlobalHintsComment
+    | null selectors0 = T.replace globalHintsLine ("\n" <> globalHintsComment <> globalHintsLine)
+    -- Append comment instead of pre-pending. The reasoning here is
+    -- that something *could* expect that the result of 'stack query
+    -- global-hints ghc-boot' is just a string literal. Seems easier
+    -- for to expect the first line of the output to be the literal.
+    | ["global-hints"] `isPrefixOf` selectors0 = (<> ("\n" <> globalHintsComment))
+    | otherwise = id
+  globalHintsLine = "\nglobal-hints:\n"
+  globalHintsComment = T.concat
+    [ "# Note: global-hints is experimental and may be renamed / removed in the future.\n"
+    , "# See https://github.com/commercialhaskell/stack/issues/3796"
+    ]
+
+-- | Get the raw build information object
+rawBuildInfo :: HasEnvConfig env => RIO env Value
+rawBuildInfo = do
+  locals <- projectLocalPackages
+  wantedCompiler <- view $ wantedCompilerVersionL.to (utf8BuilderToText . display)
+  actualCompiler <- view $ actualCompilerVersionL.to compilerVersionText
+  pure $ object
+    [ "locals" .= Object (KeyMap.fromList $ map localToPair locals)
+    , "compiler" .= object
+        [ "wanted" .= wantedCompiler
+        , "actual" .= actualCompiler
+        ]
+    ]
+ where
+  localToPair lp =
+    (Key.fromText $ T.pack $ packageNameString $ packageName p, value)
+   where
+    p = lpPackage lp
+    value = object
+      [ "version" .= CabalString (packageVersion p)
+      , "path" .= toFilePath (parent $ lpCabalFile lp)
+      ]
src/Stack/Runners.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Utilities for running stack commands.
@@ -23,18 +22,32 @@ import           RIO.Time ( addUTCTime, getCurrentTime )
 import           Stack.Build.Target ( NeedTargets (..) )
 import           Stack.Config
+                   ( getInContainer, getInNixShell, loadConfig, withBuildConfig
+                   , withNewLogFunc
+                   )
 import           Stack.Constants
+                   ( defaultTerminalWidth, maxTerminalWidth, minTerminalWidth )
 import           Stack.DefaultColorWhen ( defaultColorWhen )
 import qualified Stack.Docker as Docker
 import qualified Stack.Nix as Nix
 import           Stack.Prelude
-import           Stack.Setup
-import           Stack.Storage.User ( upgradeChecksSince, logUpgradeCheck )
-import           Stack.Types.Config
+import           Stack.Setup ( setupEnv )
+import           Stack.Storage.User ( logUpgradeCheck, upgradeChecksSince )
+import           Stack.Types.BuildOpts
+                   ( BuildOptsCLI, defaultBuildOptsCLI )
+import           Stack.Types.ColorWhen ( ColorWhen (..) )
+import           Stack.Types.Config ( Config (..) )
+import           Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
 import           Stack.Types.Docker ( dockerEnable )
+import           Stack.Types.EnvConfig ( EnvConfig )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
 import           Stack.Types.Nix ( nixEnable )
-import           Stack.Types.Version ( stackMinorVersion, minorVersion )
-import           System.Console.ANSI ( hSupportsANSIWithoutEmulation )
+import           Stack.Types.Runner
+                   ( Runner (..), globalOptsL, reExecL, stackYamlLocL )
+import           Stack.Types.StackYamlLoc ( StackYamlLoc (..) )
+import           Stack.Types.Version
+                   ( minorVersion, stackMinorVersion, stackVersion )
+import           System.Console.ANSI ( hSupportsANSI )
 import           System.Terminal ( getTerminalWidth )
 
 -- | Type representing exceptions thrown by functions exported by the
@@ -74,9 +87,7 @@ -- * No targets are requested
 --
 -- * Default command line build options are assumed
-withDefaultEnvConfig
-    :: RIO EnvConfig a
-    -> RIO Config a
+withDefaultEnvConfig :: RIO EnvConfig a -> RIO Config a
 withDefaultEnvConfig = withEnvConfig AllowNoTargets defaultBuildOptsCLI
 
 -- | Upgrade a 'Config' environment to an 'EnvConfig' environment by
@@ -84,13 +95,13 @@ -- 'withBuildConfig') and then setting up a build environment
 -- toolchain. This is intended to be run inside a call to
 -- 'withConfig'.
-withEnvConfig
-    :: NeedTargets
-    -> BuildOptsCLI
-    -> RIO EnvConfig a
-    -- ^ Action that uses the build config.  If Docker is enabled for builds,
-    -- this will be run in a Docker container.
-    -> RIO Config a
+withEnvConfig ::
+     NeedTargets
+  -> BuildOptsCLI
+  -> RIO EnvConfig a
+  -- ^ Action that uses the build config.  If Docker is enabled for builds,
+  -- this will be run in a Docker container.
+  -> RIO Config a
 withEnvConfig needTargets boptsCLI inner =
   withBuildConfig $ do
     envConfig <- setupEnv needTargets boptsCLI Nothing
@@ -98,35 +109,34 @@     runRIO envConfig inner
 
 -- | If the settings justify it, should we reexec inside Docker or Nix?
-data ShouldReexec = YesReexec | NoReexec
+data ShouldReexec
+  = YesReexec
+  | NoReexec
 
 -- | Load the configuration. Convenience function used
 -- throughout this module.
-withConfig
-  :: ShouldReexec
-  -> RIO Config a
-  -> RIO Runner a
+withConfig :: ShouldReexec -> RIO Config a -> RIO Runner a
 withConfig shouldReexec inner =
-    loadConfig $ \config -> do
-      -- If we have been relaunched in a Docker container, perform in-container initialization
-      -- (switch UID, etc.).  We do this after first loading the configuration since it must
-      -- happen ASAP but needs a configuration.
-      view (globalOptsL.to globalDockerEntrypoint) >>=
-        traverse_ (Docker.entrypoint config)
-      runRIO config $ do
-        -- Catching all exceptions here, since we don't want this
-        -- check to ever cause Stack to stop working
-        shouldUpgradeCheck `catchAny` \e ->
-          logError $
-            "Error: [S-7353]\n" <>
-            "Error when running shouldUpgradeCheck: " <>
-            displayShow e
-        case shouldReexec of
-          YesReexec -> reexec inner
-          NoReexec -> inner
+  loadConfig $ \config -> do
+    -- If we have been relaunched in a Docker container, perform in-container
+    -- initialization (switch UID, etc.).  We do this after first loading the
+    -- configuration since it must happen ASAP but needs a configuration.
+    view (globalOptsL.to globalDockerEntrypoint) >>=
+      traverse_ (Docker.entrypoint config)
+    runRIO config $ do
+      -- Catching all exceptions here, since we don't want this
+      -- check to ever cause Stack to stop working
+      shouldUpgradeCheck `catchAny` \e ->
+        logError $
+          "Error: [S-7353]\n" <>
+          "Error when running shouldUpgradeCheck: " <>
+          displayShow e
+      case shouldReexec of
+        YesReexec -> reexec inner
+        NoReexec -> inner
 
--- | Perform a Docker or Nix reexec, if warranted. Otherwise run the
--- inner action.
+-- | Perform a Docker or Nix reexec, if warranted. Otherwise run the inner
+-- action.
 reexec :: RIO Config a -> RIO Config a
 reexec inner = do
   nixEnable' <- asks $ nixEnable . configNix
@@ -165,8 +175,7 @@   useColor <- case colorWhen of
     ColorNever -> pure False
     ColorAlways -> pure True
-    ColorAuto -> fromMaybe True <$>
-                          hSupportsANSIWithoutEmulation stderr
+    ColorAuto -> hSupportsANSI stderr
   termWidth <- clipWidth <$> maybe (fromMaybe defaultTerminalWidth
                                     <$> getTerminalWidth)
                                    pure (globalTermWidth go)
@@ -179,10 +188,11 @@     , runnerTermWidth = termWidth
     , runnerProcessContext = menv
     } inner
-  where clipWidth w
-          | w < minTerminalWidth = minTerminalWidth
-          | w > maxTerminalWidth = maxTerminalWidth
-          | otherwise = w
+ where
+  clipWidth w
+    | w < minTerminalWidth = minTerminalWidth
+    | w > maxTerminalWidth = maxTerminalWidth
+    | otherwise = w
 
 -- | Check if we should recommend upgrading Stack and, if so, recommend it.
 shouldUpgradeCheck :: RIO Config ()
@@ -198,19 +208,26 @@         -- Compare the minor version so we avoid patch-level, Hackage-only releases.
         -- See: https://github.com/commercialhaskell/stack/pull/4729#pullrequestreview-227176315
         Just (PackageIdentifierRevision _ version _) | minorVersion version > stackMinorVersion -> do
-          logWarn "<<<<<<<<<<<<<<<<<<"
-          logWarn $
-            "You are currently using Stack version " <>
-            fromString (versionString stackVersion) <>
-            ", but version " <>
-            fromString (versionString version) <>
-            " is available"
-          logWarn "You can try to upgrade by running 'stack upgrade'"
-          logWarn $
-            "Tired of seeing this? Add 'recommend-stack-upgrade: false' to " <>
-            fromString (toFilePath (configUserConfigPath config))
-          logWarn ">>>>>>>>>>>>>>>>>>"
-          logWarn ""
-          logWarn ""
+          prettyWarn $
+               fillSep
+                 [ flow "You are currently using Stack version"
+                 , fromString (versionString stackVersion)
+                 , flow "but version"
+                 , fromString (versionString version)
+                 , flow "is available."
+                 ]
+            <> blankLine
+            <> fillSep
+                 [ "You can try to upgrade by running"
+                 , style Shell (flow "stack upgrade")
+                 ]
+            <> blankLine
+            <> fillSep
+                 [ flow "Tired of seeing this? Add"
+                 , style Shell (flow "recommend-stack-upgrade: false")
+                 , "to"
+                 , pretty (configUserConfigPath config) <> "."
+                 ]
+            <> blankLine
         _ -> pure ()
       logUpgradeCheck now
src/Stack/SDist.hs view
@@ -1,23 +1,20 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE ConstraintKinds    #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts   #-}
 {-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RankNTypes         #-}
 {-# LANGUAGE TypeFamilies       #-}
 
--- Create a source distribution tarball
+-- Types and functions related to Stack's @sdist@ command.
 module Stack.SDist
-  ( getSDistTarball
+  ( SDistOpts (..)
+  , sdistCmd
+  , getSDistTarball
   , checkSDistTarball
   , checkSDistTarball'
-  , SDistOpts (..)
   ) where
 
 import qualified Codec.Archive.Tar as Tar
 import qualified Codec.Archive.Tar.Entry as Tar
 import qualified Codec.Compression.GZip as GZip
-import           Control.Applicative
+import           Conduit ( runConduitRes, sourceLazy, sinkFileCautious )
 import           Control.Concurrent.Execute
                    ( ActionContext (..), Concurrency (..) )
 import qualified Data.ByteString as S
@@ -34,7 +31,7 @@ import qualified Data.Text.Encoding.Error as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
-import           Data.Time.Clock.POSIX
+import           Data.Time.Clock.POSIX ( getPOSIXTime, utcTimeToPOSIXSeconds )
 import           Distribution.Package ( Dependency (..) )
 import qualified Distribution.PackageDescription as Cabal
 import qualified Distribution.PackageDescription.Check as Check
@@ -45,24 +42,56 @@                    ( simplifyVersionRange, orLaterVersion, earlierVersion
                    , hasUpperBound, hasLowerBound
                    )
-import           Path
-import           Path.IO
-                   hiding
-                     ( getModificationTime, getPermissions, withSystemTempDir )
+import           Path ( (</>), parent, parseRelDir, parseRelFile )
+import           Path.IO ( ensureDir, resolveDir' )
 import           Stack.Build ( mkBaseConfigOpts, build, buildLocalTargets )
 import           Stack.Build.Execute
-import           Stack.Build.Installed
+                   ( ExcludeTHLoading (..), KeepOutputOpen (..), withExecuteEnv
+                   , withSingleContext
+                   )
+import           Stack.Build.Installed ( getInstalled, toInstallMap )
 import           Stack.Build.Source ( projectLocalPackages )
+import           Stack.Constants ( stackProgName, stackProgName' )
+import           Stack.Constants.Config ( distDirFromDir )
 import           Stack.Package
-import           Stack.Prelude hiding ( Display (..) )
-import           Stack.SourceMap
+                   ( PackageDescriptionPair (..), resolvePackage
+                   , resolvePackageDescription
+                   )
+import           Stack.Prelude
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
+import           Stack.SourceMap ( mkProjectPackage )
 import           Stack.Types.Build
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
+                   ( CachePkgSrc (..), Task (..), TaskConfigOpts (..)
+                   , TaskType (..)
+                   )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), stackYamlL )
+import           Stack.Types.BuildOpts
+                   ( BuildOpts (..), defaultBuildOpts, defaultBuildOptsCLI )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.ConfigureOpts ( ConfigureOpts (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
 import           Stack.Types.Package
+                   ( InstallMap, Installed (..), InstalledMap, LocalPackage (..)
+                   , Package (..), PackageConfig (..), installedVersion
+                   , packageIdentifier
+                   )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.PvpBounds ( PvpBounds (..), PvpBoundsType (..) )
+import           Stack.Types.Runner ( HasRunner, Runner )
 import           Stack.Types.SourceMap
+                   ( CommonPackage (..), ProjectPackage (..), SMWanted (..)
+                   , SourceMap (..), ppRoot
+                   )
 import           Stack.Types.Version
-import           System.Directory ( getModificationTime, getPermissions )
+                   ( intersectVersionRanges, nextMajorVersion )
+import           System.Directory
+                   ( copyFile, createDirectoryIfMissing, executable
+                   , getModificationTime, getPermissions
+                   )
 import qualified System.FilePath as FP
 
 -- | Type representing exceptions thrown by functions exported by the
@@ -86,7 +115,7 @@   displayException (ToTarPathException e) =
     "Error: [S-7875\n"
     ++ e
-
+-- | Type representing command line options for @stack sdist@ command.
 data SDistOpts = SDistOpts
   { sdoptsDirsToWorkWith :: [String]
   -- ^ Directories to package
@@ -100,94 +129,144 @@   -- ^ Where to copy the tarball
   }
 
+-- | Function underlying the @stack sdist@ command.
+sdistCmd :: SDistOpts -> RIO Runner ()
+sdistCmd sdistOpts =
+  withConfig YesReexec $ withDefaultEnvConfig $ do
+    -- If no directories are specified, build all sdist tarballs.
+    dirs' <- if null (sdoptsDirsToWorkWith sdistOpts)
+      then do
+        dirs <- view $ buildConfigL.to (map ppRoot . Map.elems . smwProject . bcSMWanted)
+        when (null dirs) $ do
+          stackYaml <- view stackYamlL
+          prettyErrorL
+            [ style Shell "stack sdist"
+            , flow "expects a list of targets, and otherwise defaults to all of the project's packages."
+            , flow "However, the configuration at"
+            , pretty stackYaml
+            , flow "contains no packages, so no sdist tarballs will be generated."
+            ]
+          exitFailure
+        pure dirs
+      else mapM resolveDir' (sdoptsDirsToWorkWith sdistOpts)
+    forM_ dirs' $ \dir -> do
+      (tarName, tarBytes, _mcabalRevision) <-
+        getSDistTarball (sdoptsPvpBounds sdistOpts) dir
+      distDir <- distDirFromDir dir
+      tarPath <- (distDir </>) <$> parseRelFile tarName
+      ensureDir (parent tarPath)
+      runConduitRes $
+        sourceLazy tarBytes .|
+        sinkFileCautious (toFilePath tarPath)
+      prettyInfoL
+        [flow "Wrote sdist-format compressed archive to"
+        , pretty tarPath <> "."
+        ]
+      checkSDistTarball sdistOpts tarPath
+      forM_ (sdoptsTarPath sdistOpts) $ copyTarToTarPath tarPath tarName
+ where
+  copyTarToTarPath tarPath tarName targetDir = liftIO $ do
+    let targetTarPath = targetDir FP.</> tarName
+    createDirectoryIfMissing True $ FP.takeDirectory targetTarPath
+    copyFile (toFilePath tarPath) targetTarPath
+
 -- | Given the path to a local package, creates its source
 -- distribution tarball.
 --
 -- While this yields a 'FilePath', the name of the tarball, this
 -- tarball is not written to the disk and instead yielded as a lazy
 -- bytestring.
-getSDistTarball
-  :: HasEnvConfig env
+getSDistTarball ::
+     HasEnvConfig env
   => Maybe PvpBounds            -- ^ Override Config value
   -> Path Abs Dir               -- ^ Path to local package
   -> RIO env (FilePath, L.ByteString, Maybe (PackageIdentifier, L.ByteString))
   -- ^ Filename, tarball contents, and option Cabal file revision to upload
 getSDistTarball mpvpBounds pkgDir = do
-    config <- view configL
-    let PvpBounds pvpBounds asRevision = fromMaybe (configPvpBounds config) mpvpBounds
-        tweakCabal = pvpBounds /= PvpBoundsNone
-        pkgFp = toFilePath pkgDir
-    lp <- readLocalPackage pkgDir
-    forM_ (packageSetupDeps (lpPackage lp)) $ \customSetupDeps ->
-        case NE.nonEmpty (map (T.pack . packageNameString) (Map.keys customSetupDeps)) of
-          Just nonEmptyDepTargets -> do
-            eres <- buildLocalTargets nonEmptyDepTargets
-            case eres of
-              Left err ->
-                logError $
-                  "Error: [S-8399]\n" <>
-                  "Error building custom-setup dependencies: " <>
-                  displayShow err
-              Right _ ->
-                pure ()
-          Nothing ->
-            logWarn "unexpected empty custom-setup dependencies"
-    sourceMap <- view $ envConfigL.to envConfigSourceMap
-
-    installMap <- toInstallMap sourceMap
-    (installedMap, _globalDumpPkgs, _snapshotDumpPkgs, _localDumpPkgs) <-
-        getInstalled installMap
-    let deps = Map.fromList [ (pid, ghcPkgId)
-                            | (_, Library pid ghcPkgId _) <- Map.elems installedMap]
-
-    logInfo $ "Getting file list for " <> fromString pkgFp
-    (fileList, cabalfp) <- getSDistFileList lp deps
-    logInfo $ "Building sdist tarball for " <> fromString pkgFp
-    files <- normalizeTarballPaths (map (T.unpack . stripCR . T.pack) (lines fileList))
-
-    -- We're going to loop below and eventually find the cabal
-    -- file. When we do, we'll upload this reference, if the
-    -- mpvpBounds value indicates that we should be uploading a cabal
-    -- file revision.
-    cabalFileRevisionRef <- liftIO (newIORef Nothing)
-
-    -- NOTE: Could make this use lazy I/O to only read files as needed
-    -- for upload (both GZip.compress and Tar.write are lazy).
-    -- However, it seems less error prone and more predictable to read
-    -- everything in at once, so that's what we're doing for now:
-    let tarPath isDir fp =
-            case Tar.toTarPath isDir (forceUtf8Enc (pkgId FP.</> fp)) of
-                Left e -> throwIO $ ToTarPathException e
-                Right tp -> pure tp
-        -- convert a String of proper characters to a String of bytes
-        -- in UTF8 encoding masquerading as characters. This is
-        -- necessary for tricking the tar package into proper
-        -- character encoding.
-        forceUtf8Enc = S8.unpack . T.encodeUtf8 . T.pack
-        packWith f isDir fp = liftIO $ f (pkgFp FP.</> fp) =<< tarPath isDir fp
-        packDir = packWith Tar.packDirectoryEntry True
-        packFile fp
-            -- This is a Cabal file, we're going to tweak it, but only
-            -- tweak it as a revision.
-            | tweakCabal && isCabalFp fp && asRevision = do
-                lbsIdent <- getCabalLbs pvpBounds (Just 1) cabalfp sourceMap
-                liftIO (writeIORef cabalFileRevisionRef (Just lbsIdent))
-                packWith packFileEntry False fp
-            -- Same, except we'll include the Cabal file in the
-            -- original tarball upload.
-            | tweakCabal && isCabalFp fp = do
-                (_ident, lbs) <- getCabalLbs pvpBounds Nothing cabalfp sourceMap
-                currTime <- liftIO getPOSIXTime -- Seconds from UNIX epoch
-                tp <- liftIO $ tarPath False fp
-                pure $ (Tar.fileEntry tp lbs) { Tar.entryTime = floor currTime }
-            | otherwise = packWith packFileEntry False fp
-        isCabalFp fp = toFilePath pkgDir FP.</> fp == toFilePath cabalfp
-        tarName = pkgId FP.<.> "tar.gz"
-        pkgId = packageIdentifierString (packageIdentifier (lpPackage lp))
-    dirEntries <- mapM packDir (dirsFromFiles files)
-    fileEntries <- mapM packFile files
-    mcabalFileRevision <- liftIO (readIORef cabalFileRevisionRef)
-    pure (tarName, GZip.compress (Tar.write (dirEntries ++ fileEntries)), mcabalFileRevision)
+  config <- view configL
+  let PvpBounds pvpBounds asRevision =
+        fromMaybe (configPvpBounds config) mpvpBounds
+      tweakCabal = pvpBounds /= PvpBoundsNone
+      pkgFp = toFilePath pkgDir
+  lp <- readLocalPackage pkgDir
+  forM_ (packageSetupDeps (lpPackage lp)) $ \customSetupDeps ->
+    case NE.nonEmpty (map (T.pack . packageNameString) (Map.keys customSetupDeps)) of
+      Just nonEmptyDepTargets -> do
+        eres <- buildLocalTargets nonEmptyDepTargets
+        case eres of
+          Left err ->
+            logError $
+              "Error: [S-8399]\n" <>
+              "Error building custom-setup dependencies: " <>
+              displayShow err
+          Right _ ->
+            pure ()
+      Nothing ->
+        prettyWarnS "unexpected empty custom-setup dependencies."
+  sourceMap <- view $ envConfigL.to envConfigSourceMap
+  installMap <- toInstallMap sourceMap
+  (installedMap, _globalDumpPkgs, _snapshotDumpPkgs, _localDumpPkgs) <-
+    getInstalled installMap
+  let deps = Map.fromList
+        [ (pid, ghcPkgId)
+        | (_, Library pid ghcPkgId _) <- Map.elems installedMap]
+  prettyInfoL
+    [ flow "Getting the file list for"
+    , style File (fromString  pkgFp) <> "."
+    ]
+  (fileList, cabalfp) <- getSDistFileList lp deps
+  prettyInfoL
+    [ flow "Building a compressed archive file in the sdist format for"
+    , style File (fromString pkgFp) <> "."
+    ]
+  files <-
+    normalizeTarballPaths (map (T.unpack . stripCR . T.pack) (lines fileList))
+  -- We're going to loop below and eventually find the cabal
+  -- file. When we do, we'll upload this reference, if the
+  -- mpvpBounds value indicates that we should be uploading a cabal
+  -- file revision.
+  cabalFileRevisionRef <- liftIO (newIORef Nothing)
+  -- NOTE: Could make this use lazy I/O to only read files as needed
+  -- for upload (both GZip.compress and Tar.write are lazy).
+  -- However, it seems less error prone and more predictable to read
+  -- everything in at once, so that's what we're doing for now:
+  let tarPath isDir fp =
+        case Tar.toTarPath isDir (forceUtf8Enc (pkgId FP.</> fp)) of
+          Left e -> throwIO $ ToTarPathException e
+          Right tp -> pure tp
+      -- convert a String of proper characters to a String of bytes
+      -- in UTF8 encoding masquerading as characters. This is
+      -- necessary for tricking the tar package into proper
+      -- character encoding.
+      forceUtf8Enc = S8.unpack . T.encodeUtf8 . T.pack
+      packWith f isDir fp = liftIO $ f (pkgFp FP.</> fp) =<< tarPath isDir fp
+      packDir = packWith Tar.packDirectoryEntry True
+      packFile fp
+        -- This is a Cabal file, we're going to tweak it, but only
+        -- tweak it as a revision.
+        | tweakCabal && isCabalFp fp && asRevision = do
+            lbsIdent <- getCabalLbs pvpBounds (Just 1) cabalfp sourceMap
+            liftIO (writeIORef cabalFileRevisionRef (Just lbsIdent))
+            packWith packFileEntry False fp
+        -- Same, except we'll include the Cabal file in the
+        -- original tarball upload.
+        | tweakCabal && isCabalFp fp = do
+            (_ident, lbs) <- getCabalLbs pvpBounds Nothing cabalfp sourceMap
+            currTime <- liftIO getPOSIXTime -- Seconds from UNIX epoch
+            tp <- liftIO $ tarPath False fp
+            pure $ (Tar.fileEntry tp lbs) { Tar.entryTime = floor currTime }
+        | otherwise = packWith packFileEntry False fp
+      isCabalFp fp = toFilePath pkgDir FP.</> fp == toFilePath cabalfp
+      tarName = pkgId FP.<.> "tar.gz"
+      pkgId = packageIdentifierString (packageIdentifier (lpPackage lp))
+  dirEntries <- mapM packDir (dirsFromFiles files)
+  fileEntries <- mapM packFile files
+  mcabalFileRevision <- liftIO (readIORef cabalFileRevisionRef)
+  pure
+    ( tarName
+    , GZip.compress (Tar.write (dirEntries ++ fileEntries))
+    , mcabalFileRevision
+    )
 
 -- | Get the PVP bounds-enabled version of the given Cabal file
 getCabalLbs :: HasEnvConfig env
@@ -197,128 +276,128 @@             -> SourceMap
             -> RIO env (PackageIdentifier, L.ByteString)
 getCabalLbs pvpBounds mrev cabalfp sourceMap = do
-    (gpdio, _name, cabalfp') <-
-      loadCabalFilePath (Just stackProgName') (parent cabalfp)
-    gpd <- liftIO $ gpdio NoPrintWarnings
-    unless (cabalfp == cabalfp') $
-      throwIO $ CabalFilePathsInconsistentBug cabalfp cabalfp'
-    installMap <- toInstallMap sourceMap
-    (installedMap, _, _, _) <- getInstalled installMap
-    let internalPackages = Set.fromList $
-          gpdPackageName gpd :
-          map (Cabal.unqualComponentNameToPackageName . fst) (Cabal.condSubLibraries gpd)
-        gpd' = gtraverseT (addBounds internalPackages installMap installedMap) gpd
-        gpd'' =
-          case mrev of
-            Nothing -> gpd'
-            Just rev -> gpd'
-              { Cabal.packageDescription
-               = (Cabal.packageDescription gpd')
-                  { Cabal.customFieldsPD
-                  = (("x-revision", show rev):)
-                  $ filter (\(x, _) -> map toLower x /= "x-revision")
-                  $ Cabal.customFieldsPD
-                  $ Cabal.packageDescription gpd'
-                  }
-              }
-        ident = Cabal.package $ Cabal.packageDescription gpd''
-    -- Sanity rendering and reparsing the input, to ensure there are no
-    -- cabal bugs, since there have been bugs here before, and currently
-    -- are at the time of writing:
-    --
-    -- https://github.com/haskell/cabal/issues/1202
-    -- https://github.com/haskell/cabal/issues/2353
-    -- https://github.com/haskell/cabal/issues/4863 (current issue)
-    let roundtripErrs =
-          [ flow "Bug detected in Cabal library. ((parse . render . parse) === \
-                 \id) does not hold for the Cabal file at"
-          <+> pretty cabalfp
-          , ""
-          ]
-        (_warnings, eres) = Cabal.runParseResult
-                          $ Cabal.parseGenericPackageDescription
-                          $ T.encodeUtf8
-                          $ T.pack
-                          $ showGenericPackageDescription gpd
-    case eres of
-      Right roundtripped
-        | roundtripped == gpd -> pure ()
-        | otherwise -> do
-            prettyWarn $ vsep $ roundtripErrs ++
-              [ "This seems to be fixed in development versions of Cabal, but \
-                \at time of writing, the fix is not in any released versions."
-              , ""
-              ,  "Please see this GitHub issue for status:" <+> style Url "https://github.com/commercialhaskell/stack/issues/3549"
-              , ""
-              , fillSep
-                [ flow "If the issue is closed as resolved, then you may be \
-                       \able to fix this by upgrading to a newer version of \
-                       \Stack via"
-                , style Shell "stack upgrade"
-                , flow "for latest stable version or"
-                , style Shell "stack upgrade --git"
-                , flow "for the latest development version."
-                ]
-              , ""
-              , fillSep
-                [ flow "If the issue is fixed, but updating doesn't solve the \
-                       \problem, please check if there are similar open \
-                       \issues, and if not, report a new issue to the Stack \
-                       \issue tracker, at"
-                , style Url "https://github.com/commercialhaskell/stack/issues/new"
-                ]
-              , ""
-              , flow "If the issue is not fixed, feel free to leave a comment \
-                     \on it indicating that you would like it to be fixed."
-              , ""
+  (gpdio, _name, cabalfp') <-
+    loadCabalFilePath (Just stackProgName') (parent cabalfp)
+  gpd <- liftIO $ gpdio NoPrintWarnings
+  unless (cabalfp == cabalfp') $
+    throwIO $ CabalFilePathsInconsistentBug cabalfp cabalfp'
+  installMap <- toInstallMap sourceMap
+  (installedMap, _, _, _) <- getInstalled installMap
+  let internalPackages = Set.fromList $
+        gpdPackageName gpd :
+        map (Cabal.unqualComponentNameToPackageName . fst) (Cabal.condSubLibraries gpd)
+      gpd' = gtraverseT (addBounds internalPackages installMap installedMap) gpd
+      gpd'' =
+        case mrev of
+          Nothing -> gpd'
+          Just rev -> gpd'
+            { Cabal.packageDescription
+             = (Cabal.packageDescription gpd')
+                { Cabal.customFieldsPD
+                = (("x-revision", show rev):)
+                $ filter (\(x, _) -> map toLower x /= "x-revision")
+                $ Cabal.customFieldsPD
+                $ Cabal.packageDescription gpd'
+                }
+            }
+      ident = Cabal.package $ Cabal.packageDescription gpd''
+  -- Sanity rendering and reparsing the input, to ensure there are no
+  -- cabal bugs, since there have been bugs here before, and currently
+  -- are at the time of writing:
+  --
+  -- https://github.com/haskell/cabal/issues/1202
+  -- https://github.com/haskell/cabal/issues/2353
+  -- https://github.com/haskell/cabal/issues/4863 (current issue)
+  let roundtripErrs =
+        [ flow "Bug detected in Cabal library. ((parse . render . parse) === \
+               \id) does not hold for the Cabal file at"
+        <+> pretty cabalfp
+        , ""
+        ]
+      (_warnings, eres) = Cabal.runParseResult
+                        $ Cabal.parseGenericPackageDescription
+                        $ T.encodeUtf8
+                        $ T.pack
+                        $ showGenericPackageDescription gpd
+  case eres of
+    Right roundtripped
+      | roundtripped == gpd -> pure ()
+      | otherwise ->
+          prettyWarn $ vsep $ roundtripErrs ++
+            [ "This seems to be fixed in development versions of Cabal, but \
+              \at time of writing, the fix is not in any released versions."
+            , ""
+            ,  "Please see this GitHub issue for status:" <+> style Url "https://github.com/commercialhaskell/stack/issues/3549"
+            , ""
+            , fillSep
+              [ flow "If the issue is closed as resolved, then you may be \
+                     \able to fix this by upgrading to a newer version of \
+                     \Stack via"
+              , style Shell "stack upgrade"
+              , flow "for latest stable version or"
+              , style Shell "stack upgrade --git"
+              , flow "for the latest development version."
               ]
-      Left (_version, errs) -> do
-        prettyWarn $ vsep $ roundtripErrs ++
-          [ flow "In particular, parsing the rendered Cabal file is yielding a \
-                 \parse error. Please check if there are already issues \
-                 \tracking this, and if not, please report new issues to the \
-                 \Stack and Cabal issue trackers, via"
-          , bulletedList
-            [ style Url "https://github.com/commercialhaskell/stack/issues/new"
-            , style Url "https://github.com/haskell/cabal/issues/new"
+            , ""
+            , fillSep
+              [ flow "If the issue is fixed, but updating doesn't solve the \
+                     \problem, please check if there are similar open \
+                     \issues, and if not, report a new issue to the Stack \
+                     \issue tracker, at"
+              , style Url "https://github.com/commercialhaskell/stack/issues/new"
+              ]
+            , ""
+            , flow "If the issue is not fixed, feel free to leave a comment \
+                   \on it indicating that you would like it to be fixed."
+            , ""
             ]
-          , flow $ "The parse error is: " ++ unlines (map show (toList errs))
-          , ""
+    Left (_version, errs) ->
+      prettyWarn $ vsep $ roundtripErrs ++
+        [ flow "In particular, parsing the rendered Cabal file is yielding a \
+               \parse error. Please check if there are already issues \
+               \tracking this, and if not, please report new issues to the \
+               \Stack and Cabal issue trackers, via"
+        , bulletedList
+          [ style Url "https://github.com/commercialhaskell/stack/issues/new"
+          , style Url "https://github.com/haskell/cabal/issues/new"
           ]
-    pure
-      ( ident
-      , TLE.encodeUtf8 $ TL.pack $ showGenericPackageDescription gpd''
-      )
-  where
-    addBounds :: Set PackageName -> InstallMap -> InstalledMap -> Dependency -> Dependency
-    addBounds internalPackages installMap installedMap dep@(Dependency name range s) =
-      if name `Set.member` internalPackages
-        then dep
-        else case foundVersion of
-          Nothing -> dep
-          Just version -> Dependency name (simplifyVersionRange
-            $ (if toAddUpper && not (hasUpperBound range) then addUpper version else id)
-            $ (if toAddLower && not (hasLowerBound range) then addLower version else id)
-              range) s
-      where
-        foundVersion =
-          case Map.lookup name installMap of
-              Just (_, version) -> Just version
-              Nothing ->
-                  case Map.lookup name installedMap of
-                      Just (_, installed) -> Just (installedVersion installed)
-                      Nothing -> Nothing
+        , flow $ "The parse error is: " ++ unlines (map show (toList errs))
+        , ""
+        ]
+  pure
+    ( ident
+    , TLE.encodeUtf8 $ TL.pack $ showGenericPackageDescription gpd''
+    )
+ where
+  addBounds :: Set PackageName -> InstallMap -> InstalledMap -> Dependency -> Dependency
+  addBounds internalPackages installMap installedMap dep@(Dependency name range s) =
+    if name `Set.member` internalPackages
+      then dep
+      else case foundVersion of
+        Nothing -> dep
+        Just version -> Dependency name (simplifyVersionRange
+          $ (if toAddUpper && not (hasUpperBound range) then addUpper version else id)
+          $ (if toAddLower && not (hasLowerBound range) then addLower version else id)
+            range) s
+   where
+    foundVersion =
+      case Map.lookup name installMap of
+        Just (_, version) -> Just version
+        Nothing ->
+          case Map.lookup name installedMap of
+            Just (_, installed) -> Just (installedVersion installed)
+            Nothing -> Nothing
 
-    addUpper version = intersectVersionRanges
-        (earlierVersion $ nextMajorVersion version)
-    addLower version = intersectVersionRanges (orLaterVersion version)
+  addUpper version = intersectVersionRanges
+      (earlierVersion $ nextMajorVersion version)
+  addLower version = intersectVersionRanges (orLaterVersion version)
 
-    (toAddLower, toAddUpper) =
-      case pvpBounds of
-        PvpBoundsNone  -> (False, False)
-        PvpBoundsUpper -> (False, True)
-        PvpBoundsLower -> (True,  False)
-        PvpBoundsBoth  -> (True,  True)
+  (toAddLower, toAddUpper) =
+    case pvpBounds of
+      PvpBoundsNone  -> (False, False)
+      PvpBoundsUpper -> (False, True)
+      PvpBoundsLower -> (True,  False)
+      PvpBoundsBoth  -> (True,  True)
 
 -- | Traverse a data type.
 gtraverseT :: (Data a,Typeable b) => (Typeable b => b -> b) -> a -> a
@@ -332,147 +411,168 @@ -- use-cases.
 readLocalPackage :: HasEnvConfig env => Path Abs Dir -> RIO env LocalPackage
 readLocalPackage pkgDir = do
-    config  <- getDefaultPackageConfig
-    (gpdio, _, cabalfp) <- loadCabalFilePath (Just stackProgName') pkgDir
-    gpd <- liftIO $ gpdio YesPrintWarnings
-    let package = resolvePackage config gpd
-    pure LocalPackage
-        { lpPackage = package
-        , lpWanted = False -- HACK: makes it so that sdist output goes to a log instead of a file.
-        , lpCabalFile = cabalfp
-        -- NOTE: these aren't the 'correct values, but aren't used in
-        -- the usage of this function in this module.
-        , lpTestBench = Nothing
-        , lpBuildHaddocks = False
-        , lpForceDirty = False
-        , lpDirtyFiles = pure Nothing
-        , lpNewBuildCaches = pure Map.empty
-        , lpComponentFiles = pure Map.empty
-        , lpComponents = Set.empty
-        , lpUnbuildable = Set.empty
-        }
+  config  <- getDefaultPackageConfig
+  (gpdio, _, cabalfp) <- loadCabalFilePath (Just stackProgName') pkgDir
+  gpd <- liftIO $ gpdio YesPrintWarnings
+  let package = resolvePackage config gpd
+  pure LocalPackage
+    { lpPackage = package
+    , lpWanted = False -- HACK: makes it so that sdist output goes to a log instead of a file.
+    , lpCabalFile = cabalfp
+    -- NOTE: these aren't the 'correct values, but aren't used in
+    -- the usage of this function in this module.
+    , lpTestBench = Nothing
+    , lpBuildHaddocks = False
+    , lpForceDirty = False
+    , lpDirtyFiles = pure Nothing
+    , lpNewBuildCaches = pure Map.empty
+    , lpComponentFiles = pure Map.empty
+    , lpComponents = Set.empty
+    , lpUnbuildable = Set.empty
+    }
 
 -- | Returns a newline-separate list of paths, and the absolute path to the
 -- Cabal file.
-getSDistFileList :: HasEnvConfig env => LocalPackage -> Map PackageIdentifier GhcPkgId -> RIO env (String, Path Abs File)
+getSDistFileList ::
+     HasEnvConfig env
+  => LocalPackage
+  -> Map PackageIdentifier GhcPkgId
+  -> RIO env (String, Path Abs File)
 getSDistFileList lp deps =
-    withSystemTempDir (stackProgName <> "-sdist") $ \tmpdir -> do
-        let bopts = defaultBuildOpts
-        let boptsCli = defaultBuildOptsCLI
-        baseConfigOpts <- mkBaseConfigOpts boptsCli
-        locals <- projectLocalPackages
-        withExecuteEnv bopts boptsCli baseConfigOpts locals
-            [] [] [] Nothing -- provide empty list of globals. This is a hack around custom Setup.hs files
-            $ \ee ->
-            withSingleContext ac ee task deps (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _outputType -> do
-                let outFile = toFilePath tmpdir FP.</> "source-files-list"
-                cabal CloseOnException KeepTHLoading ["sdist", "--list-sources", outFile]
-                contents <- liftIO (S.readFile outFile)
-                pure (T.unpack $ T.decodeUtf8With T.lenientDecode contents, cabalfp)
-  where
-    package = lpPackage lp
-    ac = ActionContext Set.empty [] ConcurrencyAllowed
-    task = Task
-        { taskProvides = PackageIdentifier (packageName package) (packageVersion package)
-        , taskType = TTLocalMutable lp
-        , taskConfigOpts = TaskConfigOpts
-            { tcoMissing = Set.empty
-            , tcoOpts = \_ -> ConfigureOpts [] []
-            }
-        , taskBuildHaddock = False
-        , taskPresent = Map.empty
-        , taskAllInOne = True
-        , taskCachePkgSrc = CacheSrcLocal (toFilePath (parent $ lpCabalFile lp))
-        , taskAnyMissing = True
-        , taskBuildTypeConfig = False
+  withSystemTempDir (stackProgName <> "-sdist") $ \tmpdir -> do
+    let bopts = defaultBuildOpts
+    let boptsCli = defaultBuildOptsCLI
+    baseConfigOpts <- mkBaseConfigOpts boptsCli
+    locals <- projectLocalPackages
+    withExecuteEnv bopts boptsCli baseConfigOpts locals
+      [] [] [] Nothing -- provide empty list of globals. This is a hack around custom Setup.hs files
+      $ \ee ->
+      withSingleContext ac ee task deps (Just "sdist") $
+        \_package cabalfp _pkgDir cabal _announce _outputType -> do
+          let outFile = toFilePath tmpdir FP.</> "source-files-list"
+          cabal
+            CloseOnException
+            KeepTHLoading
+            ["sdist", "--list-sources", outFile]
+          contents <- liftIO (S.readFile outFile)
+          pure (T.unpack $ T.decodeUtf8With T.lenientDecode contents, cabalfp)
+ where
+  package = lpPackage lp
+  ac = ActionContext Set.empty [] ConcurrencyAllowed
+  task = Task
+    { taskProvides =
+        PackageIdentifier (packageName package) (packageVersion package)
+    , taskType = TTLocalMutable lp
+    , taskConfigOpts = TaskConfigOpts
+        { tcoMissing = Set.empty
+        , tcoOpts = \_ -> ConfigureOpts [] []
         }
+    , taskBuildHaddock = False
+    , taskPresent = Map.empty
+    , taskAllInOne = True
+    , taskCachePkgSrc = CacheSrcLocal (toFilePath (parent $ lpCabalFile lp))
+    , taskAnyMissing = True
+    , taskBuildTypeConfig = False
+    }
 
-normalizeTarballPaths :: HasRunner env => [FilePath] -> RIO env [FilePath]
+normalizeTarballPaths ::
+     (HasRunner env, HasTerm env)
+  => [FilePath]
+  -> RIO env [FilePath]
 normalizeTarballPaths fps = do
-    -- TODO: consider whether erroring out is better - otherwise the
-    -- user might upload an incomplete tar?
-    unless (null outsideDir) $
-        logWarn $
-            "Warning: These files are outside of the package directory, and will be omitted from the tarball: " <>
-            displayShow outsideDir
-    pure (nubOrd files)
-  where
-    (outsideDir, files) = partitionEithers (map pathToEither fps)
-    pathToEither fp = maybe (Left fp) Right (normalizePath fp)
+  -- TODO: consider whether erroring out is better - otherwise the
+  -- user might upload an incomplete tar?
+  unless (null outsideDir) $
+    prettyWarn $
+         flow "These files are outside of the package directory, and will be \
+              \omitted from the tarball:"
+      <> line
+      <> bulletedList (map (style File . fromString) outsideDir)
+  pure (nubOrd files)
+ where
+  (outsideDir, files) = partitionEithers (map pathToEither fps)
+  pathToEither fp = maybe (Left fp) Right (normalizePath fp)
 
 normalizePath :: FilePath -> Maybe FilePath
 normalizePath = fmap FP.joinPath . go . FP.splitDirectories . FP.normalise
-  where
-    go [] = Just []
-    go ("..":_) = Nothing
-    go (_:"..":xs) = go xs
-    go (x:xs) = (x :) <$> go xs
+ where
+  go [] = Just []
+  go ("..":_) = Nothing
+  go (_:"..":xs) = go xs
+  go (x:xs) = (x :) <$> go xs
 
 dirsFromFiles :: [FilePath] -> [FilePath]
 dirsFromFiles dirs = Set.toAscList (Set.delete "." results)
-  where
-    results = foldl' (\s -> go s . FP.takeDirectory) Set.empty dirs
-    go s x
-      | Set.member x s = s
-      | otherwise = go (Set.insert x s) (FP.takeDirectory x)
+ where
+  results = foldl' (\s -> go s . FP.takeDirectory) Set.empty dirs
+  go s x
+    | Set.member x s = s
+    | otherwise = go (Set.insert x s) (FP.takeDirectory x)
 
 -- | Check package in given tarball. This will log all warnings
 -- and will throw an exception in case of critical errors.
 --
 -- Note that we temporarily decompress the archive to analyze it.
-checkSDistTarball
-  :: HasEnvConfig env
+checkSDistTarball ::
+     HasEnvConfig env
   => SDistOpts -- ^ The configuration of what to check
   -> Path Abs File -- ^ Absolute path to tarball
   -> RIO env ()
 checkSDistTarball opts tarball = withTempTarGzContents tarball $ \pkgDir' -> do
-    pkgDir  <- (pkgDir' </>) `liftM`
-        (parseRelDir . FP.takeBaseName . FP.takeBaseName . toFilePath $ tarball)
-    --               ^ drop ".tar"     ^ drop ".gz"
-    when (sdoptsBuildTarball opts) (buildExtractedTarball ResolvedPath
-                                      { resolvedRelative = RelFilePath "this-is-not-used" -- ugly hack
-                                      , resolvedAbsolute = pkgDir
-                                      })
-    unless (sdoptsIgnoreCheck opts) (checkPackageInExtractedTarball pkgDir)
+  pkgDir  <- (pkgDir' </>) <$>
+    (parseRelDir . FP.takeBaseName . FP.takeBaseName . toFilePath $ tarball)
+  --               ^ drop ".tar"     ^ drop ".gz"
+  when (sdoptsBuildTarball opts)
+    ( buildExtractedTarball ResolvedPath
+        { resolvedRelative = RelFilePath "this-is-not-used" -- ugly hack
+        , resolvedAbsolute = pkgDir
+        }
+    )
+  unless (sdoptsIgnoreCheck opts) (checkPackageInExtractedTarball pkgDir)
 
-checkPackageInExtractedTarball
-  :: HasEnvConfig env
+checkPackageInExtractedTarball ::
+     HasEnvConfig env
   => Path Abs Dir -- ^ Absolute path to tarball
   -> RIO env ()
 checkPackageInExtractedTarball pkgDir = do
-    (gpdio, name, _cabalfp) <- loadCabalFilePath (Just stackProgName') pkgDir
-    gpd <- liftIO $ gpdio YesPrintWarnings
-    config  <- getDefaultPackageConfig
-    let PackageDescriptionPair pkgDesc _ = resolvePackageDescription config gpd
-    logInfo $
-        "Checking package '" <> fromString (packageNameString name) <> "' for common mistakes"
-    let pkgChecks =
-          -- MSS 2017-12-12: Try out a few different variants of
-          -- pkgDesc to try and provoke an error or warning. I don't
-          -- know why, but when using `Just pkgDesc`, it appears that
-          -- Cabal does not detect that `^>=` is used with
-          -- `cabal-version: 1.24` or earlier. It seems like pkgDesc
-          -- (the one we create) does not populate the `buildDepends`
-          -- field, whereas flattenPackageDescription from Cabal
-          -- does. In any event, using `Nothing` seems more logical
-          -- for this check anyway, and the fallback to `Just pkgDesc`
-          -- is just a crazy sanity check.
-          case Check.checkPackage gpd Nothing of
-            [] -> Check.checkPackage gpd (Just pkgDesc)
-            x -> x
-    fileChecks <- liftIO $ Check.checkPackageFiles minBound pkgDesc (toFilePath pkgDir)
-    let checks = pkgChecks ++ fileChecks
-        (errors, warnings) =
-          let criticalIssue (Check.PackageBuildImpossible _) = True
-              criticalIssue (Check.PackageDistInexcusable _) = True
-              criticalIssue _ = False
-          in List.partition criticalIssue checks
-    unless (null warnings) $
-        logWarn $ "Package check reported the following warnings:\n" <>
-                   mconcat (List.intersperse "\n" . fmap displayShow $ warnings)
-    case NE.nonEmpty errors of
-        Nothing -> pure ()
-        Just ne -> throwM $ CheckException ne
+  (gpdio, name, _cabalfp) <- loadCabalFilePath (Just stackProgName') pkgDir
+  gpd <- liftIO $ gpdio YesPrintWarnings
+  config  <- getDefaultPackageConfig
+  let PackageDescriptionPair pkgDesc _ = resolvePackageDescription config gpd
+  prettyInfoL
+    [ flow "Checking package"
+    , style Current (fromString $ packageNameString name)
+    , flow "for common mistakes."
+    ]
+  let pkgChecks =
+        -- MSS 2017-12-12: Try out a few different variants of
+        -- pkgDesc to try and provoke an error or warning. I don't
+        -- know why, but when using `Just pkgDesc`, it appears that
+        -- Cabal does not detect that `^>=` is used with
+        -- `cabal-version: 1.24` or earlier. It seems like pkgDesc
+        -- (the one we create) does not populate the `buildDepends`
+        -- field, whereas flattenPackageDescription from Cabal
+        -- does. In any event, using `Nothing` seems more logical
+        -- for this check anyway, and the fallback to `Just pkgDesc`
+        -- is just a crazy sanity check.
+        case Check.checkPackage gpd Nothing of
+          [] -> Check.checkPackage gpd (Just pkgDesc)
+          x -> x
+  fileChecks <- liftIO $ Check.checkPackageFiles minBound pkgDesc (toFilePath pkgDir)
+  let checks = pkgChecks ++ fileChecks
+      (errors, warnings) =
+        let criticalIssue (Check.PackageBuildImpossible _) = True
+            criticalIssue (Check.PackageDistInexcusable _) = True
+            criticalIssue _ = False
+        in  List.partition criticalIssue checks
+  unless (null warnings) $
+    prettyWarn $
+         flow "Package check reported the following warnings:"
+      <> line
+      <> bulletedList (map (fromString . show) warnings)
+  case NE.nonEmpty errors of
+    Nothing -> pure ()
+    Just ne -> throwM $ CheckException ne
 
 buildExtractedTarball :: HasEnvConfig env => ResolvedPath Dir -> RIO env ()
 buildExtractedTarball pkgDir = do
@@ -481,7 +581,9 @@   -- We remove the path based on the name of the package
   let isPathToRemove path = do
         localPackage <- readLocalPackage path
-        pure $ packageName (lpPackage localPackage) == packageName (lpPackage localPackageToBuild)
+        pure
+          $  packageName (lpPackage localPackage)
+          == packageName (lpPackage localPackageToBuild)
   pathsToKeep
     <- fmap Map.fromList
      $ flip filterM (Map.toList (smwProject (bcSMWanted (envConfigBuildConfig envConfig))))
@@ -489,39 +591,43 @@   pp <- mkProjectPackage YesPrintWarnings pkgDir False
   let adjustEnvForBuild env =
         let updatedEnvConfig = envConfig
-              { envConfigSourceMap = updatePackagesInSourceMap (envConfigSourceMap envConfig)
-              , envConfigBuildConfig = updateBuildConfig (envConfigBuildConfig envConfig)
+              { envConfigSourceMap =
+                  updatePackagesInSourceMap (envConfigSourceMap envConfig)
+              , envConfigBuildConfig =
+                  updateBuildConfig (envConfigBuildConfig envConfig)
               }
             updateBuildConfig bc = bc
               { bcConfig = (bcConfig bc)
                  { configBuild = defaultBuildOpts { boptsTests = True } }
               }
-        in set envConfigL updatedEnvConfig env
+        in  set envConfigL updatedEnvConfig env
       updatePackagesInSourceMap sm =
         sm {smProject = Map.insert (cpName $ ppCommon pp) pp pathsToKeep}
   local adjustEnvForBuild $ build Nothing
 
 -- | Version of 'checkSDistTarball' that first saves lazy bytestring to
 -- temporary directory and then calls 'checkSDistTarball' on it.
-checkSDistTarball'
-  :: HasEnvConfig env
+checkSDistTarball' ::
+     HasEnvConfig env
   => SDistOpts
   -> String       -- ^ Tarball name
   -> L.ByteString -- ^ Tarball contents as a byte string
   -> RIO env ()
 checkSDistTarball' opts name bytes = withSystemTempDir "stack" $ \tpath -> do
-    npath   <- (tpath </>) `liftM` parseRelFile name
-    liftIO $ L.writeFile (toFilePath npath) bytes
-    checkSDistTarball opts npath
+  npath   <- (tpath </>) <$> parseRelFile name
+  liftIO $ L.writeFile (toFilePath npath) bytes
+  checkSDistTarball opts npath
 
-withTempTarGzContents
-  :: Path Abs File                     -- ^ Location of tarball
-  -> (Path Abs Dir -> RIO env a) -- ^ Perform actions given dir with tarball contents
+withTempTarGzContents ::
+     Path Abs File
+     -- ^ Location of tarball
+  -> (Path Abs Dir -> RIO env a)
+     -- ^ Perform actions given dir with tarball contents
   -> RIO env a
 withTempTarGzContents apath f = withSystemTempDir "stack" $ \tpath -> do
-    archive <- liftIO $ L.readFile (toFilePath apath)
-    liftIO . Tar.unpack (toFilePath tpath) . Tar.read . GZip.decompress $ archive
-    f tpath
+  archive <- liftIO $ L.readFile (toFilePath apath)
+  liftIO . Tar.unpack (toFilePath tpath) . Tar.read . GZip.decompress $ archive
+  f tpath
 
 --------------------------------------------------------------------------------
 
@@ -537,15 +643,16 @@   content <- S.readFile filepath
   let size = fromIntegral (S.length content)
   pure (Tar.simpleEntry tarpath (Tar.NormalFile (L.fromStrict content) size)) {
-    Tar.entryPermissions = if executable perms then Tar.executableFilePermissions
-                                               else Tar.ordinaryFilePermissions,
+    Tar.entryPermissions = if executable perms
+                             then Tar.executableFilePermissions
+                             else Tar.ordinaryFilePermissions,
     Tar.entryTime = mtime
   }
 
 getModTime :: FilePath -> IO Tar.EpochTime
 getModTime path = do
-    t <- getModificationTime path
-    pure . floor . utcTimeToPOSIXSeconds $ t
+  t <- getModificationTime path
+  pure $ floor . utcTimeToPOSIXSeconds $ t
 
 getDefaultPackageConfig :: (MonadIO m, MonadReader env m, HasEnvConfig env)
   => m PackageConfig
src/Stack/Script.hs view
@@ -2,9 +2,14 @@ {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
+
+-- Types and functions related to Stack's @script@ command.
 module Stack.Script
-    ( scriptCmd
-    ) where
+  ( ScriptOpts (..)
+  , ScriptExecute (..)
+  , ShouldRun (..)
+  , scriptCmd
+  ) where
 
 import           Data.ByteString.Builder ( toLazyByteString )
 import qualified Data.ByteString.Char8 as S8
@@ -21,119 +26,202 @@ import           Distribution.Types.VersionRange ( withinRange )
 import           Distribution.System ( Platform (..) )
 import qualified Pantry.SHA256 as SHA256
-import           Path ( parent )
+import           Path
+                   ( (</>), filename, fromAbsDir, fromAbsFile, fromRelFile
+                   , parent, parseRelDir, replaceExtension, splitExtension
+                   )
 import           Path.IO ( getModificationTime, resolveFile' )
 import qualified RIO.Directory as Dir
 import           RIO.Process ( exec, proc, readProcessStdout_, withWorkingDir )
 import qualified RIO.Text as T
-import qualified Stack.Build
-import           Stack.Build.Installed
-import           Stack.Constants ( osIsWindows )
-import           Stack.PackageDump
+import           Stack.Build ( build )
+import           Stack.Build.Installed ( getInstalled, toInstallMap )
+import           Stack.Constants ( osIsWindows, relDirScripts )
 import           Stack.Prelude
-import           Stack.Options.ScriptParser
 import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
 import           Stack.Setup ( withNewLocalBuildTargets )
 import           Stack.SourceMap ( getCompilerInfo, immutableLocSha )
-import           Stack.Types.Compiler
-import           Stack.Types.Config
+import           Stack.Types.Compiler ( ActualCompiler (..) )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), GhcPkgExe (..), HasCompiler (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..), stackRootL )
+import           Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL
+                   , appropriateGhcColorFlag
+                   )
+import           Stack.Types.EnvSettings ( defaultEnvSettings )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( Runner, globalOptsL )
 import           Stack.Types.SourceMap
-import           System.FilePath ( dropExtension, replaceExtension )
+                   ( CommonPackage (..), DepPackage (..), SourceMap (..) )
+import           Stack.Types.StackYamlLoc ( StackYamlLoc (..) )
+import           System.FilePath ( splitDrive )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Script" module.
 data ScriptException
-    = MutableDependenciesForScript [PackageName]
-    | AmbiguousModuleName ModuleName [PackageName]
-    | ArgumentsWithNoRunInvalid
-    | NoRunWithoutCompilationInvalid
+  = MutableDependenciesForScript [PackageName]
+  | AmbiguousModuleName ModuleName [PackageName]
+  | ArgumentsWithNoRunInvalid
+  | NoRunWithoutCompilationInvalid
+  | FailedToParseScriptFileAsDirBug (Path Rel File)
+  | FailedToParseFileAsDirBug (Path Abs Dir)
   deriving (Show, Typeable)
 
 instance Exception ScriptException where
-    displayException (MutableDependenciesForScript names) = unlines
-        $ "Error: [S-4994]"
-        : "No mutable packages are allowed in the 'script' command. Mutable \
-          \packages found:"
-        : map (\name -> "- " ++ packageNameString name) names
-    displayException (AmbiguousModuleName mname pkgs) = unlines
-        $ "Error: [S-1691]"
-        : (  "Module "
-          ++ moduleNameString mname
-          ++ " appears in multiple packages: "
-          )
-        : [ unwords $ map packageNameString pkgs ]
-    displayException ArgumentsWithNoRunInvalid =
-        "Error: [S-5067]\n"
-        ++ "'--no-run' incompatible with arguments."
-    displayException NoRunWithoutCompilationInvalid =
-        "Error: [S-9469]\n"
-        ++ "'--no-run' requires either '--compile' or '--optimize'."
+  displayException (MutableDependenciesForScript names) = unlines
+    $ "Error: [S-4994]"
+    : "No mutable packages are allowed in the 'script' command. Mutable \
+      \packages found:"
+    : map (\name -> "- " ++ packageNameString name) names
+  displayException (AmbiguousModuleName mname pkgs) = unlines
+    $ "Error: [S-1691]"
+    : (  "Module "
+      ++ moduleNameString mname
+      ++ " appears in multiple packages: "
+      )
+    : [ unwords $ map packageNameString pkgs ]
+  displayException ArgumentsWithNoRunInvalid =
+    "Error: [S-5067]\n"
+    ++ "'--no-run' incompatible with arguments."
+  displayException NoRunWithoutCompilationInvalid =
+    "Error: [S-9469]\n"
+    ++ "'--no-run' requires either '--compile' or '--optimize'."
+  displayException (FailedToParseScriptFileAsDirBug fp) = bugReport "[S-5055]" $
+       "Failed to parse script file name as directory:\n"
+    <> fromRelFile fp <> "\n"
+  displayException (FailedToParseFileAsDirBug p) = bugReport "[S-9464]" $
+       "Failed to parse path to script file as directory:\n"
+    <> fromAbsDir p <> "\n"
 
+-- | Type representing choices of interpreting, compiling (without optimisation)
+-- and compiling (with optimisation).
+data ScriptExecute
+  = SEInterpret
+  | SECompile
+    -- ^ Without optimisation.
+  | SEOptimize
+    -- ^ Compile with optimisation.
+  deriving Show
+
+-- | Type representing choices of whether to run or not.
+data ShouldRun
+  = YesRun
+    -- ^ Run.
+  | NoRun
+    -- ^ Do not run.
+  deriving Show
+
+-- | Type representing command line options for the @stack script@ command.
+data ScriptOpts = ScriptOpts
+  { soPackages :: ![String]
+  , soFile :: !FilePath
+  , soArgs :: ![String]
+  , soCompile :: !ScriptExecute
+  , soUseRoot :: !Bool
+  , soGhcOptions :: ![String]
+  , soScriptExtraDeps :: ![PackageIdentifierRevision]
+  , soShouldRun :: !ShouldRun
+  }
+  deriving Show
+
 -- | Run a Stack Script
 scriptCmd :: ScriptOpts -> RIO Runner ()
 scriptCmd opts = do
-    -- Some warnings in case the user somehow tries to set a
-    -- stack.yaml location. Note that in this functions we use
-    -- logError instead of logWarn because, when using the
-    -- interpreter mode, only error messages are shown. See:
-    -- https://github.com/commercialhaskell/stack/issues/3007
-    view (globalOptsL.to globalStackYaml) >>= \case
-      SYLOverride fp -> logError $
-        "Ignoring override stack.yaml file for script command: " <>
-        fromString (toFilePath fp)
-      SYLGlobalProject -> logError "Ignoring SYLGlobalProject for script command"
-      SYLDefault -> pure ()
-      SYLNoProject _ -> assert False (pure ())
+  -- Some warnings in case the user somehow tries to set a stack.yaml location.
+  -- Note that in this functions we use logError instead of logWarn because,
+  -- when using the interpreter mode, only error messages are shown. See:
+  -- https://github.com/commercialhaskell/stack/issues/3007
+  view (globalOptsL.to globalStackYaml) >>= \case
+    SYLOverride fp -> logError $
+         "Ignoring override stack.yaml file for script command: "
+      <> fromString (toFilePath fp)
+    SYLGlobalProject -> logError "Ignoring SYLGlobalProject for script command"
+    SYLDefault -> pure ()
+    SYLNoProject _ -> assert False (pure ())
 
-    file <- resolveFile' $ soFile opts
+  file <- resolveFile' $ soFile opts
+  let scriptFile = filename file
 
-    isNoRunCompile <- fromFirstFalse . configMonoidNoRunCompile <$>
-                             view (globalOptsL.to globalConfigMonoid)
+  isNoRunCompile <- fromFirstFalse . configMonoidNoRunCompile <$>
+                           view (globalOptsL.to globalConfigMonoid)
 
-    let scriptDir = parent file
-        modifyGO go = go
-            { globalConfigMonoid = (globalConfigMonoid go)
-                { configMonoidInstallGHC = FirstTrue $ Just True
-                }
-            , globalStackYaml = SYLNoProject $ soScriptExtraDeps opts
+  let scriptDir = parent file
+      modifyGO go = go
+        { globalConfigMonoid = (globalConfigMonoid go)
+            { configMonoidInstallGHC = FirstTrue $ Just True
             }
-        (shouldRun, shouldCompile) = if isNoRunCompile
-          then (NoRun, SECompile)
-          else (soShouldRun opts, soCompile opts)
+        , globalStackYaml = SYLNoProject $ soScriptExtraDeps opts
+        }
+      (shouldRun, shouldCompile) = if isNoRunCompile
+        then (NoRun, SECompile)
+        else (soShouldRun opts, soCompile opts)
 
-    case shouldRun of
-      YesRun -> pure ()
-      NoRun -> do
-        unless (null $ soArgs opts) $ throwIO ArgumentsWithNoRunInvalid
-        case shouldCompile of
-          SEInterpret -> throwIO NoRunWithoutCompilationInvalid
-          SECompile -> pure ()
-          SEOptimize -> pure ()
+  root <- withConfig NoReexec $ view stackRootL
+  outputDir <- if soUseRoot opts
+    then do
+      scriptFileAsDir <- maybe
+        (throwIO $ FailedToParseScriptFileAsDirBug scriptFile)
+        pure
+        (parseRelDir $ fromRelFile scriptFile)
+      let fileAsDir = scriptDir </> scriptFileAsDir
+          -- We drop the information about the drive. On Windows, in principle,
+          -- the drive could distinguish between two otherwise identical
+          -- fileAsDir (eg C:\MyScript.hs\ D:\MyScript.hs\). In pactice, we
+          -- tolerate that possibility as being unlikely.
+          (_, escaped) = splitDrive (fromAbsDir fileAsDir)
+      escapedRelDir <- maybe
+        (throwIO $ FailedToParseFileAsDirBug fileAsDir)
+        pure
+        (parseRelDir escaped)
+      pure $ root </> relDirScripts </> escapedRelDir
+    else pure scriptDir
 
-    -- Optimization: if we're compiling, and the executable is newer
-    -- than the source file, run it immediately.
-    local (over globalOptsL modifyGO) $
+  let dropExtension path = fst <$> splitExtension path
+
+  exe <- if osIsWindows
+    then replaceExtension ".exe" (outputDir </> scriptFile)
+    else dropExtension (outputDir </> scriptFile)
+
+  case shouldRun of
+    YesRun -> pure ()
+    NoRun -> do
+      unless (null $ soArgs opts) $ throwIO ArgumentsWithNoRunInvalid
       case shouldCompile of
-        SEInterpret -> longWay shouldRun shouldCompile file scriptDir
-        SECompile -> shortCut shouldRun shouldCompile file scriptDir
-        SEOptimize -> shortCut shouldRun shouldCompile file scriptDir
+        SEInterpret -> throwIO NoRunWithoutCompilationInvalid
+        SECompile -> pure ()
+        SEOptimize -> pure ()
 
-  where
-  runCompiled shouldRun file = do
-    let exeName = toExeName $ toFilePath file
+  -- Optimization: if we're compiling, and the executable is newer than the
+  -- source file, run it immediately.
+  local (over globalOptsL modifyGO) $
+    case shouldCompile of
+      SEInterpret -> longWay shouldRun shouldCompile file exe
+      SECompile -> shortCut shouldRun shouldCompile file exe
+      SEOptimize -> shortCut shouldRun shouldCompile file exe
+
+ where
+  runCompiled shouldRun exe = do
     case shouldRun of
-      YesRun -> exec exeName (soArgs opts)
-      NoRun -> logInfo $ "Compilation finished, executable available at " <> fromString exeName
+      YesRun -> exec (fromAbsFile exe) (soArgs opts)
+      NoRun -> prettyInfoL
+        [ flow "Compilation finished, executable available at"
+        , style File (fromString (fromAbsFile exe)) <> "."
+        ]
 
-  shortCut shouldRun shouldCompile file scriptDir =
-    handleIO (const $ longWay shouldRun shouldCompile file scriptDir) $ do
+  shortCut shouldRun shouldCompile file exe =
+    handleIO (const $ longWay shouldRun shouldCompile file exe) $ do
       srcMod <- getModificationTime file
-      exeMod <- Dir.getModificationTime $ toExeName $ toFilePath file
+      exeMod <- Dir.getModificationTime (fromAbsFile exe)
       if srcMod < exeMod
-        then runCompiled shouldRun file
-        else longWay shouldRun shouldCompile file scriptDir
+        then runCompiled shouldRun exe
+        else longWay shouldRun shouldCompile file exe
 
-  longWay shouldRun shouldCompile file scriptDir =
+  longWay shouldRun shouldCompile file exe =
     withConfig YesReexec $
     withDefaultEnvConfig $ do
       config <- view configL
@@ -142,50 +230,55 @@         colorFlag <- appropriateGhcColorFlag
 
         targetsSet <-
-            case soPackages opts of
-                [] -> do
-                    -- Using the import parser
-                    getPackagesFromImports (soFile opts)
-                packages -> do
-                    let targets = concatMap wordsComma packages
-                    targets' <- mapM parsePackageNameThrowing targets
-                    pure $ Set.fromList targets'
+          case soPackages opts of
+            [] -> getPackagesFromImports (soFile opts) -- Using the import parser
+            packages -> do
+              let targets = concatMap wordsComma packages
+              targets' <- mapM parsePackageNameThrowing targets
+              pure $ Set.fromList targets'
 
         unless (Set.null targetsSet) $ do
-            -- Optimization: use the relatively cheap ghc-pkg list
-            -- --simple-output to check which packages are installed
-            -- already. If all needed packages are available, we can
-            -- skip the (rather expensive) build call below.
-            GhcPkgExe pkg <- view $ compilerPathsL.to cpPkg
-            -- https://github.com/haskell/process/issues/251
-            bss <- snd <$> sinkProcessStderrStdout (toFilePath pkg)
-                ["list", "--simple-output"] CL.sinkNull CL.consume -- FIXME use the package info from envConfigPackages, or is that crazy?
-            let installed = Set.fromList
-                          $ map toPackageName
-                          $ words
-                          $ S8.unpack
-                          $ S8.concat bss
-            if Set.null $ Set.difference (Set.map packageNameString targetsSet) installed
-                then logDebug "All packages already installed"
-                else do
-                    logDebug "Missing packages, performing installation"
-                    let targets = map (T.pack . packageNameString) $ Set.toList targetsSet
-                    withNewLocalBuildTargets targets $ Stack.Build.build Nothing
+          -- Optimization: use the relatively cheap ghc-pkg list --simple-output
+          -- to check which packages are installed already. If all needed
+          -- packages are available, we can skip the (rather expensive) build
+          -- call below.
+          GhcPkgExe pkg <- view $ compilerPathsL.to cpPkg
+          -- https://github.com/haskell/process/issues/251
+          bss <- snd <$> sinkProcessStderrStdout (toFilePath pkg)
+              ["list", "--simple-output"] CL.sinkNull CL.consume -- FIXME use the package info from envConfigPackages, or is that crazy?
+          let installed = Set.fromList
+                        $ map toPackageName
+                        $ words
+                        $ S8.unpack
+                        $ S8.concat bss
+          if Set.null $ Set.difference (Set.map packageNameString targetsSet) installed
+            then logDebug "All packages already installed"
+            else do
+              logDebug "Missing packages, performing installation"
+              let targets =
+                    map (T.pack . packageNameString) $ Set.toList targetsSet
+              withNewLocalBuildTargets targets $ build Nothing
 
         let ghcArgs = concat
-                [ ["-i", "-i" ++ toFilePath scriptDir]
-                , ["-hide-all-packages"]
-                , maybeToList colorFlag
-                , map (\x -> "-package" ++ x)
-                    $ Set.toList
-                    $ Set.insert "base"
-                    $ Set.map packageNameString targetsSet
-                , case shouldCompile of
-                    SEInterpret -> []
-                    SECompile -> []
-                    SEOptimize -> ["-O2"]
-                , soGhcOptions opts
-                ]
+              [ ["-i", "-i" ++ fromAbsDir (parent file)]
+              , ["-hide-all-packages"]
+              , maybeToList colorFlag
+              , map ("-package" ++)
+                  $ Set.toList
+                  $ Set.insert "base"
+                  $ Set.map packageNameString targetsSet
+              , case shouldCompile of
+                  SEInterpret -> []
+                  SECompile -> []
+                  SEOptimize -> ["-O2"]
+              , soGhcOptions opts
+              , if soUseRoot opts
+                  then
+                    [ "-outputdir=" ++ fromAbsDir (parent exe)
+                    , "-o", fromAbsFile exe
+                    ]
+                  else []
+              ]
         case shouldCompile of
           SEInterpret -> do
             interpret <- view $ compilerPathsL.to cpInterpreter
@@ -197,92 +290,89 @@             -- stdout, which could break scripts, and (2) if there's an
             -- exception, the standard output we did capture will be reported
             -- to the user.
+            liftIO $ Dir.createDirectoryIfMissing True (fromAbsDir (parent exe))
             compilerExeName <- view $ compilerPathsL.to cpCompiler.to toFilePath
-            withWorkingDir (toFilePath scriptDir) $ proc
+            withWorkingDir (fromAbsDir (parent file)) $ proc
               compilerExeName
               (ghcArgs ++ [toFilePath file])
               (void . readProcessStdout_)
-            runCompiled shouldRun file
+            runCompiled shouldRun exe
 
   toPackageName = reverse . drop 1 . dropWhile (/= '-') . reverse
 
   -- Like words, but splits on both commas and spaces
   wordsComma = splitWhen (\c -> c == ' ' || c == ',')
 
-  toExeName fp =
-    if osIsWindows
-      then replaceExtension fp "exe"
-      else dropExtension fp
-
-getPackagesFromImports
-  :: FilePath -- ^ script filename
+getPackagesFromImports ::
+     FilePath -- ^ script filename
   -> RIO EnvConfig (Set PackageName)
 getPackagesFromImports scriptFP = do
-    (pns, mns) <- liftIO $ parseImports <$> S8.readFile scriptFP
-    if Set.null mns
-        then pure pns
-        else Set.union pns <$> getPackagesFromModuleNames mns
+  (pns, mns) <- liftIO $ parseImports <$> S8.readFile scriptFP
+  if Set.null mns
+    then pure pns
+    else Set.union pns <$> getPackagesFromModuleNames mns
 
-getPackagesFromModuleNames
-  :: Set ModuleName
+getPackagesFromModuleNames ::
+     Set ModuleName
   -> RIO EnvConfig (Set PackageName)
 getPackagesFromModuleNames mns = do
-    hash <- hashSnapshot
-    withSnapshotCache hash mapSnapshotPackageModules $ \getModulePackages -> do
-        pns <- forM (Set.toList mns) $ \mn -> do
-            pkgs <- getModulePackages mn
-            case pkgs of
-                [] -> pure Set.empty
-                [pn] -> pure $ Set.singleton pn
-                _ -> throwM $ AmbiguousModuleName mn pkgs
-        pure $ Set.unions pns `Set.difference` blacklist
+  hash <- hashSnapshot
+  withSnapshotCache hash mapSnapshotPackageModules $ \getModulePackages -> do
+    pns <- forM (Set.toList mns) $ \mn -> do
+      pkgs <- getModulePackages mn
+      case pkgs of
+        [] -> pure Set.empty
+        [pn] -> pure $ Set.singleton pn
+        _ -> throwM $ AmbiguousModuleName mn pkgs
+    pure $ Set.unions pns `Set.difference` blacklist
 
 hashSnapshot :: RIO EnvConfig SnapshotCacheHash
 hashSnapshot = do
-    sourceMap <- view $ envConfigL . to envConfigSourceMap
-    compilerInfo <- getCompilerInfo
-    let eitherPliHash (pn, dep) | PLImmutable pli <- dpLocation dep =
-                                    Right $ immutableLocSha pli
-                                | otherwise =
-                                    Left pn
-        deps = Map.toList (smDeps sourceMap)
-    case partitionEithers (map eitherPliHash deps) of
-        ([], pliHashes) -> do
-            let hashedContent = mconcat $ compilerInfo : pliHashes
-            pure $ SnapshotCacheHash (SHA256.hashLazyBytes $ toLazyByteString hashedContent)
-        (mutables, _) ->
-            throwM $ MutableDependenciesForScript mutables
+  sourceMap <- view $ envConfigL . to envConfigSourceMap
+  compilerInfo <- getCompilerInfo
+  let eitherPliHash (pn, dep)
+        | PLImmutable pli <- dpLocation dep = Right $ immutableLocSha pli
+        | otherwise = Left pn
+      deps = Map.toList (smDeps sourceMap)
+  case partitionEithers (map eitherPliHash deps) of
+    ([], pliHashes) -> do
+      let hashedContent = mconcat $ compilerInfo : pliHashes
+      pure
+        $ SnapshotCacheHash (SHA256.hashLazyBytes
+        $ toLazyByteString hashedContent)
+    (mutables, _) -> throwM $ MutableDependenciesForScript mutables
 
 mapSnapshotPackageModules :: RIO EnvConfig (Map PackageName (Set ModuleName))
 mapSnapshotPackageModules = do
-    sourceMap <- view $ envConfigL . to envConfigSourceMap
-    installMap <- toInstallMap sourceMap
-    (_installedMap, globalDumpPkgs, snapshotDumpPkgs, _localDumpPkgs) <-
-        getInstalled installMap
-    let globals = dumpedPackageModules (smGlobal sourceMap) globalDumpPkgs
-        notHidden = Map.filter (not . dpHidden)
-        notHiddenDeps = notHidden $ smDeps sourceMap
-        installedDeps = dumpedPackageModules notHiddenDeps snapshotDumpPkgs
-        dumpPkgs = Set.fromList $ map (pkgName . dpPackageIdent) snapshotDumpPkgs
-        notInstalledDeps = Map.withoutKeys notHiddenDeps dumpPkgs
-    otherDeps <- for notInstalledDeps $ \dep -> do
-        gpd <- liftIO $ cpGPD (dpCommon dep)
-        Set.fromList <$> allExposedModules gpd
-    -- source map construction process should guarantee unique package names
-    -- in these maps
-    pure $ globals <> installedDeps <> otherDeps
+  sourceMap <- view $ envConfigL . to envConfigSourceMap
+  installMap <- toInstallMap sourceMap
+  (_installedMap, globalDumpPkgs, snapshotDumpPkgs, _localDumpPkgs) <-
+    getInstalled installMap
+  let globals = dumpedPackageModules (smGlobal sourceMap) globalDumpPkgs
+      notHidden = Map.filter (not . dpHidden)
+      notHiddenDeps = notHidden $ smDeps sourceMap
+      installedDeps = dumpedPackageModules notHiddenDeps snapshotDumpPkgs
+      dumpPkgs = Set.fromList $ map (pkgName . dpPackageIdent) snapshotDumpPkgs
+      notInstalledDeps = Map.withoutKeys notHiddenDeps dumpPkgs
+  otherDeps <- for notInstalledDeps $ \dep -> do
+    gpd <- liftIO $ cpGPD (dpCommon dep)
+    Set.fromList <$> allExposedModules gpd
+  -- source map construction process should guarantee unique package names in
+  -- these maps
+  pure $ globals <> installedDeps <> otherDeps
 
-dumpedPackageModules :: Map PackageName a
-                     -> [DumpPackage]
-                     -> Map PackageName (Set ModuleName)
+dumpedPackageModules ::
+     Map PackageName a
+  -> [DumpPackage]
+  -> Map PackageName (Set ModuleName)
 dumpedPackageModules pkgs dumpPkgs =
-    let pnames = Map.keysSet pkgs `Set.difference` blacklist
-    in Map.fromList
-           [ (pn, dpExposedModules)
-           | DumpPackage {..} <- dumpPkgs
-           , let PackageIdentifier pn _ = dpPackageIdent
-           , pn `Set.member` pnames
-           ]
+  let pnames = Map.keysSet pkgs `Set.difference` blacklist
+  in  Map.fromList
+        [ (pn, dpExposedModules)
+        | DumpPackage {..} <- dumpPkgs
+        , let PackageIdentifier pn _ = dpPackageIdent
+        , pn `Set.member` pnames
+        ]
 
 allExposedModules :: PD.GenericPackageDescription -> RIO EnvConfig [ModuleName]
 allExposedModules gpd = do
@@ -303,86 +393,86 @@                 map moduleReexportName (PD.reexportedModules lib)
     Nothing  -> mempty
 
--- | The Stackage project introduced the concept of hidden packages,
--- to deal with conflicting module names. However, this is a
--- relatively recent addition (at time of writing). See:
--- http://www.snoyman.com/blog/2017/01/conflicting-module-names. To
--- kick this thing off a bit better, we're included a blacklist of
--- packages that should never be auto-parsed in.
+-- | The Stackage project introduced the concept of hidden packages, to deal
+-- with conflicting module names. However, this is a relatively recent addition
+-- (at time of writing). See:
+-- http://www.snoyman.com/blog/2017/01/conflicting-module-names. To kick this
+-- thing off a bit better, we're included a blacklist of packages that should
+-- never be auto-parsed in.
 blacklist :: Set PackageName
 blacklist = Set.fromList
-    [ mkPackageName "async-dejafu"
-    , mkPackageName "monads-tf"
-    , mkPackageName "crypto-api"
-    , mkPackageName "fay-base"
-    , mkPackageName "hashmap"
-    , mkPackageName "hxt-unicode"
-    , mkPackageName "hledger-web"
-    , mkPackageName "plot-gtk3"
-    , mkPackageName "gtk3"
-    , mkPackageName "regex-pcre-builtin"
-    , mkPackageName "regex-compat-tdfa"
-    , mkPackageName "log"
-    , mkPackageName "zip"
-    , mkPackageName "monad-extras"
-    , mkPackageName "control-monad-free"
-    , mkPackageName "prompt"
-    , mkPackageName "kawhi"
-    , mkPackageName "language-c"
-    , mkPackageName "gl"
-    , mkPackageName "svg-tree"
-    , mkPackageName "Glob"
-    , mkPackageName "nanospec"
-    , mkPackageName "HTF"
-    , mkPackageName "courier"
-    , mkPackageName "newtype-generics"
-    , mkPackageName "objective"
-    , mkPackageName "binary-ieee754"
-    , mkPackageName "rerebase"
-    , mkPackageName "cipher-aes"
-    , mkPackageName "cipher-blowfish"
-    , mkPackageName "cipher-camellia"
-    , mkPackageName "cipher-des"
-    , mkPackageName "cipher-rc4"
-    , mkPackageName "crypto-cipher-types"
-    , mkPackageName "crypto-numbers"
-    , mkPackageName "crypto-pubkey"
-    , mkPackageName "crypto-random"
-    , mkPackageName "cryptohash"
-    , mkPackageName "cryptohash-conduit"
-    , mkPackageName "cryptohash-md5"
-    , mkPackageName "cryptohash-sha1"
-    , mkPackageName "cryptohash-sha256"
-    ]
+  [ mkPackageName "Glob"
+  , mkPackageName "HTF"
+  , mkPackageName "async-dejafu"
+  , mkPackageName "binary-ieee754"
+  , mkPackageName "cipher-aes"
+  , mkPackageName "cipher-blowfish"
+  , mkPackageName "cipher-camellia"
+  , mkPackageName "cipher-des"
+  , mkPackageName "cipher-rc4"
+  , mkPackageName "control-monad-free"
+  , mkPackageName "courier"
+  , mkPackageName "crypto-api"
+  , mkPackageName "crypto-cipher-types"
+  , mkPackageName "crypto-numbers"
+  , mkPackageName "crypto-pubkey"
+  , mkPackageName "crypto-random"
+  , mkPackageName "cryptohash"
+  , mkPackageName "cryptohash-conduit"
+  , mkPackageName "cryptohash-md5"
+  , mkPackageName "cryptohash-sha1"
+  , mkPackageName "cryptohash-sha256"
+  , mkPackageName "fay-base"
+  , mkPackageName "gl"
+  , mkPackageName "gtk3"
+  , mkPackageName "hashmap"
+  , mkPackageName "hledger-web"
+  , mkPackageName "hxt-unicode"
+  , mkPackageName "kawhi"
+  , mkPackageName "language-c"
+  , mkPackageName "log"
+  , mkPackageName "monad-extras"
+  , mkPackageName "monads-tf"
+  , mkPackageName "nanospec"
+  , mkPackageName "newtype-generics"
+  , mkPackageName "objective"
+  , mkPackageName "plot-gtk3"
+  , mkPackageName "prompt"
+  , mkPackageName "regex-compat-tdfa"
+  , mkPackageName "regex-pcre-builtin"
+  , mkPackageName "rerebase"
+  , mkPackageName "svg-tree"
+  , mkPackageName "zip"
+  ]
 
 parseImports :: ByteString -> (Set PackageName, Set ModuleName)
 parseImports =
-    fold . mapMaybe (parseLine . stripCR') . S8.lines
-  where
-    -- Remove any carriage pure character present at the end, to
-    -- support Windows-style line endings (CRLF)
-    stripCR' bs
-      | S8.null bs = bs
-      | S8.last bs == '\r' = S8.init bs
-      | otherwise = bs
+  fold . mapMaybe (parseLine . stripCR') . S8.lines
+ where
+  -- Remove any carriage pure character present at the end, to support
+  -- Windows-style line endings (CRLF)
+  stripCR' bs
+    | S8.null bs = bs
+    | S8.last bs == '\r' = S8.init bs
+    | otherwise = bs
 
-    stripPrefix x y
-      | x `S8.isPrefixOf` y = Just $ S8.drop (S8.length x) y
-      | otherwise = Nothing
+  stripPrefix x y
+    | x `S8.isPrefixOf` y = Just $ S8.drop (S8.length x) y
+    | otherwise = Nothing
 
-    parseLine bs0 = do
-        bs1 <- stripPrefix "import " bs0
-        let bs2 = S8.dropWhile (== ' ') bs1
-            bs3 = fromMaybe bs2 $ stripPrefix "qualified " bs2
-        case stripPrefix "\"" bs3 of
-            Just bs4 -> do
-                pn <- parsePackageNameThrowing $ S8.unpack $ S8.takeWhile (/= '"') bs4
-                Just (Set.singleton pn, Set.empty)
-            Nothing -> Just
-                ( Set.empty
-                , Set.singleton
-                    $ fromString
-                    $ T.unpack
-                    $ decodeUtf8With lenientDecode
-                    $ S8.takeWhile (\c -> c /= ' ' && c /= '(') bs3
-                )
+  parseLine bs0 = do
+    bs1 <- stripPrefix "import " bs0
+    let bs2 = S8.dropWhile (== ' ') bs1
+        bs3 = fromMaybe bs2 $ stripPrefix "qualified " bs2
+    case stripPrefix "\"" bs3 of
+      Just bs4 -> do
+        pn <- parsePackageNameThrowing $ S8.unpack $ S8.takeWhile (/= '"') bs4
+        Just (Set.singleton pn, Set.empty)
+      Nothing -> Just
+        ( Set.empty
+        , Set.singleton
+            $ fromString
+            $ T.unpack
+            $ decodeUtf8With lenientDecode
+            $ S8.takeWhile (\c -> c /= ' ' && c /= '(') bs3
+        )
src/Stack/Setup.hs view
@@ -1,2383 +1,2858 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveFunctor       #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE MultiWayIf          #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE ViewPatterns        #-}
-
-module Stack.Setup
-  ( setupEnv
-  , ensureCompilerAndMsys
-  , ensureDockerStackExe
-  , SetupOpts (..)
-  , defaultSetupInfoYaml
-  , withNewLocalBuildTargets
-
-  -- * Stack binary download
-  , StackReleaseInfo
-  , getDownloadVersion
-  , stackVersion
-  , preferredPlatforms
-  , downloadStackReleaseInfo
-  , downloadStackExe
-  ) where
-
-import qualified Codec.Archive.Tar as Tar
-import           Conduit
-                   ( ConduitT, await, concatMapMC, filterCE, foldMC, yield )
-import           Control.Applicative ( empty )
-import           Crypto.Hash ( SHA1 (..), SHA256 (..) )
-import qualified Data.Aeson.KeyMap as KeyMap
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Conduit.Binary as CB
-import           Data.Conduit.Lazy ( lazyConsume )
-import qualified Data.Conduit.List as CL
-import           Data.Conduit.Process.Typed ( createSource )
-import           Data.Conduit.Zlib ( ungzip )
-import           Data.List.Split ( splitOn )
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Lazy.Encoding as TL
-import qualified Data.Text.Encoding.Error as T
-import qualified Data.Yaml as Yaml
-import           Distribution.System ( Arch (..), OS, Platform (..) )
-import qualified Distribution.System as Cabal
-import           Distribution.Text ( simpleParse )
-import           Distribution.Types.PackageName ( mkPackageName )
-import           Distribution.Version ( mkVersion )
-import           Network.HTTP.Client ( redirectCount )
-import           Network.HTTP.StackClient
-                   ( CheckHexDigest (..), HashCheck (..), getResponseBody
-                   , getResponseStatusCode, httpLbs, httpJSON
-                   , mkDownloadRequest, parseRequest, parseUrlThrow
-                   , setGitHubHeaders, setHashChecks, setLengthCheck
-                   , verifiedDownloadWithProgress, withResponse
-                   , setRequestMethod
-                   )
-import           Network.HTTP.Simple ( getResponseHeader )
-import           Pantry.Internal.AesonExtended
-                   ( Value (..), WithJSONWarnings (..), logJSONWarnings )
-import           Path
-                   ( (</>), dirname, filename, parent, parseAbsDir, parseAbsFile
-                   , parseRelDir, parseRelFile, toFilePath
-                   )
-import           Path.CheckInstall ( warnInstallSearchPathIssues )
-import           Path.Extended ( fileExtension )
-import           Path.Extra ( toFilePathNoTrailingSep )
-import           Path.IO hiding ( findExecutable, withSystemTempDir )
-import           RIO.List
-                   ( headMaybe, intercalate, intersperse, isPrefixOf
-                   , maximumByMaybe, sort, sortBy, stripPrefix )
-import           RIO.Process
-                   ( EnvVars, HasProcessContext (..), ProcessContext
-                   , augmentPath, augmentPathMap, doesExecutableExist, envVarsL
-                   , exeSearchPathL, getStdout, mkProcessContext, modifyEnvVars
-                   , proc, readProcess_, readProcessStdout, runProcess
-                   , runProcess_, setStdout, waitExitCode, withModifyEnvVars
-                   , withProcessWait, withWorkingDir, workingDirL
-                   )
-import           Stack.Build.Haddock ( shouldHaddockDeps )
-import           Stack.Build.Source ( hashSourceMapData, loadSourceMap )
-import           Stack.Build.Target ( NeedTargets (..), parseTargets )
-import           Stack.Constants
-import           Stack.Constants.Config ( distRelativeDir )
-import           Stack.GhcPkg
-                   ( createDatabase, getGlobalDB, ghcPkgPathEnvVar
-                   , mkGhcPackagePath )
-import           Stack.Prelude
-import           Stack.SourceMap
-import           Stack.Setup.Installed
-                   ( Tool (..), extraDirs, filterTools, getCompilerVersion
-                   , installDir, listInstalled, markInstalled, tempInstallDir
-                   , toolString, unmarkInstalled
-                   )
-import           Stack.Storage.User ( loadCompilerPaths, saveCompilerPaths )
-import           Stack.Types.Build
-import           Stack.Types.Compiler
-import           Stack.Types.CompilerBuild
-import           Stack.Types.Config
-import           Stack.Types.Docker
-import           Stack.Types.SourceMap
-import           Stack.Types.Version
-import qualified System.Directory as D
-import           System.Environment ( getExecutablePath, lookupEnv )
-import           System.IO.Error ( isPermissionError )
-import           System.FilePath ( searchPathSeparator )
-import qualified System.FilePath as FP
-import           System.Permissions ( setFileExecutable )
-import           System.Uname ( getRelease )
-
--- | Type representing exceptions thrown by functions exported by the
--- "Stack.Setup" module
-data SetupException
-    = UnsupportedSetupCombo OS Arch
-    | MissingDependencies [String]
-    | UnknownCompilerVersion (Set.Set Text) WantedCompiler (Set.Set ActualCompiler)
-    | UnknownOSKey Text
-    | GHCSanityCheckCompileFailed SomeException (Path Abs File)
-    | WantedMustBeGHC
-    | RequireCustomGHCVariant
-    | ProblemWhileDecompressing (Path Abs File)
-    | SetupInfoMissingSevenz
-    | DockerStackExeNotFound Version Text
-    | UnsupportedSetupConfiguration
-    | InvalidGhcAt (Path Abs File) SomeException
-    | MSYS2NotFound Text
-    | UnwantedCompilerVersion
-    | UnwantedArchitecture
-    | SandboxedCompilerNotFound
-    | CompilerNotFound [String]
-    | GHCInfoNotValidUTF8 UnicodeException
-    | GHCInfoNotListOfPairs
-    | GHCInfoMissingGlobalPackageDB
-    | GHCInfoMissingTargetPlatform
-    | GHCInfoTargetPlatformInvalid String
-    | CabalNotFound (Path Abs File)
-    | HadrianScriptNotFound
-    | URLInvalid String
-    | UnknownArchiveExtension String
-    | Unsupported7z
-    | TarballInvalid String
-    | TarballFileInvalid String (Path Abs File)
-    | UnknownArchiveStructure (Path Abs File)
-    | StackReleaseInfoNotFound String
-    | StackBinaryArchiveNotFound [String]
-    | WorkingDirectoryInvalidBug
-    | HadrianBindistNotFound
-    | DownloadAndInstallCompilerError
-    | StackBinaryArchiveZipUnsupportedBug
-    | StackBinaryArchiveUnsupported Text
-    | StackBinaryNotInArchive String Text
-    | FileTypeInArchiveInvalid Tar.Entry Text
-    | BinaryUpgradeOnOSUnsupported Cabal.OS
-    | BinaryUpgradeOnArchUnsupported Cabal.Arch
-    | ExistingMSYS2NotDeleted (Path Abs Dir) IOException
-    deriving (Show, Typeable)
-
-instance Exception SetupException where
-    displayException (UnsupportedSetupCombo os arch) = concat
-        [ "Error: [S-1852]\n"
-        , "I don't know how to install GHC for "
-        , show (os, arch)
-        , ", please install manually"
-        ]
-    displayException (MissingDependencies tools) = concat
-        [ "Error: [S-2126]\n"
-        , "The following executables are missing and must be installed: "
-        , intercalate ", " tools
-        ]
-    displayException (UnknownCompilerVersion oskeys wanted known) = concat
-        [ "Error: [S-9443]\n"
-        , "No setup information found for "
-        , T.unpack $ utf8BuilderToText $ display wanted
-        , " on your platform.\nThis probably means a GHC bindist has not yet been added for OS key '"
-        , T.unpack (T.intercalate "', '" (sort $ Set.toList oskeys))
-        , "'.\nSupported versions: "
-        , T.unpack (T.intercalate ", " (map compilerVersionText (sort $ Set.toList known)))
-        ]
-    displayException (UnknownOSKey oskey) = concat
-        [ "Error: [S-6810]\n"
-        , "Unable to find installation URLs for OS key: "
-        , T.unpack oskey
-        ]
-    displayException (GHCSanityCheckCompileFailed e ghc) = concat
-        [ "Error: [S-5159]\n"
-        , "The GHC located at "
-        , toFilePath ghc
-        , " failed to compile a sanity check. Please see:\n\n"
-        , "    http://docs.haskellstack.org/en/stable/install_and_upgrade/\n\n"
-        , "for more information. Exception was:\n"
-        , displayException e
-        ]
-    displayException WantedMustBeGHC =
-        "Error: [S-9030]\n"
-        ++ "The wanted compiler must be GHC."
-    displayException RequireCustomGHCVariant =
-        "Error: [S-8948]\n"
-        ++ "A custom '--ghc-variant' must be specified to use '--ghc-bindist'."
-    displayException (ProblemWhileDecompressing archive) = concat
-        [ "Error: [S-2905]\n"
-        , "Problem while decompressing "
-        , toFilePath archive
-        ]
-    displayException SetupInfoMissingSevenz =
-        "Error: [S-9561]\n"
-        ++ "SetupInfo missing Sevenz EXE/DLL."
-    displayException (DockerStackExeNotFound stackVersion' osKey) = concat
-        [ "Error: [S-1457]\n"
-        , stackProgName
-        , "-"
-        , versionString stackVersion'
-        , " executable not found for "
-        , T.unpack osKey
-        , "\nUse the '"
-        , T.unpack dockerStackExeArgName
-        , "' option to specify a location."]
-    displayException UnsupportedSetupConfiguration =
-        "Error: [S-7748]\n"
-        ++ "Stack does not know how to install GHC on your system \
-           \configuration, please install manually."
-    displayException (InvalidGhcAt compiler e) = concat
-        [ "Error: [S-2476]\n"
-        , "Found an invalid compiler at "
-        , show (toFilePath compiler)
-        , ": "
-        , displayException e
-        ]
-    displayException (MSYS2NotFound osKey) = concat
-        [ "Error: [S-5308]\n"
-        , "MSYS2 not found for "
-        , T.unpack osKey
-        ]
-    displayException UnwantedCompilerVersion =
-        "Error: [S-5127]\n"
-        ++ "Not the compiler version we want."
-    displayException UnwantedArchitecture =
-        "Error: [S-1540]\n"
-        ++ "Not the architecture we want."
-    displayException SandboxedCompilerNotFound =
-        "Error: [S-9953]\n"
-        ++ "Could not find sandboxed compiler."
-    displayException (CompilerNotFound toTry) = concat
-        [ "Error: [S-4764]\n"
-        , "Could not find any of: "
-        , show toTry
-        ]
-    displayException (GHCInfoNotValidUTF8 e) = concat
-        [ "Error: [S-8668]\n"
-        , "GHC info is not valid UTF-8: "
-        , displayException e
-        ]
-    displayException GHCInfoNotListOfPairs =
-        "Error: [S-4878]\n"
-        ++ "GHC info does not parse as a list of pairs."
-    displayException GHCInfoMissingGlobalPackageDB =
-        "Error: [S-2965]\n"
-        ++ "Key 'Global Package DB' not found in GHC info."
-    displayException GHCInfoMissingTargetPlatform =
-        "Error: [S-5219]\n"
-        ++ "Key 'Target platform' not found in GHC info."
-    displayException (GHCInfoTargetPlatformInvalid targetPlatform) = concat
-        [ "Error: [S-8299]\n"
-        , "Invalid target platform in GHC info: "
-        , targetPlatform
-        ]
-    displayException (CabalNotFound compiler) = concat
-        [ "Error: [S-2574]\n"
-        , "Cabal library not found in global package database for "
-        , toFilePath compiler
-        ]
-    displayException HadrianScriptNotFound =
-        "Error: [S-1128]\n"
-        ++ "No Hadrian build script found."
-    displayException (URLInvalid url) = concat
-         [ "Error: [S-1906]\n"
-         , "`url` must be either an HTTP URL or a file path: "
-         , url
-         ]
-    displayException (UnknownArchiveExtension url) = concat
-         [ "Error: [S-1648]\n"
-         , "Unknown extension for url: "
-         , url
-         ]
-    displayException Unsupported7z =
-        "Error: [S-4509]\n"
-        ++ "Don't know how to deal with .7z files on non-Windows."
-    displayException (TarballInvalid name) = concat
-        [ "Error: [S-3158]\n"
-        , name
-        , " must be a tarball file."
-        ]
-    displayException (TarballFileInvalid name archiveFile) = concat
-        [ "Error: [S-5252]\n"
-        , "Invalid "
-        , name
-        , " filename: "
-        , show archiveFile
-        ]
-    displayException (UnknownArchiveStructure archiveFile) = concat
-        [ "Error: [S-1827]\n"
-        , "Expected a single directory within unpacked "
-        , toFilePath archiveFile
-        ]
-    displayException (StackReleaseInfoNotFound url) = concat
-        [ "Error: [S-9476]\n"
-        , "Could not get release information for Stack from: "
-        , url
-        ]
-    displayException (StackBinaryArchiveNotFound platforms) = concat
-        [ "Error: [S-4461]\n"
-        , "Unable to find binary Stack archive for platforms: "
-        , unwords platforms
-        ]
-    displayException WorkingDirectoryInvalidBug = bugReport "[S-2076]"
-        "Invalid working directory."
-    displayException HadrianBindistNotFound =
-        "Error: [S-6617]\n"
-        ++ "Can't find Hadrian-generated binary distribution."
-    displayException DownloadAndInstallCompilerError =
-        "Error: [S-7227]\n"
-        ++ "'downloadAndInstallCompiler' should not be reached with ghc-git."
-    displayException StackBinaryArchiveZipUnsupportedBug = bugReport "[S-3967]"
-        "FIXME: Handle zip files."
-    displayException (StackBinaryArchiveUnsupported archiveURL) = concat
-        [ "Error: [S-6636]\n"
-        , "Unknown archive format for Stack archive: "
-        , T.unpack archiveURL
-        ]
-    displayException (StackBinaryNotInArchive exeName url) = concat
-        [ "Error: [S-7871]\n"
-        , "Stack executable "
-        , exeName
-        , " not found in archive from "
-        , T.unpack url
-        ]
-    displayException (FileTypeInArchiveInvalid e url) = concat
-        [ "Error: [S-5046]\n"
-        , "Invalid file type for tar entry named "
-        , Tar.entryPath e
-        , " downloaded from "
-        , T.unpack url
-        ]
-    displayException (BinaryUpgradeOnOSUnsupported os) = concat
-        [ "Error: [S-4132]\n"
-        , "Binary upgrade not yet supported on OS: "
-        , show os
-        ]
-    displayException (BinaryUpgradeOnArchUnsupported arch) = concat
-        [ "Error: [S-3249]\n"
-        , "Binary upgrade not yet supported on arch: "
-        , show arch
-        ]
-    displayException (ExistingMSYS2NotDeleted destDir e) = concat
-        [ "Error: [S-4230]\n"
-        , "Could not delete existing MSYS2 directory: "
-        , toFilePath destDir
-        , "\n"
-        , displayException e
-        ]
-
--- | Type representing \'pretty\' exceptions thrown by functions exported by the
--- "Stack.Setup" module
-data SetupPrettyException
-    = GHCInstallFailed SomeException String String [String] (Path Abs Dir)
-          (Path Abs Dir) (Path Abs Dir)
-    deriving (Show, Typeable)
-
-instance Pretty SetupPrettyException where
-    pretty (GHCInstallFailed ex step cmd args wd tempDir destDir) =
-         "[S-7441]"
-      <> line
-      <> string (displayException ex)
-      <> line
-      <> hang 2 (  flow "Error encountered while" <+> fromString step <+> flow "GHC with"
-                <> line
-                <> style Shell (fromString (unwords (cmd : args)))
-                <> line
-                -- TODO: Figure out how to insert \ in the appropriate spots
-                -- hang 2 (shellColor (fillSep (fromString cmd : map fromString args))) <> line <>
-                <> flow "run in" <+> pretty wd
-                )
-      <> blankLine
-      <> flow "The following directories may now contain files, but won't be \
-              \used by Stack:"
-      <> line
-      <> "  -" <+> pretty tempDir
-      <> line
-      <> "  -" <+> pretty destDir
-      <> blankLine
-      <> flow "For more information consider rerunning with --verbose flag"
-      <> line
-
-instance Exception SetupPrettyException
-
--- | Type representing exceptions thrown by 'performPathChecking'
-data PerformPathCheckingException
-    = ProcessExited ExitCode String [String]
-    deriving (Show, Typeable)
-
-instance Exception PerformPathCheckingException where
-    displayException (ProcessExited ec cmd args) = concat
-        [ "Error: [S-1991]\n"
-        , "Process exited with "
-        , displayException ec
-        , ": "
-        , unwords (cmd:args)
-        ]
-
--- | Default location of the stack-setup.yaml file
-defaultSetupInfoYaml :: String
-defaultSetupInfoYaml =
-    "https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml"
-
-data SetupOpts = SetupOpts
-    { soptsInstallIfMissing :: !Bool
-    , soptsUseSystem :: !Bool
-    -- ^ Should we use a system compiler installation, if available?
-    , soptsWantedCompiler :: !WantedCompiler
-    , soptsCompilerCheck :: !VersionCheck
-    , soptsStackYaml :: !(Maybe (Path Abs File))
-    -- ^ If we got the desired GHC version from that file
-    , soptsForceReinstall :: !Bool
-    , soptsSanityCheck :: !Bool
-    -- ^ Run a sanity check on the selected GHC
-    , soptsSkipGhcCheck :: !Bool
-    -- ^ Don't check for a compatible GHC version/architecture
-    , soptsSkipMsys :: !Bool
-    -- ^ Do not use a custom msys installation on Windows
-    , soptsResolveMissingGHC :: !(Maybe Text)
-    -- ^ Message shown to user for how to resolve the missing GHC
-    , soptsGHCBindistURL :: !(Maybe String)
-    -- ^ Alternate GHC binary distribution (requires custom GHCVariant)
-    }
-    deriving Show
--- | Modify the environment variables (like PATH) appropriately, possibly doing installation too
-setupEnv :: NeedTargets
-         -> BuildOptsCLI
-         -> Maybe Text -- ^ Message to give user when necessary GHC is not available
-         -> RIO BuildConfig EnvConfig
-setupEnv needTargets boptsCLI mResolveMissingGHC = do
-    config <- view configL
-    bc <- view buildConfigL
-    let stackYaml = bcStackYaml bc
-    platform <- view platformL
-    wcVersion <- view wantedCompilerVersionL
-    wanted <- view wantedCompilerVersionL
-    actual <- either throwIO pure $ wantedToActual wanted
-    let wc = actual^.whichCompilerL
-    let sopts = SetupOpts
-            { soptsInstallIfMissing = configInstallGHC config
-            , soptsUseSystem = configSystemGHC config
-            , soptsWantedCompiler = wcVersion
-            , soptsCompilerCheck = configCompilerCheck config
-            , soptsStackYaml = Just stackYaml
-            , soptsForceReinstall = False
-            , soptsSanityCheck = False
-            , soptsSkipGhcCheck = configSkipGHCCheck config
-            , soptsSkipMsys = configSkipMsys config
-            , soptsResolveMissingGHC = mResolveMissingGHC
-            , soptsGHCBindistURL = Nothing
-            }
-
-    (compilerPaths, ghcBin) <- ensureCompilerAndMsys sopts
-    let compilerVer = cpCompilerVersion compilerPaths
-
-    -- Modify the initial environment to include the GHC path, if a local GHC
-    -- is being used
-    menv0 <- view processContextL
-    env <- either throwM (pure . removeHaskellEnvVars)
-               $ augmentPathMap
-                    (map toFilePath $ edBins ghcBin)
-                    (view envVarsL menv0)
-    menv <- mkProcessContext env
-
-    logDebug "Resolving package entries"
-
-    (sourceMap, sourceMapHash) <- runWithGHC menv compilerPaths $ do
-      smActual <- actualFromGhc (bcSMWanted bc) compilerVer
-      let actualPkgs = Map.keysSet (smaDeps smActual) <>
-                       Map.keysSet (smaProject smActual)
-          prunedActual = smActual { smaGlobal = pruneGlobals (smaGlobal smActual) actualPkgs }
-          haddockDeps = shouldHaddockDeps (configBuild config)
-      targets <- parseTargets needTargets haddockDeps boptsCLI prunedActual
-      sourceMap <- loadSourceMap targets boptsCLI smActual
-      sourceMapHash <- hashSourceMapData boptsCLI sourceMap
-      pure (sourceMap, sourceMapHash)
-
-    let envConfig0 = EnvConfig
-            { envConfigBuildConfig = bc
-            , envConfigBuildOptsCLI = boptsCLI
-            , envConfigSourceMap = sourceMap
-            , envConfigSourceMapHash = sourceMapHash
-            , envConfigCompilerPaths = compilerPaths
-            }
-
-    -- extra installation bin directories
-    mkDirs <- runRIO envConfig0 extraBinDirs
-    let mpath = Map.lookup "PATH" env
-    depsPath <- either throwM pure $ augmentPath (toFilePath <$> mkDirs False) mpath
-    localsPath <- either throwM pure $ augmentPath (toFilePath <$> mkDirs True) mpath
-
-    deps <- runRIO envConfig0 packageDatabaseDeps
-    runWithGHC menv compilerPaths $ createDatabase (cpPkg compilerPaths) deps
-    localdb <- runRIO envConfig0 packageDatabaseLocal
-    runWithGHC menv compilerPaths $ createDatabase (cpPkg compilerPaths) localdb
-    extras <- runReaderT packageDatabaseExtra envConfig0
-    let mkGPP locals = mkGhcPackagePath locals localdb deps extras $ cpGlobalDB compilerPaths
-
-    distDir <- runReaderT distRelativeDir envConfig0 >>= canonicalizePath
-
-    executablePath <- liftIO getExecutablePath
-
-    utf8EnvVars <- withProcessContext menv $ getUtf8EnvVars compilerVer
-
-    mGhcRtsEnvVar <- liftIO $ lookupEnv "GHCRTS"
-
-    envRef <- liftIO $ newIORef Map.empty
-    let getProcessContext' es = do
-            m <- readIORef envRef
-            case Map.lookup es m of
-                Just eo -> pure eo
-                Nothing -> do
-                    eo <- mkProcessContext
-                        $ Map.insert "PATH" (if esIncludeLocals es then localsPath else depsPath)
-                        $ (if esIncludeGhcPackagePath es
-                                then Map.insert (ghcPkgPathEnvVar wc) (mkGPP (esIncludeLocals es))
-                                else id)
-
-                        $ (if esStackExe es
-                                then Map.insert "STACK_EXE" (T.pack executablePath)
-                                else id)
-
-                        $ (if esLocaleUtf8 es
-                                then Map.union utf8EnvVars
-                                else id)
-
-                        $ case (soptsSkipMsys sopts, platform) of
-                            (False, Platform Cabal.I386   Cabal.Windows)
-                                -> Map.insert "MSYSTEM" "MINGW32"
-                            (False, Platform Cabal.X86_64 Cabal.Windows)
-                                -> Map.insert "MSYSTEM" "MINGW64"
-                            _   -> id
-
-                        -- See https://github.com/commercialhaskell/stack/issues/3444
-                        $ case (esKeepGhcRts es, mGhcRtsEnvVar) of
-                            (True, Just ghcRts) -> Map.insert "GHCRTS" (T.pack ghcRts)
-                            _ -> id
-
-                        -- For reasoning and duplication, see:
-                        -- https://github.com/commercialhaskell/stack/issues/70
-                        $ Map.insert "HASKELL_PACKAGE_SANDBOX" (T.pack $ toFilePathNoTrailingSep deps)
-                        $ Map.insert "HASKELL_PACKAGE_SANDBOXES"
-                            (T.pack $ if esIncludeLocals es
-                                then intercalate [searchPathSeparator]
-                                        [ toFilePathNoTrailingSep localdb
-                                        , toFilePathNoTrailingSep deps
-                                        , ""
-                                        ]
-                                else intercalate [searchPathSeparator]
-                                        [ toFilePathNoTrailingSep deps
-                                        , ""
-                                        ])
-                        $ Map.insert "HASKELL_DIST_DIR" (T.pack $ toFilePathNoTrailingSep distDir)
-
-                          -- Make sure that any .ghc.environment files
-                          -- are ignored, since we're setting up our
-                          -- own package databases. See
-                          -- https://github.com/commercialhaskell/stack/issues/4706
-                        $ (case cpCompilerVersion compilerPaths of
-                             ACGhc version | version >= mkVersion [8, 4, 4] ->
-                               Map.insert "GHC_ENVIRONMENT" "-"
-                             _ -> id)
-
-                          env
-
-                    () <- atomicModifyIORef envRef $ \m' ->
-                        (Map.insert es eo m', ())
-                    pure eo
-
-    envOverride <- liftIO $ getProcessContext' minimalEnvSettings
-    pure EnvConfig
-        { envConfigBuildConfig = bc
-            { bcConfig = addIncludeLib ghcBin
-                       $ set processContextL envOverride
-                         (view configL bc)
-                { configProcessContextSettings = getProcessContext'
-                }
-            }
-        , envConfigBuildOptsCLI = boptsCLI
-        , envConfigSourceMap = sourceMap
-        , envConfigSourceMapHash = sourceMapHash
-        , envConfigCompilerPaths = compilerPaths
-        }
-
--- | A modified env which we know has an installed compiler on the PATH.
-data WithGHC env = WithGHC !CompilerPaths !env
-
-insideL :: Lens' (WithGHC env) env
-insideL = lens (\(WithGHC _ x) -> x) (\(WithGHC cp _) -> WithGHC cp)
-
-instance HasLogFunc env => HasLogFunc (WithGHC env) where
-  logFuncL = insideL.logFuncL
-instance HasRunner env => HasRunner (WithGHC env) where
-  runnerL = insideL.runnerL
-instance HasProcessContext env => HasProcessContext (WithGHC env) where
-  processContextL = insideL.processContextL
-instance HasStylesUpdate env => HasStylesUpdate (WithGHC env) where
-  stylesUpdateL = insideL.stylesUpdateL
-instance HasTerm env => HasTerm (WithGHC env) where
-  useColorL = insideL.useColorL
-  termWidthL = insideL.termWidthL
-instance HasPantryConfig env => HasPantryConfig (WithGHC env) where
-  pantryConfigL = insideL.pantryConfigL
-instance HasConfig env => HasPlatform (WithGHC env)
-instance HasConfig env => HasGHCVariant (WithGHC env)
-instance HasConfig env => HasConfig (WithGHC env) where
-  configL = insideL.configL
-instance HasBuildConfig env => HasBuildConfig (WithGHC env) where
-  buildConfigL = insideL.buildConfigL
-instance HasCompiler (WithGHC env) where
-  compilerPathsL = to (\(WithGHC cp _) -> cp)
-
--- | Set up a modified environment which includes the modified PATH
--- that GHC can be found on. This is needed for looking up global
--- package information and ghc fingerprint (result from 'ghc --info').
-runWithGHC :: HasConfig env => ProcessContext -> CompilerPaths -> RIO (WithGHC env) a -> RIO env a
-runWithGHC pc cp inner = do
-  env <- ask
-  let envg
-        = WithGHC cp $
-          set envOverrideSettingsL (\_ -> pure pc) $
-          set processContextL pc env
-  runRIO envg inner
-
--- | special helper for GHCJS which needs an updated source map
--- only project dependencies should get included otherwise source map hash will
--- get changed and EnvConfig will become inconsistent
-rebuildEnv :: EnvConfig
-    -> NeedTargets
-    -> Bool
-    -> BuildOptsCLI
-    -> RIO env EnvConfig
-rebuildEnv envConfig needTargets haddockDeps boptsCLI = do
-    let bc = envConfigBuildConfig envConfig
-        cp = envConfigCompilerPaths envConfig
-        compilerVer = smCompiler $ envConfigSourceMap envConfig
-    runRIO (WithGHC cp bc) $ do
-        smActual <- actualFromGhc (bcSMWanted bc) compilerVer
-        let actualPkgs = Map.keysSet (smaDeps smActual) <> Map.keysSet (smaProject smActual)
-            prunedActual = smActual {
-              smaGlobal = pruneGlobals (smaGlobal smActual) actualPkgs
-              }
-        targets <- parseTargets needTargets haddockDeps boptsCLI prunedActual
-        sourceMap <- loadSourceMap targets boptsCLI smActual
-        pure $
-            envConfig
-            {envConfigSourceMap = sourceMap, envConfigBuildOptsCLI = boptsCLI}
-
--- | Some commands (script, ghci and exec) set targets dynamically
--- see also the note about only local targets for rebuildEnv
-withNewLocalBuildTargets :: HasEnvConfig  env => [Text] -> RIO env a -> RIO env a
-withNewLocalBuildTargets targets f = do
-    envConfig <- view $ envConfigL
-    haddockDeps <- view $ configL.to configBuild.to shouldHaddockDeps
-    let boptsCLI = envConfigBuildOptsCLI envConfig
-    envConfig' <- rebuildEnv envConfig NeedTargets haddockDeps $
-                  boptsCLI {boptsCLITargets = targets}
-    local (set envConfigL envConfig') f
-
--- | Add the include and lib paths to the given Config
-addIncludeLib :: ExtraDirs -> Config -> Config
-addIncludeLib (ExtraDirs _bins includes libs) config = config
-    { configExtraIncludeDirs =
-        configExtraIncludeDirs config ++
-        map toFilePathNoTrailingSep includes
-    , configExtraLibDirs =
-        configExtraLibDirs config ++
-        map toFilePathNoTrailingSep libs
-    }
-
--- | Ensure both the compiler and the msys toolchain are installed and
--- provide the PATHs to add if necessary
-ensureCompilerAndMsys
-  :: (HasBuildConfig env, HasGHCVariant env)
-  => SetupOpts
-  -> RIO env (CompilerPaths, ExtraDirs)
-ensureCompilerAndMsys sopts = do
-  getSetupInfo' <- memoizeRef getSetupInfo
-  mmsys2Tool <- ensureMsys sopts getSetupInfo'
-  msysPaths <- maybe (pure Nothing) (fmap Just . extraDirs) mmsys2Tool
-
-  actual <- either throwIO pure $ wantedToActual $ soptsWantedCompiler sopts
-  didWarn <- warnUnsupportedCompiler $ getGhcVersion actual
-
-  (cp, ghcPaths) <- ensureCompiler sopts getSetupInfo'
-
-  warnUnsupportedCompilerCabal cp didWarn
-
-  let paths = maybe ghcPaths (ghcPaths <>) msysPaths
-  pure (cp, paths)
-
--- | See <https://github.com/commercialhaskell/stack/issues/4246>
-warnUnsupportedCompiler :: HasLogFunc env => Version -> RIO env Bool
-warnUnsupportedCompiler ghcVersion = do
-  if
-    | ghcVersion < mkVersion [7, 8] -> do
-        logWarn $
-          "Stack will almost certainly fail with GHC below version 7.8, requested " <>
-          fromString (versionString ghcVersion)
-        logWarn "Valiantly attempting to run anyway, but I know this is doomed"
-        logWarn "For more information, see: https://github.com/commercialhaskell/stack/issues/648"
-        logWarn ""
-        pure True
-    | ghcVersion >= mkVersion [9, 5] -> do
-        logWarn $
-          "Stack has not been tested with GHC versions above 9.4, and using " <>
-          fromString (versionString ghcVersion) <>
-          ", this may fail"
-        pure True
-    | otherwise -> do
-        logDebug "Asking for a supported GHC version"
-        pure False
-
--- | See <https://github.com/commercialhaskell/stack/issues/4246>
-warnUnsupportedCompilerCabal
-  :: HasLogFunc env
-  => CompilerPaths
-  -> Bool -- ^ already warned about GHC?
-  -> RIO env ()
-warnUnsupportedCompilerCabal cp didWarn = do
-  unless didWarn $ void $ warnUnsupportedCompiler $ getGhcVersion $ cpCompilerVersion cp
-  let cabalVersion = cpCabalVersion cp
-
-  if
-    | cabalVersion < mkVersion [1, 19, 2] -> do
-        logWarn $ "Stack no longer supports Cabal versions below 1.19.2,"
-        logWarn $ "but version " <> fromString (versionString cabalVersion) <> " was found."
-        logWarn "This invocation will most likely fail."
-        logWarn "To fix this, either use an older version of Stack or a newer resolver"
-        logWarn "Acceptable resolvers: lts-3.0/nightly-2015-05-05 or later"
-    | cabalVersion >= mkVersion [3, 9] ->
-        logWarn $
-          "Stack has not been tested with Cabal versions above 3.8, but version " <>
-          fromString (versionString cabalVersion) <>
-          " was found, this may fail"
-    | otherwise -> pure ()
-
--- | Ensure that the msys toolchain is installed if necessary and
--- provide the PATHs to add if necessary
-ensureMsys
-  :: HasBuildConfig env
-  => SetupOpts
-  -> Memoized SetupInfo
-  -> RIO env (Maybe Tool)
-ensureMsys sopts getSetupInfo' = do
-  platform <- view platformL
-  localPrograms <- view $ configL.to configLocalPrograms
-  installed <- listInstalled localPrograms
-
-  case platform of
-      Platform _ Cabal.Windows | not (soptsSkipMsys sopts) ->
-          case getInstalledTool installed (mkPackageName "msys2") (const True) of
-              Just tool -> pure (Just tool)
-              Nothing
-                  | soptsInstallIfMissing sopts -> do
-                      si <- runMemoized getSetupInfo'
-                      osKey <- getOSKey platform
-                      config <- view configL
-                      VersionedDownloadInfo version info <-
-                          case Map.lookup osKey $ siMsys2 si of
-                              Just x -> pure x
-                              Nothing -> throwIO $ MSYS2NotFound osKey
-                      let tool = Tool (PackageIdentifier (mkPackageName "msys2") version)
-                      Just <$> downloadAndInstallTool (configLocalPrograms config) info tool (installMsys2Windows si)
-                  | otherwise -> do
-                      logWarn "Continuing despite missing tool: msys2"
-                      pure Nothing
-      _ -> pure Nothing
-
-installGhcBindist
-  :: HasBuildConfig env
-  => SetupOpts
-  -> Memoized SetupInfo
-  -> [Tool]
-  -> RIO env (Tool, CompilerBuild)
-installGhcBindist sopts getSetupInfo' installed = do
-    Platform expectedArch _ <- view platformL
-    let wanted = soptsWantedCompiler sopts
-        isWanted = isWantedCompiler (soptsCompilerCheck sopts) (soptsWantedCompiler sopts)
-    config <- view configL
-    ghcVariant <- view ghcVariantL
-    wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted
-    possibleCompilers <-
-            case wc of
-                Ghc -> do
-                    ghcBuilds <- getGhcBuilds
-                    forM ghcBuilds $ \ghcBuild -> do
-                        ghcPkgName <- parsePackageNameThrowing ("ghc" ++ ghcVariantSuffix ghcVariant ++ compilerBuildSuffix ghcBuild)
-                        pure (getInstalledTool installed ghcPkgName (isWanted . ACGhc), ghcBuild)
-    let existingCompilers = concatMap
-            (\(installedCompiler, compilerBuild) ->
-                case (installedCompiler, soptsForceReinstall sopts) of
-                    (Just tool, False) -> [(tool, compilerBuild)]
-                    _ -> [])
-            possibleCompilers
-    logDebug $
-      "Found already installed GHC builds: " <>
-      mconcat (intersperse ", " (map (fromString . compilerBuildName . snd) existingCompilers))
-    case existingCompilers of
-        (tool, build_):_ -> pure (tool, build_)
-        []
-            | soptsInstallIfMissing sopts -> do
-                si <- runMemoized getSetupInfo'
-                downloadAndInstallPossibleCompilers
-                    (map snd possibleCompilers)
-                    si
-                    (soptsWantedCompiler sopts)
-                    (soptsCompilerCheck sopts)
-                    (soptsGHCBindistURL sopts)
-            | otherwise -> do
-                let suggestion = fromMaybe
-                        (mconcat
-                             [ "To install the correct GHC into "
-                             , T.pack (toFilePath (configLocalPrograms config))
-                             , ", try running 'stack setup' or use the '--install-ghc' flag."
-                             , " To use your system GHC installation, run \
-                               \'stack config set system-ghc --global true', \
-                               \or use the '--system-ghc' flag."
-                             ])
-                        (soptsResolveMissingGHC sopts)
-                throwM $ CompilerVersionMismatch
-                    Nothing -- FIXME ((\(x, y, _) -> (x, y)) <$> msystem)
-                    (soptsWantedCompiler sopts, expectedArch)
-                    ghcVariant
-                    (case possibleCompilers of
-                        [] -> CompilerBuildStandard
-                        (_, compilerBuild):_ -> compilerBuild)
-                    (soptsCompilerCheck sopts)
-                    (soptsStackYaml sopts)
-                    suggestion
-
--- | Ensure compiler is installed, without worrying about msys
-ensureCompiler
-  :: forall env. (HasConfig env, HasBuildConfig env, HasGHCVariant env)
-  => SetupOpts
-  -> Memoized SetupInfo
-  -> RIO env (CompilerPaths, ExtraDirs)
-ensureCompiler sopts getSetupInfo' = do
-    let wanted = soptsWantedCompiler sopts
-    wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted
-
-    hook <- ghcInstallHook
-    hookIsExecutable <- handleIO (\_ -> pure False) $ if osIsWindows
-      then doesFileExist hook  -- can't really detect executable on windows, only file extension
-      else executable <$> getPermissions hook
-
-    Platform expectedArch _ <- view platformL
-
-    let canUseCompiler cp
-            | soptsSkipGhcCheck sopts = pure cp
-            | not $ isWanted $ cpCompilerVersion cp = throwIO UnwantedCompilerVersion
-            | cpArch cp /= expectedArch = throwIO UnwantedArchitecture
-            | otherwise = pure cp
-        isWanted = isWantedCompiler (soptsCompilerCheck sopts) (soptsWantedCompiler sopts)
-
-    let checkCompiler :: Path Abs File -> RIO env (Maybe CompilerPaths)
-        checkCompiler compiler = do
-          eres <- tryAny $ pathsFromCompiler wc CompilerBuildStandard False compiler >>= canUseCompiler
-          case eres of
-            Left e -> do
-              logDebug $ "Not using compiler at " <> displayShow (toFilePath compiler) <> ": " <> displayShow e
-              pure Nothing
-            Right cp -> pure $ Just cp
-
-    mcp <-
-      if | soptsUseSystem sopts -> do
-            logDebug "Getting system compiler version"
-            runConduit $
-              sourceSystemCompilers wanted .|
-              concatMapMC checkCompiler .|
-              await
-         | hookIsExecutable -> do
-          -- if the hook fails, we fall through to stacks sandboxed installation
-            hookGHC <- runGHCInstallHook sopts hook
-            maybe (pure Nothing) checkCompiler hookGHC
-         | otherwise -> pure Nothing
-    case mcp of
-      Nothing -> ensureSandboxedCompiler sopts getSetupInfo'
-      Just cp -> do
-        let paths = ExtraDirs { edBins = [parent $ cpCompiler cp], edInclude = [], edLib = [] }
-        pure (cp, paths)
-
-
--- | Runs @STACK_ROOT\/hooks\/ghc-install.sh@.
---
--- Reads and possibly validates the output of the process as the GHC
--- binary and returns it.
-runGHCInstallHook
-  :: HasBuildConfig env
-  => SetupOpts
-  -> Path Abs File
-  -> RIO env (Maybe (Path Abs File))
-runGHCInstallHook sopts hook = do
-    logDebug "Getting hook installed compiler version"
-    let wanted = soptsWantedCompiler sopts
-    menv0 <- view processContextL
-    menv <- mkProcessContext (Map.union (wantedCompilerToEnv wanted) $
-      removeHaskellEnvVars (view envVarsL menv0))
-    (exit, out) <- withProcessContext menv $ proc "sh" [toFilePath hook] readProcessStdout
-    case exit of
-      ExitSuccess -> do
-        let ghcPath = stripNewline . TL.unpack . TL.decodeUtf8With T.lenientDecode $ out
-        case parseAbsFile ghcPath of
-          Just compiler -> do
-            when (soptsSanityCheck sopts) $ sanityCheck compiler
-            logDebug ("Using GHC compiler at: " <> fromString (toFilePath compiler))
-            pure (Just compiler)
-          Nothing -> do
-            logWarn ("Path to GHC binary is not a valid path: " <> fromString ghcPath)
-            pure Nothing
-      ExitFailure i -> do
-        logWarn ("GHC install hook exited with code: " <> fromString (show i))
-        pure Nothing
- where
-    wantedCompilerToEnv :: WantedCompiler -> EnvVars
-    wantedCompilerToEnv (WCGhc ver) =
-      Map.fromList [("HOOK_GHC_TYPE", "bindist")
-                   ,("HOOK_GHC_VERSION", T.pack (versionString ver))
-                   ]
-    wantedCompilerToEnv (WCGhcGit commit flavor) =
-      Map.fromList [("HOOK_GHC_TYPE", "git")
-                   ,("HOOK_GHC_COMMIT", commit)
-                   ,("HOOK_GHC_FLAVOR", flavor)
-                   ,("HOOK_GHC_FLAVOUR", flavor)
-                   ]
-    wantedCompilerToEnv (WCGhcjs ghcjs_ver ghc_ver) =
-      Map.fromList [("HOOK_GHC_TYPE", "ghcjs")
-                   ,("HOOK_GHC_VERSION", T.pack (versionString ghc_ver))
-                   ,("HOOK_GHCJS_VERSION", T.pack (versionString ghcjs_ver))
-                   ]
-    newlines :: [Char]
-    newlines = ['\n', '\r']
-
-    stripNewline :: String -> String
-    stripNewline str = filter (flip notElem newlines) str
-
-
-ensureSandboxedCompiler
-  :: HasBuildConfig env
-  => SetupOpts
-  -> Memoized SetupInfo
-  -> RIO env (CompilerPaths, ExtraDirs)
-ensureSandboxedCompiler sopts getSetupInfo' = do
-    let wanted = soptsWantedCompiler sopts
-    -- List installed tools
-    config <- view configL
-    let localPrograms = configLocalPrograms config
-    installed <- listInstalled localPrograms
-    logDebug $ "Installed tools: \n - " <> mconcat (intersperse "\n - " (map (fromString . toolString) installed))
-    (compilerTool, compilerBuild) <-
-      case soptsWantedCompiler sopts of
-       -- shall we build GHC from source?
-       WCGhcGit commitId flavour -> buildGhcFromSource getSetupInfo' installed  (configCompilerRepository config) commitId flavour
-       _ -> installGhcBindist sopts getSetupInfo' installed
-    paths <- extraDirs compilerTool
-
-    wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted
-    menv0 <- view processContextL
-    m <- either throwM pure
-       $ augmentPathMap (toFilePath <$> edBins paths) (view envVarsL menv0)
-    menv <- mkProcessContext (removeHaskellEnvVars m)
-
-    names <-
-      case wanted of
-        WCGhc version -> pure ["ghc-" ++ versionString version, "ghc"]
-        WCGhcGit{} -> pure ["ghc"]
-        WCGhcjs{} -> throwIO GhcjsNotSupported
-
-    -- Previously, we used findExecutable to locate these executables. This was
-    -- actually somewhat sloppy, as it could discover executables outside of the
-    -- sandbox. This led to a specific issue on Windows with GHC 9.0.1. See
-    -- https://gitlab.haskell.org/ghc/ghc/-/issues/20074. Instead, now, we look
-    -- on the paths specified only.
-    let loop [] = do
-          logError $ "Looked for sandboxed compiler named one of: " <> displayShow names
-          logError $ "Could not find it on the paths " <> displayShow (edBins paths)
-          throwIO SandboxedCompilerNotFound
-        loop (x:xs) = do
-          res <- liftIO $ D.findExecutablesInDirectories (map toFilePath (edBins paths)) x
-          case res of
-            [] -> loop xs
-            compiler:rest -> do
-              unless (null rest) $ do
-                logWarn "Found multiple candidate compilers:"
-                for_ res $ \y -> logWarn $ "- " <> fromString y
-                logWarn $ "This usually indicates a failed installation. Trying anyway with " <> fromString compiler
-              parseAbsFile compiler
-    compiler <- withProcessContext menv $ do
-      compiler <- loop names
-
-      -- Run this here to ensure that the sanity check uses the modified
-      -- environment, otherwise we may infect GHC_PACKAGE_PATH and break sanity
-      -- checks.
-      when (soptsSanityCheck sopts) $ sanityCheck compiler
-
-      pure compiler
-
-    cp <- pathsFromCompiler wc compilerBuild True compiler
-    pure (cp, paths)
-
-pathsFromCompiler
-  :: forall env. HasConfig env
-  => WhichCompiler
-  -> CompilerBuild
-  -> Bool
-  -> Path Abs File -- ^ executable filepath
-  -> RIO env CompilerPaths
-pathsFromCompiler wc compilerBuild isSandboxed compiler = withCache $ handleAny onErr $ do
-    let dir = toFilePath $ parent compiler
-        suffixNoVersion
-          | osIsWindows = ".exe"
-          | otherwise = ""
-        msuffixWithVersion = do
-          let prefix =
-                case wc of
-                  Ghc -> "ghc-"
-          fmap ("-" ++) $ stripPrefix prefix $ toFilePath $ filename compiler
-        suffixes = maybe id (:) msuffixWithVersion [suffixNoVersion]
-        findHelper :: (WhichCompiler -> [String]) -> RIO env (Path Abs File)
-        findHelper getNames = do
-          let toTry = [dir ++ name ++ suffix | suffix <- suffixes, name <- getNames wc]
-              loop [] = throwIO $ CompilerNotFound toTry
-              loop (guessedPath':rest) = do
-                guessedPath <- parseAbsFile guessedPath'
-                exists <- doesFileExist guessedPath
-                if exists
-                  then pure guessedPath
-                  else loop rest
-          logDebug $ "Looking for executable(s): " <> displayShow toTry
-          loop toTry
-    pkg <- fmap GhcPkgExe $ findHelper $ \case
-                               Ghc -> ["ghc-pkg"]
-
-    menv0 <- view processContextL
-    menv <- mkProcessContext (removeHaskellEnvVars (view envVarsL menv0))
-
-    interpreter <- findHelper $
-                   \case
-                      Ghc -> ["runghc"]
-    haddock <- findHelper $
-               \case
-                  Ghc -> ["haddock", "haddock-ghc"]
-    infobs <- proc (toFilePath compiler) ["--info"]
-            $ fmap (toStrictBytes . fst) . readProcess_
-    infotext <-
-      case decodeUtf8' infobs of
-        Left e -> throwIO $ GHCInfoNotValidUTF8 e
-        Right info -> pure info
-    infoPairs :: [(String, String)] <-
-      case readMaybe $ T.unpack infotext of
-        Nothing -> throwIO GHCInfoNotListOfPairs
-        Just infoPairs -> pure infoPairs
-    let infoMap = Map.fromList infoPairs
-
-    eglobaldb <- tryAny $
-      case Map.lookup "Global Package DB" infoMap of
-        Nothing -> throwIO GHCInfoMissingGlobalPackageDB
-        Just db -> parseAbsDir db
-
-    arch <-
-      case Map.lookup "Target platform" infoMap of
-        Nothing -> throwIO GHCInfoMissingTargetPlatform
-        Just targetPlatform ->
-          case simpleParse $ takeWhile (/= '-') targetPlatform of
-            Nothing -> throwIO $ GHCInfoTargetPlatformInvalid targetPlatform
-            Just arch -> pure arch
-    compilerVer <-
-      case wc of
-        Ghc ->
-          case Map.lookup "Project version" infoMap of
-            Nothing -> do
-              logWarn "Key 'Project version' not found in GHC info"
-              getCompilerVersion wc compiler
-            Just versionString' -> ACGhc <$> parseVersionThrowing versionString'
-    globaldb <-
-      case eglobaldb of
-        Left e -> do
-          logWarn "Parsing global DB from GHC info failed"
-          logWarn $ displayShow e
-          logWarn "Asking ghc-pkg directly"
-          withProcessContext menv $ getGlobalDB pkg
-        Right x -> pure x
-
-    globalDump <- withProcessContext menv $ globalsFromDump pkg
-    cabalPkgVer <-
-      case Map.lookup cabalPackageName globalDump of
-        Nothing -> throwIO $ CabalNotFound compiler
-        Just dp -> pure $ pkgVersion $ dpPackageIdent dp
-
-    pure CompilerPaths
-      { cpBuild = compilerBuild
-      , cpArch = arch
-      , cpSandboxed = isSandboxed
-      , cpCompilerVersion = compilerVer
-      , cpCompiler = compiler
-      , cpPkg = pkg
-      , cpInterpreter = interpreter
-      , cpHaddock = haddock
-      , cpCabalVersion = cabalPkgVer
-      , cpGlobalDB = globaldb
-      , cpGhcInfo = infobs
-      , cpGlobalDump = globalDump
-      }
-  where
-    onErr = throwIO . InvalidGhcAt compiler
-
-    withCache inner = do
-      eres <- tryAny $ loadCompilerPaths compiler compilerBuild isSandboxed
-      mres <-
-        case eres of
-          Left e -> do
-            logWarn $ "Trouble loading CompilerPaths cache: " <> displayShow e
-            pure Nothing
-          Right x -> pure x
-      case mres of
-        Just cp -> cp <$ logDebug "Loaded compiler information from cache"
-        Nothing -> do
-          cp <- inner
-          saveCompilerPaths cp `catchAny` \e ->
-            logWarn ("Unable to save CompilerPaths cache: " <> displayShow e)
-          pure cp
-
-buildGhcFromSource :: forall env.
-   ( HasTerm env
-   , HasProcessContext env
-   , HasBuildConfig env
-   ) => Memoized SetupInfo -> [Tool] -> CompilerRepository -> Text -> Text
-   -> RIO env (Tool, CompilerBuild)
-buildGhcFromSource getSetupInfo' installed (CompilerRepository url) commitId flavour = do
-   config <- view configL
-   let compilerTool = ToolGhcGit commitId flavour
-
-   -- detect when the correct GHC is already installed
-   if compilerTool `elem` installed
-     then pure (compilerTool,CompilerBuildStandard)
-     else do
-       -- clone the repository and execute the given commands
-       withRepo (SimpleRepo url commitId RepoGit) $ do
-         -- withRepo is guaranteed to set workingDirL, so let's get it
-         mcwd <- traverse parseAbsDir =<< view workingDirL
-         cwd <- maybe (throwIO WorkingDirectoryInvalidBug) pure mcwd
-         threads <- view $ configL.to configJobs
-         let
-           hadrianArgs = fmap T.unpack
-               [ "-c"                    -- run ./boot and ./configure
-               , "-j" <> tshow threads   -- parallel build
-               , "--flavour=" <> flavour -- selected flavour
-               , "binary-dist"
-               ]
-           hadrianScripts
-             | osIsWindows = hadrianScriptsWindows
-             | otherwise   = hadrianScriptsPosix
-
-         foundHadrianPaths <- filterM doesFileExist $ (cwd </>) <$> hadrianScripts
-         hadrianPath <-
-           maybe (throwIO HadrianScriptNotFound) pure $ listToMaybe foundHadrianPaths
-
-         logSticky $ "Building GHC from source with `"
-            <> display flavour
-            <> "` flavour. It can take a long time (more than one hour)..."
-
-         -- We need to provide an absolute path to the script since
-         -- the process package only sets working directory _after_
-         -- discovering the executable
-         proc (toFilePath hadrianPath) hadrianArgs runProcess_
-
-         -- find the bindist and install it
-         bindistPath <- parseRelDir "_build/bindist"
-         (_,files) <- listDir (cwd </> bindistPath)
-         let
-           isBindist p = do
-             extension <- fileExtension (filename p)
-
-             pure $ "ghc-" `isPrefixOf` (toFilePath (filename p))
-                         && extension == ".xz"
-
-         mbindist <- filterM isBindist files
-         case mbindist of
-           [bindist] -> do
-               let bindist' = T.pack (toFilePath bindist)
-                   dlinfo = DownloadInfo
-                             { downloadInfoUrl           = bindist'
-                               -- we can specify a filepath instead of a URL
-                             , downloadInfoContentLength = Nothing
-                             , downloadInfoSha1          = Nothing
-                             , downloadInfoSha256        = Nothing
-                             }
-                   ghcdlinfo = GHCDownloadInfo mempty mempty dlinfo
-                   installer
-                      | osIsWindows = installGHCWindows
-                      | otherwise   = installGHCPosix ghcdlinfo
-               si <- runMemoized getSetupInfo'
-               _ <- downloadAndInstallTool
-                 (configLocalPrograms config)
-                 dlinfo
-                 compilerTool
-                 (installer si)
-               pure (compilerTool, CompilerBuildStandard)
-           _ -> do
-              forM_ files (logDebug . fromString . (" - " ++) . toFilePath)
-              throwIO HadrianBindistNotFound
-
--- | Determine which GHC builds to use depending on which shared libraries are available
--- on the system.
-getGhcBuilds :: HasConfig env => RIO env [CompilerBuild]
-getGhcBuilds = do
-
-    config <- view configL
-    case configGHCBuild config of
-        Just ghcBuild -> pure [ghcBuild]
-        Nothing -> determineGhcBuild
-  where
-    determineGhcBuild = do
-        -- TODO: a more reliable, flexible, and data driven approach would be to actually download small
-        -- "test" executables (from setup-info) that link to the same gmp/tinfo versions
-        -- that GHC does (i.e. built in same environment as the GHC bindist). The algorithm would go
-        -- something like this:
-        --
-        -- check for previous 'uname -a'/`ldconfig -p` plus compiler version/variant in cache
-        -- if cached, then use that as suffix
-        -- otherwise:
-        --     download setup-info
-        --     go through all with right prefix for os/version/variant
-        --     first try "standard" (no extra suffix), then the rest
-        --         download "compatibility check" exe if not already downloaded
-        --         try running it
-        --         if successful, then choose that
-        --             cache compiler suffix with the uname -a and ldconfig -p output hash plus compiler version
-        --
-        -- Of course, could also try to make a static GHC bindist instead of all this rigamarole.
-
-        platform <- view platformL
-        case platform of
-            Platform _ Cabal.Linux -> do
-                -- Some systems don't have ldconfig in the PATH, so make sure to look in /sbin and /usr/sbin as well
-                let sbinEnv m = Map.insert
-                      "PATH"
-                      ("/sbin:/usr/sbin" <> maybe "" (":" <>) (Map.lookup "PATH" m))
-                      m
-                eldconfigOut
-                  <- withModifyEnvVars sbinEnv
-                   $ proc "ldconfig" ["-p"]
-                   $ tryAny . fmap fst . readProcess_
-                let firstWords = case eldconfigOut of
-                        Right ldconfigOut -> mapMaybe (listToMaybe . T.words) $
-                            T.lines $ T.decodeUtf8With T.lenientDecode
-                                    $ LBS.toStrict ldconfigOut
-                        Left _ -> []
-                    checkLib lib
-                        | libT `elem` firstWords = do
-                            logDebug ("Found shared library " <> libD <> " in 'ldconfig -p' output")
-                            pure True
-                        | osIsWindows =
-                            -- Cannot parse /usr/lib on Windows
-                            pure False
-                        | otherwise = do
-                        -- This is a workaround for the fact that libtinfo.so.x doesn't appear in
-                        -- the 'ldconfig -p' output on Arch or Slackware even when it exists.
-                        -- There doesn't seem to be an easy way to get the true list of directories
-                        -- to scan for shared libs, but this works for our particular cases.
-                            matches <- filterM (doesFileExist .(</> lib)) usrLibDirs
-                            case matches of
-                                [] -> logDebug ("Did not find shared library " <> libD)
-                                    >> pure False
-                                (path:_) -> logDebug ("Found shared library " <> libD
-                                        <> " in " <> fromString (Path.toFilePath path))
-                                    >> pure True
-                      where
-                        libT = T.pack (toFilePath lib)
-                        libD = fromString (toFilePath lib)
-                hastinfo5 <- checkLib relFileLibtinfoSo5
-                hastinfo6 <- checkLib relFileLibtinfoSo6
-                hasncurses6 <- checkLib relFileLibncurseswSo6
-                hasgmp5 <- checkLib relFileLibgmpSo10
-                hasgmp4 <- checkLib relFileLibgmpSo3
-                let libComponents = concat
-                        [ [["tinfo6"] | hastinfo6 && hasgmp5]
-                        , [[] | hastinfo5 && hasgmp5]
-                        , [["ncurses6"] | hasncurses6 && hasgmp5 ]
-                        , [["gmp4"] | hasgmp4 ]
-                        ]
-                useBuilds $ map
-                    (\c -> case c of
-                        [] -> CompilerBuildStandard
-                        _ -> CompilerBuildSpecialized (intercalate "-" c))
-                    libComponents
-            Platform _ Cabal.FreeBSD -> do
-                let getMajorVer = readMaybe <=< headMaybe . (splitOn ".")
-                majorVer <- getMajorVer <$> sysRelease
-                if majorVer >= Just (12 :: Int) then
-                  useBuilds [CompilerBuildSpecialized "ino64"]
-                else
-                  useBuilds [CompilerBuildStandard]
-            Platform _ Cabal.OpenBSD -> do
-                releaseStr <- mungeRelease <$> sysRelease
-                useBuilds [CompilerBuildSpecialized releaseStr]
-            _ -> useBuilds [CompilerBuildStandard]
-    useBuilds builds = do
-        logDebug $
-          "Potential GHC builds: " <>
-          mconcat (intersperse ", " (map (fromString . compilerBuildName) builds))
-        pure builds
-
--- | Encode an OpenBSD version (like "6.1") into a valid argument for
--- CompilerBuildSpecialized, so "maj6-min1". Later version numbers are prefixed
--- with "r".
--- The result r must be such that "ghc-" ++ r is a valid package name,
--- as recognized by parsePackageNameFromString.
-mungeRelease :: String -> String
-mungeRelease = intercalate "-" . prefixMaj . splitOn "."
-  where
-    prefixFst pfx k (rev : revs) = (pfx ++ rev) : k revs
-    prefixFst _ _ [] = []
-    prefixMaj = prefixFst "maj" prefixMin
-    prefixMin = prefixFst "min" (map ('r':))
-
-sysRelease :: HasLogFunc env => RIO env String
-sysRelease =
-  handleIO (\e -> do
-               logWarn $ "Could not query OS version: " <> displayShow e
-               pure "")
-  (liftIO getRelease)
-
--- | Ensure Docker container-compatible 'stack' executable is downloaded
-ensureDockerStackExe :: HasConfig env => Platform -> RIO env (Path Abs File)
-ensureDockerStackExe containerPlatform = do
-    config <- view configL
-    containerPlatformDir <- runReaderT platformOnlyRelDir (containerPlatform,PlatformVariantNone)
-    let programsPath = configLocalProgramsBase config </> containerPlatformDir
-        tool = Tool (PackageIdentifier (mkPackageName "stack") stackVersion)
-    stackExeDir <- installDir programsPath tool
-    let stackExePath = stackExeDir </> relFileStack
-    stackExeExists <- doesFileExist stackExePath
-    unless stackExeExists $ do
-        logInfo $
-          "Downloading Docker-compatible " <>
-          fromString stackProgName <>
-          " executable"
-        sri <- downloadStackReleaseInfo Nothing Nothing (Just (versionString stackMinorVersion))
-        platforms <- runReaderT preferredPlatforms (containerPlatform, PlatformVariantNone)
-        downloadStackExe platforms sri stackExeDir False (const $ pure ())
-    pure stackExePath
-
--- | Get all executables on the path that might match the wanted compiler
-sourceSystemCompilers
-  :: (HasProcessContext env, HasLogFunc env)
-  => WantedCompiler
-  -> ConduitT i (Path Abs File) (RIO env) ()
-sourceSystemCompilers wanted = do
-  searchPath <- view exeSearchPathL
-  names <-
-    case wanted of
-      WCGhc version -> pure
-        [ "ghc-" ++ versionString version
-        , "ghc"
-        ]
-      WCGhcjs{} -> throwIO GhcjsNotSupported
-      WCGhcGit{} -> pure [] -- only use sandboxed versions
-  for_ names $ \name -> for_ searchPath $ \dir -> do
-    fp <- resolveFile' $ addExe $ dir FP.</> name
-    exists <- doesFileExist fp
-    when exists $ yield fp
-  where
-    addExe
-      | osIsWindows = (++ ".exe")
-      | otherwise = id
-
--- | Download the most recent SetupInfo
-getSetupInfo :: HasConfig env => RIO env SetupInfo
-getSetupInfo = do
-    config <- view configL
-    let inlineSetupInfo = configSetupInfoInline config
-        locations' = configSetupInfoLocations config
-        locations = if null locations' then [defaultSetupInfoYaml] else locations'
-
-    resolvedSetupInfos <- mapM loadSetupInfo locations
-    pure (inlineSetupInfo <> mconcat resolvedSetupInfos)
-  where
-    loadSetupInfo urlOrFile = do
-      bs <-
-          case parseUrlThrow urlOrFile of
-              Just req -> liftM (LBS.toStrict . getResponseBody) $ httpLbs req
-              Nothing -> liftIO $ S.readFile urlOrFile
-      WithJSONWarnings si warnings <- either throwM pure (Yaml.decodeEither' bs)
-      when (urlOrFile /= defaultSetupInfoYaml) $
-          logJSONWarnings urlOrFile warnings
-      pure si
-
-getInstalledTool :: [Tool]            -- ^ already installed
-                 -> PackageName       -- ^ package to find
-                 -> (Version -> Bool) -- ^ which versions are acceptable
-                 -> Maybe Tool
-getInstalledTool installed name goodVersion = Tool <$>
-  maximumByMaybe (comparing pkgVersion) (filterTools name goodVersion installed)
-
-downloadAndInstallTool :: (HasTerm env, HasBuildConfig env)
-                       => Path Abs Dir
-                       -> DownloadInfo
-                       -> Tool
-                       -> (Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> RIO env ())
-                       -> RIO env Tool
-downloadAndInstallTool programsDir downloadInfo tool installer = do
-    ensureDir programsDir
-    (file, at) <- downloadFromInfo programsDir downloadInfo tool
-    dir <- installDir programsDir tool
-    tempDir <- tempInstallDir programsDir tool
-    liftIO $ ignoringAbsence (removeDirRecur tempDir)
-    ensureDir tempDir
-    unmarkInstalled programsDir tool
-    installer file at tempDir dir
-    markInstalled programsDir tool
-    liftIO $ ignoringAbsence (removeDirRecur tempDir)
-    pure tool
-
-downloadAndInstallCompiler :: (HasBuildConfig env, HasGHCVariant env)
-                           => CompilerBuild
-                           -> SetupInfo
-                           -> WantedCompiler
-                           -> VersionCheck
-                           -> Maybe String
-                           -> RIO env Tool
-downloadAndInstallCompiler ghcBuild si wanted@(WCGhc version) versionCheck mbindistURL = do
-    ghcVariant <- view ghcVariantL
-    (selectedVersion, downloadInfo) <- case mbindistURL of
-        Just bindistURL -> do
-            case ghcVariant of
-                GHCCustom _ -> pure ()
-                _ -> throwM RequireCustomGHCVariant
-            pure (version, GHCDownloadInfo mempty mempty DownloadInfo
-                     { downloadInfoUrl = T.pack bindistURL
-                     , downloadInfoContentLength = Nothing
-                     , downloadInfoSha1 = Nothing
-                     , downloadInfoSha256 = Nothing
-                     })
-        _ -> do
-            ghcKey <- getGhcKey ghcBuild
-            case Map.lookup ghcKey $ siGHCs si of
-                Nothing -> throwM $ UnknownOSKey ghcKey
-                Just pairs_ -> getWantedCompilerInfo ghcKey versionCheck wanted ACGhc pairs_
-    config <- view configL
-    let installer =
-            case configPlatform config of
-                Platform _ Cabal.Windows -> installGHCWindows
-                _ -> installGHCPosix downloadInfo
-    logInfo $
-        "Preparing to install GHC" <>
-        (case ghcVariant of
-            GHCStandard -> ""
-            v -> " (" <> fromString (ghcVariantName v) <> ")") <>
-        (case ghcBuild of
-            CompilerBuildStandard -> ""
-            b -> " (" <> fromString (compilerBuildName b) <> ")") <>
-        " to an isolated location."
-    logInfo "This will not interfere with any system-level installation."
-    ghcPkgName <- parsePackageNameThrowing ("ghc" ++ ghcVariantSuffix ghcVariant ++ compilerBuildSuffix ghcBuild)
-    let tool = Tool $ PackageIdentifier ghcPkgName selectedVersion
-    downloadAndInstallTool (configLocalPrograms config) (gdiDownloadInfo downloadInfo) tool (installer si)
-
-downloadAndInstallCompiler _ _ WCGhcjs{} _ _ = throwIO GhcjsNotSupported
-
-downloadAndInstallCompiler _ _ WCGhcGit{} _ _ =
-    throwIO DownloadAndInstallCompilerError
-
-getWantedCompilerInfo :: (Ord k, MonadThrow m)
-                      => Text
-                      -> VersionCheck
-                      -> WantedCompiler
-                      -> (k -> ActualCompiler)
-                      -> Map k a
-                      -> m (k, a)
-getWantedCompilerInfo key versionCheck wanted toCV pairs_ =
-    case mpair of
-        Just pair -> pure pair
-        Nothing -> throwM $ UnknownCompilerVersion (Set.singleton key) wanted (Set.fromList $ map toCV (Map.keys pairs_))
-  where
-    mpair =
-        listToMaybe $
-        sortBy (flip (comparing fst)) $
-        filter (isWantedCompiler versionCheck wanted . toCV . fst) (Map.toList pairs_)
-
--- | Download and install the first available compiler build.
-downloadAndInstallPossibleCompilers
-    :: (HasGHCVariant env, HasBuildConfig env)
-    => [CompilerBuild]
-    -> SetupInfo
-    -> WantedCompiler
-    -> VersionCheck
-    -> Maybe String
-    -> RIO env (Tool, CompilerBuild)
-downloadAndInstallPossibleCompilers possibleCompilers si wanted versionCheck mbindistURL =
-    go possibleCompilers Nothing
-  where
-    -- This will stop as soon as one of the builds doesn't throw an @UnknownOSKey@ or
-    -- @UnknownCompilerVersion@ exception (so it will only try subsequent builds if one is nonexistent,
-    -- not if the download or install fails for some other reason).
-    -- The @Unknown*@ exceptions thrown by each attempt are combined into a single exception
-    -- (if only @UnknownOSKey@ is thrown, then the first of those is rethrown, but if any
-    -- @UnknownCompilerVersion@s are thrown then the attempted OS keys and available versions
-    -- are unioned).
-    go [] Nothing = throwM UnsupportedSetupConfiguration
-    go [] (Just e) = throwM e
-    go (b:bs) e = do
-        logDebug $ "Trying to setup GHC build: " <> fromString (compilerBuildName b)
-        er <- try $ downloadAndInstallCompiler b si wanted versionCheck mbindistURL
-        case er of
-            Left e'@(UnknownCompilerVersion ks' w' vs') ->
-                case e of
-                    Nothing -> go bs (Just e')
-                    Just (UnknownOSKey k) ->
-                        go bs $ Just $ UnknownCompilerVersion (Set.insert k ks') w' vs'
-                    Just (UnknownCompilerVersion ks _ vs) ->
-                        go bs $ Just $ UnknownCompilerVersion (Set.union ks' ks) w' (Set.union vs' vs)
-                    Just x -> throwM x
-            Left e'@(UnknownOSKey k') ->
-                case e of
-                    Nothing -> go bs (Just e')
-                    Just (UnknownOSKey _) -> go bs e
-                    Just (UnknownCompilerVersion ks w vs) ->
-                        go bs $ Just $ UnknownCompilerVersion (Set.insert k' ks) w vs
-                    Just x -> throwM x
-            Left e' -> throwM e'
-            Right r -> pure (r, b)
-
-getGhcKey :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m)
-          => CompilerBuild -> m Text
-getGhcKey ghcBuild = do
-    ghcVariant <- view ghcVariantL
-    platform <- view platformL
-    osKey <- getOSKey platform
-    pure $ osKey <> T.pack (ghcVariantSuffix ghcVariant) <> T.pack (compilerBuildSuffix ghcBuild)
-
-getOSKey :: (MonadThrow m)
-         => Platform -> m Text
-getOSKey platform =
-    case platform of
-        Platform I386                  Cabal.Linux   -> pure "linux32"
-        Platform X86_64                Cabal.Linux   -> pure "linux64"
-        Platform I386                  Cabal.OSX     -> pure "macosx"
-        Platform X86_64                Cabal.OSX     -> pure "macosx"
-        Platform I386                  Cabal.FreeBSD -> pure "freebsd32"
-        Platform X86_64                Cabal.FreeBSD -> pure "freebsd64"
-        Platform I386                  Cabal.OpenBSD -> pure "openbsd32"
-        Platform X86_64                Cabal.OpenBSD -> pure "openbsd64"
-        Platform I386                  Cabal.Windows -> pure "windows32"
-        Platform X86_64                Cabal.Windows -> pure "windows64"
-        Platform Arm                   Cabal.Linux   -> pure "linux-armv7"
-        Platform AArch64               Cabal.Linux   -> pure "linux-aarch64"
-        Platform Sparc                 Cabal.Linux   -> pure "linux-sparc"
-        Platform AArch64               Cabal.OSX     -> pure "macosx-aarch64"
-        Platform AArch64               Cabal.FreeBSD -> pure "freebsd-aarch64"
-        Platform arch os -> throwM $ UnsupportedSetupCombo os arch
-
-downloadOrUseLocal
-    :: (HasTerm env, HasBuildConfig env)
-    => Text -> DownloadInfo -> Path Abs File -> RIO env (Path Abs File)
-downloadOrUseLocal downloadLabel downloadInfo destination =
-  case url of
-    (parseUrlThrow -> Just _) -> do
-        ensureDir (parent destination)
-        chattyDownload downloadLabel downloadInfo destination
-        pure destination
-    (parseAbsFile -> Just path) -> do
-        warnOnIgnoredChecks
-        pure path
-    (parseRelFile -> Just path) -> do
-        warnOnIgnoredChecks
-        root <- view projectRootL
-        pure (root </> path)
-    _ -> throwIO $ URLInvalid url
-  where
-    url = T.unpack $ downloadInfoUrl downloadInfo
-    warnOnIgnoredChecks = do
-      let DownloadInfo{downloadInfoContentLength=contentLength, downloadInfoSha1=sha1,
-                       downloadInfoSha256=sha256} = downloadInfo
-      when (isJust contentLength) $
-        logWarn "`content-length` is not checked and should not be specified when `url` is a file path"
-      when (isJust sha1) $
-        logWarn "`sha1` is not checked and should not be specified when `url` is a file path"
-      when (isJust sha256) $
-        logWarn "`sha256` is not checked and should not be specified when `url` is a file path"
-
-downloadFromInfo
-    :: (HasTerm env, HasBuildConfig env)
-    => Path Abs Dir -> DownloadInfo -> Tool -> RIO env (Path Abs File, ArchiveType)
-downloadFromInfo programsDir downloadInfo tool = do
-    archiveType <-
-        case extension of
-            ".tar.xz" -> pure TarXz
-            ".tar.bz2" -> pure TarBz2
-            ".tar.gz" -> pure TarGz
-            ".7z.exe" -> pure SevenZ
-            _ -> throwIO $ UnknownArchiveExtension url
-
-    relativeFile <- parseRelFile $ toolString tool ++ extension
-    let destinationPath = programsDir </> relativeFile
-    localPath <- downloadOrUseLocal (T.pack (toolString tool)) downloadInfo destinationPath
-    pure (localPath, archiveType)
-
-  where
-    url = T.unpack $ downloadInfoUrl downloadInfo
-    extension = loop url
-      where
-        loop fp
-            | ext `elem` [".tar", ".bz2", ".xz", ".exe", ".7z", ".gz"] = loop fp' ++ ext
-            | otherwise = ""
-          where
-            (fp', ext) = FP.splitExtension fp
-
-
-data ArchiveType
-    = TarBz2
-    | TarXz
-    | TarGz
-    | SevenZ
-
-installGHCPosix :: HasConfig env
-                => GHCDownloadInfo
-                -> SetupInfo
-                -> Path Abs File
-                -> ArchiveType
-                -> Path Abs Dir
-                -> Path Abs Dir
-                -> RIO env ()
-installGHCPosix downloadInfo _ archiveFile archiveType tempDir destDir = do
-    platform <- view platformL
-    menv0 <- view processContextL
-    menv <- mkProcessContext (removeHaskellEnvVars (view envVarsL menv0))
-    logDebug $ "menv = " <> displayShow (view envVarsL menv)
-    (zipTool', compOpt) <-
-        case archiveType of
-            TarXz -> pure ("xz", 'J')
-            TarBz2 -> pure ("bzip2", 'j')
-            TarGz -> pure ("gzip", 'z')
-            SevenZ -> throwIO Unsupported7z
-    -- Slight hack: OpenBSD's tar doesn't support xz.
-    -- https://github.com/commercialhaskell/stack/issues/2283#issuecomment-237980986
-    let tarDep =
-          case (platform, archiveType) of
-            (Platform _ Cabal.OpenBSD, TarXz) -> checkDependency "gtar"
-            _ -> checkDependency "tar"
-    (zipTool, makeTool, tarTool) <- checkDependencies $ (,,)
-        <$> checkDependency zipTool'
-        <*> (checkDependency "gmake" <|> checkDependency "make")
-        <*> tarDep
-
-    logDebug $ "ziptool: " <> fromString zipTool
-    logDebug $ "make: " <> fromString makeTool
-    logDebug $ "tar: " <> fromString tarTool
-
-    let runStep step wd env cmd args = do
-          menv' <- modifyEnvVars menv (Map.union env)
-          let logLines lvl = CB.lines .| CL.mapM_ (lvl . displayBytesUtf8)
-              logStdout = logLines logDebug
-              logStderr = logLines logError
-          void $ withWorkingDir (toFilePath wd) $
-                withProcessContext menv' $
-                sinkProcessStderrStdout cmd args logStderr logStdout
-                `catchAny` \ex ->
-                    throwIO $ PrettyException
-                      (GHCInstallFailed ex step cmd args wd tempDir destDir)
-
-    logSticky $
-      "Unpacking GHC into " <>
-      fromString (toFilePath tempDir) <>
-      " ..."
-    logDebug $ "Unpacking " <> fromString (toFilePath archiveFile)
-    runStep "unpacking" tempDir mempty tarTool [compOpt : "xf", toFilePath archiveFile]
-
-    dir <- expectSingleUnpackedDir archiveFile tempDir
-
-    mOverrideGccPath <- view $ configL.to configOverrideGccPath
-
-    -- The make application uses the CC environment variable to configure the
-    -- program for compiling C programs
-    let mGccEnv = let gccEnvFromPath p =
-                        Map.singleton "CC" $ T.pack (toFilePath p)
-                  in  gccEnvFromPath <$> mOverrideGccPath
-
-    -- Data.Map.union provides a left-biased union, so mGccEnv will prevail
-    let ghcConfigureEnv =
-          fromMaybe Map.empty mGccEnv `Map.union` gdiConfigureEnv downloadInfo
-
-    logSticky "Configuring GHC ..."
-    runStep "configuring" dir
-        ghcConfigureEnv
-        (toFilePath $ dir </> relFileConfigure)
-        (("--prefix=" ++ toFilePath destDir) : map T.unpack (gdiConfigureOpts downloadInfo))
-
-    logSticky "Installing GHC ..."
-    runStep "installing" dir mempty makeTool ["install"]
-
-    logStickyDone $ "Installed GHC."
-    logDebug $ "GHC installed to " <> fromString (toFilePath destDir)
-
--- | Check if given processes appear to be present, throwing an exception if
--- missing.
-checkDependencies :: CheckDependency env a -> RIO env a
-checkDependencies (CheckDependency f) = f >>= either (throwIO . MissingDependencies) pure
-
-checkDependency :: HasProcessContext env => String -> CheckDependency env String
-checkDependency tool = CheckDependency $ do
-    exists <- doesExecutableExist tool
-    pure $ if exists then Right tool else Left [tool]
-
-newtype CheckDependency env a = CheckDependency (RIO env (Either [String] a))
-    deriving Functor
-instance Applicative (CheckDependency env) where
-    pure x = CheckDependency $ pure (Right x)
-    CheckDependency f <*> CheckDependency x = CheckDependency $ do
-        f' <- f
-        x' <- x
-        pure $
-            case (f', x') of
-                (Left e1, Left e2) -> Left $ e1 ++ e2
-                (Left e, Right _) -> Left e
-                (Right _, Left e) -> Left e
-                (Right f'', Right x'') -> Right $ f'' x''
-instance Alternative (CheckDependency env) where
-    empty = CheckDependency $ pure $ Left []
-    CheckDependency x <|> CheckDependency y = CheckDependency $ do
-        res1 <- x
-        case res1 of
-            Left _ -> y
-            Right x' -> pure $ Right x'
-
-installGHCWindows :: HasBuildConfig env
-                  => SetupInfo
-                  -> Path Abs File
-                  -> ArchiveType
-                  -> Path Abs Dir
-                  -> Path Abs Dir
-                  -> RIO env ()
-installGHCWindows si archiveFile archiveType _tempDir destDir = do
-    withUnpackedTarball7z "GHC" si archiveFile archiveType destDir
-    logInfo $ "GHC installed to " <> fromString (toFilePath destDir)
-
-installMsys2Windows :: HasBuildConfig env
-                  => SetupInfo
-                  -> Path Abs File
-                  -> ArchiveType
-                  -> Path Abs Dir
-                  -> Path Abs Dir
-                  -> RIO env ()
-installMsys2Windows si archiveFile archiveType _tempDir destDir = do
-    exists <- liftIO $ D.doesDirectoryExist $ toFilePath destDir
-    when exists $ liftIO (D.removeDirectoryRecursive $ toFilePath destDir) `catchIO` \e -> do
-        throwM $ ExistingMSYS2NotDeleted destDir e
-
-    withUnpackedTarball7z "MSYS2" si archiveFile archiveType destDir
-
-
-    -- I couldn't find this officially documented anywhere, but you need to run
-    -- the MSYS shell once in order to initialize some pacman stuff. Once that
-    -- run happens, you can just run commands as usual.
-    menv0 <- view processContextL
-    newEnv0 <- modifyEnvVars menv0 $ Map.insert "MSYSTEM" "MSYS"
-    newEnv <- either throwM pure $ augmentPathMap
-                  [toFilePath $ destDir </> relDirUsr </> relDirBin]
-                  (view envVarsL newEnv0)
-    menv <- mkProcessContext newEnv
-    withWorkingDir (toFilePath destDir) $ withProcessContext menv
-      $ proc "sh" ["--login", "-c", "true"] runProcess_
-
-    -- No longer installing git, it's unreliable
-    -- (https://github.com/commercialhaskell/stack/issues/1046) and the
-    -- MSYS2-installed version has bad CRLF defaults.
-    --
-    -- Install git. We could install other useful things in the future too.
-    -- runCmd (Cmd (Just destDir) "pacman" menv ["-Sy", "--noconfirm", "git"]) Nothing
-
--- | Unpack a compressed tarball using 7zip.  Expects a single directory in
--- the unpacked results, which is renamed to the destination directory.
-withUnpackedTarball7z :: HasBuildConfig env
-                      => String -- ^ Name of tool, used in error messages
-                      -> SetupInfo
-                      -> Path Abs File -- ^ Path to archive file
-                      -> ArchiveType
-                      -> Path Abs Dir -- ^ Destination directory.
-                      -> RIO env ()
-withUnpackedTarball7z name si archiveFile archiveType destDir = do
-    suffix <-
-        case archiveType of
-            TarXz -> pure ".xz"
-            TarBz2 -> pure ".bz2"
-            TarGz -> pure ".gz"
-            _ -> throwIO $ TarballInvalid name
-    tarFile <-
-        case T.stripSuffix suffix $ T.pack $ toFilePath (filename archiveFile) of
-            Nothing -> throwIO $ TarballFileInvalid name archiveFile
-            Just x -> parseRelFile $ T.unpack x
-    run7z <- setup7z si
-    let tmpName = toFilePathNoTrailingSep (dirname destDir) ++ "-tmp"
-    ensureDir (parent destDir)
-    withRunInIO $ \run -> withTempDir (parent destDir) tmpName $ \tmpDir -> run $ do
-        liftIO $ ignoringAbsence (removeDirRecur destDir)
-        run7z tmpDir archiveFile
-        run7z tmpDir (tmpDir </> tarFile)
-        absSrcDir <- expectSingleUnpackedDir archiveFile tmpDir
-        renameDir absSrcDir destDir
-
-expectSingleUnpackedDir :: (MonadIO m, MonadThrow m) => Path Abs File -> Path Abs Dir -> m (Path Abs Dir)
-expectSingleUnpackedDir archiveFile destDir = do
-    contents <- listDir destDir
-    case contents of
-        ([dir], _ ) -> pure dir
-        _ -> throwIO $ UnknownArchiveStructure archiveFile
-
--- | Download 7z as necessary, and get a function for unpacking things.
---
--- Returned function takes an unpack directory and archive.
-setup7z :: (HasBuildConfig env, MonadIO m)
-        => SetupInfo
-        -> RIO env (Path Abs Dir -> Path Abs File -> m ())
-setup7z si = do
-    dir <- view $ configL.to configLocalPrograms
-    ensureDir dir
-    let exeDestination = dir </> relFile7zexe
-        dllDestination = dir </> relFile7zdll
-    case (siSevenzDll si, siSevenzExe si) of
-        (Just sevenzDll, Just sevenzExe) -> do
-            _ <- downloadOrUseLocal "7z.dll" sevenzDll dllDestination
-            exePath <- downloadOrUseLocal "7z.exe" sevenzExe exeDestination
-            withRunInIO $ \run -> pure $ \outdir archive -> liftIO $ run $ do
-                let cmd = toFilePath exePath
-                    args =
-                        [ "x"
-                        , "-o" ++ toFilePath outdir
-                        , "-y"
-                        , toFilePath archive
-                        ]
-                let archiveDisplay = fromString $ FP.takeFileName $ toFilePath archive
-                    isExtract = FP.takeExtension (toFilePath archive) == ".tar"
-                logInfo $
-                  (if isExtract then "Extracting " else "Decompressing ") <>
-                  archiveDisplay <> "..."
-                ec <-
-                  proc cmd args $ \pc ->
-                  if isExtract
-                    then withProcessWait (setStdout createSource pc) $ \p -> do
-                        total <- runConduit
-                            $ getStdout p
-                           .| filterCE (== 10) -- newline characters
-                           .| foldMC
-                                (\count bs -> do
-                                    let count' = count + S.length bs
-                                    logSticky $ "Extracted " <> display count' <> " files"
-                                    pure count'
-                                )
-                                0
-                        logStickyDone $
-                          "Extracted total of " <>
-                          display total <>
-                          " files from " <>
-                          archiveDisplay
-                        waitExitCode p
-                    else runProcess pc
-                when (ec /= ExitSuccess)
-                    $ liftIO $ throwM (ProblemWhileDecompressing archive)
-        _ -> throwM SetupInfoMissingSevenz
-
-chattyDownload :: HasTerm env
-               => Text          -- ^ label
-               -> DownloadInfo  -- ^ URL, content-length, sha1, and sha256
-               -> Path Abs File -- ^ destination
-               -> RIO env ()
-chattyDownload label downloadInfo path = do
-    let url = downloadInfoUrl downloadInfo
-    req <- parseUrlThrow $ T.unpack url
-    logSticky $
-      "Preparing to download " <>
-      display label <>
-      " ..."
-    logDebug $
-      "Downloading from " <>
-      display url <>
-      " to " <>
-      fromString (toFilePath path) <>
-      " ..."
-    hashChecks <- fmap catMaybes $ forM
-      [ ("sha1",   HashCheck SHA1,   downloadInfoSha1)
-      , ("sha256", HashCheck SHA256, downloadInfoSha256)
-      ]
-      $ \(name, constr, getter) ->
-        case getter downloadInfo of
-          Just bs -> do
-            logDebug $
-                "Will check against " <>
-                name <>
-                " hash: " <>
-                displayBytesUtf8 bs
-            pure $ Just $ constr $ CheckHexDigestByteString bs
-          Nothing -> pure Nothing
-    when (null hashChecks) $ logWarn $
-        "No sha1 or sha256 found in metadata," <>
-        " download hash won't be checked."
-    let dReq = setHashChecks hashChecks $
-               setLengthCheck mtotalSize $
-               mkDownloadRequest req
-    x <- verifiedDownloadWithProgress dReq path label mtotalSize
-    if x
-        then logStickyDone ("Downloaded " <> display label <> ".")
-        else logStickyDone "Already downloaded."
-  where
-    mtotalSize = downloadInfoContentLength downloadInfo
-
--- | Perform a basic sanity check of GHC
-sanityCheck :: (HasProcessContext env, HasLogFunc env)
-            => Path Abs File -> RIO env ()
-sanityCheck ghc = withSystemTempDir "stack-sanity-check" $ \dir -> do
-    let fp = toFilePath $ dir </> relFileMainHs
-    liftIO $ S.writeFile fp $ T.encodeUtf8 $ T.pack $ unlines
-        [ "import Distribution.Simple" -- ensure Cabal library is present
-        , "main = putStrLn \"Hello World\""
-        ]
-    logDebug $ "Performing a sanity check on: " <> fromString (toFilePath ghc)
-    eres <- withWorkingDir (toFilePath dir) $ proc (toFilePath ghc)
-        [ fp
-        , "-no-user-package-db"
-        ] $ try . readProcess_
-    case eres of
-        Left e -> throwIO $ GHCSanityCheckCompileFailed e ghc
-        Right _ -> pure () -- TODO check that the output of running the command is correct
-
--- Remove potentially confusing environment variables
-removeHaskellEnvVars :: Map Text Text -> Map Text Text
-removeHaskellEnvVars =
-    Map.delete "GHC_PACKAGE_PATH" .
-    Map.delete "GHC_ENVIRONMENT" .
-    Map.delete "HASKELL_PACKAGE_SANDBOX" .
-    Map.delete "HASKELL_PACKAGE_SANDBOXES" .
-    Map.delete "HASKELL_DIST_DIR" .
-    -- https://github.com/commercialhaskell/stack/issues/1460
-    Map.delete "DESTDIR" .
-    -- https://github.com/commercialhaskell/stack/issues/3444
-    Map.delete "GHCRTS"
-
--- | Get map of environment variables to set to change the GHC's encoding to UTF-8
-getUtf8EnvVars
-    :: (HasProcessContext env, HasPlatform env, HasLogFunc env)
-    => ActualCompiler
-    -> RIO env (Map Text Text)
-getUtf8EnvVars compilerVer =
-    if getGhcVersion compilerVer >= mkVersion [7, 10, 3]
-        -- GHC_CHARENC supported by GHC >=7.10.3
-        then pure $ Map.singleton "GHC_CHARENC" "UTF-8"
-        else legacyLocale
-  where
-    legacyLocale = do
-        menv <- view processContextL
-        Platform _ os <- view platformL
-        if os == Cabal.Windows
-            then
-                 -- On Windows, locale is controlled by the code page, so we don't set any environment
-                 -- variables.
-                 pure
-                     Map.empty
-            else do
-                let checkedVars = map checkVar (Map.toList $ view envVarsL menv)
-                    -- List of environment variables that will need to be updated to set UTF-8 (because
-                    -- they currently do not specify UTF-8).
-                    needChangeVars = concatMap fst checkedVars
-                    -- Set of locale-related environment variables that have already have a value.
-                    existingVarNames = Set.unions (map snd checkedVars)
-                    -- True if a locale is already specified by one of the "global" locale variables.
-                    hasAnyExisting =
-                        any (`Set.member` existingVarNames) ["LANG", "LANGUAGE", "LC_ALL"]
-                if null needChangeVars && hasAnyExisting
-                    then
-                         -- If no variables need changes and at least one "global" variable is set, no
-                         -- changes to environment need to be made.
-                         pure
-                             Map.empty
-                    else do
-                        -- Get a list of known locales by running @locale -a@.
-                        elocales <- tryAny $ fmap fst $ proc "locale" ["-a"] readProcess_
-                        let
-                            -- Filter the list to only include locales with UTF-8 encoding.
-                            utf8Locales =
-                                case elocales of
-                                    Left _ -> []
-                                    Right locales ->
-                                        filter
-                                            isUtf8Locale
-                                            (T.lines $
-                                             T.decodeUtf8With
-                                                 T.lenientDecode $
-                                                 LBS.toStrict locales)
-                            mfallback = getFallbackLocale utf8Locales
-                        when
-                            (isNothing mfallback)
-                            (logWarn
-                                 "Warning: unable to set locale to UTF-8 encoding; GHC may fail with 'invalid character'")
-                        let
-                            -- Get the new values of variables to adjust.
-                            changes =
-                                Map.unions $
-                                map
-                                    (adjustedVarValue menv utf8Locales mfallback)
-                                    needChangeVars
-                            -- Get the values of variables to add.
-                            adds
-                              | hasAnyExisting =
-                                  -- If we already have a "global" variable, then nothing needs
-                                  -- to be added.
-                                  Map.empty
-                              | otherwise =
-                                  -- If we don't already have a "global" variable, then set LANG to the
-                                  -- fallback.
-                                  case mfallback of
-                                      Nothing -> Map.empty
-                                      Just fallback ->
-                                          Map.singleton "LANG" fallback
-                        pure (Map.union changes adds)
-    -- Determines whether an environment variable is locale-related and, if so, whether it needs to
-    -- be adjusted.
-    checkVar
-        :: (Text, Text) -> ([Text], Set Text)
-    checkVar (k,v) =
-        if k `elem` ["LANG", "LANGUAGE"] || "LC_" `T.isPrefixOf` k
-            then if isUtf8Locale v
-                     then ([], Set.singleton k)
-                     else ([k], Set.singleton k)
-            else ([], Set.empty)
-    -- Adjusted value of an existing locale variable.  Looks for valid UTF-8 encodings with
-    -- same language /and/ territory, then with same language, and finally the first UTF-8 locale
-    -- returned by @locale -a@.
-    adjustedVarValue
-        :: ProcessContext -> [Text] -> Maybe Text -> Text -> Map Text Text
-    adjustedVarValue menv utf8Locales mfallback k =
-        case Map.lookup k (view envVarsL menv) of
-            Nothing -> Map.empty
-            Just v ->
-                case concatMap
-                         (matchingLocales utf8Locales)
-                         [ T.takeWhile (/= '.') v <> "."
-                         , T.takeWhile (/= '_') v <> "_"] of
-                    (v':_) -> Map.singleton k v'
-                    [] ->
-                        case mfallback of
-                            Just fallback -> Map.singleton k fallback
-                            Nothing -> Map.empty
-    -- Determine the fallback locale, by looking for any UTF-8 locale prefixed with the list in
-    -- @fallbackPrefixes@, and if not found, picking the first UTF-8 encoding returned by @locale
-    -- -a@.
-    getFallbackLocale
-        :: [Text] -> Maybe Text
-    getFallbackLocale utf8Locales =
-        case concatMap (matchingLocales utf8Locales) fallbackPrefixes of
-            (v:_) -> Just v
-            [] ->
-                case utf8Locales of
-                    [] -> Nothing
-                    (v:_) -> Just v
-    -- Filter the list of locales for any with the given prefixes (case-insensitive).
-    matchingLocales
-        :: [Text] -> Text -> [Text]
-    matchingLocales utf8Locales prefix =
-        filter (\v -> T.toLower prefix `T.isPrefixOf` T.toLower v) utf8Locales
-    -- Does the locale have one of the encodings in @utf8Suffixes@ (case-insensitive)?
-    isUtf8Locale locale =
-      any (\ v -> T.toLower v `T.isSuffixOf` T.toLower locale) utf8Suffixes
-    -- Prefixes of fallback locales (case-insensitive)
-    fallbackPrefixes = ["C.", "en_US.", "en_"]
-    -- Suffixes of UTF-8 locales (case-insensitive)
-    utf8Suffixes = [".UTF-8", ".utf8"]
-
--- Binary Stack upgrades
-
--- | Information on a binary release of Stack
-data StackReleaseInfo
-  = SRIGitHub !Value
-  -- ^ Metadata downloaded from GitHub releases about available binaries.
-  | SRIHaskellStackOrg !HaskellStackOrg
-  -- ^ Information on the latest available binary for the current platforms.
-
-data HaskellStackOrg = HaskellStackOrg
-  { hsoUrl :: !Text
-  , hsoVersion :: !Version
-  }
-  deriving Show
-
-downloadStackReleaseInfo
-  :: (HasPlatform env, HasLogFunc env)
-  => Maybe String -- GitHub org
-  -> Maybe String -- GitHub repo
-  -> Maybe String -- ^ optional version
-  -> RIO env StackReleaseInfo
-downloadStackReleaseInfo Nothing Nothing Nothing = do
-    platform <- view platformL
-    -- Fallback list of URLs to try for upgrading.
-    let urls0 =
-          case platform of
-            Platform X86_64 Cabal.Linux ->
-              [ "https://get.haskellstack.org/upgrade/linux-x86_64-static.tar.gz"
-              , "https://get.haskellstack.org/upgrade/linux-x86_64.tar.gz"
-              ]
-            Platform X86_64 Cabal.OSX ->
-              [ "https://get.haskellstack.org/upgrade/osx-x86_64.tar.gz"
-              ]
-            Platform X86_64 Cabal.Windows ->
-              [ "https://get.haskellstack.org/upgrade/windows-x86_64.tar.gz"
-              ]
-            _ -> []
-        -- Helper function: extract the version from a GitHub releases URL.
-    let extractVersion loc = do
-          version0 <-
-            case reverse $ splitOn "/" $ T.unpack loc of
-              _final:version0:_ -> Right version0
-              _ -> Left $ "Insufficient pieces in location: " ++ show loc
-          version1 <- maybe (Left "no leading v on version") Right $ stripPrefix "v" version0
-          maybe (Left $ "Invalid version: " ++ show version1) Right $ parseVersion version1
-
-        -- Try out different URLs. If we've exhausted all of them, fall back to GitHub.
-        loop [] = do
-          logDebug "Could not get binary from haskellstack.org, trying GitHub"
-          downloadStackReleaseInfoGitHub Nothing Nothing Nothing
-
-        -- Try the next URL
-        loop (url:urls) = do
-          -- Make a HEAD request without any redirects
-          req <- setRequestMethod "HEAD" <$> parseRequest (T.unpack url)
-          res <- httpLbs req { redirectCount = 0 }
-
-          -- Look for a redirect. We're looking for a standard GitHub releases
-          -- URL where we can extract version information from.
-          case getResponseHeader "location" res of
-            [] -> logDebug "No location header found, continuing" *> loop urls
-            -- Exactly one location header.
-            [locBS] ->
-              case decodeUtf8' locBS of
-                Left e -> logDebug ("Invalid UTF8: " <> displayShow (locBS, e)) *> loop urls
-                Right loc ->
-                  case extractVersion loc of
-                    Left s -> logDebug ("No version found: " <> displayShow (url, loc, s)) *> loop (loc:urls)
-                    -- We found a valid URL, let's use it!
-                    Right version -> do
-                      let hso = HaskellStackOrg
-                                  { hsoUrl = loc
-                                  , hsoVersion = version
-                                  }
-                      logDebug $ "Downloading from haskellstack.org: " <> displayShow hso
-                      pure $ SRIHaskellStackOrg hso
-            locs -> logDebug ("Multiple location headers found: " <> displayShow locs) *> loop urls
-    loop urls0
-downloadStackReleaseInfo morg mrepo mver = downloadStackReleaseInfoGitHub morg mrepo mver
-
--- | Same as above, but always uses GitHub
-downloadStackReleaseInfoGitHub
-  :: (MonadIO m, MonadThrow m)
-  => Maybe String -- GitHub org
-  -> Maybe String -- GitHub repo
-  -> Maybe String -- ^ optional version
-  -> m StackReleaseInfo
-downloadStackReleaseInfoGitHub morg mrepo mver = liftIO $ do
-    let org = fromMaybe "commercialhaskell" morg
-        repo = fromMaybe "stack" mrepo
-    let url = concat
-            [ "https://api.github.com/repos/"
-            , org
-            , "/"
-            , repo
-            , "/releases/"
-            , case mver of
-                Nothing -> "latest"
-                Just ver -> "tags/v" ++ ver
-            ]
-    req <- parseRequest url
-    res <- httpJSON $ setGitHubHeaders req
-    let code = getResponseStatusCode res
-    if code >= 200 && code < 300
-        then pure $ SRIGitHub $ getResponseBody res
-        else throwIO $ StackReleaseInfoNotFound url
-
-preferredPlatforms :: (MonadReader env m, HasPlatform env, MonadThrow m)
-                   => m [(Bool, String)]
-preferredPlatforms = do
-    Platform arch' os' <- view platformL
-    (isWindows, os) <-
-      case os' of
-        Cabal.Linux -> pure (False, "linux")
-        Cabal.Windows -> pure (True, "windows")
-        Cabal.OSX -> pure (False, "osx")
-        Cabal.FreeBSD -> pure (False, "freebsd")
-        _ -> throwM $ BinaryUpgradeOnOSUnsupported os'
-    arch <-
-      case arch' of
-        I386 -> pure "i386"
-        X86_64 -> pure "x86_64"
-        Arm -> pure "arm"
-        _ -> throwM $ BinaryUpgradeOnArchUnsupported arch'
-    hasgmp4 <- pure False -- FIXME import relevant code from Stack.Setup? checkLib $(mkRelFile "libgmp.so.3")
-    let suffixes
-          | hasgmp4 = ["-static", "-gmp4", ""]
-          | otherwise = ["-static", ""]
-    pure $ map (\suffix -> (isWindows, concat [os, "-", arch, suffix])) suffixes
-
-downloadStackExe
-    :: HasConfig env
-    => [(Bool, String)] -- ^ acceptable platforms
-    -> StackReleaseInfo
-    -> Path Abs Dir -- ^ destination directory
-    -> Bool -- ^ perform PATH-aware checking, see #3232
-    -> (Path Abs File -> IO ()) -- ^ test the temp exe before renaming
-    -> RIO env ()
-downloadStackExe platforms0 archiveInfo destDir checkPath testExe = do
-    (isWindows, archiveURL) <-
-      let loop [] = throwIO $ StackBinaryArchiveNotFound (map snd platforms0)
-          loop ((isWindows, p'):ps) = do
-            let p = T.pack p'
-            logInfo $ "Querying for archive location for platform: " <> fromString p'
-            case findArchive archiveInfo p of
-              Just x -> pure (isWindows, x)
-              Nothing -> loop ps
-       in loop platforms0
-
-    let (destFile, tmpFile)
-            | isWindows =
-                ( destDir </> relFileStackDotExe
-                , destDir </> relFileStackDotTmpDotExe
-                )
-            | otherwise =
-                ( destDir </> relFileStack
-                , destDir </> relFileStackDotTmp
-                )
-
-    logInfo $ "Downloading from: " <> display archiveURL
-
-    liftIO $ do
-      case () of
-        ()
-          | ".tar.gz" `T.isSuffixOf` archiveURL ->
-              handleTarball tmpFile isWindows archiveURL
-          | ".zip" `T.isSuffixOf` archiveURL ->
-              throwIO StackBinaryArchiveZipUnsupportedBug
-          | otherwise -> throwIO $ StackBinaryArchiveUnsupported archiveURL
-
-    logInfo "Download complete, testing executable"
-
-    platform <- view platformL
-
-    -- We need to call getExecutablePath before we overwrite the
-    -- currently running binary: after that, Linux will append
-    -- (deleted) to the filename.
-    currExe <- liftIO getExecutablePath
-
-    liftIO $ do
-      setFileExecutable (toFilePath tmpFile)
-
-      testExe tmpFile
-
-      case platform of
-          Platform _ Cabal.Windows | FP.equalFilePath (toFilePath destFile) currExe -> do
-              old <- parseAbsFile (toFilePath destFile ++ ".old")
-              renameFile destFile old
-              renameFile tmpFile destFile
-          _ -> renameFile tmpFile destFile
-
-    destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir
-    warnInstallSearchPathIssues destDir' ["stack"]
-
-    logInfo $ "New Stack executable available at " <> fromString (toFilePath destFile)
-
-    when checkPath $ performPathChecking destFile currExe
-      `catchAny` (logError . displayShow)
-  where
-
-    findArchive (SRIGitHub val) pattern = do
-        Object top <- pure val
-        Array assets <- KeyMap.lookup "assets" top
-        getFirst $ fold $ fmap (First . findMatch pattern') assets
-      where
-        pattern' = mconcat ["-", pattern, "."]
-
-        findMatch pattern'' (Object o) = do
-            String name <- KeyMap.lookup "name" o
-            guard $ not $ ".asc" `T.isSuffixOf` name
-            guard $ pattern'' `T.isInfixOf` name
-            String url <- KeyMap.lookup "browser_download_url" o
-            Just url
-        findMatch _ _ = Nothing
-    findArchive (SRIHaskellStackOrg hso) _ = pure $ hsoUrl hso
-
-    handleTarball :: Path Abs File -> Bool -> T.Text -> IO ()
-    handleTarball tmpFile isWindows url = do
-        req <- fmap setGitHubHeaders $ parseUrlThrow $ T.unpack url
-        withResponse req $ \res -> do
-            entries <- fmap (Tar.read . LBS.fromChunks)
-                     $ lazyConsume
-                     $ getResponseBody res .| ungzip
-            let loop Tar.Done = throwIO $ StackBinaryNotInArchive exeName url
-                loop (Tar.Fail e) = throwM e
-                loop (Tar.Next e es) =
-                    case FP.splitPath (Tar.entryPath e) of
-                        -- Ignore the first component, see: https://github.com/commercialhaskell/stack/issues/5288
-                        [_ignored, name] | name == exeName -> do
-                            case Tar.entryContent e of
-                                Tar.NormalFile lbs _ -> do
-                                  ensureDir destDir
-                                  LBS.writeFile (toFilePath tmpFile) lbs
-                                _ -> throwIO $ FileTypeInArchiveInvalid e url
-                        _ -> loop es
-            loop entries
-      where
-        exeName
-          | isWindows = "stack.exe"
-          | otherwise = "stack"
-
--- | Ensure that the Stack executable download is in the same location
--- as the currently running executable. See:
--- https://github.com/commercialhaskell/stack/issues/3232
-performPathChecking
-    :: HasConfig env
-    => Path Abs File -- ^ location of the newly downloaded file
-    -> String -- ^ currently running executable
-    -> RIO env ()
-performPathChecking newFile executablePath = do
-  executablePath' <- parseAbsFile executablePath
-  unless (toFilePath newFile == executablePath) $ do
-    logInfo $ "Also copying Stack executable to " <> fromString executablePath
-    tmpFile <- parseAbsFile $ executablePath ++ ".tmp"
-    eres <- tryIO $ do
-      liftIO $ copyFile newFile tmpFile
-      setFileExecutable (toFilePath tmpFile)
-      liftIO $ renameFile tmpFile executablePath'
-      logInfo "Stack executable copied successfully!"
-    case eres of
-      Right () -> pure ()
-      Left e
-        | isPermissionError e -> do
-            logWarn $ "Permission error when trying to copy: " <> displayShow e
-            logWarn "Should I try to perform the file copy using sudo? This may fail"
-            toSudo <- promptBool "Try using sudo? (y/n) "
-            when toSudo $ do
-              let run cmd args = do
-                    ec <- proc cmd args runProcess
-                    when (ec /= ExitSuccess) $
-                        throwIO $ ProcessExited ec cmd args
-                  commands =
-                    [ ("sudo",
-                        [ "cp"
-                        , toFilePath newFile
-                        , toFilePath tmpFile
-                        ])
-                    , ("sudo",
-                        [ "mv"
-                        , toFilePath tmpFile
-                        , executablePath
-                        ])
-                    ]
-              logInfo "Going to run the following commands:"
-              logInfo ""
-              forM_ commands $ \(cmd, args) ->
-                logInfo $ "-  " <> mconcat (intersperse " " (fromString <$> (cmd:args)))
-              mapM_ (uncurry run) commands
-              logInfo ""
-              logInfo "sudo file copy worked!"
-        | otherwise -> throwM e
-
-getDownloadVersion :: StackReleaseInfo -> Maybe Version
-getDownloadVersion (SRIGitHub val) = do
-    Object o <- Just val
-    String rawName <- KeyMap.lookup "name" o
-    -- drop the "v" at the beginning of the name
-    parseVersion $ T.unpack (T.drop 1 rawName)
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE MultiWayIf          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module Stack.Setup
+  ( setupEnv
+  , ensureCompilerAndMsys
+  , ensureDockerStackExe
+  , SetupOpts (..)
+  , defaultSetupInfoYaml
+  , withNewLocalBuildTargets
+
+  -- * Stack binary download
+  , StackReleaseInfo
+  , getDownloadVersion
+  , stackVersion
+  , preferredPlatforms
+  , downloadStackReleaseInfo
+  , downloadStackExe
+  ) where
+
+import qualified Codec.Archive.Tar as Tar
+import           Conduit
+                   ( ConduitT, await, concatMapMC, filterCE, foldMC, yield )
+import           Control.Applicative ( empty )
+import           Crypto.Hash ( SHA1 (..), SHA256 (..) )
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.Attoparsec.Text as P
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as LBS
+import           Data.Char ( isDigit )
+import qualified Data.Conduit.Binary as CB
+import           Data.Conduit.Lazy ( lazyConsume )
+import qualified Data.Conduit.List as CL
+import           Data.Conduit.Process.Typed ( createSource )
+import           Data.Conduit.Zlib ( ungzip )
+import           Data.List.Split ( splitOn )
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Encoding.Error as T
+import qualified Data.Yaml as Yaml
+import           Distribution.System ( Arch (..), OS, Platform (..) )
+import qualified Distribution.System as Cabal
+import           Distribution.Text ( simpleParse )
+import           Distribution.Types.PackageName ( mkPackageName )
+import           Distribution.Version ( mkVersion )
+import           Network.HTTP.Client ( redirectCount )
+import           Network.HTTP.StackClient
+                   ( CheckHexDigest (..), HashCheck (..), getResponseBody
+                   , getResponseStatusCode, httpLbs, httpJSON, mkDownloadRequest
+                   , parseRequest, parseUrlThrow, setGitHubHeaders
+                   , setHashChecks, setLengthCheck, setRequestMethod
+                   , verifiedDownloadWithProgress, withResponse
+                   )
+import           Network.HTTP.Simple ( getResponseHeader )
+import           Pantry.Internal.AesonExtended
+                   ( Value (..), WithJSONWarnings (..), logJSONWarnings )
+import           Path
+                   ( (</>), addExtension, dirname, filename, parent, parseAbsDir
+                   , parseAbsFile, parseRelDir, parseRelFile, toFilePath
+                   )
+import           Path.CheckInstall ( warnInstallSearchPathIssues )
+import           Path.Extended ( fileExtension )
+import           Path.Extra ( toFilePathNoTrailingSep )
+import           Path.IO hiding ( findExecutable, withSystemTempDir )
+import           RIO.List
+                   ( headMaybe, intercalate, intersperse, isPrefixOf
+                   , maximumByMaybe, sort, sortOn, stripPrefix )
+import           RIO.Process
+                   ( EnvVars, HasProcessContext (..), ProcessContext
+                   , augmentPath, augmentPathMap, doesExecutableExist, envVarsL
+                   , exeSearchPathL, getStdout, mkProcessContext, modifyEnvVars
+                   , proc, readProcess_, readProcessStdout, readProcessStdout_
+                   , runProcess, runProcess_, setStdout, waitExitCode
+                   , withModifyEnvVars, withProcessWait, withWorkingDir
+                   , workingDirL
+                   )
+import           Stack.Build.Haddock ( shouldHaddockDeps )
+import           Stack.Build.Source ( hashSourceMapData, loadSourceMap )
+import           Stack.Build.Target ( NeedTargets (..), parseTargets )
+import           Stack.Constants
+                   ( cabalPackageName, hadrianScriptsPosix
+                   , hadrianScriptsWindows, relDirBin, relDirUsr, relFile7zdll
+                   , relFile7zexe, relFileConfigure, relFileLibgmpSo10
+                   , relFileLibgmpSo3, relFileLibncurseswSo6, relFileLibtinfoSo5
+                   , relFileLibtinfoSo6, relFileMainHs, relFileStack
+                   , relFileStackDotExe, relFileStackDotTmp
+                   , relFileStackDotTmpDotExe, stackProgName, usrLibDirs
+                   )
+import           Stack.Constants.Config ( distRelativeDir )
+import           Stack.GhcPkg
+                   ( createDatabase, getGlobalDB, ghcPkgPathEnvVar
+                   , mkGhcPackagePath )
+import           Stack.Prelude
+import           Stack.Setup.Installed
+                   ( Tool (..), extraDirs, filterTools, getCompilerVersion
+                   , installDir, listInstalled, markInstalled, tempInstallDir
+                   , toolString, unmarkInstalled
+                   )
+import           Stack.SourceMap
+                   ( actualFromGhc, globalsFromDump, pruneGlobals )
+import           Stack.Storage.User ( loadCompilerPaths, saveCompilerPaths )
+import           Stack.Types.Build.Exception ( BuildException (..) )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..), projectRootL
+                   , wantedCompilerVersionL
+                   )
+import           Stack.Types.BuildOpts ( BuildOptsCLI (..) )
+import           Stack.Types.Compiler
+                   ( ActualCompiler (..), CompilerException (..)
+                   , CompilerRepository (..), WhichCompiler (..)
+                   , compilerVersionText, getGhcVersion, isWantedCompiler
+                   , wantedToActual, whichCompiler, whichCompilerL
+                   )
+import           Stack.Types.CompilerBuild
+                   ( CompilerBuild (..), compilerBuildName, compilerBuildSuffix
+                   )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), GhcPkgExe (..), HasCompiler (..) )
+import           Stack.Types.Config
+                   ( Config (..), HasConfig (..), envOverrideSettingsL
+                   , ghcInstallHook
+                   )
+import           Stack.Types.DownloadInfo ( DownloadInfo (..) )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.EnvConfig
+                   ( EnvConfig (..), HasEnvConfig (..), extraBinDirs
+                   , packageDatabaseDeps, packageDatabaseExtra
+                   , packageDatabaseLocal
+                   )
+import           Stack.Types.EnvSettings ( EnvSettings (..), minimalEnvSettings )
+import           Stack.Types.ExtraDirs ( ExtraDirs (..) )
+import           Stack.Types.GHCDownloadInfo ( GHCDownloadInfo (..) )
+import           Stack.Types.GHCVariant
+                   ( GHCVariant (..), HasGHCVariant (..), ghcVariantName
+                   , ghcVariantSuffix
+                   )
+import           Stack.Types.Platform
+                   ( HasPlatform (..), PlatformVariant (..)
+                   , platformOnlyRelDir )
+import           Stack.Types.Runner ( HasRunner (..) )
+import           Stack.Types.SetupInfo ( SetupInfo (..) )
+import           Stack.Types.SourceMap ( SMActual (..), SourceMap (..) )
+import           Stack.Types.Version
+                   ( VersionCheck, stackMinorVersion, stackVersion )
+import           Stack.Types.VersionedDownloadInfo
+                   ( VersionedDownloadInfo (..) )
+import qualified System.Directory as D
+import           System.Environment ( getExecutablePath, lookupEnv )
+import           System.IO.Error ( isPermissionError )
+import           System.FilePath ( searchPathSeparator )
+import qualified System.FilePath as FP
+import           System.Permissions ( osIsWindows, setFileExecutable )
+import           System.Uname ( getRelease )
+
+-- | Type representing exceptions thrown by functions exported by the
+-- "Stack.Setup" module
+data SetupException
+  = WorkingDirectoryInvalidBug
+  | StackBinaryArchiveZipUnsupportedBug
+  deriving (Show, Typeable)
+
+instance Exception SetupException where
+  displayException WorkingDirectoryInvalidBug = bugReport "[S-2076]"
+    "Invalid working directory."
+  displayException StackBinaryArchiveZipUnsupportedBug = bugReport "[S-3967]"
+    "FIXME: Handle zip files."
+
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.Setup" module
+data SetupPrettyException
+  = GHCInstallFailed
+      !SomeException
+      !String
+      !String
+      ![String]
+      !(Path Abs Dir)
+      !(Path Abs Dir)
+      !(Path Abs Dir)
+  | InvalidGhcAt !(Path Abs File) !SomeException
+  | ExecutableNotFound ![Path Abs File]
+  | SandboxedCompilerNotFound ![String] ![Path Abs Dir]
+  | UnsupportedSetupCombo !OS !Arch
+  | MissingDependencies ![String]
+  | UnknownCompilerVersion
+      !(Set.Set Text)
+      !WantedCompiler
+      !(Set.Set ActualCompiler)
+  | UnknownOSKey !Text
+  | GHCSanityCheckCompileFailed !SomeException !(Path Abs File)
+  | RequireCustomGHCVariant
+  | ProblemWhileDecompressing !(Path Abs File)
+  | SetupInfoMissingSevenz
+  | UnsupportedSetupConfiguration
+  | MSYS2NotFound !Text
+  | UnwantedCompilerVersion
+  | UnwantedArchitecture
+  | GHCInfoNotValidUTF8 !UnicodeException
+  | GHCInfoNotListOfPairs
+  | GHCInfoMissingGlobalPackageDB
+  | GHCInfoMissingTargetPlatform
+  | GHCInfoTargetPlatformInvalid !String
+  | CabalNotFound !(Path Abs File)
+  | HadrianScriptNotFound
+  | URLInvalid !String
+  | UnknownArchiveExtension !String
+  | Unsupported7z
+  | TarballInvalid !String
+  | TarballFileInvalid !String !(Path Abs File)
+  | UnknownArchiveStructure !(Path Abs File)
+  | StackReleaseInfoNotFound !String
+  | StackBinaryArchiveNotFound ![String]
+  | HadrianBindistNotFound
+  | DownloadAndInstallCompilerError
+  | StackBinaryArchiveUnsupported !Text
+  | StackBinaryNotInArchive !String !Text
+  | FileTypeInArchiveInvalid !Tar.Entry !Text
+  | BinaryUpgradeOnOSUnsupported !Cabal.OS
+  | BinaryUpgradeOnArchUnsupported !Cabal.Arch
+  | ExistingMSYS2NotDeleted !(Path Abs Dir) !IOException
+  deriving (Show, Typeable)
+
+instance Pretty SetupPrettyException where
+  pretty (GHCInstallFailed ex step cmd args wd tempDir destDir) =
+    "[S-7441]"
+    <> line
+    <> string (displayException ex)
+    <> line
+    <> hang 2 (  fillSep
+                   [ flow "Error encountered while"
+                   , fromString step
+                   , flow "GHC with"
+                   ]
+              <> line
+              <> style Shell (fromString (unwords (cmd : args)))
+              <> line
+              -- TODO: Figure out how to insert \ in the appropriate spots
+              -- hang 2 (shellColor (fillSep (fromString cmd : map fromString args))) <> line <>
+              <> fillSep
+                   [ flow "run in"
+                   , pretty wd
+                   ]
+              )
+    <> blankLine
+    <> flow "The following directories may now contain files, but won't be \
+            \used by Stack:"
+    <> line
+    <> bulletedList [pretty tempDir, pretty destDir]
+    <> blankLine
+    <> fillSep
+         [ flow "For more information consider rerunning with"
+         , style Shell "--verbose"
+         , "flag."
+         ]
+    <> line
+  pretty (InvalidGhcAt compiler e) =
+    "[S-2476]"
+    <> line
+    <> fillSep
+         [ flow "Stack considers the compiler at"
+         , pretty compiler
+         , flow "to be invalid."
+         ]
+    <> blankLine
+    <> flow "While assessing that compiler, Stack encountered the error:"
+    <> blankLine
+    <> ppException e
+  pretty (ExecutableNotFound toTry) =
+    "[S-4764]"
+    <> line
+    <> flow "Stack could not find any of the following executables:"
+    <> line
+    <> bulletedList (map pretty toTry)
+  pretty (SandboxedCompilerNotFound names fps) =
+    "[S-9953]"
+    <> line
+    <> fillSep
+         ( ( flow "Stack could not find the sandboxed compiler. It looked for \
+                   \one named one of:"
+            : mkNarrativeList Nothing False
+                ( map fromString names :: [StyleDoc] )
+            )
+         <> ( flow "However, it could not find any on one of the paths:"
+            : mkNarrativeList Nothing False fps
+            )
+         )
+    <> blankLine
+    <> fillSep
+         [ flow "Perhaps a previously-installed compiler was not completely \
+                \uninstalled. For further information about uninstalling \
+                \tools, see the output of"
+         , style Shell (flow "stack uninstall") <> "."
+         ]
+  pretty (UnsupportedSetupCombo os arch) =
+    "[S-1852]"
+    <> line
+    <> fillSep
+         [ flow "Stack does not know how to install GHC for the combination of \
+                \operating system"
+         , fromString $ show os
+         , "and architecture"
+         , fromString $ show arch <> "."
+         , flow "Please install manually."
+         ]
+  pretty (MissingDependencies tools) =
+    "[S-2126]"
+    <> line
+    <> fillSep
+         ( flow "The following executables are missing and must be installed:"
+         : mkNarrativeList Nothing False (map fromString tools :: [StyleDoc])
+         )
+  pretty (UnknownCompilerVersion oskeys wanted known) =
+    "[S-9443]"
+    <> line
+    <> fillSep
+         (  ( flow "No setup information found for"
+            : style Current wanted'
+            : flow "on your platform. This probably means a GHC binary \
+                   \distribution has not yet been added for OS key"
+            : mkNarrativeList (Just Shell) False
+                (map (fromString . T.unpack) (sort $ Set.toList oskeys) :: [StyleDoc])
+            )
+         <> ( flow "Supported versions:"
+            : mkNarrativeList Nothing False
+                ( map
+                    (fromString . T.unpack . compilerVersionText)
+                    (sort $ Set.toList known)
+                    :: [StyleDoc]
+                )
+            )
+         )
+   where
+    wanted' = fromString . T.unpack . utf8BuilderToText $ display wanted
+  pretty (UnknownOSKey oskey) =
+    "[S-6810]"
+    <> line
+    <> fillSep
+         [ flow "Unable to find installation URLs for OS key:"
+         , fromString $ T.unpack oskey <> "."
+         ]
+  pretty (GHCSanityCheckCompileFailed e ghc) =
+    "[S-5159]"
+    <> line
+    <> fillSep
+         [ flow "The GHC located at"
+         , pretty ghc
+         , flow "failed to compile a sanity check. Please see:"
+         , style Url "http://docs.haskellstack.org/en/stable/install_and_upgrade/"
+         , flow "for more information. Stack encountered the following \
+                \error:"
+         ]
+    <> blankLine
+    <> string (displayException e)
+  pretty RequireCustomGHCVariant =
+    "[S-8948]"
+    <> line
+    <> fillSep
+         [ flow "A custom"
+         , style Shell "--ghc-variant"
+         , flow "must be specified to use"
+         , style Shell "--ghc-bindist" <> "."
+         ]
+  pretty (ProblemWhileDecompressing archive) =
+    "[S-2905]"
+    <> line
+    <> fillSep
+         [ flow "Problem while decompressing"
+         , pretty archive <> "."
+         ]
+  pretty SetupInfoMissingSevenz =
+    "[S-9561]"
+    <> line
+    <> flow "SetupInfo missing Sevenz EXE/DLL."
+  pretty UnsupportedSetupConfiguration =
+    "[S-7748]"
+    <> line
+    <> flow "Stack does not know how to install GHC on your system \
+            \configuration. Please install manually."
+  pretty (MSYS2NotFound osKey) =
+    "[S-5308]"
+    <> line
+    <> fillSep
+         [ flow "MSYS2 not found for"
+         , fromString $ T.unpack osKey <> "."
+         ]
+  pretty UnwantedCompilerVersion =
+    "[S-5127]"
+    <> line
+    <> flow "Not the compiler version we want."
+  pretty UnwantedArchitecture =
+    "[S-1540]"
+    <> line
+    <> flow "Not the architecture we want."
+  pretty (GHCInfoNotValidUTF8 e) =
+    "[S-8668]"
+    <> line
+    <> flow "GHC info is not valid UTF-8. Stack encountered the following \
+            \error:"
+    <> blankLine
+    <> string (displayException e)
+  pretty GHCInfoNotListOfPairs =
+    "[S-4878]"
+    <> line
+    <> flow "GHC info does not parse as a list of pairs."
+  pretty GHCInfoMissingGlobalPackageDB =
+    "[S-2965]"
+    <> line
+    <> flow "Key 'Global Package DB' not found in GHC info."
+  pretty GHCInfoMissingTargetPlatform =
+    "[S-5219]"
+    <> line
+    <> flow "Key 'Target platform' not found in GHC info."
+  pretty (GHCInfoTargetPlatformInvalid targetPlatform) =
+    "[S-8299]"
+    <> line
+    <> fillSep
+         [ flow "Invalid target platform in GHC info:"
+         , fromString targetPlatform <> "."
+         ]
+  pretty (CabalNotFound compiler) =
+    "[S-2574]"
+    <> line
+    <> fillSep
+         [ flow "Cabal library not found in global package database for"
+         , pretty compiler <> "."
+         ]
+  pretty HadrianScriptNotFound =
+    "[S-1128]"
+    <> line
+    <> flow "No Hadrian build script found."
+  pretty (URLInvalid url) =
+    "[S-1906]"
+    <> line
+    <> fillSep
+         [ flow "`url` must be either an HTTP URL or a file path:"
+         , fromString url <> "."
+         ]
+  pretty (UnknownArchiveExtension url) =
+    "[S-1648]"
+    <> line
+    <> fillSep
+         [ flow "Unknown extension for url:"
+         , style Url (fromString url) <> "."
+         ]
+  pretty Unsupported7z =
+    "[S-4509]"
+    <> line
+    <> fillSep
+         [ flow "Stack does not know how to deal with"
+         , style File ".7z"
+         , flow "files on non-Windows operating systems."
+         ]
+  pretty (TarballInvalid name) =
+    "[S-3158]"
+    <> line
+    <> fillSep
+         [ style File (fromString name)
+         , flow "must be a tarball file."
+         ]
+  pretty (TarballFileInvalid name archiveFile) =
+    "[S-5252]"
+    <> line
+    <> fillSep
+         [ "Invalid"
+         , style File (fromString name)
+         , "filename:"
+         , pretty archiveFile <> "."
+         ]
+  pretty (UnknownArchiveStructure archiveFile) =
+    "[S-1827]"
+    <> line
+    <> fillSep
+         [ flow "Expected a single directory within unpacked"
+         , pretty archiveFile <> "."
+         ]
+  pretty (StackReleaseInfoNotFound url) =
+    "[S-9476]"
+    <> line
+    <> fillSep
+         [ flow "Could not get release information for Stack from:"
+         , style Url (fromString url) <> "."
+         ]
+  pretty (StackBinaryArchiveNotFound platforms) =
+    "[S-4461]"
+    <> line
+    <> fillSep
+         ( flow "Unable to find binary Stack archive for platforms:"
+         : mkNarrativeList Nothing False
+             (map fromString platforms :: [StyleDoc])
+         )
+  pretty HadrianBindistNotFound =
+    "[S-6617]"
+    <> line
+    <> flow "Can't find Hadrian-generated binary distribution."
+  pretty DownloadAndInstallCompilerError =
+    "[S-7227]"
+    <> line
+    <> flow "'downloadAndInstallCompiler' should not be reached with ghc-git."
+  pretty (StackBinaryArchiveUnsupported archiveURL) =
+    "[S-6636]"
+    <> line
+    <> fillSep
+         [ flow "Unknown archive format for Stack archive:"
+         , style Url (fromString $ T.unpack archiveURL) <> "."
+         ]
+  pretty (StackBinaryNotInArchive exeName url) =
+    "[S-7871]"
+    <> line
+    <> fillSep
+         [ flow "Stack executable"
+         , style File (fromString exeName)
+         , flow "not found in archive from"
+         , style Url (fromString $ T.unpack url) <> "."
+         ]
+  pretty (FileTypeInArchiveInvalid e url) =
+    "[S-5046]"
+    <> line
+    <> fillSep
+         [ flow "Invalid file type for tar entry named"
+         , fromString (Tar.entryPath e)
+         , flow "downloaded from"
+         , style Url (fromString $ T.unpack url) <> "."
+         ]
+  pretty (BinaryUpgradeOnOSUnsupported os) =
+    "[S-4132]"
+    <> line
+    <> fillSep
+         [ flow "Binary upgrade not yet supported on OS:"
+         , fromString (show os) <> "."
+         ]
+  pretty (BinaryUpgradeOnArchUnsupported arch) =
+    "[S-3249]"
+    <> line
+    <> fillSep
+         [ flow "Binary upgrade not yet supported on architecture:"
+         , fromString (show arch) <> "."
+         ]
+  pretty (ExistingMSYS2NotDeleted destDir e) =
+    "[S-4230]"
+    <> line
+    <> fillSep
+         [ flow "Could not delete existing MSYS2 directory:"
+         , pretty destDir <> "."
+         , flow "Stack encountered the following error:"
+         ]
+    <> blankLine
+    <> string (displayException e)
+
+instance Exception SetupPrettyException
+
+-- | Type representing exceptions thrown by 'performPathChecking'
+data PerformPathCheckingException
+  = ProcessExited ExitCode String [String]
+  deriving (Show, Typeable)
+
+instance Exception PerformPathCheckingException where
+  displayException (ProcessExited ec cmd args) = concat
+    [ "Error: [S-1991]\n"
+    , "Process exited with "
+    , displayException ec
+    , ": "
+    , unwords (cmd:args)
+    ]
+
+-- | Default location of the stack-setup.yaml file
+defaultSetupInfoYaml :: String
+defaultSetupInfoYaml =
+  "https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml"
+
+data SetupOpts = SetupOpts
+  { soptsInstallIfMissing :: !Bool
+  , soptsUseSystem :: !Bool
+    -- ^ Should we use a system compiler installation, if available?
+  , soptsWantedCompiler :: !WantedCompiler
+  , soptsCompilerCheck :: !VersionCheck
+  , soptsStackYaml :: !(Maybe (Path Abs File))
+    -- ^ If we got the desired GHC version from that file
+  , soptsForceReinstall :: !Bool
+  , soptsSanityCheck :: !Bool
+    -- ^ Run a sanity check on the selected GHC
+  , soptsSkipGhcCheck :: !Bool
+    -- ^ Don't check for a compatible GHC version/architecture
+  , soptsSkipMsys :: !Bool
+    -- ^ Do not use a custom msys installation on Windows
+  , soptsResolveMissingGHC :: !(Maybe Text)
+    -- ^ Message shown to user for how to resolve the missing GHC
+  , soptsGHCBindistURL :: !(Maybe String)
+    -- ^ Alternate GHC binary distribution (requires custom GHCVariant)
+  }
+  deriving Show
+
+-- | Modify the environment variables (like PATH) appropriately, possibly doing
+-- installation too
+setupEnv ::
+     NeedTargets
+  -> BuildOptsCLI
+  -> Maybe Text -- ^ Message to give user when necessary GHC is not available
+  -> RIO BuildConfig EnvConfig
+setupEnv needTargets boptsCLI mResolveMissingGHC = do
+  config <- view configL
+  bc <- view buildConfigL
+  let stackYaml = bcStackYaml bc
+  platform <- view platformL
+  wcVersion <- view wantedCompilerVersionL
+  wanted <- view wantedCompilerVersionL
+  actual <- either throwIO pure $ wantedToActual wanted
+  let wc = actual^.whichCompilerL
+  let sopts = SetupOpts
+        { soptsInstallIfMissing = configInstallGHC config
+        , soptsUseSystem = configSystemGHC config
+        , soptsWantedCompiler = wcVersion
+        , soptsCompilerCheck = configCompilerCheck config
+        , soptsStackYaml = Just stackYaml
+        , soptsForceReinstall = False
+        , soptsSanityCheck = False
+        , soptsSkipGhcCheck = configSkipGHCCheck config
+        , soptsSkipMsys = configSkipMsys config
+        , soptsResolveMissingGHC = mResolveMissingGHC
+        , soptsGHCBindistURL = Nothing
+        }
+
+  (compilerPaths, ghcBin) <- ensureCompilerAndMsys sopts
+  let compilerVer = cpCompilerVersion compilerPaths
+
+  -- Modify the initial environment to include the GHC path, if a local GHC
+  -- is being used
+  menv0 <- view processContextL
+  env <- either throwM (pure . removeHaskellEnvVars)
+           $ augmentPathMap
+               (map toFilePath $ edBins ghcBin)
+               (view envVarsL menv0)
+  menv <- mkProcessContext env
+
+  logDebug "Resolving package entries"
+
+  (sourceMap, sourceMapHash) <- runWithGHC menv compilerPaths $ do
+    smActual <- actualFromGhc (bcSMWanted bc) compilerVer
+    let actualPkgs = Map.keysSet (smaDeps smActual) <>
+                     Map.keysSet (smaProject smActual)
+        prunedActual = smActual
+          { smaGlobal = pruneGlobals (smaGlobal smActual) actualPkgs }
+        haddockDeps = shouldHaddockDeps (configBuild config)
+    targets <- parseTargets needTargets haddockDeps boptsCLI prunedActual
+    sourceMap <- loadSourceMap targets boptsCLI smActual
+    sourceMapHash <- hashSourceMapData boptsCLI sourceMap
+    pure (sourceMap, sourceMapHash)
+
+  let envConfig0 = EnvConfig
+        { envConfigBuildConfig = bc
+        , envConfigBuildOptsCLI = boptsCLI
+        , envConfigSourceMap = sourceMap
+        , envConfigSourceMapHash = sourceMapHash
+        , envConfigCompilerPaths = compilerPaths
+        }
+
+  -- extra installation bin directories
+  mkDirs <- runRIO envConfig0 extraBinDirs
+  let mpath = Map.lookup "PATH" env
+  depsPath <-
+    either throwM pure $ augmentPath (toFilePath <$> mkDirs False) mpath
+  localsPath <-
+    either throwM pure $ augmentPath (toFilePath <$> mkDirs True) mpath
+
+  deps <- runRIO envConfig0 packageDatabaseDeps
+  runWithGHC menv compilerPaths $ createDatabase (cpPkg compilerPaths) deps
+  localdb <- runRIO envConfig0 packageDatabaseLocal
+  runWithGHC menv compilerPaths $ createDatabase (cpPkg compilerPaths) localdb
+  extras <- runReaderT packageDatabaseExtra envConfig0
+  let mkGPP locals =
+        mkGhcPackagePath locals localdb deps extras $ cpGlobalDB compilerPaths
+
+  distDir <- runReaderT distRelativeDir envConfig0 >>= canonicalizePath
+
+  executablePath <- liftIO getExecutablePath
+
+  utf8EnvVars <- withProcessContext menv $ getUtf8EnvVars compilerVer
+
+  mGhcRtsEnvVar <- liftIO $ lookupEnv "GHCRTS"
+
+  envRef <- liftIO $ newIORef Map.empty
+  let getProcessContext' es = do
+        m <- readIORef envRef
+        case Map.lookup es m of
+          Just eo -> pure eo
+          Nothing -> do
+            eo <- mkProcessContext
+              $ Map.insert
+                  "PATH"
+                  (if esIncludeLocals es then localsPath else depsPath)
+              $ (if esIncludeGhcPackagePath es
+                   then
+                     Map.insert
+                       (ghcPkgPathEnvVar wc)
+                       (mkGPP (esIncludeLocals es))
+                   else id)
+
+              $ (if esStackExe es
+                   then Map.insert "STACK_EXE" (T.pack executablePath)
+                   else id)
+
+              $ (if esLocaleUtf8 es
+                   then Map.union utf8EnvVars
+                   else id)
+
+              $ case (soptsSkipMsys sopts, platform) of
+                  (False, Platform Cabal.I386   Cabal.Windows) ->
+                    Map.insert "MSYSTEM" "MINGW32"
+                  (False, Platform Cabal.X86_64 Cabal.Windows) ->
+                    Map.insert "MSYSTEM" "MINGW64"
+                  _ -> id
+
+              -- See https://github.com/commercialhaskell/stack/issues/3444
+              $ case (esKeepGhcRts es, mGhcRtsEnvVar) of
+                  (True, Just ghcRts) -> Map.insert "GHCRTS" (T.pack ghcRts)
+                  _ -> id
+
+              -- For reasoning and duplication, see:
+              -- https://github.com/commercialhaskell/stack/issues/70
+              $ Map.insert
+                  "HASKELL_PACKAGE_SANDBOX"
+                  (T.pack $ toFilePathNoTrailingSep deps)
+              $ Map.insert "HASKELL_PACKAGE_SANDBOXES"
+                  (T.pack $ if esIncludeLocals es
+                    then intercalate [searchPathSeparator]
+                           [ toFilePathNoTrailingSep localdb
+                           , toFilePathNoTrailingSep deps
+                           , ""
+                           ]
+                    else intercalate [searchPathSeparator]
+                           [ toFilePathNoTrailingSep deps
+                           , ""
+                           ])
+              $ Map.insert
+                  "HASKELL_DIST_DIR"
+                  (T.pack $ toFilePathNoTrailingSep distDir)
+
+                -- Make sure that any .ghc.environment files
+                -- are ignored, since we're setting up our
+                -- own package databases. See
+                -- https://github.com/commercialhaskell/stack/issues/4706
+              $ (case cpCompilerVersion compilerPaths of
+                  ACGhc version | version >= mkVersion [8, 4, 4] ->
+                    Map.insert "GHC_ENVIRONMENT" "-"
+                  _ -> id)
+
+                env
+
+            () <- atomicModifyIORef envRef $ \m' ->
+                (Map.insert es eo m', ())
+            pure eo
+
+  envOverride <- liftIO $ getProcessContext' minimalEnvSettings
+  pure EnvConfig
+    { envConfigBuildConfig = bc
+        { bcConfig = addIncludeLib ghcBin
+                   $ set processContextL envOverride
+                     (view configL bc)
+            { configProcessContextSettings = getProcessContext'
+            }
+        }
+    , envConfigBuildOptsCLI = boptsCLI
+    , envConfigSourceMap = sourceMap
+    , envConfigSourceMapHash = sourceMapHash
+    , envConfigCompilerPaths = compilerPaths
+    }
+
+-- | A modified env which we know has an installed compiler on the PATH.
+data WithGHC env = WithGHC !CompilerPaths !env
+
+insideL :: Lens' (WithGHC env) env
+insideL = lens (\(WithGHC _ x) -> x) (\(WithGHC cp _) -> WithGHC cp)
+
+instance HasLogFunc env => HasLogFunc (WithGHC env) where
+  logFuncL = insideL.logFuncL
+
+instance HasRunner env => HasRunner (WithGHC env) where
+  runnerL = insideL.runnerL
+
+instance HasProcessContext env => HasProcessContext (WithGHC env) where
+  processContextL = insideL.processContextL
+
+instance HasStylesUpdate env => HasStylesUpdate (WithGHC env) where
+  stylesUpdateL = insideL.stylesUpdateL
+
+instance HasTerm env => HasTerm (WithGHC env) where
+  useColorL = insideL.useColorL
+  termWidthL = insideL.termWidthL
+
+instance HasPantryConfig env => HasPantryConfig (WithGHC env) where
+  pantryConfigL = insideL.pantryConfigL
+
+instance HasConfig env => HasPlatform (WithGHC env) where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
+instance HasConfig env => HasGHCVariant (WithGHC env) where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
+instance HasConfig env => HasConfig (WithGHC env) where
+  configL = insideL.configL
+
+instance HasBuildConfig env => HasBuildConfig (WithGHC env) where
+  buildConfigL = insideL.buildConfigL
+
+instance HasCompiler (WithGHC env) where
+  compilerPathsL = to (\(WithGHC cp _) -> cp)
+
+-- | Set up a modified environment which includes the modified PATH that GHC can
+-- be found on. This is needed for looking up global package information and ghc
+-- fingerprint (result from 'ghc --info').
+runWithGHC ::
+     HasConfig env
+  => ProcessContext
+  -> CompilerPaths
+  -> RIO (WithGHC env) a
+  -> RIO env a
+runWithGHC pc cp inner = do
+  env <- ask
+  let envg
+        = WithGHC cp $
+          set envOverrideSettingsL (\_ -> pure pc) $
+          set processContextL pc env
+  runRIO envg inner
+
+-- | special helper for GHCJS which needs an updated source map
+-- only project dependencies should get included otherwise source map hash will
+-- get changed and EnvConfig will become inconsistent
+rebuildEnv ::
+     EnvConfig
+  -> NeedTargets
+  -> Bool
+  -> BuildOptsCLI
+  -> RIO env EnvConfig
+rebuildEnv envConfig needTargets haddockDeps boptsCLI = do
+  let bc = envConfigBuildConfig envConfig
+      cp = envConfigCompilerPaths envConfig
+      compilerVer = smCompiler $ envConfigSourceMap envConfig
+  runRIO (WithGHC cp bc) $ do
+    smActual <- actualFromGhc (bcSMWanted bc) compilerVer
+    let actualPkgs =
+          Map.keysSet (smaDeps smActual) <> Map.keysSet (smaProject smActual)
+        prunedActual = smActual
+          { smaGlobal = pruneGlobals (smaGlobal smActual) actualPkgs }
+    targets <- parseTargets needTargets haddockDeps boptsCLI prunedActual
+    sourceMap <- loadSourceMap targets boptsCLI smActual
+    pure $ envConfig
+      { envConfigSourceMap = sourceMap
+      , envConfigBuildOptsCLI = boptsCLI
+      }
+
+-- | Some commands (script, ghci and exec) set targets dynamically
+-- see also the note about only local targets for rebuildEnv
+withNewLocalBuildTargets ::
+     HasEnvConfig  env
+  => [Text]
+  -> RIO env a
+  -> RIO env a
+withNewLocalBuildTargets targets f = do
+  envConfig <- view envConfigL
+  haddockDeps <- view $ configL.to configBuild.to shouldHaddockDeps
+  let boptsCLI = envConfigBuildOptsCLI envConfig
+  envConfig' <- rebuildEnv envConfig NeedTargets haddockDeps $
+                boptsCLI {boptsCLITargets = targets}
+  local (set envConfigL envConfig') f
+
+-- | Add the include and lib paths to the given Config
+addIncludeLib :: ExtraDirs -> Config -> Config
+addIncludeLib (ExtraDirs _bins includes libs) config = config
+  { configExtraIncludeDirs =
+      configExtraIncludeDirs config ++
+      map toFilePathNoTrailingSep includes
+  , configExtraLibDirs =
+      configExtraLibDirs config ++
+      map toFilePathNoTrailingSep libs
+  }
+
+-- | Ensure both the compiler and the msys toolchain are installed and
+-- provide the PATHs to add if necessary
+ensureCompilerAndMsys ::
+     (HasBuildConfig env, HasGHCVariant env)
+  => SetupOpts
+  -> RIO env (CompilerPaths, ExtraDirs)
+ensureCompilerAndMsys sopts = do
+  getSetupInfo' <- memoizeRef getSetupInfo
+  mmsys2Tool <- ensureMsys sopts getSetupInfo'
+  msysPaths <- maybe (pure Nothing) (fmap Just . extraDirs) mmsys2Tool
+
+  actual <- either throwIO pure $ wantedToActual $ soptsWantedCompiler sopts
+  didWarn <- warnUnsupportedCompiler $ getGhcVersion actual
+
+  (cp, ghcPaths) <- ensureCompiler sopts getSetupInfo'
+
+  warnUnsupportedCompilerCabal cp didWarn
+
+  let paths = maybe ghcPaths (ghcPaths <>) msysPaths
+  pure (cp, paths)
+
+-- | See <https://github.com/commercialhaskell/stack/issues/4246>
+warnUnsupportedCompiler :: HasTerm env => Version -> RIO env Bool
+warnUnsupportedCompiler ghcVersion =
+  if
+    | ghcVersion < mkVersion [7, 8] -> do
+        prettyWarnL
+          [ flow "Stack will almost certainly fail with GHC below version 7.8, \
+                 \requested"
+          , fromString (versionString ghcVersion) <> "."
+          , flow "Valiantly attempting to run anyway, but I know this is \
+                 \doomed."
+          , flow "For more information, see:"
+          , style Url "https://github.com/commercialhaskell/stack/issues/648" <> "."
+          ]
+        pure True
+    | ghcVersion >= mkVersion [9, 5] -> do
+        prettyWarnL
+          [ flow "Stack has not been tested with GHC versions above 9.6, and \
+                 \using"
+          , fromString (versionString ghcVersion) <> ","
+          , flow "this may fail."
+          ]
+        pure True
+    | otherwise -> do
+        logDebug "Asking for a supported GHC version"
+        pure False
+
+-- | See <https://github.com/commercialhaskell/stack/issues/4246>
+warnUnsupportedCompilerCabal ::
+     HasTerm env
+  => CompilerPaths
+  -> Bool -- ^ already warned about GHC?
+  -> RIO env ()
+warnUnsupportedCompilerCabal cp didWarn = do
+  unless didWarn $
+    void $ warnUnsupportedCompiler $ getGhcVersion $ cpCompilerVersion cp
+  let cabalVersion = cpCabalVersion cp
+
+  if
+    | cabalVersion < mkVersion [1, 19, 2] -> do
+        prettyWarnL
+          [ flow "Stack no longer supports Cabal versions below 1.19.2, but \
+                 \version"
+          , fromString (versionString cabalVersion)
+          , flow "was found. This invocation will most likely fail. To fix \
+                 \this, either use an older version of Stack or a newer \
+                 \resolver. Acceptable resolvers: lts-3.0/nightly-2015-05-05 \
+                 \or later."
+          ]
+    | cabalVersion >= mkVersion [3, 9] ->
+        prettyWarnL
+          [ flow "Stack has not been tested with Cabal versions above 3.10, \
+                 \but version"
+          , fromString (versionString cabalVersion)
+          , flow "was found, this may fail."
+          ]
+    | otherwise -> pure ()
+
+-- | Ensure that the msys toolchain is installed if necessary and provide the
+-- PATHs to add if necessary
+ensureMsys ::
+     HasBuildConfig env
+  => SetupOpts
+  -> Memoized SetupInfo
+  -> RIO env (Maybe Tool)
+ensureMsys sopts getSetupInfo' = do
+  platform <- view platformL
+  localPrograms <- view $ configL.to configLocalPrograms
+  installed <- listInstalled localPrograms
+
+  case platform of
+    Platform _ Cabal.Windows | not (soptsSkipMsys sopts) ->
+      case getInstalledTool installed (mkPackageName "msys2") (const True) of
+        Just tool -> pure (Just tool)
+        Nothing
+          | soptsInstallIfMissing sopts -> do
+              si <- runMemoized getSetupInfo'
+              osKey <- getOSKey platform
+              config <- view configL
+              VersionedDownloadInfo version info <-
+                case Map.lookup osKey $ siMsys2 si of
+                  Just x -> pure x
+                  Nothing -> prettyThrowIO $ MSYS2NotFound osKey
+              let tool = Tool (PackageIdentifier (mkPackageName "msys2") version)
+              Just <$> downloadAndInstallTool
+                         (configLocalPrograms config)
+                         info
+                         tool
+                         (installMsys2Windows si)
+          | otherwise -> do
+              prettyWarnS "Continuing despite missing tool: msys2"
+              pure Nothing
+    _ -> pure Nothing
+
+installGhcBindist ::
+     HasBuildConfig env
+  => SetupOpts
+  -> Memoized SetupInfo
+  -> [Tool]
+  -> RIO env (Tool, CompilerBuild)
+installGhcBindist sopts getSetupInfo' installed = do
+  Platform expectedArch _ <- view platformL
+  let wanted = soptsWantedCompiler sopts
+      isWanted =
+        isWantedCompiler (soptsCompilerCheck sopts) (soptsWantedCompiler sopts)
+  config <- view configL
+  ghcVariant <- view ghcVariantL
+  wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted
+  possibleCompilers <-
+    case wc of
+      Ghc -> do
+        ghcBuilds <- getGhcBuilds
+        forM ghcBuilds $ \ghcBuild -> do
+          ghcPkgName <- parsePackageNameThrowing
+            (  "ghc"
+            ++ ghcVariantSuffix ghcVariant
+            ++ compilerBuildSuffix ghcBuild
+            )
+          pure (getInstalledTool installed ghcPkgName (isWanted . ACGhc), ghcBuild)
+  let existingCompilers = concatMap
+        (\(installedCompiler, compilerBuild) ->
+          case (installedCompiler, soptsForceReinstall sopts) of
+            (Just tool, False) -> [(tool, compilerBuild)]
+            _ -> [])
+        possibleCompilers
+  logDebug $
+       "Found already installed GHC builds: "
+    <> mconcat (intersperse ", " (map (fromString . compilerBuildName . snd) existingCompilers))
+  case existingCompilers of
+    (tool, build_):_ -> pure (tool, build_)
+    []
+      | soptsInstallIfMissing sopts -> do
+          si <- runMemoized getSetupInfo'
+          downloadAndInstallPossibleCompilers
+            (map snd possibleCompilers)
+            si
+            (soptsWantedCompiler sopts)
+            (soptsCompilerCheck sopts)
+            (soptsGHCBindistURL sopts)
+      | otherwise -> do
+          let suggestion = fromMaybe
+                (mconcat
+                  [ "To install the correct GHC into "
+                  , T.pack (toFilePath (configLocalPrograms config))
+                  , ", try running 'stack setup' or use the '--install-ghc' flag."
+                  , " To use your system GHC installation, run \
+                    \'stack config set system-ghc --global true', \
+                    \or use the '--system-ghc' flag."
+                  ])
+                (soptsResolveMissingGHC sopts)
+          throwM $ CompilerVersionMismatch
+            Nothing -- FIXME ((\(x, y, _) -> (x, y)) <$> msystem)
+            (soptsWantedCompiler sopts, expectedArch)
+            ghcVariant
+            (case possibleCompilers of
+              [] -> CompilerBuildStandard
+              (_, compilerBuild):_ -> compilerBuild)
+            (soptsCompilerCheck sopts)
+            (soptsStackYaml sopts)
+            suggestion
+
+-- | Ensure compiler is installed, without worrying about msys
+ensureCompiler ::
+     forall env. (HasConfig env, HasBuildConfig env, HasGHCVariant env)
+  => SetupOpts
+  -> Memoized SetupInfo
+  -> RIO env (CompilerPaths, ExtraDirs)
+ensureCompiler sopts getSetupInfo' = do
+  let wanted = soptsWantedCompiler sopts
+  wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted
+
+  hook <- ghcInstallHook
+  hookIsExecutable <- handleIO (\_ -> pure False) $ if osIsWindows
+    then doesFileExist hook  -- can't really detect executable on windows, only
+                             -- file extension
+    else executable <$> getPermissions hook
+
+  Platform expectedArch _ <- view platformL
+
+  let canUseCompiler cp
+        | soptsSkipGhcCheck sopts = pure cp
+        | not $ isWanted $ cpCompilerVersion cp =
+            prettyThrowIO UnwantedCompilerVersion
+        | cpArch cp /= expectedArch = prettyThrowIO UnwantedArchitecture
+        | otherwise = pure cp
+      isWanted =
+        isWantedCompiler (soptsCompilerCheck sopts) (soptsWantedCompiler sopts)
+
+  let checkCompiler :: Path Abs File -> RIO env (Maybe CompilerPaths)
+      checkCompiler compiler = do
+        eres <- tryAny $
+          pathsFromCompiler wc CompilerBuildStandard False compiler >>= canUseCompiler
+        case eres of
+          Left e -> do
+            logDebug $
+                 "Not using compiler at "
+              <> displayShow (toFilePath compiler)
+              <> ": "
+              <> displayShow e
+            pure Nothing
+          Right cp -> pure $ Just cp
+
+  mcp <-
+    if | soptsUseSystem sopts -> do
+          logDebug "Getting system compiler version"
+          runConduit $
+            sourceSystemCompilers wanted .|
+            concatMapMC checkCompiler .|
+            await
+       | hookIsExecutable -> do
+        -- if the hook fails, we fall through to stacks sandboxed installation
+          hookGHC <- runGHCInstallHook sopts hook
+          maybe (pure Nothing) checkCompiler hookGHC
+       | otherwise -> pure Nothing
+  case mcp of
+    Nothing -> ensureSandboxedCompiler sopts getSetupInfo'
+    Just cp -> do
+      let paths = ExtraDirs
+            { edBins = [parent $ cpCompiler cp]
+            , edInclude = [], edLib = []
+            }
+      pure (cp, paths)
+
+
+-- | Runs @STACK_ROOT\/hooks\/ghc-install.sh@.
+--
+-- Reads and possibly validates the output of the process as the GHC binary and
+-- returns it.
+runGHCInstallHook ::
+     HasBuildConfig env
+  => SetupOpts
+  -> Path Abs File
+  -> RIO env (Maybe (Path Abs File))
+runGHCInstallHook sopts hook = do
+  logDebug "Getting hook installed compiler version"
+  let wanted = soptsWantedCompiler sopts
+  menv0 <- view processContextL
+  menv <- mkProcessContext (Map.union (wantedCompilerToEnv wanted) $
+    removeHaskellEnvVars (view envVarsL menv0))
+  (exit, out) <- withProcessContext menv $ proc "sh" [toFilePath hook] readProcessStdout
+  case exit of
+    ExitSuccess -> do
+      let ghcPath = stripNewline . TL.unpack . TL.decodeUtf8With T.lenientDecode $ out
+      case parseAbsFile ghcPath of
+        Just compiler -> do
+          when (soptsSanityCheck sopts) $ sanityCheck compiler
+          logDebug ("Using GHC compiler at: " <> fromString (toFilePath compiler))
+          pure (Just compiler)
+        Nothing -> do
+          prettyWarnL
+            [ flow "Path to GHC binary is not a valid path:"
+            , style Dir (fromString ghcPath) <> "."
+            ]
+          pure Nothing
+    ExitFailure i -> do
+      prettyWarnL
+        [ flow "GHC install hook exited with code:"
+        , style Error (fromString $ show i) <> "."
+        ]
+      pure Nothing
+ where
+  wantedCompilerToEnv :: WantedCompiler -> EnvVars
+  wantedCompilerToEnv (WCGhc ver) =
+    Map.fromList [ ("HOOK_GHC_TYPE", "bindist")
+                 , ("HOOK_GHC_VERSION", T.pack (versionString ver))
+                 ]
+  wantedCompilerToEnv (WCGhcGit commit flavor) =
+    Map.fromList [ ("HOOK_GHC_TYPE", "git")
+                 , ("HOOK_GHC_COMMIT", commit)
+                 , ("HOOK_GHC_FLAVOR", flavor)
+                 , ("HOOK_GHC_FLAVOUR", flavor)
+                 ]
+  wantedCompilerToEnv (WCGhcjs ghcjs_ver ghc_ver) =
+    Map.fromList [ ("HOOK_GHC_TYPE", "ghcjs")
+                 , ("HOOK_GHC_VERSION", T.pack (versionString ghc_ver))
+                 , ("HOOK_GHCJS_VERSION", T.pack (versionString ghcjs_ver))
+                 ]
+  newlines :: [Char]
+  newlines = ['\n', '\r']
+
+  stripNewline :: String -> String
+  stripNewline = filter (`notElem` newlines)
+
+ensureSandboxedCompiler ::
+     HasBuildConfig env
+  => SetupOpts
+  -> Memoized SetupInfo
+  -> RIO env (CompilerPaths, ExtraDirs)
+ensureSandboxedCompiler sopts getSetupInfo' = do
+  let wanted = soptsWantedCompiler sopts
+  -- List installed tools
+  config <- view configL
+  let localPrograms = configLocalPrograms config
+  installed <- listInstalled localPrograms
+  logDebug $
+       "Installed tools: \n - "
+    <> mconcat (intersperse "\n - " (map (fromString . toolString) installed))
+  (compilerTool, compilerBuild) <-
+    case soptsWantedCompiler sopts of
+     -- shall we build GHC from source?
+     WCGhcGit commitId flavour ->
+       buildGhcFromSource
+         getSetupInfo'
+         installed
+         (configCompilerRepository config)
+         commitId
+         flavour
+     _ -> installGhcBindist sopts getSetupInfo' installed
+  paths <- extraDirs compilerTool
+
+  wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted
+  menv0 <- view processContextL
+  m <- either throwM pure
+     $ augmentPathMap (toFilePath <$> edBins paths) (view envVarsL menv0)
+  menv <- mkProcessContext (removeHaskellEnvVars m)
+
+  names <-
+    case wanted of
+      WCGhc version -> pure ["ghc-" ++ versionString version, "ghc"]
+      WCGhcGit{} -> pure ["ghc"]
+      WCGhcjs{} -> throwIO GhcjsNotSupported
+
+  -- Previously, we used findExecutable to locate these executables. This was
+  -- actually somewhat sloppy, as it could discover executables outside of the
+  -- sandbox. This led to a specific issue on Windows with GHC 9.0.1. See
+  -- https://gitlab.haskell.org/ghc/ghc/-/issues/20074. Instead, now, we look
+  -- on the paths specified only.
+  let loop [] = prettyThrowIO $ SandboxedCompilerNotFound names (edBins paths)
+      loop (x:xs) = do
+        res <- liftIO $
+          D.findExecutablesInDirectories (map toFilePath (edBins paths)) x
+        case res of
+          [] -> loop xs
+          compiler:rest -> do
+            unless (null rest) $ do
+              prettyWarn $
+                   flow "Found multiple candidate compilers:"
+                <> line
+                <> bulletedList (map fromString res)
+                <> blankLine
+                <> fillSep
+                     [ flow "This usually indicates a failed installation. \
+                        \Trying anyway with"
+                     , fromString compiler
+                     ]
+            parseAbsFile compiler
+  compiler <- withProcessContext menv $ do
+    compiler <- loop names
+
+    -- Run this here to ensure that the sanity check uses the modified
+    -- environment, otherwise we may infect GHC_PACKAGE_PATH and break sanity
+    -- checks.
+    when (soptsSanityCheck sopts) $ sanityCheck compiler
+
+    pure compiler
+
+  cp <- pathsFromCompiler wc compilerBuild True compiler
+  pure (cp, paths)
+
+pathsFromCompiler ::
+     forall env. HasConfig env
+  => WhichCompiler
+  -> CompilerBuild
+  -> Bool
+  -> Path Abs File -- ^ executable filepath
+  -> RIO env CompilerPaths
+pathsFromCompiler wc compilerBuild isSandboxed compiler =
+  withCache $ handleAny onErr $ do
+    let dir = toFilePath $ parent compiler
+
+        suffixNoVersion
+          | osIsWindows = ".exe"
+          | otherwise = ""
+        msuffixWithVersion = do
+          let prefix =
+                case wc of
+                  Ghc -> "ghc-"
+          fmap ("-" ++) $ stripPrefix prefix $ toFilePath $ filename compiler
+        suffixes = maybe id (:) msuffixWithVersion [suffixNoVersion]
+        findHelper :: (WhichCompiler -> [String]) -> RIO env (Path Abs File)
+        findHelper getNames = do
+          toTry <- mapM
+                     parseAbsFile
+                     [ dir ++ name ++ suffix
+                     | suffix <- suffixes, name <- getNames wc
+                     ]
+          let loop [] = throwIO $ PrettyException $ ExecutableNotFound toTry
+              loop (guessedPath:rest) = do
+                exists <- doesFileExist guessedPath
+                if exists
+                  then pure guessedPath
+                  else loop rest
+          prettyDebug $
+               flow "Looking for executable(s):"
+            <> line
+            <> bulletedList (map pretty toTry)
+          loop toTry
+    pkg <- fmap GhcPkgExe $ findHelper $ \case
+                               Ghc -> ["ghc-pkg"]
+
+    menv0 <- view processContextL
+    menv <- mkProcessContext (removeHaskellEnvVars (view envVarsL menv0))
+
+    interpreter <- findHelper $
+                   \case
+                      Ghc -> ["runghc"]
+    haddock <- findHelper $
+               \case
+                  Ghc -> ["haddock", "haddock-ghc"]
+    infobs <- proc (toFilePath compiler) ["--info"]
+            $ fmap (toStrictBytes . fst) . readProcess_
+    infotext <-
+      case decodeUtf8' infobs of
+        Left e -> prettyThrowIO $ GHCInfoNotValidUTF8 e
+        Right info -> pure info
+    infoPairs :: [(String, String)] <-
+      case readMaybe $ T.unpack infotext of
+        Nothing -> prettyThrowIO GHCInfoNotListOfPairs
+        Just infoPairs -> pure infoPairs
+    let infoMap = Map.fromList infoPairs
+
+    eglobaldb <- tryAny $
+      case Map.lookup "Global Package DB" infoMap of
+        Nothing -> prettyThrowIO GHCInfoMissingGlobalPackageDB
+        Just db -> parseAbsDir db
+
+    arch <-
+      case Map.lookup "Target platform" infoMap of
+        Nothing -> prettyThrowIO GHCInfoMissingTargetPlatform
+        Just targetPlatform ->
+          case simpleParse $ takeWhile (/= '-') targetPlatform of
+            Nothing ->
+              prettyThrowIO $ GHCInfoTargetPlatformInvalid targetPlatform
+            Just arch -> pure arch
+    compilerVer <-
+      case wc of
+        Ghc ->
+          case Map.lookup "Project version" infoMap of
+            Nothing -> do
+              prettyWarnS "Key 'Project version' not found in GHC info."
+              getCompilerVersion wc compiler
+            Just versionString' -> ACGhc <$> parseVersionThrowing versionString'
+    globaldb <-
+      case eglobaldb of
+        Left e -> do
+          prettyWarn $
+               flow "Stack failed to parse the global DB from GHC info."
+            <> blankLine
+            <> flow "While parsing, Stack encountered the error:"
+            <> blankLine
+            <> string (show e)
+            <> blankLine
+            <> flow "Asking ghc-pkg directly."
+          withProcessContext menv $ getGlobalDB pkg
+        Right x -> pure x
+
+    globalDump <- withProcessContext menv $ globalsFromDump pkg
+    cabalPkgVer <-
+      case Map.lookup cabalPackageName globalDump of
+        Nothing -> prettyThrowIO $ CabalNotFound compiler
+        Just dp -> pure $ pkgVersion $ dpPackageIdent dp
+
+    pure CompilerPaths
+      { cpBuild = compilerBuild
+      , cpArch = arch
+      , cpSandboxed = isSandboxed
+      , cpCompilerVersion = compilerVer
+      , cpCompiler = compiler
+      , cpPkg = pkg
+      , cpInterpreter = interpreter
+      , cpHaddock = haddock
+      , cpCabalVersion = cabalPkgVer
+      , cpGlobalDB = globaldb
+      , cpGhcInfo = infobs
+      , cpGlobalDump = globalDump
+      }
+ where
+  onErr = throwIO . PrettyException . InvalidGhcAt compiler
+
+  withCache inner = do
+    eres <- tryAny $ loadCompilerPaths compiler compilerBuild isSandboxed
+    mres <-
+      case eres of
+        Left e -> do
+          prettyWarn $
+               flow "Trouble loading CompilerPaths cache:"
+            <> blankLine
+            <> string (displayException e)
+          pure Nothing
+        Right x -> pure x
+    case mres of
+      Just cp -> cp <$ logDebug "Loaded compiler information from cache"
+      Nothing -> do
+        cp <- inner
+        saveCompilerPaths cp `catchAny` \e ->
+          prettyWarn $
+               flow "Unable to save CompilerPaths cache:"
+            <> blankLine
+            <> string (displayException e)
+        pure cp
+
+buildGhcFromSource ::
+     forall env. ( HasTerm env, HasProcessContext env, HasBuildConfig env)
+  => Memoized SetupInfo
+  -> [Tool]
+  -> CompilerRepository
+  -> Text
+  -> Text
+  -> RIO env (Tool, CompilerBuild)
+buildGhcFromSource getSetupInfo' installed (CompilerRepository url) commitId flavour = do
+  config <- view configL
+  let compilerTool = ToolGhcGit commitId flavour
+
+  -- detect when the correct GHC is already installed
+  if compilerTool `elem` installed
+    then pure (compilerTool,CompilerBuildStandard)
+    else
+      -- clone the repository and execute the given commands
+      withRepo (SimpleRepo url commitId RepoGit) $ do
+        -- withRepo is guaranteed to set workingDirL, so let's get it
+        mcwd <- traverse parseAbsDir =<< view workingDirL
+        cwd <- maybe (throwIO WorkingDirectoryInvalidBug) pure mcwd
+        threads <- view $ configL.to configJobs
+        let hadrianArgs = fmap T.unpack
+              [ "-c"                    -- run ./boot and ./configure
+              , "-j" <> tshow threads   -- parallel build
+              , "--flavour=" <> flavour -- selected flavour
+              , "binary-dist"
+              ]
+            hadrianScripts
+              | osIsWindows = hadrianScriptsWindows
+              | otherwise   = hadrianScriptsPosix
+
+        foundHadrianPaths <-
+          filterM doesFileExist $ (cwd </>) <$> hadrianScripts
+        hadrianPath <- maybe (prettyThrowIO HadrianScriptNotFound) pure $
+          listToMaybe foundHadrianPaths
+
+        logSticky $
+             "Building GHC from source with `"
+          <> display flavour
+          <> "` flavour. It can take a long time (more than one hour)..."
+
+        -- We need to provide an absolute path to the script since
+        -- the process package only sets working directory _after_
+        -- discovering the executable
+        proc (toFilePath hadrianPath) hadrianArgs runProcess_
+
+        -- find the bindist and install it
+        bindistPath <- parseRelDir "_build/bindist"
+        (_,files) <- listDir (cwd </> bindistPath)
+        let isBindist p = do
+              extension <- fileExtension (filename p)
+
+              pure $
+                   "ghc-" `isPrefixOf` toFilePath (filename p)
+                && extension == ".xz"
+
+        mbindist <- filterM isBindist files
+        case mbindist of
+          [bindist] -> do
+            let bindist' = T.pack (toFilePath bindist)
+                dlinfo = DownloadInfo
+                          { downloadInfoUrl           = bindist'
+                            -- we can specify a filepath instead of a URL
+                          , downloadInfoContentLength = Nothing
+                          , downloadInfoSha1          = Nothing
+                          , downloadInfoSha256        = Nothing
+                          }
+                ghcdlinfo = GHCDownloadInfo mempty mempty dlinfo
+                installer
+                   | osIsWindows = installGHCWindows
+                   | otherwise   = installGHCPosix ghcdlinfo
+            si <- runMemoized getSetupInfo'
+            _ <- downloadAndInstallTool
+              (configLocalPrograms config)
+              dlinfo
+              compilerTool
+              (installer si)
+            pure (compilerTool, CompilerBuildStandard)
+          _ -> do
+            forM_ files (logDebug . fromString . (" - " ++) . toFilePath)
+            prettyThrowIO HadrianBindistNotFound
+
+-- | Determine which GHC builds to use depending on which shared libraries are
+-- available on the system.
+getGhcBuilds :: HasConfig env => RIO env [CompilerBuild]
+getGhcBuilds = do
+  config <- view configL
+  case configGHCBuild config of
+    Just ghcBuild -> pure [ghcBuild]
+    Nothing -> determineGhcBuild
+ where
+  determineGhcBuild = do
+    -- TODO: a more reliable, flexible, and data driven approach would be to
+    -- actually download small "test" executables (from setup-info) that link to
+    -- the same gmp/tinfo versions that GHC does (i.e. built in same environment
+    -- as the GHC bindist). The algorithm would go something like this:
+    --
+    -- check for previous 'uname -a'/`ldconfig -p` plus compiler version/variant
+    -- in cache.
+    -- if cached, then use that as suffix
+    -- otherwise:
+    --     download setup-info
+    --     go through all with right prefix for os/version/variant
+    --     first try "standard" (no extra suffix), then the rest
+    --         download "compatibility check" exe if not already downloaded
+    --         try running it
+    --         if successful, then choose that
+    --             cache compiler suffix with the uname -a and
+    --               ldconfig -p output hash plus compiler version
+    --
+    -- Of course, could also try to make a static GHC bindist instead of all
+    -- this rigamarole.
+
+    platform <- view platformL
+    case platform of
+      Platform _ Cabal.Linux -> do
+        -- Some systems don't have ldconfig in the PATH, so make sure to look in
+        -- /sbin and /usr/sbin as well
+        let sbinEnv m = Map.insert
+              "PATH"
+              ("/sbin:/usr/sbin" <> maybe "" (":" <>) (Map.lookup "PATH" m))
+              m
+        eldconfigOut <- withModifyEnvVars sbinEnv
+          $ proc "ldconfig" ["-p"]
+          $ tryAny . fmap fst . readProcess_
+        let firstWords = case eldconfigOut of
+              Right ldconfigOut -> mapMaybe (listToMaybe . T.words) $
+                T.lines $ T.decodeUtf8With T.lenientDecode
+                        $ LBS.toStrict ldconfigOut
+              Left _ -> []
+            checkLib lib
+              | libT `elem` firstWords = do
+                  logDebug $
+                       "Found shared library "
+                    <> libD
+                    <> " in 'ldconfig -p' output"
+                  pure True
+              | osIsWindows =
+                  -- Cannot parse /usr/lib on Windows
+                  pure False
+              | otherwise = do
+              -- This is a workaround for the fact that libtinfo.so.x doesn't
+              -- appear in the 'ldconfig -p' output on Arch or Slackware even
+              -- when it exists. There doesn't seem to be an easy way to get the
+              -- true list of directories to scan for shared libs, but this
+              -- works for our particular cases.
+                  matches <- filterM (doesFileExist .(</> lib)) usrLibDirs
+                  case matches of
+                    [] ->
+                         logDebug
+                           (  "Did not find shared library "
+                           <> libD
+                           )
+                      >> pure False
+                    (path:_) ->
+                         logDebug
+                           (  "Found shared library "
+                           <> libD
+                           <> " in "
+                           <> fromString (Path.toFilePath path)
+                           )
+                      >> pure True
+             where
+              libT = T.pack (toFilePath lib)
+              libD = fromString (toFilePath lib)
+            getLibc6Version = do
+              elddOut <-
+                proc "ldd" ["--version"] $ tryAny . readProcessStdout_
+              pure $ case elddOut of
+                Right lddOut ->
+                  let lddOut' =
+                        decodeUtf8Lenient (LBS.toStrict lddOut)
+                  in  case P.parse lddVersion lddOut' of
+                        P.Done _ result -> Just result
+                        _ -> Nothing
+                Left _ -> Nothing
+            -- Assumes the first line of ldd has the format:
+            --
+            -- ldd (...) nn.nn
+            --
+            -- where nn.nn corresponds to the version of libc6.
+            lddVersion :: P.Parser Version
+            lddVersion = do
+              P.skipWhile (/= ')')
+              P.skip (== ')')
+              P.skipSpace
+              lddMajorVersion <- P.decimal
+              P.skip (== '.')
+              lddMinorVersion <- P.decimal
+              P.skip (not . isDigit)
+              pure $ mkVersion [ lddMajorVersion, lddMinorVersion ]
+        mLibc6Version <- getLibc6Version
+        case mLibc6Version of
+          Just libc6Version -> logDebug $
+               "Found shared library libc6 in version: "
+            <> fromString (versionString libc6Version)
+          Nothing -> logDebug
+            "Did not find a version of shared library libc6."
+        let hasLibc6_2_32 =
+              maybe False (>= mkVersion [2 , 32]) mLibc6Version
+        hastinfo5 <- checkLib relFileLibtinfoSo5
+        hastinfo6 <- checkLib relFileLibtinfoSo6
+        hasncurses6 <- checkLib relFileLibncurseswSo6
+        hasgmp5 <- checkLib relFileLibgmpSo10
+        hasgmp4 <- checkLib relFileLibgmpSo3
+        let libComponents = concat
+              [ if hastinfo6 && hasgmp5
+                  then
+                    if hasLibc6_2_32
+                      then [["tinfo6"]]
+                      else [["tinfo6-libc6-pre232"]]
+                  else [[]]
+              , [[] | hastinfo5 && hasgmp5]
+              , [["ncurses6"] | hasncurses6 && hasgmp5 ]
+              , [["gmp4"] | hasgmp4 ]
+              ]
+        useBuilds $ map
+          (\c -> case c of
+            [] -> CompilerBuildStandard
+            _ -> CompilerBuildSpecialized (intercalate "-" c))
+          libComponents
+      Platform _ Cabal.FreeBSD -> do
+        let getMajorVer = readMaybe <=< headMaybe . splitOn "."
+        majorVer <- getMajorVer <$> sysRelease
+        if majorVer >= Just (12 :: Int)
+          then
+            useBuilds [CompilerBuildSpecialized "ino64"]
+          else
+            useBuilds [CompilerBuildStandard]
+      Platform _ Cabal.OpenBSD -> do
+        releaseStr <- mungeRelease <$> sysRelease
+        useBuilds [CompilerBuildSpecialized releaseStr]
+      _ -> useBuilds [CompilerBuildStandard]
+  useBuilds builds = do
+    logDebug $
+         "Potential GHC builds: "
+      <> mconcat (intersperse ", " (map (fromString . compilerBuildName) builds))
+    pure builds
+
+-- | Encode an OpenBSD version (like "6.1") into a valid argument for
+-- CompilerBuildSpecialized, so "maj6-min1". Later version numbers are prefixed
+-- with "r".
+-- The result r must be such that "ghc-" ++ r is a valid package name,
+-- as recognized by parsePackageNameFromString.
+mungeRelease :: String -> String
+mungeRelease = intercalate "-" . prefixMaj . splitOn "."
+ where
+  prefixFst pfx k (rev : revs) = (pfx ++ rev) : k revs
+  prefixFst _ _ [] = []
+  prefixMaj = prefixFst "maj" prefixMin
+  prefixMin = prefixFst "min" (map ('r':))
+
+sysRelease :: HasTerm env => RIO env String
+sysRelease =
+  handleIO
+    ( \e -> do
+        prettyWarn $
+             flow "Could not query OS version:"
+          <> blankLine
+          <> string (displayException e)
+        pure ""
+    )
+    (liftIO getRelease)
+
+-- | Ensure Docker container-compatible 'stack' executable is downloaded
+ensureDockerStackExe :: HasConfig env => Platform -> RIO env (Path Abs File)
+ensureDockerStackExe containerPlatform = do
+  config <- view configL
+  containerPlatformDir <- runReaderT platformOnlyRelDir (containerPlatform,PlatformVariantNone)
+  let programsPath = configLocalProgramsBase config </> containerPlatformDir
+      tool = Tool (PackageIdentifier (mkPackageName "stack") stackVersion)
+  stackExeDir <- installDir programsPath tool
+  let stackExePath = stackExeDir </> relFileStack
+  stackExeExists <- doesFileExist stackExePath
+  unless stackExeExists $ do
+    prettyInfoL
+      [ flow "Downloading Docker-compatible"
+      , fromString stackProgName
+      , "executable."
+      ]
+    sri <-
+      downloadStackReleaseInfo
+        Nothing
+        Nothing
+        (Just (versionString stackMinorVersion))
+    platforms <-
+      runReaderT preferredPlatforms (containerPlatform, PlatformVariantNone)
+    downloadStackExe platforms sri stackExeDir False (const $ pure ())
+  pure stackExePath
+
+-- | Get all executables on the path that might match the wanted compiler
+sourceSystemCompilers ::
+     (HasProcessContext env, HasLogFunc env)
+  => WantedCompiler
+  -> ConduitT i (Path Abs File) (RIO env) ()
+sourceSystemCompilers wanted = do
+  searchPath <- view exeSearchPathL
+  names <-
+    case wanted of
+      WCGhc version -> pure
+        [ "ghc-" ++ versionString version
+        , "ghc"
+        ]
+      WCGhcjs{} -> throwIO GhcjsNotSupported
+      WCGhcGit{} -> pure [] -- only use sandboxed versions
+  for_ names $ \name -> for_ searchPath $ \dir -> do
+    fp <- resolveFile' $ addExe $ dir FP.</> name
+    exists <- doesFileExist fp
+    when exists $ yield fp
+ where
+  addExe
+    | osIsWindows = (++ ".exe")
+    | otherwise = id
+
+-- | Download the most recent SetupInfo
+getSetupInfo :: HasConfig env => RIO env SetupInfo
+getSetupInfo = do
+  config <- view configL
+  let inlineSetupInfo = configSetupInfoInline config
+      locations' = configSetupInfoLocations config
+      locations = if null locations' then [defaultSetupInfoYaml] else locations'
+
+  resolvedSetupInfos <- mapM loadSetupInfo locations
+  pure (inlineSetupInfo <> mconcat resolvedSetupInfos)
+ where
+  loadSetupInfo urlOrFile = do
+    bs <- case parseUrlThrow urlOrFile of
+            Just req -> LBS.toStrict . getResponseBody <$> httpLbs req
+            Nothing -> liftIO $ S.readFile urlOrFile
+    WithJSONWarnings si warnings <- either throwM pure (Yaml.decodeEither' bs)
+    when (urlOrFile /= defaultSetupInfoYaml) $
+      logJSONWarnings urlOrFile warnings
+    pure si
+
+getInstalledTool :: [Tool]            -- ^ already installed
+                 -> PackageName       -- ^ package to find
+                 -> (Version -> Bool) -- ^ which versions are acceptable
+                 -> Maybe Tool
+getInstalledTool installed name goodVersion = Tool <$>
+  maximumByMaybe (comparing pkgVersion) (filterTools name goodVersion installed)
+
+downloadAndInstallTool ::
+     (HasTerm env, HasBuildConfig env)
+  => Path Abs Dir
+  -> DownloadInfo
+  -> Tool
+  -> (  Path Abs File
+     -> ArchiveType
+     -> Path Abs Dir
+     -> Path Abs Dir
+     -> RIO env ()
+     )
+  -> RIO env Tool
+downloadAndInstallTool programsDir downloadInfo tool installer = do
+  ensureDir programsDir
+  (file, at) <- downloadFromInfo programsDir downloadInfo tool
+  dir <- installDir programsDir tool
+  tempDir <- tempInstallDir programsDir tool
+  liftIO $ ignoringAbsence (removeDirRecur tempDir)
+  ensureDir tempDir
+  unmarkInstalled programsDir tool
+  installer file at tempDir dir
+  markInstalled programsDir tool
+  liftIO $ ignoringAbsence (removeDirRecur tempDir)
+  pure tool
+
+downloadAndInstallCompiler :: (HasBuildConfig env, HasGHCVariant env)
+                           => CompilerBuild
+                           -> SetupInfo
+                           -> WantedCompiler
+                           -> VersionCheck
+                           -> Maybe String
+                           -> RIO env Tool
+downloadAndInstallCompiler ghcBuild si wanted@(WCGhc version) versionCheck mbindistURL = do
+  ghcVariant <- view ghcVariantL
+  (selectedVersion, downloadInfo) <- case mbindistURL of
+    Just bindistURL -> do
+      case ghcVariant of
+        GHCCustom _ -> pure ()
+        _ -> prettyThrowM RequireCustomGHCVariant
+      pure (version, GHCDownloadInfo mempty mempty DownloadInfo
+               { downloadInfoUrl = T.pack bindistURL
+               , downloadInfoContentLength = Nothing
+               , downloadInfoSha1 = Nothing
+               , downloadInfoSha256 = Nothing
+               })
+    _ -> do
+      ghcKey <- getGhcKey ghcBuild
+      case Map.lookup ghcKey $ siGHCs si of
+        Nothing -> prettyThrowM $ UnknownOSKey ghcKey
+        Just pairs_ ->
+          getWantedCompilerInfo ghcKey versionCheck wanted ACGhc pairs_
+  config <- view configL
+  let installer =
+        case configPlatform config of
+          Platform _ Cabal.Windows -> installGHCWindows
+          _ -> installGHCPosix downloadInfo
+  prettyInfo $
+    fillSep $
+         flow "Preparing to install GHC"
+      :  case ghcVariant of
+           GHCStandard -> []
+           v -> ["(" <> fromString (ghcVariantName v) <> ")"]
+      <> case ghcBuild of
+          CompilerBuildStandard -> []
+          b -> ["(" <> fromString (compilerBuildName b) <> ")"]
+      <> [ flow "to an isolated location. This will not interfere with any \
+                \system-level installation."
+         ]
+  ghcPkgName <- parsePackageNameThrowing
+    ("ghc" ++ ghcVariantSuffix ghcVariant ++ compilerBuildSuffix ghcBuild)
+  let tool = Tool $ PackageIdentifier ghcPkgName selectedVersion
+  downloadAndInstallTool
+    (configLocalPrograms config)
+    (gdiDownloadInfo downloadInfo)
+    tool
+    (installer si)
+
+downloadAndInstallCompiler _ _ WCGhcjs{} _ _ = throwIO GhcjsNotSupported
+
+downloadAndInstallCompiler _ _ WCGhcGit{} _ _ =
+  prettyThrowIO DownloadAndInstallCompilerError
+
+getWantedCompilerInfo :: (Ord k, MonadThrow m)
+                      => Text
+                      -> VersionCheck
+                      -> WantedCompiler
+                      -> (k -> ActualCompiler)
+                      -> Map k a
+                      -> m (k, a)
+getWantedCompilerInfo key versionCheck wanted toCV pairs_ =
+  case mpair of
+    Just pair -> pure pair
+    Nothing -> prettyThrowM $
+      UnknownCompilerVersion
+        (Set.singleton key)
+        wanted
+        (Set.fromList $ map toCV (Map.keys pairs_))
+ where
+  mpair =
+    listToMaybe $
+    sortOn (Down . fst) $
+    filter
+      (isWantedCompiler versionCheck wanted . toCV . fst)
+      (Map.toList pairs_)
+
+-- | Download and install the first available compiler build.
+downloadAndInstallPossibleCompilers ::
+       (HasGHCVariant env, HasBuildConfig env)
+    => [CompilerBuild]
+    -> SetupInfo
+    -> WantedCompiler
+    -> VersionCheck
+    -> Maybe String
+    -> RIO env (Tool, CompilerBuild)
+downloadAndInstallPossibleCompilers possibleCompilers si wanted versionCheck mbindistURL =
+  go possibleCompilers Nothing
+ where
+  -- This will stop as soon as one of the builds doesn't throw an @UnknownOSKey@
+  -- or @UnknownCompilerVersion@ exception (so it will only try subsequent
+  -- builds if one is nonexistent, not if the download or install fails for some
+  -- other reason). The @Unknown*@ exceptions thrown by each attempt are
+  -- combined into a single exception (if only @UnknownOSKey@ is thrown, then
+  -- the first of those is rethrown, but if any @UnknownCompilerVersion@s are
+  -- thrown then the attempted OS keys and available versions are unioned).
+  go [] Nothing = prettyThrowM UnsupportedSetupConfiguration
+  go [] (Just e) = prettyThrowM e
+  go (b:bs) e = do
+    logDebug $ "Trying to setup GHC build: " <> fromString (compilerBuildName b)
+    er <- try $ downloadAndInstallCompiler b si wanted versionCheck mbindistURL
+    case er of
+      Left e'@(UnknownCompilerVersion ks' w' vs') ->
+        case e of
+          Nothing -> go bs (Just e')
+          Just (UnknownOSKey k) ->
+            go bs $ Just $ UnknownCompilerVersion (Set.insert k ks') w' vs'
+          Just (UnknownCompilerVersion ks _ vs) ->
+            go bs $ Just $
+              UnknownCompilerVersion (Set.union ks' ks) w' (Set.union vs' vs)
+          Just x -> prettyThrowM x
+      Left e'@(UnknownOSKey k') ->
+        case e of
+          Nothing -> go bs (Just e')
+          Just (UnknownOSKey _) -> go bs e
+          Just (UnknownCompilerVersion ks w vs) ->
+            go bs $ Just $ UnknownCompilerVersion (Set.insert k' ks) w vs
+          Just x -> prettyThrowM x
+      Left e' -> prettyThrowM e'
+      Right r -> pure (r, b)
+
+getGhcKey ::
+     (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m)
+  => CompilerBuild
+  -> m Text
+getGhcKey ghcBuild = do
+  ghcVariant <- view ghcVariantL
+  platform <- view platformL
+  osKey <- getOSKey platform
+  pure $
+       osKey
+    <> T.pack (ghcVariantSuffix ghcVariant)
+    <> T.pack (compilerBuildSuffix ghcBuild)
+
+getOSKey :: (MonadThrow m)
+         => Platform
+         -> m Text
+getOSKey platform =
+  case platform of
+    Platform I386                  Cabal.Linux   -> pure "linux32"
+    Platform X86_64                Cabal.Linux   -> pure "linux64"
+    Platform I386                  Cabal.OSX     -> pure "macosx"
+    Platform X86_64                Cabal.OSX     -> pure "macosx"
+    Platform I386                  Cabal.FreeBSD -> pure "freebsd32"
+    Platform X86_64                Cabal.FreeBSD -> pure "freebsd64"
+    Platform I386                  Cabal.OpenBSD -> pure "openbsd32"
+    Platform X86_64                Cabal.OpenBSD -> pure "openbsd64"
+    Platform I386                  Cabal.Windows -> pure "windows32"
+    Platform X86_64                Cabal.Windows -> pure "windows64"
+    Platform Arm                   Cabal.Linux   -> pure "linux-armv7"
+    Platform AArch64               Cabal.Linux   -> pure "linux-aarch64"
+    Platform Sparc                 Cabal.Linux   -> pure "linux-sparc"
+    Platform AArch64               Cabal.OSX     -> pure "macosx-aarch64"
+    Platform AArch64               Cabal.FreeBSD -> pure "freebsd-aarch64"
+    Platform arch os -> prettyThrowM $ UnsupportedSetupCombo os arch
+
+downloadOrUseLocal ::
+     (HasTerm env, HasBuildConfig env)
+  => Text
+  -> DownloadInfo
+  -> Path Abs File
+  -> RIO env (Path Abs File)
+downloadOrUseLocal downloadLabel downloadInfo destination =
+  case url of
+    (parseUrlThrow -> Just _) -> do
+      ensureDir (parent destination)
+      chattyDownload downloadLabel downloadInfo destination
+      pure destination
+    (parseAbsFile -> Just path) -> do
+      warnOnIgnoredChecks
+      pure path
+    (parseRelFile -> Just path) -> do
+      warnOnIgnoredChecks
+      root <- view projectRootL
+      pure (root </> path)
+    _ -> prettyThrowIO $ URLInvalid url
+ where
+  url = T.unpack $ downloadInfoUrl downloadInfo
+  warnOnIgnoredChecks = do
+    let DownloadInfo
+          { downloadInfoContentLength = contentLength
+          , downloadInfoSha1 = sha1
+          , downloadInfoSha256 = sha256
+          } = downloadInfo
+    when (isJust contentLength) $
+      prettyWarnS
+         "`content-length` is not checked and should not be specified when \
+         \`url` is a file path."
+    when (isJust sha1) $
+      prettyWarnS
+        "`sha1` is not checked and should not be specified when `url` is a \
+        \file path."
+    when (isJust sha256) $
+      prettyWarn
+        "`sha256` is not checked and should not be specified when `url` is a \
+        \file path"
+
+downloadFromInfo ::
+     (HasTerm env, HasBuildConfig env)
+  => Path Abs Dir
+  -> DownloadInfo
+  -> Tool
+  -> RIO env (Path Abs File, ArchiveType)
+downloadFromInfo programsDir downloadInfo tool = do
+  archiveType <-
+    case extension of
+      ".tar.xz" -> pure TarXz
+      ".tar.bz2" -> pure TarBz2
+      ".tar.gz" -> pure TarGz
+      ".7z.exe" -> pure SevenZ
+      _ -> prettyThrowIO $ UnknownArchiveExtension url
+
+  relativeFile <- parseRelFile $ toolString tool ++ extension
+  let destinationPath = programsDir </> relativeFile
+  localPath <-
+    downloadOrUseLocal (T.pack (toolString tool)) downloadInfo destinationPath
+  pure (localPath, archiveType)
+
+ where
+  url = T.unpack $ downloadInfoUrl downloadInfo
+  extension = loop url
+   where
+    loop fp
+      | ext `elem` [".tar", ".bz2", ".xz", ".exe", ".7z", ".gz"] = loop fp' ++ ext
+      | otherwise = ""
+     where
+      (fp', ext) = FP.splitExtension fp
+
+
+data ArchiveType
+  = TarBz2
+  | TarXz
+  | TarGz
+  | SevenZ
+
+installGHCPosix :: HasConfig env
+                => GHCDownloadInfo
+                -> SetupInfo
+                -> Path Abs File
+                -> ArchiveType
+                -> Path Abs Dir
+                -> Path Abs Dir
+                -> RIO env ()
+installGHCPosix downloadInfo _ archiveFile archiveType tempDir destDir = do
+  platform <- view platformL
+  menv0 <- view processContextL
+  menv <- mkProcessContext (removeHaskellEnvVars (view envVarsL menv0))
+  logDebug $ "menv = " <> displayShow (view envVarsL menv)
+  (zipTool', compOpt) <-
+    case archiveType of
+      TarXz -> pure ("xz", 'J')
+      TarBz2 -> pure ("bzip2", 'j')
+      TarGz -> pure ("gzip", 'z')
+      SevenZ -> prettyThrowIO Unsupported7z
+  -- Slight hack: OpenBSD's tar doesn't support xz.
+  -- https://github.com/commercialhaskell/stack/issues/2283#issuecomment-237980986
+  let tarDep =
+        case (platform, archiveType) of
+          (Platform _ Cabal.OpenBSD, TarXz) -> checkDependency "gtar"
+          _ -> checkDependency "tar"
+  (zipTool, makeTool, tarTool) <- checkDependencies $ (,,)
+    <$> checkDependency zipTool'
+    <*> (checkDependency "gmake" <|> checkDependency "make")
+    <*> tarDep
+
+  logDebug $ "ziptool: " <> fromString zipTool
+  logDebug $ "make: " <> fromString makeTool
+  logDebug $ "tar: " <> fromString tarTool
+
+  let runStep step wd env cmd args = do
+        menv' <- modifyEnvVars menv (Map.union env)
+        let logLines lvl = CB.lines .| CL.mapM_ (lvl . displayBytesUtf8)
+            logStdout = logLines logDebug
+            logStderr = logLines logError
+        void $ withWorkingDir (toFilePath wd) $
+          withProcessContext menv' $
+          sinkProcessStderrStdout cmd args logStderr logStdout
+          `catchAny` \ex ->
+            prettyThrowIO (GHCInstallFailed ex step cmd args wd tempDir destDir)
+
+  logSticky $
+       "Unpacking GHC into "
+    <> fromString (toFilePath tempDir)
+    <> " ..."
+  logDebug $ "Unpacking " <> fromString (toFilePath archiveFile)
+  runStep "unpacking" tempDir
+    mempty
+    tarTool
+    [compOpt : "xf", toFilePath archiveFile]
+
+  dir <- expectSingleUnpackedDir archiveFile tempDir
+
+  mOverrideGccPath <- view $ configL.to configOverrideGccPath
+
+  -- The make application uses the CC environment variable to configure the
+  -- program for compiling C programs
+  let mGccEnv = let gccEnvFromPath p =
+                      Map.singleton "CC" $ T.pack (toFilePath p)
+                in  gccEnvFromPath <$> mOverrideGccPath
+
+  -- Data.Map.union provides a left-biased union, so mGccEnv will prevail
+  let ghcConfigureEnv =
+        fromMaybe Map.empty mGccEnv `Map.union` gdiConfigureEnv downloadInfo
+
+  logSticky "Configuring GHC ..."
+  runStep "configuring" dir
+    ghcConfigureEnv
+    (toFilePath $ dir </> relFileConfigure)
+    ( ("--prefix=" ++ toFilePath destDir)
+    : map T.unpack (gdiConfigureOpts downloadInfo)
+    )
+
+  logSticky "Installing GHC ..."
+  runStep "installing" dir mempty makeTool ["install"]
+
+  logStickyDone "Installed GHC."
+  logDebug $ "GHC installed to " <> fromString (toFilePath destDir)
+
+-- | Check if given processes appear to be present, throwing an exception if
+-- missing.
+checkDependencies :: CheckDependency env a -> RIO env a
+checkDependencies (CheckDependency f) =
+  f >>= either (prettyThrowIO . MissingDependencies) pure
+
+checkDependency :: HasProcessContext env => String -> CheckDependency env String
+checkDependency tool = CheckDependency $ do
+  exists <- doesExecutableExist tool
+  pure $ if exists then Right tool else Left [tool]
+
+newtype CheckDependency env a
+  = CheckDependency (RIO env (Either [String] a))
+  deriving Functor
+
+instance Applicative (CheckDependency env) where
+  pure x = CheckDependency $ pure (Right x)
+  CheckDependency f <*> CheckDependency x = CheckDependency $ do
+    f' <- f
+    x' <- x
+    pure $
+      case (f', x') of
+        (Left e1, Left e2) -> Left $ e1 ++ e2
+        (Left e, Right _) -> Left e
+        (Right _, Left e) -> Left e
+        (Right f'', Right x'') -> Right $ f'' x''
+
+instance Alternative (CheckDependency env) where
+  empty = CheckDependency $ pure $ Left []
+  CheckDependency x <|> CheckDependency y = CheckDependency $ do
+    res1 <- x
+    case res1 of
+      Left _ -> y
+      Right x' -> pure $ Right x'
+
+installGHCWindows :: HasBuildConfig env
+                  => SetupInfo
+                  -> Path Abs File
+                  -> ArchiveType
+                  -> Path Abs Dir
+                  -> Path Abs Dir
+                  -> RIO env ()
+installGHCWindows si archiveFile archiveType _tempDir destDir = do
+  withUnpackedTarball7z "GHC" si archiveFile archiveType destDir
+  prettyInfoL
+    [ flow "GHC installed to"
+    , pretty destDir <> "."
+    ]
+
+installMsys2Windows :: HasBuildConfig env
+                  => SetupInfo
+                  -> Path Abs File
+                  -> ArchiveType
+                  -> Path Abs Dir
+                  -> Path Abs Dir
+                  -> RIO env ()
+installMsys2Windows si archiveFile archiveType _tempDir destDir = do
+  exists <- liftIO $ D.doesDirectoryExist $ toFilePath destDir
+  when exists $
+    liftIO (D.removeDirectoryRecursive $ toFilePath destDir) `catchIO` \e ->
+      prettyThrowM $ ExistingMSYS2NotDeleted destDir e
+
+  withUnpackedTarball7z "MSYS2" si archiveFile archiveType destDir
+
+
+  -- I couldn't find this officially documented anywhere, but you need to run
+  -- the MSYS shell once in order to initialize some pacman stuff. Once that
+  -- run happens, you can just run commands as usual.
+  menv0 <- view processContextL
+  newEnv0 <- modifyEnvVars menv0 $ Map.insert "MSYSTEM" "MSYS"
+  newEnv <- either throwM pure $ augmentPathMap
+              [toFilePath $ destDir </> relDirUsr </> relDirBin]
+              (view envVarsL newEnv0)
+  menv <- mkProcessContext newEnv
+  withWorkingDir (toFilePath destDir) $ withProcessContext menv
+    $ proc "sh" ["--login", "-c", "true"] runProcess_
+
+  -- No longer installing git, it's unreliable
+  -- (https://github.com/commercialhaskell/stack/issues/1046) and the
+  -- MSYS2-installed version has bad CRLF defaults.
+  --
+  -- Install git. We could install other useful things in the future too.
+  -- runCmd (Cmd (Just destDir) "pacman" menv ["-Sy", "--noconfirm", "git"]) Nothing
+
+-- | Unpack a compressed tarball using 7zip.  Expects a single directory in
+-- the unpacked results, which is renamed to the destination directory.
+withUnpackedTarball7z :: HasBuildConfig env
+                      => String -- ^ Name of tool, used in error messages
+                      -> SetupInfo
+                      -> Path Abs File -- ^ Path to archive file
+                      -> ArchiveType
+                      -> Path Abs Dir -- ^ Destination directory.
+                      -> RIO env ()
+withUnpackedTarball7z name si archiveFile archiveType destDir = do
+  suffix <-
+    case archiveType of
+      TarXz -> pure ".xz"
+      TarBz2 -> pure ".bz2"
+      TarGz -> pure ".gz"
+      _ -> prettyThrowIO $ TarballInvalid name
+  tarFile <-
+    case T.stripSuffix suffix $ T.pack $ toFilePath (filename archiveFile) of
+      Nothing -> prettyThrowIO $ TarballFileInvalid name archiveFile
+      Just x -> parseRelFile $ T.unpack x
+  run7z <- setup7z si
+  let tmpName = toFilePathNoTrailingSep (dirname destDir) ++ "-tmp"
+  ensureDir (parent destDir)
+  withRunInIO $ \run ->
+    withTempDir (parent destDir) tmpName $ \tmpDir ->
+      run $ do
+        liftIO $ ignoringAbsence (removeDirRecur destDir)
+        run7z tmpDir archiveFile
+        run7z tmpDir (tmpDir </> tarFile)
+        absSrcDir <- expectSingleUnpackedDir archiveFile tmpDir
+        renameDir absSrcDir destDir
+
+expectSingleUnpackedDir ::
+     (MonadIO m, MonadThrow m)
+  => Path Abs File
+  -> Path Abs Dir
+  -> m (Path Abs Dir)
+expectSingleUnpackedDir archiveFile destDir = do
+  contents <- listDir destDir
+  case contents of
+    ([dir], _ ) -> pure dir
+    _ -> prettyThrowIO $ UnknownArchiveStructure archiveFile
+
+-- | Download 7z as necessary, and get a function for unpacking things.
+--
+-- Returned function takes an unpack directory and archive.
+setup7z :: (HasBuildConfig env, MonadIO m)
+        => SetupInfo
+        -> RIO env (Path Abs Dir -> Path Abs File -> m ())
+setup7z si = do
+  dir <- view $ configL.to configLocalPrograms
+  ensureDir dir
+  let exeDestination = dir </> relFile7zexe
+      dllDestination = dir </> relFile7zdll
+  case (siSevenzDll si, siSevenzExe si) of
+    (Just sevenzDll, Just sevenzExe) -> do
+      _ <- downloadOrUseLocal "7z.dll" sevenzDll dllDestination
+      exePath <- downloadOrUseLocal "7z.exe" sevenzExe exeDestination
+      withRunInIO $ \run -> pure $ \outdir archive -> liftIO $ run $ do
+        let cmd = toFilePath exePath
+            args =
+              [ "x"
+              , "-o" ++ toFilePath outdir
+              , "-y"
+              , archiveFP
+              ]
+            archiveFP = toFilePath archive
+            archiveFileName = filename archive
+            archiveDisplay = fromString $ toFilePath archiveFileName
+            isExtract = FP.takeExtension archiveFP == ".tar"
+        prettyInfoL
+          [ if isExtract then "Extracting" else "Decompressing"
+          , pretty archiveFileName <> "..."
+          ]
+        ec <-
+          proc cmd args $ \pc ->
+          if isExtract
+            then withProcessWait (setStdout createSource pc) $ \p -> do
+              total <- runConduit
+                 $ getStdout p
+                .| filterCE (== 10) -- newline characters
+                .| foldMC
+                     (\count bs -> do
+                         let count' = count + S.length bs
+                         logSticky $ "Extracted " <> display count' <> " files"
+                         pure count'
+                     )
+                     0
+              logStickyDone $
+                   "Extracted total of "
+                <> display total
+                <> " files from "
+                <> archiveDisplay
+              waitExitCode p
+            else runProcess pc
+        when (ec /= ExitSuccess) $
+          liftIO $ prettyThrowM (ProblemWhileDecompressing archive)
+    _ -> prettyThrowM SetupInfoMissingSevenz
+
+chattyDownload :: HasTerm env
+               => Text          -- ^ label
+               -> DownloadInfo  -- ^ URL, content-length, sha1, and sha256
+               -> Path Abs File -- ^ destination
+               -> RIO env ()
+chattyDownload label downloadInfo path = do
+  let url = downloadInfoUrl downloadInfo
+  req <- parseUrlThrow $ T.unpack url
+  logSticky $
+       "Preparing to download "
+    <> display label
+    <> " ..."
+  logDebug $
+       "Downloading from "
+    <> display url
+    <> " to "
+    <> fromString (toFilePath path)
+    <> " ..."
+  hashChecks <- fmap catMaybes $ forM
+    [ ("sha1",   HashCheck SHA1,   downloadInfoSha1)
+    , ("sha256", HashCheck SHA256, downloadInfoSha256)
+    ]
+    $ \(name, constr, getter) ->
+      case getter downloadInfo of
+        Just bs -> do
+          logDebug $
+               "Will check against "
+            <> name
+            <> " hash: "
+            <> displayBytesUtf8 bs
+          pure $ Just $ constr $ CheckHexDigestByteString bs
+        Nothing -> pure Nothing
+  when (null hashChecks) $
+    prettyWarnS
+      "No sha1 or sha256 found in metadata, download hash won't be checked."
+  let dReq = setHashChecks hashChecks $
+             setLengthCheck mtotalSize $
+             mkDownloadRequest req
+  x <- verifiedDownloadWithProgress dReq path label mtotalSize
+  if x
+    then logStickyDone ("Downloaded " <> display label <> ".")
+    else logStickyDone ("Already downloaded " <> display label <> ".")
+ where
+  mtotalSize = downloadInfoContentLength downloadInfo
+
+-- | Perform a basic sanity check of GHC
+sanityCheck :: (HasProcessContext env, HasLogFunc env)
+            => Path Abs File -> RIO env ()
+sanityCheck ghc = withSystemTempDir "stack-sanity-check" $ \dir -> do
+  let fp = toFilePath $ dir </> relFileMainHs
+  liftIO $ S.writeFile fp $ T.encodeUtf8 $ T.pack $ unlines
+    [ "import Distribution.Simple" -- ensure Cabal library is present
+    , "main = putStrLn \"Hello World\""
+    ]
+  logDebug $ "Performing a sanity check on: " <> fromString (toFilePath ghc)
+  eres <- withWorkingDir (toFilePath dir) $ proc (toFilePath ghc)
+    [ fp
+    , "-no-user-package-db"
+    ] $ try . readProcess_
+  case eres of
+    Left e -> prettyThrowIO $ GHCSanityCheckCompileFailed e ghc
+    Right _ -> pure () -- TODO check that the output of running the command is
+                       -- correct
+
+-- Remove potentially confusing environment variables
+removeHaskellEnvVars :: Map Text Text -> Map Text Text
+removeHaskellEnvVars =
+  Map.delete "GHC_PACKAGE_PATH" .
+  Map.delete "GHC_ENVIRONMENT" .
+  Map.delete "HASKELL_PACKAGE_SANDBOX" .
+  Map.delete "HASKELL_PACKAGE_SANDBOXES" .
+  Map.delete "HASKELL_DIST_DIR" .
+  -- https://github.com/commercialhaskell/stack/issues/1460
+  Map.delete "DESTDIR" .
+  -- https://github.com/commercialhaskell/stack/issues/3444
+  Map.delete "GHCRTS"
+
+-- | Get map of environment variables to set to change the GHC's encoding to UTF-8
+getUtf8EnvVars ::
+     (HasPlatform env, HasProcessContext env, HasTerm env)
+  => ActualCompiler
+  -> RIO env (Map Text Text)
+getUtf8EnvVars compilerVer =
+  if getGhcVersion compilerVer >= mkVersion [7, 10, 3]
+    -- GHC_CHARENC supported by GHC >=7.10.3
+    then pure $ Map.singleton "GHC_CHARENC" "UTF-8"
+    else legacyLocale
+ where
+  legacyLocale = do
+    menv <- view processContextL
+    Platform _ os <- view platformL
+    if os == Cabal.Windows
+      then
+        -- On Windows, locale is controlled by the code page, so we don't set
+        -- any environment variables.
+        pure Map.empty
+      else do
+        let checkedVars = map checkVar (Map.toList $ view envVarsL menv)
+            -- List of environment variables that will need to be updated to set
+            -- UTF-8 (because they currently do not specify UTF-8).
+            needChangeVars = concatMap fst checkedVars
+            -- Set of locale-related environment variables that have already
+            -- have a value.
+            existingVarNames = Set.unions (map snd checkedVars)
+            -- True if a locale is already specified by one of the "global"
+            -- locale variables.
+            hasAnyExisting =
+              any (`Set.member` existingVarNames) ["LANG", "LANGUAGE", "LC_ALL"]
+        if null needChangeVars && hasAnyExisting
+          then
+            -- If no variables need changes and at least one "global" variable
+            -- is set, no changes to environment need to be made.
+            pure Map.empty
+          else do
+            -- Get a list of known locales by running @locale -a@.
+            elocales <- tryAny (fst <$> proc "locale" ["-a"] readProcess_)
+            let
+                -- Filter the list to only include locales with UTF-8 encoding.
+                utf8Locales =
+                  case elocales of
+                    Left _ -> []
+                    Right locales ->
+                      filter
+                        isUtf8Locale
+                        ( T.lines $
+                          T.decodeUtf8With
+                            T.lenientDecode $
+                            LBS.toStrict locales
+                        )
+                mfallback = getFallbackLocale utf8Locales
+            when
+              (isNothing mfallback)
+              ( prettyWarnS
+                  "Unable to set locale to UTF-8 encoding; GHC may \
+                  \fail with 'invalid character'"
+              )
+            let
+                -- Get the new values of variables to adjust.
+                changes =
+                  Map.unions $
+                  map
+                    (adjustedVarValue menv utf8Locales mfallback)
+                    needChangeVars
+                -- Get the values of variables to add.
+                adds
+                  | hasAnyExisting =
+                      -- If we already have a "global" variable, then nothing
+                      -- needs to be added.
+                      Map.empty
+                  | otherwise =
+                      -- If we don't already have a "global" variable, then set
+                      -- LANG to the fallback.
+                      case mfallback of
+                        Nothing -> Map.empty
+                        Just fallback ->
+                          Map.singleton "LANG" fallback
+            pure (Map.union changes adds)
+  -- Determines whether an environment variable is locale-related and, if so,
+  -- whether it needs to be adjusted.
+  checkVar :: (Text, Text) -> ([Text], Set Text)
+  checkVar (k,v) =
+    if k `elem` ["LANG", "LANGUAGE"] || "LC_" `T.isPrefixOf` k
+      then if isUtf8Locale v
+             then ([], Set.singleton k)
+             else ([k], Set.singleton k)
+      else ([], Set.empty)
+  -- Adjusted value of an existing locale variable.  Looks for valid UTF-8
+  -- encodings with same language /and/ territory, then with same language, and
+  -- finally the first UTF-8 locale returned by @locale -a@.
+  adjustedVarValue ::
+       ProcessContext
+    -> [Text]
+    -> Maybe Text
+    -> Text
+    -> Map Text Text
+  adjustedVarValue menv utf8Locales mfallback k =
+    case Map.lookup k (view envVarsL menv) of
+      Nothing -> Map.empty
+      Just v ->
+        case concatMap
+               (matchingLocales utf8Locales)
+               [ T.takeWhile (/= '.') v <> "."
+               , T.takeWhile (/= '_') v <> "_"] of
+          (v':_) -> Map.singleton k v'
+          [] -> case mfallback of
+                  Just fallback -> Map.singleton k fallback
+                  Nothing -> Map.empty
+  -- Determine the fallback locale, by looking for any UTF-8 locale prefixed
+  -- with the list in @fallbackPrefixes@, and if not found, picking the first
+  -- UTF-8 encoding returned by @locale -a@.
+  getFallbackLocale :: [Text] -> Maybe Text
+  getFallbackLocale utf8Locales =
+    case concatMap (matchingLocales utf8Locales) fallbackPrefixes of
+      (v:_) -> Just v
+      [] -> case utf8Locales of
+              [] -> Nothing
+              (v:_) -> Just v
+  -- Filter the list of locales for any with the given prefixes
+  -- (case-insensitive).
+  matchingLocales :: [Text] -> Text -> [Text]
+  matchingLocales utf8Locales prefix =
+    filter (\v -> T.toLower prefix `T.isPrefixOf` T.toLower v) utf8Locales
+  -- Does the locale have one of the encodings in @utf8Suffixes@
+  -- (case-insensitive)?
+  isUtf8Locale locale =
+    any (\ v -> T.toLower v `T.isSuffixOf` T.toLower locale) utf8Suffixes
+  -- Prefixes of fallback locales (case-insensitive)
+  fallbackPrefixes = ["C.", "en_US.", "en_"]
+  -- Suffixes of UTF-8 locales (case-insensitive)
+  utf8Suffixes = [".UTF-8", ".utf8"]
+
+-- Binary Stack upgrades
+
+-- | Information on a binary release of Stack
+data StackReleaseInfo
+  = SRIGitHub !Value
+    -- ^ Metadata downloaded from GitHub releases about available binaries.
+  | SRIHaskellStackOrg !HaskellStackOrg
+    -- ^ Information on the latest available binary for the current platforms.
+
+data HaskellStackOrg = HaskellStackOrg
+  { hsoUrl :: !Text
+  , hsoVersion :: !Version
+  }
+  deriving Show
+
+downloadStackReleaseInfo ::
+     (HasPlatform env, HasLogFunc env)
+  => Maybe String -- GitHub org
+  -> Maybe String -- GitHub repo
+  -> Maybe String -- ^ optional version
+  -> RIO env StackReleaseInfo
+downloadStackReleaseInfo Nothing Nothing Nothing = do
+  platform <- view platformL
+  -- Fallback list of URLs to try for upgrading.
+  let urls0 =
+        case platform of
+          Platform X86_64 Cabal.Linux ->
+            [ "https://get.haskellstack.org/upgrade/linux-x86_64-static.tar.gz"
+            , "https://get.haskellstack.org/upgrade/linux-x86_64.tar.gz"
+            ]
+          Platform X86_64 Cabal.OSX ->
+            [ "https://get.haskellstack.org/upgrade/osx-x86_64.tar.gz"
+            ]
+          Platform X86_64 Cabal.Windows ->
+            [ "https://get.haskellstack.org/upgrade/windows-x86_64.tar.gz"
+            ]
+          _ -> []
+      -- Helper function: extract the version from a GitHub releases URL.
+  let extractVersion loc = do
+        version0 <-
+          case reverse $ splitOn "/" $ T.unpack loc of
+            _final:version0:_ -> Right version0
+            _ -> Left $ "Insufficient pieces in location: " ++ show loc
+        version1 <-
+          maybe (Left "no leading v on version") Right $ stripPrefix "v" version0
+        maybe (Left $ "Invalid version: " ++ show version1) Right $ parseVersion version1
+
+      -- Try out different URLs. If we've exhausted all of them, fall back to GitHub.
+      loop [] = do
+        logDebug "Could not get binary from haskellstack.org, trying GitHub"
+        downloadStackReleaseInfoGitHub Nothing Nothing Nothing
+
+      -- Try the next URL
+      loop (url:urls) = do
+        -- Make a HEAD request without any redirects
+        req <- setRequestMethod "HEAD" <$> parseRequest (T.unpack url)
+        res <- httpLbs req { redirectCount = 0 }
+
+        -- Look for a redirect. We're looking for a standard GitHub releases
+        -- URL where we can extract version information from.
+        case getResponseHeader "location" res of
+          [] -> logDebug "No location header found, continuing" *> loop urls
+          -- Exactly one location header.
+          [locBS] ->
+            case decodeUtf8' locBS of
+              Left e ->
+                   logDebug
+                     (   "Invalid UTF8: "
+                     <> displayShow (locBS, e)
+                     )
+                *> loop urls
+              Right loc ->
+                case extractVersion loc of
+                  Left s ->
+                       logDebug
+                         (   "No version found: "
+                         <> displayShow (url, loc, s)
+                         )
+                    *> loop (loc:urls)
+                  -- We found a valid URL, let's use it!
+                  Right version -> do
+                    let hso = HaskellStackOrg
+                                { hsoUrl = loc
+                                , hsoVersion = version
+                                }
+                    logDebug $
+                         "Downloading from haskellstack.org: "
+                      <> displayShow hso
+                    pure $ SRIHaskellStackOrg hso
+          locs ->
+               logDebug
+                 (  "Multiple location headers found: "
+                 <> displayShow locs
+                 )
+            *> loop urls
+  loop urls0
+downloadStackReleaseInfo morg mrepo mver =
+  downloadStackReleaseInfoGitHub morg mrepo mver
+
+-- | Same as above, but always uses GitHub
+downloadStackReleaseInfoGitHub ::
+     (MonadIO m, MonadThrow m)
+  => Maybe String -- GitHub org
+  -> Maybe String -- GitHub repo
+  -> Maybe String -- ^ optional version
+  -> m StackReleaseInfo
+downloadStackReleaseInfoGitHub morg mrepo mver = liftIO $ do
+  let org = fromMaybe "commercialhaskell" morg
+      repo = fromMaybe "stack" mrepo
+  let url = concat
+        [ "https://api.github.com/repos/"
+        , org
+        , "/"
+        , repo
+        , "/releases/"
+        , case mver of
+            Nothing -> "latest"
+            Just ver -> "tags/v" ++ ver
+        ]
+  req <- parseRequest url
+  res <- httpJSON $ setGitHubHeaders req
+  let code = getResponseStatusCode res
+  if code >= 200 && code < 300
+    then pure $ SRIGitHub $ getResponseBody res
+    else prettyThrowIO $ StackReleaseInfoNotFound url
+
+preferredPlatforms :: (MonadReader env m, HasPlatform env, MonadThrow m)
+                   => m [(Bool, String)]
+preferredPlatforms = do
+  Platform arch' os' <- view platformL
+  (isWindows, os) <-
+    case os' of
+      Cabal.Linux -> pure (False, "linux")
+      Cabal.Windows -> pure (True, "windows")
+      Cabal.OSX -> pure (False, "osx")
+      Cabal.FreeBSD -> pure (False, "freebsd")
+      _ -> prettyThrowM $ BinaryUpgradeOnOSUnsupported os'
+  arch <-
+    case arch' of
+      I386 -> pure "i386"
+      X86_64 -> pure "x86_64"
+      Arm -> pure "arm"
+      _ -> prettyThrowM $ BinaryUpgradeOnArchUnsupported arch'
+  let hasgmp4 = False -- FIXME import relevant code from Stack.Setup?
+                      -- checkLib $(mkRelFile "libgmp.so.3")
+      suffixes
+        | hasgmp4 = ["-static", "-gmp4", ""]
+        | otherwise = ["-static", ""]
+  pure $ map (\suffix -> (isWindows, concat [os, "-", arch, suffix])) suffixes
+
+downloadStackExe ::
+     HasConfig env
+  => [(Bool, String)] -- ^ acceptable platforms
+  -> StackReleaseInfo
+  -> Path Abs Dir -- ^ destination directory
+  -> Bool -- ^ perform PATH-aware checking, see #3232
+  -> (Path Abs File -> IO ()) -- ^ test the temp exe before renaming
+  -> RIO env ()
+downloadStackExe platforms0 archiveInfo destDir checkPath testExe = do
+  (isWindows, archiveURL) <-
+    let loop [] =
+          prettyThrowIO $ StackBinaryArchiveNotFound (map snd platforms0)
+        loop ((isWindows, p'):ps) = do
+          let p = T.pack p'
+          prettyInfoL
+            [ flow "Querying for archive location for platform:"
+            , style Current (fromString p') <> "."
+            ]
+          case findArchive archiveInfo p of
+            Just x -> pure (isWindows, x)
+            Nothing -> loop ps
+    in  loop platforms0
+
+  let (destFile, tmpFile)
+        | isWindows =
+            ( destDir </> relFileStackDotExe
+            , destDir </> relFileStackDotTmpDotExe
+            )
+        | otherwise =
+            ( destDir </> relFileStack
+            , destDir </> relFileStackDotTmp
+            )
+
+  prettyInfoL
+    [ flow "Downloading from:"
+    , style Url (fromString $ T.unpack archiveURL) <> "."
+    ]
+
+  liftIO $
+    if | ".tar.gz" `T.isSuffixOf` archiveURL ->
+           handleTarball tmpFile isWindows archiveURL
+       | ".zip" `T.isSuffixOf` archiveURL ->
+            throwIO StackBinaryArchiveZipUnsupportedBug
+       | otherwise -> prettyThrowIO $ StackBinaryArchiveUnsupported archiveURL
+
+  prettyInfoS "Download complete, testing executable."
+
+  -- We need to call getExecutablePath before we overwrite the
+  -- currently running binary: after that, Linux will append
+  -- (deleted) to the filename.
+  currExe <- liftIO getExecutablePath >>= parseAbsFile
+
+  liftIO $ do
+    setFileExecutable (toFilePath tmpFile)
+    testExe tmpFile
+
+  relocateStackExeFile currExe tmpFile destFile
+
+  prettyInfoL
+    [ flow "New Stack executable available at:"
+    , pretty destFile <> "."
+    ]
+
+  destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir
+  warnInstallSearchPathIssues destDir' ["stack"]
+
+  when checkPath $ performPathChecking destFile currExe
+    `catchAny` (logError . displayShow)
+ where
+
+  findArchive (SRIGitHub val) platformPattern = do
+    Object top <- pure val
+    Array assets <- KeyMap.lookup "assets" top
+    getFirst $ foldMap (First . findMatch pattern') assets
+   where
+    pattern' = mconcat ["-", platformPattern, "."]
+
+    findMatch pattern'' (Object o) = do
+        String name <- KeyMap.lookup "name" o
+        guard $ not $ ".asc" `T.isSuffixOf` name
+        guard $ pattern'' `T.isInfixOf` name
+        String url <- KeyMap.lookup "browser_download_url" o
+        Just url
+    findMatch _ _ = Nothing
+  findArchive (SRIHaskellStackOrg hso) _ = pure $ hsoUrl hso
+
+  handleTarball :: Path Abs File -> Bool -> T.Text -> IO ()
+  handleTarball tmpFile isWindows url = do
+    req <- fmap setGitHubHeaders $ parseUrlThrow $ T.unpack url
+    withResponse req $ \res -> do
+      entries <- fmap (Tar.read . LBS.fromChunks)
+        $ lazyConsume
+        $ getResponseBody res .| ungzip
+      let loop Tar.Done = prettyThrowIO $ StackBinaryNotInArchive exeName url
+          loop (Tar.Fail e) = throwM e
+          loop (Tar.Next e es) =
+            case FP.splitPath (Tar.entryPath e) of
+              -- Ignore the first component, see:
+              -- https://github.com/commercialhaskell/stack/issues/5288
+              [_ignored, name] | name == exeName -> do
+                case Tar.entryContent e of
+                  Tar.NormalFile lbs _ -> do
+                    ensureDir destDir
+                    LBS.writeFile (toFilePath tmpFile) lbs
+                  _ -> prettyThrowIO $ FileTypeInArchiveInvalid e url
+              _ -> loop es
+      loop entries
+   where
+    exeName
+      | isWindows = "stack.exe"
+      | otherwise = "stack"
+
+relocateStackExeFile ::
+     HasTerm env
+  => Path Abs File
+     -- ^ Path to the currently running executable
+  -> Path Abs File
+     -- ^ Path to the executable file to be relocated
+  -> Path Abs File
+     -- ^ Path to the new location for the excutable file
+  -> RIO env ()
+relocateStackExeFile currExeFile newExeFile destExeFile = do
+  when (osIsWindows && destExeFile == currExeFile) $ do
+    -- Windows allows a running executable's file to be renamed, but not to be
+    -- overwritten.
+    old <- addExtension ".old" currExeFile
+    prettyInfoL
+      [ flow "Renaming existing:"
+      , pretty currExeFile
+      , "as:"
+      , pretty old <> "."
+      ]
+    renameFile currExeFile old
+  renameFile newExeFile destExeFile
+
+-- | Ensure that the Stack executable download is in the same location as the
+-- currently running executable. See:
+-- https://github.com/commercialhaskell/stack/issues/3232
+performPathChecking ::
+     HasConfig env
+  => Path Abs File
+     -- ^ Path to the newly downloaded file
+  -> Path Abs File
+     -- ^ Path to the currently running executable
+  -> RIO env ()
+performPathChecking newExeFile currExeFile = do
+  unless (newExeFile == currExeFile) $ do
+    prettyInfoL
+      [ flow "Also copying Stack executable to:"
+      , pretty currExeFile <> "."
+      ]
+    tmpFile <- toFilePath <$> addExtension ".tmp" currExeFile
+    eres <- tryIO $
+      relocateStackExeFile currExeFile newExeFile currExeFile
+    case eres of
+      Right () -> prettyInfoS "Stack executable copied successfully!"
+      Left e
+        | isPermissionError e -> if osIsWindows
+            then do
+              prettyWarn $
+                   flow "Permission error when trying to copy:"
+                <> blankLine
+                <> string (displayException e)
+            else do
+              prettyWarn $
+                   flow "Permission error when trying to copy:"
+                <> blankLine
+                <> string (displayException e)
+                <> blankLine
+                <> fillSep
+                     [ flow "Should I try to perform the file copy using"
+                     , style Shell "sudo" <> "?"
+                     , flow "This may fail."
+                     ]
+              toSudo <- promptBool "Try using sudo? (y/n) "
+              when toSudo $ do
+                let run cmd args = do
+                      ec <- proc cmd args runProcess
+                      when (ec /= ExitSuccess) $
+                        throwIO $ ProcessExited ec cmd args
+                    commands =
+                      [ ("sudo",
+                          [ "cp"
+                          , toFilePath newExeFile
+                          , tmpFile
+                          ])
+                      , ("sudo",
+                          [ "mv"
+                          , tmpFile
+                          , toFilePath currExeFile
+                          ])
+                      ]
+                prettyInfo $
+                     flow "Going to run the following commands:"
+                  <> blankLine
+                  <> bulletedList
+                       ( map
+                         ( \(cmd, args) ->
+                             style Shell $ fillSep
+                               $ fromString cmd
+                               : map fromString args
+                         )
+                         commands
+                       )
+                mapM_ (uncurry run) commands
+                prettyInfo $
+                     line
+                  <> flow "sudo file copy worked!"
+        | otherwise -> throwM e
+
+getDownloadVersion :: StackReleaseInfo -> Maybe Version
+getDownloadVersion (SRIGitHub val) = do
+  Object o <- Just val
+  String rawName <- KeyMap.lookup "name" o
+  -- drop the "v" at the beginning of the name
+  parseVersion $ T.unpack (T.drop 1 rawName)
 getDownloadVersion (SRIHaskellStackOrg hso) = Just $ hsoVersion hso
src/Stack/Setup/Installed.hs view
@@ -1,25 +1,23 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns      #-}
 
 module Stack.Setup.Installed
-    ( getCompilerVersion
-    , markInstalled
-    , unmarkInstalled
-    , listInstalled
-    , Tool (..)
-    , toolString
-    , toolNameString
-    , parseToolText
-    , filterTools
-    , extraDirs
-    , installDir
-    , tempInstallDir
-    ) where
+  ( getCompilerVersion
+  , markInstalled
+  , unmarkInstalled
+  , listInstalled
+  , Tool (..)
+  , toolString
+  , toolNameString
+  , parseToolText
+  , filterTools
+  , extraDirs
+  , installDir
+  , tempInstallDir
+  ) where
 
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as BL
@@ -29,34 +27,39 @@ import qualified Data.Text.Encoding as T
 import           Distribution.System ( Platform (..) )
 import qualified Distribution.System as Cabal
-import           Path
-import           Path.IO
-import           RIO.Process
+import           Path ( (</>), filename, parseRelDir, parseRelFile )
+import           Path.IO ( doesDirExist, ignoringAbsence, listDir, removeFile )
+import           RIO.Process ( HasProcessContext, proc, readProcess_ )
 import           Stack.Constants
+                   ( relDirBin, relDirInclude, relDirLib, relDirLocal, relDirMingw
+                   , relDirMingw32, relDirMingw64, relDirUsr
+                   )
 import           Stack.Prelude
 import           Stack.Types.Compiler
-import           Stack.Types.Config
+                   ( ActualCompiler (..), WhichCompiler (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.ExtraDirs ( ExtraDirs (..) )
 
 data Tool
-    = Tool PackageIdentifier -- ^ e.g. ghc-7.8.4, msys2-20150512
-    | ToolGhcGit !Text !Text   -- ^ e.g. ghc-git-COMMIT_ID-FLAVOUR
-    deriving (Eq)
+  = Tool PackageIdentifier -- ^ e.g. ghc-7.8.4, msys2-20150512
+  | ToolGhcGit !Text !Text   -- ^ e.g. ghc-git-COMMIT_ID-FLAVOUR
+  deriving Eq
 
 -- | 'Tool' values are ordered by name (being @ghc-git@, for @ToolGhcGit _ _@)
 -- alphabetically and then by version (later versions are ordered before
 -- earlier versions, where applicable).
 instance Ord Tool where
   compare (Tool pkgId1) (Tool pkgId2) = if pkgName1 == pkgName2
-      then compare pkgVersion2 pkgVersion1 -- Later versions ordered first
-      else compare pkgName1 pkgName2
-    where
-      PackageIdentifier pkgName1 pkgVersion1 = pkgId1
-      PackageIdentifier pkgName2 pkgVersion2 = pkgId2
+    then compare pkgVersion2 pkgVersion1 -- Later versions ordered first
+    else compare pkgName1 pkgName2
+   where
+    PackageIdentifier pkgName1 pkgVersion1 = pkgId1
+    PackageIdentifier pkgName2 pkgVersion2 = pkgId2
   compare (Tool pkgId) (ToolGhcGit _ _) = compare (pkgName pkgId) "ghc-git"
   compare (ToolGhcGit _ _) (Tool pkgId) = compare "ghc-git" (pkgName pkgId)
   compare (ToolGhcGit c1 f1) (ToolGhcGit c2 f2) = if f1 == f2
-      then compare c1 c2
-      else compare f1 f2
+    then compare c1 c2
+    else compare f1 f2
 
 toolString :: Tool -> String
 toolString (Tool ident) = packageIdentifierString ident
@@ -77,120 +80,124 @@               -> Tool
               -> m ()
 markInstalled programsPath tool = do
-    fpRel <- parseRelFile $ toolString tool ++ ".installed"
-    writeBinaryFileAtomic (programsPath </> fpRel) "installed"
+  fpRel <- parseRelFile $ toolString tool ++ ".installed"
+  writeBinaryFileAtomic (programsPath </> fpRel) "installed"
 
 unmarkInstalled :: MonadIO m
                 => Path Abs Dir
                 -> Tool
                 -> m ()
 unmarkInstalled programsPath tool = liftIO $ do
-    fpRel <- parseRelFile $ toolString tool ++ ".installed"
-    ignoringAbsence (removeFile $ programsPath </> fpRel)
+  fpRel <- parseRelFile $ toolString tool ++ ".installed"
+  ignoringAbsence (removeFile $ programsPath </> fpRel)
 
 listInstalled :: (MonadIO m, MonadThrow m)
               => Path Abs Dir
               -> m [Tool]
-listInstalled programsPath = do
-    doesDirExist programsPath >>= \case
-        False -> pure []
-        True -> do (_, files) <- listDir programsPath
-                   pure $ mapMaybe toTool files
-  where
-    toTool fp = do
-        x <- T.stripSuffix ".installed" $ T.pack $ toFilePath $ filename fp
-        parseToolText x
+listInstalled programsPath =
+  doesDirExist programsPath >>= \case
+    False -> pure []
+    True -> do (_, files) <- listDir programsPath
+               pure $ mapMaybe toTool files
+ where
+  toTool fp = do
+    x <- T.stripSuffix ".installed" $ T.pack $ toFilePath $ filename fp
+    parseToolText x
 
 filterTools :: PackageName       -- ^ package to find
             -> (Version -> Bool) -- ^ which versions are acceptable
             -> [Tool]            -- ^ tools to filter
             -> [PackageIdentifier]
 filterTools name goodVersion installed =
-    [ pkgId | Tool pkgId <- installed
-            , pkgName pkgId == name
-            , goodVersion (pkgVersion pkgId) ]
+  [ pkgId | Tool pkgId <- installed
+          , pkgName pkgId == name
+          , goodVersion (pkgVersion pkgId) ]
 
-getCompilerVersion
-  :: (HasProcessContext env, HasLogFunc env)
+getCompilerVersion ::
+     (HasProcessContext env, HasLogFunc env)
   => WhichCompiler
   -> Path Abs File -- ^ executable
   -> RIO env ActualCompiler
-getCompilerVersion wc exe = do
-    case wc of
-        Ghc -> do
-            logDebug "Asking GHC for its version"
-            bs <- fst <$> proc (toFilePath exe) ["--numeric-version"] readProcess_
-            let (_, ghcVersion) = versionFromEnd $ BL.toStrict bs
-            x <- ACGhc <$> parseVersionThrowing (T.unpack $ T.decodeUtf8 ghcVersion)
-            logDebug $ "GHC version is: " <> display x
-            pure x
-  where
-    versionFromEnd = S8.spanEnd isValid . fst . S8.breakEnd isValid
-    isValid c = c == '.' || isDigit c
+getCompilerVersion wc exe =
+  case wc of
+    Ghc -> do
+      logDebug "Asking GHC for its version"
+      bs <- fst <$> proc (toFilePath exe) ["--numeric-version"] readProcess_
+      let (_, ghcVersion) = versionFromEnd $ BL.toStrict bs
+      x <- ACGhc <$> parseVersionThrowing (T.unpack $ T.decodeUtf8 ghcVersion)
+      logDebug $ "GHC version is: " <> display x
+      pure x
+ where
+  versionFromEnd = S8.spanEnd isValid . fst . S8.breakEnd isValid
+  isValid c = c == '.' || isDigit c
 
 -- | Binary directories for the given installed package
 extraDirs :: HasConfig env => Tool -> RIO env ExtraDirs
 extraDirs tool = do
-    config <- view configL
-    dir <- installDir (configLocalPrograms config) tool
-    case (configPlatform config, toolNameString tool) of
-        (Platform _ Cabal.Windows, isGHC -> True) -> pure mempty
-            { edBins =
-                [ dir </> relDirBin
-                , dir </> relDirMingw </> relDirBin
-                ]
-            }
-        (Platform Cabal.I386 Cabal.Windows, "msys2") -> pure mempty
-            { edBins =
-                [ dir </> relDirMingw32 </> relDirBin
-                , dir </> relDirUsr </> relDirBin
-                , dir </> relDirUsr </> relDirLocal </> relDirBin
-                ]
-            , edInclude =
-                [ dir </> relDirMingw32 </> relDirInclude
-                ]
-            , edLib =
-                [ dir </> relDirMingw32 </> relDirLib
-                , dir </> relDirMingw32 </> relDirBin
-                ]
-            }
-        (Platform Cabal.X86_64 Cabal.Windows, "msys2") -> pure mempty
-            { edBins =
-                [ dir </> relDirMingw64 </> relDirBin
-                , dir </> relDirUsr </> relDirBin
-                , dir </> relDirUsr </> relDirLocal </> relDirBin
-                ]
-            , edInclude =
-                [ dir </> relDirMingw64 </> relDirInclude
-                ]
-            , edLib =
-                [ dir </> relDirMingw64 </> relDirLib
-                , dir </> relDirMingw64 </> relDirBin
-                ]
-            }
-        (_, isGHC -> True) -> pure mempty
-            { edBins =
-                [ dir </> relDirBin
-                ]
-            }
-        (Platform _ x, toolName) -> do
-            logWarn $ "binDirs: unexpected OS/tool combo: " <> displayShow (x, toolName)
-            pure mempty
-  where
-    isGHC n = "ghc" == n || "ghc-" `L.isPrefixOf` n
+  config <- view configL
+  dir <- installDir (configLocalPrograms config) tool
+  case (configPlatform config, toolNameString tool) of
+    (Platform _ Cabal.Windows, isGHC -> True) -> pure mempty
+      { edBins =
+          [ dir </> relDirBin
+          , dir </> relDirMingw </> relDirBin
+          ]
+      }
+    (Platform Cabal.I386 Cabal.Windows, "msys2") -> pure mempty
+      { edBins =
+          [ dir </> relDirMingw32 </> relDirBin
+          , dir </> relDirUsr </> relDirBin
+          , dir </> relDirUsr </> relDirLocal </> relDirBin
+          ]
+      , edInclude =
+          [ dir </> relDirMingw32 </> relDirInclude
+          ]
+      , edLib =
+          [ dir </> relDirMingw32 </> relDirLib
+          , dir </> relDirMingw32 </> relDirBin
+          ]
+      }
+    (Platform Cabal.X86_64 Cabal.Windows, "msys2") -> pure mempty
+      { edBins =
+          [ dir </> relDirMingw64 </> relDirBin
+          , dir </> relDirUsr </> relDirBin
+          , dir </> relDirUsr </> relDirLocal </> relDirBin
+          ]
+      , edInclude =
+          [ dir </> relDirMingw64 </> relDirInclude
+          ]
+      , edLib =
+          [ dir </> relDirMingw64 </> relDirLib
+          , dir </> relDirMingw64 </> relDirBin
+          ]
+      }
+    (_, isGHC -> True) -> pure mempty
+      { edBins =
+          [ dir </> relDirBin
+          ]
+      }
+    (Platform _ x, toolName) -> do
+      prettyWarnL
+        [ flow "binDirs: unexpected OS/tool combo:"
+        , flow (show (x, toolName) <> ".")
+        ]
+      pure mempty
+ where
+  isGHC n = "ghc" == n || "ghc-" `L.isPrefixOf` n
 
 installDir :: (MonadReader env m, MonadThrow m)
            => Path Abs Dir
            -> Tool
            -> m (Path Abs Dir)
 installDir programsDir tool = do
-    relativeDir <- parseRelDir $ toolString tool
-    pure $ programsDir </> relativeDir
+  relativeDir <- parseRelDir $ toolString tool
+  pure $ programsDir </> relativeDir
 
-tempInstallDir :: (MonadReader env m, MonadThrow m)
-           => Path Abs Dir
-           -> Tool
-           -> m (Path Abs Dir)
+tempInstallDir ::
+     (MonadReader env m, MonadThrow m)
+  => Path Abs Dir
+  -> Tool
+  -> m (Path Abs Dir)
 tempInstallDir programsDir tool = do
-    relativeDir <- parseRelDir $ toolString tool ++ ".temp"
-    pure $ programsDir </> relativeDir
+  relativeDir <- parseRelDir $ toolString tool ++ ".temp"
+  pure $ programsDir </> relativeDir
src/Stack/SetupCmd.hs view
@@ -1,97 +1,109 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
--- | Install GHC/GHCJS and Cabal.
+-- | Types and functions related to Stack's @setup@ command.
 module Stack.SetupCmd
-  ( setup
-  , setupParser
-  , SetupCmdOpts (..)
+  ( SetupCmdOpts (..)
+  , setupCmd
+  , setup
   ) where
 
-import           Control.Applicative
-import qualified Data.Text as T
-import qualified Options.Applicative as OA
-import qualified Options.Applicative.Builder.Extra as OA
-import qualified Options.Applicative.Types as OA
-import           Path
 import           Stack.Prelude
-import           Stack.Setup
-import           Stack.Types.Config
-import           Stack.Types.Version
+import           Stack.Runners
+                   ( ShouldReexec (..), withBuildConfig, withConfig )
+import           Stack.Setup ( SetupOpts (..), ensureCompilerAndMsys )
+import           Stack.Types.BuildConfig
+                   ( HasBuildConfig, stackYamlL, wantedCompilerVersionL )
+import           Stack.Types.CompilerPaths ( CompilerPaths (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.GHCVariant ( HasGHCVariant )
+import           Stack.Types.Runner ( Runner )
+import           Stack.Types.Version ( VersionCheck (..) )
 
+-- | Type representing command line options for the @stack setup@ command.
 data SetupCmdOpts = SetupCmdOpts
-    { scoCompilerVersion :: !(Maybe WantedCompiler)
-    , scoForceReinstall  :: !Bool
-    , scoGHCBindistURL   :: !(Maybe String)
-    , scoGHCJSBootOpts   :: ![String]
-    , scoGHCJSBootClean  :: !Bool
-    }
+  { scoCompilerVersion :: !(Maybe WantedCompiler)
+  , scoForceReinstall  :: !Bool
+  , scoGHCBindistURL   :: !(Maybe String)
+  , scoGHCJSBootOpts   :: ![String]
+  , scoGHCJSBootClean  :: !Bool
+  }
 
-setupParser :: OA.Parser SetupCmdOpts
-setupParser = SetupCmdOpts
-    <$> OA.optional (OA.argument readVersion
-            (OA.metavar "GHC_VERSION" <>
-             OA.help ("Version of GHC to install, e.g. 7.10.2. " ++
-                      "The default is to install the version implied by the resolver.")))
-    <*> OA.boolFlags False
-            "reinstall"
-            "reinstalling GHC, even if available (incompatible with --system-ghc)"
-            OA.idm
-    <*> OA.optional (OA.strOption
-            (OA.long "ghc-bindist"
-           <> OA.metavar "URL"
-           <> OA.help "Alternate GHC binary distribution (requires custom --ghc-variant)"))
-    <*> OA.many (OA.strOption
-            (OA.long "ghcjs-boot-options"
-           <> OA.metavar "GHCJS_BOOT"
-           <> OA.help "Additional ghcjs-boot options"))
-    <*> OA.boolFlags True
-            "ghcjs-boot-clean"
-            "Control if ghcjs-boot should have --clean option present"
-            OA.idm
-  where
-    readVersion = do
-        s <- OA.readerAsk
-        case parseWantedCompiler ("ghc-" <> T.pack s) of
-            Left _ ->
-                case parseWantedCompiler (T.pack s) of
-                    Left _ -> OA.readerError $ "Invalid version: " ++ s
-                    Right x -> pure x
-            Right x -> pure x
+-- | Function underlying the @stack setup@ command.
+setupCmd :: SetupCmdOpts -> RIO Runner ()
+setupCmd sco@SetupCmdOpts{..} = withConfig YesReexec $ do
+  installGHC <- view $ configL.to configInstallGHC
+  if installGHC
+    then
+       withBuildConfig $ do
+       (wantedCompiler, compilerCheck, mstack) <-
+         case scoCompilerVersion of
+           Just v -> pure (v, MatchMinor, Nothing)
+           Nothing -> (,,)
+             <$> view wantedCompilerVersionL
+             <*> view (configL.to configCompilerCheck)
+             <*> (Just <$> view stackYamlL)
+       setup sco wantedCompiler compilerCheck mstack
+    else
+      prettyWarnL
+        [ "The"
+        , style Shell "--no-install-ghc"
+        , flow "flag is inconsistent with"
+        , style Shell (flow "stack setup") <> "."
+        , flow "No action taken."
+        ]
 
-setup
-    :: (HasBuildConfig env, HasGHCVariant env)
-    => SetupCmdOpts
-    -> WantedCompiler
-    -> VersionCheck
-    -> Maybe (Path Abs File)
-    -> RIO env ()
+setup ::
+     (HasBuildConfig env, HasGHCVariant env)
+  => SetupCmdOpts
+  -> WantedCompiler
+  -> VersionCheck
+  -> Maybe (Path Abs File)
+  -> RIO env ()
 setup SetupCmdOpts{..} wantedCompiler compilerCheck mstack = do
-    Config{..} <- view configL
-    sandboxedGhc <- cpSandboxed . fst <$> ensureCompilerAndMsys SetupOpts
-        { soptsInstallIfMissing = True
-        , soptsUseSystem = configSystemGHC && not scoForceReinstall
-        , soptsWantedCompiler = wantedCompiler
-        , soptsCompilerCheck = compilerCheck
-        , soptsStackYaml = mstack
-        , soptsForceReinstall = scoForceReinstall
-        , soptsSanityCheck = True
-        , soptsSkipGhcCheck = False
-        , soptsSkipMsys = configSkipMsys
-        , soptsResolveMissingGHC = Nothing
-        , soptsGHCBindistURL = scoGHCBindistURL
-        }
-    let compiler = case wantedCompiler of
-            WCGhc _ -> "GHC"
-            WCGhcGit{} -> "GHC (built from source)"
-            WCGhcjs {} -> "GHCJS"
-    if sandboxedGhc
-        then logInfo $ "Stack will use a sandboxed " <> compiler <> " it installed."
-        else logInfo $ "Stack will use the " <> compiler <> " on your PATH."
-    logInfo "For more information on paths, see 'stack path' and 'stack exec env'."
-    logInfo $ "To use this " <> compiler <> " and packages outside of a project, consider using:"
-    logInfo "'stack ghc', 'stack ghci', 'stack runghc', or 'stack exec'."
+  Config{..} <- view configL
+  sandboxedGhc <- cpSandboxed . fst <$> ensureCompilerAndMsys SetupOpts
+    { soptsInstallIfMissing = True
+    , soptsUseSystem = configSystemGHC && not scoForceReinstall
+    , soptsWantedCompiler = wantedCompiler
+    , soptsCompilerCheck = compilerCheck
+    , soptsStackYaml = mstack
+    , soptsForceReinstall = scoForceReinstall
+    , soptsSanityCheck = True
+    , soptsSkipGhcCheck = False
+    , soptsSkipMsys = configSkipMsys
+    , soptsResolveMissingGHC = Nothing
+    , soptsGHCBindistURL = scoGHCBindistURL
+    }
+  let compiler = case wantedCompiler of
+        WCGhc _ -> "GHC"
+        WCGhcGit{} -> "GHC (built from source)"
+        WCGhcjs {} -> "GHCJS"
+      compilerHelpMsg = fillSep
+        [ flow "To use this"
+        , compiler
+        , flow "and packages outside of a project, consider using:"
+        , style Shell (flow "stack ghc") <> ","
+        , style Shell (flow "stack ghci") <> ","
+        , style Shell (flow "stack runghc") <> ","
+        , "or"
+        , style Shell (flow "stack exec") <> "."
+        ]
+  if sandboxedGhc
+    then prettyInfoL
+      [ flow "Stack will use a sandboxed"
+      , compiler
+      , flow "it installed."
+      , compilerHelpMsg
+      ]
+    else prettyInfoL
+      [ flow "Stack will use the"
+      , compiler
+      , flow "on your PATH. For more information on paths, see"
+      , style Shell (flow "stack path")
+      , "and"
+      , style Shell (flow "stack exec env") <> "."
+      , compilerHelpMsg
+      ]
src/Stack/SourceMap.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE RecordWildCards   #-}
 
 module Stack.SourceMap
@@ -25,18 +24,31 @@ 
 import           Data.ByteString.Builder ( byteString )
 import qualified Data.Conduit.List as CL
+import qualified Data.Text as T
 import qualified Distribution.PackageDescription as PD
 import           Distribution.System ( Platform (..) )
 import qualified Pantry.SHA256 as SHA256
 import qualified RIO.Map as Map
-import           RIO.Process
+import           RIO.Process ( HasProcessContext )
 import qualified RIO.Set as Set
-import           Stack.PackageDump
+import           Stack.Constants ( stackProgName' )
+import           Stack.PackageDump ( conduitDumpPackage, ghcPkgDump )
 import           Stack.Prelude
-import           Stack.Types.Build
+import           Stack.Types.Build.Exception ( BuildPrettyException (..) )
 import           Stack.Types.Compiler
-import           Stack.Types.Config
+                   ( ActualCompiler, actualToWanted, wantedToActual )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), GhcPkgExe, HasCompiler (..) )
+import           Stack.Types.Config ( HasConfig )
+import           Stack.Types.DumpPackage ( DumpPackage (..) )
+import           Stack.Types.UnusedFlags ( FlagSource, UnusedFlags (..) )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( rslInLogL )
 import           Stack.Types.SourceMap
+                   ( CommonPackage (..), DepPackage (..), FromSnapshot (..)
+                   , GlobalPackage (..), GlobalPackageVersion (..)
+                   , ProjectPackage (..), SMActual (..), SMWanted (..)
+                   )
 
 -- | Create a 'ProjectPackage' from a directory containing a package.
 mkProjectPackage ::
@@ -129,7 +141,7 @@ getPLIVersion (PLIRepo _ pm) = pkgVersion $ pmIdent pm
 
 globalsFromDump ::
-     (HasLogFunc env, HasProcessContext env)
+     (HasProcessContext env, HasTerm env)
   => GhcPkgExe
   -> RIO env (Map PackageName DumpedGlobalPackage)
 globalsFromDump pkgexe = do
@@ -148,7 +160,10 @@   case mglobalHints of
     Just hints -> pure hints
     Nothing -> do
-      logWarn $ "Unable to load global hints for " <> display compiler
+      prettyWarnL
+        [ flow "Unable to load global hints for"
+        , fromString $ T.unpack $ textDisplay compiler
+        ]
       pure mempty
 
 type DumpedGlobalPackage = DumpPackage
@@ -207,7 +222,7 @@     forMaybeM (Map.toList packageFlags) $ \(pname, flags) ->
       getUnusedPackageFlags (pname, flags) source prjPackages deps
   unless (null unusedFlags) $
-    throwM $ InvalidFlagSpecification $ Set.fromList unusedFlags
+    prettyThrowM $ InvalidFlagSpecification $ Set.fromList unusedFlags
 
 getUnusedPackageFlags ::
      MonadIO m
@@ -243,8 +258,8 @@   let (prunedGlobals, keptGlobals) =
         partitionReplacedDependencies globals (pkgName . dpPackageIdent)
           dpGhcPkgId dpDepends deps
-  in Map.map (GlobalPackage . pkgVersion . dpPackageIdent) keptGlobals <>
-     Map.map ReplacedGlobalPackage prunedGlobals
+  in  Map.map (GlobalPackage . pkgVersion . dpPackageIdent) keptGlobals <>
+      Map.map ReplacedGlobalPackage prunedGlobals
 
 getCompilerInfo :: (HasConfig env, HasCompiler env) => RIO env Builder
 getCompilerInfo = view $ compilerPathsL.to (byteString . cpGhcInfo)
src/Stack/Storage/Project.hs view
@@ -1,52 +1,51 @@ {-# LANGUAGE NoImplicitPrelude          #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
 {-# OPTIONS_GHC -Wno-unused-top-binds -Wno-identities #-}
 
 -- | Work with SQLite database used for caches across a single project.
 module Stack.Storage.Project
-    ( initProjectStorage
-    , ConfigCacheKey
-    , configCacheKey
-    , loadConfigCache
-    , saveConfigCache
-    , deactiveConfigCache
-    ) where
+  ( initProjectStorage
+  , ConfigCacheKey
+  , configCacheKey
+  , loadConfigCache
+  , saveConfigCache
+  , deactiveConfigCache
+  ) where
 
 import qualified Data.ByteString as S
 import qualified Data.Set as Set
 import           Database.Persist.Sqlite
+                   ( Entity (..), SelectOpt (..), SqlBackend, Unique, (=.)
+                   , (==.), getBy, insert, selectList, update, updateWhere
+                   )
 import           Database.Persist.TH
+                   ( mkMigrate, mkPersist, persistLowerCase, share
+                   , sqlSettings
+                   )
 import qualified Pantry.Internal as SQLite
-import           Path
 import           Stack.Prelude
 import           Stack.Storage.Util
                    ( handleMigrationException, updateList, updateSet )
-import           Stack.Types.Build
-import           Stack.Types.Cache
-import           Stack.Types.Config
-                   ( HasBuildConfig, ProjectStorage (..), bcProjectStorage
-                   , buildConfigL
-                   )
-import           Stack.Types.GhcPkgId
+import           Stack.Types.Build ( CachePkgSrc, ConfigCache (..) )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.Cache ( ConfigCacheType )
+import           Stack.Types.ConfigureOpts  ( ConfigureOpts (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
+import           Stack.Types.Storage ( ProjectStorage (..) )
 
 share [ mkPersist sqlSettings
       , mkMigrate "migrateAll"
-    ]
-    [persistLowerCase|
+      ]
+      [persistLowerCase|
 ConfigCacheParent sql="config_cache"
   directory FilePath "default=(hex(randomblob(16)))"
   type ConfigCacheType
@@ -86,21 +85,21 @@ 
 -- | Initialize the database.
 initProjectStorage ::
-       HasLogFunc env
-    => Path Abs File -- ^ storage file
-    -> (ProjectStorage -> RIO env a)
-    -> RIO env a
+     HasLogFunc env
+  => Path Abs File -- ^ storage file
+  -> (ProjectStorage -> RIO env a)
+  -> RIO env a
 initProjectStorage fp f = handleMigrationException $
-    SQLite.initStorage "Stack" migrateAll fp $ f . ProjectStorage
+  SQLite.initStorage "Stack" migrateAll fp $ f . ProjectStorage
 
 -- | Run an action in a database transaction
 withProjectStorage ::
-       (HasBuildConfig env, HasLogFunc env)
-    => ReaderT SqlBackend (RIO env) a
-    -> RIO env a
+     (HasBuildConfig env, HasLogFunc env)
+  => ReaderT SqlBackend (RIO env) a
+  -> RIO env a
 withProjectStorage inner = do
-    storage <- view (buildConfigL . to bcProjectStorage . to unProjectStorage)
-    SQLite.withStorage_ storage inner
+  storage <- view (buildConfigL . to bcProjectStorage . to unProjectStorage)
+  SQLite.withStorage_ storage inner
 
 -- | Key used to retrieve configuration or flag cache
 type ConfigCacheKey = Unique ConfigCacheParent
@@ -111,106 +110,106 @@ 
 -- | Internal helper to read the 'ConfigCache'
 readConfigCache ::
-       (HasBuildConfig env, HasLogFunc env)
-    => Entity ConfigCacheParent
-    -> ReaderT SqlBackend (RIO env) ConfigCache
+     (HasBuildConfig env, HasLogFunc env)
+  => Entity ConfigCacheParent
+  -> ReaderT SqlBackend (RIO env) ConfigCache
 readConfigCache (Entity parentId ConfigCacheParent {..}) = do
-    let configCachePkgSrc = configCacheParentPkgSrc
-    coDirs <-
-        map (configCacheDirOptionValue . entityVal) <$>
-        selectList
-            [ConfigCacheDirOptionParent ==. parentId]
-            [Asc ConfigCacheDirOptionIndex]
-    coNoDirs <-
-        map (configCacheNoDirOptionValue . entityVal) <$>
-        selectList
-            [ConfigCacheNoDirOptionParent ==. parentId]
-            [Asc ConfigCacheNoDirOptionIndex]
-    let configCacheOpts = ConfigureOpts {..}
-    configCacheDeps <-
-        Set.fromList . map (configCacheDepValue . entityVal) <$>
-        selectList [ConfigCacheDepParent ==. parentId] []
-    configCacheComponents <-
-        Set.fromList . map (configCacheComponentValue . entityVal) <$>
-        selectList [ConfigCacheComponentParent ==. parentId] []
-    let configCachePathEnvVar = configCacheParentPathEnvVar
-    let configCacheHaddock = configCacheParentHaddock
-    pure ConfigCache {..}
+  let configCachePkgSrc = configCacheParentPkgSrc
+  coDirs <-
+    map (configCacheDirOptionValue . entityVal) <$>
+    selectList
+      [ConfigCacheDirOptionParent ==. parentId]
+      [Asc ConfigCacheDirOptionIndex]
+  coNoDirs <-
+    map (configCacheNoDirOptionValue . entityVal) <$>
+    selectList
+      [ConfigCacheNoDirOptionParent ==. parentId]
+      [Asc ConfigCacheNoDirOptionIndex]
+  let configCacheOpts = ConfigureOpts {..}
+  configCacheDeps <-
+    Set.fromList . map (configCacheDepValue . entityVal) <$>
+    selectList [ConfigCacheDepParent ==. parentId] []
+  configCacheComponents <-
+    Set.fromList . map (configCacheComponentValue . entityVal) <$>
+    selectList [ConfigCacheComponentParent ==. parentId] []
+  let configCachePathEnvVar = configCacheParentPathEnvVar
+  let configCacheHaddock = configCacheParentHaddock
+  pure ConfigCache {..}
 
 -- | Load 'ConfigCache' from the database.
 loadConfigCache ::
-       (HasBuildConfig env, HasLogFunc env)
-    => ConfigCacheKey
-    -> RIO env (Maybe ConfigCache)
+     (HasBuildConfig env, HasLogFunc env)
+  => ConfigCacheKey
+  -> RIO env (Maybe ConfigCache)
 loadConfigCache key =
-    withProjectStorage $ do
-        mparent <- getBy key
-        case mparent of
-            Nothing -> pure Nothing
-            Just parentEntity@(Entity _ ConfigCacheParent {..})
-                | configCacheParentActive ->
-                    Just <$> readConfigCache parentEntity
-                | otherwise -> pure Nothing
+  withProjectStorage $ do
+    mparent <- getBy key
+    case mparent of
+      Nothing -> pure Nothing
+      Just parentEntity@(Entity _ ConfigCacheParent {..})
+        | configCacheParentActive ->
+            Just <$> readConfigCache parentEntity
+        | otherwise -> pure Nothing
 
 -- | Insert or update 'ConfigCache' to the database.
 saveConfigCache ::
-       (HasBuildConfig env, HasLogFunc env)
-    => ConfigCacheKey
-    -> ConfigCache
-    -> RIO env ()
+     (HasBuildConfig env, HasLogFunc env)
+  => ConfigCacheKey
+  -> ConfigCache
+  -> RIO env ()
 saveConfigCache key@(UniqueConfigCacheParent dir type_) new =
-    withProjectStorage $ do
-        mparent <- getBy key
-        (parentId, mold) <-
-            case mparent of
-                Nothing ->
-                    (, Nothing) <$>
-                    insert
-                        ConfigCacheParent
-                            { configCacheParentDirectory = dir
-                            , configCacheParentType = type_
-                            , configCacheParentPkgSrc = configCachePkgSrc new
-                            , configCacheParentActive = True
-                            , configCacheParentPathEnvVar = configCachePathEnvVar new
-                            , configCacheParentHaddock = configCacheHaddock new
-                            }
-                Just parentEntity@(Entity parentId _) -> do
-                    old <- readConfigCache parentEntity
-                    update
-                        parentId
-                        [ ConfigCacheParentPkgSrc =. configCachePkgSrc new
-                        , ConfigCacheParentActive =. True
-                        , ConfigCacheParentPathEnvVar =. configCachePathEnvVar new
-                        ]
-                    pure (parentId, Just old)
-        updateList
-            ConfigCacheDirOption
-            ConfigCacheDirOptionParent
-            parentId
-            ConfigCacheDirOptionIndex
-            (maybe [] (coDirs . configCacheOpts) mold)
-            (coDirs $ configCacheOpts new)
-        updateList
-            ConfigCacheNoDirOption
-            ConfigCacheNoDirOptionParent
-            parentId
-            ConfigCacheNoDirOptionIndex
-            (maybe [] (coNoDirs . configCacheOpts) mold)
-            (coNoDirs $ configCacheOpts new)
-        updateSet
-            ConfigCacheDep
-            ConfigCacheDepParent
-            parentId
-            ConfigCacheDepValue
-            (maybe Set.empty configCacheDeps mold)
-            (configCacheDeps new)
-        updateSet
-            ConfigCacheComponent
-            ConfigCacheComponentParent
+  withProjectStorage $ do
+    mparent <- getBy key
+    (parentId, mold) <-
+      case mparent of
+        Nothing ->
+          (, Nothing) <$>
+          insert
+            ConfigCacheParent
+              { configCacheParentDirectory = dir
+              , configCacheParentType = type_
+              , configCacheParentPkgSrc = configCachePkgSrc new
+              , configCacheParentActive = True
+              , configCacheParentPathEnvVar = configCachePathEnvVar new
+              , configCacheParentHaddock = configCacheHaddock new
+              }
+        Just parentEntity@(Entity parentId _) -> do
+          old <- readConfigCache parentEntity
+          update
             parentId
-            ConfigCacheComponentValue
-            (maybe Set.empty configCacheComponents mold)
-            (configCacheComponents new)
+            [ ConfigCacheParentPkgSrc =. configCachePkgSrc new
+            , ConfigCacheParentActive =. True
+            , ConfigCacheParentPathEnvVar =. configCachePathEnvVar new
+            ]
+          pure (parentId, Just old)
+    updateList
+      ConfigCacheDirOption
+      ConfigCacheDirOptionParent
+      parentId
+      ConfigCacheDirOptionIndex
+      (maybe [] (coDirs . configCacheOpts) mold)
+      (coDirs $ configCacheOpts new)
+    updateList
+      ConfigCacheNoDirOption
+      ConfigCacheNoDirOptionParent
+      parentId
+      ConfigCacheNoDirOptionIndex
+      (maybe [] (coNoDirs . configCacheOpts) mold)
+      (coNoDirs $ configCacheOpts new)
+    updateSet
+      ConfigCacheDep
+      ConfigCacheDepParent
+      parentId
+      ConfigCacheDepValue
+      (maybe Set.empty configCacheDeps mold)
+      (configCacheDeps new)
+    updateSet
+      ConfigCacheComponent
+      ConfigCacheComponentParent
+      parentId
+      ConfigCacheComponentValue
+      (maybe Set.empty configCacheComponents mold)
+      (configCacheComponents new)
 
 -- | Mark 'ConfigCache' as inactive in the database.
 -- We use a flag instead of deleting the records since, in most cases, the same
@@ -218,7 +217,7 @@ -- `cabal configure`), so this avoids unnecessary database churn.
 deactiveConfigCache :: HasBuildConfig env => ConfigCacheKey -> RIO env ()
 deactiveConfigCache (UniqueConfigCacheParent dir type_) =
-    withProjectStorage $
+  withProjectStorage $
     updateWhere
-        [ConfigCacheParentDirectory ==. dir, ConfigCacheParentType ==. type_]
-        [ConfigCacheParentActive =. False]
+      [ConfigCacheParentDirectory ==. dir, ConfigCacheParentType ==. type_]
+      [ConfigCacheParentActive =. False]
src/Stack/Storage/User.hs view
@@ -1,57 +1,58 @@ {-# LANGUAGE NoImplicitPrelude          #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
 {-# OPTIONS_GHC -Wno-unused-top-binds -Wno-identities #-}
 
 -- | Work with SQLite database used for caches across an entire user account.
 module Stack.Storage.User
-    ( initUserStorage
-    , PrecompiledCacheKey
-    , precompiledCacheKey
-    , loadPrecompiledCache
-    , savePrecompiledCache
-    , loadDockerImageExeCache
-    , saveDockerImageExeCache
-    , loadCompilerPaths
-    , saveCompilerPaths
-    , upgradeChecksSince
-    , logUpgradeCheck
-    ) where
+  ( initUserStorage
+  , PrecompiledCacheKey
+  , precompiledCacheKey
+  , loadPrecompiledCache
+  , savePrecompiledCache
+  , loadDockerImageExeCache
+  , saveDockerImageExeCache
+  , loadCompilerPaths
+  , saveCompilerPaths
+  , upgradeChecksSince
+  , logUpgradeCheck
+  ) where
 
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Data.Time.Clock ( UTCTime )
 import           Database.Persist.Sqlite
+                   ( Entity (..), SqlBackend, Unique, (=.), (==.), (>=.), count
+                   , deleteBy, getBy, insert, insert_, selectList, update
+                   , upsert
+                   )
 import           Database.Persist.TH
+                   ( mkMigrate, mkPersist, persistLowerCase, share
+                   , sqlSettings
+                   )
 import           Distribution.Text ( simpleParse, display )
 import           Foreign.C.Types ( CTime (..) )
 import qualified Pantry.Internal as SQLite
-import           Path
+import           Path ( (</>), mkRelFile, parseRelFile )
 import           Path.IO ( resolveFile', resolveDir' )
 import qualified RIO.FilePath as FP
-import           Stack.Prelude hiding ( MigrationFailure )
+import           Stack.Prelude
 import           Stack.Storage.Util ( handleMigrationException, updateSet )
-import           Stack.Types.Build
-import           Stack.Types.Cache
-import           Stack.Types.Compiler
+import           Stack.Types.Build ( PrecompiledCache (..) )
+import           Stack.Types.Cache ( Action (..) )
+import           Stack.Types.Compiler ( ActualCompiler, compilerVersionText )
 import           Stack.Types.CompilerBuild ( CompilerBuild )
-import           Stack.Types.Config
-                   ( CompilerPaths (..), GhcPkgExe (..), HasConfig
-                   , UserStorage (..), configL, configUserStorage
-                   )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), GhcPkgExe (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.Storage ( UserStorage (..) )
 import           System.Posix.Types ( COff (..) )
 import           System.PosixCompat.Files
                    ( fileSize, getFileStatus, modificationTime )
@@ -59,33 +60,33 @@ -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Storage.User" module.
 data StorageUserException
-    = CompilerFileMetadataMismatch
-    | GlobalPackageCacheFileMetadataMismatch
-    | GlobalDumpParseFailure
-    | CompilerCacheArchitectureInvalid Text
-    deriving (Show, Typeable)
+  = CompilerFileMetadataMismatch
+  | GlobalPackageCacheFileMetadataMismatch
+  | GlobalDumpParseFailure
+  | CompilerCacheArchitectureInvalid Text
+  deriving (Show, Typeable)
 
 instance Exception StorageUserException where
-    displayException CompilerFileMetadataMismatch =
-        "Error: [S-8196]\n"
-        ++ "Compiler file metadata mismatch, ignoring cache."
-    displayException GlobalPackageCacheFileMetadataMismatch =
-        "Error: [S-5378]\n"
-        ++ "Global package cache file metadata mismatch, ignoring cache."
-    displayException GlobalDumpParseFailure =
-        "Error: [S-2673]\n"
-        ++ "Global dump did not parse correctly."
-    displayException
-      (CompilerCacheArchitectureInvalid compilerCacheArch) = concat
-        [ "Error: [S-8441]\n"
-        , "Invalid arch: "
-        , show compilerCacheArch
-        ]
+  displayException CompilerFileMetadataMismatch =
+    "Error: [S-8196]\n"
+    ++ "Compiler file metadata mismatch, ignoring cache."
+  displayException GlobalPackageCacheFileMetadataMismatch =
+    "Error: [S-5378]\n"
+    ++ "Global package cache file metadata mismatch, ignoring cache."
+  displayException GlobalDumpParseFailure =
+    "Error: [S-2673]\n"
+    ++ "Global dump did not parse correctly."
+  displayException
+    (CompilerCacheArchitectureInvalid compilerCacheArch) = concat
+      [ "Error: [S-8441]\n"
+      , "Invalid arch: "
+      , show compilerCacheArch
+      ]
 
 share [ mkPersist sqlSettings
       , mkMigrate "migrateAll"
-    ]
-    [persistLowerCase|
+      ]
+      [persistLowerCase|
 PrecompiledCacheParent sql="precompiled_cache"
   platformGhcDir FilePath "default=(hex(randomblob(16)))"
   compiler Text
@@ -153,147 +154,156 @@ 
 -- | Initialize the database.
 initUserStorage ::
-       HasLogFunc env
-    => Path Abs File -- ^ storage file
-    -> (UserStorage -> RIO env a)
-    -> RIO env a
+     HasLogFunc env
+  => Path Abs File -- ^ storage file
+  -> (UserStorage -> RIO env a)
+  -> RIO env a
 initUserStorage fp f = handleMigrationException $
-    SQLite.initStorage "Stack" migrateAll fp $ f . UserStorage
+  SQLite.initStorage "Stack" migrateAll fp $ f . UserStorage
 
 -- | Run an action in a database transaction
 withUserStorage ::
-       (HasConfig env, HasLogFunc env)
-    => ReaderT SqlBackend (RIO env) a
-    -> RIO env a
+     (HasConfig env, HasLogFunc env)
+  => ReaderT SqlBackend (RIO env) a
+  -> RIO env a
 withUserStorage inner = do
-    storage <- view (configL . to configUserStorage . to unUserStorage)
-    SQLite.withStorage_ storage inner
+  storage <- view (configL . to configUserStorage . to unUserStorage)
+  SQLite.withStorage_ storage inner
 
 -- | Key used to retrieve the precompiled cache
 type PrecompiledCacheKey = Unique PrecompiledCacheParent
 
 -- | Build key used to retrieve the precompiled cache
 precompiledCacheKey ::
-       Path Rel Dir
-    -> ActualCompiler
-    -> Version
-    -> Text
-    -> ByteString
-    -> Bool
-    -> PrecompiledCacheKey
+     Path Rel Dir
+  -> ActualCompiler
+  -> Version
+  -> Text
+  -> ByteString
+  -> Bool
+  -> PrecompiledCacheKey
 precompiledCacheKey platformGhcDir compiler cabalVersion =
-    UniquePrecompiledCacheParent
-        (toFilePath platformGhcDir)
-        (compilerVersionText compiler)
-        (T.pack $ versionString cabalVersion)
+  UniquePrecompiledCacheParent
+    (toFilePath platformGhcDir)
+    (compilerVersionText compiler)
+    (T.pack $ versionString cabalVersion)
 
 -- | Internal helper to read the 'PrecompiledCache' from the database
 readPrecompiledCache ::
-       (HasConfig env, HasLogFunc env)
-    => PrecompiledCacheKey
-    -> ReaderT SqlBackend (RIO env) (Maybe ( PrecompiledCacheParentId
-                                           , PrecompiledCache Rel))
+     (HasConfig env, HasLogFunc env)
+  => PrecompiledCacheKey
+  -> ReaderT SqlBackend (RIO env) (Maybe ( PrecompiledCacheParentId
+                                         , PrecompiledCache Rel))
 readPrecompiledCache key = do
-    mparent <- getBy key
-    forM mparent $ \(Entity parentId PrecompiledCacheParent {..}) -> do
-        pcLibrary <- mapM parseRelFile precompiledCacheParentLibrary
-        pcSubLibs <-
-            mapM (parseRelFile . precompiledCacheSubLibValue . entityVal) =<<
-            selectList [PrecompiledCacheSubLibParent ==. parentId] []
-        pcExes <-
-            mapM (parseRelFile . precompiledCacheExeValue . entityVal) =<<
-            selectList [PrecompiledCacheExeParent ==. parentId] []
-        pure (parentId, PrecompiledCache {..})
+  mparent <- getBy key
+  forM mparent $ \(Entity parentId PrecompiledCacheParent {..}) -> do
+    pcLibrary <- mapM parseRelFile precompiledCacheParentLibrary
+    pcSubLibs <-
+      mapM (parseRelFile . precompiledCacheSubLibValue . entityVal) =<<
+      selectList [PrecompiledCacheSubLibParent ==. parentId] []
+    pcExes <-
+      mapM (parseRelFile . precompiledCacheExeValue . entityVal) =<<
+      selectList [PrecompiledCacheExeParent ==. parentId] []
+    pure (parentId, PrecompiledCache {..})
 
 -- | Load 'PrecompiledCache' from the database.
 loadPrecompiledCache ::
-       (HasConfig env, HasLogFunc env)
-    => PrecompiledCacheKey
-    -> RIO env (Maybe (PrecompiledCache Rel))
-loadPrecompiledCache key = withUserStorage $ fmap snd <$> readPrecompiledCache key
+     (HasConfig env, HasLogFunc env)
+  => PrecompiledCacheKey
+  -> RIO env (Maybe (PrecompiledCache Rel))
+loadPrecompiledCache key =
+  withUserStorage $ fmap snd <$> readPrecompiledCache key
 
 -- | Insert or update 'PrecompiledCache' to the database.
 savePrecompiledCache ::
-       (HasConfig env, HasLogFunc env)
-    => PrecompiledCacheKey
-    -> PrecompiledCache Rel
-    -> RIO env ()
-savePrecompiledCache key@(UniquePrecompiledCacheParent precompiledCacheParentPlatformGhcDir precompiledCacheParentCompiler precompiledCacheParentCabalVersion precompiledCacheParentPackageKey precompiledCacheParentOptionsHash precompiledCacheParentHaddock) new =
-    withUserStorage $ do
-        let precompiledCacheParentLibrary = fmap toFilePath (pcLibrary new)
-        mIdOld <- readPrecompiledCache key
-        (parentId, mold) <-
-            case mIdOld of
-                Nothing -> (, Nothing) <$> insert PrecompiledCacheParent {..}
-                Just (parentId, old) -> do
-                    update
-                        parentId
-                        [ PrecompiledCacheParentLibrary =.
-                          precompiledCacheParentLibrary
-                        ]
-                    pure (parentId, Just old)
-        updateSet
-            PrecompiledCacheSubLib
-            PrecompiledCacheSubLibParent
-            parentId
-            PrecompiledCacheSubLibValue
-            (maybe Set.empty (toFilePathSet . pcSubLibs) mold)
-            (toFilePathSet $ pcSubLibs new)
-        updateSet
-            PrecompiledCacheExe
-            PrecompiledCacheExeParent
-            parentId
-            PrecompiledCacheExeValue
-            (maybe Set.empty (toFilePathSet . pcExes) mold)
-            (toFilePathSet $ pcExes new)
-  where
-    toFilePathSet = Set.fromList . map toFilePath
+     (HasConfig env, HasLogFunc env)
+  => PrecompiledCacheKey
+  -> PrecompiledCache Rel
+  -> RIO env ()
+savePrecompiledCache
+  key@( UniquePrecompiledCacheParent
+          precompiledCacheParentPlatformGhcDir
+          precompiledCacheParentCompiler
+          precompiledCacheParentCabalVersion
+          precompiledCacheParentPackageKey
+          precompiledCacheParentOptionsHash
+          precompiledCacheParentHaddock
+      )
+  new
+  = withUserStorage $ do
+      let precompiledCacheParentLibrary = fmap toFilePath (pcLibrary new)
+      mIdOld <- readPrecompiledCache key
+      (parentId, mold) <-
+        case mIdOld of
+          Nothing -> (, Nothing) <$> insert PrecompiledCacheParent {..}
+          Just (parentId, old) -> do
+            update
+              parentId
+              [ PrecompiledCacheParentLibrary =.
+                precompiledCacheParentLibrary
+              ]
+            pure (parentId, Just old)
+      updateSet
+        PrecompiledCacheSubLib
+        PrecompiledCacheSubLibParent
+        parentId
+        PrecompiledCacheSubLibValue
+        (maybe Set.empty (toFilePathSet . pcSubLibs) mold)
+        (toFilePathSet $ pcSubLibs new)
+      updateSet
+        PrecompiledCacheExe
+        PrecompiledCacheExeParent
+        parentId
+        PrecompiledCacheExeValue
+        (maybe Set.empty (toFilePathSet . pcExes) mold)
+        (toFilePathSet $ pcExes new)
+ where
+  toFilePathSet = Set.fromList . map toFilePath
 
 -- | Get the record of whether an executable is compatible with a Docker image
 loadDockerImageExeCache ::
-       (HasConfig env, HasLogFunc env)
-    => Text
-    -> Path Abs File
-    -> UTCTime
-    -> RIO env (Maybe Bool)
-loadDockerImageExeCache imageId exePath exeTimestamp =
-    withUserStorage $
-    fmap (dockerImageExeCacheCompatible . entityVal) <$>
-    getBy (DockerImageExeCacheUnique imageId (toFilePath exePath) exeTimestamp)
+     (HasConfig env, HasLogFunc env)
+  => Text
+  -> Path Abs File
+  -> UTCTime
+  -> RIO env (Maybe Bool)
+loadDockerImageExeCache imageId exePath exeTimestamp = withUserStorage $
+  fmap (dockerImageExeCacheCompatible . entityVal) <$>
+  getBy (DockerImageExeCacheUnique imageId (toFilePath exePath) exeTimestamp)
 
 -- | Sets the record of whether an executable is compatible with a Docker image
 saveDockerImageExeCache ::
-       (HasConfig env, HasLogFunc env)
-    => Text
-    -> Path Abs File
-    -> UTCTime
-    -> Bool
-    -> RIO env ()
-saveDockerImageExeCache imageId exePath exeTimestamp compatible =
-    void $
-    withUserStorage $
+     (HasConfig env, HasLogFunc env)
+  => Text
+  -> Path Abs File
+  -> UTCTime
+  -> Bool
+  -> RIO env ()
+saveDockerImageExeCache imageId exePath exeTimestamp compatible = void $
+  withUserStorage $
     upsert
-        (DockerImageExeCache
-             imageId
-             (toFilePath exePath)
-             exeTimestamp
-             compatible)
-        []
+      ( DockerImageExeCache
+          imageId
+          (toFilePath exePath)
+          exeTimestamp
+          compatible
+      )
+      []
 
--- | Type-restricted version of 'fromIntegral' to ensure we're making
--- the value bigger, not smaller.
+-- | Type-restricted version of 'fromIntegral' to ensure we're making the value
+-- bigger, not smaller.
 sizeToInt64 :: COff -> Int64
 sizeToInt64 (COff i) = fromIntegral i -- fromIntegral added for 32-bit systems
 
--- | Type-restricted version of 'fromIntegral' to ensure we're making
--- the value bigger, not smaller.
+-- | Type-restricted version of 'fromIntegral' to ensure we're making the value
+-- bigger, not smaller.
 timeToInt64 :: CTime -> Int64
 timeToInt64 (CTime i) = fromIntegral i -- fromIntegral added for 32-bit systems
 
--- | Load compiler information, if available, and confirm that the
--- referenced files are unchanged. May throw exceptions!
-loadCompilerPaths
-  :: HasConfig env
+-- | Load compiler information, if available, and confirm that the referenced
+-- files are unchanged. May throw exceptions!
+loadCompilerPaths ::
+     HasConfig env
   => Path Abs File -- ^ compiler executable
   -> CompilerBuild
   -> Bool -- ^ sandboxed?
@@ -303,18 +313,23 @@   for mres $ \(Entity _ CompilerCache {..}) -> do
     compilerStatus <- liftIO $ getFileStatus $ toFilePath compiler
     when
-      (compilerCacheGhcSize /= sizeToInt64 (fileSize compilerStatus) ||
-       compilerCacheGhcModified /= timeToInt64 (modificationTime compilerStatus))
+      (  compilerCacheGhcSize /= sizeToInt64 (fileSize compilerStatus)
+      || compilerCacheGhcModified /=
+           timeToInt64 (modificationTime compilerStatus)
+      )
       (throwIO CompilerFileMetadataMismatch)
-    globalDbStatus <- liftIO $ getFileStatus $ compilerCacheGlobalDb FP.</> "package.cache"
+    globalDbStatus <-
+      liftIO $ getFileStatus $ compilerCacheGlobalDb FP.</> "package.cache"
     when
-      (compilerCacheGlobalDbCacheSize /= sizeToInt64 (fileSize globalDbStatus) ||
-       compilerCacheGlobalDbCacheModified /= timeToInt64 (modificationTime globalDbStatus))
+      (  compilerCacheGlobalDbCacheSize /= sizeToInt64 (fileSize globalDbStatus)
+      || compilerCacheGlobalDbCacheModified /=
+           timeToInt64 (modificationTime globalDbStatus)
+      )
       (throwIO GlobalPackageCacheFileMetadataMismatch)
 
-    -- We could use parseAbsFile instead of resolveFile' below to
-    -- bypass some system calls, at the cost of some really wonky
-    -- error messages in case someone screws up their GHC installation
+    -- We could use parseAbsFile instead of resolveFile' below to bypass some
+    -- system calls, at the cost of some really wonky error messages in case
+    -- someone screws up their GHC installation
     pkgexe <- resolveFile' compilerCacheGhcPkgPath
     runghc <- resolveFile' compilerCacheRunghcPath
     haddock <- resolveFile' compilerCacheHaddockPath
@@ -346,14 +361,16 @@       }
 
 -- | Save compiler information. May throw exceptions!
-saveCompilerPaths
-  :: HasConfig env
+saveCompilerPaths ::
+     HasConfig env
   => CompilerPaths
   -> RIO env ()
 saveCompilerPaths CompilerPaths {..} = withUserStorage $ do
   deleteBy $ UniqueCompilerInfo $ toFilePath cpCompiler
   compilerStatus <- liftIO $ getFileStatus $ toFilePath cpCompiler
-  globalDbStatus <- liftIO $ getFileStatus $ toFilePath $ cpGlobalDB </> $(mkRelFile "package.cache")
+  globalDbStatus <-
+    liftIO $
+      getFileStatus $ toFilePath $ cpGlobalDB </> $(mkRelFile "package.cache")
   let GhcPkgExe pkgexe = cpPkg
   insert_ CompilerCache
     { compilerCacheActualVersion = cpCompilerVersion
@@ -366,7 +383,8 @@     , compilerCacheCabalVersion = T.pack $ versionString cpCabalVersion
     , compilerCacheGlobalDb = toFilePath cpGlobalDB
     , compilerCacheGlobalDbCacheSize = sizeToInt64 $ fileSize globalDbStatus
-    , compilerCacheGlobalDbCacheModified = timeToInt64 $ modificationTime globalDbStatus
+    , compilerCacheGlobalDbCacheModified =
+        timeToInt64 $ modificationTime globalDbStatus
     , compilerCacheInfo = cpGhcInfo
     , compilerCacheGlobalDump = tshow cpGlobalDump
     , compilerCacheArch = T.pack $ Distribution.Text.display cpArch
src/Stack/Storage/Util.hs view
@@ -1,93 +1,88 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE CPP                   #-}
 
 -- | Utils for the other Stack.Storage modules
 module Stack.Storage.Util
-    ( handleMigrationException
-    , updateList
-    , updateSet
-    ) where
+  ( handleMigrationException
+  , updateList
+  , updateSet
+  ) where
 
 import qualified Data.Set as Set
 import           Database.Persist
+                   ( BaseBackend, EntityField, PersistEntity
+                   , PersistEntityBackend, PersistField, PersistQueryWrite
+                   , SafeToInsert, (<-.), (==.), deleteWhere, insertMany_
+                   )
 import           Stack.Prelude
 import           Stack.Types.Storage ( StoragePrettyException (..) )
 
 -- | Efficiently update a set of values stored in a database table
 updateSet ::
-       ( PersistEntityBackend record ~ BaseBackend backend
-       , PersistField parentid
-       , PersistField value
-       , Ord value
-       , PersistEntity record
-       , MonadIO m
-       , PersistQueryWrite backend
-#if MIN_VERSION_persistent(2,14,0)
-       , SafeToInsert record
-#endif
-       )
-    => (parentid -> value -> record)
-    -> EntityField record parentid
-    -> parentid
-    -> EntityField record value
-    -> Set value
-    -> Set value
-    -> ReaderT backend m ()
+     ( PersistEntityBackend record ~ BaseBackend backend
+     , PersistField parentid
+     , PersistField value
+     , Ord value
+     , PersistEntity record
+     , MonadIO m
+     , PersistQueryWrite backend
+     , SafeToInsert record
+     )
+  => (parentid -> value -> record)
+  -> EntityField record parentid
+  -> parentid
+  -> EntityField record value
+  -> Set value
+  -> Set value
+  -> ReaderT backend m ()
 updateSet recordCons parentFieldCons parentId valueFieldCons old new =
-    when (old /= new) $ do
-        deleteWhere
-            [ parentFieldCons ==. parentId
-            , valueFieldCons <-. Set.toList (Set.difference old new)
-            ]
-        insertMany_ $
-            map (recordCons parentId) $ Set.toList (Set.difference new old)
+  when (old /= new) $ do
+    deleteWhere
+      [ parentFieldCons ==. parentId
+      , valueFieldCons <-. Set.toList (Set.difference old new)
+      ]
+    insertMany_ $
+      map (recordCons parentId) $ Set.toList (Set.difference new old)
 
 -- | Efficiently update a list of values stored in a database table.
 updateList ::
-       ( PersistEntityBackend record ~ BaseBackend backend
-       , PersistField parentid
-       , Ord value
-       , PersistEntity record
-       , MonadIO m
-       , PersistQueryWrite backend
-#if MIN_VERSION_persistent(2,14,0)
-       , SafeToInsert record
-#endif
-       )
-    => (parentid -> Int -> value -> record)
-    -> EntityField record parentid
-    -> parentid
-    -> EntityField record Int
-    -> [value]
-    -> [value]
-    -> ReaderT backend m ()
+     ( PersistEntityBackend record ~ BaseBackend backend
+     , PersistField parentid
+     , Ord value
+     , PersistEntity record
+     , MonadIO m
+     , PersistQueryWrite backend
+     , SafeToInsert record
+     )
+  => (parentid -> Int -> value -> record)
+  -> EntityField record parentid
+  -> parentid
+  -> EntityField record Int
+  -> [value]
+  -> [value]
+  -> ReaderT backend m ()
 updateList recordCons parentFieldCons parentId indexFieldCons old new =
-    when (old /= new) $ do
-        let oldSet = Set.fromList (zip [0 ..] old)
-            newSet = Set.fromList (zip [0 ..] new)
-        deleteWhere
-            [ parentFieldCons ==. parentId
-            , indexFieldCons <-.
-              map fst (Set.toList $ Set.difference oldSet newSet)
-            ]
-        insertMany_ $
-            map (uncurry $ recordCons parentId) $
-            Set.toList (Set.difference newSet oldSet)
+  when (old /= new) $ do
+    let oldSet = Set.fromList (zip [0 ..] old)
+        newSet = Set.fromList (zip [0 ..] new)
+    deleteWhere
+      [ parentFieldCons ==. parentId
+      , indexFieldCons <-.
+        map fst (Set.toList $ Set.difference oldSet newSet)
+      ]
+    insertMany_ $
+      map (uncurry $ recordCons parentId) $
+      Set.toList (Set.difference newSet oldSet)
 
 handleMigrationException :: HasLogFunc env => RIO env a -> RIO env a
 handleMigrationException inner = do
-    eres <- try inner
-    either
-        ( \e -> case e :: PantryException of
-                    MigrationFailure desc fp ex ->
-                        throwIO $
-                            PrettyException $ StorageMigrationFailure desc fp ex
-                    _ -> throwIO e
-        )
-        pure
-        eres
+  eres <- try inner
+  either
+    ( \e -> case e :: PantryException of
+              MigrationFailure desc fp ex ->
+                prettyThrowIO $ StorageMigrationFailure desc fp ex
+              _ -> throwIO e
+    )
+    pure
+    eres
+ src/Stack/Templates.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Functions related to Stack's @templates@ command.
+module Stack.Templates
+  ( templatesCmd
+  , templatesHelp
+  ) where
+
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Text as T
+import           Network.HTTP.StackClient
+                   ( HttpException (..), getResponseBody, httpLbs, parseUrlThrow
+                   , setGitHubHeaders
+                   )
+import           Stack.Prelude
+import           Stack.Runners ( ShouldReexec (..), withConfig )
+import           Stack.Types.Runner ( Runner )
+
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.Templates" module.
+data TemplatesPrettyException
+  = DownloadTemplatesHelpFailed !HttpException
+  | TemplatesHelpEncodingInvalid !String !UnicodeException
+  deriving Typeable
+
+deriving instance Show TemplatesPrettyException
+
+instance Pretty TemplatesPrettyException where
+  pretty (DownloadTemplatesHelpFailed err) =
+    "[S-8143]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to download the help for"
+         , style Shell "stack templates" <> "."
+         ]
+    <> blankLine
+    <> flow "While downloading, Stack encountered the following error:"
+    <> blankLine
+    <> string (displayException err)
+  pretty (TemplatesHelpEncodingInvalid url err) =
+    "[S-6670]"
+    <> line
+    <> fillSep
+         [ flow "Stack failed to decode the help for"
+         , style Shell "stack templates"
+         , flow "downloaded from"
+         , style Url (fromString url) <> "."
+         ]
+    <> blankLine
+    <> flow "While decoding, Stack encountered the following error:"
+    <> blankLine
+    <> string (displayException err)
+
+instance Exception TemplatesPrettyException
+
+-- | Function underlying the @stack templates@ command. Display instructions for
+-- how to use templates.
+templatesCmd :: () -> RIO Runner ()
+templatesCmd () = withConfig NoReexec templatesHelp
+
+-- | Display help for the templates command.
+templatesHelp :: HasTerm env => RIO env ()
+templatesHelp = do
+  let url = defaultTemplatesHelpUrl
+  req <- fmap setGitHubHeaders (parseUrlThrow url)
+  resp <- catch
+    (httpLbs req)
+    (prettyThrowM . DownloadTemplatesHelpFailed)
+  case decodeUtf8' $ LB.toStrict $ getResponseBody resp of
+    Left err -> prettyThrowM $ TemplatesHelpEncodingInvalid url err
+    Right txt -> prettyInfo (string $ T.unpack txt)
+
+-- | Default web URL to get the `stack templates` help output.
+defaultTemplatesHelpUrl :: String
+defaultTemplatesHelpUrl =
+  "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master/STACK_HELP.md"
+ src/Stack/Types/AddCommand.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.AddCommand
+  ( AddCommand
+  ) where
+
+import           Control.Monad.Trans.Except ( ExceptT )
+import           Control.Monad.Writer ( Writer )
+import qualified Options.Applicative as OA
+import           Stack.Prelude
+import           Stack.Types.GlobalOptsMonoid ( GlobalOptsMonoid )
+import           Stack.Types.Runner ( Runner )
+
+type AddCommand =
+  ExceptT (RIO Runner ())
+          (Writer (OA.Mod OA.CommandFields (RIO Runner (), GlobalOptsMonoid)))
+          ()
+ src/Stack/Types/AllowNewerDeps.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.AllowNewerDeps
+  ( AllowNewerDeps (..)
+  ) where
+
+import qualified Distribution.PackageDescription as C
+import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import           Pantry.Internal.AesonExtended ( FromJSON (..) )
+import           Stack.Prelude
+
+newtype AllowNewerDeps
+  = AllowNewerDeps [PackageName]
+  deriving (Eq, Generic, Ord, Read, Show)
+
+instance Semigroup AllowNewerDeps where
+  (<>) = mappenddefault
+
+instance Monoid AllowNewerDeps where
+  mappend = (<>)
+  mempty = memptydefault
+
+instance FromJSON AllowNewerDeps where
+  parseJSON = fmap (AllowNewerDeps . fmap C.mkPackageName) . parseJSON
+ src/Stack/Types/ApplyGhcOptions.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.ApplyGhcOptions
+  ( ApplyGhcOptions (..)
+  ) where
+
+import           Pantry.Internal.AesonExtended ( FromJSON (..), withText )
+import           Stack.Prelude
+
+-- | Which packages do ghc-options on the command line apply to?
+data ApplyGhcOptions
+  = AGOTargets -- ^ all local targets
+  | AGOLocals -- ^ all local packages, even non-targets
+  | AGOEverything -- ^ every package
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+instance FromJSON ApplyGhcOptions where
+  parseJSON = withText "ApplyGhcOptions" $ \t ->
+    case t of
+      "targets" -> pure AGOTargets
+      "locals" -> pure AGOLocals
+      "everything" -> pure AGOEverything
+      _ -> fail $ "Invalid ApplyGhcOptions: " ++ show t
+ src/Stack/Types/ApplyProgOptions.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.ApplyProgOptions
+  ( ApplyProgOptions (..)
+  ) where
+
+import           Pantry.Internal.AesonExtended ( FromJSON (..), withText )
+import           Stack.Prelude
+
+-- | Which packages do all and any --PROG-option options on the command line
+-- apply to?
+data ApplyProgOptions
+  = APOTargets -- ^ All local packages that are targets.
+  | APOLocals -- ^ All local packages (targets or otherwise).
+  | APOEverything -- ^ All packages (local or otherwise).
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+instance FromJSON ApplyProgOptions where
+  parseJSON = withText "ApplyProgOptions" $ \t ->
+    case t of
+      "targets" -> pure APOTargets
+      "locals" -> pure APOLocals
+      "everything" -> pure APOEverything
+      _ -> fail $ "Invalid ApplyProgOptions: " ++ show t
src/Stack/Types/Build.hs view
@@ -1,1122 +1,223 @@ {-# LANGUAGE NoImplicitPrelude          #-}
 {-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-
--- | Build-specific types.
-
-module Stack.Types.Build
-  ( BuildException (..)
-  , BuildPrettyException (..)
-  , ConstructPlanException (..)
-  , BadDependency (..)
-  , ParentMap
-  , FlagSource (..)
-  , UnusedFlags (..)
-  , InstallLocation (..)
-  , Installed (..)
-  , psVersion
-  , Task (..)
-  , taskIsTarget
-  , taskLocation
-  , taskTargetIsMutable
-  , LocalPackage (..)
-  , BaseConfigOpts (..)
-  , Plan (..)
-  , TestOpts (..)
-  , BenchmarkOpts (..)
-  , FileWatchOpts (..)
-  , BuildOpts (..)
-  , BuildSubset (..)
-  , defaultBuildOpts
-  , TaskType (..)
-  , IsMutable (..)
-  , installLocationIsMutable
-  , TaskConfigOpts (..)
-  , BuildCache (..)
-  , ConfigCache (..)
-  , configureOpts
-  , CachePkgSrc (..)
-  , toCachePkgSrc
-  , isStackOpt
-  , wantedLocalPackages
-  , FileCacheInfo (..)
-  , ConfigureOpts (..)
-  , PrecompiledCache (..)
-  ) where
-
-import           Data.Aeson ( ToJSON, FromJSON )
-import qualified Data.ByteString as S
-import           Data.Char ( isSpace )
-import           Data.List as L
-import qualified Data.Map as Map
-import qualified Data.Map.Strict as M
-import           Data.Monoid.Map ( MonoidMap (..) )
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import           Database.Persist.Sql
-                   ( PersistField (..), PersistFieldSql (..)
-                   , PersistValue (PersistText), SqlType (SqlString)
-                   )
-import           Distribution.PackageDescription
-                   ( TestSuiteInterface, mkPackageName )
-import           Distribution.System ( Arch )
-import qualified Distribution.Text as C
-import qualified Distribution.Version as C
-import           Path ( parseRelDir, (</>), parent )
-import           Path.Extra ( toFilePathNoTrailingSep )
-import           RIO.Process ( showProcessArgDebug )
-import           Stack.Constants
-import           Stack.Prelude
-import           Stack.Types.Compiler
-import           Stack.Types.CompilerBuild
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
-import           Stack.Types.Package
-import           Stack.Types.Version
-import           System.FilePath ( pathSeparator )
-
--- | Type representing exceptions thrown by functions exported by modules with
--- names beginning @Stack.Build@.
-data BuildException
-  = Couldn'tFindPkgId PackageName
-  | CompilerVersionMismatch
-        (Maybe (ActualCompiler, Arch)) -- found
-        (WantedCompiler, Arch) -- expected
-        GHCVariant -- expected
-        CompilerBuild -- expected
-        VersionCheck
-        (Maybe (Path Abs File)) -- Path to the stack.yaml file
-        Text -- recommended resolution
-  | Couldn'tParseTargets [Text]
-  | UnknownTargets
-    (Set PackageName) -- no known version
-    (Map PackageName Version) -- not in snapshot, here's the most recent version in the index
-    (Path Abs File) -- stack.yaml
-  | TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) S.ByteString
-  | TestSuiteTypeUnsupported TestSuiteInterface
-  | LocalPackageDoesn'tMatchTarget
-        PackageName
-        Version -- local version
-        Version -- version specified on command line
-  | NoSetupHsFound (Path Abs Dir)
-  | InvalidFlagSpecification (Set UnusedFlags)
-  | InvalidGhcOptionsSpecification [PackageName]
-  | TargetParseException [Text]
-  | SomeTargetsNotBuildable [(PackageName, NamedComponent)]
-  | TestSuiteExeMissing Bool String String String
-  | CabalCopyFailed Bool String
-  | LocalPackagesPresent [PackageIdentifier]
-  | CouldNotLockDistDir !(Path Abs File)
-  | TaskCycleBug PackageIdentifier
-  | PackageIdMissingBug PackageIdentifier
-  | AllInOneBuildBug
-  | MulipleResultsBug PackageName [DumpPackage]
-  | TemplateHaskellNotFoundBug
-  | HaddockIndexNotFound
-  | ShowBuildErrorBug
-  deriving (Show, Typeable)
-
-instance Exception BuildException where
-    displayException (Couldn'tFindPkgId name) = bugReport "[S-7178]" $ concat
-        [ "After installing "
-        , packageNameString name
-        ,", the package id couldn't be found (via ghc-pkg describe "
-        , packageNameString name
-        , ")."
-        ]
-    displayException (CompilerVersionMismatch mactual (expected, eArch) ghcVariant ghcBuild check mstack resolution) = concat
-        [ "Error: [S-6362]\n"
-        , case mactual of
-            Nothing -> "No compiler found, expected "
-            Just (actual, arch) -> concat
-                [ "Compiler version mismatched, found "
-                , compilerVersionString actual
-                , " ("
-                , C.display arch
-                , ")"
-                , ", but expected "
-                ]
-        , case check of
-            MatchMinor -> "minor version match with "
-            MatchExact -> "exact version "
-            NewerMinor -> "minor version match or newer with "
-        , T.unpack $ utf8BuilderToText $ display expected
-        , " ("
-        , C.display eArch
-        , ghcVariantSuffix ghcVariant
-        , compilerBuildSuffix ghcBuild
-        , ") (based on "
-        , case mstack of
-            Nothing -> "command line arguments"
-            Just stack -> "resolver setting in " ++ toFilePath stack
-        , ").\n"
-        , T.unpack resolution
-        ]
-    displayException (Couldn'tParseTargets targets) = unlines
-        $ "Error: [S-3127]"
-        : "The following targets could not be parsed as package names or \
-          \directories:"
-        : map T.unpack targets
-    displayException (UnknownTargets noKnown notInSnapshot stackYaml) = unlines
-        $ "Error: [S-2154]"
-        : (noKnown' ++ notInSnapshot')
-      where
-        noKnown'
-            | Set.null noKnown = []
-            | otherwise = pure $
-                "The following target packages were not found: " ++
-                intercalate ", " (map packageNameString $ Set.toList noKnown) ++
-                "\nSee https://docs.haskellstack.org/en/stable/build_command/#target-syntax for details."
-        notInSnapshot'
-            | Map.null notInSnapshot = []
-            | otherwise =
-                  "The following packages are not in your snapshot, but exist"
-                : "in your package index. Recommended action: add them to your"
-                : ("extra-deps in " ++ toFilePath stackYaml)
-                : "(Note: these are the most recent versions,"
-                : "but there's no guarantee that they'll build together)."
-                : ""
-                : map
-                    (\(name, version') -> "- " ++ packageIdentifierString
-                        (PackageIdentifier name version'))
-                    (Map.toList notInSnapshot)
-    displayException (TestSuiteFailure ident codes mlogFile bs) = unlines
-        $ "Error: [S-1995]"
-        : concat
-            [ ["Test suite failure for package " ++ packageIdentifierString ident]
-            , flip map (Map.toList codes) $ \(name, mcode) -> concat
-                [ "    "
-                , T.unpack name
-                , ": "
-                , case mcode of
-                    Nothing -> " executable not found"
-                    Just ec -> " exited with: " ++ displayException ec
-                ]
-            , pure $ case mlogFile of
-                Nothing -> "Logs printed to console"
-                -- TODO Should we load up the full error output and print it here?
-                Just logFile -> "Full log available at " ++ toFilePath logFile
-            , if S.null bs
-                then []
-                else ["", "", doubleIndent $ T.unpack $ decodeUtf8With lenientDecode bs]
-            ]
-      where
-        indent' = dropWhileEnd isSpace . unlines . fmap (\l -> "  " ++ l) . lines
-        doubleIndent = indent' . indent'
-    displayException (TestSuiteTypeUnsupported interface) = concat
-        [ "Error: [S-3819]\n"
-        , "Unsupported test suite type: "
-        , show interface
-        ]
-     -- Suppressing duplicate output
-    displayException (LocalPackageDoesn'tMatchTarget name localV requestedV) = concat
-        [ "Error: [S-5797]\n"
-        , "Version for local package "
-        , packageNameString name
-        , " is "
-        , versionString localV
-        , ", but you asked for "
-        , versionString requestedV
-        , " on the command line"
-        ]
-    displayException (NoSetupHsFound dir) = concat
-        [ "Error: [S-3118]\n"
-        , "No Setup.hs or Setup.lhs file found in "
-        , toFilePath dir
-        ]
-    displayException (InvalidFlagSpecification unused) = unlines
-        $ "Error: [S-8664]"
-        : "Invalid flag specification:"
-        : map go (Set.toList unused)
-      where
-        showFlagSrc :: FlagSource -> String
-        showFlagSrc FSCommandLine = " (specified on command line)"
-        showFlagSrc FSStackYaml = " (specified in stack.yaml)"
-
-        go :: UnusedFlags -> String
-        go (UFNoPackage src name) = concat
-            [ "- Package '"
-            , packageNameString name
-            , "' not found"
-            , showFlagSrc src
-            ]
-        go (UFFlagsNotDefined src pname pkgFlags flags) = concat
-            [ "- Package '"
-            , name
-            , "' does not define the following flags"
-            , showFlagSrc src
-            , ":\n"
-            , intercalate "\n"
-                          (map (\flag -> "  " ++ flagNameString flag)
-                               (Set.toList flags))
-            , "\n- Flags defined by package '" ++ name ++ "':\n"
-            , intercalate "\n"
-                          (map (\flag -> "  " ++ name ++ ":" ++ flagNameString flag)
-                               (Set.toList pkgFlags))
-            ]
-          where name = packageNameString pname
-        go (UFSnapshot name) = concat
-            [ "- Attempted to set flag on snapshot package "
-            , packageNameString name
-            , ", please add to extra-deps"
-            ]
-    displayException (InvalidGhcOptionsSpecification unused) = unlines
-        $ "Error: [S-4925]"
-        : "Invalid GHC options specification:"
-        : map showGhcOptionSrc unused
-      where
-        showGhcOptionSrc name = concat
-            [ "- Package '"
-            , packageNameString name
-            , "' not found"
-            ]
-    displayException (TargetParseException [err]) = concat
-        [ "Error: [S-8506]\n"
-        , "Error parsing targets: "
-        , T.unpack err
-        ]
-    displayException (TargetParseException errs) = unlines
-        $ "Error [S-8506]"
-        : "The following errors occurred while parsing the build targets:"
-        : map (("- " ++) . T.unpack) errs
-    displayException (SomeTargetsNotBuildable xs) = unlines
-        [ "Error: [S-7086]"
-        , "The following components have 'buildable: False' set in the Cabal \
-          \configuration, and so cannot be targets:"
-        , "    " <> T.unpack (renderPkgComponents xs)
-        , "To resolve this, either provide flags such that these components \
-          \are buildable, or only specify buildable targets."
-        ]
-    displayException (TestSuiteExeMissing isSimpleBuildType exeName pkgName' testName) =
-        missingExeError "[S-7987]"
-          isSimpleBuildType $ concat
-            [ "Test suite executable \""
-            , exeName
-            , " not found for "
-            , pkgName'
-            , ":test:"
-            , testName
-            ]
-    displayException (CabalCopyFailed isSimpleBuildType innerMsg) =
-        missingExeError "[S-8027]"
-          isSimpleBuildType $ concat
-            [ "'cabal copy' failed.  Error message:\n"
-            , innerMsg
-            , "\n"
-            ]
-    displayException (LocalPackagesPresent locals) = unlines
-        $ "Error: [S-5510]"
-        : "Local packages are not allowed when using the 'script' command. \
-          \Packages found:"
-        : map (\ident -> "- " ++ packageIdentifierString ident) locals
-    displayException (CouldNotLockDistDir lockFile) = unlines
-        [ "Error: [S-7168]"
-        , "Locking the dist directory failed, try to lock file:"
-        , "  " ++ toFilePath lockFile
-        , "Maybe you're running another copy of Stack?"
-        ]
-    displayException (TaskCycleBug pid) = bugReport "[S-7868]" $
-        "Error: The impossible happened! Unexpected task cycle for "
-        ++ packageNameString (pkgName pid)
-    displayException (PackageIdMissingBug ident) = bugReport "[S-8923]" $
-        "The impossible happened! singleBuild: missing package ID missing: "
-        ++ show ident
-    displayException AllInOneBuildBug = bugReport "[S-7371]"
-        "Cannot have an all-in-one build that also has a final build step."
-    displayException (MulipleResultsBug name dps) = bugReport "[S-6739]"
-        "singleBuild: multiple results when describing installed package "
-        ++ show (name, dps)
-    displayException TemplateHaskellNotFoundBug = bugReport "[S-3121]"
-        "template-haskell is a wired-in GHC boot library but it wasn't found."
-    displayException HaddockIndexNotFound =
-        "Error: [S-6901]\n"
-        ++ "No local or snapshot doc index found to open."
-    displayException ShowBuildErrorBug = bugReport "[S-5452]"
-        "Unexpected case in showBuildError."
-
-data BuildPrettyException
-    = ConstructPlanFailed
-        [ConstructPlanException]
-        (Path Abs File)
-        (Path Abs Dir)
-        ParentMap
-        (Set PackageName)
-        (Map PackageName [PackageName])
-    | ExecutionFailure [SomeException]
-    | CabalExitedUnsuccessfully
-        ExitCode
-        PackageIdentifier
-        (Path Abs File)  -- cabal Executable
-        [String]         -- cabal arguments
-        (Maybe (Path Abs File)) -- logfiles location
-        [Text]     -- log contents
-    | SetupHsBuildFailure
-        ExitCode
-        (Maybe PackageIdentifier) -- which package's custom setup, is simple setup if Nothing
-        (Path Abs File)  -- ghc Executable
-        [String]         -- ghc arguments
-        (Maybe (Path Abs File)) -- logfiles location
-        [Text]     -- log contents
-    deriving (Show, Typeable)
-
-instance Pretty BuildPrettyException where
-    pretty ( ConstructPlanFailed errs stackYaml stackRoot parents wanted prunedGlobalDeps ) =
-           "[S-4804]"
-        <> line
-        <> flow "Stack failed to construct a build plan."
-        <> blankLine
-        <> pprintExceptions
-               errs stackYaml stackRoot parents wanted prunedGlobalDeps
-    pretty (ExecutionFailure es) =
-           "[S-7282]"
-        <> line
-        <> flow "Stack failed to execute the build plan."
-        <> blankLine
-        <> flow "While executing the build plan, Stack encountered the \
-                \following errors:"
-        <> blankLine
-        <> hcat (L.intersperse blankLine (map ppExceptions es))
-      where
-        ppExceptions :: SomeException -> StyleDoc
-        ppExceptions e = case fromException e of
-            Just (PrettyException e') -> pretty e'
-            Nothing -> (string . show) e
-    pretty (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bss) =
-        showBuildError "[S-7011]"
-            False exitCode (Just taskProvides') execName fullArgs logFiles bss
-    pretty (SetupHsBuildFailure exitCode mtaskProvides execName fullArgs logFiles bss) =
-        showBuildError "[S-6374]"
-            True exitCode mtaskProvides execName fullArgs logFiles bss
-
-instance Exception BuildPrettyException
-
-pprintExceptions
-    :: [ConstructPlanException]
-    -> Path Abs File
-    -> Path Abs Dir
-    -> ParentMap
-    -> Set PackageName
-    -> Map PackageName [PackageName]
-    -> StyleDoc
-pprintExceptions exceptions stackYaml stackRoot parentMap wanted' prunedGlobalDeps =
-    mconcat $
-      [ flow "While constructing the build plan, Stack encountered the \
-             \following errors:"
-      , blankLine
-      , mconcat (L.intersperse blankLine (mapMaybe pprintException exceptions'))
-      ] ++ if L.null recommendations
-               then []
-               else
-                   [ blankLine
-                   , flow "Some different approaches to resolving this:"
-                   , blankLine
-                   ] ++ recommendations
-
-  where
-    exceptions' = {- should we dedupe these somehow? nubOrd -} exceptions
-
-    recommendations =
-        if not onlyHasDependencyMismatches
-            then []
-            else
-                [ "  *" <+> align
-                    (   flow "Set 'allow-newer: true' in "
-                    <+> pretty (defaultUserConfigPath stackRoot)
-                    <+> "to ignore all version constraints and build anyway."
-                    )
-                , blankLine
-                ]
-        ++ addExtraDepsRecommendations
-
-    addExtraDepsRecommendations
-      | Map.null extras = []
-      | (Just _) <- Map.lookup (mkPackageName "base") extras =
-          [ "  *" <+> align (flow "Build requires unattainable version of base. Since base is a part of GHC, you most likely need to use a different GHC version with the matching base.")
-           , line
-          ]
-      | otherwise =
-         [ "  *" <+> align
-           (style Recommendation (flow "Recommended action:") <+>
-            flow "try adding the following to your extra-deps in" <+>
-            pretty stackYaml <> ":")
-         , blankLine
-         , vsep (map pprintExtra (Map.toList extras))
-         , line
-         ]
-
-    extras = Map.unions $ map getExtras exceptions'
-    getExtras DependencyCycleDetected{} = Map.empty
-    getExtras UnknownPackage{} = Map.empty
-    getExtras (DependencyPlanFailures _ m) =
-       Map.unions $ map go $ Map.toList m
-     where
-       -- TODO: Likely a good idea to distinguish these to the user.  In particular, for DependencyMismatch
-       go (name, (_range, Just (version,cabalHash), NotInBuildPlan)) =
-           Map.singleton name (version,cabalHash)
-       go (name, (_range, Just (version,cabalHash), DependencyMismatch{})) =
-           Map.singleton name (version, cabalHash)
-       go _ = Map.empty
-    pprintExtra (name, (version, BlobKey cabalHash cabalSize)) =
-      let cfInfo = CFIHash cabalHash (Just cabalSize)
-          packageIdRev = PackageIdentifierRevision name version cfInfo
-       in fromString ("- " ++ T.unpack (utf8BuilderToText (display packageIdRev)))
-
-    allNotInBuildPlan = Set.fromList $ concatMap toNotInBuildPlan exceptions'
-    toNotInBuildPlan (DependencyPlanFailures _ pDeps) =
-      map fst $ filter (\(_, (_, _, badDep)) -> badDep == NotInBuildPlan) $ Map.toList pDeps
-    toNotInBuildPlan _ = []
-
-    -- This checks if 'allow-newer: true' could resolve all issues.
-    onlyHasDependencyMismatches = all go exceptions'
-      where
-        go DependencyCycleDetected{} = False
-        go UnknownPackage{} = False
-        go (DependencyPlanFailures _ m) =
-          all (\(_, _, depErr) -> isMismatch depErr) (M.elems m)
-        isMismatch DependencyMismatch{} = True
-        isMismatch Couldn'tResolveItsDependencies{} = True
-        isMismatch _ = False
-
-    pprintException (DependencyCycleDetected pNames) = Just $
-        flow "Dependency cycle detected in packages:" <> line <>
-        indent 4 (encloseSep "[" "]" "," (map (style Error . fromString . packageNameString) pNames))
-    pprintException (DependencyPlanFailures pkg pDeps) =
-        case mapMaybe pprintDep (Map.toList pDeps) of
-            [] -> Nothing
-            depErrors -> Just $
-                flow "In the dependencies for" <+> pkgIdent <>
-                pprintFlags (packageFlags pkg) <> ":" <> line <>
-                indent 4 (vsep depErrors) <>
-                case getShortestDepsPath parentMap wanted' (packageName pkg) of
-                    Nothing -> line <> flow "needed for unknown reason - stack invariant violated."
-                    Just [] -> line <> flow "needed since" <+> pkgName' <+> flow "is a build target."
-                    Just (target:path) -> line <> flow "needed due to" <+> encloseSep "" "" " -> " pathElems
-                      where
-                        pathElems =
-                            [style Target . fromString . packageIdentifierString $ target] ++
-                            map (fromString . packageIdentifierString) path ++
-                            [pkgIdent]
-              where
-                pkgName' = style Current . fromString . packageNameString $ packageName pkg
-                pkgIdent = style Current . fromString . packageIdentifierString $ packageIdentifier pkg
-    -- Skip these when they are redundant with 'NotInBuildPlan' info.
-    pprintException (UnknownPackage name)
-        | name `Set.member` allNotInBuildPlan = Nothing
-        | name `Set.member` wiredInPackages =
-            Just $ flow "Can't build a package with same name as a wired-in-package:" <+> (style Current . fromString . packageNameString $ name)
-        | Just pruned <- Map.lookup name prunedGlobalDeps =
-            let prunedDeps = map (style Current . fromString . packageNameString) pruned
-            in Just $ flow "Can't use GHC boot package" <+>
-                      (style Current . fromString . packageNameString $ name) <+>
-                      flow "when it has an overridden dependency (issue #4510);" <+>
-                      flow "you need to add the following as explicit dependencies to the project:" <+>
-                      line <+> encloseSep "" "" ", " prunedDeps
-        | otherwise = Just $ flow "Unknown package:" <+> (style Current . fromString . packageNameString $ name)
-
-    pprintFlags flags
-        | Map.null flags = ""
-        | otherwise = parens $ sep $ map pprintFlag $ Map.toList flags
-    pprintFlag (name, True) = "+" <> fromString (flagNameString name)
-    pprintFlag (name, False) = "-" <> fromString (flagNameString name)
-
-    pprintDep (name, (range, mlatestApplicable, badDep)) = case badDep of
-        NotInBuildPlan
-          | name `elem` fold prunedGlobalDeps -> Just $
-              style Error (fromString $ packageNameString name) <+>
-              align ((if range == C.anyVersion
-                        then flow "needed"
-                        else flow "must match" <+> goodRange) <> "," <> softline <>
-                     flow "but this GHC boot package has been pruned (issue #4510);" <+>
-                     flow "you need to add the package explicitly to extra-deps" <+>
-                     latestApplicable Nothing)
-          | otherwise -> Just $
-              style Error (fromString $ packageNameString name) <+>
-              align ((if range == C.anyVersion
-                        then flow "needed"
-                        else flow "must match" <+> goodRange) <> "," <> softline <>
-                     flow "but the Stack configuration has no specified version" <+>
-                     latestApplicable Nothing)
-        -- TODO: For local packages, suggest editing constraints
-        DependencyMismatch version -> Just $
-            (style Error . fromString . packageIdentifierString) (PackageIdentifier name version) <+>
-            align (flow "from Stack configuration does not match" <+> goodRange <+>
-                   latestApplicable (Just version))
-        -- I think the main useful info is these explain why missing
-        -- packages are needed. Instead lets give the user the shortest
-        -- path from a target to the package.
-        Couldn'tResolveItsDependencies _version -> Nothing
-        HasNoLibrary -> Just $
-            style Error (fromString $ packageNameString name) <+>
-            align (flow "is a library dependency, but the package provides no library")
-        BDDependencyCycleDetected names -> Just $
-            style Error (fromString $ packageNameString name) <+>
-            align (flow $ "dependency cycle detected: " ++ L.intercalate ", " (map packageNameString names))
-      where
-        goodRange = style Good (fromString (C.display range))
-        latestApplicable mversion =
-            case mlatestApplicable of
-                Nothing
-                    | isNothing mversion ->
-                        flow "(no package with that name found, perhaps there \
-                             \is a typo in a package's build-depends or an \
-                             \omission from the stack.yaml packages list?)"
-                    | otherwise -> ""
-                Just (laVer, _)
-                    | Just laVer == mversion ->
-                        flow "(latest matching version is specified)"
-                    | otherwise ->
-                        fillSep
-                          [ flow "(latest matching version is"
-                          , style Good (fromString $ versionString laVer) <> ")"
-                          ]
-
--- | Get the shortest reason for the package to be in the build plan. In
--- other words, trace the parent dependencies back to a 'wanted'
--- package.
-getShortestDepsPath
-    :: ParentMap
-    -> Set PackageName
-    -> PackageName
-    -> Maybe [PackageIdentifier]
-getShortestDepsPath (MonoidMap parentsMap) wanted' name =
-    if Set.member name wanted'
-        then Just []
-        else case M.lookup name parentsMap of
-            Nothing -> Nothing
-            Just (_, parents) -> Just $ findShortest 256 paths0
-              where
-                paths0 = M.fromList $ map (\(ident, _) -> (pkgName ident, startDepsPath ident)) parents
-  where
-    -- The 'paths' map is a map from PackageName to the shortest path
-    -- found to get there. It is the frontier of our breadth-first
-    -- search of dependencies.
-    findShortest :: Int -> Map PackageName DepsPath -> [PackageIdentifier]
-    findShortest fuel _ | fuel <= 0 =
-        [PackageIdentifier (mkPackageName "stack-ran-out-of-jet-fuel") (C.mkVersion [0])]
-    findShortest _ paths | M.null paths = []
-    findShortest fuel paths =
-        case targets of
-            [] -> findShortest (fuel - 1) $ M.fromListWith chooseBest $ concatMap extendPath recurses
-            _ -> let (DepsPath _ _ path) = L.minimum (map snd targets) in path
-      where
-        (targets, recurses) = L.partition (\(n, _) -> n `Set.member` wanted') (M.toList paths)
-    chooseBest :: DepsPath -> DepsPath -> DepsPath
-    chooseBest x y = max x y
-    -- Extend a path to all its parents.
-    extendPath :: (PackageName, DepsPath) -> [(PackageName, DepsPath)]
-    extendPath (n, dp) =
-        case M.lookup n parentsMap of
-            Nothing -> []
-            Just (_, parents) -> map (\(pkgId, _) -> (pkgName pkgId, extendDepsPath pkgId dp)) parents
-
-startDepsPath :: PackageIdentifier -> DepsPath
-startDepsPath ident = DepsPath
-    { dpLength = 1
-    , dpNameLength = length (packageNameString (pkgName ident))
-    , dpPath = [ident]
-    }
-
-extendDepsPath :: PackageIdentifier -> DepsPath -> DepsPath
-extendDepsPath ident dp = DepsPath
-    { dpLength = dpLength dp + 1
-    , dpNameLength = dpNameLength dp + length (packageNameString (pkgName ident))
-    , dpPath = [ident]
-    }
-
-data ConstructPlanException
-    = DependencyCycleDetected [PackageName]
-    | DependencyPlanFailures Package (Map PackageName (VersionRange, LatestApplicableVersion, BadDependency))
-    | UnknownPackage PackageName -- TODO perhaps this constructor will be removed, and BadDependency will handle it all
-    -- ^ Recommend adding to extra-deps, give a helpful version number?
-    deriving (Typeable, Eq, Show)
-
--- | The latest applicable version and it's latest Cabal file revision.
--- For display purposes only, Nothing if package not found
-type LatestApplicableVersion = Maybe (Version, BlobKey)
-
--- | Reason why a dependency was not used
-data BadDependency
-    = NotInBuildPlan
-    | Couldn'tResolveItsDependencies Version
-    | DependencyMismatch Version
-    | HasNoLibrary
-    -- ^ See description of 'DepType'
-    | BDDependencyCycleDetected ![PackageName]
-    deriving (Typeable, Eq, Ord, Show)
-
-type ParentMap = MonoidMap PackageName (First Version, [(PackageIdentifier, VersionRange)])
-
-data DepsPath = DepsPath
-    { dpLength :: Int -- ^ Length of dpPath
-    , dpNameLength :: Int -- ^ Length of package names combined
-    , dpPath :: [PackageIdentifier] -- ^ A path where the packages later
-                                    -- in the list depend on those that
-                                    -- come earlier
-    }
-    deriving (Eq, Ord, Show)
-
-data FlagSource = FSCommandLine | FSStackYaml
-    deriving (Show, Eq, Ord)
-
-data UnusedFlags = UFNoPackage FlagSource PackageName
-                 | UFFlagsNotDefined
-                       FlagSource
-                       PackageName
-                       (Set FlagName) -- defined in package
-                       (Set FlagName) -- not defined
-                 | UFSnapshot PackageName
-    deriving (Show, Eq, Ord)
-
-missingExeError :: String -> Bool -> String -> String
-missingExeError errorCode isSimpleBuildType msg = unlines
-    $ "Error: " <> errorCode
-    : msg
-    : "Possible causes of this issue:"
-    : map ("* " <>) possibleCauses
-  where
-    possibleCauses
-        = "No module named \"Main\". The 'main-is' source file should usually \
-          \have a header indicating that it's a 'Main' module."
-        : "A Cabal file that refers to nonexistent other files (e.g. a \
-          \license-file that doesn't exist). Running 'cabal check' may point \
-          \out these issues."
-        : if isSimpleBuildType
-            then []
-            else ["The Setup.hs file is changing the installation target dir."]
-
-showBuildError
-  :: String
-  -> Bool
-  -> ExitCode
-  -> Maybe PackageIdentifier
-  -> Path Abs File
-  -> [String]
-  -> Maybe (Path Abs File)
-  -> [Text]
-  -> StyleDoc
-showBuildError errorCode isBuildingSetup exitCode mtaskProvides execName fullArgs logFiles bss =
-  let fullCmd = unwords
-              $ dropQuotes (toFilePath execName)
-              : map (T.unpack . showProcessArgDebug) fullArgs
-      logLocations =
-          maybe
-              mempty
-              (\fp -> line <> flow "Logs have been written to:" <+>
-                        style File (pretty fp))
-              logFiles
-  in     fromString errorCode
-      <> line
-      <> flow "While building" <+>
-         ( case (isBuildingSetup, mtaskProvides) of
-             (False, Nothing) -> impureThrow ShowBuildErrorBug
-             (False, Just taskProvides') ->
-                "package" <+>
-                  style
-                    Target
-                    (fromString $ dropQuotes (packageIdentifierString taskProvides'))
-             (True, Nothing) -> "simple" <+> style File "Setup.hs"
-             (True, Just taskProvides') ->
-                "custom" <+>
-                  style File "Setup.hs" <+>
-                  flow "for package" <+>
-                  style
-                    Target
-                    (fromString $ dropQuotes (packageIdentifierString taskProvides'))
-         ) <+>
-         flow "(scroll up to its section to see the error) using:"
-      <> line
-      <> style Shell (fromString fullCmd)
-      <> line
-      <> flow "Process exited with code:" <+> (fromString . show) exitCode <+>
-         ( if exitCode == ExitFailure (-9)
-             then flow "(THIS MAY INDICATE OUT OF MEMORY)"
-             else mempty
-         )
-      <> logLocations
-      <> if null bss
-           then mempty
-           else blankLine <> string (removeTrailingSpaces (map T.unpack bss))
-   where
-    removeTrailingSpaces = dropWhileEnd isSpace . unlines
-    dropQuotes = filter ('\"' /=)
-
-----------------------------------------------
-
--- | Package dependency oracle.
-newtype PkgDepsOracle =
-    PkgDeps PackageName
-    deriving (Show,Typeable,Eq,NFData)
-
--- | Stored on disk to know whether the files have changed.
-newtype BuildCache = BuildCache
-    { buildCacheTimes :: Map FilePath FileCacheInfo
-      -- ^ Modification times of files.
-    }
-    deriving (Generic, Eq, Show, Typeable, ToJSON, FromJSON)
-instance NFData BuildCache
-
--- | Stored on disk to know whether the flags have changed.
-data ConfigCache = ConfigCache
-    { configCacheOpts :: !ConfigureOpts
-      -- ^ All options used for this package.
-    , configCacheDeps :: !(Set GhcPkgId)
-      -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take
-      -- the complete GhcPkgId (only a PackageIdentifier) in the configure
-      -- options, just using the previous value is insufficient to know if
-      -- dependencies have changed.
-    , configCacheComponents :: !(Set S.ByteString)
-      -- ^ The components to be built. It's a bit of a hack to include this in
-      -- here, as it's not a configure option (just a build option), but this
-      -- is a convenient way to force compilation when the components change.
-    , configCacheHaddock :: !Bool
-      -- ^ Are haddocks to be built?
-    , configCachePkgSrc :: !CachePkgSrc
-    , configCachePathEnvVar :: !Text
-    -- ^ Value of the PATH env var, see <https://github.com/commercialhaskell/stack/issues/3138>
-    }
-    deriving (Generic, Eq, Show, Data, Typeable)
-instance NFData ConfigCache
-
-data CachePkgSrc = CacheSrcUpstream | CacheSrcLocal FilePath
-    deriving (Generic, Eq, Read, Show, Data, Typeable)
-instance NFData CachePkgSrc
-
-instance PersistField CachePkgSrc where
-    toPersistValue CacheSrcUpstream = PersistText "upstream"
-    toPersistValue (CacheSrcLocal fp) = PersistText ("local:" <> T.pack fp)
-    fromPersistValue (PersistText t) = do
-        if t == "upstream"
-            then Right CacheSrcUpstream
-            else case T.stripPrefix "local:" t of
-                Just fp -> Right $ CacheSrcLocal (T.unpack fp)
-                Nothing -> Left $ "Unexpected CachePkgSrc value: " <> t
-    fromPersistValue _ = Left "Unexpected CachePkgSrc type"
-
-instance PersistFieldSql CachePkgSrc where
-    sqlType _ = SqlString
-
-toCachePkgSrc :: PackageSource -> CachePkgSrc
-toCachePkgSrc (PSFilePath lp) = CacheSrcLocal (toFilePath (parent (lpCabalFile lp)))
-toCachePkgSrc PSRemote{} = CacheSrcUpstream
-
--- | A task to perform when building
-data Task = Task
-    { taskProvides        :: !PackageIdentifier -- FIXME turn this into a function on taskType?
-    -- ^ the package/version to be built
-    , taskType            :: !TaskType
-    -- ^ the task type, telling us how to build this
-    , taskConfigOpts      :: !TaskConfigOpts
-    , taskBuildHaddock    :: !Bool
-    , taskPresent         :: !(Map PackageIdentifier GhcPkgId)
-    -- ^ GhcPkgIds of already-installed dependencies
-    , taskAllInOne        :: !Bool
-    -- ^ indicates that the package can be built in one step
-    , taskCachePkgSrc     :: !CachePkgSrc
-    , taskAnyMissing      :: !Bool
-    -- ^ Were any of the dependencies missing? The reason this is
-    -- necessary is... hairy. And as you may expect, a bug in
-    -- Cabal. See:
-    -- <https://github.com/haskell/cabal/issues/4728#issuecomment-337937673>. The
-    -- problem is that Cabal may end up generating the same package ID
-    -- for a dependency, even if the ABI has changed. As a result,
-    -- without this field, Stack would think that a reconfigure is
-    -- unnecessary, when in fact we _do_ need to reconfigure. The
-    -- details here suck. We really need proper hashes for package
-    -- identifiers.
-    , taskBuildTypeConfig :: !Bool
-    -- ^ Is the build type of this package Configure. Check out
-    -- ensureConfigureScript in Stack.Build.Execute for the motivation
-    }
-    deriving Show
-
--- | Given the IDs of any missing packages, produce the configure options
-data TaskConfigOpts = TaskConfigOpts
-    { tcoMissing :: !(Set PackageIdentifier)
-      -- ^ Dependencies for which we don't yet have an GhcPkgId
-    , tcoOpts    :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts)
-      -- ^ Produce the list of options given the missing @GhcPkgId@s
-    }
-instance Show TaskConfigOpts where
-    show (TaskConfigOpts missing f) = concat
-        [ "Missing: "
-        , show missing
-        , ". Without those: "
-        , show $ f Map.empty
-        ]
-
--- | The type of a task, either building local code or something from the
--- package index (upstream)
-data TaskType
-  = TTLocalMutable LocalPackage
-  | TTRemotePackage IsMutable Package PackageLocationImmutable
-    deriving Show
-
-data IsMutable
-    = Mutable
-    | Immutable
-    deriving (Eq, Show)
-
-instance Semigroup IsMutable where
-    Mutable <> _ = Mutable
-    _ <> Mutable = Mutable
-    Immutable <> Immutable = Immutable
-
-instance Monoid IsMutable where
-    mempty = Immutable
-    mappend = (<>)
-
-taskIsTarget :: Task -> Bool
-taskIsTarget t =
-    case taskType t of
-        TTLocalMutable lp -> lpWanted lp
-        _ -> False
-
-taskLocation :: Task -> InstallLocation
-taskLocation task =
-    case taskType task of
-        TTLocalMutable _ -> Local
-        TTRemotePackage Mutable _ _ -> Local
-        TTRemotePackage Immutable _ _ -> Snap
-
-taskTargetIsMutable :: Task -> IsMutable
-taskTargetIsMutable task =
-    case taskType task of
-        TTLocalMutable _ -> Mutable
-        TTRemotePackage mutable _ _ -> mutable
-
-installLocationIsMutable :: InstallLocation -> IsMutable
-installLocationIsMutable Snap = Immutable
-installLocationIsMutable Local = Mutable
-
--- | A complete plan of what needs to be built and how to do it
-data Plan = Plan
-    { planTasks :: !(Map PackageName Task)
-    , planFinals :: !(Map PackageName Task)
-    -- ^ Final actions to be taken (test, benchmark, etc)
-    , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Text))
-    -- ^ Text is reason we're unregistering, for display only
-    , planInstallExes :: !(Map Text InstallLocation)
-    -- ^ Executables that should be installed after successful building
-    }
-    deriving Show
-
--- | Basic information used to calculate what the configure options are
-data BaseConfigOpts = BaseConfigOpts
-    { bcoSnapDB :: !(Path Abs Dir)
-    , bcoLocalDB :: !(Path Abs Dir)
-    , bcoSnapInstallRoot :: !(Path Abs Dir)
-    , bcoLocalInstallRoot :: !(Path Abs Dir)
-    , bcoBuildOpts :: !BuildOpts
-    , bcoBuildOptsCLI :: !BuildOptsCLI
-    , bcoExtraDBs :: ![Path Abs Dir]
-    }
-    deriving Show
-
--- | Render a @BaseConfigOpts@ to an actual list of options
-configureOpts :: EnvConfig
-              -> BaseConfigOpts
-              -> Map PackageIdentifier GhcPkgId -- ^ dependencies
-              -> Bool -- ^ local non-extra-dep?
-              -> IsMutable
-              -> Package
-              -> ConfigureOpts
-configureOpts econfig bco deps isLocal isMutable package = ConfigureOpts
-    { coDirs = configureOptsDirs bco isMutable package
-    , coNoDirs = configureOptsNoDir econfig bco deps isLocal package
-    }
-
--- options set by stack
-isStackOpt :: Text -> Bool
-isStackOpt t = any (`T.isPrefixOf` t)
-    [ "--dependency="
-    , "--constraint="
-    , "--package-db="
-    , "--libdir="
-    , "--bindir="
-    , "--datadir="
-    , "--libexecdir="
-    , "--sysconfdir"
-    , "--docdir="
-    , "--htmldir="
-    , "--haddockdir="
-    , "--enable-tests"
-    , "--enable-benchmarks"
-    , "--exact-configuration"
-    -- Treat these as causing dirtiness, to resolve
-    -- https://github.com/commercialhaskell/stack/issues/2984
-    --
-    -- , "--enable-library-profiling"
-    -- , "--enable-executable-profiling"
-    -- , "--enable-profiling"
-    ] || t == "--user"
-
-configureOptsDirs :: BaseConfigOpts
-                  -> IsMutable
-                  -> Package
-                  -> [String]
-configureOptsDirs bco isMutable package = concat
-    [ ["--user", "--package-db=clear", "--package-db=global"]
-    , map (("--package-db=" ++) . toFilePathNoTrailingSep) $ case isMutable of
-        Immutable -> bcoExtraDBs bco ++ [bcoSnapDB bco]
-        Mutable -> bcoExtraDBs bco ++ [bcoSnapDB bco] ++ [bcoLocalDB bco]
-    , [ "--libdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirLib)
-      , "--bindir=" ++ toFilePathNoTrailingSep (installRoot </> bindirSuffix)
-      , "--datadir=" ++ toFilePathNoTrailingSep (installRoot </> relDirShare)
-      , "--libexecdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirLibexec)
-      , "--sysconfdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirEtc)
-      , "--docdir=" ++ toFilePathNoTrailingSep docDir
-      , "--htmldir=" ++ toFilePathNoTrailingSep docDir
-      , "--haddockdir=" ++ toFilePathNoTrailingSep docDir]
-    ]
-  where
-    installRoot =
-        case isMutable of
-            Immutable -> bcoSnapInstallRoot bco
-            Mutable -> bcoLocalInstallRoot bco
-    docDir =
-        case pkgVerDir of
-            Nothing -> installRoot </> docDirSuffix
-            Just dir -> installRoot </> docDirSuffix </> dir
-    pkgVerDir =
-        parseRelDir (packageIdentifierString (PackageIdentifier (packageName package)
-                                                                (packageVersion package)) ++
-                     [pathSeparator])
-
--- | Same as 'configureOpts', but does not include directory path options
-configureOptsNoDir :: EnvConfig
-                   -> BaseConfigOpts
-                   -> Map PackageIdentifier GhcPkgId -- ^ dependencies
-                   -> Bool -- ^ is this a local, non-extra-dep?
-                   -> Package
-                   -> [String]
-configureOptsNoDir econfig bco deps isLocal package = concat
-    [ depOptions
-    , ["--enable-library-profiling" | boptsLibProfile bopts || boptsExeProfile bopts]
-    -- Cabal < 1.21.1 does not support --enable-profiling, use --enable-executable-profiling instead
-    , let profFlag = "--enable-" <> concat ["executable-" | not newerCabal] <> "profiling"
-      in [ profFlag | boptsExeProfile bopts && isLocal]
-    , ["--enable-split-objs" | boptsSplitObjs bopts]
-    , ["--disable-library-stripping" | not $ boptsLibStrip bopts || boptsExeStrip bopts]
-    , ["--disable-executable-stripping" | not (boptsExeStrip bopts) && isLocal]
-    , map (\(name,enabled) ->
-                       "-f" <>
-                       (if enabled
-                           then ""
-                           else "-") <>
-                       flagNameString name)
-                    (Map.toList flags)
-    , map T.unpack $ packageCabalConfigOpts package
-    , processGhcOptions (packageGhcOptions package)
-    , map ("--extra-include-dirs=" ++) (configExtraIncludeDirs config)
-    , map ("--extra-lib-dirs=" ++) (configExtraLibDirs config)
-    , maybe [] (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc]) (configOverrideGccPath config)
-    , ["--exact-configuration"]
-    , ["--ghc-option=-fhide-source-paths" | hideSourcePaths cv]
-    ]
-  where
-    -- This function parses the GHC options that are providing in the
-    -- stack.yaml file. In order to handle RTS arguments correctly, we need
-    -- to provide the RTS arguments as a single argument.
-    processGhcOptions :: [Text] -> [String]
-    processGhcOptions args =
-        let
-            (preRtsArgs, mid) =
-                break ("+RTS" ==) args
-            (rtsArgs, end) =
-                break ("-RTS" ==) mid
-            fullRtsArgs =
-                case rtsArgs of
-                    [] ->
-                        -- This means that we didn't have any RTS args - no
-                        -- `+RTS` - and therefore no need for a `-RTS`.
-                        []
-                    _ ->
-                        -- In this case, we have some RTS args. `break`
-                        -- puts the `"-RTS"` string in the `snd` list, so
-                        -- we want to append it on the end of `rtsArgs`
-                        -- here.
-                        --
-                        -- We're not checking that `-RTS` is the first
-                        -- element of `end`. This is because the GHC RTS
-                        -- allows you to omit a trailing -RTS if that's the
-                        -- last of the arguments. This permits a GHC
-                        -- options in stack.yaml that matches what you
-                        -- might pass directly to GHC.
-                        [T.unwords $ rtsArgs ++ ["-RTS"]]
-            -- We drop the first element from `end`, because it is always
-            -- either `"-RTS"` (and we don't want that as a separate
-            -- argument) or the list is empty (and `drop _ [] = []`).
-            postRtsArgs =
-                drop 1 end
-            newArgs =
-                concat [preRtsArgs, fullRtsArgs, postRtsArgs]
-        in
-            concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) newArgs
-
-    wc = view (actualCompilerVersionL.to whichCompiler) econfig
-    cv = view (actualCompilerVersionL.to getGhcVersion) econfig
-
-    hideSourcePaths ghcVersion = ghcVersion >= C.mkVersion [8, 2] && configHideSourcePaths config
-
-    config = view configL econfig
-    bopts = bcoBuildOpts bco
-
-    newerCabal = view cabalVersionL econfig >= C.mkVersion [1, 22]
-
-    -- Unioning atop defaults is needed so that all flags are specified
-    -- with --exact-configuration.
-    flags = packageFlags package `Map.union` packageDefaultFlags package
-
-    depOptions = map (uncurry toDepOption) $ Map.toList deps
-      where
-        toDepOption = if newerCabal then toDepOption1_22 else toDepOption1_18
-
-    toDepOption1_22 (PackageIdentifier name _) gid = concat
-        [ "--dependency="
-        , packageNameString name
-        , "="
-        , ghcPkgIdString gid
-        ]
-
-    toDepOption1_18 ident _gid = concat
-        [ "--constraint="
-        , packageNameString name
-        , "=="
-        , versionString version'
-        ]
-      where
-        PackageIdentifier name version' = ident
-
--- | Get set of wanted package names from locals.
-wantedLocalPackages :: [LocalPackage] -> Set PackageName
-wantedLocalPackages = Set.fromList . map (packageName . lpPackage) . filter lpWanted
-
--- | Configure options to be sent to Setup.hs configure
-data ConfigureOpts = ConfigureOpts
-    { coDirs :: ![String]
-    -- ^ Options related to various paths. We separate these out since they do
-    -- not have an impact on the contents of the compiled binary for checking
-    -- if we can use an existing precompiled cache.
-    , coNoDirs :: ![String]
-    }
-    deriving (Show, Eq, Generic, Data, Typeable)
-instance NFData ConfigureOpts
-
--- | Information on a compiled package: the library conf file (if relevant),
--- the sublibraries (if present) and all of the executable paths.
-data PrecompiledCache base = PrecompiledCache
-    { pcLibrary :: !(Maybe (Path base File))
-    -- ^ .conf file inside the package database
-    , pcSubLibs :: ![Path base File]
-    -- ^ .conf file inside the package database, for each of the sublibraries
-    , pcExes    :: ![Path base File]
-    -- ^ Full paths to executables
-    }
-    deriving (Show, Eq, Generic, Typeable)
-instance NFData (PrecompiledCache Abs)
+{-# LANGUAGE OverloadedStrings          #-}
+
+-- | Build-specific types.
+
+module Stack.Types.Build
+  ( InstallLocation (..)
+  , Installed (..)
+  , psVersion
+  , Task (..)
+  , taskIsTarget
+  , taskLocation
+  , taskTargetIsMutable
+  , LocalPackage (..)
+  , Plan (..)
+  , TestOpts (..)
+  , BenchmarkOpts (..)
+  , FileWatchOpts (..)
+  , BuildOpts (..)
+  , BuildSubset (..)
+  , defaultBuildOpts
+  , TaskType (..)
+  , installLocationIsMutable
+  , TaskConfigOpts (..)
+  , BuildCache (..)
+  , ConfigCache (..)
+  , configureOpts
+  , CachePkgSrc (..)
+  , toCachePkgSrc
+  , FileCacheInfo (..)
+  , PrecompiledCache (..)
+  ) where
+
+import           Data.Aeson ( ToJSON, FromJSON )
+import qualified Data.ByteString as S
+import           Data.List as L
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import           Database.Persist.Sql
+                   ( PersistField (..), PersistFieldSql (..)
+                   , PersistValue (PersistText), SqlType (SqlString)
+                   )
+import           Path ( parent )
+import           Stack.Prelude
+import           Stack.Types.BuildOpts
+                   ( BenchmarkOpts (..), BuildOpts (..), BuildSubset (..)
+                   , FileWatchOpts (..), TestOpts (..), defaultBuildOpts
+                   )
+import           Stack.Types.ConfigureOpts ( ConfigureOpts, configureOpts )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
+import           Stack.Types.IsMutable ( IsMutable (..) )
+import           Stack.Types.Package
+                   ( FileCacheInfo (..), InstallLocation (..), Installed (..)
+                   , LocalPackage (..), Package (..), PackageSource (..)
+                   , psVersion
+                   )
+
+-- | Package dependency oracle.
+newtype PkgDepsOracle
+  = PkgDeps PackageName
+  deriving (Eq, NFData, Show, Typeable)
+
+-- | Stored on disk to know whether the files have changed.
+newtype BuildCache = BuildCache
+  { buildCacheTimes :: Map FilePath FileCacheInfo
+    -- ^ Modification times of files.
+  }
+  deriving (Eq, FromJSON, Generic, Show, ToJSON, Typeable)
+
+instance NFData BuildCache
+
+-- | Stored on disk to know whether the flags have changed.
+data ConfigCache = ConfigCache
+  { configCacheOpts :: !ConfigureOpts
+    -- ^ All options used for this package.
+  , configCacheDeps :: !(Set GhcPkgId)
+    -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take
+    -- the complete GhcPkgId (only a PackageIdentifier) in the configure
+    -- options, just using the previous value is insufficient to know if
+    -- dependencies have changed.
+  , configCacheComponents :: !(Set S.ByteString)
+    -- ^ The components to be built. It's a bit of a hack to include this in
+    -- here, as it's not a configure option (just a build option), but this
+    -- is a convenient way to force compilation when the components change.
+  , configCacheHaddock :: !Bool
+    -- ^ Are haddocks to be built?
+  , configCachePkgSrc :: !CachePkgSrc
+  , configCachePathEnvVar :: !Text
+  -- ^ Value of the PATH env var, see
+  -- <https://github.com/commercialhaskell/stack/issues/3138>
+  }
+  deriving (Data, Eq, Generic, Show, Typeable)
+
+instance NFData ConfigCache
+
+data CachePkgSrc
+  = CacheSrcUpstream
+  | CacheSrcLocal FilePath
+  deriving (Data, Eq, Generic, Read, Show, Typeable)
+
+instance NFData CachePkgSrc
+
+instance PersistField CachePkgSrc where
+  toPersistValue CacheSrcUpstream = PersistText "upstream"
+  toPersistValue (CacheSrcLocal fp) = PersistText ("local:" <> T.pack fp)
+  fromPersistValue (PersistText t) =
+    if t == "upstream"
+      then Right CacheSrcUpstream
+      else case T.stripPrefix "local:" t of
+        Just fp -> Right $ CacheSrcLocal (T.unpack fp)
+        Nothing -> Left $ "Unexpected CachePkgSrc value: " <> t
+  fromPersistValue _ = Left "Unexpected CachePkgSrc type"
+
+instance PersistFieldSql CachePkgSrc where
+  sqlType _ = SqlString
+
+toCachePkgSrc :: PackageSource -> CachePkgSrc
+toCachePkgSrc (PSFilePath lp) =
+  CacheSrcLocal (toFilePath (parent (lpCabalFile lp)))
+toCachePkgSrc PSRemote{} = CacheSrcUpstream
+
+-- | A task to perform when building
+data Task = Task
+  { taskProvides        :: !PackageIdentifier -- FIXME turn this into a function on taskType?
+    -- ^ the package/version to be built
+  , taskType            :: !TaskType
+    -- ^ the task type, telling us how to build this
+  , taskConfigOpts      :: !TaskConfigOpts
+  , taskBuildHaddock    :: !Bool
+  , taskPresent         :: !(Map PackageIdentifier GhcPkgId)
+    -- ^ GhcPkgIds of already-installed dependencies
+  , taskAllInOne        :: !Bool
+    -- ^ indicates that the package can be built in one step
+  , taskCachePkgSrc     :: !CachePkgSrc
+  , taskAnyMissing      :: !Bool
+    -- ^ Were any of the dependencies missing? The reason this is necessary is...
+    -- hairy. And as you may expect, a bug in Cabal. See:
+    -- <https://github.com/haskell/cabal/issues/4728#issuecomment-337937673>.
+    -- The problem is that Cabal may end up generating the same package ID for a
+    -- dependency, even if the ABI has changed. As a result, without this field,
+    -- Stack would think that a reconfigure is unnecessary, when in fact we _do_
+    -- need to reconfigure. The details here suck. We really need proper hashes
+    -- for package identifiers.
+  , taskBuildTypeConfig :: !Bool
+    -- ^ Is the build type of this package Configure. Check out
+    -- ensureConfigureScript in Stack.Build.Execute for the motivation
+  }
+  deriving Show
+
+-- | Given the IDs of any missing packages, produce the configure options
+data TaskConfigOpts = TaskConfigOpts
+  { tcoMissing :: !(Set PackageIdentifier)
+    -- ^ Dependencies for which we don't yet have an GhcPkgId
+  , tcoOpts    :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts)
+    -- ^ Produce the list of options given the missing @GhcPkgId@s
+  }
+
+instance Show TaskConfigOpts where
+  show (TaskConfigOpts missing f) = concat
+    [ "Missing: "
+    , show missing
+    , ". Without those: "
+    , show $ f Map.empty
+    ]
+
+-- | The type of a task, either building local code or something from the
+-- package index (upstream)
+data TaskType
+  = TTLocalMutable LocalPackage
+  | TTRemotePackage IsMutable Package PackageLocationImmutable
+  deriving Show
+
+taskIsTarget :: Task -> Bool
+taskIsTarget t =
+  case taskType t of
+    TTLocalMutable lp -> lpWanted lp
+    _ -> False
+
+taskLocation :: Task -> InstallLocation
+taskLocation task =
+  case taskType task of
+    TTLocalMutable _ -> Local
+    TTRemotePackage Mutable _ _ -> Local
+    TTRemotePackage Immutable _ _ -> Snap
+
+taskTargetIsMutable :: Task -> IsMutable
+taskTargetIsMutable task =
+  case taskType task of
+    TTLocalMutable _ -> Mutable
+    TTRemotePackage mutable _ _ -> mutable
+
+installLocationIsMutable :: InstallLocation -> IsMutable
+installLocationIsMutable Snap = Immutable
+installLocationIsMutable Local = Mutable
+
+-- | A complete plan of what needs to be built and how to do it
+data Plan = Plan
+  { planTasks :: !(Map PackageName Task)
+  , planFinals :: !(Map PackageName Task)
+    -- ^ Final actions to be taken (test, benchmark, etc)
+  , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Text))
+    -- ^ Text is reason we're unregistering, for display only
+  , planInstallExes :: !(Map Text InstallLocation)
+    -- ^ Executables that should be installed after successful building
+  }
+  deriving Show
+
+-- | Information on a compiled package: the library conf file (if relevant),
+-- the sublibraries (if present) and all of the executable paths.
+data PrecompiledCache base = PrecompiledCache
+  { pcLibrary :: !(Maybe (Path base File))
+    -- ^ .conf file inside the package database
+  , pcSubLibs :: ![Path base File]
+    -- ^ .conf file inside the package database, for each of the sublibraries
+  , pcExes    :: ![Path base File]
+    -- ^ Full paths to executables
+  }
+  deriving (Eq, Generic, Show, Typeable)
+
+instance NFData (PrecompiledCache Abs)
+
 instance NFData (PrecompiledCache Rel)
+ src/Stack/Types/Build/Exception.hs view
@@ -0,0 +1,842 @@+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+module Stack.Types.Build.Exception
+  ( BuildException (..)
+  , BuildPrettyException (..)
+  , pprintTargetParseErrors
+  , ConstructPlanException (..)
+  , LatestApplicableVersion
+  , BadDependency (..)
+  ) where
+
+import qualified Data.ByteString as S
+import           Data.Char ( isSpace )
+import           Data.List as L
+import qualified Data.Map as Map
+import qualified Data.Map.Strict as M
+import           Data.Monoid.Map ( MonoidMap (..) )
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import           Distribution.System ( Arch )
+import qualified Distribution.Text as C
+import           Distribution.Types.PackageName ( mkPackageName )
+import           Distribution.Types.TestSuiteInterface ( TestSuiteInterface )
+import qualified Distribution.Version as C
+import           RIO.Process ( showProcessArgDebug )
+import           Stack.Constants
+                   ( defaultUserConfigPath, wiredInPackages )
+import           Stack.Prelude
+import           Stack.Types.Compiler ( ActualCompiler, compilerVersionString )
+import           Stack.Types.CompilerBuild
+                   ( CompilerBuild, compilerBuildSuffix )
+import           Stack.Types.DumpPackage ( DumpPackage )
+import           Stack.Types.UnusedFlags ( FlagSource (..), UnusedFlags (..) )
+import           Stack.Types.GHCVariant ( GHCVariant, ghcVariantSuffix )
+import           Stack.Types.NamedComponent
+                   ( NamedComponent, renderPkgComponent )
+import           Stack.Types.Package ( Package (..), packageIdentifier )
+import           Stack.Types.ParentMap ( ParentMap )
+import           Stack.Types.Version ( VersionCheck (..), VersionRange )
+
+-- | Type representing exceptions thrown by functions exported by modules with
+-- names beginning @Stack.Build@.
+data BuildException
+  = Couldn'tFindPkgId PackageName
+  | CompilerVersionMismatch
+      (Maybe (ActualCompiler, Arch)) -- found
+      (WantedCompiler, Arch) -- expected
+      GHCVariant -- expected
+      CompilerBuild -- expected
+      VersionCheck
+      (Maybe (Path Abs File)) -- Path to the stack.yaml file
+      Text -- recommended resolution
+  | Couldn'tParseTargets [Text]
+  | UnknownTargets
+      (Set PackageName) -- no known version
+      (Map PackageName Version) -- not in snapshot, here's the most recent
+                                -- version in the index
+      (Path Abs File) -- stack.yaml
+  | TestSuiteFailure
+      PackageIdentifier
+      (Map Text (Maybe ExitCode))
+      (Maybe (Path Abs File))
+      S.ByteString
+  | TestSuiteTypeUnsupported TestSuiteInterface
+  | LocalPackageDoesn'tMatchTarget
+      PackageName
+      Version -- local version
+      Version -- version specified on command line
+  | NoSetupHsFound (Path Abs Dir)
+  | InvalidGhcOptionsSpecification [PackageName]
+  | TestSuiteExeMissing Bool String String String
+  | CabalCopyFailed Bool String
+  | LocalPackagesPresent [PackageIdentifier]
+  | CouldNotLockDistDir !(Path Abs File)
+  | TaskCycleBug PackageIdentifier
+  | PackageIdMissingBug PackageIdentifier
+  | AllInOneBuildBug
+  | MultipleResultsBug PackageName [DumpPackage]
+  | TemplateHaskellNotFoundBug
+  | HaddockIndexNotFound
+  | ShowBuildErrorBug
+  deriving (Show, Typeable)
+
+instance Exception BuildException where
+  displayException (Couldn'tFindPkgId name) = bugReport "[S-7178]" $ concat
+    [ "After installing "
+    , packageNameString name
+    ,", the package id couldn't be found (via ghc-pkg describe "
+    , packageNameString name
+    , ")."
+    ]
+  displayException (CompilerVersionMismatch mactual (expected, eArch) ghcVariant ghcBuild check mstack resolution) = concat
+    [ "Error: [S-6362]\n"
+    , case mactual of
+        Nothing -> "No compiler found, expected "
+        Just (actual, arch) -> concat
+          [ "Compiler version mismatched, found "
+          , compilerVersionString actual
+          , " ("
+          , C.display arch
+          , ")"
+          , ", but expected "
+          ]
+    , case check of
+        MatchMinor -> "minor version match with "
+        MatchExact -> "exact version "
+        NewerMinor -> "minor version match or newer with "
+    , T.unpack $ utf8BuilderToText $ display expected
+    , " ("
+    , C.display eArch
+    , ghcVariantSuffix ghcVariant
+    , compilerBuildSuffix ghcBuild
+    , ") (based on "
+    , case mstack of
+        Nothing -> "command line arguments"
+        Just stack -> "resolver setting in " ++ toFilePath stack
+    , ").\n"
+    , T.unpack resolution
+    ]
+  displayException (Couldn'tParseTargets targets) = unlines
+    $ "Error: [S-3127]"
+    : "The following targets could not be parsed as package names or \
+      \directories:"
+    : map T.unpack targets
+  displayException (UnknownTargets noKnown notInSnapshot stackYaml) = unlines
+    $ "Error: [S-2154]"
+    : (noKnown' ++ notInSnapshot')
+   where
+    noKnown'
+      | Set.null noKnown = []
+      | otherwise = pure $
+          "The following target packages were not found: " ++
+          intercalate ", " (map packageNameString $ Set.toList noKnown) ++
+          "\nSee https://docs.haskellstack.org/en/stable/build_command/#target-syntax for details."
+    notInSnapshot'
+      | Map.null notInSnapshot = []
+      | otherwise =
+            "The following packages are not in your snapshot, but exist"
+          : "in your package index. Recommended action: add them to your"
+          : ("extra-deps in " ++ toFilePath stackYaml)
+          : "(Note: these are the most recent versions,"
+          : "but there's no guarantee that they'll build together)."
+          : ""
+          : map
+              (\(name, version') -> "- " ++ packageIdentifierString
+                  (PackageIdentifier name version'))
+              (Map.toList notInSnapshot)
+  displayException (TestSuiteFailure ident codes mlogFile bs) = unlines
+    $ "Error: [S-1995]"
+    : concat
+        [ ["Test suite failure for package " ++ packageIdentifierString ident]
+        , flip map (Map.toList codes) $ \(name, mcode) -> concat
+            [ "    "
+            , T.unpack name
+            , ": "
+            , case mcode of
+                Nothing -> " executable not found"
+                Just ec -> " exited with: " ++ displayException ec
+            ]
+        , pure $ case mlogFile of
+            Nothing -> "Logs printed to console"
+            -- TODO Should we load up the full error output and print it here?
+            Just logFile -> "Full log available at " ++ toFilePath logFile
+        , if S.null bs
+            then []
+            else
+              [ ""
+              , ""
+              , doubleIndent $ T.unpack $ decodeUtf8With lenientDecode bs
+              ]
+        ]
+   where
+    indent' = dropWhileEnd isSpace . unlines . fmap ("  " ++) . lines
+    doubleIndent = indent' . indent'
+  displayException (TestSuiteTypeUnsupported interface) = concat
+    [ "Error: [S-3819]\n"
+    , "Unsupported test suite type: "
+    , show interface
+    ]
+     -- Suppressing duplicate output
+  displayException (LocalPackageDoesn'tMatchTarget name localV requestedV) = concat
+    [ "Error: [S-5797]\n"
+    , "Version for local package "
+    , packageNameString name
+    , " is "
+    , versionString localV
+    , ", but you asked for "
+    , versionString requestedV
+    , " on the command line"
+    ]
+  displayException (NoSetupHsFound dir) = concat
+    [ "Error: [S-3118]\n"
+    , "No Setup.hs or Setup.lhs file found in "
+    , toFilePath dir
+    ]
+  displayException (InvalidGhcOptionsSpecification unused) = unlines
+    $ "Error: [S-4925]"
+    : "Invalid GHC options specification:"
+    : map showGhcOptionSrc unused
+   where
+    showGhcOptionSrc name = concat
+      [ "- Package '"
+      , packageNameString name
+      , "' not found"
+      ]
+  displayException (TestSuiteExeMissing isSimpleBuildType exeName pkgName' testName) =
+    missingExeError "[S-7987]"
+      isSimpleBuildType $ concat
+        [ "Test suite executable \""
+        , exeName
+        , " not found for "
+        , pkgName'
+        , ":test:"
+        , testName
+        ]
+  displayException (CabalCopyFailed isSimpleBuildType innerMsg) =
+    missingExeError "[S-8027]"
+      isSimpleBuildType $ concat
+        [ "'cabal copy' failed.  Error message:\n"
+        , innerMsg
+        , "\n"
+        ]
+  displayException (LocalPackagesPresent locals) = unlines
+    $ "Error: [S-5510]"
+    : "Local packages are not allowed when using the 'script' command. \
+      \Packages found:"
+    : map (\ident -> "- " ++ packageIdentifierString ident) locals
+  displayException (CouldNotLockDistDir lockFile) = unlines
+    [ "Error: [S-7168]"
+    , "Locking the dist directory failed, try to lock file:"
+    , "  " ++ toFilePath lockFile
+    , "Maybe you're running another copy of Stack?"
+    ]
+  displayException (TaskCycleBug pid) = bugReport "[S-7868]" $
+    "Unexpected task cycle for "
+    ++ packageNameString (pkgName pid)
+  displayException (PackageIdMissingBug ident) = bugReport "[S-8923]" $
+    "singleBuild: missing package ID missing: "
+    ++ show ident
+  displayException AllInOneBuildBug = bugReport "[S-7371]"
+    "Cannot have an all-in-one build that also has a final build step."
+  displayException (MultipleResultsBug name dps) = bugReport "[S-6739]" $
+    "singleBuild: multiple results when describing installed package "
+    ++ show (name, dps)
+  displayException TemplateHaskellNotFoundBug = bugReport "[S-3121]"
+    "template-haskell is a wired-in GHC boot library but it wasn't found."
+  displayException HaddockIndexNotFound =
+    "Error: [S-6901]\n"
+    ++ "No local or snapshot doc index found to open."
+  displayException ShowBuildErrorBug = bugReport "[S-5452]"
+    "Unexpected case in showBuildError."
+
+data BuildPrettyException
+  = ConstructPlanFailed
+      [ConstructPlanException]
+      (Path Abs File)
+      (Path Abs Dir)
+      ParentMap
+      (Set PackageName)
+      (Map PackageName [PackageName])
+  | ExecutionFailure [SomeException]
+  | CabalExitedUnsuccessfully
+      ExitCode
+      PackageIdentifier
+      (Path Abs File)  -- cabal Executable
+      [String]         -- cabal arguments
+      (Maybe (Path Abs File)) -- logfiles location
+      [Text]     -- log contents
+  | SetupHsBuildFailure
+      ExitCode
+      (Maybe PackageIdentifier) -- which package's custom setup, is simple setup
+                                -- if Nothing
+      (Path Abs File)  -- ghc Executable
+      [String]         -- ghc arguments
+      (Maybe (Path Abs File)) -- logfiles location
+      [Text]     -- log contents
+  | TargetParseException [StyleDoc]
+  | SomeTargetsNotBuildable [(PackageName, NamedComponent)]
+  | InvalidFlagSpecification (Set UnusedFlags)
+  | GHCProfOptionInvalid
+  deriving (Show, Typeable)
+
+instance Pretty BuildPrettyException where
+  pretty ( ConstructPlanFailed errs stackYaml stackRoot parents wanted prunedGlobalDeps ) =
+    "[S-4804]"
+    <> line
+    <> flow "Stack failed to construct a build plan."
+    <> blankLine
+    <> pprintExceptions
+           errs stackYaml stackRoot parents wanted prunedGlobalDeps
+  pretty (ExecutionFailure es) =
+    "[S-7282]"
+    <> line
+    <> flow "Stack failed to execute the build plan."
+    <> blankLine
+    <> fillSep
+         [ flow "While executing the build plan, Stack encountered the"
+         , case es of
+             [_] -> "error:"
+             _ -> flow "following errors:"
+         ]
+    <> blankLine
+    <> hcat (L.intersperse blankLine (map ppException es))
+  pretty (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bss) =
+    showBuildError "[S-7011]"
+      False exitCode (Just taskProvides') execName fullArgs logFiles bss
+  pretty (SetupHsBuildFailure exitCode mtaskProvides execName fullArgs logFiles bss) =
+    showBuildError "[S-6374]"
+      True exitCode mtaskProvides execName fullArgs logFiles bss
+  pretty (TargetParseException errs) =
+    "[S-8506]"
+    <> pprintTargetParseErrors errs
+  pretty (SomeTargetsNotBuildable xs) =
+    "[S-7086]"
+    <> line
+    <> fillSep
+         (  [ flow "The following components have"
+            , style Shell (flow "buildable: False")
+            , flow "set in the Cabal configuration, and so cannot be targets:"
+            ]
+         <> mkNarrativeList (Just Target) False
+              (map (fromString . T.unpack . renderPkgComponent) xs :: [StyleDoc])
+         )
+    <> blankLine
+    <> flow "To resolve this, either provide flags such that these components \
+            \are buildable, or only specify buildable targets."
+  pretty (InvalidFlagSpecification unused) =
+    "[S-8664]"
+    <> line
+    <> flow "Invalid flag specification:"
+    <> line
+    <> bulletedList (map go (Set.toList unused))
+   where
+    showFlagSrc :: FlagSource -> StyleDoc
+    showFlagSrc FSCommandLine = flow "(specified on the command line)"
+    showFlagSrc FSStackYaml =
+      flow "(specified in the project-level configuration (e.g. stack.yaml))"
+
+    go :: UnusedFlags -> StyleDoc
+    go (UFNoPackage src name) = fillSep
+      [ "Package"
+      , style Error (fromString $ packageNameString name)
+      , flow "not found"
+      , showFlagSrc src
+      ]
+    go (UFFlagsNotDefined src pname pkgFlags flags) =
+         fillSep
+           ( "Package"
+           : style Current (fromString name)
+           : flow "does not define the following flags"
+           : showFlagSrc src <> ":"
+           : mkNarrativeList (Just Error) False
+               (map (fromString . flagNameString) (Set.toList flags) :: [StyleDoc])
+           )
+      <> line
+      <> if Set.null pkgFlags
+           then fillSep
+             [ flow "No flags are defined by package"
+             , style Current (fromString name) <> "."
+             ]
+           else fillSep
+           ( flow "Flags defined by package"
+           : style Current (fromString name)
+           : "are:"
+           : mkNarrativeList (Just Good) False
+               (map (fromString . flagNameString) (Set.toList pkgFlags) :: [StyleDoc])
+           )
+     where
+      name = packageNameString pname
+    go (UFSnapshot name) = fillSep
+      [ flow "Attempted to set flag on snapshot package"
+      , style Current (fromString $ packageNameString name) <> ","
+      , flow "please add the package to"
+      , style Shell "extra-deps" <> "."
+      ]
+  pretty GHCProfOptionInvalid =
+    "[S-8100]"
+    <> line
+    <> fillSep
+         [ flow "When building with Stack, you should not use GHC's"
+         , style Shell "-prof"
+         , flow "option. Instead, please use Stack's"
+         , style Shell "--library-profiling"
+         , "and"
+         , style Shell "--executable-profiling"
+         , flow "flags. See:"
+         , style Url "https://github.com/commercialhaskell/stack/issues/1015" <> "."
+         ]
+
+instance Exception BuildPrettyException
+
+-- | Helper function to pretty print an error message for target parse errors.
+pprintTargetParseErrors :: [StyleDoc] -> StyleDoc
+pprintTargetParseErrors errs =
+     line
+  <> flow "Stack failed to parse the target(s)."
+  <> blankLine
+  <> fillSep
+       [ flow "While parsing, Stack encountered the"
+       , case errs of
+           [err] ->
+                  "error:"
+               <> blankLine
+               <> indent 4 err
+           _ ->
+                  flow "following errors:"
+               <> blankLine
+               <> bulletedList errs
+       ]
+  <> blankLine
+  <> fillSep
+       [ flow "Stack expects a target to be a package name (e.g."
+       , style Shell "my-package" <> "),"
+       , flow "a package identifier (e.g."
+       , style Shell "my-package-0.1.2.3" <> "),"
+       , flow "a package component (e.g."
+       , style Shell "my-package:test:my-test-suite" <> "),"
+       , flow "or, failing that, a relative path to a directory that is a \
+              \local package directory or a parent directory of one or more \
+              \local package directories."
+       ]
+
+pprintExceptions ::
+     [ConstructPlanException]
+  -> Path Abs File
+  -> Path Abs Dir
+  -> ParentMap
+  -> Set PackageName
+  -> Map PackageName [PackageName]
+  -> StyleDoc
+pprintExceptions exceptions stackYaml stackRoot parentMap wanted' prunedGlobalDeps =
+  mconcat $
+    [ flow "While constructing the build plan, Stack encountered the \
+           \following errors:"
+    , blankLine
+    , mconcat (L.intersperse blankLine (mapMaybe pprintException exceptions'))
+    ] ++ if L.null recommendations
+           then []
+           else
+             [ blankLine
+             , flow "Some different approaches to resolving this:"
+             , blankLine
+             ] ++ recommendations
+
+ where
+  exceptions' = {- should we dedupe these somehow? nubOrd -} exceptions
+
+  recommendations =
+    if not onlyHasDependencyMismatches
+      then []
+      else
+        [ "  *" <+> align (fillSep
+            [ "Set"
+            , style Shell (flow "allow-newer: true")
+            , "in"
+            , pretty (defaultUserConfigPath stackRoot)
+            , flow "to ignore all version constraints and build anyway."
+            ])
+        , blankLine
+        ]
+    ++ addExtraDepsRecommendations
+
+  addExtraDepsRecommendations
+    | Map.null extras = []
+    | (Just _) <- Map.lookup (mkPackageName "base") extras =
+        [ "  *" <+> align (fillSep
+            [ flow "Build requires unattainable version of the"
+            , style Current "base"
+            , flow "package. Since"
+            , style Current "base"
+            , flow "is a part of GHC, you most likely need to use a \
+                   \different GHC version with the matching"
+            , style Current "base"<> "."
+            ])
+         , line
+        ]
+    | otherwise =
+       [ "  *" <+> align (fillSep
+         [ style Recommendation (flow "Recommended action:")
+         , flow "try adding the following to your"
+         , style Shell "extra-deps"
+         , "in"
+         , pretty stackYaml <> ":"
+         ])
+       , blankLine
+       , vsep (map pprintExtra (Map.toList extras))
+       , line
+       ]
+
+  extras = Map.unions $ map getExtras exceptions'
+  getExtras DependencyCycleDetected{} = Map.empty
+  getExtras UnknownPackage{} = Map.empty
+  getExtras (DependencyPlanFailures _ m) =
+    Map.unions $ map go $ Map.toList m
+   where
+    -- TODO: Likely a good idea to distinguish these to the user.  In
+    -- particular, for DependencyMismatch
+    go (name, (_range, Just (version,cabalHash), NotInBuildPlan)) =
+      Map.singleton name (version,cabalHash)
+    go (name, (_range, Just (version,cabalHash), DependencyMismatch{})) =
+      Map.singleton name (version, cabalHash)
+    go _ = Map.empty
+  pprintExtra (name, (version, BlobKey cabalHash cabalSize)) =
+    let cfInfo = CFIHash cabalHash (Just cabalSize)
+        packageIdRev = PackageIdentifierRevision name version cfInfo
+    in  fromString ("- " ++ T.unpack (utf8BuilderToText (display packageIdRev)))
+
+  allNotInBuildPlan = Set.fromList $ concatMap toNotInBuildPlan exceptions'
+  toNotInBuildPlan (DependencyPlanFailures _ pDeps) =
+    map fst $
+      filter
+        (\(_, (_, _, badDep)) -> badDep == NotInBuildPlan)
+        (Map.toList pDeps)
+  toNotInBuildPlan _ = []
+
+  -- This checks if 'allow-newer: true' could resolve all issues.
+  onlyHasDependencyMismatches = all go exceptions'
+   where
+    go DependencyCycleDetected{} = False
+    go UnknownPackage{} = False
+    go (DependencyPlanFailures _ m) =
+      all (\(_, _, depErr) -> isMismatch depErr) (M.elems m)
+    isMismatch DependencyMismatch{} = True
+    isMismatch Couldn'tResolveItsDependencies{} = True
+    isMismatch _ = False
+
+  pprintException (DependencyCycleDetected pNames) = Just $
+       flow "Dependency cycle detected in packages:"
+    <> line
+    <> indent 4
+         ( encloseSep "[" "]" ","
+             (map (style Error . fromString . packageNameString) pNames)
+         )
+  pprintException (DependencyPlanFailures pkg pDeps) =
+    case mapMaybe pprintDep (Map.toList pDeps) of
+      [] -> Nothing
+      depErrors -> Just $
+        flow "In the dependencies for" <+> pkgIdent <>
+        pprintFlags (packageFlags pkg) <> ":" <> line <>
+        indent 4 (vsep depErrors) <>
+        case getShortestDepsPath parentMap wanted' (packageName pkg) of
+          Nothing ->
+               line
+            <> flow "needed for unknown reason - stack invariant violated."
+          Just [] ->
+               line
+            <> fillSep
+                 [ flow "needed since"
+                 , pkgName'
+                 , flow "is a build target."
+                 ]
+          Just (target:path) ->
+               line
+            <> flow "needed due to" <+> encloseSep "" "" " -> " pathElems
+           where
+            pathElems =
+              [style Target . fromString . packageIdentifierString $ target] ++
+              map (fromString . packageIdentifierString) path ++
+              [pkgIdent]
+       where
+        pkgName' =
+          style Current . fromString . packageNameString $ packageName pkg
+        pkgIdent =
+          style
+            Current
+            (fromString . packageIdentifierString $ packageIdentifier pkg)
+  -- Skip these when they are redundant with 'NotInBuildPlan' info.
+  pprintException (UnknownPackage name)
+    | name `Set.member` allNotInBuildPlan = Nothing
+    | name `Set.member` wiredInPackages = Just $ fillSep
+        [ flow "Can't build a package with same name as a wired-in-package:"
+        , style Current . fromString . packageNameString $ name
+        ]
+    | Just pruned <- Map.lookup name prunedGlobalDeps =
+        let prunedDeps =
+              map (style Current . fromString . packageNameString) pruned
+        in  Just $ fillSep
+              [ flow "Can't use GHC boot package"
+              , style Current . fromString . packageNameString $ name
+              , flow "when it has an overridden dependency (issue #4510);"
+              , flow "you need to add the following as explicit dependencies \
+                     \to the project:"
+              , line
+              , encloseSep "" "" ", " prunedDeps
+              ]
+    | otherwise = Just $ fillSep
+        [ flow "Unknown package:"
+        , style Current . fromString . packageNameString $ name
+        ]
+
+  pprintFlags flags
+    | Map.null flags = ""
+    | otherwise = parens $ sep $ map pprintFlag $ Map.toList flags
+  pprintFlag (name, True) = "+" <> fromString (flagNameString name)
+  pprintFlag (name, False) = "-" <> fromString (flagNameString name)
+
+  pprintDep (name, (range, mlatestApplicable, badDep)) = case badDep of
+    NotInBuildPlan
+      | name `elem` fold prunedGlobalDeps -> Just $
+          style Error (fromString $ packageNameString name) <+>
+          align
+            (  ( if range == C.anyVersion
+                   then flow "needed"
+                   else flow "must match" <+> goodRange
+               )
+            <> ","
+            <> softline
+            <> fillSep
+                 [ flow "but this GHC boot package has been pruned (issue \
+                        \#4510); you need to add the package explicitly to \
+                        \extra-deps"
+                 ,latestApplicable Nothing
+                 ]
+            )
+      | otherwise -> Just $
+          style Error (fromString $ packageNameString name) <+>
+          align
+            (  ( if range == C.anyVersion
+                   then flow "needed"
+                   else flow "must match" <+> goodRange
+               )
+            <> ","
+            <> softline
+            <> fillSep
+                 [ flow "but the Stack configuration has no specified version"
+                 , latestApplicable Nothing
+                 ]
+            )
+    -- TODO: For local packages, suggest editing constraints
+    DependencyMismatch version -> Just $
+      style
+         Error
+         (fromString . packageIdentifierString $ PackageIdentifier name version)
+      <+>
+      align
+        ( fillSep
+            [ flow "from Stack configuration does not match"
+            , goodRange
+            , latestApplicable (Just version)
+            ]
+        )
+    -- I think the main useful info is these explain why missing packages are
+    -- needed. Instead lets give the user the shortest path from a target to the
+    -- package.
+    Couldn'tResolveItsDependencies _version -> Nothing
+    HasNoLibrary -> Just $
+      style Error (fromString $ packageNameString name) <+>
+      align (flow "is a library dependency, but the package provides no library")
+    BDDependencyCycleDetected names -> Just $
+      style Error (fromString $ packageNameString name) <+>
+      align
+        ( flow $ "dependency cycle detected: "
+             ++ L.intercalate ", " (map packageNameString names)
+        )
+   where
+    goodRange = style Good (fromString (C.display range))
+    latestApplicable mversion =
+      case mlatestApplicable of
+        Nothing
+          | isNothing mversion ->
+              flow "(no package with that name found, perhaps there is a typo \
+                   \in a package's build-depends or an omission from the \
+                   \stack.yaml packages list?)"
+          | otherwise -> ""
+        Just (laVer, _)
+          | Just laVer == mversion ->
+              flow "(latest matching version is specified)"
+          | otherwise ->
+              fillSep
+                [ flow "(latest matching version is"
+                , style Good (fromString $ versionString laVer) <> ")"
+                ]
+
+data ConstructPlanException
+  = DependencyCycleDetected [PackageName]
+  | DependencyPlanFailures
+      Package
+      (Map PackageName (VersionRange, LatestApplicableVersion, BadDependency))
+  | UnknownPackage PackageName -- TODO perhaps this constructor will be removed,
+                               -- and BadDependency will handle it all
+  -- ^ Recommend adding to extra-deps, give a helpful version number?
+  deriving (Eq, Show, Typeable)
+
+-- | The latest applicable version and it's latest Cabal file revision.
+-- For display purposes only, Nothing if package not found
+type LatestApplicableVersion = Maybe (Version, BlobKey)
+
+-- | Reason why a dependency was not used
+data BadDependency
+  = NotInBuildPlan
+  | Couldn'tResolveItsDependencies Version
+  | DependencyMismatch Version
+  | HasNoLibrary
+  -- ^ See description of 'DepType'
+  | BDDependencyCycleDetected ![PackageName]
+  deriving (Eq, Ord, Show, Typeable)
+
+missingExeError :: String -> Bool -> String -> String
+missingExeError errorCode isSimpleBuildType msg = unlines
+  $ "Error: " <> errorCode
+  : msg
+  : "Possible causes of this issue:"
+  : map ("* " <>) possibleCauses
+ where
+  possibleCauses
+    = "No module named \"Main\". The 'main-is' source file should usually \
+      \have a header indicating that it's a 'Main' module."
+    : "A Cabal file that refers to nonexistent other files (e.g. a \
+      \license-file that doesn't exist). Running 'cabal check' may point \
+      \out these issues."
+    : [ "The Setup.hs file is changing the installation target dir."
+      | not isSimpleBuildType
+      ]
+
+showBuildError ::
+     String
+  -> Bool
+  -> ExitCode
+  -> Maybe PackageIdentifier
+  -> Path Abs File
+  -> [String]
+  -> Maybe (Path Abs File)
+  -> [Text]
+  -> StyleDoc
+showBuildError errorCode isBuildingSetup exitCode mtaskProvides execName fullArgs logFiles bss =
+  let fullCmd = unwords
+        $ dropQuotes (toFilePath execName)
+        : map (T.unpack . showProcessArgDebug) fullArgs
+      logLocations =
+        maybe
+          mempty
+          (\fp -> line <> flow "Logs have been written to:" <+>
+                    pretty fp)
+          logFiles
+  in     fromString errorCode
+      <> line
+      <> flow "While building" <+>
+         ( case (isBuildingSetup, mtaskProvides) of
+             (False, Nothing) -> impureThrow ShowBuildErrorBug
+             (False, Just taskProvides') ->
+                "package" <+>
+                  style
+                    Target
+                    (fromString $ dropQuotes (packageIdentifierString taskProvides'))
+             (True, Nothing) -> "simple" <+> style File "Setup.hs"
+             (True, Just taskProvides') ->
+                "custom" <+>
+                  style File "Setup.hs" <+>
+                  flow "for package" <+>
+                  style
+                    Target
+                    (fromString $ dropQuotes (packageIdentifierString taskProvides'))
+         ) <+>
+         flow "(scroll up to its section to see the error) using:"
+      <> line
+      <> style Shell (fromString fullCmd)
+      <> line
+      <> flow "Process exited with code:" <+> (fromString . show) exitCode <+>
+         ( if exitCode == ExitFailure (-9)
+             then flow "(THIS MAY INDICATE OUT OF MEMORY)"
+             else mempty
+         )
+      <> logLocations
+      <> if null bss
+           then mempty
+           else blankLine <> string (removeTrailingSpaces (map T.unpack bss))
+   where
+    removeTrailingSpaces = dropWhileEnd isSpace . unlines
+    dropQuotes = filter ('\"' /=)
+
+-- | Get the shortest reason for the package to be in the build plan. In
+-- other words, trace the parent dependencies back to a 'wanted'
+-- package.
+getShortestDepsPath ::
+     ParentMap
+  -> Set PackageName
+  -> PackageName
+  -> Maybe [PackageIdentifier]
+getShortestDepsPath (MonoidMap parentsMap) wanted' name =
+  if Set.member name wanted'
+    then Just []
+    else case M.lookup name parentsMap of
+      Nothing -> Nothing
+      Just (_, parents) -> Just $ findShortest 256 paths0
+       where
+        paths0 = M.fromList $
+          map (\(ident, _) -> (pkgName ident, startDepsPath ident)) parents
+ where
+  -- The 'paths' map is a map from PackageName to the shortest path
+  -- found to get there. It is the frontier of our breadth-first
+  -- search of dependencies.
+  findShortest :: Int -> Map PackageName DepsPath -> [PackageIdentifier]
+  findShortest fuel _ | fuel <= 0 =
+    [ PackageIdentifier
+        (mkPackageName "stack-ran-out-of-jet-fuel")
+        (C.mkVersion [0])
+    ]
+  findShortest _ paths | M.null paths = []
+  findShortest fuel paths =
+    case targets of
+      [] -> findShortest (fuel - 1) $ M.fromListWith chooseBest $
+              concatMap extendPath recurses
+      _ -> let (DepsPath _ _ path) = L.minimum (map snd targets) in path
+   where
+    (targets, recurses) =
+      L.partition (\(n, _) -> n `Set.member` wanted') (M.toList paths)
+  chooseBest :: DepsPath -> DepsPath -> DepsPath
+  chooseBest = max
+  -- Extend a path to all its parents.
+  extendPath :: (PackageName, DepsPath) -> [(PackageName, DepsPath)]
+  extendPath (n, dp) =
+    case M.lookup n parentsMap of
+      Nothing -> []
+      Just (_, parents) ->
+        map (\(pkgId, _) -> (pkgName pkgId, extendDepsPath pkgId dp)) parents
+
+startDepsPath :: PackageIdentifier -> DepsPath
+startDepsPath ident = DepsPath
+  { dpLength = 1
+  , dpNameLength = length (packageNameString (pkgName ident))
+  , dpPath = [ident]
+  }
+
+extendDepsPath :: PackageIdentifier -> DepsPath -> DepsPath
+extendDepsPath ident dp = DepsPath
+  { dpLength = dpLength dp + 1
+  , dpNameLength = dpNameLength dp + length (packageNameString (pkgName ident))
+  , dpPath = [ident]
+  }
+
+data DepsPath = DepsPath
+  { dpLength :: Int
+    -- ^ Length of dpPath
+  , dpNameLength :: Int
+    -- ^ Length of package names combined
+  , dpPath :: [PackageIdentifier]
+    -- ^ A path where the packages later in the list depend on those that come
+    -- earlier
+  }
+  deriving (Eq, Ord, Show)
+ src/Stack/Types/BuildConfig.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+module Stack.Types.BuildConfig
+  ( BuildConfig (..)
+  , HasBuildConfig (..)
+  , stackYamlL
+  , projectRootL
+  , getProjectWorkDir
+  , wantedCompilerVersionL
+  ) where
+
+import           Path ( (</>), parent )
+import           RIO.Process ( HasProcessContext (..) )
+import           Stack.Prelude
+import           Stack.Types.Config ( Config, HasConfig (..), workDirL )
+import           Stack.Types.Curator ( Curator )
+import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( HasRunner (..) )
+import           Stack.Types.SourceMap ( SMWanted (..) )
+import           Stack.Types.Storage ( ProjectStorage )
+
+-- | A superset of 'Config' adding information on how to build code. The reason
+-- for this breakdown is because we will need some of the information from
+-- 'Config' in order to determine the values here.
+--
+-- These are the components which know nothing about local configuration.
+data BuildConfig = BuildConfig
+  { bcConfig     :: !Config
+  , bcSMWanted :: !SMWanted
+  , bcExtraPackageDBs :: ![Path Abs Dir]
+    -- ^ Extra package databases
+  , bcStackYaml  :: !(Path Abs File)
+    -- ^ Location of the stack.yaml file.
+    --
+    -- Note: if the STACK_YAML environment variable is used, this may be
+    -- different from projectRootL </> "stack.yaml" if a different file
+    -- name is used.
+  , bcProjectStorage :: !ProjectStorage
+  -- ^ Database connection pool for project Stack database
+  , bcCurator :: !(Maybe Curator)
+  }
+
+instance HasPlatform BuildConfig where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
+instance HasGHCVariant BuildConfig where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
+instance HasProcessContext BuildConfig where
+  processContextL = configL.processContextL
+
+instance HasPantryConfig BuildConfig where
+  pantryConfigL = configL.pantryConfigL
+
+instance HasConfig BuildConfig where
+  configL = lens bcConfig (\x y -> x { bcConfig = y })
+
+instance HasRunner BuildConfig where
+  runnerL = configL.runnerL
+
+instance HasLogFunc BuildConfig where
+  logFuncL = runnerL.logFuncL
+
+instance HasStylesUpdate BuildConfig where
+  stylesUpdateL = runnerL.stylesUpdateL
+
+instance HasTerm BuildConfig where
+  useColorL = runnerL.useColorL
+  termWidthL = runnerL.termWidthL
+
+class HasConfig env => HasBuildConfig env where
+  buildConfigL :: Lens' env BuildConfig
+
+instance HasBuildConfig BuildConfig where
+  buildConfigL = id
+  {-# INLINE buildConfigL #-}
+
+stackYamlL :: HasBuildConfig env => Lens' env (Path Abs File)
+stackYamlL = buildConfigL.lens bcStackYaml (\x y -> x { bcStackYaml = y })
+
+-- | Directory containing the project's stack.yaml file
+projectRootL :: HasBuildConfig env => Getting r env (Path Abs Dir)
+projectRootL = stackYamlL.to parent
+
+-- | Per-project work dir
+getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir)
+getProjectWorkDir = do
+  root    <- view projectRootL
+  workDir <- view workDirL
+  pure (root </> workDir)
+
+-- | The compiler specified by the @SnapshotDef@. This may be different from the
+-- actual compiler used!
+wantedCompilerVersionL :: HasBuildConfig s => Getting r s WantedCompiler
+wantedCompilerVersionL = buildConfigL.to (smwCompiler . bcSMWanted)
+ src/Stack/Types/BuildOpts.hs view
@@ -0,0 +1,591 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+-- | Configuration options for building.
+module Stack.Types.BuildOpts
+  ( BuildOpts (..)
+  , buildOptsHaddockL
+  , buildOptsInstallExesL
+  , BuildCommand (..)
+  , defaultBuildOpts
+  , defaultBuildOptsCLI
+  , BuildOptsCLI (..)
+  , boptsCLIAllProgOptions
+  , BuildOptsMonoid (..)
+  , buildOptsMonoidBenchmarksL
+  , buildOptsMonoidHaddockL
+  , buildOptsMonoidInstallExesL
+  , buildOptsMonoidTestsL
+  , TestOpts (..)
+  , defaultTestOpts
+  , TestOptsMonoid (..)
+  , HaddockOpts (..)
+  , defaultHaddockOpts
+  , HaddockOptsMonoid (..)
+  , BenchmarkOpts (..)
+  , defaultBenchmarkOpts
+  , BenchmarkOptsMonoid (..)
+  , FileWatchOpts (..)
+  , BuildSubset (..)
+  , ApplyCLIFlag (..)
+  , boptsCLIFlagsByName
+  , CabalVerbosity (..)
+  , toFirstCabalVerbosity
+  ) where
+
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import           Distribution.Parsec ( Parsec (..), simpleParsec )
+import           Distribution.Verbosity ( Verbosity, normal, verbose )
+import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), WithJSONWarnings, (..:?), (..!=)
+                   , jsonSubWarnings, withObjectWarnings, withText
+                   )
+import           Stack.Prelude
+
+-- | Build options that is interpreted by the build command. This is built up
+-- from BuildOptsCLI and BuildOptsMonoid
+data BuildOpts = BuildOpts
+  { boptsLibProfile :: !Bool
+  , boptsExeProfile :: !Bool
+  , boptsLibStrip :: !Bool
+  , boptsExeStrip :: !Bool
+  , boptsHaddock :: !Bool
+    -- ^ Build haddocks?
+  , boptsHaddockOpts :: !HaddockOpts
+    -- ^ Options to pass to haddock
+  , boptsOpenHaddocks :: !Bool
+    -- ^ Open haddocks in the browser?
+  , boptsHaddockDeps :: !(Maybe Bool)
+    -- ^ Build haddocks for dependencies?
+  , boptsHaddockInternal :: !Bool
+    -- ^ Build haddocks for all symbols and packages, like
+    -- @cabal haddock --internal@
+  , boptsHaddockHyperlinkSource :: !Bool
+    -- ^ Build hyperlinked source if possible. Fallback to @hscolour@. Disable
+    -- for no sources.
+  , boptsInstallExes :: !Bool
+    -- ^ Install executables to user path after building?
+  , boptsInstallCompilerTool :: !Bool
+    -- ^ Install executables to compiler tools path after building?
+  , boptsPreFetch :: !Bool
+    -- ^ Fetch all packages immediately
+    -- ^ Watch files for changes and automatically rebuild
+  , boptsKeepGoing :: !(Maybe Bool)
+    -- ^ Keep building/running after failure
+  , boptsKeepTmpFiles :: !Bool
+    -- ^ Keep intermediate files and build directories
+  , boptsForceDirty :: !Bool
+    -- ^ Force treating all local packages as having dirty files
+  , boptsTests :: !Bool
+    -- ^ Turn on tests for local targets
+  , boptsTestOpts :: !TestOpts
+    -- ^ Additional test arguments
+  , boptsBenchmarks :: !Bool
+    -- ^ Turn on benchmarks for local targets
+  , boptsBenchmarkOpts :: !BenchmarkOpts
+    -- ^ Additional test arguments
+    -- ^ Commands (with arguments) to run after a successful build
+    -- ^ Only perform the configure step when building
+  , boptsReconfigure :: !Bool
+    -- ^ Perform the configure step even if already configured
+  , boptsCabalVerbose :: !CabalVerbosity
+    -- ^ Ask Cabal to be verbose in its builds
+  , boptsSplitObjs :: !Bool
+    -- ^ Whether to enable split-objs.
+  , boptsSkipComponents :: ![Text]
+    -- ^ Which components to skip when building
+  , boptsInterleavedOutput :: !Bool
+    -- ^ Should we use the interleaved GHC output when building
+    -- multiple packages?
+  , boptsDdumpDir :: !(Maybe Text)
+  }
+  deriving Show
+
+defaultBuildOpts :: BuildOpts
+defaultBuildOpts = BuildOpts
+  { boptsLibProfile = defaultFirstFalse buildMonoidLibProfile
+  , boptsExeProfile = defaultFirstFalse buildMonoidExeProfile
+  , boptsLibStrip = defaultFirstTrue buildMonoidLibStrip
+  , boptsExeStrip = defaultFirstTrue buildMonoidExeStrip
+  , boptsHaddock = False
+  , boptsHaddockOpts = defaultHaddockOpts
+  , boptsOpenHaddocks = defaultFirstFalse buildMonoidOpenHaddocks
+  , boptsHaddockDeps = Nothing
+  , boptsHaddockInternal = defaultFirstFalse buildMonoidHaddockInternal
+  , boptsHaddockHyperlinkSource =
+      defaultFirstTrue buildMonoidHaddockHyperlinkSource
+  , boptsInstallExes = defaultFirstFalse buildMonoidInstallExes
+  , boptsInstallCompilerTool = defaultFirstFalse buildMonoidInstallCompilerTool
+  , boptsPreFetch = defaultFirstFalse buildMonoidPreFetch
+  , boptsKeepGoing = Nothing
+  , boptsKeepTmpFiles = defaultFirstFalse buildMonoidKeepTmpFiles
+  , boptsForceDirty = defaultFirstFalse buildMonoidForceDirty
+  , boptsTests = defaultFirstFalse buildMonoidTests
+  , boptsTestOpts = defaultTestOpts
+  , boptsBenchmarks = defaultFirstFalse buildMonoidBenchmarks
+  , boptsBenchmarkOpts = defaultBenchmarkOpts
+  , boptsReconfigure = defaultFirstFalse buildMonoidReconfigure
+  , boptsCabalVerbose = CabalVerbosity normal
+  , boptsSplitObjs = defaultFirstFalse buildMonoidSplitObjs
+  , boptsSkipComponents = []
+  , boptsInterleavedOutput = defaultFirstTrue buildMonoidInterleavedOutput
+  , boptsDdumpDir = Nothing
+  }
+
+defaultBuildOptsCLI ::BuildOptsCLI
+defaultBuildOptsCLI = BuildOptsCLI
+  { boptsCLITargets = []
+  , boptsCLIDryrun = False
+  , boptsCLIFlags = Map.empty
+  , boptsCLIGhcOptions = []
+  , boptsCLIProgsOptions = []
+  , boptsCLIBuildSubset = BSAll
+  , boptsCLIFileWatch = NoFileWatch
+  , boptsCLIWatchAll = False
+  , boptsCLIExec = []
+  , boptsCLIOnlyConfigure = False
+  , boptsCLICommand = Build
+  , boptsCLIInitialBuildSteps = False
+  }
+
+-- | How to apply a CLI flag
+data ApplyCLIFlag
+  = ACFAllProjectPackages
+    -- ^ Apply to all project packages which have such a flag name available.
+  | ACFByName !PackageName
+    -- ^ Apply to the specified package only.
+  deriving (Eq, Ord, Show)
+
+-- | Only flags set via 'ACFByName'
+boptsCLIFlagsByName :: BuildOptsCLI -> Map PackageName (Map FlagName Bool)
+boptsCLIFlagsByName =
+  Map.fromList .
+  mapMaybe go .
+  Map.toList .
+  boptsCLIFlags
+ where
+  go (ACFAllProjectPackages, _) = Nothing
+  go (ACFByName name, flags) = Just (name, flags)
+
+-- | Build options that may only be specified from the CLI
+data BuildOptsCLI = BuildOptsCLI
+  { boptsCLITargets :: ![Text]
+  , boptsCLIDryrun :: !Bool
+  , boptsCLIGhcOptions :: ![Text]
+  , boptsCLIProgsOptions :: ![(Text, [Text])]
+  , boptsCLIFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
+  , boptsCLIBuildSubset :: !BuildSubset
+  , boptsCLIFileWatch :: !FileWatchOpts
+  , boptsCLIWatchAll :: !Bool
+  , boptsCLIExec :: ![(String, [String])]
+  , boptsCLIOnlyConfigure :: !Bool
+  , boptsCLICommand :: !BuildCommand
+  , boptsCLIInitialBuildSteps :: !Bool
+  }
+  deriving Show
+
+-- | Generate a list of --PROG-option="<argument>" arguments for all PROGs.
+boptsCLIAllProgOptions :: BuildOptsCLI -> [Text]
+boptsCLIAllProgOptions boptsCLI =
+  concatMap progOptionArgs (boptsCLIProgsOptions boptsCLI)
+ where
+  -- Generate a list of --PROG-option="<argument>" arguments for a PROG.
+  progOptionArgs :: (Text, [Text]) -> [Text]
+  progOptionArgs (prog, opts) = map progOptionArg opts
+   where
+    -- Generate a --PROG-option="<argument>" argument for a PROG and option.
+    progOptionArg :: Text -> Text
+    progOptionArg opt = T.concat
+      [ "--"
+      , prog
+      , "-option=\""
+      , opt
+      , "\""
+      ]
+
+-- | Command sum type for conditional arguments.
+data BuildCommand
+  = Build
+  | Test
+  | Haddock
+  | Bench
+  | Install
+  deriving (Eq, Show)
+
+-- | Build options that may be specified in the stack.yaml or from the CLI
+data BuildOptsMonoid = BuildOptsMonoid
+  { buildMonoidTrace :: !Any
+  , buildMonoidProfile :: !Any
+  , buildMonoidNoStrip :: !Any
+  , buildMonoidLibProfile :: !FirstFalse
+  , buildMonoidExeProfile :: !FirstFalse
+  , buildMonoidLibStrip :: !FirstTrue
+  , buildMonoidExeStrip :: !FirstTrue
+  , buildMonoidHaddock :: !FirstFalse
+  , buildMonoidHaddockOpts :: !HaddockOptsMonoid
+  , buildMonoidOpenHaddocks :: !FirstFalse
+  , buildMonoidHaddockDeps :: !(First Bool)
+  , buildMonoidHaddockInternal :: !FirstFalse
+  , buildMonoidHaddockHyperlinkSource :: !FirstTrue
+  , buildMonoidInstallExes :: !FirstFalse
+  , buildMonoidInstallCompilerTool :: !FirstFalse
+  , buildMonoidPreFetch :: !FirstFalse
+  , buildMonoidKeepGoing :: !(First Bool)
+  , buildMonoidKeepTmpFiles :: !FirstFalse
+  , buildMonoidForceDirty :: !FirstFalse
+  , buildMonoidTests :: !FirstFalse
+  , buildMonoidTestOpts :: !TestOptsMonoid
+  , buildMonoidBenchmarks :: !FirstFalse
+  , buildMonoidBenchmarkOpts :: !BenchmarkOptsMonoid
+  , buildMonoidReconfigure :: !FirstFalse
+  , buildMonoidCabalVerbose :: !(First CabalVerbosity)
+  , buildMonoidSplitObjs :: !FirstFalse
+  , buildMonoidSkipComponents :: ![Text]
+  , buildMonoidInterleavedOutput :: !FirstTrue
+  , buildMonoidDdumpDir :: !(First Text)
+  }
+  deriving (Generic, Show)
+
+instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
+  parseJSON = withObjectWarnings "BuildOptsMonoid" $ \o -> do
+    let buildMonoidTrace = Any False
+        buildMonoidProfile = Any False
+        buildMonoidNoStrip = Any False
+    buildMonoidLibProfile <- FirstFalse <$> o ..:? buildMonoidLibProfileArgName
+    buildMonoidExeProfile <-FirstFalse <$>  o ..:? buildMonoidExeProfileArgName
+    buildMonoidLibStrip <- FirstTrue <$> o ..:? buildMonoidLibStripArgName
+    buildMonoidExeStrip <-FirstTrue <$>  o ..:? buildMonoidExeStripArgName
+    buildMonoidHaddock <- FirstFalse <$> o ..:? buildMonoidHaddockArgName
+    buildMonoidHaddockOpts <-
+      jsonSubWarnings (o ..:? buildMonoidHaddockOptsArgName ..!= mempty)
+    buildMonoidOpenHaddocks <-
+      FirstFalse <$> o ..:? buildMonoidOpenHaddocksArgName
+    buildMonoidHaddockDeps <- First <$> o ..:? buildMonoidHaddockDepsArgName
+    buildMonoidHaddockInternal <-
+      FirstFalse <$> o ..:? buildMonoidHaddockInternalArgName
+    buildMonoidHaddockHyperlinkSource <-
+      FirstTrue <$> o ..:? buildMonoidHaddockHyperlinkSourceArgName
+    buildMonoidInstallExes <-
+      FirstFalse <$> o ..:? buildMonoidInstallExesArgName
+    buildMonoidInstallCompilerTool <-
+      FirstFalse <$> o ..:? buildMonoidInstallCompilerToolArgName
+    buildMonoidPreFetch <- FirstFalse <$> o ..:? buildMonoidPreFetchArgName
+    buildMonoidKeepGoing <- First <$> o ..:? buildMonoidKeepGoingArgName
+    buildMonoidKeepTmpFiles <-
+      FirstFalse <$> o ..:? buildMonoidKeepTmpFilesArgName
+    buildMonoidForceDirty <- FirstFalse <$> o ..:? buildMonoidForceDirtyArgName
+    buildMonoidTests <- FirstFalse <$> o ..:? buildMonoidTestsArgName
+    buildMonoidTestOpts <-
+      jsonSubWarnings (o ..:? buildMonoidTestOptsArgName ..!= mempty)
+    buildMonoidBenchmarks <- FirstFalse <$> o ..:? buildMonoidBenchmarksArgName
+    buildMonoidBenchmarkOpts <-
+      jsonSubWarnings (o ..:? buildMonoidBenchmarkOptsArgName ..!= mempty)
+    buildMonoidReconfigure <-
+      FirstFalse <$> o ..:? buildMonoidReconfigureArgName
+    cabalVerbosity <- First <$> o ..:? buildMonoidCabalVerbosityArgName
+    cabalVerbose <- FirstFalse <$> o ..:? buildMonoidCabalVerboseArgName
+    let buildMonoidCabalVerbose =
+          cabalVerbosity <> toFirstCabalVerbosity cabalVerbose
+    buildMonoidSplitObjs <- FirstFalse <$> o ..:? buildMonoidSplitObjsName
+    buildMonoidSkipComponents <-
+      o ..:? buildMonoidSkipComponentsName ..!= mempty
+    buildMonoidInterleavedOutput <-
+      FirstTrue <$> o ..:? buildMonoidInterleavedOutputName
+    buildMonoidDdumpDir <- o ..:? buildMonoidDdumpDirName ..!= mempty
+    pure BuildOptsMonoid{..}
+
+buildMonoidLibProfileArgName :: Text
+buildMonoidLibProfileArgName = "library-profiling"
+
+buildMonoidExeProfileArgName :: Text
+buildMonoidExeProfileArgName = "executable-profiling"
+
+buildMonoidLibStripArgName :: Text
+buildMonoidLibStripArgName = "library-stripping"
+
+buildMonoidExeStripArgName :: Text
+buildMonoidExeStripArgName = "executable-stripping"
+
+buildMonoidHaddockArgName :: Text
+buildMonoidHaddockArgName = "haddock"
+
+buildMonoidHaddockOptsArgName :: Text
+buildMonoidHaddockOptsArgName = "haddock-arguments"
+
+buildMonoidOpenHaddocksArgName :: Text
+buildMonoidOpenHaddocksArgName = "open-haddocks"
+
+buildMonoidHaddockDepsArgName :: Text
+buildMonoidHaddockDepsArgName = "haddock-deps"
+
+buildMonoidHaddockInternalArgName :: Text
+buildMonoidHaddockInternalArgName = "haddock-internal"
+
+buildMonoidHaddockHyperlinkSourceArgName :: Text
+buildMonoidHaddockHyperlinkSourceArgName = "haddock-hyperlink-source"
+
+buildMonoidInstallExesArgName :: Text
+buildMonoidInstallExesArgName = "copy-bins"
+
+buildMonoidInstallCompilerToolArgName :: Text
+buildMonoidInstallCompilerToolArgName = "copy-compiler-tool"
+
+buildMonoidPreFetchArgName :: Text
+buildMonoidPreFetchArgName = "prefetch"
+
+buildMonoidKeepGoingArgName :: Text
+buildMonoidKeepGoingArgName = "keep-going"
+
+buildMonoidKeepTmpFilesArgName :: Text
+buildMonoidKeepTmpFilesArgName = "keep-tmp-files"
+
+buildMonoidForceDirtyArgName :: Text
+buildMonoidForceDirtyArgName = "force-dirty"
+
+buildMonoidTestsArgName :: Text
+buildMonoidTestsArgName = "test"
+
+buildMonoidTestOptsArgName :: Text
+buildMonoidTestOptsArgName = "test-arguments"
+
+buildMonoidBenchmarksArgName :: Text
+buildMonoidBenchmarksArgName = "bench"
+
+buildMonoidBenchmarkOptsArgName :: Text
+buildMonoidBenchmarkOptsArgName = "benchmark-opts"
+
+buildMonoidReconfigureArgName :: Text
+buildMonoidReconfigureArgName = "reconfigure"
+
+buildMonoidCabalVerbosityArgName :: Text
+buildMonoidCabalVerbosityArgName = "cabal-verbosity"
+
+buildMonoidCabalVerboseArgName :: Text
+buildMonoidCabalVerboseArgName = "cabal-verbose"
+
+buildMonoidSplitObjsName :: Text
+buildMonoidSplitObjsName = "split-objs"
+
+buildMonoidSkipComponentsName :: Text
+buildMonoidSkipComponentsName = "skip-components"
+
+buildMonoidInterleavedOutputName :: Text
+buildMonoidInterleavedOutputName = "interleaved-output"
+
+buildMonoidDdumpDirName :: Text
+buildMonoidDdumpDirName = "ddump-dir"
+
+instance Semigroup BuildOptsMonoid where
+  (<>) = mappenddefault
+
+instance Monoid BuildOptsMonoid where
+  mempty = memptydefault
+  mappend = (<>)
+
+-- | Which subset of packages to build
+data BuildSubset
+  = BSAll
+  | BSOnlySnapshot
+    -- ^ Only install packages in the snapshot database, skipping
+    -- packages intended for the local database.
+  | BSOnlyDependencies
+  | BSOnlyLocals
+    -- ^ Refuse to build anything in the snapshot database, see
+    -- https://github.com/commercialhaskell/stack/issues/5272
+  deriving (Show, Eq)
+
+-- | Options for the 'FinalAction' 'DoTests'
+data TestOpts = TestOpts
+  { toRerunTests :: !Bool -- ^ Whether successful tests will be run gain
+  , toAdditionalArgs :: ![String] -- ^ Arguments passed to the test program
+  , toCoverage :: !Bool -- ^ Generate a code coverage report
+  , toDisableRun :: !Bool -- ^ Disable running of tests
+  , toMaximumTimeSeconds :: !(Maybe Int) -- ^ test suite timeout in seconds
+  , toAllowStdin :: !Bool -- ^ Whether to allow standard input
+  }
+  deriving (Eq, Show)
+
+defaultTestOpts :: TestOpts
+defaultTestOpts = TestOpts
+  { toRerunTests = defaultFirstTrue toMonoidRerunTests
+  , toAdditionalArgs = []
+  , toCoverage = defaultFirstFalse toMonoidCoverage
+  , toDisableRun = defaultFirstFalse toMonoidDisableRun
+  , toMaximumTimeSeconds = Nothing
+  , toAllowStdin = defaultFirstTrue toMonoidAllowStdin
+  }
+
+data TestOptsMonoid = TestOptsMonoid
+  { toMonoidRerunTests :: !FirstTrue
+  , toMonoidAdditionalArgs :: ![String]
+  , toMonoidCoverage :: !FirstFalse
+  , toMonoidDisableRun :: !FirstFalse
+  , toMonoidMaximumTimeSeconds :: !(First (Maybe Int))
+  , toMonoidAllowStdin :: !FirstTrue
+  }
+  deriving (Show, Generic)
+
+instance FromJSON (WithJSONWarnings TestOptsMonoid) where
+  parseJSON = withObjectWarnings "TestOptsMonoid" $ \o -> do
+    toMonoidRerunTests <- FirstTrue <$> o ..:? toMonoidRerunTestsArgName
+    toMonoidAdditionalArgs <- o ..:? toMonoidAdditionalArgsName ..!= []
+    toMonoidCoverage <- FirstFalse <$> o ..:? toMonoidCoverageArgName
+    toMonoidDisableRun <- FirstFalse <$> o ..:? toMonoidDisableRunArgName
+    toMonoidMaximumTimeSeconds <-
+      First <$> o ..:? toMonoidMaximumTimeSecondsArgName
+    toMonoidAllowStdin <- FirstTrue <$> o ..:? toMonoidTestsAllowStdinName
+    pure TestOptsMonoid{..}
+
+toMonoidRerunTestsArgName :: Text
+toMonoidRerunTestsArgName = "rerun-tests"
+
+toMonoidAdditionalArgsName :: Text
+toMonoidAdditionalArgsName = "additional-args"
+
+toMonoidCoverageArgName :: Text
+toMonoidCoverageArgName = "coverage"
+
+toMonoidDisableRunArgName :: Text
+toMonoidDisableRunArgName = "no-run-tests"
+
+toMonoidMaximumTimeSecondsArgName :: Text
+toMonoidMaximumTimeSecondsArgName = "test-suite-timeout"
+
+toMonoidTestsAllowStdinName :: Text
+toMonoidTestsAllowStdinName = "tests-allow-stdin"
+
+instance Semigroup TestOptsMonoid where
+  (<>) = mappenddefault
+
+instance Monoid TestOptsMonoid where
+  mempty = memptydefault
+  mappend = (<>)
+
+-- | Haddock Options
+newtype HaddockOpts = HaddockOpts
+  { hoAdditionalArgs :: [String] -- ^ Arguments passed to haddock program
+  }
+  deriving (Eq, Show)
+
+newtype HaddockOptsMonoid = HaddockOptsMonoid
+  { hoMonoidAdditionalArgs :: [String]
+  }
+  deriving (Generic, Show)
+
+defaultHaddockOpts :: HaddockOpts
+defaultHaddockOpts = HaddockOpts {hoAdditionalArgs = []}
+
+instance FromJSON (WithJSONWarnings HaddockOptsMonoid) where
+  parseJSON = withObjectWarnings "HaddockOptsMonoid" $ \o -> do
+    hoMonoidAdditionalArgs <- o ..:? hoMonoidAdditionalArgsName ..!= []
+    pure HaddockOptsMonoid{..}
+
+instance Semigroup HaddockOptsMonoid where
+  (<>) = mappenddefault
+
+instance Monoid HaddockOptsMonoid where
+  mempty = memptydefault
+  mappend = (<>)
+
+hoMonoidAdditionalArgsName :: Text
+hoMonoidAdditionalArgsName = "haddock-args"
+
+-- | Options for the 'FinalAction' 'DoBenchmarks'
+data BenchmarkOpts = BenchmarkOpts
+  { beoAdditionalArgs :: !(Maybe String)
+    -- ^ Arguments passed to the benchmark program
+  , beoDisableRun :: !Bool
+    -- ^ Disable running of benchmarks
+  }
+  deriving (Eq, Show)
+
+defaultBenchmarkOpts :: BenchmarkOpts
+defaultBenchmarkOpts = BenchmarkOpts
+  { beoAdditionalArgs = Nothing
+  , beoDisableRun = False
+  }
+
+data BenchmarkOptsMonoid = BenchmarkOptsMonoid
+  { beoMonoidAdditionalArgs :: !(First String)
+  , beoMonoidDisableRun :: !(First Bool)
+  }
+  deriving (Generic, Show)
+
+instance FromJSON (WithJSONWarnings BenchmarkOptsMonoid) where
+  parseJSON = withObjectWarnings "BenchmarkOptsMonoid" $ \o -> do
+    beoMonoidAdditionalArgs <- First <$> o ..:? beoMonoidAdditionalArgsArgName
+    beoMonoidDisableRun <- First <$> o ..:? beoMonoidDisableRunArgName
+    pure BenchmarkOptsMonoid{..}
+
+beoMonoidAdditionalArgsArgName :: Text
+beoMonoidAdditionalArgsArgName = "benchmark-arguments"
+
+beoMonoidDisableRunArgName :: Text
+beoMonoidDisableRunArgName = "no-run-benchmarks"
+
+instance Semigroup BenchmarkOptsMonoid where
+  (<>) = mappenddefault
+
+instance Monoid BenchmarkOptsMonoid where
+  mempty = memptydefault
+  mappend = (<>)
+
+data FileWatchOpts
+  = NoFileWatch
+  | FileWatch
+  | FileWatchPoll
+  deriving (Show, Eq)
+
+newtype CabalVerbosity
+  = CabalVerbosity Verbosity
+  deriving (Eq, Show)
+
+toFirstCabalVerbosity :: FirstFalse -> First CabalVerbosity
+toFirstCabalVerbosity vf = First $ getFirstFalse vf <&> \p ->
+  if p then verboseLevel else normalLevel
+ where
+  verboseLevel = CabalVerbosity verbose
+  normalLevel  = CabalVerbosity normal
+
+instance FromJSON CabalVerbosity where
+
+  parseJSON = withText "CabalVerbosity" $ \t ->
+    let s = T.unpack t
+        errMsg = fail $ "Unrecognised Cabal verbosity: " ++ s
+    in  maybe errMsg pure (simpleParsec s)
+
+instance Parsec CabalVerbosity where
+  parsec = CabalVerbosity <$> parsec
+
+buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool)
+buildOptsMonoidHaddockL =
+  lens (getFirstFalse . buildMonoidHaddock)
+    (\buildMonoid t -> buildMonoid {buildMonoidHaddock = FirstFalse t})
+
+buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool)
+buildOptsMonoidTestsL =
+  lens (getFirstFalse . buildMonoidTests)
+    (\buildMonoid t -> buildMonoid {buildMonoidTests = FirstFalse t})
+
+buildOptsMonoidBenchmarksL :: Lens' BuildOptsMonoid (Maybe Bool)
+buildOptsMonoidBenchmarksL =
+  lens (getFirstFalse . buildMonoidBenchmarks)
+    (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = FirstFalse t})
+
+buildOptsMonoidInstallExesL :: Lens' BuildOptsMonoid (Maybe Bool)
+buildOptsMonoidInstallExesL =
+  lens (getFirstFalse . buildMonoidInstallExes)
+    (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = FirstFalse t})
+
+buildOptsInstallExesL :: Lens' BuildOpts Bool
+buildOptsInstallExesL =
+  lens boptsInstallExes
+    (\bopts t -> bopts {boptsInstallExes = t})
+
+buildOptsHaddockL :: Lens' BuildOpts Bool
+buildOptsHaddockL =
+  lens boptsHaddock
+    (\bopts t -> bopts {boptsHaddock = t})
+ src/Stack/Types/CabalConfigKey.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.CabalConfigKey
+  ( CabalConfigKey (..)
+  , parseCabalConfigKey
+  ) where
+
+import qualified Data.Text as T
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..)
+                   , withText
+                   )
+import           Stack.Prelude
+
+-- | Which packages do configure opts apply to?
+data CabalConfigKey
+  = CCKTargets -- ^ See AGOTargets
+  | CCKLocals -- ^ See AGOLocals
+  | CCKEverything -- ^ See AGOEverything
+  | CCKPackage !PackageName -- ^ A specific package
+  deriving (Show, Read, Eq, Ord)
+
+instance FromJSON CabalConfigKey where
+  parseJSON = withText "CabalConfigKey" parseCabalConfigKey
+
+instance FromJSONKey CabalConfigKey where
+  fromJSONKey = FromJSONKeyTextParser parseCabalConfigKey
+
+parseCabalConfigKey :: (Monad m, MonadFail m) => Text -> m CabalConfigKey
+parseCabalConfigKey "$targets" = pure CCKTargets
+parseCabalConfigKey "$locals" = pure CCKLocals
+parseCabalConfigKey "$everything" = pure CCKEverything
+parseCabalConfigKey name =
+  case parsePackageName $ T.unpack name of
+    Nothing -> fail $ "Invalid CabalConfigKey: " ++ show name
+    Just x -> pure $ CCKPackage x
src/Stack/Types/Cache.hs view
@@ -8,49 +8,54 @@ 
 import qualified Data.Text as T
 import           Database.Persist.Sql
+                   ( PersistField (..), PersistFieldSql (..), PersistValue (..)
+                   , SqlType (..)
+                   )
 import           Stack.Prelude
-import           Stack.Types.GhcPkgId
+import           Stack.Types.GhcPkgId ( GhcPkgId, parseGhcPkgId, unGhcPkgId )
 
 -- | Type of config cache
 data ConfigCacheType
-    = ConfigCacheTypeConfig
-    | ConfigCacheTypeFlagLibrary GhcPkgId
-    | ConfigCacheTypeFlagExecutable PackageIdentifier
-    deriving (Eq, Show)
+  = ConfigCacheTypeConfig
+  | ConfigCacheTypeFlagLibrary GhcPkgId
+  | ConfigCacheTypeFlagExecutable PackageIdentifier
+  deriving (Eq, Show)
 
 instance PersistField ConfigCacheType where
-    toPersistValue ConfigCacheTypeConfig = PersistText "config"
-    toPersistValue (ConfigCacheTypeFlagLibrary v) =
-        PersistText $ "lib:" <> unGhcPkgId v
-    toPersistValue (ConfigCacheTypeFlagExecutable v) =
-        PersistText $ "exe:" <> T.pack (packageIdentifierString v)
-    fromPersistValue (PersistText t) =
-        fromMaybe (Left $ "Unexpected ConfigCacheType value: " <> t) $
-        config <|> fmap lib (T.stripPrefix "lib:" t) <|>
-        fmap exe (T.stripPrefix "exe:" t)
-      where
-        config
-            | t == "config" = Just (Right ConfigCacheTypeConfig)
-            | otherwise = Nothing
-        lib v = do
-            ghcPkgId <- mapLeft tshow (parseGhcPkgId v)
-            Right $ ConfigCacheTypeFlagLibrary ghcPkgId
-        exe v = do
-            pkgId <-
-                maybe (Left $ "Unexpected ConfigCacheType value: " <> t) Right $
-                parsePackageIdentifier (T.unpack v)
-            Right $ ConfigCacheTypeFlagExecutable pkgId
-    fromPersistValue _ = Left "Unexpected ConfigCacheType type"
+  toPersistValue ConfigCacheTypeConfig = PersistText "config"
+  toPersistValue (ConfigCacheTypeFlagLibrary v) =
+    PersistText $ "lib:" <> unGhcPkgId v
+  toPersistValue (ConfigCacheTypeFlagExecutable v) =
+    PersistText $ "exe:" <> T.pack (packageIdentifierString v)
+  fromPersistValue (PersistText t) =
+    fromMaybe (Left $ "Unexpected ConfigCacheType value: " <> t) $
+    config <|> fmap lib (T.stripPrefix "lib:" t) <|>
+    fmap exe (T.stripPrefix "exe:" t)
+   where
+    config
+      | t == "config" = Just (Right ConfigCacheTypeConfig)
+      | otherwise = Nothing
+    lib v = do
+      ghcPkgId <- mapLeft tshow (parseGhcPkgId v)
+      Right $ ConfigCacheTypeFlagLibrary ghcPkgId
+    exe v = do
+      pkgId <-
+        maybe (Left $ "Unexpected ConfigCacheType value: " <> t) Right $
+        parsePackageIdentifier (T.unpack v)
+      Right $ ConfigCacheTypeFlagExecutable pkgId
+  fromPersistValue _ = Left "Unexpected ConfigCacheType type"
 
 instance PersistFieldSql ConfigCacheType where
-    sqlType _ = SqlString
+  sqlType _ = SqlString
 
 data Action
   = UpgradeCheck
-  deriving (Show, Eq, Ord)
+  deriving (Eq, Ord, Show)
+
 instance PersistField Action where
-    toPersistValue UpgradeCheck = PersistInt64 1
-    fromPersistValue (PersistInt64 1) = Right UpgradeCheck
-    fromPersistValue x = Left $ T.pack $ "Invalid Action: " ++ show x
+  toPersistValue UpgradeCheck = PersistInt64 1
+  fromPersistValue (PersistInt64 1) = Right UpgradeCheck
+  fromPersistValue x = Left $ T.pack $ "Invalid Action: " ++ show x
+
 instance PersistFieldSql Action where
-    sqlType _ = SqlInt64
+  sqlType _ = SqlInt64
+ src/Stack/Types/ColorWhen.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.ColorWhen
+  ( ColorWhen (..)
+  , readColorWhen
+  ) where
+
+import           Options.Applicative ( ReadM )
+import qualified Options.Applicative.Types as OA
+import           Pantry.Internal.AesonExtended ( FromJSON (..) )
+import           Stack.Prelude
+
+data ColorWhen
+  = ColorNever
+  | ColorAlways
+  | ColorAuto
+  deriving (Eq, Generic, Show)
+
+instance FromJSON ColorWhen where
+  parseJSON v = do
+    s <- parseJSON v
+    case s of
+      "never"  -> pure ColorNever
+      "always" -> pure ColorAlways
+      "auto"   -> pure ColorAuto
+      _ -> fail ("Unknown color use: " <> s <> ". Expected values of " <>
+                 "option are 'never', 'always', or 'auto'.")
+
+readColorWhen :: ReadM ColorWhen
+readColorWhen = do
+  s <- OA.readerAsk
+  case s of
+    "never" -> pure ColorNever
+    "always" -> pure ColorAlways
+    "auto" -> pure ColorAuto
+    _ -> OA.readerError "Expected values of color option are 'never', \
+                        \'always', or 'auto'."
src/Stack/Types/Compiler.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE NoImplicitPrelude  #-}
 {-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE TypeFamilies       #-}
 
@@ -20,14 +17,18 @@   , wantedToActual
   , actualToWanted
   , parseActualCompiler
+  , whichCompilerL
   ) where
 
 import           Data.Aeson
-import           Database.Persist
+                   ( FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..)
+                   , ToJSON (..), Value (..), withText
+                   )
 import           Database.Persist.Sql
+                   ( PersistField (..), PersistFieldSql (..), SqlType (..) )
 import qualified Data.Text as T
 import           Stack.Prelude
-import           Stack.Types.Version
+import           Stack.Types.Version ( VersionCheck, checkVersion )
 import           Distribution.Version ( mkVersion )
 
 -- | Type representing exceptions thrown by functions exported by the
@@ -38,43 +39,54 @@   deriving (Show, Typeable)
 
 instance Exception CompilerException where
-    displayException GhcjsNotSupported =
-        "Error: [S-7903]\n"
-        ++ "GHCJS is no longer supported by Stack."
-    displayException (PantryException p) =
-        "Error: [S-7972]\n"
-        ++ displayException p
+  displayException GhcjsNotSupported =
+    "Error: [S-7903]\n"
+    ++ "GHCJS is no longer supported by Stack."
+  displayException (PantryException p) =
+    "Error: [S-7972]\n"
+    ++ displayException p
 
 -- | Variety of compiler to use.
 data WhichCompiler
-    = Ghc
-    deriving (Show, Eq, Ord)
+  = Ghc
+  deriving (Eq, Ord, Show)
 
 -- | Specifies a compiler and its version number(s).
 --
 -- Note that despite having this datatype, Stack isn't in a hurry to
 -- support compilers other than GHC.
 data ActualCompiler
-    = ACGhc !Version
-    | ACGhcGit !Text !Text
-    deriving (Generic, Show, Eq, Ord, Data, Typeable)
+  = ACGhc !Version
+  | ACGhcGit !Text !Text
+  deriving (Data, Eq, Generic, Ord, Show, Typeable)
+
 instance NFData ActualCompiler
+
 instance Display ActualCompiler where
-    display (ACGhc x) = display (WCGhc x)
-    display (ACGhcGit x y) = display (WCGhcGit x y)
+  display (ACGhc x) = display (WCGhc x)
+  display (ACGhcGit x y) = display (WCGhcGit x y)
+
 instance ToJSON ActualCompiler where
-    toJSON = toJSON . compilerVersionText
+  toJSON = toJSON . compilerVersionText
+
 instance FromJSON ActualCompiler where
-    parseJSON (String t) = either (const $ fail "Failed to parse compiler version") pure (parseActualCompiler t)
-    parseJSON _ = fail "Invalid CompilerVersion, must be String"
+  parseJSON (String t) =
+    either
+      (const $ fail "Failed to parse compiler version")
+      pure
+      (parseActualCompiler t)
+  parseJSON _ = fail "Invalid CompilerVersion, must be String"
+
 instance FromJSONKey ActualCompiler where
-    fromJSONKey = FromJSONKeyTextParser $ \k ->
-        case parseActualCompiler k of
-            Left _ -> fail $ "Failed to parse CompilerVersion " ++ T.unpack k
-            Right parsed -> pure parsed
+  fromJSONKey = FromJSONKeyTextParser $ \k ->
+    case parseActualCompiler k of
+      Left _ -> fail $ "Failed to parse CompilerVersion " ++ T.unpack k
+      Right parsed -> pure parsed
+
 instance PersistField ActualCompiler where
   toPersistValue = toPersistValue . compilerVersionText
   fromPersistValue = (mapLeft tshow . parseActualCompiler) <=< fromPersistValue
+
 instance PersistFieldSql ActualCompiler where
   sqlType _ = SqlString
 
@@ -89,8 +101,9 @@ 
 parseActualCompiler :: T.Text -> Either CompilerException ActualCompiler
 parseActualCompiler =
-  either (Left . PantryException) wantedToActual .
-  parseWantedCompiler
+  either
+    (Left . PantryException)
+    wantedToActual . parseWantedCompiler
 
 compilerVersionText :: ActualCompiler -> T.Text
 compilerVersionText = utf8BuilderToText . display
@@ -104,27 +117,31 @@ 
 isWantedCompiler :: VersionCheck -> WantedCompiler -> ActualCompiler -> Bool
 isWantedCompiler check (WCGhc wanted) (ACGhc actual) =
-    checkVersion check wanted actual
+  checkVersion check wanted actual
 isWantedCompiler _check (WCGhcGit wCommit wFlavour) (ACGhcGit aCommit aFlavour) =
-    wCommit == aCommit && wFlavour == aFlavour
+  wCommit == aCommit && wFlavour == aFlavour
 isWantedCompiler _ _ _ = False
 
 getGhcVersion :: ActualCompiler -> Version
 getGhcVersion (ACGhc v) = v
 getGhcVersion (ACGhcGit _ _) =
-   -- We can't return the actual version without running the installed ghc.
-   -- For now we assume that users of ghc-git use it with a recent commit so we
-   -- return a version far in the future. This disables our hacks for older
-   -- versions and passes version checking when we use newer features.
-   mkVersion [999,0,0]
+  -- We can't return the actual version without running the installed ghc.
+  -- For now we assume that users of ghc-git use it with a recent commit so we
+  -- return a version far in the future. This disables our hacks for older
+  -- versions and passes version checking when we use newer features.
+  mkVersion [999, 0, 0]
 
 -- | Repository containing the compiler sources
 newtype CompilerRepository
   = CompilerRepository Text
-  deriving (Show)
+  deriving Show
 
 instance FromJSON CompilerRepository where
   parseJSON = withText "CompilerRepository" (pure . CompilerRepository)
 
 defaultCompilerRepository :: CompilerRepository
-defaultCompilerRepository = CompilerRepository "https://gitlab.haskell.org/ghc/ghc.git"
+defaultCompilerRepository =
+  CompilerRepository "https://gitlab.haskell.org/ghc/ghc.git"
+
+whichCompilerL :: Getting r ActualCompiler WhichCompiler
+whichCompilerL = to whichCompiler
src/Stack/Types/CompilerBuild.hs view
@@ -12,16 +12,16 @@ import           Data.Text as T
 
 data CompilerBuild
-    = CompilerBuildStandard
-    | CompilerBuildSpecialized String
-    deriving (Show)
+  = CompilerBuildStandard
+  | CompilerBuildSpecialized String
+  deriving Show
 
 instance FromJSON CompilerBuild where
-    -- Strange structuring is to give consistent error messages
-    parseJSON =
-        withText
-            "CompilerBuild"
-            (either (fail . show) pure . parseCompilerBuild . T.unpack)
+  -- Strange structuring is to give consistent error messages
+  parseJSON =
+    withText
+      "CompilerBuild"
+      (either (fail . show) pure . parseCompilerBuild . T.unpack)
 
 -- | Descriptive name for compiler build
 compilerBuildName :: CompilerBuild -> String
+ src/Stack/Types/CompilerPaths.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.CompilerPaths
+  ( CompilerPaths (..)
+  , GhcPkgExe (..)
+  , HasCompiler (..)
+  , cabalVersionL
+  , cpWhich
+  , getCompilerPath
+  , getGhcPkgExe
+  ) where
+
+import           Distribution.System ( Arch )
+import           Stack.Prelude
+import           Stack.Types.Compiler
+                   ( ActualCompiler, WhichCompiler, whichCompiler )
+import           Stack.Types.CompilerBuild ( CompilerBuild )
+import           Stack.Types.DumpPackage ( DumpPackage )
+
+-- | Paths on the filesystem for the compiler we're using
+data CompilerPaths = CompilerPaths
+  { cpCompilerVersion :: !ActualCompiler
+  , cpArch :: !Arch
+  , cpBuild :: !CompilerBuild
+  , cpCompiler :: !(Path Abs File)
+  , cpPkg :: !GhcPkgExe
+    -- ^ ghc-pkg or equivalent
+  , cpInterpreter :: !(Path Abs File)
+    -- ^ runghc
+  , cpHaddock :: !(Path Abs File)
+    -- ^ haddock, in 'IO' to allow deferring the lookup
+  , cpSandboxed :: !Bool
+    -- ^ Is this a Stack-sandboxed installation?
+  , cpCabalVersion :: !Version
+    -- ^ This is the version of Cabal that Stack will use to compile Setup.hs
+    -- files in the build process.
+    --
+    -- Note that this is not necessarily the same version as the one that Stack
+    -- depends on as a library and which is displayed when running
+    -- @stack ls dependencies | grep Cabal@ in the Stack project.
+  , cpGlobalDB :: !(Path Abs Dir)
+    -- ^ Global package database
+  , cpGhcInfo :: !ByteString
+    -- ^ Output of @ghc --info@
+  , cpGlobalDump :: !(Map PackageName DumpPackage)
+  }
+  deriving Show
+
+-- | An environment which ensures that the given compiler is available on the
+-- PATH
+class HasCompiler env where
+  compilerPathsL :: SimpleGetter env CompilerPaths
+
+instance HasCompiler CompilerPaths where
+  compilerPathsL = id
+
+-- | Location of the ghc-pkg executable
+newtype GhcPkgExe
+  = GhcPkgExe (Path Abs File)
+  deriving Show
+
+cabalVersionL :: HasCompiler env => SimpleGetter env Version
+cabalVersionL = compilerPathsL.to cpCabalVersion
+
+cpWhich :: (MonadReader env m, HasCompiler env) => m WhichCompiler
+cpWhich = view $ compilerPathsL.to (whichCompiler.cpCompilerVersion)
+
+-- | Get the path for the given compiler ignoring any local binaries.
+--
+-- https://github.com/commercialhaskell/stack/issues/1052
+getCompilerPath :: HasCompiler env => RIO env (Path Abs File)
+getCompilerPath = view $ compilerPathsL.to cpCompiler
+
+-- | Get the 'GhcPkgExe' from a 'HasCompiler' environment
+getGhcPkgExe :: HasCompiler env => RIO env GhcPkgExe
+getGhcPkgExe = view $ compilerPathsL.to cpPkg
src/Stack/Types/Config.hs view
@@ -1,2315 +1,288 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DefaultSignatures     #-}
-{-# LANGUAGE DeriveDataTypeable    #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE MultiWayIf            #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE ViewPatterns          #-}
-
--- | The Config type.
-
-module Stack.Types.Config
-  (
-  -- * Main configuration types and classes
-  -- ** HasPlatform & HasStackRoot
-    HasPlatform (..)
-  , PlatformVariant (..)
-  -- ** Runner
-  , HasRunner (..)
-  , Runner (..)
-  , ColorWhen (..)
-  , terminalL
-  , reExecL
-  -- ** Config & HasConfig
-  , Config (..)
-  , HasConfig (..)
-  , askLatestSnapshotUrl
-  , configProjectRoot
-  -- ** BuildConfig & HasBuildConfig
-  , BuildConfig (..)
-  , ProjectPackage (..)
-  , DepPackage (..)
-  , ppRoot
-  , ppVersion
-  , ppComponents
-  , ppGPD
-  , stackYamlL
-  , projectRootL
-  , HasBuildConfig (..)
-  -- ** Storage databases
-  , UserStorage (..)
-  , ProjectStorage (..)
-  -- ** GHCVariant & HasGHCVariant
-  , GHCVariant (..)
-  , ghcVariantName
-  , ghcVariantSuffix
-  , parseGHCVariant
-  , HasGHCVariant (..)
-  , snapshotsDir
-  -- ** EnvConfig & HasEnvConfig
-  , EnvConfig (..)
-  , HasSourceMap (..)
-  , HasEnvConfig (..)
-  , getCompilerPath
-  -- * Details
-  -- ** ApplyGhcOptions
-  , ApplyGhcOptions (..)
-  -- ** AllowNewerDeps
-  , AllowNewerDeps (..)
-  -- ** CabalConfigKey
-  , CabalConfigKey (..)
-  -- ** ConfigException
-  , HpackExecutable (..)
-  , ConfigException (..)
-  , ConfigPrettyException (..)
-  , ParseAbsolutePathException (..)
-  , packageIndicesWarning
-  -- ** ConfigMonoid
-  , ConfigMonoid (..)
-  , configMonoidInstallGHCName
-  , configMonoidSystemGHCName
-  , parseConfigMonoid
-  -- ** DumpLogs
-  , DumpLogs (..)
-  -- ** EnvSettings
-  , EnvSettings (..)
-  , minimalEnvSettings
-  , defaultEnvSettings
-  , plainEnvSettings
-  -- ** GlobalOpts & GlobalOptsMonoid
-  , GlobalOpts (..)
-  , GlobalOptsMonoid (..)
-  , rslInLogL
-  , StackYamlLoc (..)
-  , stackYamlLocL
-  , LockFileBehavior (..)
-  , readLockFileBehavior
-  , lockFileBehaviorL
-  , defaultLogLevel
-  -- ** Project & ProjectAndConfigMonoid
-  , Project (..)
-  , ProjectConfig (..)
-  , Curator (..)
-  , ProjectAndConfigMonoid (..)
-  , parseProjectAndConfigMonoid
-  -- ** PvpBounds
-  , PvpBounds (..)
-  , PvpBoundsType (..)
-  , parsePvpBounds
-  -- ** ColorWhen
-  , readColorWhen
-  -- ** Styles
-  , readStyles
-  -- ** SCM
-  , SCM(..)
-  -- * Paths
-  , bindirSuffix
-  , GlobalInfoSource (..)
-  , getProjectWorkDir
-  , docDirSuffix
-  , extraBinDirs
-  , hpcReportDir
-  , installationRootDeps
-  , installationRootLocal
-  , bindirCompilerTools
-  , hoogleRoot
-  , hoogleDatabasePath
-  , packageDatabaseDeps
-  , packageDatabaseExtra
-  , packageDatabaseLocal
-  , platformOnlyRelDir
-  , platformGhcRelDir
-  , platformGhcVerOnlyRelDir
-  , useShaPathOnWindows
-  , shaPath
-  , shaPathForBytes
-  , workDirL
-  , ghcInstallHook
-  -- * Command-related types
-  , AddCommand
-  -- ** Eval
-  , EvalOpts (..)
-  -- ** Exec
-  , ExecOpts (..)
-  , SpecialExecCmd (..)
-  , ExecOptsExtra (..)
-  -- ** Setup
-  , DownloadInfo (..)
-  , VersionedDownloadInfo (..)
-  , GHCDownloadInfo (..)
-  , SetupInfo (..)
-  -- ** Docker entrypoint
-  , DockerEntrypoint (..)
-  , DockerUser (..)
-  , module X
-  -- * Lens helpers
-  , wantedCompilerVersionL
-  , actualCompilerVersionL
-  , HasCompiler (..)
-  , DumpPackage (..)
-  , CompilerPaths (..)
-  , GhcPkgExe (..)
-  , getGhcPkgExe
-  , cpWhich
-  , ExtraDirs (..)
-  , buildOptsL
-  , globalOptsL
-  , buildOptsInstallExesL
-  , buildOptsMonoidHaddockL
-  , buildOptsMonoidTestsL
-  , buildOptsMonoidBenchmarksL
-  , buildOptsMonoidInstallExesL
-  , buildOptsHaddockL
-  , globalOptsBuildOptsMonoidL
-  , stackRootL
-  , stackGlobalConfigL
-  , cabalVersionL
-  , whichCompilerL
-  , envOverrideSettingsL
-  , shouldForceGhcColorFlag
-  , appropriateGhcColorFlag
-  -- * Helper logging functions
-  , prettyStackDevL
-  -- * Lens reexport
-  , view
-  , to
-  ) where
-
-import           Control.Monad.Writer ( Writer, tell )
-import           Control.Monad.Trans.Except ( ExceptT )
-import           Crypto.Hash ( hashWith, SHA1 (..) )
-import           Pantry.Internal.AesonExtended
-                   ( ToJSON, toJSON, FromJSON, FromJSONKey (..), parseJSON
-                   , withText, object, (.=), (..:), (...:), (..:?), (..!=)
-                   , Value(Bool), withObjectWarnings, WarningParser, Object
-                   , jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT
-                   , WithJSONWarnings (..)
-                   , FromJSONKeyFunction (FromJSONKeyTextParser)
-                   )
-import           Data.Attoparsec.Args ( parseArgs, EscapingMode (Escaping) )
-import qualified Data.ByteArray.Encoding as Mem ( convertToBase, Base(Base16) )
-import qualified Data.ByteString.Char8 as S8
-import           Data.Coerce ( coerce )
-import           Data.List ( stripPrefix )
-import qualified Data.List.NonEmpty as NonEmpty
-import qualified Data.Map as Map
-import qualified Data.Map.Strict as M
-import qualified Data.Monoid as Monoid
-import           Data.Monoid.Map ( MonoidMap (..) )
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import           Data.Yaml ( ParseException )
-import qualified Data.Yaml as Yaml
-import qualified Distribution.License as C
-import           Distribution.ModuleName ( ModuleName )
-import           Distribution.PackageDescription ( GenericPackageDescription )
-import qualified Distribution.PackageDescription as C
-import           Distribution.System ( Platform, Arch )
-import qualified Distribution.Text
-import           Distribution.Version ( anyVersion, mkVersion )
-import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
-import           Lens.Micro
-import           Options.Applicative ( ReadM )
-import qualified Options.Applicative as OA
-import qualified Options.Applicative.Types as OA
-import           Pantry.Internal ( Storage )
-import           Path
-import qualified RIO.List as List
-import           Stack.Constants
-import           Stack.Prelude
-import           Stack.Types.Compiler
-import           Stack.Types.CompilerBuild
-import           Stack.Types.Docker
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
-import           Stack.Types.Nix
-import           Stack.Types.Resolver
-import           Stack.Types.SourceMap
-import           Stack.Types.TemplateName
-import           Stack.Types.Version
-                   ( IntersectingVersionRange (..), VersionCheck (..)
-                   , VersionRange, stackVersion, versionRangeText
-                   )
-import qualified System.FilePath as FilePath
-import           System.PosixCompat.Types ( UserID, GroupID, FileMode )
-import           RIO.Process ( ProcessContext, HasProcessContext (..) )
-import           Casa.Client ( CasaRepoPrefix )
-
--- Re-exports
-import           Stack.Types.Config.Build as X
-
--- | Type representing exceptions thrown by functions exported by the
--- "Stack.Config" module.
-data ConfigException
-  = ParseCustomSnapshotException Text ParseException
-  | NoProjectConfigFound (Path Abs Dir) (Maybe Text)
-  | UnexpectedArchiveContents [Path Abs Dir] [Path Abs File]
-  | UnableToExtractArchive Text (Path Abs File)
-  | BadStackVersionException VersionRange
-  | NoSuchDirectory FilePath
-  | ParseGHCVariantException String
-  | BadStackRoot (Path Abs Dir)
-  | Won'tCreateStackRootInDirectoryOwnedByDifferentUser (Path Abs Dir) (Path Abs Dir) -- ^ @$STACK_ROOT@, parent dir
-  | UserDoesn'tOwnDirectory (Path Abs Dir)
-  | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC
-  | NixRequiresSystemGhc
-  | NoResolverWhenUsingNoProject
-  | DuplicateLocalPackageNames ![(PackageName, [PackageLocation])]
-  | NoLTSWithMajorVersion Int
-  | NoLTSFound
-  | MultiplePackageIndices [PackageIndexConfig]
-  deriving (Show, Typeable)
-
-instance Exception ConfigException where
-    displayException (ParseCustomSnapshotException url exception) = concat
-        [ "Error: [S-8981]\n"
-        , "Could not parse '"
-        , T.unpack url
-        , "':\n"
-        , Yaml.prettyPrintParseException exception
-        , "\nSee https://docs.haskellstack.org/en/stable/custom_snapshot/"
-        ]
-    displayException (NoProjectConfigFound dir mcmd) = concat
-        [ "Error: [S-2206]\n"
-        , "Unable to find a stack.yaml file in the current directory ("
-        , toFilePath dir
-        , ") or its ancestors"
-        , case mcmd of
-            Nothing -> ""
-            Just cmd -> "\nRecommended action: stack " ++ T.unpack cmd
-        ]
-    displayException (UnexpectedArchiveContents dirs files) = concat
-        [ "Error: [S-4964]\n"
-        , "When unpacking an archive specified in your stack.yaml file, "
-        , "did not find expected contents. Expected: a single directory. Found: "
-        , show ( map (toFilePath . dirname) dirs
-               , map (toFilePath . filename) files
-               )
-        ]
-    displayException (UnableToExtractArchive url file) = concat
-        [ "Error: [S-2040]\n"
-        , "Archive extraction failed. Tarballs and zip archives are supported, \
-          \couldn't handle the following URL, "
-        , T.unpack url
-        , " downloaded to the file "
-        , toFilePath $ filename file
-        ]
-    displayException (BadStackVersionException requiredRange) = concat
-        [ "Error: [S-1641]\n"
-        , "The version of Stack you are using ("
-        , show stackVersion
-        , ") is outside the required\n"
-        ,"version range specified in stack.yaml ("
-        , T.unpack (versionRangeText requiredRange)
-        , ").\n"
-        , "You can upgrade Stack by running:\n\n"
-        , "stack upgrade"
-        ]
-    displayException (NoSuchDirectory dir) = concat
-        [ "Error: [S-8773]\n"
-        , "No directory could be located matching the supplied path: "
-        , dir
-        ]
-    displayException (ParseGHCVariantException v) = concat
-        [ "Error: [S-3938]\n"
-        , "Invalid ghc-variant value: "
-        , v
-        ]
-    displayException (BadStackRoot stackRoot) = concat
-        [ "Error: [S-8530]\n"
-        , "Invalid Stack root: '"
-        , toFilePath stackRoot
-        , "'. Please provide a valid absolute path."
-        ]
-    displayException (Won'tCreateStackRootInDirectoryOwnedByDifferentUser envStackRoot parentDir) = concat
-        [ "Error: [S-7613]\n"
-        , "Preventing creation of Stack root '"
-        , toFilePath envStackRoot
-        , "'. Parent directory '"
-        , toFilePath parentDir
-        , "' is owned by someone else."
-        ]
-    displayException (UserDoesn'tOwnDirectory dir) = concat
-        [ "Error: [S-8707]\n"
-        , "You are not the owner of '"
-        , toFilePath dir
-        , "'. Aborting to protect file permissions."
-        , "\nRetry with '--"
-        , T.unpack configMonoidAllowDifferentUserName
-        , "' to disable this precaution."
-        ]
-    displayException ManualGHCVariantSettingsAreIncompatibleWithSystemGHC = T.unpack $ T.concat
-        [ "Error: [S-3605]\n"
-        , "Stack can only control the "
-        , configMonoidGHCVariantName
-        , " of its own GHC installations. Please use '--no-"
-        , configMonoidSystemGHCName
-        , "'."
-        ]
-    displayException NixRequiresSystemGhc = T.unpack $ T.concat
-        [ "Error: [S-6816]\n"
-        , "Stack's Nix integration is incompatible with '--no-system-ghc'. "
-        , "Please use '--"
-        , configMonoidSystemGHCName
-        , "' or disable the Nix integration."
-        ]
-    displayException NoResolverWhenUsingNoProject =
-        "Error: [S-5027]\n"
-        ++ "When using the script command, you must provide a resolver argument"
-    displayException (DuplicateLocalPackageNames pairs) = concat
-        $ "Error: [S-5470]\n"
-        : "The same package name is used in multiple local packages\n"
-        : map go pairs
-      where
-        go (name, dirs) = unlines
-            $ ""
-            : (packageNameString name ++ " used in:")
-            : map goLoc dirs
-        goLoc loc = "- " ++ show loc
-    displayException (NoLTSWithMajorVersion n) = concat
-        [ "Error: [S-3803]\n"
-        , "No LTS release found with major version "
-        , show n
-        , "."
-        ]
-    displayException NoLTSFound =
-        "Error: [S-5472]\n"
-        ++ "No LTS releases found."
-    displayException (MultiplePackageIndices pics) = concat
-        [ "Error: [S-3251]\n"
-        , "When using the 'package-indices' key to override the default "
-        , "package index, you must provide exactly one value, received: "
-        , show pics
-        , "\n"
-        , packageIndicesWarning
-        ]
-
--- | Type representing \'pretty\' exceptions thrown by functions exported by the
--- "Stack.Config" module.
-data ConfigPrettyException
-    = ParseConfigFileException !(Path Abs File) !ParseException
-    | NoMatchingSnapshot !(NonEmpty SnapName)
-    | ResolverMismatch !RawSnapshotLocation String
-    | ResolverPartial !RawSnapshotLocation !String
-    deriving (Show, Typeable)
-
-instance Pretty ConfigPrettyException where
-    pretty (ParseConfigFileException configFile exception) =
-        "[S-6602]"
-        <> line
-        <> fillSep
-             [ flow "Stack could not load and parse"
-             , style File (pretty configFile)
-             , flow "as a YAML configuraton file."
-             ]
-        <> blankLine
-        <> flow "While loading and parsing, Stack encountered the following \
-                \error:"
-        <> blankLine
-        <> string (Yaml.prettyPrintParseException exception)
-        <> blankLine
-        <> fillSep
-             [ flow "For help about the content of Stack's YAML configuration \
-                    \files, see (for the most recent release of Stack)"
-             ,    style
-                    Url
-                    "http://docs.haskellstack.org/en/stable/yaml_configuration/"
-               <> "."
-             ]
-    pretty (NoMatchingSnapshot names) =
-        "[S-1833]"
-        <> line
-        <> flow "None of the following snapshots provides a compiler matching \
-                \your package(s):"
-        <> line
-        <> bulletedList (map (fromString . show) (NonEmpty.toList names))
-        <> blankLine
-        <> resolveOptions
-    pretty (ResolverMismatch resolver errDesc) =
-        "[S-6395]"
-        <> line
-        <> fillSep
-             [ "Snapshot"
-             , style Url (pretty $ PrettyRawSnapshotLocation resolver)
-             , flow "does not have a matching compiler to build some or all of \
-                    \your package(s)."
-             ]
-        <> blankLine
-        <> indent 4 (string errDesc)
-        <> line
-        <> resolveOptions
-    pretty (ResolverPartial resolver errDesc) =
-        "[S-2422]"
-        <> line
-        <> fillSep
-             [ "Snapshot"
-             , style Url (pretty $ PrettyRawSnapshotLocation resolver)
-             , flow "does not have all the packages to match your requirements."
-             ]
-        <> blankLine
-        <> indent 4 (string errDesc)
-        <> line
-        <> resolveOptions
-
-instance Exception ConfigPrettyException
-
-data ParseAbsolutePathException
-    = ParseAbsolutePathException String String
-    deriving (Show, Typeable)
-
-instance Exception ParseAbsolutePathException where
-    displayException (ParseAbsolutePathException envVar dir) = concat
-        [ "Error: [S-9437]\n"
-        , "Failed to parse "
-        , envVar
-        , " environment variable (expected absolute directory): "
-        , dir
-        ]
-
--- | The base environment that almost everything in Stack runs in,
--- based off of parsing command line options in 'GlobalOpts'. Provides
--- logging and process execution.
-data Runner = Runner
-  { runnerGlobalOpts :: !GlobalOpts
-  , runnerUseColor   :: !Bool
-  , runnerLogFunc    :: !LogFunc
-  , runnerTermWidth  :: !Int
-  , runnerProcessContext :: !ProcessContext
-  }
-
-data ColorWhen = ColorNever | ColorAlways | ColorAuto
-    deriving (Eq, Show, Generic)
-
-instance FromJSON ColorWhen where
-    parseJSON v = do
-        s <- parseJSON v
-        case s of
-            "never"  -> pure ColorNever
-            "always" -> pure ColorAlways
-            "auto"   -> pure ColorAuto
-            _ -> fail ("Unknown color use: " <> s <> ". Expected values of " <>
-                       "option are 'never', 'always', or 'auto'.")
-
--- | The top-level Stackage configuration.
-data Config =
-  Config {configWorkDir             :: !(Path Rel Dir)
-         -- ^ this allows to override .stack-work directory
-         ,configUserConfigPath      :: !(Path Abs File)
-         -- ^ Path to user configuration file (usually ~/.stack/config.yaml)
-         ,configBuild               :: !BuildOpts
-         -- ^ Build configuration
-         ,configDocker              :: !DockerOpts
-         -- ^ Docker configuration
-         ,configNix                 :: !NixOpts
-         -- ^ Execution environment (e.g nix-shell) configuration
-         ,configProcessContextSettings :: !(EnvSettings -> IO ProcessContext)
-         -- ^ Environment variables to be passed to external tools
-         ,configLocalProgramsBase   :: !(Path Abs Dir)
-         -- ^ Non-platform-specific path containing local installations
-         ,configLocalPrograms       :: !(Path Abs Dir)
-         -- ^ Path containing local installations (mainly GHC)
-         ,configHideTHLoading       :: !Bool
-         -- ^ Hide the Template Haskell "Loading package ..." messages from the
-         -- console
-         ,configPrefixTimestamps    :: !Bool
-         -- ^ Prefix build output with timestamps for each line.
-         ,configPlatform            :: !Platform
-         -- ^ The platform we're building for, used in many directory names
-         ,configPlatformVariant     :: !PlatformVariant
-         -- ^ Variant of the platform, also used in directory names
-         ,configGHCVariant          :: !(Maybe GHCVariant)
-         -- ^ The variant of GHC requested by the user.
-         ,configGHCBuild            :: !(Maybe CompilerBuild)
-         -- ^ Override build of the compiler distribution (e.g. standard, gmp4, tinfo6)
-         ,configLatestSnapshot      :: !Text
-         -- ^ URL of a JSON file providing the latest LTS and Nightly snapshots.
-         ,configSystemGHC           :: !Bool
-         -- ^ Should we use the system-installed GHC (on the PATH) if
-         -- available? Can be overridden by command line options.
-         ,configInstallGHC          :: !Bool
-         -- ^ Should we automatically install GHC if missing or the wrong
-         -- version is available? Can be overridden by command line options.
-         ,configSkipGHCCheck        :: !Bool
-         -- ^ Don't bother checking the GHC version or architecture.
-         ,configSkipMsys            :: !Bool
-         -- ^ On Windows: don't use a sandboxed MSYS
-         ,configCompilerCheck       :: !VersionCheck
-         -- ^ Specifies which versions of the compiler are acceptable.
-         ,configCompilerRepository  :: !CompilerRepository
-         -- ^ Specifies the repository containing the compiler sources
-         ,configLocalBin            :: !(Path Abs Dir)
-         -- ^ Directory we should install executables into
-         ,configRequireStackVersion :: !VersionRange
-         -- ^ Require a version of Stack within this range.
-         ,configJobs                :: !Int
-         -- ^ How many concurrent jobs to run, defaults to number of capabilities
-         ,configOverrideGccPath     :: !(Maybe (Path Abs File))
-         -- ^ Optional gcc override path
-         ,configExtraIncludeDirs    :: ![FilePath]
-         -- ^ --extra-include-dirs arguments
-         ,configExtraLibDirs        :: ![FilePath]
-         -- ^ --extra-lib-dirs arguments
-         ,configCustomPreprocessorExts :: ![Text]
-         -- ^ List of custom preprocessors to complete the hard coded ones
-         ,configConcurrentTests     :: !Bool
-         -- ^ Run test suites concurrently
-         ,configTemplateParams      :: !(Map Text Text)
-         -- ^ Parameters for templates.
-         ,configScmInit             :: !(Maybe SCM)
-         -- ^ Initialize SCM (e.g. git) when creating new projects.
-         ,configGhcOptionsByName    :: !(Map PackageName [Text])
-         -- ^ Additional GHC options to apply to specific packages.
-         ,configGhcOptionsByCat     :: !(Map ApplyGhcOptions [Text])
-         -- ^ Additional GHC options to apply to categories of packages
-         ,configCabalConfigOpts     :: !(Map CabalConfigKey [Text])
-         -- ^ Additional options to be passed to ./Setup.hs configure
-         ,configSetupInfoLocations  :: ![String]
-         -- ^ URLs or paths to stack-setup.yaml files, for finding tools.
-         -- If none present, the default setup-info is used.
-         ,configSetupInfoInline     :: !SetupInfo
-         -- ^ Additional SetupInfo to use to find tools.
-         ,configPvpBounds           :: !PvpBounds
-         -- ^ How PVP upper bounds should be added to packages
-         ,configModifyCodePage      :: !Bool
-         -- ^ Force the code page to UTF-8 on Windows
-         ,configRebuildGhcOptions   :: !Bool
-         -- ^ Rebuild on GHC options changes
-         ,configApplyGhcOptions     :: !ApplyGhcOptions
-         -- ^ Which packages to ghc-options on the command line apply to?
-         ,configAllowNewer          :: !Bool
-         -- ^ Ignore version ranges in .cabal files. Funny naming chosen to
-         -- match cabal.
-         ,configAllowNewerDeps      :: !(Maybe [PackageName])
-         -- ^ Ignore dependency upper and lower bounds only for specified
-         -- packages. No effect unless allow-newer is enabled.
-         ,configDefaultTemplate     :: !(Maybe TemplateName)
-         -- ^ The default template to use when none is specified.
-         -- (If Nothing, the 'default' default template is used.)
-         ,configAllowDifferentUser  :: !Bool
-         -- ^ Allow users other than the Stack root owner to use the Stack
-         -- installation.
-         ,configDumpLogs            :: !DumpLogs
-         -- ^ Dump logs of local non-dependencies when doing a build.
-         ,configProject             :: !(ProjectConfig (Project, Path Abs File))
-         -- ^ Project information and stack.yaml file location
-         ,configAllowLocals         :: !Bool
-         -- ^ Are we allowed to build local packages? The script
-         -- command disallows this.
-         ,configSaveHackageCreds    :: !Bool
-         -- ^ Should we save Hackage credentials to a file?
-         ,configHackageBaseUrl      :: !Text
-         -- ^ Hackage base URL used when uploading packages
-         ,configRunner              :: !Runner
-         ,configPantryConfig        :: !PantryConfig
-         ,configStackRoot           :: !(Path Abs Dir)
-         ,configResolver            :: !(Maybe AbstractResolver)
-         -- ^ Any resolver override from the command line
-         ,configUserStorage         :: !UserStorage
-         -- ^ Database connection pool for user Stack database
-         ,configHideSourcePaths     :: !Bool
-         -- ^ Enable GHC hiding source paths?
-         ,configRecommendUpgrade    :: !Bool
-         -- ^ Recommend a Stack upgrade?
-         ,configNoRunCompile   :: !Bool
-         -- ^ Use --no-run and --compile options when using `stack script`
-         ,configStackDeveloperMode  :: !Bool
-         -- ^ Turn on Stack developer mode for additional messages?
-         }
-
--- | A bit of type safety to ensure we're talking to the right database.
-newtype UserStorage = UserStorage
-  { unUserStorage :: Storage
-  }
-
--- | A bit of type safety to ensure we're talking to the right database.
-newtype ProjectStorage = ProjectStorage
-  { unProjectStorage :: Storage
-  }
-
--- | The project root directory, if in a project.
-configProjectRoot :: Config -> Maybe (Path Abs Dir)
-configProjectRoot c =
-  case configProject c of
-    PCProject (_, fp) -> Just $ parent fp
-    PCGlobalProject -> Nothing
-    PCNoProject _deps -> Nothing
-
--- | Which packages do configure opts apply to?
-data CabalConfigKey
-  = CCKTargets -- ^ See AGOTargets
-  | CCKLocals -- ^ See AGOLocals
-  | CCKEverything -- ^ See AGOEverything
-  | CCKPackage !PackageName -- ^ A specific package
-  deriving (Show, Read, Eq, Ord)
-instance FromJSON CabalConfigKey where
-  parseJSON = withText "CabalConfigKey" parseCabalConfigKey
-instance FromJSONKey CabalConfigKey where
-  fromJSONKey = FromJSONKeyTextParser parseCabalConfigKey
-
-parseCabalConfigKey :: (Monad m, MonadFail m) => Text -> m CabalConfigKey
-parseCabalConfigKey "$targets" = pure CCKTargets
-parseCabalConfigKey "$locals" = pure CCKLocals
-parseCabalConfigKey "$everything" = pure CCKEverything
-parseCabalConfigKey name =
-  case parsePackageName $ T.unpack name of
-    Nothing -> fail $ "Invalid CabalConfigKey: " ++ show name
-    Just x -> pure $ CCKPackage x
-
--- | Which packages do ghc-options on the command line apply to?
-data ApplyGhcOptions = AGOTargets -- ^ all local targets
-                     | AGOLocals -- ^ all local packages, even non-targets
-                     | AGOEverything -- ^ every package
-  deriving (Show, Read, Eq, Ord, Enum, Bounded)
-
-instance FromJSON ApplyGhcOptions where
-    parseJSON = withText "ApplyGhcOptions" $ \t ->
-        case t of
-            "targets" -> pure AGOTargets
-            "locals" -> pure AGOLocals
-            "everything" -> pure AGOEverything
-            _ -> fail $ "Invalid ApplyGhcOptions: " ++ show t
-
-newtype AllowNewerDeps = AllowNewerDeps [PackageName]
-  deriving (Show, Read, Eq, Ord, Generic)
-
-instance Semigroup AllowNewerDeps where
-  (<>) = mappenddefault
-
-instance Monoid AllowNewerDeps where
-  mappend = (<>)
-  mempty = memptydefault
-
-instance FromJSON AllowNewerDeps where
-  parseJSON = fmap (AllowNewerDeps . fmap C.mkPackageName) . parseJSON
-
--- | Which build log files to dump
-data DumpLogs
-  = DumpNoLogs -- ^ don't dump any logfiles
-  | DumpWarningLogs -- ^ dump logfiles containing warnings
-  | DumpAllLogs -- ^ dump all logfiles
-  deriving (Show, Read, Eq, Ord, Enum, Bounded)
-
-instance FromJSON DumpLogs where
-  parseJSON (Bool True) = pure DumpAllLogs
-  parseJSON (Bool False) = pure DumpNoLogs
-  parseJSON v =
-    withText
-      "DumpLogs"
-      (\t ->
-          if | t == "none" -> pure DumpNoLogs
-             | t == "warning" -> pure DumpWarningLogs
-             | t == "all" -> pure DumpAllLogs
-             | otherwise -> fail ("Invalid DumpLogs: " ++ show t))
-      v
-
--- | Controls which version of the environment is used
-data EnvSettings = EnvSettings
-    { esIncludeLocals :: !Bool
-    -- ^ include local project bin directory, GHC_PACKAGE_PATH, etc
-    , esIncludeGhcPackagePath :: !Bool
-    -- ^ include the GHC_PACKAGE_PATH variable
-    , esStackExe :: !Bool
-    -- ^ set the STACK_EXE variable to the current executable name
-    , esLocaleUtf8 :: !Bool
-    -- ^ set the locale to C.UTF-8
-    , esKeepGhcRts :: !Bool
-    -- ^ if True, keep GHCRTS variable in environment
-    }
-    deriving (Show, Eq, Ord)
-
-type AddCommand =
-  ExceptT (RIO Runner ())
-          (Writer (OA.Mod OA.CommandFields (RIO Runner (), GlobalOptsMonoid)))
-          ()
-
-data ExecOpts = ExecOpts
-    { eoCmd :: !SpecialExecCmd
-    , eoArgs :: ![String]
-    , eoExtra :: !ExecOptsExtra
-    } deriving (Show)
-
-data SpecialExecCmd
-    = ExecCmd String
-    | ExecRun
-    | ExecGhc
-    | ExecRunGhc
-    deriving (Show, Eq)
-
-data ExecOptsExtra = ExecOptsExtra
-  { eoEnvSettings :: !EnvSettings
-  , eoPackages :: ![String]
-  , eoRtsOptions :: ![String]
-  , eoCwd :: !(Maybe FilePath)
-  }
-  deriving (Show)
-
-data EvalOpts = EvalOpts
-    { evalArg :: !String
-    , evalExtra :: !ExecOptsExtra
-    } deriving (Show)
-
--- | Parsed global command-line options.
-data GlobalOpts = GlobalOpts
-    { globalReExecVersion :: !(Maybe String) -- ^ Expected re-exec in container version
-    , globalDockerEntrypoint :: !(Maybe DockerEntrypoint)
-      -- ^ Data used when Stack is acting as a Docker entrypoint (internal use only)
-    , globalLogLevel     :: !LogLevel -- ^ Log level
-    , globalTimeInLog    :: !Bool -- ^ Whether to include timings in logs.
-    , globalRSLInLog     :: !Bool -- ^ Whether to include raw snapshot layer (RSL) in logs.
-    , globalConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig'
-    , globalResolver     :: !(Maybe AbstractResolver) -- ^ Resolver override
-    , globalCompiler     :: !(Maybe WantedCompiler) -- ^ Compiler override
-    , globalTerminal     :: !Bool -- ^ We're in a terminal?
-    , globalStylesUpdate :: !StylesUpdate -- ^ SGR (Ansi) codes for styles
-    , globalTermWidth    :: !(Maybe Int) -- ^ Terminal width override
-    , globalStackYaml    :: !StackYamlLoc -- ^ Override project stack.yaml
-    , globalLockFileBehavior :: !LockFileBehavior
-    } deriving (Show)
-
-rslInLogL :: HasRunner env => SimpleGetter env Bool
-rslInLogL = globalOptsL.to globalRSLInLog
-
--- | Location for the project's stack.yaml file.
-data StackYamlLoc
-    = SYLDefault
-    -- ^ Use the standard parent-directory-checking logic
-    | SYLOverride !(Path Abs File)
-    -- ^ Use a specific stack.yaml file provided
-    | SYLNoProject ![PackageIdentifierRevision]
-    -- ^ Do not load up a project, just user configuration. Include
-    -- the given extra dependencies with the resolver.
-    | SYLGlobalProject
-    -- ^ Do not look for a project configuration, and use the implicit global.
-    deriving Show
-
-stackYamlLocL :: HasRunner env => Lens' env StackYamlLoc
-stackYamlLocL = globalOptsL.lens globalStackYaml (\x y -> x { globalStackYaml = y })
-
--- | How to interact with lock files
-data LockFileBehavior
-  = LFBReadWrite
-  -- ^ Read and write lock files
-  | LFBReadOnly
-  -- ^ Read lock files, but do not write them
-  | LFBIgnore
-  -- ^ Entirely ignore lock files
-  | LFBErrorOnWrite
-  -- ^ Error out on trying to write a lock file. This can be used to
-  -- ensure that lock files in a repository already ensure
-  -- reproducible builds.
-  deriving (Show, Enum, Bounded)
-
-lockFileBehaviorL :: HasRunner env => SimpleGetter env LockFileBehavior
-lockFileBehaviorL = globalOptsL.to globalLockFileBehavior
-
--- | Parser for 'LockFileBehavior'
-readLockFileBehavior :: ReadM LockFileBehavior
-readLockFileBehavior = do
-  s <- OA.readerAsk
-  case Map.lookup s m of
-    Just x -> pure x
-    Nothing -> OA.readerError $ "Invalid lock file behavior, valid options: " ++
-                                List.intercalate ", " (Map.keys m)
-  where
-    m = Map.fromList $ map (\x -> (render x, x)) [minBound..maxBound]
-    render LFBReadWrite = "read-write"
-    render LFBReadOnly = "read-only"
-    render LFBIgnore = "ignore"
-    render LFBErrorOnWrite = "error-on-write"
-
--- | Project configuration information. Not every run of Stack has a
--- true local project; see constructors below.
-data ProjectConfig a
-    = PCProject a
-    -- ^ Normal run: we want a project, and have one. This comes from
-    -- either 'SYLDefault' or 'SYLOverride'.
-    | PCGlobalProject
-    -- ^ No project was found when using 'SYLDefault'. Instead, use
-    -- the implicit global.
-    | PCNoProject ![PackageIdentifierRevision]
-    -- ^ Use a no project run. This comes from 'SYLNoProject'.
-
--- | Parsed global command-line options monoid.
-data GlobalOptsMonoid = GlobalOptsMonoid
-    { globalMonoidReExecVersion :: !(First String) -- ^ Expected re-exec in container version
-    , globalMonoidDockerEntrypoint :: !(First DockerEntrypoint)
-      -- ^ Data used when Stack is acting as a Docker entrypoint (internal use only)
-    , globalMonoidLogLevel     :: !(First LogLevel) -- ^ Log level
-    , globalMonoidTimeInLog    :: !FirstTrue -- ^ Whether to include timings in logs.
-    , globalMonoidRSLInLog     :: !FirstFalse -- ^ Whether to include raw snapshot layer (RSL) in logs.
-    , globalMonoidConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig'
-    , globalMonoidResolver     :: !(First (Unresolved AbstractResolver)) -- ^ Resolver override
-    , globalMonoidResolverRoot :: !(First FilePath) -- ^ root directory for resolver relative path
-    , globalMonoidCompiler     :: !(First WantedCompiler) -- ^ Compiler override
-    , globalMonoidTerminal     :: !(First Bool) -- ^ We're in a terminal?
-    , globalMonoidStyles       :: !StylesUpdate -- ^ Stack's output styles
-    , globalMonoidTermWidth    :: !(First Int) -- ^ Terminal width override
-    , globalMonoidStackYaml    :: !(First FilePath) -- ^ Override project stack.yaml
-    , globalMonoidLockFileBehavior :: !(First LockFileBehavior) -- ^ See 'globalLockFileBehavior'
-    } deriving Generic
-
-instance Semigroup GlobalOptsMonoid where
-    (<>) = mappenddefault
-
-instance Monoid GlobalOptsMonoid where
-    mempty = memptydefault
-    mappend = (<>)
-
--- | Default logging level should be something useful but not crazy.
-defaultLogLevel :: LogLevel
-defaultLogLevel = LevelInfo
-
-readColorWhen :: ReadM ColorWhen
-readColorWhen = do
-    s <- OA.readerAsk
-    case s of
-        "never" -> pure ColorNever
-        "always" -> pure ColorAlways
-        "auto" -> pure ColorAuto
-        _ -> OA.readerError "Expected values of color option are 'never', 'always', or 'auto'."
-
-readStyles :: ReadM StylesUpdate
-readStyles = parseStylesUpdateFromString <$> OA.readerAsk
-
--- | A superset of 'Config' adding information on how to build code. The reason
--- for this breakdown is because we will need some of the information from
--- 'Config' in order to determine the values here.
---
--- These are the components which know nothing about local configuration.
-data BuildConfig = BuildConfig
-    { bcConfig     :: !Config
-    , bcSMWanted :: !SMWanted
-    , bcExtraPackageDBs :: ![Path Abs Dir]
-      -- ^ Extra package databases
-    , bcStackYaml  :: !(Path Abs File)
-      -- ^ Location of the stack.yaml file.
-      --
-      -- Note: if the STACK_YAML environment variable is used, this may be
-      -- different from projectRootL </> "stack.yaml" if a different file
-      -- name is used.
-    , bcProjectStorage :: !ProjectStorage
-    -- ^ Database connection pool for project Stack database
-    , bcCurator :: !(Maybe Curator)
-    }
-
-stackYamlL :: HasBuildConfig env => Lens' env (Path Abs File)
-stackYamlL = buildConfigL.lens bcStackYaml (\x y -> x { bcStackYaml = y })
-
--- | Directory containing the project's stack.yaml file
-projectRootL :: HasBuildConfig env => Getting r env (Path Abs Dir)
-projectRootL = stackYamlL.to parent
-
--- | Configuration after the environment has been setup.
-data EnvConfig = EnvConfig
-    {envConfigBuildConfig :: !BuildConfig
-    ,envConfigBuildOptsCLI :: !BuildOptsCLI
-    ,envConfigSourceMap :: !SourceMap
-    ,envConfigSourceMapHash :: !SourceMapHash
-    ,envConfigCompilerPaths :: !CompilerPaths
-    }
-
-ppGPD :: MonadIO m => ProjectPackage -> m GenericPackageDescription
-ppGPD = liftIO . cpGPD . ppCommon
-
--- | Root directory for the given 'ProjectPackage'
-ppRoot :: ProjectPackage -> Path Abs Dir
-ppRoot = parent . ppCabalFP
-
--- | All components available in the given 'ProjectPackage'
-ppComponents :: MonadIO m => ProjectPackage -> m (Set NamedComponent)
-ppComponents pp = do
-  gpd <- ppGPD pp
-  pure $ Set.fromList $ concat
-    [ maybe []  (const [CLib]) (C.condLibrary gpd)
-    , go CExe   (fst <$> C.condExecutables gpd)
-    , go CTest  (fst <$> C.condTestSuites gpd)
-    , go CBench (fst <$> C.condBenchmarks gpd)
-    ]
-  where
-    go :: (T.Text -> NamedComponent)
-       -> [C.UnqualComponentName]
-       -> [NamedComponent]
-    go wrapper = map (wrapper . T.pack . C.unUnqualComponentName)
-
--- | Version for the given 'ProjectPackage
-ppVersion :: MonadIO m => ProjectPackage -> m Version
-ppVersion = fmap gpdVersion . ppGPD
-
--- | A project is a collection of packages. We can have multiple stack.yaml
--- files, but only one of them may contain project information.
-data Project = Project
-    { projectUserMsg :: !(Maybe String)
-    -- ^ A warning message to display to the user when the auto generated
-    -- config may have issues.
-    , projectPackages :: ![RelFilePath]
-    -- ^ Packages which are actually part of the project (as opposed
-    -- to dependencies).
-    , projectDependencies :: ![RawPackageLocation]
-    -- ^ Dependencies defined within the stack.yaml file, to be
-    -- applied on top of the snapshot.
-    , projectFlags :: !(Map PackageName (Map FlagName Bool))
-    -- ^ Flags to be applied on top of the snapshot flags.
-    , projectResolver :: !RawSnapshotLocation
-    -- ^ How we resolve which @Snapshot@ to use
-    , projectCompiler :: !(Maybe WantedCompiler)
-    -- ^ Override the compiler in 'projectResolver'
-    , projectExtraPackageDBs :: ![FilePath]
-    , projectCurator :: !(Maybe Curator)
-    -- ^ Extra configuration intended exclusively for usage by the
-    -- curator tool. In other words, this is /not/ part of the
-    -- documented and exposed Stack API. SUBJECT TO CHANGE.
-    , projectDropPackages :: !(Set PackageName)
-    -- ^ Packages to drop from the 'projectResolver'.
-    }
-  deriving Show
-
-instance ToJSON Project where
-    -- Expanding the constructor fully to ensure we don't miss any fields.
-    toJSON (Project userMsg packages extraDeps flags resolver mcompiler extraPackageDBs mcurator drops) = object $ concat
-      [ maybe [] (\cv -> ["compiler" .= cv]) mcompiler
-      , maybe [] (\msg -> ["user-message" .= msg]) userMsg
-      , if null extraPackageDBs then [] else ["extra-package-dbs" .= extraPackageDBs]
-      , if null extraDeps then [] else ["extra-deps" .= extraDeps]
-      , if Map.null flags then [] else ["flags" .= fmap toCabalStringMap (toCabalStringMap flags)]
-      , ["packages" .= packages]
-      , ["resolver" .= resolver]
-      , maybe [] (\c -> ["curator" .= c]) mcurator
-      , if Set.null drops then [] else ["drop-packages" .= Set.map CabalString drops]
-      ]
-
--- | Extra configuration intended exclusively for usage by the
--- curator tool. In other words, this is /not/ part of the
--- documented and exposed Stack API. SUBJECT TO CHANGE.
-data Curator = Curator
-  { curatorSkipTest :: !(Set PackageName)
-  , curatorExpectTestFailure :: !(Set PackageName)
-  , curatorSkipBenchmark :: !(Set PackageName)
-  , curatorExpectBenchmarkFailure :: !(Set PackageName)
-  , curatorSkipHaddock :: !(Set PackageName)
-  , curatorExpectHaddockFailure :: !(Set PackageName)
-  }
-  deriving Show
-instance ToJSON Curator where
-  toJSON c = object
-    [ "skip-test" .= Set.map CabalString (curatorSkipTest c)
-    , "expect-test-failure" .= Set.map CabalString (curatorExpectTestFailure c)
-    , "skip-bench" .= Set.map CabalString (curatorSkipBenchmark c)
-    , "expect-benchmark-failure" .= Set.map CabalString (curatorExpectTestFailure c)
-    , "skip-haddock" .= Set.map CabalString (curatorSkipHaddock c)
-    , "expect-test-failure" .= Set.map CabalString (curatorExpectHaddockFailure c)
-    ]
-instance FromJSON (WithJSONWarnings Curator) where
-  parseJSON = withObjectWarnings "Curator" $ \o -> Curator
-    <$> fmap (Set.map unCabalString) (o ..:? "skip-test" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "expect-test-failure" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "skip-bench" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "expect-benchmark-failure" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "skip-haddock" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "expect-haddock-failure" ..!= mempty)
-
--- An uninterpreted representation of configuration options.
--- Configurations may be "cascaded" using mappend (left-biased).
-data ConfigMonoid =
-  ConfigMonoid
-    { configMonoidStackRoot          :: !(First (Path Abs Dir))
-    -- ^ See: 'clStackRoot'
-    , configMonoidWorkDir            :: !(First (Path Rel Dir))
-    -- ^ See: 'configWorkDir'.
-    , configMonoidBuildOpts          :: !BuildOptsMonoid
-    -- ^ build options.
-    , configMonoidDockerOpts         :: !DockerOptsMonoid
-    -- ^ Docker options.
-    , configMonoidNixOpts            :: !NixOptsMonoid
-    -- ^ Options for the execution environment (nix-shell or container)
-    , configMonoidConnectionCount    :: !(First Int)
-    -- ^ See: 'configConnectionCount'
-    , configMonoidHideTHLoading      :: !FirstTrue
-    -- ^ See: 'configHideTHLoading'
-    , configMonoidPrefixTimestamps   :: !(First Bool)
-    -- ^ See: 'configPrefixTimestamps'
-    , configMonoidLatestSnapshot     :: !(First Text)
-    -- ^ See: 'configLatestSnapshot'
-    , configMonoidPackageIndex     :: !(First PackageIndexConfig)
-    -- ^ See: 'withPantryConfig'
-    , configMonoidPackageIndices     :: !(First [PackageIndexConfig])
-    -- ^ Deprecated in favour of package-index
-    , configMonoidSystemGHC          :: !(First Bool)
-    -- ^ See: 'configSystemGHC'
-    ,configMonoidInstallGHC          :: !FirstTrue
-    -- ^ See: 'configInstallGHC'
-    ,configMonoidSkipGHCCheck        :: !FirstFalse
-    -- ^ See: 'configSkipGHCCheck'
-    ,configMonoidSkipMsys            :: !FirstFalse
-    -- ^ See: 'configSkipMsys'
-    ,configMonoidCompilerCheck       :: !(First VersionCheck)
-    -- ^ See: 'configCompilerCheck'
-    ,configMonoidCompilerRepository  :: !(First CompilerRepository)
-    -- ^ See: 'configCompilerRepository'
-    ,configMonoidRequireStackVersion :: !IntersectingVersionRange
-    -- ^ See: 'configRequireStackVersion'
-    ,configMonoidArch                :: !(First String)
-    -- ^ Used for overriding the platform
-    ,configMonoidGHCVariant          :: !(First GHCVariant)
-    -- ^ Used for overriding the platform
-    ,configMonoidGHCBuild            :: !(First CompilerBuild)
-    -- ^ Used for overriding the GHC build
-    ,configMonoidJobs                :: !(First Int)
-    -- ^ See: 'configJobs'
-    ,configMonoidExtraIncludeDirs    :: ![FilePath]
-    -- ^ See: 'configExtraIncludeDirs'
-    ,configMonoidExtraLibDirs        :: ![FilePath]
-    -- ^ See: 'configExtraLibDirs'
-    ,configMonoidCustomPreprocessorExts :: ![Text]
-    -- ^ See: 'configCustomPreprocessorExts'
-    , configMonoidOverrideGccPath    :: !(First (Path Abs File))
-    -- ^ Allow users to override the path to gcc
-    ,configMonoidOverrideHpack       :: !(First FilePath)
-    -- ^ Use Hpack executable (overrides bundled Hpack)
-    ,configMonoidConcurrentTests     :: !(First Bool)
-    -- ^ See: 'configConcurrentTests'
-    ,configMonoidLocalBinPath        :: !(First FilePath)
-    -- ^ Used to override the binary installation dir
-    ,configMonoidTemplateParameters  :: !(Map Text Text)
-    -- ^ Template parameters.
-    ,configMonoidScmInit             :: !(First SCM)
-    -- ^ Initialize SCM (e.g. git init) when making new projects?
-    ,configMonoidGhcOptionsByName    :: !(MonoidMap PackageName (Monoid.Dual [Text]))
-    -- ^ See 'configGhcOptionsByName'. Uses 'Monoid.Dual' so that
-    -- options from the configs on the right come first, so that they
-    -- can be overridden.
-    ,configMonoidGhcOptionsByCat     :: !(MonoidMap ApplyGhcOptions (Monoid.Dual [Text]))
-    -- ^ See 'configGhcOptionsAll'. Uses 'Monoid.Dual' so that options
-    -- from the configs on the right come first, so that they can be
-    -- overridden.
-    ,configMonoidCabalConfigOpts     :: !(MonoidMap CabalConfigKey (Monoid.Dual [Text]))
-    -- ^ See 'configCabalConfigOpts'.
-    ,configMonoidExtraPath           :: ![Path Abs Dir]
-    -- ^ Additional paths to search for executables in
-    ,configMonoidSetupInfoLocations  :: ![String]
-    -- ^ See 'configSetupInfoLocations'
-    ,configMonoidSetupInfoInline     :: !SetupInfo
-    -- ^ See 'configSetupInfoInline'
-    ,configMonoidLocalProgramsBase   :: !(First (Path Abs Dir))
-    -- ^ Override the default local programs dir, where e.g. GHC is installed.
-    ,configMonoidPvpBounds           :: !(First PvpBounds)
-    -- ^ See 'configPvpBounds'
-    ,configMonoidModifyCodePage      :: !FirstTrue
-    -- ^ See 'configModifyCodePage'
-    ,configMonoidRebuildGhcOptions   :: !FirstFalse
-    -- ^ See 'configMonoidRebuildGhcOptions'
-    ,configMonoidApplyGhcOptions     :: !(First ApplyGhcOptions)
-    -- ^ See 'configApplyGhcOptions'
-    ,configMonoidAllowNewer          :: !(First Bool)
-    -- ^ See 'configMonoidAllowNewer'
-    ,configMonoidAllowNewerDeps      :: !(Maybe AllowNewerDeps)
-    -- ^ See 'configMonoidAllowNewerDeps'
-    ,configMonoidDefaultTemplate     :: !(First TemplateName)
-    -- ^ The default template to use when none is specified.
-    -- (If Nothing, the 'default' default template is used.)
-    , configMonoidAllowDifferentUser :: !(First Bool)
-    -- ^ Allow users other than the Stack root owner to use the Stack
-    -- installation.
-    , configMonoidDumpLogs           :: !(First DumpLogs)
-    -- ^ See 'configDumpLogs'
-    , configMonoidSaveHackageCreds   :: !(First Bool)
-    -- ^ See 'configSaveHackageCreds'
-    , configMonoidHackageBaseUrl     :: !(First Text)
-    -- ^ See 'configHackageBaseUrl'
-    , configMonoidColorWhen          :: !(First ColorWhen)
-    -- ^ When to use 'ANSI' colors
-    , configMonoidStyles             :: !StylesUpdate
-    , configMonoidHideSourcePaths    :: !FirstTrue
-    -- ^ See 'configHideSourcePaths'
-    , configMonoidRecommendUpgrade   :: !FirstTrue
-    -- ^ See 'configRecommendUpgrade'
-    , configMonoidCasaRepoPrefix     :: !(First CasaRepoPrefix)
-    , configMonoidSnapshotLocation :: !(First Text)
-    -- ^ Custom location of LTS/Nightly snapshots
-    , configMonoidNoRunCompile  :: !FirstFalse
-    -- ^ See: 'configNoRunCompile'
-    , configMonoidStackDeveloperMode :: !(First Bool)
-    -- ^ See 'configStackDeveloperMode'
-    }
-  deriving (Show, Generic)
-
-instance Semigroup ConfigMonoid where
-    (<>) = mappenddefault
-
-instance Monoid ConfigMonoid where
-    mempty = memptydefault
-    mappend = (<>)
-
-parseConfigMonoid :: Path Abs Dir -> Value -> Yaml.Parser (WithJSONWarnings ConfigMonoid)
-parseConfigMonoid = withObjectWarnings "ConfigMonoid" . parseConfigMonoidObject
-
--- | Parse a partial configuration.  Used both to parse both a standalone config
--- file and a project file, so that a sub-parser is not required, which would interfere with
--- warnings for missing fields.
-parseConfigMonoidObject :: Path Abs Dir -> Object -> WarningParser ConfigMonoid
-parseConfigMonoidObject rootDir obj = do
-    -- Parsing 'stackRoot' from 'stackRoot'/config.yaml would be nonsensical
-    let configMonoidStackRoot = First Nothing
-    configMonoidWorkDir <- First <$> obj ..:? configMonoidWorkDirName
-    configMonoidBuildOpts <- jsonSubWarnings (obj ..:? configMonoidBuildOptsName ..!= mempty)
-    configMonoidDockerOpts <- jsonSubWarnings (obj ..:? configMonoidDockerOptsName ..!= mempty)
-    configMonoidNixOpts <- jsonSubWarnings (obj ..:? configMonoidNixOptsName ..!= mempty)
-    configMonoidConnectionCount <- First <$> obj ..:? configMonoidConnectionCountName
-    configMonoidHideTHLoading <- FirstTrue <$> obj ..:? configMonoidHideTHLoadingName
-    configMonoidPrefixTimestamps <- First <$> obj ..:? configMonoidPrefixTimestampsName
-
-    murls :: Maybe Value <- obj ..:? configMonoidUrlsName
-    configMonoidLatestSnapshot <-
-      case murls of
-        Nothing -> pure $ First Nothing
-        Just urls -> jsonSubWarnings $ lift $ withObjectWarnings
-          "urls"
-          (\o -> First <$> o ..:? "latest-snapshot" :: WarningParser (First Text))
-          urls
-
-    configMonoidPackageIndex <- First <$> jsonSubWarningsT (obj ..:?  configMonoidPackageIndexName)
-    configMonoidPackageIndices <- First <$> jsonSubWarningsTT (obj ..:?  configMonoidPackageIndicesName)
-    configMonoidSystemGHC <- First <$> obj ..:? configMonoidSystemGHCName
-    configMonoidInstallGHC <- FirstTrue <$> obj ..:? configMonoidInstallGHCName
-    configMonoidSkipGHCCheck <- FirstFalse <$> obj ..:? configMonoidSkipGHCCheckName
-    configMonoidSkipMsys <- FirstFalse <$> obj ..:? configMonoidSkipMsysName
-    configMonoidRequireStackVersion <- IntersectingVersionRange . unVersionRangeJSON <$> (
-                                       obj ..:? configMonoidRequireStackVersionName
-                                           ..!= VersionRangeJSON anyVersion)
-    configMonoidArch <- First <$> obj ..:? configMonoidArchName
-    configMonoidGHCVariant <- First <$> obj ..:? configMonoidGHCVariantName
-    configMonoidGHCBuild <- First <$> obj ..:? configMonoidGHCBuildName
-    configMonoidJobs <- First <$> obj ..:? configMonoidJobsName
-    configMonoidExtraIncludeDirs <- map (toFilePath rootDir FilePath.</>) <$>
-        obj ..:?  configMonoidExtraIncludeDirsName ..!= []
-    configMonoidExtraLibDirs <- map (toFilePath rootDir FilePath.</>) <$>
-        obj ..:?  configMonoidExtraLibDirsName ..!= []
-    configMonoidCustomPreprocessorExts <- obj ..:?  configMonoidCustomPreprocessorExtsName ..!= []
-    configMonoidOverrideGccPath <- First <$> obj ..:? configMonoidOverrideGccPathName
-    configMonoidOverrideHpack <- First <$> obj ..:? configMonoidOverrideHpackName
-    configMonoidConcurrentTests <- First <$> obj ..:? configMonoidConcurrentTestsName
-    configMonoidLocalBinPath <- First <$> obj ..:? configMonoidLocalBinPathName
-    templates <- obj ..:? "templates"
-    (configMonoidScmInit,configMonoidTemplateParameters) <-
-      case templates of
-        Nothing -> pure (First Nothing,M.empty)
-        Just tobj -> do
-          scmInit <- tobj ..:? configMonoidScmInitName
-          params <- tobj ..:? configMonoidTemplateParametersName
-          pure (First scmInit,fromMaybe M.empty params)
-    configMonoidCompilerCheck <- First <$> obj ..:? configMonoidCompilerCheckName
-    configMonoidCompilerRepository <- First <$> (obj ..:? configMonoidCompilerRepositoryName)
-
-    options <- Map.map unGhcOptions <$> obj ..:? configMonoidGhcOptionsName ..!= mempty
-
-    optionsEverything <-
-      case (Map.lookup GOKOldEverything options, Map.lookup GOKEverything options) of
-        (Just _, Just _) -> fail "Cannot specify both `*` and `$everything` GHC options"
-        (Nothing, Just x) -> pure x
-        (Just x, Nothing) -> do
-          tell "The `*` ghc-options key is not recommended. Consider using $locals, or if really needed, $everything"
-          pure x
-        (Nothing, Nothing) -> pure []
-
-    let configMonoidGhcOptionsByCat = coerce $ Map.fromList
-          [ (AGOEverything, optionsEverything)
-          , (AGOLocals, Map.findWithDefault [] GOKLocals options)
-          , (AGOTargets, Map.findWithDefault [] GOKTargets options)
-          ]
-
-        configMonoidGhcOptionsByName = coerce $ Map.fromList
-            [(name, opts) | (GOKPackage name, opts) <- Map.toList options]
-
-    configMonoidCabalConfigOpts' <- obj ..:? "configure-options" ..!= mempty
-    let configMonoidCabalConfigOpts = coerce (configMonoidCabalConfigOpts' :: Map CabalConfigKey [Text])
-
-    configMonoidExtraPath <- obj ..:? configMonoidExtraPathName ..!= []
-    configMonoidSetupInfoLocations <- obj ..:? configMonoidSetupInfoLocationsName ..!= []
-    configMonoidSetupInfoInline <- jsonSubWarningsT (obj ..:? configMonoidSetupInfoInlineName) ..!= mempty
-    configMonoidLocalProgramsBase <- First <$> obj ..:? configMonoidLocalProgramsBaseName
-    configMonoidPvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName
-    configMonoidModifyCodePage <- FirstTrue <$> obj ..:? configMonoidModifyCodePageName
-    configMonoidRebuildGhcOptions <- FirstFalse <$> obj ..:? configMonoidRebuildGhcOptionsName
-    configMonoidApplyGhcOptions <- First <$> obj ..:? configMonoidApplyGhcOptionsName
-    configMonoidAllowNewer <- First <$> obj ..:? configMonoidAllowNewerName
-    configMonoidAllowNewerDeps <- obj ..:? configMonoidAllowNewerDepsName
-    configMonoidDefaultTemplate <- First <$> obj ..:? configMonoidDefaultTemplateName
-    configMonoidAllowDifferentUser <- First <$> obj ..:? configMonoidAllowDifferentUserName
-    configMonoidDumpLogs <- First <$> obj ..:? configMonoidDumpLogsName
-    configMonoidSaveHackageCreds <- First <$> obj ..:? configMonoidSaveHackageCredsName
-    configMonoidHackageBaseUrl <- First <$> obj ..:? configMonoidHackageBaseUrlName
-
-    configMonoidColorWhenUS <- obj ..:? configMonoidColorWhenUSName
-    configMonoidColorWhenGB <- obj ..:? configMonoidColorWhenGBName
-    let configMonoidColorWhen =  First $   configMonoidColorWhenUS
-                                       <|> configMonoidColorWhenGB
-
-    configMonoidStylesUS <- obj ..:? configMonoidStylesUSName
-    configMonoidStylesGB <- obj ..:? configMonoidStylesGBName
-    let configMonoidStyles = fromMaybe mempty $   configMonoidStylesUS
-                                              <|> configMonoidStylesGB
-
-    configMonoidHideSourcePaths <- FirstTrue <$> obj ..:? configMonoidHideSourcePathsName
-    configMonoidRecommendUpgrade <- FirstTrue <$> obj ..:? configMonoidRecommendUpgradeName
-
-    configMonoidCasaRepoPrefix <- First <$> obj ..:? configMonoidCasaRepoPrefixName
-    configMonoidSnapshotLocation <- First <$> obj ..:? configMonoidSnapshotLocationName
-    configMonoidNoRunCompile <- FirstFalse <$> obj ..:? configMonoidNoRunCompileName
-
-    configMonoidStackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName
-
-    pure ConfigMonoid {..}
-
-configMonoidWorkDirName :: Text
-configMonoidWorkDirName = "work-dir"
-
-configMonoidBuildOptsName :: Text
-configMonoidBuildOptsName = "build"
-
-configMonoidDockerOptsName :: Text
-configMonoidDockerOptsName = "docker"
-
-configMonoidNixOptsName :: Text
-configMonoidNixOptsName = "nix"
-
-configMonoidConnectionCountName :: Text
-configMonoidConnectionCountName = "connection-count"
-
-configMonoidHideTHLoadingName :: Text
-configMonoidHideTHLoadingName = "hide-th-loading"
-
-configMonoidPrefixTimestampsName :: Text
-configMonoidPrefixTimestampsName = "build-output-timestamps"
-
-configMonoidUrlsName :: Text
-configMonoidUrlsName = "urls"
-
-configMonoidPackageIndexName :: Text
-configMonoidPackageIndexName = "package-index"
-
--- Deprecated in favour of package-index
-configMonoidPackageIndicesName :: Text
-configMonoidPackageIndicesName = "package-indices"
-
-configMonoidSystemGHCName :: Text
-configMonoidSystemGHCName = "system-ghc"
-
-configMonoidInstallGHCName :: Text
-configMonoidInstallGHCName = "install-ghc"
-
-configMonoidSkipGHCCheckName :: Text
-configMonoidSkipGHCCheckName = "skip-ghc-check"
-
-configMonoidSkipMsysName :: Text
-configMonoidSkipMsysName = "skip-msys"
-
-configMonoidRequireStackVersionName :: Text
-configMonoidRequireStackVersionName = "require-stack-version"
-
-configMonoidArchName :: Text
-configMonoidArchName = "arch"
-
-configMonoidGHCVariantName :: Text
-configMonoidGHCVariantName = "ghc-variant"
-
-configMonoidGHCBuildName :: Text
-configMonoidGHCBuildName = "ghc-build"
-
-configMonoidJobsName :: Text
-configMonoidJobsName = "jobs"
-
-configMonoidExtraIncludeDirsName :: Text
-configMonoidExtraIncludeDirsName = "extra-include-dirs"
-
-configMonoidExtraLibDirsName :: Text
-configMonoidExtraLibDirsName = "extra-lib-dirs"
-
-configMonoidCustomPreprocessorExtsName  :: Text
-configMonoidCustomPreprocessorExtsName  = "custom-preprocessor-extensions"
-
-configMonoidOverrideGccPathName :: Text
-configMonoidOverrideGccPathName = "with-gcc"
-
-configMonoidOverrideHpackName :: Text
-configMonoidOverrideHpackName = "with-hpack"
-
-configMonoidConcurrentTestsName :: Text
-configMonoidConcurrentTestsName = "concurrent-tests"
-
-configMonoidLocalBinPathName :: Text
-configMonoidLocalBinPathName = "local-bin-path"
-
-configMonoidScmInitName :: Text
-configMonoidScmInitName = "scm-init"
-
-configMonoidTemplateParametersName :: Text
-configMonoidTemplateParametersName = "params"
-
-configMonoidCompilerCheckName :: Text
-configMonoidCompilerCheckName = "compiler-check"
-
-configMonoidCompilerRepositoryName :: Text
-configMonoidCompilerRepositoryName = "compiler-repository"
-
-configMonoidGhcOptionsName :: Text
-configMonoidGhcOptionsName = "ghc-options"
-
-configMonoidExtraPathName :: Text
-configMonoidExtraPathName = "extra-path"
-
-configMonoidSetupInfoLocationsName :: Text
-configMonoidSetupInfoLocationsName = "setup-info-locations"
-
-configMonoidSetupInfoInlineName :: Text
-configMonoidSetupInfoInlineName = "setup-info"
-
-configMonoidLocalProgramsBaseName :: Text
-configMonoidLocalProgramsBaseName = "local-programs-path"
-
-configMonoidPvpBoundsName :: Text
-configMonoidPvpBoundsName = "pvp-bounds"
-
-configMonoidModifyCodePageName :: Text
-configMonoidModifyCodePageName = "modify-code-page"
-
-configMonoidRebuildGhcOptionsName :: Text
-configMonoidRebuildGhcOptionsName = "rebuild-ghc-options"
-
-configMonoidApplyGhcOptionsName :: Text
-configMonoidApplyGhcOptionsName = "apply-ghc-options"
-
-configMonoidAllowNewerName :: Text
-configMonoidAllowNewerName = "allow-newer"
-
-configMonoidAllowNewerDepsName :: Text
-configMonoidAllowNewerDepsName = "allow-newer-deps"
-
-configMonoidDefaultTemplateName :: Text
-configMonoidDefaultTemplateName = "default-template"
-
-configMonoidAllowDifferentUserName :: Text
-configMonoidAllowDifferentUserName = "allow-different-user"
-
-configMonoidDumpLogsName :: Text
-configMonoidDumpLogsName = "dump-logs"
-
-configMonoidSaveHackageCredsName :: Text
-configMonoidSaveHackageCredsName = "save-hackage-creds"
-
-configMonoidHackageBaseUrlName :: Text
-configMonoidHackageBaseUrlName = "hackage-base-url"
-
-configMonoidColorWhenUSName :: Text
-configMonoidColorWhenUSName = "color"
-
-configMonoidColorWhenGBName :: Text
-configMonoidColorWhenGBName = "colour"
-
-configMonoidStylesUSName :: Text
-configMonoidStylesUSName = "stack-colors"
-
-configMonoidStylesGBName :: Text
-configMonoidStylesGBName = "stack-colours"
-
-configMonoidHideSourcePathsName :: Text
-configMonoidHideSourcePathsName = "hide-source-paths"
-
-configMonoidRecommendUpgradeName :: Text
-configMonoidRecommendUpgradeName = "recommend-stack-upgrade"
-
-configMonoidCasaRepoPrefixName :: Text
-configMonoidCasaRepoPrefixName = "casa-repo-prefix"
-
-configMonoidSnapshotLocationName :: Text
-configMonoidSnapshotLocationName = "snapshot-location-base"
-
-configMonoidNoRunCompileName :: Text
-configMonoidNoRunCompileName = "script-no-run-compile"
-
-configMonoidStackDeveloperModeName :: Text
-configMonoidStackDeveloperModeName = "stack-developer-mode"
-
-packageIndicesWarning :: String
-packageIndicesWarning =
-    "The 'package-indices' key is deprecated in favour of 'package-index'."
-
-resolveOptions :: StyleDoc
-resolveOptions =
-     flow "This may be resolved by:"
-  <> line
-  <> bulletedList
-       [ fillSep
-           [ "Using"
-           , style Shell "--omit-packages"
-           , "to exclude mismatching package(s)."
-           ]
-       , fillSep
-           [ "Using"
-           , style Shell "--resolver"
-           , "to specify a matching snapshot/resolver."
-           ]
-       ]
-
--- | Get the URL to request the information on the latest snapshots
-askLatestSnapshotUrl :: (MonadReader env m, HasConfig env) => m Text
-askLatestSnapshotUrl = view $ configL.to configLatestSnapshot
-
--- | @".stack-work"@
-workDirL :: HasConfig env => Lens' env (Path Rel Dir)
-workDirL = configL.lens configWorkDir (\x y -> x { configWorkDir = y })
-
--- | @STACK_ROOT\/hooks\/@
-hooksDir :: HasConfig env => RIO env (Path Abs Dir)
-hooksDir = do
-  sr <- view $ configL.to configStackRoot
-  pure (sr </> [reldir|hooks|])
-
--- | @STACK_ROOT\/hooks\/ghc-install.sh@
-ghcInstallHook :: HasConfig env => RIO env (Path Abs File)
-ghcInstallHook = do
-  hd <- hooksDir
-  pure (hd </> [relfile|ghc-install.sh|])
-
--- | Per-project work dir
-getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir)
-getProjectWorkDir = do
-    root    <- view projectRootL
-    workDir <- view workDirL
-    pure (root </> workDir)
-
--- | Relative directory for the platform identifier
-platformOnlyRelDir
-    :: (MonadReader env m, HasPlatform env, MonadThrow m)
-    => m (Path Rel Dir)
-platformOnlyRelDir = do
-    platform <- view platformL
-    platformVariant <- view platformVariantL
-    parseRelDir (Distribution.Text.display platform ++ platformVariantSuffix platformVariant)
-
--- | Directory containing snapshots
-snapshotsDir :: (MonadReader env m, HasEnvConfig env, MonadThrow m) => m (Path Abs Dir)
-snapshotsDir = do
-    root <- view stackRootL
-    platform <- platformGhcRelDir
-    pure $ root </> relDirSnapshots </> platform
-
--- | Installation root for dependencies
-installationRootDeps :: (HasEnvConfig env) => RIO env (Path Abs Dir)
-installationRootDeps = do
-    root <- view stackRootL
-    -- TODO: also useShaPathOnWindows here, once #1173 is resolved.
-    psc <- platformSnapAndCompilerRel
-    pure $ root </> relDirSnapshots </> psc
-
--- | Installation root for locals
-installationRootLocal :: (HasEnvConfig env) => RIO env (Path Abs Dir)
-installationRootLocal = do
-    workDir <- getProjectWorkDir
-    psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel
-    pure $ workDir </> relDirInstall </> psc
-
--- | Installation root for compiler tools
-bindirCompilerTools :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir)
-bindirCompilerTools = do
-    config <- view configL
-    platform <- platformGhcRelDir
-    compilerVersion <- view actualCompilerVersionL
-    compiler <- parseRelDir $ compilerVersionString compilerVersion
-    pure $
-        view stackRootL config </>
-        relDirCompilerTools </>
-        platform </>
-        compiler </>
-        bindirSuffix
-
--- | Hoogle directory.
-hoogleRoot :: (HasEnvConfig env) => RIO env (Path Abs Dir)
-hoogleRoot = do
-    workDir <- getProjectWorkDir
-    psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel
-    pure $ workDir </> relDirHoogle </> psc
-
--- | Get the hoogle database path.
-hoogleDatabasePath :: (HasEnvConfig env) => RIO env (Path Abs File)
-hoogleDatabasePath = do
-    dir <- hoogleRoot
-    pure (dir </> relFileDatabaseHoo)
-
--- | Path for platform followed by snapshot name followed by compiler
--- name.
-platformSnapAndCompilerRel
-    :: (HasEnvConfig env)
-    => RIO env (Path Rel Dir)
-platformSnapAndCompilerRel = do
-    platform <- platformGhcRelDir
-    smh <- view $ envConfigL.to envConfigSourceMapHash
-    name <- smRelDir smh
-    ghc <- compilerVersionDir
-    useShaPathOnWindows (platform </> name </> ghc)
-
--- | Relative directory for the platform and GHC identifier
-platformGhcRelDir
-    :: (MonadReader env m, HasEnvConfig env, MonadThrow m)
-    => m (Path Rel Dir)
-platformGhcRelDir = do
-    cp <- view compilerPathsL
-    let cbSuffix = compilerBuildSuffix $ cpBuild cp
-    verOnly <- platformGhcVerOnlyRelDirStr
-    parseRelDir (mconcat [ verOnly, cbSuffix ])
-
--- | Relative directory for the platform and GHC identifier without GHC bindist build
-platformGhcVerOnlyRelDir
-    :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m)
-    => m (Path Rel Dir)
-platformGhcVerOnlyRelDir =
-    parseRelDir =<< platformGhcVerOnlyRelDirStr
-
--- | Relative directory for the platform and GHC identifier without GHC bindist build
--- (before parsing into a Path)
-platformGhcVerOnlyRelDirStr
-    :: (MonadReader env m, HasPlatform env, HasGHCVariant env)
-    => m FilePath
-platformGhcVerOnlyRelDirStr = do
-    platform <- view platformL
-    platformVariant <- view platformVariantL
-    ghcVariant <- view ghcVariantL
-    pure $ mconcat [ Distribution.Text.display platform
-                     , platformVariantSuffix platformVariant
-                     , ghcVariantSuffix ghcVariant ]
-
--- | This is an attempt to shorten Stack paths on Windows to decrease our
--- chances of hitting 260 symbol path limit. The idea is to calculate
--- SHA1 hash of the path used on other architectures, encode with base
--- 16 and take first 8 symbols of it.
-useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir)
-useShaPathOnWindows
-  | osIsWindows = shaPath
-  | otherwise = pure
-
-shaPath :: (IsPath Rel t, MonadThrow m) => Path Rel t -> m (Path Rel t)
-shaPath = shaPathForBytes . encodeUtf8 . T.pack . toFilePath
-
-shaPathForBytes :: (IsPath Rel t, MonadThrow m) => ByteString -> m (Path Rel t)
-shaPathForBytes
-    = parsePath . S8.unpack . S8.take 8
-    . Mem.convertToBase Mem.Base16 . hashWith SHA1
-
--- TODO: Move something like this into the path package. Consider
--- subsuming path-io's 'AnyPath'?
-class IsPath b t where
-  parsePath :: MonadThrow m => FilePath -> m (Path b t)
-
-instance IsPath Abs Dir where parsePath = parseAbsDir
-instance IsPath Rel Dir where parsePath = parseRelDir
-instance IsPath Abs File where parsePath = parseAbsFile
-instance IsPath Rel File where parsePath = parseRelFile
-
-compilerVersionDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Rel Dir)
-compilerVersionDir = do
-    compilerVersion <- view actualCompilerVersionL
-    parseRelDir $ case compilerVersion of
-        ACGhc version -> versionString version
-        ACGhcGit {} -> compilerVersionString compilerVersion
-
--- | Package database for installing dependencies into
-packageDatabaseDeps :: (HasEnvConfig env) => RIO env (Path Abs Dir)
-packageDatabaseDeps = do
-    root <- installationRootDeps
-    pure $ root </> relDirPkgdb
-
--- | Package database for installing local packages into
-packageDatabaseLocal :: (HasEnvConfig env) => RIO env (Path Abs Dir)
-packageDatabaseLocal = do
-    root <- installationRootLocal
-    pure $ root </> relDirPkgdb
-
--- | Extra package databases
-packageDatabaseExtra :: (MonadReader env m, HasEnvConfig env) => m [Path Abs Dir]
-packageDatabaseExtra = view $ buildConfigL.to bcExtraPackageDBs
-
--- | Where do we get information on global packages for loading up a
--- 'LoadedSnapshot'?
-data GlobalInfoSource
-  = GISSnapshotHints
-  -- ^ Accept the hints in the snapshot definition
-  | GISCompiler ActualCompiler
-  -- ^ Look up the actual information in the installed compiler
-
--- | Where HPC reports and tix files get stored.
-hpcReportDir :: (HasEnvConfig env)
-             => RIO env (Path Abs Dir)
-hpcReportDir = do
-   root <- installationRootLocal
-   pure $ root </> relDirHpc
-
--- | Get the extra bin directories (for the PATH). Puts more local first
---
--- Bool indicates whether or not to include the locals
-extraBinDirs :: (HasEnvConfig env)
-             => RIO env (Bool -> [Path Abs Dir])
-extraBinDirs = do
-    deps <- installationRootDeps
-    local' <- installationRootLocal
-    tools <- bindirCompilerTools
-    pure $ \locals -> if locals
-        then [local' </> bindirSuffix, deps </> bindirSuffix, tools]
-        else [deps </> bindirSuffix, tools]
-
-minimalEnvSettings :: EnvSettings
-minimalEnvSettings =
-    EnvSettings
-    { esIncludeLocals = False
-    , esIncludeGhcPackagePath = False
-    , esStackExe = False
-    , esLocaleUtf8 = False
-    , esKeepGhcRts = False
-    }
-
--- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH.
---
--- Note that this also passes through the GHCRTS environment variable.
--- See https://github.com/commercialhaskell/stack/issues/3444
-defaultEnvSettings :: EnvSettings
-defaultEnvSettings = EnvSettings
-    { esIncludeLocals = True
-    , esIncludeGhcPackagePath = True
-    , esStackExe = True
-    , esLocaleUtf8 = False
-    , esKeepGhcRts = True
-    }
-
--- | Environment settings which do not embellish the environment
---
--- Note that this also passes through the GHCRTS environment variable.
--- See https://github.com/commercialhaskell/stack/issues/3444
-plainEnvSettings :: EnvSettings
-plainEnvSettings = EnvSettings
-    { esIncludeLocals = False
-    , esIncludeGhcPackagePath = False
-    , esStackExe = False
-    , esLocaleUtf8 = False
-    , esKeepGhcRts = True
-    }
-
--- | Get the path for the given compiler ignoring any local binaries.
---
--- https://github.com/commercialhaskell/stack/issues/1052
-getCompilerPath :: HasCompiler env => RIO env (Path Abs File)
-getCompilerPath = view $ compilerPathsL.to cpCompiler
-
-data ProjectAndConfigMonoid
-  = ProjectAndConfigMonoid !Project !ConfigMonoid
-
-parseProjectAndConfigMonoid :: Path Abs Dir -> Value -> Yaml.Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
-parseProjectAndConfigMonoid rootDir =
-    withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do
-        packages <- o ..:? "packages" ..!= [RelFilePath "."]
-        deps <- jsonSubWarningsTT (o ..:? "extra-deps") ..!= []
-        flags' <- o ..:? "flags" ..!= mempty
-        let flags = unCabalStringMap <$> unCabalStringMap
-                    (flags' :: Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
-
-        resolver <- jsonSubWarnings $ o ...: ["snapshot", "resolver"]
-        mcompiler <- o ..:? "compiler"
-        msg <- o ..:? "user-message"
-        config <- parseConfigMonoidObject rootDir o
-        extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
-        mcurator <- jsonSubWarningsT (o ..:? "curator")
-        drops <- o ..:? "drop-packages" ..!= mempty
-        pure $ do
-          deps' <- mapM (resolvePaths (Just rootDir)) deps
-          resolver' <- resolvePaths (Just rootDir) resolver
-          let project = Project
-                  { projectUserMsg = msg
-                  , projectResolver = resolver'
-                  , projectCompiler = mcompiler -- FIXME make sure resolver' isn't SLCompiler
-                  , projectExtraPackageDBs = extraPackageDBs
-                  , projectPackages = packages
-                  , projectDependencies = concatMap toList (deps' :: [NonEmpty RawPackageLocation])
-                  , projectFlags = flags
-                  , projectCurator = mcurator
-                  , projectDropPackages = Set.map unCabalString drops
-                  }
-          pure $ ProjectAndConfigMonoid project config
-
--- | A software control system.
-data SCM = Git
-  deriving (Show)
-
-instance FromJSON SCM where
-    parseJSON v = do
-        s <- parseJSON v
-        case s of
-            "git" -> pure Git
-            _ -> fail ("Unknown or unsupported SCM: " <> s)
-
-instance ToJSON SCM where
-    toJSON Git = toJSON ("git" :: Text)
-
--- | A variant of the platform, used to differentiate Docker builds from host
-data PlatformVariant = PlatformVariantNone
-                     | PlatformVariant String
-
--- | Render a platform variant to a String suffix.
-platformVariantSuffix :: PlatformVariant -> String
-platformVariantSuffix PlatformVariantNone = ""
-platformVariantSuffix (PlatformVariant v) = "-" ++ v
-
--- | Specialized variant of GHC (e.g. libgmp4 or integer-simple)
-data GHCVariant
-    = GHCStandard
-    -- ^ Standard bindist
-    | GHCIntegerSimple
-    -- ^ Bindist that uses integer-simple
-    | GHCNativeBignum
-    -- ^ Bindist that uses the Haskell-native big-integer backend
-    | GHCCustom String
-    -- ^ Other bindists
-    deriving (Show)
-
-instance FromJSON GHCVariant where
-    -- Strange structuring is to give consistent error messages
-    parseJSON =
-        withText
-            "GHCVariant"
-            (either (fail . show) pure . parseGHCVariant . T.unpack)
-
--- | Render a GHC variant to a String.
-ghcVariantName :: GHCVariant -> String
-ghcVariantName GHCStandard = "standard"
-ghcVariantName GHCIntegerSimple = "integersimple"
-ghcVariantName GHCNativeBignum = "int-native"
-ghcVariantName (GHCCustom name) = "custom-" ++ name
-
--- | Render a GHC variant to a String suffix.
-ghcVariantSuffix :: GHCVariant -> String
-ghcVariantSuffix GHCStandard = ""
-ghcVariantSuffix v = "-" ++ ghcVariantName v
-
--- | Parse GHC variant from a String.
-parseGHCVariant :: (MonadThrow m) => String -> m GHCVariant
-parseGHCVariant s =
-    case stripPrefix "custom-" s of
-        Just name -> pure (GHCCustom name)
-        Nothing
-          | s == "" -> pure GHCStandard
-          | s == "standard" -> pure GHCStandard
-          | s == "integersimple" -> pure GHCIntegerSimple
-          | s == "int-native" -> pure GHCNativeBignum
-          | otherwise -> pure (GHCCustom s)
-
--- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)
--- | Information for a file to download.
-data DownloadInfo = DownloadInfo
-    { downloadInfoUrl :: Text
-      -- ^ URL or absolute file path
-    , downloadInfoContentLength :: Maybe Int
-    , downloadInfoSha1 :: Maybe ByteString
-    , downloadInfoSha256 :: Maybe ByteString
-    } deriving (Show)
-
-instance FromJSON (WithJSONWarnings DownloadInfo) where
-    parseJSON = withObjectWarnings "DownloadInfo" parseDownloadInfoFromObject
-
--- | Parse JSON in existing object for 'DownloadInfo'
-parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo
-parseDownloadInfoFromObject o = do
-    url <- o ..: "url"
-    contentLength <- o ..:? "content-length"
-    sha1TextMay <- o ..:? "sha1"
-    sha256TextMay <- o ..:? "sha256"
-    pure
-        DownloadInfo
-        { downloadInfoUrl = url
-        , downloadInfoContentLength = contentLength
-        , downloadInfoSha1 = fmap encodeUtf8 sha1TextMay
-        , downloadInfoSha256 = fmap encodeUtf8 sha256TextMay
-        }
-
-data VersionedDownloadInfo = VersionedDownloadInfo
-    { vdiVersion :: Version
-    , vdiDownloadInfo :: DownloadInfo
-    }
-    deriving Show
-
-instance FromJSON (WithJSONWarnings VersionedDownloadInfo) where
-    parseJSON = withObjectWarnings "VersionedDownloadInfo" $ \o -> do
-        CabalString version <- o ..: "version"
-        downloadInfo <- parseDownloadInfoFromObject o
-        pure VersionedDownloadInfo
-            { vdiVersion = version
-            , vdiDownloadInfo = downloadInfo
-            }
-
-data GHCDownloadInfo = GHCDownloadInfo
-    { gdiConfigureOpts :: [Text]
-    , gdiConfigureEnv :: Map Text Text
-    , gdiDownloadInfo :: DownloadInfo
-    }
-    deriving Show
-
-instance FromJSON (WithJSONWarnings GHCDownloadInfo) where
-    parseJSON = withObjectWarnings "GHCDownloadInfo" $ \o -> do
-        configureOpts <- o ..:? "configure-opts" ..!= mempty
-        configureEnv <- o ..:? "configure-env" ..!= mempty
-        downloadInfo <- parseDownloadInfoFromObject o
-        pure GHCDownloadInfo
-            { gdiConfigureOpts = configureOpts
-            , gdiConfigureEnv = configureEnv
-            , gdiDownloadInfo = downloadInfo
-            }
-
-data SetupInfo = SetupInfo
-    { siSevenzExe :: Maybe DownloadInfo
-    , siSevenzDll :: Maybe DownloadInfo
-    , siMsys2 :: Map Text VersionedDownloadInfo
-    , siGHCs :: Map Text (Map Version GHCDownloadInfo)
-    , siStack :: Map Text (Map Version DownloadInfo)
-    }
-    deriving Show
-
-instance FromJSON (WithJSONWarnings SetupInfo) where
-    parseJSON = withObjectWarnings "SetupInfo" $ \o -> do
-        siSevenzExe <- jsonSubWarningsT (o ..:? "sevenzexe-info")
-        siSevenzDll <- jsonSubWarningsT (o ..:? "sevenzdll-info")
-        siMsys2 <- jsonSubWarningsT (o ..:? "msys2" ..!= mempty)
-        (fmap unCabalStringMap -> siGHCs) <- jsonSubWarningsTT (o ..:? "ghc" ..!= mempty)
-        (fmap unCabalStringMap -> siStack) <- jsonSubWarningsTT (o ..:? "stack" ..!= mempty)
-        pure SetupInfo {..}
-
--- | For the @siGHCs@ field maps are deeply merged.
--- For all fields the values from the first @SetupInfo@ win.
-instance Semigroup SetupInfo where
-    l <> r =
-        SetupInfo
-        { siSevenzExe = siSevenzExe l <|> siSevenzExe r
-        , siSevenzDll = siSevenzDll l <|> siSevenzDll r
-        , siMsys2 = siMsys2 l <> siMsys2 r
-        , siGHCs = Map.unionWith (<>) (siGHCs l) (siGHCs r)
-        , siStack = Map.unionWith (<>) (siStack l) (siStack r) }
-
-instance Monoid SetupInfo where
-    mempty =
-        SetupInfo
-        { siSevenzExe = Nothing
-        , siSevenzDll = Nothing
-        , siMsys2 = Map.empty
-        , siGHCs = Map.empty
-        , siStack = Map.empty
-        }
-    mappend = (<>)
-
--- | How PVP bounds should be added to .cabal files
-data PvpBoundsType
-  = PvpBoundsNone
-  | PvpBoundsUpper
-  | PvpBoundsLower
-  | PvpBoundsBoth
-  deriving (Show, Read, Eq, Typeable, Ord, Enum, Bounded)
-
-data PvpBounds = PvpBounds
-  { pbType :: !PvpBoundsType
-  , pbAsRevision :: !Bool
-  }
-  deriving (Show, Read, Eq, Typeable, Ord)
-
-pvpBoundsText :: PvpBoundsType -> Text
-pvpBoundsText PvpBoundsNone = "none"
-pvpBoundsText PvpBoundsUpper = "upper"
-pvpBoundsText PvpBoundsLower = "lower"
-pvpBoundsText PvpBoundsBoth = "both"
-
-parsePvpBounds :: Text -> Either String PvpBounds
-parsePvpBounds t = maybe err Right $ do
-    (t', asRevision) <-
-      case T.break (== '-') t of
-        (x, "") -> Just (x, False)
-        (x, "-revision") -> Just (x, True)
-        _ -> Nothing
-    x <- Map.lookup t' m
-    Just PvpBounds
-      { pbType = x
-      , pbAsRevision = asRevision
-      }
-  where
-    m = Map.fromList $ map (pvpBoundsText &&& id) [minBound..maxBound]
-    err = Left $ "Invalid PVP bounds: " ++ T.unpack t
-
-instance ToJSON PvpBounds where
-  toJSON (PvpBounds typ asRevision) =
-    toJSON (pvpBoundsText typ <> (if asRevision then "-revision" else ""))
-instance FromJSON PvpBounds where
-  parseJSON = withText "PvpBounds" (either fail pure . parsePvpBounds)
-
--- | Data passed into Docker container for the Docker entrypoint's use
-newtype DockerEntrypoint = DockerEntrypoint
-    { deUser :: Maybe DockerUser
-      -- ^ UID/GID/etc of host user, if we wish to perform UID/GID switch in container
-    } deriving (Read,Show)
-
--- | Docker host user info
-data DockerUser = DockerUser
-    { duUid :: UserID -- ^ uid
-    , duGid :: GroupID -- ^ gid
-    , duGroups :: [GroupID] -- ^ Supplemental groups
-    , duUmask :: FileMode -- ^ File creation mask }
-    } deriving (Read,Show)
-
-data GhcOptionKey
-  = GOKOldEverything
-  | GOKEverything
-  | GOKLocals
-  | GOKTargets
-  | GOKPackage !PackageName
-  deriving (Eq, Ord)
-
-instance FromJSONKey GhcOptionKey where
-  fromJSONKey = FromJSONKeyTextParser $ \t ->
-    case t of
-      "*" -> pure GOKOldEverything
-      "$everything" -> pure GOKEverything
-      "$locals" -> pure GOKLocals
-      "$targets" -> pure GOKTargets
-      _ ->
-        case parsePackageName $ T.unpack t of
-          Nothing -> fail $ "Invalid package name: " ++ show t
-          Just x -> pure $ GOKPackage x
-  fromJSONKeyList = FromJSONKeyTextParser $ \_ -> fail "GhcOptionKey.fromJSONKeyList"
-
-newtype GhcOptions = GhcOptions { unGhcOptions :: [Text] }
-
-instance FromJSON GhcOptions where
-  parseJSON = withText "GhcOptions" $ \t ->
-    case parseArgs Escaping t of
-      Left e -> fail e
-      Right opts -> pure $ GhcOptions $ map T.pack opts
-
------------------------------------
--- Lens classes
------------------------------------
-
--- | Class for environment values which have a Platform
-class HasPlatform env where
-    platformL :: Lens' env Platform
-    default platformL :: HasConfig env => Lens' env Platform
-    platformL = configL.platformL
-    {-# INLINE platformL #-}
-    platformVariantL :: Lens' env PlatformVariant
-    default platformVariantL :: HasConfig env => Lens' env PlatformVariant
-    platformVariantL = configL.platformVariantL
-    {-# INLINE platformVariantL #-}
-
--- | Class for environment values which have a GHCVariant
-class HasGHCVariant env where
-    ghcVariantL :: SimpleGetter env GHCVariant
-    default ghcVariantL :: HasConfig env => SimpleGetter env GHCVariant
-    ghcVariantL = configL.ghcVariantL
-    {-# INLINE ghcVariantL #-}
-
--- | Class for environment values which have a 'Runner'.
-class (HasProcessContext env, HasLogFunc env) => HasRunner env where
-  runnerL :: Lens' env Runner
-instance HasLogFunc Runner where
-  logFuncL = lens runnerLogFunc (\x y -> x { runnerLogFunc = y })
-instance HasProcessContext Runner where
-  processContextL = lens runnerProcessContext (\x y -> x { runnerProcessContext = y })
-instance HasRunner Runner where
-  runnerL = id
-instance HasStylesUpdate Runner where
-  stylesUpdateL = globalOptsL.
-                  lens globalStylesUpdate (\x y -> x { globalStylesUpdate = y })
-instance HasTerm Runner where
-  useColorL = lens runnerUseColor (\x y -> x { runnerUseColor = y })
-  termWidthL = lens runnerTermWidth (\x y -> x { runnerTermWidth = y })
-
-globalOptsL :: HasRunner env => Lens' env GlobalOpts
-globalOptsL = runnerL.lens runnerGlobalOpts (\x y -> x { runnerGlobalOpts = y })
-
--- | Class for environment values that can provide a 'Config'.
-class ( HasPlatform env, HasGHCVariant env, HasProcessContext env, HasPantryConfig env, HasTerm env, HasRunner env) => HasConfig env where
-    configL :: Lens' env Config
-    default configL :: HasBuildConfig env => Lens' env Config
-    configL = buildConfigL.lens bcConfig (\x y -> x { bcConfig = y })
-    {-# INLINE configL #-}
-
-class HasConfig env => HasBuildConfig env where
-    buildConfigL :: Lens' env BuildConfig
-    default buildConfigL :: HasEnvConfig env => Lens' env BuildConfig
-    buildConfigL = envConfigL.lens
-        envConfigBuildConfig
-        (\x y -> x { envConfigBuildConfig = y })
-
-class (HasBuildConfig env, HasSourceMap env, HasCompiler env) => HasEnvConfig env where
-    envConfigL :: Lens' env EnvConfig
-
------------------------------------
--- Lens instances
------------------------------------
-
-instance HasPlatform (Platform,PlatformVariant) where
-    platformL = _1
-    platformVariantL = _2
-instance HasPlatform Config where
-    platformL = lens configPlatform (\x y -> x { configPlatform = y })
-    platformVariantL = lens configPlatformVariant (\x y -> x { configPlatformVariant = y })
-instance HasPlatform BuildConfig
-instance HasPlatform EnvConfig
-
-instance HasGHCVariant GHCVariant where
-    ghcVariantL = id
-    {-# INLINE ghcVariantL #-}
-instance HasGHCVariant Config where
-    ghcVariantL = to $ fromMaybe GHCStandard . configGHCVariant
-instance HasGHCVariant BuildConfig
-instance HasGHCVariant EnvConfig
-
-instance HasProcessContext Config where
-    processContextL = runnerL.processContextL
-instance HasProcessContext BuildConfig where
-    processContextL = configL.processContextL
-instance HasProcessContext EnvConfig where
-    processContextL = configL.processContextL
-
-instance HasPantryConfig Config where
-    pantryConfigL = lens configPantryConfig (\x y -> x { configPantryConfig = y })
-instance HasPantryConfig BuildConfig where
-    pantryConfigL = configL.pantryConfigL
-instance HasPantryConfig EnvConfig where
-    pantryConfigL = configL.pantryConfigL
-
-instance HasConfig Config where
-    configL = id
-    {-# INLINE configL #-}
-instance HasConfig BuildConfig where
-    configL = lens bcConfig (\x y -> x { bcConfig = y })
-instance HasConfig EnvConfig
-
-instance HasBuildConfig BuildConfig where
-    buildConfigL = id
-    {-# INLINE buildConfigL #-}
-instance HasBuildConfig EnvConfig
-
-instance HasCompiler EnvConfig where
-    compilerPathsL = to envConfigCompilerPaths
-instance HasEnvConfig EnvConfig where
-    envConfigL = id
-    {-# INLINE envConfigL #-}
-
-instance HasRunner Config where
-  runnerL = lens configRunner (\x y -> x { configRunner = y })
-instance HasRunner BuildConfig where
-  runnerL = configL.runnerL
-instance HasRunner EnvConfig where
-  runnerL = configL.runnerL
-
-instance HasLogFunc Config where
-  logFuncL = runnerL.logFuncL
-instance HasLogFunc BuildConfig where
-  logFuncL = runnerL.logFuncL
-instance HasLogFunc EnvConfig where
-  logFuncL = runnerL.logFuncL
-
-instance HasStylesUpdate Config where
-  stylesUpdateL = runnerL.stylesUpdateL
-instance HasStylesUpdate BuildConfig where
-  stylesUpdateL = runnerL.stylesUpdateL
-instance HasStylesUpdate EnvConfig where
-  stylesUpdateL = runnerL.stylesUpdateL
-
-instance HasTerm Config where
-  useColorL = runnerL.useColorL
-  termWidthL = runnerL.termWidthL
-instance HasTerm BuildConfig where
-  useColorL = runnerL.useColorL
-  termWidthL = runnerL.termWidthL
-instance HasTerm EnvConfig where
-  useColorL = runnerL.useColorL
-  termWidthL = runnerL.termWidthL
-
------------------------------------
--- Helper lenses
------------------------------------
-
-stackRootL :: HasConfig s => Lens' s (Path Abs Dir)
-stackRootL = configL.lens configStackRoot (\x y -> x { configStackRoot = y })
-
-stackGlobalConfigL :: HasConfig s => Lens' s (Path Abs File)
-stackGlobalConfigL = configL.lens configUserConfigPath (\x y -> x { configUserConfigPath = y })
-
--- | The compiler specified by the @SnapshotDef@. This may be
--- different from the actual compiler used!
-wantedCompilerVersionL :: HasBuildConfig s => Getting r s WantedCompiler
-wantedCompilerVersionL = buildConfigL.to (smwCompiler . bcSMWanted)
-
--- | Location of the ghc-pkg executable
-newtype GhcPkgExe = GhcPkgExe (Path Abs File)
-  deriving Show
-
--- | Get the 'GhcPkgExe' from a 'HasCompiler' environment
-getGhcPkgExe :: HasCompiler env => RIO env GhcPkgExe
-getGhcPkgExe = view $ compilerPathsL.to cpPkg
-
--- | Dump information for a single package
-data DumpPackage = DumpPackage
-    { dpGhcPkgId :: !GhcPkgId
-    , dpPackageIdent :: !PackageIdentifier
-    , dpParentLibIdent :: !(Maybe PackageIdentifier)
-    , dpLicense :: !(Maybe C.License)
-    , dpLibDirs :: ![FilePath]
-    , dpLibraries :: ![Text]
-    , dpHasExposedModules :: !Bool
-    , dpExposedModules :: !(Set ModuleName)
-    , dpDepends :: ![GhcPkgId]
-    , dpHaddockInterfaces :: ![FilePath]
-    , dpHaddockHtml :: !(Maybe FilePath)
-    , dpIsExposed :: !Bool
-    }
-    deriving (Show, Read, Eq)
-
--- | Paths on the filesystem for the compiler we're using
-data CompilerPaths = CompilerPaths
-  { cpCompilerVersion :: !ActualCompiler
-  , cpArch :: !Arch
-  , cpBuild :: !CompilerBuild
-  , cpCompiler :: !(Path Abs File)
-  -- | ghc-pkg or equivalent
-  , cpPkg :: !GhcPkgExe
-  -- | runghc
-  , cpInterpreter :: !(Path Abs File)
-  -- | haddock, in 'IO' to allow deferring the lookup
-  , cpHaddock :: !(Path Abs File)
-  -- | Is this a Stack-sandboxed installation?
-  , cpSandboxed :: !Bool
-  , cpCabalVersion :: !Version
-  -- ^ This is the version of Cabal that Stack will use to compile Setup.hs files
-  -- in the build process.
-  --
-  -- Note that this is not necessarily the same version as the one that Stack
-  -- depends on as a library and which is displayed when running
-  -- @stack ls dependencies | grep Cabal@ in the Stack project.
-  , cpGlobalDB :: !(Path Abs Dir)
-  -- ^ Global package database
-  , cpGhcInfo :: !ByteString
-  -- ^ Output of @ghc --info@
-  , cpGlobalDump :: !(Map PackageName DumpPackage)
-  }
-  deriving Show
-
-cpWhich :: (MonadReader env m, HasCompiler env) => m WhichCompiler
-cpWhich = view $ compilerPathsL.to (whichCompiler.cpCompilerVersion)
-
-data ExtraDirs = ExtraDirs
-    { edBins :: ![Path Abs Dir]
-    , edInclude :: ![Path Abs Dir]
-    , edLib :: ![Path Abs Dir]
-    } deriving (Show, Generic)
-instance Semigroup ExtraDirs where
-    (<>) = mappenddefault
-instance Monoid ExtraDirs where
-    mempty = memptydefault
-    mappend = (<>)
-
--- | An environment which ensures that the given compiler is available
--- on the PATH
-class HasCompiler env where
-  compilerPathsL :: SimpleGetter env CompilerPaths
-instance HasCompiler CompilerPaths where
-  compilerPathsL = id
-
-class HasSourceMap env where
-  sourceMapL :: Lens' env SourceMap
-instance HasSourceMap EnvConfig where
-  sourceMapL = lens envConfigSourceMap (\x y -> x { envConfigSourceMap = y })
-
--- | The version of the compiler which will actually be used. May be
--- different than that specified in the 'SnapshotDef' and returned
--- by 'wantedCompilerVersionL'.
-actualCompilerVersionL :: HasSourceMap env => SimpleGetter env ActualCompiler
-actualCompilerVersionL = sourceMapL.to smCompiler
-
-buildOptsL :: HasConfig s => Lens' s BuildOpts
-buildOptsL = configL.lens
-    configBuild
-    (\x y -> x { configBuild = y })
-
-buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool)
-buildOptsMonoidHaddockL = lens (getFirstFalse . buildMonoidHaddock)
-                            (\buildMonoid t -> buildMonoid {buildMonoidHaddock = FirstFalse t})
-
-buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool)
-buildOptsMonoidTestsL = lens (getFirstFalse . buildMonoidTests)
-                            (\buildMonoid t -> buildMonoid {buildMonoidTests = FirstFalse t})
-
-buildOptsMonoidBenchmarksL :: Lens' BuildOptsMonoid (Maybe Bool)
-buildOptsMonoidBenchmarksL = lens (getFirstFalse . buildMonoidBenchmarks)
-                            (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = FirstFalse t})
-
-buildOptsMonoidInstallExesL :: Lens' BuildOptsMonoid (Maybe Bool)
-buildOptsMonoidInstallExesL =
-  lens (getFirstFalse . buildMonoidInstallExes)
-       (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = FirstFalse t})
-
-buildOptsInstallExesL :: Lens' BuildOpts Bool
-buildOptsInstallExesL =
-  lens boptsInstallExes
-       (\bopts t -> bopts {boptsInstallExes = t})
-
-buildOptsHaddockL :: Lens' BuildOpts Bool
-buildOptsHaddockL =
-  lens boptsHaddock
-       (\bopts t -> bopts {boptsHaddock = t})
-
-globalOptsBuildOptsMonoidL :: Lens' GlobalOpts BuildOptsMonoid
-globalOptsBuildOptsMonoidL =
-  lens
-    globalConfigMonoid
-    (\x y -> x { globalConfigMonoid = y })
-  .
-  lens
-    configMonoidBuildOpts
-    (\x y -> x { configMonoidBuildOpts = y })
-
-cabalVersionL :: HasCompiler env => SimpleGetter env Version
-cabalVersionL = compilerPathsL.to cpCabalVersion
-
-whichCompilerL :: Getting r ActualCompiler WhichCompiler
-whichCompilerL = to whichCompiler
-
-envOverrideSettingsL :: HasConfig env => Lens' env (EnvSettings -> IO ProcessContext)
-envOverrideSettingsL = configL.lens
-    configProcessContextSettings
-    (\x y -> x { configProcessContextSettings = y })
-
-shouldForceGhcColorFlag :: (HasRunner env, HasEnvConfig env)
-                        => RIO env Bool
-shouldForceGhcColorFlag = do
-    canDoColor <- (>= mkVersion [8, 2, 1]) . getGhcVersion
-              <$> view actualCompilerVersionL
-    shouldDoColor <- view useColorL
-    pure $ canDoColor && shouldDoColor
-
-appropriateGhcColorFlag :: (HasRunner env, HasEnvConfig env)
-                        => RIO env (Maybe String)
-appropriateGhcColorFlag = f <$> shouldForceGhcColorFlag
-  where f True = Just ghcColorForceFlag
-        f False = Nothing
-
--- | See 'globalTerminal'
-terminalL :: HasRunner env => Lens' env Bool
-terminalL = globalOptsL.lens globalTerminal (\x y -> x { globalTerminal = y })
-
--- | See 'globalReExecVersion'
-reExecL :: HasRunner env => SimpleGetter env Bool
-reExecL = globalOptsL.to (isJust . globalReExecVersion)
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DefaultSignatures     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE MultiWayIf            #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module Stack.Types.Config
+  (
+    Config (..)
+  , HasConfig (..)
+  , askLatestSnapshotUrl
+  , configProjectRoot
+  , ghcInstallHook
+  -- * Lens helpers
+  , buildOptsL
+  , envOverrideSettingsL
+  , globalOptsL
+  , stackGlobalConfigL
+  , stackRootL
+  , workDirL
+  -- * Helper logging functions
+  , prettyStackDevL
+  ) where
+
+import           Distribution.System ( Platform )
+import           Path ( (</>), parent, reldir, relfile )
+import           RIO.Process ( HasProcessContext (..), ProcessContext )
+import           Stack.Prelude
+import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
+import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
+import           Stack.Types.BuildOpts ( BuildOpts )
+import           Stack.Types.CabalConfigKey ( CabalConfigKey )
+import           Stack.Types.Compiler ( CompilerRepository )
+import           Stack.Types.CompilerBuild ( CompilerBuild )
+import           Stack.Types.Docker ( DockerOpts )
+import           Stack.Types.DumpLogs ( DumpLogs )
+import           Stack.Types.EnvSettings ( EnvSettings )
+import           Stack.Types.GHCVariant ( GHCVariant (..), HasGHCVariant (..) )
+import           Stack.Types.Nix ( NixOpts )
+import           Stack.Types.Platform ( HasPlatform (..), PlatformVariant )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
+import           Stack.Types.PvpBounds ( PvpBounds )
+import           Stack.Types.Resolver ( AbstractResolver )
+import           Stack.Types.Runner ( HasRunner (..), Runner, globalOptsL )
+import           Stack.Types.SCM ( SCM )
+import           Stack.Types.SetupInfo ( SetupInfo )
+import           Stack.Types.Storage ( UserStorage )
+import           Stack.Types.TemplateName ( TemplateName )
+import           Stack.Types.Version ( VersionCheck (..), VersionRange )
+
+-- | The top-level Stackage configuration.
+data Config = Config
+  { configWorkDir             :: !(Path Rel Dir)
+    -- ^ this allows to override .stack-work directory
+  , configUserConfigPath      :: !(Path Abs File)
+    -- ^ Path to user configuration file (usually ~/.stack/config.yaml)
+  , configBuild               :: !BuildOpts
+    -- ^ Build configuration
+  , configDocker              :: !DockerOpts
+    -- ^ Docker configuration
+  , configNix                 :: !NixOpts
+    -- ^ Execution environment (e.g nix-shell) configuration
+  , configProcessContextSettings :: !(EnvSettings -> IO ProcessContext)
+    -- ^ Environment variables to be passed to external tools
+  , configLocalProgramsBase   :: !(Path Abs Dir)
+    -- ^ Non-platform-specific path containing local installations
+  , configLocalPrograms       :: !(Path Abs Dir)
+    -- ^ Path containing local installations (mainly GHC)
+  , configHideTHLoading       :: !Bool
+    -- ^ Hide the Template Haskell "Loading package ..." messages from the
+    -- console
+  , configPrefixTimestamps    :: !Bool
+    -- ^ Prefix build output with timestamps for each line.
+  , configPlatform            :: !Platform
+    -- ^ The platform we're building for, used in many directory names
+  , configPlatformVariant     :: !PlatformVariant
+    -- ^ Variant of the platform, also used in directory names
+  , configGHCVariant          :: !(Maybe GHCVariant)
+    -- ^ The variant of GHC requested by the user.
+  , configGHCBuild            :: !(Maybe CompilerBuild)
+    -- ^ Override build of the compiler distribution (e.g. standard, gmp4,
+    -- tinfo6)
+  , configLatestSnapshot      :: !Text
+    -- ^ URL of a JSON file providing the latest LTS and Nightly snapshots.
+  , configSystemGHC           :: !Bool
+    -- ^ Should we use the system-installed GHC (on the PATH) if
+    -- available? Can be overridden by command line options.
+  , configInstallGHC          :: !Bool
+    -- ^ Should we automatically install GHC if missing or the wrong
+    -- version is available? Can be overridden by command line options.
+  , configSkipGHCCheck        :: !Bool
+    -- ^ Don't bother checking the GHC version or architecture.
+  , configSkipMsys            :: !Bool
+    -- ^ On Windows: don't use a sandboxed MSYS
+  , configCompilerCheck       :: !VersionCheck
+    -- ^ Specifies which versions of the compiler are acceptable.
+  , configCompilerRepository  :: !CompilerRepository
+    -- ^ Specifies the repository containing the compiler sources
+  , configLocalBin            :: !(Path Abs Dir)
+    -- ^ Directory we should install executables into
+  , configRequireStackVersion :: !VersionRange
+    -- ^ Require a version of Stack within this range.
+  , configJobs                :: !Int
+    -- ^ How many concurrent jobs to run, defaults to number of capabilities
+  , configOverrideGccPath     :: !(Maybe (Path Abs File))
+    -- ^ Optional gcc override path
+  , configExtraIncludeDirs    :: ![FilePath]
+    -- ^ --extra-include-dirs arguments
+  , configExtraLibDirs        :: ![FilePath]
+    -- ^ --extra-lib-dirs arguments
+  , configCustomPreprocessorExts :: ![Text]
+    -- ^ List of custom preprocessors to complete the hard coded ones
+  , configConcurrentTests     :: !Bool
+    -- ^ Run test suites concurrently
+  , configTemplateParams      :: !(Map Text Text)
+    -- ^ Parameters for templates.
+  , configScmInit             :: !(Maybe SCM)
+    -- ^ Initialize SCM (e.g. git) when creating new projects.
+  , configGhcOptionsByName    :: !(Map PackageName [Text])
+    -- ^ Additional GHC options to apply to specific packages.
+  , configGhcOptionsByCat     :: !(Map ApplyGhcOptions [Text])
+    -- ^ Additional GHC options to apply to categories of packages
+  , configCabalConfigOpts     :: !(Map CabalConfigKey [Text])
+    -- ^ Additional options to be passed to ./Setup.hs configure
+  , configSetupInfoLocations  :: ![String]
+    -- ^ URLs or paths to stack-setup.yaml files, for finding tools.
+    -- If none present, the default setup-info is used.
+  , configSetupInfoInline     :: !SetupInfo
+    -- ^ Additional SetupInfo to use to find tools.
+  , configPvpBounds           :: !PvpBounds
+    -- ^ How PVP upper bounds should be added to packages
+  , configModifyCodePage      :: !Bool
+    -- ^ Force the code page to UTF-8 on Windows
+  , configRebuildGhcOptions   :: !Bool
+    -- ^ Rebuild on GHC options changes
+  , configApplyGhcOptions     :: !ApplyGhcOptions
+    -- ^ Which packages do --ghc-options on the command line apply to?
+  , configApplyProgOptions     :: !ApplyProgOptions
+    -- ^ Which packages do all and any --PROG-option options on the command line
+    -- apply to?
+  , configAllowNewer          :: !Bool
+    -- ^ Ignore version ranges in .cabal files. Funny naming chosen to
+    -- match cabal.
+  , configAllowNewerDeps      :: !(Maybe [PackageName])
+    -- ^ Ignore dependency upper and lower bounds only for specified
+    -- packages. No effect unless allow-newer is enabled.
+  , configDefaultTemplate     :: !(Maybe TemplateName)
+    -- ^ The default template to use when none is specified.
+    -- (If Nothing, the 'default' default template is used.)
+  , configAllowDifferentUser  :: !Bool
+    -- ^ Allow users other than the Stack root owner to use the Stack
+    -- installation.
+  , configDumpLogs            :: !DumpLogs
+    -- ^ Dump logs of local non-dependencies when doing a build.
+  , configProject             :: !(ProjectConfig (Project, Path Abs File))
+    -- ^ Project information and stack.yaml file location
+  , configAllowLocals         :: !Bool
+    -- ^ Are we allowed to build local packages? The script
+    -- command disallows this.
+  , configSaveHackageCreds    :: !Bool
+    -- ^ Should we save Hackage credentials to a file?
+  , configHackageBaseUrl      :: !Text
+    -- ^ Hackage base URL used when uploading packages
+  , configRunner              :: !Runner
+  , configPantryConfig        :: !PantryConfig
+  , configStackRoot           :: !(Path Abs Dir)
+  , configResolver            :: !(Maybe AbstractResolver)
+    -- ^ Any resolver override from the command line
+  , configUserStorage         :: !UserStorage
+    -- ^ Database connection pool for user Stack database
+  , configHideSourcePaths     :: !Bool
+    -- ^ Enable GHC hiding source paths?
+  , configRecommendUpgrade    :: !Bool
+    -- ^ Recommend a Stack upgrade?
+  , configNoRunCompile   :: !Bool
+    -- ^ Use --no-run and --compile options when using `stack script`
+  , configStackDeveloperMode  :: !Bool
+    -- ^ Turn on Stack developer mode for additional messages?
+  }
+
+-- | The project root directory, if in a project.
+configProjectRoot :: Config -> Maybe (Path Abs Dir)
+configProjectRoot c =
+  case configProject c of
+    PCProject (_, fp) -> Just $ parent fp
+    PCGlobalProject -> Nothing
+    PCNoProject _deps -> Nothing
+
+-- | Get the URL to request the information on the latest snapshots
+askLatestSnapshotUrl :: (MonadReader env m, HasConfig env) => m Text
+askLatestSnapshotUrl = view $ configL.to configLatestSnapshot
+
+-- | @STACK_ROOT\/hooks\/@
+hooksDir :: HasConfig env => RIO env (Path Abs Dir)
+hooksDir = do
+  sr <- view $ configL.to configStackRoot
+  pure (sr </> [reldir|hooks|])
+
+-- | @STACK_ROOT\/hooks\/ghc-install.sh@
+ghcInstallHook :: HasConfig env => RIO env (Path Abs File)
+ghcInstallHook = do
+  hd <- hooksDir
+  pure (hd </> [relfile|ghc-install.sh|])
+
+-----------------------------------
+-- Lens classes
+-----------------------------------
+
+-- | Class for environment values that can provide a 'Config'.
+class ( HasPlatform env
+      , HasGHCVariant env
+      , HasProcessContext env
+      , HasPantryConfig env
+      , HasTerm env
+      , HasRunner env
+      ) => HasConfig env where
+  configL :: Lens' env Config
+
+-----------------------------------
+-- Lens instances
+-----------------------------------
+
+instance HasPlatform Config where
+  platformL = lens configPlatform (\x y -> x { configPlatform = y })
+  platformVariantL =
+    lens configPlatformVariant (\x y -> x { configPlatformVariant = y })
+
+instance HasGHCVariant Config where
+  ghcVariantL = to $ fromMaybe GHCStandard . configGHCVariant
+
+instance HasProcessContext Config where
+  processContextL = runnerL.processContextL
+
+instance HasPantryConfig Config where
+  pantryConfigL = lens configPantryConfig (\x y -> x { configPantryConfig = y })
+
+instance HasConfig Config where
+  configL = id
+  {-# INLINE configL #-}
+
+instance HasRunner Config where
+  runnerL = lens configRunner (\x y -> x { configRunner = y })
+
+instance HasLogFunc Config where
+  logFuncL = runnerL.logFuncL
+
+instance HasStylesUpdate Config where
+  stylesUpdateL = runnerL.stylesUpdateL
+
+instance HasTerm Config where
+  useColorL = runnerL.useColorL
+  termWidthL = runnerL.termWidthL
+
+-----------------------------------
+-- Helper lenses
+-----------------------------------
+
+stackRootL :: HasConfig s => Lens' s (Path Abs Dir)
+stackRootL = configL.lens configStackRoot (\x y -> x { configStackRoot = y })
+
+stackGlobalConfigL :: HasConfig s => Lens' s (Path Abs File)
+stackGlobalConfigL =
+  configL.lens configUserConfigPath (\x y -> x { configUserConfigPath = y })
+
+buildOptsL :: HasConfig s => Lens' s BuildOpts
+buildOptsL = configL.lens
+  configBuild
+  (\x y -> x { configBuild = y })
+
+envOverrideSettingsL ::
+     HasConfig env
+  => Lens' env (EnvSettings -> IO ProcessContext)
+envOverrideSettingsL = configL.lens
+  configProcessContextSettings
+  (\x y -> x { configProcessContextSettings = y })
+
+-- | @".stack-work"@
+workDirL :: HasConfig env => Lens' env (Path Rel Dir)
+workDirL = configL.lens configWorkDir (\x y -> x { configWorkDir = y })
 
 -- | In dev mode, print as a warning, otherwise as debug
 prettyStackDevL :: HasConfig env => [StyleDoc] -> RIO env ()
− src/Stack/Types/Config/Build.hs 
@@ -1,516 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-
--- | Configuration options for building.
-
-module Stack.Types.Config.Build
-    (
-      BuildOpts (..)
-    , BuildCommand (..)
-    , defaultBuildOpts
-    , defaultBuildOptsCLI
-    , BuildOptsCLI (..)
-    , BuildOptsMonoid (..)
-    , TestOpts (..)
-    , defaultTestOpts
-    , TestOptsMonoid (..)
-    , HaddockOpts (..)
-    , defaultHaddockOpts
-    , HaddockOptsMonoid (..)
-    , BenchmarkOpts (..)
-    , defaultBenchmarkOpts
-    , BenchmarkOptsMonoid (..)
-    , FileWatchOpts (..)
-    , BuildSubset (..)
-    , ApplyCLIFlag (..)
-    , boptsCLIFlagsByName
-    , CabalVerbosity (..)
-    , toFirstCabalVerbosity
-    )
-    where
-
-import qualified Data.Map.Strict as Map
-import qualified Data.Text as T
-import           Distribution.Parsec ( Parsec (..), simpleParsec )
-import           Distribution.Verbosity ( Verbosity, normal, verbose )
-import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
-import           Pantry.Internal.AesonExtended
-import           Stack.Prelude
-
--- | Build options that is interpreted by the build command.
---   This is built up from BuildOptsCLI and BuildOptsMonoid
-data BuildOpts =
-  BuildOpts {boptsLibProfile :: !Bool
-            ,boptsExeProfile :: !Bool
-            ,boptsLibStrip :: !Bool
-            ,boptsExeStrip :: !Bool
-            ,boptsHaddock :: !Bool
-            -- ^ Build haddocks?
-            ,boptsHaddockOpts :: !HaddockOpts
-            -- ^ Options to pass to haddock
-            ,boptsOpenHaddocks :: !Bool
-            -- ^ Open haddocks in the browser?
-            ,boptsHaddockDeps :: !(Maybe Bool)
-            -- ^ Build haddocks for dependencies?
-            ,boptsHaddockInternal :: !Bool
-            -- ^ Build haddocks for all symbols and packages, like @cabal haddock --internal@
-            ,boptsHaddockHyperlinkSource  :: !Bool
-            -- ^ Build hyperlinked source if possible. Fallback to
-            -- @hscolour@. Disable for no sources.
-            ,boptsInstallExes :: !Bool
-            -- ^ Install executables to user path after building?
-            ,boptsInstallCompilerTool :: !Bool
-            -- ^ Install executables to compiler tools path after building?
-            ,boptsPreFetch :: !Bool
-            -- ^ Fetch all packages immediately
-            -- ^ Watch files for changes and automatically rebuild
-            ,boptsKeepGoing :: !(Maybe Bool)
-            -- ^ Keep building/running after failure
-            ,boptsKeepTmpFiles :: !Bool
-            -- ^ Keep intermediate files and build directories
-            ,boptsForceDirty :: !Bool
-            -- ^ Force treating all local packages as having dirty files
-
-            ,boptsTests :: !Bool
-            -- ^ Turn on tests for local targets
-            ,boptsTestOpts :: !TestOpts
-            -- ^ Additional test arguments
-
-            ,boptsBenchmarks :: !Bool
-            -- ^ Turn on benchmarks for local targets
-            ,boptsBenchmarkOpts :: !BenchmarkOpts
-            -- ^ Additional test arguments
-            -- ^ Commands (with arguments) to run after a successful build
-            -- ^ Only perform the configure step when building
-            ,boptsReconfigure :: !Bool
-            -- ^ Perform the configure step even if already configured
-            ,boptsCabalVerbose :: !CabalVerbosity
-            -- ^ Ask Cabal to be verbose in its builds
-            ,boptsSplitObjs :: !Bool
-            -- ^ Whether to enable split-objs.
-            ,boptsSkipComponents :: ![Text]
-            -- ^ Which components to skip when building
-            ,boptsInterleavedOutput :: !Bool
-            -- ^ Should we use the interleaved GHC output when building
-            -- multiple packages?
-            ,boptsDdumpDir :: !(Maybe Text)
-            }
-  deriving (Show)
-
-defaultBuildOpts :: BuildOpts
-defaultBuildOpts = BuildOpts
-    { boptsLibProfile = defaultFirstFalse buildMonoidLibProfile
-    , boptsExeProfile = defaultFirstFalse buildMonoidExeProfile
-    , boptsLibStrip = defaultFirstTrue buildMonoidLibStrip
-    , boptsExeStrip = defaultFirstTrue buildMonoidExeStrip
-    , boptsHaddock = False
-    , boptsHaddockOpts = defaultHaddockOpts
-    , boptsOpenHaddocks = defaultFirstFalse buildMonoidOpenHaddocks
-    , boptsHaddockDeps = Nothing
-    , boptsHaddockInternal = defaultFirstFalse buildMonoidHaddockInternal
-    , boptsHaddockHyperlinkSource = defaultFirstTrue buildMonoidHaddockHyperlinkSource
-    , boptsInstallExes = defaultFirstFalse buildMonoidInstallExes
-    , boptsInstallCompilerTool = defaultFirstFalse buildMonoidInstallCompilerTool
-    , boptsPreFetch = defaultFirstFalse buildMonoidPreFetch
-    , boptsKeepGoing = Nothing
-    , boptsKeepTmpFiles = defaultFirstFalse buildMonoidKeepTmpFiles
-    , boptsForceDirty = defaultFirstFalse buildMonoidForceDirty
-    , boptsTests = defaultFirstFalse buildMonoidTests
-    , boptsTestOpts = defaultTestOpts
-    , boptsBenchmarks = defaultFirstFalse buildMonoidBenchmarks
-    , boptsBenchmarkOpts = defaultBenchmarkOpts
-    , boptsReconfigure = defaultFirstFalse buildMonoidReconfigure
-    , boptsCabalVerbose = CabalVerbosity normal
-    , boptsSplitObjs = defaultFirstFalse buildMonoidSplitObjs
-    , boptsSkipComponents = []
-    , boptsInterleavedOutput = defaultFirstTrue buildMonoidInterleavedOutput
-    , boptsDdumpDir = Nothing
-    }
-
-defaultBuildOptsCLI ::BuildOptsCLI
-defaultBuildOptsCLI = BuildOptsCLI
-    { boptsCLITargets = []
-    , boptsCLIDryrun = False
-    , boptsCLIFlags = Map.empty
-    , boptsCLIGhcOptions = []
-    , boptsCLIBuildSubset = BSAll
-    , boptsCLIFileWatch = NoFileWatch
-    , boptsCLIWatchAll = False
-    , boptsCLIExec = []
-    , boptsCLIOnlyConfigure = False
-    , boptsCLICommand = Build
-    , boptsCLIInitialBuildSteps = False
-    }
-
--- | How to apply a CLI flag
-data ApplyCLIFlag
-  = ACFAllProjectPackages
-  -- ^ Apply to all project packages which have such a flag name available.
-  | ACFByName !PackageName
-  -- ^ Apply to the specified package only.
-  deriving (Show, Eq, Ord)
-
--- | Only flags set via 'ACFByName'
-boptsCLIFlagsByName :: BuildOptsCLI -> Map PackageName (Map FlagName Bool)
-boptsCLIFlagsByName =
-  Map.fromList .
-  mapMaybe go .
-  Map.toList .
-  boptsCLIFlags
-  where
-    go (ACFAllProjectPackages, _) = Nothing
-    go (ACFByName name, flags) = Just (name, flags)
-
--- | Build options that may only be specified from the CLI
-data BuildOptsCLI = BuildOptsCLI
-    { boptsCLITargets :: ![Text]
-    , boptsCLIDryrun :: !Bool
-    , boptsCLIGhcOptions :: ![Text]
-    , boptsCLIFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
-    , boptsCLIBuildSubset :: !BuildSubset
-    , boptsCLIFileWatch :: !FileWatchOpts
-    , boptsCLIWatchAll :: !Bool
-    , boptsCLIExec :: ![(String, [String])]
-    , boptsCLIOnlyConfigure :: !Bool
-    , boptsCLICommand :: !BuildCommand
-    , boptsCLIInitialBuildSteps :: !Bool
-    } deriving Show
-
--- | Command sum type for conditional arguments.
-data BuildCommand
-    = Build
-    | Test
-    | Haddock
-    | Bench
-    | Install
-    deriving (Eq, Show)
-
--- | Build options that may be specified in the stack.yaml or from the CLI
-data BuildOptsMonoid = BuildOptsMonoid
-    { buildMonoidTrace :: !Any
-    , buildMonoidProfile :: !Any
-    , buildMonoidNoStrip :: !Any
-    , buildMonoidLibProfile :: !FirstFalse
-    , buildMonoidExeProfile :: !FirstFalse
-    , buildMonoidLibStrip :: !FirstTrue
-    , buildMonoidExeStrip :: !FirstTrue
-    , buildMonoidHaddock :: !FirstFalse
-    , buildMonoidHaddockOpts :: !HaddockOptsMonoid
-    , buildMonoidOpenHaddocks :: !FirstFalse
-    , buildMonoidHaddockDeps :: !(First Bool)
-    , buildMonoidHaddockInternal :: !FirstFalse
-    , buildMonoidHaddockHyperlinkSource :: !FirstTrue
-    , buildMonoidInstallExes :: !FirstFalse
-    , buildMonoidInstallCompilerTool :: !FirstFalse
-    , buildMonoidPreFetch :: !FirstFalse
-    , buildMonoidKeepGoing :: !(First Bool)
-    , buildMonoidKeepTmpFiles :: !FirstFalse
-    , buildMonoidForceDirty :: !FirstFalse
-    , buildMonoidTests :: !FirstFalse
-    , buildMonoidTestOpts :: !TestOptsMonoid
-    , buildMonoidBenchmarks :: !FirstFalse
-    , buildMonoidBenchmarkOpts :: !BenchmarkOptsMonoid
-    , buildMonoidReconfigure :: !FirstFalse
-    , buildMonoidCabalVerbose :: !(First CabalVerbosity)
-    , buildMonoidSplitObjs :: !FirstFalse
-    , buildMonoidSkipComponents :: ![Text]
-    , buildMonoidInterleavedOutput :: !FirstTrue
-    , buildMonoidDdumpDir :: !(First Text)
-    } deriving (Show, Generic)
-
-instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
-  parseJSON = withObjectWarnings "BuildOptsMonoid"
-    (\o -> do let buildMonoidTrace = Any False
-                  buildMonoidProfile = Any False
-                  buildMonoidNoStrip = Any False
-              buildMonoidLibProfile <- FirstFalse <$> o ..:? buildMonoidLibProfileArgName
-              buildMonoidExeProfile <-FirstFalse <$>  o ..:? buildMonoidExeProfileArgName
-              buildMonoidLibStrip <- FirstTrue <$> o ..:? buildMonoidLibStripArgName
-              buildMonoidExeStrip <-FirstTrue <$>  o ..:? buildMonoidExeStripArgName
-              buildMonoidHaddock <- FirstFalse <$> o ..:? buildMonoidHaddockArgName
-              buildMonoidHaddockOpts <- jsonSubWarnings (o ..:? buildMonoidHaddockOptsArgName ..!= mempty)
-              buildMonoidOpenHaddocks <- FirstFalse <$> o ..:? buildMonoidOpenHaddocksArgName
-              buildMonoidHaddockDeps <- First <$> o ..:? buildMonoidHaddockDepsArgName
-              buildMonoidHaddockInternal <- FirstFalse <$> o ..:? buildMonoidHaddockInternalArgName
-              buildMonoidHaddockHyperlinkSource <- FirstTrue <$> o ..:? buildMonoidHaddockHyperlinkSourceArgName
-              buildMonoidInstallExes <- FirstFalse <$> o ..:? buildMonoidInstallExesArgName
-              buildMonoidInstallCompilerTool <- FirstFalse <$> o ..:? buildMonoidInstallCompilerToolArgName
-              buildMonoidPreFetch <- FirstFalse <$> o ..:? buildMonoidPreFetchArgName
-              buildMonoidKeepGoing <- First <$> o ..:? buildMonoidKeepGoingArgName
-              buildMonoidKeepTmpFiles <- FirstFalse <$> o ..:? buildMonoidKeepTmpFilesArgName
-              buildMonoidForceDirty <- FirstFalse <$> o ..:? buildMonoidForceDirtyArgName
-              buildMonoidTests <- FirstFalse <$> o ..:? buildMonoidTestsArgName
-              buildMonoidTestOpts <- jsonSubWarnings (o ..:? buildMonoidTestOptsArgName ..!= mempty)
-              buildMonoidBenchmarks <- FirstFalse <$> o ..:? buildMonoidBenchmarksArgName
-              buildMonoidBenchmarkOpts <- jsonSubWarnings (o ..:? buildMonoidBenchmarkOptsArgName ..!= mempty)
-              buildMonoidReconfigure <- FirstFalse <$> o ..:? buildMonoidReconfigureArgName
-              cabalVerbosity <- First <$> o ..:? buildMonoidCabalVerbosityArgName
-              cabalVerbose <- FirstFalse <$> o ..:? buildMonoidCabalVerboseArgName
-              let buildMonoidCabalVerbose = cabalVerbosity <> toFirstCabalVerbosity cabalVerbose
-              buildMonoidSplitObjs <- FirstFalse <$> o ..:? buildMonoidSplitObjsName
-              buildMonoidSkipComponents <- o ..:? buildMonoidSkipComponentsName ..!= mempty
-              buildMonoidInterleavedOutput <- FirstTrue <$> o ..:? buildMonoidInterleavedOutputName
-              buildMonoidDdumpDir <- o ..:? buildMonoidDdumpDirName ..!= mempty
-              pure BuildOptsMonoid{..})
-
-buildMonoidLibProfileArgName :: Text
-buildMonoidLibProfileArgName = "library-profiling"
-
-buildMonoidExeProfileArgName :: Text
-buildMonoidExeProfileArgName = "executable-profiling"
-
-buildMonoidLibStripArgName :: Text
-buildMonoidLibStripArgName = "library-stripping"
-
-buildMonoidExeStripArgName :: Text
-buildMonoidExeStripArgName = "executable-stripping"
-
-buildMonoidHaddockArgName :: Text
-buildMonoidHaddockArgName = "haddock"
-
-buildMonoidHaddockOptsArgName :: Text
-buildMonoidHaddockOptsArgName = "haddock-arguments"
-
-buildMonoidOpenHaddocksArgName :: Text
-buildMonoidOpenHaddocksArgName = "open-haddocks"
-
-buildMonoidHaddockDepsArgName :: Text
-buildMonoidHaddockDepsArgName = "haddock-deps"
-
-buildMonoidHaddockInternalArgName :: Text
-buildMonoidHaddockInternalArgName = "haddock-internal"
-
-buildMonoidHaddockHyperlinkSourceArgName :: Text
-buildMonoidHaddockHyperlinkSourceArgName = "haddock-hyperlink-source"
-
-buildMonoidInstallExesArgName :: Text
-buildMonoidInstallExesArgName = "copy-bins"
-
-buildMonoidInstallCompilerToolArgName :: Text
-buildMonoidInstallCompilerToolArgName = "copy-compiler-tool"
-
-buildMonoidPreFetchArgName :: Text
-buildMonoidPreFetchArgName = "prefetch"
-
-buildMonoidKeepGoingArgName :: Text
-buildMonoidKeepGoingArgName = "keep-going"
-
-buildMonoidKeepTmpFilesArgName :: Text
-buildMonoidKeepTmpFilesArgName = "keep-tmp-files"
-
-buildMonoidForceDirtyArgName :: Text
-buildMonoidForceDirtyArgName = "force-dirty"
-
-buildMonoidTestsArgName :: Text
-buildMonoidTestsArgName = "test"
-
-buildMonoidTestOptsArgName :: Text
-buildMonoidTestOptsArgName = "test-arguments"
-
-buildMonoidBenchmarksArgName :: Text
-buildMonoidBenchmarksArgName = "bench"
-
-buildMonoidBenchmarkOptsArgName :: Text
-buildMonoidBenchmarkOptsArgName = "benchmark-opts"
-
-buildMonoidReconfigureArgName :: Text
-buildMonoidReconfigureArgName = "reconfigure"
-
-buildMonoidCabalVerbosityArgName :: Text
-buildMonoidCabalVerbosityArgName = "cabal-verbosity"
-
-buildMonoidCabalVerboseArgName :: Text
-buildMonoidCabalVerboseArgName = "cabal-verbose"
-
-buildMonoidSplitObjsName :: Text
-buildMonoidSplitObjsName = "split-objs"
-
-buildMonoidSkipComponentsName :: Text
-buildMonoidSkipComponentsName = "skip-components"
-
-buildMonoidInterleavedOutputName :: Text
-buildMonoidInterleavedOutputName = "interleaved-output"
-
-buildMonoidDdumpDirName :: Text
-buildMonoidDdumpDirName = "ddump-dir"
-
-instance Semigroup BuildOptsMonoid where
-    (<>) = mappenddefault
-
-instance Monoid BuildOptsMonoid where
-    mempty = memptydefault
-    mappend = (<>)
-
--- | Which subset of packages to build
-data BuildSubset
-    = BSAll
-    | BSOnlySnapshot
-    -- ^ Only install packages in the snapshot database, skipping
-    -- packages intended for the local database.
-    | BSOnlyDependencies
-    | BSOnlyLocals
-    -- ^ Refuse to build anything in the snapshot database, see
-    -- https://github.com/commercialhaskell/stack/issues/5272
-    deriving (Show, Eq)
-
--- | Options for the 'FinalAction' 'DoTests'
-data TestOpts =
-  TestOpts {toRerunTests :: !Bool -- ^ Whether successful tests will be run gain
-           ,toAdditionalArgs :: ![String] -- ^ Arguments passed to the test program
-           ,toCoverage :: !Bool -- ^ Generate a code coverage report
-           ,toDisableRun :: !Bool -- ^ Disable running of tests
-           ,toMaximumTimeSeconds :: !(Maybe Int) -- ^ test suite timeout in seconds
-           ,toAllowStdin :: !Bool -- ^ Whether to allow standard input
-           } deriving (Eq,Show)
-
-defaultTestOpts :: TestOpts
-defaultTestOpts = TestOpts
-    { toRerunTests = defaultFirstTrue toMonoidRerunTests
-    , toAdditionalArgs = []
-    , toCoverage = defaultFirstFalse toMonoidCoverage
-    , toDisableRun = defaultFirstFalse toMonoidDisableRun
-    , toMaximumTimeSeconds = Nothing
-    , toAllowStdin = defaultFirstTrue toMonoidAllowStdin
-    }
-
-data TestOptsMonoid =
-  TestOptsMonoid
-    { toMonoidRerunTests :: !FirstTrue
-    , toMonoidAdditionalArgs :: ![String]
-    , toMonoidCoverage :: !FirstFalse
-    , toMonoidDisableRun :: !FirstFalse
-    , toMonoidMaximumTimeSeconds :: !(First (Maybe Int))
-    , toMonoidAllowStdin :: !FirstTrue
-    } deriving (Show, Generic)
-
-instance FromJSON (WithJSONWarnings TestOptsMonoid) where
-  parseJSON = withObjectWarnings "TestOptsMonoid"
-    (\o -> do toMonoidRerunTests <- FirstTrue <$> o ..:? toMonoidRerunTestsArgName
-              toMonoidAdditionalArgs <- o ..:? toMonoidAdditionalArgsName ..!= []
-              toMonoidCoverage <- FirstFalse <$> o ..:? toMonoidCoverageArgName
-              toMonoidDisableRun <- FirstFalse <$> o ..:? toMonoidDisableRunArgName
-              toMonoidMaximumTimeSeconds <- First <$> o ..:? toMonoidMaximumTimeSecondsArgName
-              toMonoidAllowStdin <- FirstTrue <$> o ..:? toMonoidTestsAllowStdinName
-              pure TestOptsMonoid{..})
-
-toMonoidRerunTestsArgName :: Text
-toMonoidRerunTestsArgName = "rerun-tests"
-
-toMonoidAdditionalArgsName :: Text
-toMonoidAdditionalArgsName = "additional-args"
-
-toMonoidCoverageArgName :: Text
-toMonoidCoverageArgName = "coverage"
-
-toMonoidDisableRunArgName :: Text
-toMonoidDisableRunArgName = "no-run-tests"
-
-toMonoidMaximumTimeSecondsArgName :: Text
-toMonoidMaximumTimeSecondsArgName = "test-suite-timeout"
-
-toMonoidTestsAllowStdinName :: Text
-toMonoidTestsAllowStdinName = "tests-allow-stdin"
-
-instance Semigroup TestOptsMonoid where
-  (<>) = mappenddefault
-
-instance Monoid TestOptsMonoid where
-  mempty = memptydefault
-  mappend = (<>)
-
-
-
--- | Haddock Options
-newtype HaddockOpts =
-  HaddockOpts { hoAdditionalArgs :: [String] -- ^ Arguments passed to haddock program
-              } deriving (Eq,Show)
-
-newtype HaddockOptsMonoid =
-  HaddockOptsMonoid {hoMonoidAdditionalArgs :: [String]
-                    } deriving (Show, Generic)
-
-defaultHaddockOpts :: HaddockOpts
-defaultHaddockOpts = HaddockOpts {hoAdditionalArgs = []}
-
-instance FromJSON (WithJSONWarnings HaddockOptsMonoid) where
-  parseJSON = withObjectWarnings "HaddockOptsMonoid"
-    (\o -> do hoMonoidAdditionalArgs <- o ..:? hoMonoidAdditionalArgsName ..!= []
-              pure HaddockOptsMonoid{..})
-
-instance Semigroup HaddockOptsMonoid where
-  (<>) = mappenddefault
-
-instance Monoid HaddockOptsMonoid where
-  mempty = memptydefault
-  mappend = (<>)
-
-hoMonoidAdditionalArgsName :: Text
-hoMonoidAdditionalArgsName = "haddock-args"
-
-
--- | Options for the 'FinalAction' 'DoBenchmarks'
-data BenchmarkOpts =
-  BenchmarkOpts
-    { beoAdditionalArgs :: !(Maybe String) -- ^ Arguments passed to the benchmark program
-    , beoDisableRun :: !Bool -- ^ Disable running of benchmarks
-    } deriving (Eq,Show)
-
-defaultBenchmarkOpts :: BenchmarkOpts
-defaultBenchmarkOpts = BenchmarkOpts
-    { beoAdditionalArgs = Nothing
-    , beoDisableRun = False
-    }
-
-data BenchmarkOptsMonoid =
-  BenchmarkOptsMonoid
-     { beoMonoidAdditionalArgs :: !(First String)
-     , beoMonoidDisableRun :: !(First Bool)
-     } deriving (Show, Generic)
-
-instance FromJSON (WithJSONWarnings BenchmarkOptsMonoid) where
-  parseJSON = withObjectWarnings "BenchmarkOptsMonoid"
-    (\o -> do beoMonoidAdditionalArgs <- First <$> o ..:? beoMonoidAdditionalArgsArgName
-              beoMonoidDisableRun <- First <$> o ..:? beoMonoidDisableRunArgName
-              pure BenchmarkOptsMonoid{..})
-
-beoMonoidAdditionalArgsArgName :: Text
-beoMonoidAdditionalArgsArgName = "benchmark-arguments"
-
-beoMonoidDisableRunArgName :: Text
-beoMonoidDisableRunArgName = "no-run-benchmarks"
-
-instance Semigroup BenchmarkOptsMonoid where
-  (<>) = mappenddefault
-
-instance Monoid BenchmarkOptsMonoid where
-  mempty = memptydefault
-  mappend = (<>)
-
-data FileWatchOpts
-  = NoFileWatch
-  | FileWatch
-  | FileWatchPoll
-  deriving (Show,Eq)
-
-newtype CabalVerbosity = CabalVerbosity Verbosity
-  deriving (Eq, Show)
-
-toFirstCabalVerbosity :: FirstFalse -> First CabalVerbosity
-toFirstCabalVerbosity vf = First $ getFirstFalse vf <&> \p ->
-  if p then verboseLevel else normalLevel
- where
-  verboseLevel = CabalVerbosity verbose
-  normalLevel  = CabalVerbosity normal
-
-instance FromJSON CabalVerbosity where
-
-  parseJSON = withText "CabalVerbosity" $ \t ->
-    let s = T.unpack t
-        errMsg = fail $ "Unrecognised Cabal verbosity: " ++ s
-    in  maybe errMsg pure (simpleParsec s)
-
-instance Parsec CabalVerbosity where
-  parsec = CabalVerbosity <$> parsec
+ src/Stack/Types/Config/Exception.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+
+module Stack.Types.Config.Exception
+  ( ConfigException (..)
+  , ConfigPrettyException (..)
+  , ParseAbsolutePathException (..)
+  , packageIndicesWarning
+  ) where
+
+import qualified Data.Text as T
+import           Data.Yaml ( ParseException )
+import qualified Data.Yaml as Yaml
+import           Path( dirname, filename )
+import           Stack.Prelude
+import           Stack.Types.ConfigMonoid
+                   ( configMonoidAllowDifferentUserName
+                   , configMonoidGHCVariantName, configMonoidSystemGHCName
+                   )
+import           Stack.Types.Version
+                   ( VersionRange, stackVersion, versionRangeText )
+
+-- | Type representing exceptions thrown by functions exported by the
+-- "Stack.Config" module.
+data ConfigException
+  = ParseCustomSnapshotException Text ParseException
+  | NoProjectConfigFound (Path Abs Dir) (Maybe Text)
+  | UnexpectedArchiveContents [Path Abs Dir] [Path Abs File]
+  | UnableToExtractArchive Text (Path Abs File)
+  | BadStackVersionException VersionRange
+  | NoSuchDirectory FilePath
+  | ParseGHCVariantException String
+  | BadStackRoot (Path Abs Dir)
+  | Won'tCreateStackRootInDirectoryOwnedByDifferentUser
+      (Path Abs Dir)
+      (Path Abs Dir)
+    -- ^ @$STACK_ROOT@, parent dir
+  | UserDoesn'tOwnDirectory (Path Abs Dir)
+  | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC
+  | NixRequiresSystemGhc
+  | NoResolverWhenUsingNoProject
+  | NoLTSWithMajorVersion Int
+  | NoLTSFound
+  deriving (Show, Typeable)
+
+instance Exception ConfigException where
+  displayException (ParseCustomSnapshotException url exception) = concat
+    [ "Error: [S-8981]\n"
+    , "Could not parse '"
+    , T.unpack url
+    , "':\n"
+    , Yaml.prettyPrintParseException exception
+    , "\nSee https://docs.haskellstack.org/en/stable/custom_snapshot/"
+    ]
+  displayException (NoProjectConfigFound dir mcmd) = concat
+    [ "Error: [S-2206]\n"
+    , "Unable to find a stack.yaml file in the current directory ("
+    , toFilePath dir
+    , ") or its ancestors"
+    , case mcmd of
+        Nothing -> ""
+        Just cmd -> "\nRecommended action: stack " ++ T.unpack cmd
+    ]
+  displayException (UnexpectedArchiveContents dirs files) = concat
+    [ "Error: [S-4964]\n"
+    , "When unpacking an archive specified in your stack.yaml file, "
+    , "did not find expected contents. Expected: a single directory. Found: "
+    , show ( map (toFilePath . dirname) dirs
+           , map (toFilePath . filename) files
+           )
+    ]
+  displayException (UnableToExtractArchive url file) = concat
+    [ "Error: [S-2040]\n"
+    , "Archive extraction failed. Tarballs and zip archives are supported, \
+      \couldn't handle the following URL, "
+    , T.unpack url
+    , " downloaded to the file "
+    , toFilePath $ filename file
+    ]
+  displayException (BadStackVersionException requiredRange) = concat
+    [ "Error: [S-1641]\n"
+    , "The version of Stack you are using ("
+    , show stackVersion
+    , ") is outside the required\n"
+    ,"version range specified in stack.yaml ("
+    , T.unpack (versionRangeText requiredRange)
+    , ").\n"
+    , "You can upgrade Stack by running:\n\n"
+    , "stack upgrade"
+    ]
+  displayException (NoSuchDirectory dir) = concat
+    [ "Error: [S-8773]\n"
+    , "No directory could be located matching the supplied path: "
+    , dir
+    ]
+  displayException (ParseGHCVariantException v) = concat
+    [ "Error: [S-3938]\n"
+    , "Invalid ghc-variant value: "
+    , v
+    ]
+  displayException (BadStackRoot stackRoot) = concat
+    [ "Error: [S-8530]\n"
+    , "Invalid Stack root: '"
+    , toFilePath stackRoot
+    , "'. Please provide a valid absolute path."
+    ]
+  displayException (Won'tCreateStackRootInDirectoryOwnedByDifferentUser envStackRoot parentDir) = concat
+    [ "Error: [S-7613]\n"
+    , "Preventing creation of Stack root '"
+    , toFilePath envStackRoot
+    , "'. Parent directory '"
+    , toFilePath parentDir
+    , "' is owned by someone else."
+    ]
+  displayException (UserDoesn'tOwnDirectory dir) = concat
+    [ "Error: [S-8707]\n"
+    , "You are not the owner of '"
+    , toFilePath dir
+    , "'. Aborting to protect file permissions."
+    , "\nRetry with '--"
+    , T.unpack configMonoidAllowDifferentUserName
+    , "' to disable this precaution."
+    ]
+  displayException ManualGHCVariantSettingsAreIncompatibleWithSystemGHC = T.unpack $ T.concat
+    [ "Error: [S-3605]\n"
+    , "Stack can only control the "
+    , configMonoidGHCVariantName
+    , " of its own GHC installations. Please use '--no-"
+    , configMonoidSystemGHCName
+    , "'."
+    ]
+  displayException NixRequiresSystemGhc = T.unpack $ T.concat
+    [ "Error: [S-6816]\n"
+    , "Stack's Nix integration is incompatible with '--no-system-ghc'. "
+    , "Please use '--"
+    , configMonoidSystemGHCName
+    , "' or disable the Nix integration."
+    ]
+  displayException NoResolverWhenUsingNoProject =
+    "Error: [S-5027]\n"
+    ++ "When using the script command, you must provide a resolver argument"
+  displayException (NoLTSWithMajorVersion n) = concat
+    [ "Error: [S-3803]\n"
+    , "No LTS release found with major version "
+    , show n
+    , "."
+    ]
+  displayException NoLTSFound =
+    "Error: [S-5472]\n"
+    ++ "No LTS releases found."
+
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
+-- "Stack.Config" module.
+data ConfigPrettyException
+  = ParseConfigFileException !(Path Abs File) !ParseException
+  | StackWorkEnvNotRelativeDir !String
+  | MultiplePackageIndices [PackageIndexConfig]
+  | DuplicateLocalPackageNames ![(PackageName, [PackageLocation])]
+  deriving (Show, Typeable)
+
+instance Pretty ConfigPrettyException where
+  pretty (ParseConfigFileException configFile exception) =
+    "[S-6602]"
+    <> line
+    <> fillSep
+         [ flow "Stack could not load and parse"
+         , pretty configFile
+         , flow "as a YAML configuraton file."
+         ]
+    <> blankLine
+    <> flow "While loading and parsing, Stack encountered the following \
+            \error:"
+    <> blankLine
+    <> string (Yaml.prettyPrintParseException exception)
+    <> blankLine
+    <> fillSep
+         [ flow "For help about the content of Stack's YAML configuration \
+                \files, see (for the most recent release of Stack)"
+         ,    style
+                Url
+                "http://docs.haskellstack.org/en/stable/yaml_configuration/"
+           <> "."
+         ]
+  pretty (StackWorkEnvNotRelativeDir x) =
+    "[S-7462]"
+    <> line
+    <> flow "Stack failed to interpret the value of the STACK_WORK \
+            \environment variable as a valid relative path to a directory. \
+            \Stack will not accept an absolute path. A path containing a \
+            \.. (parent directory) component is not valid."
+    <> blankLine
+    <> fillSep
+         [ flow "If set, Stack expects the value to identify the location \
+                \of Stack's work directory, relative to the root directory \
+                \of the project or package. Stack encountered the value:"
+         , style Error (fromString x) <> "."
+         ]
+  pretty (MultiplePackageIndices pics) =
+    "[S-3251]"
+    <> line
+    <> fillSep
+         [ flow "When using the"
+         , style Shell "package-indices"
+         , flow "key to override the default package index, you must \
+                \provide exactly one value, received:"
+         , bulletedList (map (string . show) pics)
+         ]
+    <> blankLine
+    <> packageIndicesWarning
+  pretty (DuplicateLocalPackageNames pairs) =
+    "[S-5470]"
+    <> line
+    <> fillSep
+        [ flow "The same package name is used in more than one local package or"
+        , style Shell "extra-deps" <> "."
+        ]
+    <> mconcat (map go pairs)
+   where
+    go (name, dirs) =
+         blankLine
+      <> fillSep
+           [ style Error (fromString $ packageNameString name)
+           , flow "used in:"
+           ]
+      <> line
+      <> bulletedList (map (fromString . T.unpack . textDisplay) dirs)
+
+instance Exception ConfigPrettyException
+
+data ParseAbsolutePathException
+  = ParseAbsolutePathException String String
+  deriving (Show, Typeable)
+
+instance Exception ParseAbsolutePathException where
+  displayException (ParseAbsolutePathException envVar dir) = concat
+    [ "Error: [S-9437]\n"
+    , "Failed to parse "
+    , envVar
+    , " environment variable (expected absolute directory): "
+    , dir
+    ]
+
+packageIndicesWarning :: StyleDoc
+packageIndicesWarning =
+  fillSep
+    [ "The"
+    , style Shell "package-indices"
+    , flow "key is deprecated in favour of"
+    , style Shell "package-index" <> "."
+    ]
+ src/Stack/Types/ConfigMonoid.hs view
@@ -0,0 +1,522 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module Stack.Types.ConfigMonoid
+  ( ConfigMonoid (..)
+  , parseConfigMonoid
+  , parseConfigMonoidObject
+  , configMonoidAllowDifferentUserName
+  , configMonoidGHCVariantName
+  , configMonoidInstallGHCName
+  , configMonoidSystemGHCName
+  ) where
+
+import           Casa.Client ( CasaRepoPrefix )
+import           Control.Monad.Writer ( tell )
+import           Data.Coerce ( coerce )
+import qualified Data.Map as Map
+import qualified Data.Map.Strict as M
+import qualified Data.Monoid as Monoid
+import           Data.Monoid.Map ( MonoidMap (..) )
+import qualified Data.Yaml as Yaml
+import           Distribution.Version ( anyVersion )
+import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import           Pantry.Internal.AesonExtended
+                   ( Object, Value, WarningParser, WithJSONWarnings, (..:?)
+                   , (..!=), jsonSubWarnings, jsonSubWarningsT
+                   , jsonSubWarningsTT, withObjectWarnings
+                   )
+import           Stack.Prelude
+import           Stack.Types.AllowNewerDeps ( AllowNewerDeps )
+import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
+import           Stack.Types.ApplyProgOptions ( ApplyProgOptions (..) )
+import           Stack.Types.BuildOpts ( BuildOptsMonoid )
+import           Stack.Types.CabalConfigKey ( CabalConfigKey )
+import           Stack.Types.ColorWhen ( ColorWhen )
+import           Stack.Types.Compiler ( CompilerRepository )
+import           Stack.Types.CompilerBuild ( CompilerBuild )
+import           Stack.Types.Docker ( DockerOptsMonoid, VersionRangeJSON (..) )
+import           Stack.Types.DumpLogs ( DumpLogs )
+import           Stack.Types.GhcOptionKey ( GhcOptionKey (..) )
+import           Stack.Types.GhcOptions ( GhcOptions (..) )
+import           Stack.Types.GHCVariant ( GHCVariant )
+import           Stack.Types.Nix ( NixOptsMonoid )
+import           Stack.Types.PvpBounds ( PvpBounds )
+import           Stack.Types.SCM ( SCM )
+import           Stack.Types.SetupInfo ( SetupInfo )
+import           Stack.Types.TemplateName ( TemplateName )
+import           Stack.Types.Version
+                   ( IntersectingVersionRange (..), VersionCheck )
+import qualified System.FilePath as FilePath
+
+-- | An uninterpreted representation of configuration options.
+-- Configurations may be "cascaded" using mappend (left-biased).
+data ConfigMonoid = ConfigMonoid
+  { configMonoidStackRoot          :: !(First (Path Abs Dir))
+    -- ^ See: 'clStackRoot'
+  , configMonoidWorkDir            :: !(First (Path Rel Dir))
+    -- ^ See: 'configWorkDir'.
+  , configMonoidBuildOpts          :: !BuildOptsMonoid
+    -- ^ build options.
+  , configMonoidDockerOpts         :: !DockerOptsMonoid
+    -- ^ Docker options.
+  , configMonoidNixOpts            :: !NixOptsMonoid
+    -- ^ Options for the execution environment (nix-shell or container)
+  , configMonoidConnectionCount    :: !(First Int)
+    -- ^ See: 'configConnectionCount'
+  , configMonoidHideTHLoading      :: !FirstTrue
+    -- ^ See: 'configHideTHLoading'
+  , configMonoidPrefixTimestamps   :: !(First Bool)
+    -- ^ See: 'configPrefixTimestamps'
+  , configMonoidLatestSnapshot     :: !(First Text)
+    -- ^ See: 'configLatestSnapshot'
+  , configMonoidPackageIndex     :: !(First PackageIndexConfig)
+    -- ^ See: 'withPantryConfig'
+  , configMonoidPackageIndices     :: !(First [PackageIndexConfig])
+    -- ^ Deprecated in favour of package-index
+  , configMonoidSystemGHC          :: !(First Bool)
+    -- ^ See: 'configSystemGHC'
+  , configMonoidInstallGHC          :: !FirstTrue
+    -- ^ See: 'configInstallGHC'
+  , configMonoidSkipGHCCheck        :: !FirstFalse
+    -- ^ See: 'configSkipGHCCheck'
+  , configMonoidSkipMsys            :: !FirstFalse
+    -- ^ See: 'configSkipMsys'
+  , configMonoidCompilerCheck       :: !(First VersionCheck)
+    -- ^ See: 'configCompilerCheck'
+  , configMonoidCompilerRepository  :: !(First CompilerRepository)
+    -- ^ See: 'configCompilerRepository'
+  , configMonoidRequireStackVersion :: !IntersectingVersionRange
+    -- ^ See: 'configRequireStackVersion'
+  , configMonoidArch                :: !(First String)
+    -- ^ Used for overriding the platform
+  , configMonoidGHCVariant          :: !(First GHCVariant)
+    -- ^ Used for overriding the platform
+  , configMonoidGHCBuild            :: !(First CompilerBuild)
+    -- ^ Used for overriding the GHC build
+  , configMonoidJobs                :: !(First Int)
+    -- ^ See: 'configJobs'
+  , configMonoidExtraIncludeDirs    :: ![FilePath]
+    -- ^ See: 'configExtraIncludeDirs'
+  , configMonoidExtraLibDirs        :: ![FilePath]
+    -- ^ See: 'configExtraLibDirs'
+  , configMonoidCustomPreprocessorExts :: ![Text]
+    -- ^ See: 'configCustomPreprocessorExts'
+  , configMonoidOverrideGccPath    :: !(First (Path Abs File))
+    -- ^ Allow users to override the path to gcc
+  , configMonoidOverrideHpack       :: !(First FilePath)
+    -- ^ Use Hpack executable (overrides bundled Hpack)
+  , configMonoidConcurrentTests     :: !(First Bool)
+    -- ^ See: 'configConcurrentTests'
+  , configMonoidLocalBinPath        :: !(First FilePath)
+    -- ^ Used to override the binary installation dir
+  , configMonoidTemplateParameters  :: !(Map Text Text)
+    -- ^ Template parameters.
+  , configMonoidScmInit             :: !(First SCM)
+    -- ^ Initialize SCM (e.g. git init) when making new projects?
+  , configMonoidGhcOptionsByName    :: !(MonoidMap PackageName (Monoid.Dual [Text]))
+    -- ^ See 'configGhcOptionsByName'. Uses 'Monoid.Dual' so that
+    -- options from the configs on the right come first, so that they
+    -- can be overridden.
+  , configMonoidGhcOptionsByCat     :: !(MonoidMap ApplyGhcOptions (Monoid.Dual [Text]))
+    -- ^ See 'configGhcOptionsAll'. Uses 'Monoid.Dual' so that options
+    -- from the configs on the right come first, so that they can be
+    -- overridden.
+  , configMonoidCabalConfigOpts     :: !(MonoidMap CabalConfigKey (Monoid.Dual [Text]))
+    -- ^ See 'configCabalConfigOpts'.
+  , configMonoidExtraPath           :: ![Path Abs Dir]
+    -- ^ Additional paths to search for executables in
+  , configMonoidSetupInfoLocations  :: ![String]
+    -- ^ See 'configSetupInfoLocations'
+  , configMonoidSetupInfoInline     :: !SetupInfo
+    -- ^ See 'configSetupInfoInline'
+  , configMonoidLocalProgramsBase   :: !(First (Path Abs Dir))
+    -- ^ Override the default local programs dir, where e.g. GHC is installed.
+  , configMonoidPvpBounds           :: !(First PvpBounds)
+    -- ^ See 'configPvpBounds'
+  , configMonoidModifyCodePage      :: !FirstTrue
+    -- ^ See 'configModifyCodePage'
+  , configMonoidRebuildGhcOptions   :: !FirstFalse
+    -- ^ See 'configMonoidRebuildGhcOptions'
+  , configMonoidApplyGhcOptions     :: !(First ApplyGhcOptions)
+    -- ^ See 'configApplyGhcOptions'
+  , configMonoidApplyProgOptions     :: !(First ApplyProgOptions)
+    -- ^ See 'configApplyProgOptions'
+  , configMonoidAllowNewer          :: !(First Bool)
+    -- ^ See 'configMonoidAllowNewer'
+  , configMonoidAllowNewerDeps      :: !(Maybe AllowNewerDeps)
+    -- ^ See 'configMonoidAllowNewerDeps'
+  , configMonoidDefaultTemplate     :: !(First TemplateName)
+   -- ^ The default template to use when none is specified.
+   -- (If Nothing, the 'default' default template is used.)
+  , configMonoidAllowDifferentUser :: !(First Bool)
+   -- ^ Allow users other than the Stack root owner to use the Stack
+   -- installation.
+  , configMonoidDumpLogs           :: !(First DumpLogs)
+    -- ^ See 'configDumpLogs'
+  , configMonoidSaveHackageCreds   :: !(First Bool)
+    -- ^ See 'configSaveHackageCreds'
+  , configMonoidHackageBaseUrl     :: !(First Text)
+    -- ^ See 'configHackageBaseUrl'
+  , configMonoidColorWhen          :: !(First ColorWhen)
+    -- ^ When to use 'ANSI' colors
+  , configMonoidStyles             :: !StylesUpdate
+  , configMonoidHideSourcePaths    :: !FirstTrue
+    -- ^ See 'configHideSourcePaths'
+  , configMonoidRecommendUpgrade   :: !FirstTrue
+    -- ^ See 'configRecommendUpgrade'
+  , configMonoidCasaRepoPrefix     :: !(First CasaRepoPrefix)
+  , configMonoidSnapshotLocation :: !(First Text)
+    -- ^ Custom location of LTS/Nightly snapshots
+  , configMonoidNoRunCompile  :: !FirstFalse
+    -- ^ See: 'configNoRunCompile'
+  , configMonoidStackDeveloperMode :: !(First Bool)
+    -- ^ See 'configStackDeveloperMode'
+  }
+  deriving (Generic, Show)
+
+instance Semigroup ConfigMonoid where
+  (<>) = mappenddefault
+
+instance Monoid ConfigMonoid where
+  mempty = memptydefault
+  mappend = (<>)
+
+parseConfigMonoid ::
+     Path Abs Dir
+  -> Value
+  -> Yaml.Parser (WithJSONWarnings ConfigMonoid)
+parseConfigMonoid = withObjectWarnings "ConfigMonoid" . parseConfigMonoidObject
+
+-- | Parse a partial configuration.  Used both to parse both a standalone config
+-- file and a project file, so that a sub-parser is not required, which would
+-- interfere with warnings for missing fields.
+parseConfigMonoidObject :: Path Abs Dir -> Object -> WarningParser ConfigMonoid
+parseConfigMonoidObject rootDir obj = do
+  -- Parsing 'stackRoot' from 'stackRoot'/config.yaml would be nonsensical
+  let configMonoidStackRoot = First Nothing
+  configMonoidWorkDir <- First <$> obj ..:? configMonoidWorkDirName
+  configMonoidBuildOpts <-
+    jsonSubWarnings (obj ..:? configMonoidBuildOptsName ..!= mempty)
+  configMonoidDockerOpts <-
+    jsonSubWarnings (obj ..:? configMonoidDockerOptsName ..!= mempty)
+  configMonoidNixOpts <-
+    jsonSubWarnings (obj ..:? configMonoidNixOptsName ..!= mempty)
+  configMonoidConnectionCount <-
+    First <$> obj ..:? configMonoidConnectionCountName
+  configMonoidHideTHLoading <-
+    FirstTrue <$> obj ..:? configMonoidHideTHLoadingName
+  configMonoidPrefixTimestamps <-
+    First <$> obj ..:? configMonoidPrefixTimestampsName
+
+  murls :: Maybe Value <- obj ..:? configMonoidUrlsName
+  configMonoidLatestSnapshot <-
+    case murls of
+      Nothing -> pure $ First Nothing
+      Just urls -> jsonSubWarnings $ lift $ withObjectWarnings
+        "urls"
+        (\o -> First <$> o ..:? "latest-snapshot" :: WarningParser (First Text))
+        urls
+
+  configMonoidPackageIndex <-
+    First <$> jsonSubWarningsT (obj ..:?  configMonoidPackageIndexName)
+  configMonoidPackageIndices <-
+    First <$> jsonSubWarningsTT (obj ..:?  configMonoidPackageIndicesName)
+  configMonoidSystemGHC <- First <$> obj ..:? configMonoidSystemGHCName
+  configMonoidInstallGHC <- FirstTrue <$> obj ..:? configMonoidInstallGHCName
+  configMonoidSkipGHCCheck <-
+    FirstFalse <$> obj ..:? configMonoidSkipGHCCheckName
+  configMonoidSkipMsys <- FirstFalse <$> obj ..:? configMonoidSkipMsysName
+  configMonoidRequireStackVersion <-
+    IntersectingVersionRange . unVersionRangeJSON <$>
+      ( obj ..:? configMonoidRequireStackVersionName
+          ..!= VersionRangeJSON anyVersion
+      )
+  configMonoidArch <- First <$> obj ..:? configMonoidArchName
+  configMonoidGHCVariant <- First <$> obj ..:? configMonoidGHCVariantName
+  configMonoidGHCBuild <- First <$> obj ..:? configMonoidGHCBuildName
+  configMonoidJobs <- First <$> obj ..:? configMonoidJobsName
+  configMonoidExtraIncludeDirs <- map (toFilePath rootDir FilePath.</>) <$>
+    obj ..:?  configMonoidExtraIncludeDirsName ..!= []
+  configMonoidExtraLibDirs <- map (toFilePath rootDir FilePath.</>) <$>
+    obj ..:?  configMonoidExtraLibDirsName ..!= []
+  configMonoidCustomPreprocessorExts <-
+    obj ..:?  configMonoidCustomPreprocessorExtsName ..!= []
+  configMonoidOverrideGccPath <-
+    First <$> obj ..:? configMonoidOverrideGccPathName
+  configMonoidOverrideHpack <-
+    First <$> obj ..:? configMonoidOverrideHpackName
+  configMonoidConcurrentTests <-
+    First <$> obj ..:? configMonoidConcurrentTestsName
+  configMonoidLocalBinPath <- First <$> obj ..:? configMonoidLocalBinPathName
+  templates <- obj ..:? "templates"
+  (configMonoidScmInit,configMonoidTemplateParameters) <-
+    case templates of
+      Nothing -> pure (First Nothing,M.empty)
+      Just tobj -> do
+        scmInit <- tobj ..:? configMonoidScmInitName
+        params <- tobj ..:? configMonoidTemplateParametersName
+        pure (First scmInit,fromMaybe M.empty params)
+  configMonoidCompilerCheck <-
+    First <$> obj ..:? configMonoidCompilerCheckName
+  configMonoidCompilerRepository <-
+    First <$> (obj ..:? configMonoidCompilerRepositoryName)
+
+  options <-
+    Map.map unGhcOptions <$> obj ..:? configMonoidGhcOptionsName ..!= mempty
+
+  optionsEverything <-
+    case (Map.lookup GOKOldEverything options, Map.lookup GOKEverything options) of
+      (Just _, Just _) ->
+        fail "Cannot specify both `*` and `$everything` GHC options"
+      (Nothing, Just x) -> pure x
+      (Just x, Nothing) -> do
+        tell "The `*` ghc-options key is not recommended. Consider using \
+             \$locals, or if really needed, $everything"
+        pure x
+      (Nothing, Nothing) -> pure []
+
+  let configMonoidGhcOptionsByCat = coerce $ Map.fromList
+        [ (AGOEverything, optionsEverything)
+        , (AGOLocals, Map.findWithDefault [] GOKLocals options)
+        , (AGOTargets, Map.findWithDefault [] GOKTargets options)
+        ]
+
+      configMonoidGhcOptionsByName = coerce $ Map.fromList
+          [(name, opts) | (GOKPackage name, opts) <- Map.toList options]
+
+  configMonoidCabalConfigOpts' <-
+    obj ..:? configMonoidConfigureOptionsName ..!= mempty
+  let configMonoidCabalConfigOpts =
+        coerce (configMonoidCabalConfigOpts' :: Map CabalConfigKey [Text])
+
+  configMonoidExtraPath <- obj ..:? configMonoidExtraPathName ..!= []
+  configMonoidSetupInfoLocations <-
+    obj ..:? configMonoidSetupInfoLocationsName ..!= []
+  configMonoidSetupInfoInline <-
+    jsonSubWarningsT (obj ..:? configMonoidSetupInfoInlineName) ..!= mempty
+  configMonoidLocalProgramsBase <-
+    First <$> obj ..:? configMonoidLocalProgramsBaseName
+  configMonoidPvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName
+  configMonoidModifyCodePage <-
+    FirstTrue <$> obj ..:? configMonoidModifyCodePageName
+  configMonoidRebuildGhcOptions <-
+    FirstFalse <$> obj ..:? configMonoidRebuildGhcOptionsName
+  configMonoidApplyGhcOptions <-
+    First <$> obj ..:? configMonoidApplyGhcOptionsName
+  configMonoidApplyProgOptions <-
+    First <$> obj ..:? configMonoidApplyProgOptionsName
+  configMonoidAllowNewer <- First <$> obj ..:? configMonoidAllowNewerName
+  configMonoidAllowNewerDeps <- obj ..:? configMonoidAllowNewerDepsName
+  configMonoidDefaultTemplate <-
+    First <$> obj ..:? configMonoidDefaultTemplateName
+  configMonoidAllowDifferentUser <-
+    First <$> obj ..:? configMonoidAllowDifferentUserName
+  configMonoidDumpLogs <- First <$> obj ..:? configMonoidDumpLogsName
+  configMonoidSaveHackageCreds <-
+    First <$> obj ..:? configMonoidSaveHackageCredsName
+  configMonoidHackageBaseUrl <-
+    First <$> obj ..:? configMonoidHackageBaseUrlName
+
+  configMonoidColorWhenUS <- obj ..:? configMonoidColorWhenUSName
+  configMonoidColorWhenGB <- obj ..:? configMonoidColorWhenGBName
+  let configMonoidColorWhen =  First $   configMonoidColorWhenUS
+                                     <|> configMonoidColorWhenGB
+
+  configMonoidStylesUS <- obj ..:? configMonoidStylesUSName
+  configMonoidStylesGB <- obj ..:? configMonoidStylesGBName
+  let configMonoidStyles = fromMaybe mempty $   configMonoidStylesUS
+                                            <|> configMonoidStylesGB
+
+  configMonoidHideSourcePaths <-
+    FirstTrue <$> obj ..:? configMonoidHideSourcePathsName
+  configMonoidRecommendUpgrade <-
+    FirstTrue <$> obj ..:? configMonoidRecommendUpgradeName
+
+  configMonoidCasaRepoPrefix <-
+    First <$> obj ..:? configMonoidCasaRepoPrefixName
+  configMonoidSnapshotLocation <-
+    First <$> obj ..:? configMonoidSnapshotLocationName
+  configMonoidNoRunCompile <-
+    FirstFalse <$> obj ..:? configMonoidNoRunCompileName
+
+  configMonoidStackDeveloperMode <-
+    First <$> obj ..:? configMonoidStackDeveloperModeName
+
+  pure ConfigMonoid {..}
+
+configMonoidWorkDirName :: Text
+configMonoidWorkDirName = "work-dir"
+
+configMonoidBuildOptsName :: Text
+configMonoidBuildOptsName = "build"
+
+configMonoidDockerOptsName :: Text
+configMonoidDockerOptsName = "docker"
+
+configMonoidNixOptsName :: Text
+configMonoidNixOptsName = "nix"
+
+configMonoidConfigureOptionsName :: Text
+configMonoidConfigureOptionsName = "configure-options"
+
+configMonoidConnectionCountName :: Text
+configMonoidConnectionCountName = "connection-count"
+
+configMonoidHideTHLoadingName :: Text
+configMonoidHideTHLoadingName = "hide-th-loading"
+
+configMonoidPrefixTimestampsName :: Text
+configMonoidPrefixTimestampsName = "build-output-timestamps"
+
+configMonoidUrlsName :: Text
+configMonoidUrlsName = "urls"
+
+configMonoidPackageIndexName :: Text
+configMonoidPackageIndexName = "package-index"
+
+-- Deprecated in favour of package-index
+configMonoidPackageIndicesName :: Text
+configMonoidPackageIndicesName = "package-indices"
+
+configMonoidSystemGHCName :: Text
+configMonoidSystemGHCName = "system-ghc"
+
+configMonoidInstallGHCName :: Text
+configMonoidInstallGHCName = "install-ghc"
+
+configMonoidSkipGHCCheckName :: Text
+configMonoidSkipGHCCheckName = "skip-ghc-check"
+
+configMonoidSkipMsysName :: Text
+configMonoidSkipMsysName = "skip-msys"
+
+configMonoidRequireStackVersionName :: Text
+configMonoidRequireStackVersionName = "require-stack-version"
+
+configMonoidArchName :: Text
+configMonoidArchName = "arch"
+
+configMonoidGHCVariantName :: Text
+configMonoidGHCVariantName = "ghc-variant"
+
+configMonoidGHCBuildName :: Text
+configMonoidGHCBuildName = "ghc-build"
+
+configMonoidJobsName :: Text
+configMonoidJobsName = "jobs"
+
+configMonoidExtraIncludeDirsName :: Text
+configMonoidExtraIncludeDirsName = "extra-include-dirs"
+
+configMonoidExtraLibDirsName :: Text
+configMonoidExtraLibDirsName = "extra-lib-dirs"
+
+configMonoidCustomPreprocessorExtsName  :: Text
+configMonoidCustomPreprocessorExtsName  = "custom-preprocessor-extensions"
+
+configMonoidOverrideGccPathName :: Text
+configMonoidOverrideGccPathName = "with-gcc"
+
+configMonoidOverrideHpackName :: Text
+configMonoidOverrideHpackName = "with-hpack"
+
+configMonoidConcurrentTestsName :: Text
+configMonoidConcurrentTestsName = "concurrent-tests"
+
+configMonoidLocalBinPathName :: Text
+configMonoidLocalBinPathName = "local-bin-path"
+
+configMonoidScmInitName :: Text
+configMonoidScmInitName = "scm-init"
+
+configMonoidTemplateParametersName :: Text
+configMonoidTemplateParametersName = "params"
+
+configMonoidCompilerCheckName :: Text
+configMonoidCompilerCheckName = "compiler-check"
+
+configMonoidCompilerRepositoryName :: Text
+configMonoidCompilerRepositoryName = "compiler-repository"
+
+configMonoidGhcOptionsName :: Text
+configMonoidGhcOptionsName = "ghc-options"
+
+configMonoidExtraPathName :: Text
+configMonoidExtraPathName = "extra-path"
+
+configMonoidSetupInfoLocationsName :: Text
+configMonoidSetupInfoLocationsName = "setup-info-locations"
+
+configMonoidSetupInfoInlineName :: Text
+configMonoidSetupInfoInlineName = "setup-info"
+
+configMonoidLocalProgramsBaseName :: Text
+configMonoidLocalProgramsBaseName = "local-programs-path"
+
+configMonoidPvpBoundsName :: Text
+configMonoidPvpBoundsName = "pvp-bounds"
+
+configMonoidModifyCodePageName :: Text
+configMonoidModifyCodePageName = "modify-code-page"
+
+configMonoidRebuildGhcOptionsName :: Text
+configMonoidRebuildGhcOptionsName = "rebuild-ghc-options"
+
+configMonoidApplyGhcOptionsName :: Text
+configMonoidApplyGhcOptionsName = "apply-ghc-options"
+
+configMonoidApplyProgOptionsName :: Text
+configMonoidApplyProgOptionsName = "apply-prog-options"
+
+configMonoidAllowNewerName :: Text
+configMonoidAllowNewerName = "allow-newer"
+
+configMonoidAllowNewerDepsName :: Text
+configMonoidAllowNewerDepsName = "allow-newer-deps"
+
+configMonoidDefaultTemplateName :: Text
+configMonoidDefaultTemplateName = "default-template"
+
+configMonoidAllowDifferentUserName :: Text
+configMonoidAllowDifferentUserName = "allow-different-user"
+
+configMonoidDumpLogsName :: Text
+configMonoidDumpLogsName = "dump-logs"
+
+configMonoidSaveHackageCredsName :: Text
+configMonoidSaveHackageCredsName = "save-hackage-creds"
+
+configMonoidHackageBaseUrlName :: Text
+configMonoidHackageBaseUrlName = "hackage-base-url"
+
+configMonoidColorWhenUSName :: Text
+configMonoidColorWhenUSName = "color"
+
+configMonoidColorWhenGBName :: Text
+configMonoidColorWhenGBName = "colour"
+
+configMonoidStylesUSName :: Text
+configMonoidStylesUSName = "stack-colors"
+
+configMonoidStylesGBName :: Text
+configMonoidStylesGBName = "stack-colours"
+
+configMonoidHideSourcePathsName :: Text
+configMonoidHideSourcePathsName = "hide-source-paths"
+
+configMonoidRecommendUpgradeName :: Text
+configMonoidRecommendUpgradeName = "recommend-stack-upgrade"
+
+configMonoidCasaRepoPrefixName :: Text
+configMonoidCasaRepoPrefixName = "casa-repo-prefix"
+
+configMonoidSnapshotLocationName :: Text
+configMonoidSnapshotLocationName = "snapshot-location-base"
+
+configMonoidNoRunCompileName :: Text
+configMonoidNoRunCompileName = "script-no-run-compile"
+
+configMonoidStackDeveloperModeName :: Text
+configMonoidStackDeveloperModeName = "stack-developer-mode"
+ src/Stack/Types/ConfigureOpts.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.ConfigureOpts
+  ( ConfigureOpts (..)
+  , BaseConfigOpts (..)
+  , configureOpts
+  , configureOptsDirs
+  , configureOptsNoDir
+  ) where
+
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import           Distribution.Types.MungedPackageName
+                   ( decodeCompatPackageName )
+import           Distribution.Types.PackageName ( unPackageName )
+import           Distribution.Types.UnqualComponentName
+                   ( unUnqualComponentName )
+import qualified Distribution.Version as C
+import           Path ( (</>), parseRelDir )
+import           Path.Extra ( toFilePathNoTrailingSep )
+import           Stack.Constants
+                   ( bindirSuffix, compilerOptionsCabalFlag, docDirSuffix
+                   , relDirEtc, relDirLib, relDirLibexec, relDirShare
+                   )
+import           Stack.Prelude
+import           Stack.Types.BuildOpts ( BuildOpts (..), BuildOptsCLI )
+import           Stack.Types.Compiler ( getGhcVersion, whichCompiler )
+import           Stack.Types.Config
+                   ( Config (..), HasConfig (..) )
+import           Stack.Types.EnvConfig ( EnvConfig, actualCompilerVersionL )
+import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
+import           Stack.Types.IsMutable ( IsMutable (..) )
+import           Stack.Types.Package ( Package (..) )
+import           System.FilePath ( pathSeparator )
+
+-- | Basic information used to calculate what the configure options are
+data BaseConfigOpts = BaseConfigOpts
+  { bcoSnapDB :: !(Path Abs Dir)
+  , bcoLocalDB :: !(Path Abs Dir)
+  , bcoSnapInstallRoot :: !(Path Abs Dir)
+  , bcoLocalInstallRoot :: !(Path Abs Dir)
+  , bcoBuildOpts :: !BuildOpts
+  , bcoBuildOptsCLI :: !BuildOptsCLI
+  , bcoExtraDBs :: ![Path Abs Dir]
+  }
+  deriving Show
+
+-- | Render a @BaseConfigOpts@ to an actual list of options
+configureOpts :: EnvConfig
+              -> BaseConfigOpts
+              -> Map PackageIdentifier GhcPkgId -- ^ dependencies
+              -> Bool -- ^ local non-extra-dep?
+              -> IsMutable
+              -> Package
+              -> ConfigureOpts
+configureOpts econfig bco deps isLocal isMutable package = ConfigureOpts
+  { coDirs = configureOptsDirs bco isMutable package
+  , coNoDirs = configureOptsNoDir econfig bco deps isLocal package
+  }
+
+
+configureOptsDirs :: BaseConfigOpts
+                  -> IsMutable
+                  -> Package
+                  -> [String]
+configureOptsDirs bco isMutable package = concat
+  [ ["--user", "--package-db=clear", "--package-db=global"]
+  , map (("--package-db=" ++) . toFilePathNoTrailingSep) $ case isMutable of
+      Immutable -> bcoExtraDBs bco ++ [bcoSnapDB bco]
+      Mutable -> bcoExtraDBs bco ++ [bcoSnapDB bco] ++ [bcoLocalDB bco]
+  , [ "--libdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirLib)
+    , "--bindir=" ++ toFilePathNoTrailingSep (installRoot </> bindirSuffix)
+    , "--datadir=" ++ toFilePathNoTrailingSep (installRoot </> relDirShare)
+    , "--libexecdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirLibexec)
+    , "--sysconfdir=" ++ toFilePathNoTrailingSep (installRoot </> relDirEtc)
+    , "--docdir=" ++ toFilePathNoTrailingSep docDir
+    , "--htmldir=" ++ toFilePathNoTrailingSep docDir
+    , "--haddockdir=" ++ toFilePathNoTrailingSep docDir]
+  ]
+ where
+  installRoot =
+    case isMutable of
+      Immutable -> bcoSnapInstallRoot bco
+      Mutable -> bcoLocalInstallRoot bco
+  docDir =
+    case pkgVerDir of
+      Nothing -> installRoot </> docDirSuffix
+      Just dir -> installRoot </> docDirSuffix </> dir
+  pkgVerDir = parseRelDir
+    (  packageIdentifierString
+        (PackageIdentifier (packageName package) (packageVersion package))
+    ++ [pathSeparator]
+    )
+
+-- | Same as 'configureOpts', but does not include directory path options
+configureOptsNoDir ::
+     EnvConfig
+  -> BaseConfigOpts
+  -> Map PackageIdentifier GhcPkgId -- ^ Dependencies.
+  -> Bool -- ^ Is this a local, non-extra-dep?
+  -> Package
+  -> [String]
+configureOptsNoDir econfig bco deps isLocal package = concat
+  [ depOptions
+  , [ "--enable-library-profiling"
+    | boptsLibProfile bopts || boptsExeProfile bopts
+    ]
+  , ["--enable-profiling" | boptsExeProfile bopts && isLocal]
+  , ["--enable-split-objs" | boptsSplitObjs bopts]
+  , [ "--disable-library-stripping"
+    | not $ boptsLibStrip bopts || boptsExeStrip bopts
+    ]
+  , ["--disable-executable-stripping" | not (boptsExeStrip bopts) && isLocal]
+  , map (\(name,enabled) ->
+                     "-f" <>
+                     (if enabled
+                        then ""
+                        else "-") <>
+                     flagNameString name)
+                  (Map.toList flags)
+  , map T.unpack $ packageCabalConfigOpts package
+  , processGhcOptions (packageGhcOptions package)
+  , map ("--extra-include-dirs=" ++) (configExtraIncludeDirs config)
+  , map ("--extra-lib-dirs=" ++) (configExtraLibDirs config)
+  , maybe
+      []
+      (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc])
+      (configOverrideGccPath config)
+  , ["--exact-configuration"]
+  , ["--ghc-option=-fhide-source-paths" | hideSourcePaths cv]
+  ]
+ where
+  -- This function parses the GHC options that are providing in the
+  -- stack.yaml file. In order to handle RTS arguments correctly, we need
+  -- to provide the RTS arguments as a single argument.
+  processGhcOptions :: [Text] -> [String]
+  processGhcOptions args =
+    let (preRtsArgs, mid) = break ("+RTS" ==) args
+        (rtsArgs, end) = break ("-RTS" ==) mid
+        fullRtsArgs =
+          case rtsArgs of
+            [] ->
+              -- This means that we didn't have any RTS args - no `+RTS` - and
+              -- therefore no need for a `-RTS`.
+              []
+            _ ->
+              -- In this case, we have some RTS args. `break` puts the `"-RTS"`
+              -- string in the `snd` list, so we want to append it on the end of
+              -- `rtsArgs` here.
+              --
+              -- We're not checking that `-RTS` is the first element of `end`.
+              -- This is because the GHC RTS allows you to omit a trailing -RTS
+              -- if that's the last of the arguments. This permits a GHC options
+              -- in stack.yaml that matches what you might pass directly to GHC.
+              [T.unwords $ rtsArgs ++ ["-RTS"]]
+        -- We drop the first element from `end`, because it is always either
+        -- `"-RTS"` (and we don't want that as a separate argument) or the list
+        -- is empty (and `drop _ [] = []`).
+        postRtsArgs = drop 1 end
+        newArgs = concat [preRtsArgs, fullRtsArgs, postRtsArgs]
+    in  concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) newArgs
+
+  wc = view (actualCompilerVersionL.to whichCompiler) econfig
+  cv = view (actualCompilerVersionL.to getGhcVersion) econfig
+
+  hideSourcePaths ghcVersion =
+    ghcVersion >= C.mkVersion [8, 2] && configHideSourcePaths config
+
+  config = view configL econfig
+  bopts = bcoBuildOpts bco
+
+  -- Unioning atop defaults is needed so that all flags are specified with
+  -- --exact-configuration.
+  flags = packageFlags package `Map.union` packageDefaultFlags package
+
+  depOptions = map toDepOption $ Map.toList deps
+
+  toDepOption (PackageIdentifier name _, gid) = concat
+    [ "--dependency="
+    , depOptionKey
+    , "="
+    , ghcPkgIdString gid
+    ]
+   where
+    MungedPackageName subPkgName lib = decodeCompatPackageName name
+    depOptionKey = case lib of
+      LMainLibName -> unPackageName name
+      LSubLibName cn ->
+        unPackageName subPkgName <> ":" <> unUnqualComponentName cn
+
+-- | Configure options to be sent to Setup.hs configure
+data ConfigureOpts = ConfigureOpts
+  { coDirs :: ![String]
+    -- ^ Options related to various paths. We separate these out since they do
+    -- not have an impact on the contents of the compiled binary for checking
+    -- if we can use an existing precompiled cache.
+  , coNoDirs :: ![String]
+  }
+  deriving (Data, Eq, Generic, Show, Typeable)
+
+instance NFData ConfigureOpts
+ src/Stack/Types/Curator.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.Curator
+  ( Curator (..)
+  ) where
+
+import qualified Data.Set as Set
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), ToJSON (..), WithJSONWarnings (..), (.=)
+                   , (..:?), (..!=), object, withObjectWarnings
+                   )
+import           Stack.Prelude
+
+-- | Extra configuration intended exclusively for usage by the curator tool. In
+-- other words, this is /not/ part of the documented and exposed Stack API.
+-- SUBJECT TO CHANGE.
+data Curator = Curator
+  { curatorSkipTest :: !(Set PackageName)
+  , curatorExpectTestFailure :: !(Set PackageName)
+  , curatorSkipBenchmark :: !(Set PackageName)
+  , curatorExpectBenchmarkFailure :: !(Set PackageName)
+  , curatorSkipHaddock :: !(Set PackageName)
+  , curatorExpectHaddockFailure :: !(Set PackageName)
+  }
+  deriving Show
+
+instance ToJSON Curator where
+  toJSON c = object
+    [ "skip-test" .= Set.map CabalString (curatorSkipTest c)
+    , "expect-test-failure" .= Set.map CabalString (curatorExpectTestFailure c)
+    , "skip-bench" .= Set.map CabalString (curatorSkipBenchmark c)
+    , "expect-benchmark-failure" .=
+        Set.map CabalString (curatorExpectTestFailure c)
+    , "skip-haddock" .= Set.map CabalString (curatorSkipHaddock c)
+    , "expect-test-failure" .=
+        Set.map CabalString (curatorExpectHaddockFailure c)
+    ]
+
+instance FromJSON (WithJSONWarnings Curator) where
+  parseJSON = withObjectWarnings "Curator" $ \o -> Curator
+    <$> fmap (Set.map unCabalString) (o ..:? "skip-test" ..!= mempty)
+    <*> fmap (Set.map unCabalString) (o ..:? "expect-test-failure" ..!= mempty)
+    <*> fmap (Set.map unCabalString) (o ..:? "skip-bench" ..!= mempty)
+    <*> fmap (Set.map unCabalString) (o ..:? "expect-benchmark-failure" ..!= mempty)
+    <*> fmap (Set.map unCabalString) (o ..:? "skip-haddock" ..!= mempty)
+    <*> fmap (Set.map unCabalString) (o ..:? "expect-haddock-failure" ..!= mempty)
src/Stack/Types/Dependency.hs view
@@ -10,23 +10,25 @@ import           Stack.Types.Version ( intersectVersionRanges )
 
 
--- | The value for a map from dependency name. This contains both the
--- version range and the type of dependency, and provides a semigroup
--- instance.
+-- | The value for a map from dependency name. This contains both the version
+-- range and the type of dependency, and provides a semigroup instance.
 data DepValue = DepValue
   { dvVersionRange :: !VersionRange
   , dvType :: !DepType
   }
   deriving (Show, Typeable)
+
 instance Semigroup DepValue where
   DepValue a x <> DepValue b y = DepValue (intersectVersionRanges a b) (x <> y)
 
--- | Is this package being used as a library, or just as a build tool?
--- If the former, we need to ensure that a library actually
--- exists. See
+-- | Is this package being used as a library, or just as a build tool? If the
+-- former, we need to ensure that a library actually exists. See
 -- <https://github.com/commercialhaskell/stack/issues/2195>
-data DepType = AsLibrary | AsBuildTool
-  deriving (Show, Eq)
+data DepType
+  = AsLibrary
+  | AsBuildTool
+  deriving (Eq, Show)
+
 instance Semigroup DepType where
   AsLibrary <> _ = AsLibrary
   AsBuildTool <> x = x
src/Stack/Types/Docker.hs view
@@ -1,7 +1,4 @@ {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE RecordWildCards    #-}
 
@@ -53,6 +50,7 @@ import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
 import           Pantry.Internal.AesonExtended
 import           Path
+import           Stack.Constants ( stackProgName )
 import           Stack.Prelude hiding ( Display (..) )
 import           Stack.Types.Version
 import           Text.Read ( Read (..) )
@@ -273,7 +271,7 @@   , dockerRequireDockerVersion :: !VersionRange
     -- ^ Require a version of Docker within this range.
   }
-  deriving (Show)
+  deriving Show
 
 -- | An uninterpreted representation of docker options.
 -- Configurations may be "cascaded" using mappend (left-biased).
@@ -365,7 +363,7 @@   | DockerStackExeHost  -- ^ Host's `stack` (linux-x86_64 only)
   | DockerStackExeImage  -- ^ Docker image's `stack` (versions must match)
   | DockerStackExePath (Path Abs File) -- ^ Executable at given path
-  deriving (Show)
+  deriving Show
 
 instance FromJSON DockerStackExe where
   parseJSON a = do
@@ -413,7 +411,7 @@ data DockerMonoidRepoOrImage
   = DockerMonoidRepo String
   | DockerMonoidImage String
-  deriving (Show)
+  deriving Show
 
 -- | Newtype for non-orphan FromJSON instance.
 newtype VersionRangeJSON =
+ src/Stack/Types/DockerEntrypoint.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.DockerEntrypoint
+  ( DockerEntrypoint (..)
+  , DockerUser (..)
+  ) where
+
+import           Stack.Prelude
+import           System.PosixCompat.Types ( FileMode, GroupID, UserID )
+
+-- | Data passed into Docker container for the Docker entrypoint's use
+newtype DockerEntrypoint = DockerEntrypoint
+  { deUser :: Maybe DockerUser
+    -- ^ UID/GID/etc of host user, if we wish to perform UID/GID switch in
+    -- container
+  }
+  deriving (Read, Show)
+
+-- | Docker host user info
+data DockerUser = DockerUser
+  { duUid :: UserID -- ^ uid
+  , duGid :: GroupID -- ^ gid
+  , duGroups :: [GroupID] -- ^ Supplemental groups
+  , duUmask :: FileMode -- ^ File creation mask }
+  }
+  deriving (Read, Show)
+ src/Stack/Types/DownloadInfo.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.DownloadInfo
+  ( DownloadInfo (..)
+  , parseDownloadInfoFromObject
+  ) where
+
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), Object, WarningParser
+                   , WithJSONWarnings (..), (..:), (..:?), withObjectWarnings
+                   )
+import           Stack.Prelude
+
+-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)
+-- | Information for a file to download.
+data DownloadInfo = DownloadInfo
+  { downloadInfoUrl :: Text
+    -- ^ URL or absolute file path
+  , downloadInfoContentLength :: Maybe Int
+  , downloadInfoSha1 :: Maybe ByteString
+  , downloadInfoSha256 :: Maybe ByteString
+  }
+  deriving Show
+
+instance FromJSON (WithJSONWarnings DownloadInfo) where
+  parseJSON = withObjectWarnings "DownloadInfo" parseDownloadInfoFromObject
+
+-- | Parse JSON in existing object for 'DownloadInfo'
+parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo
+parseDownloadInfoFromObject o = do
+  url <- o ..: "url"
+  contentLength <- o ..:? "content-length"
+  sha1TextMay <- o ..:? "sha1"
+  sha256TextMay <- o ..:? "sha256"
+  pure
+    DownloadInfo
+    { downloadInfoUrl = url
+    , downloadInfoContentLength = contentLength
+    , downloadInfoSha1 = fmap encodeUtf8 sha1TextMay
+    , downloadInfoSha256 = fmap encodeUtf8 sha256TextMay
+    }
+ src/Stack/Types/DumpLogs.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.DumpLogs
+  ( DumpLogs (..)
+  ) where
+
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), Value (..), withText )
+import           Stack.Prelude
+
+-- | Which build log files to dump
+data DumpLogs
+  = DumpNoLogs -- ^ don't dump any logfiles
+  | DumpWarningLogs -- ^ dump logfiles containing warnings
+  | DumpAllLogs -- ^ dump all logfiles
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+instance FromJSON DumpLogs where
+  parseJSON (Bool True) = pure DumpAllLogs
+  parseJSON (Bool False) = pure DumpNoLogs
+  parseJSON v =
+    withText
+      "DumpLogs"
+      (\t ->
+          if | t == "none" -> pure DumpNoLogs
+             | t == "warning" -> pure DumpWarningLogs
+             | t == "all" -> pure DumpAllLogs
+             | otherwise -> fail ("Invalid DumpLogs: " ++ show t))
+      v
+ src/Stack/Types/DumpPackage.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.DumpPackage
+  ( DumpPackage (..)
+  ) where
+
+import qualified Distribution.License as C
+import           Distribution.ModuleName ( ModuleName )
+import           Stack.Prelude
+import           Stack.Types.GhcPkgId ( GhcPkgId )
+
+-- | Type representing dump information for a single package, as output by the
+-- @ghc-pkg describe@ command.
+data DumpPackage = DumpPackage
+  { dpGhcPkgId :: !GhcPkgId
+    -- ^ The @id@ field.
+  , dpPackageIdent :: !PackageIdentifier
+    -- ^ The @name@ and @version@ fields. The @name@ field is the munged package
+    -- name. If the package is not for a sub library, its munged name is its
+    -- name.
+  , dpParentLibIdent :: !(Maybe PackageIdentifier)
+    -- ^ The @package-name@ and @version@ fields, if @package-name@ is present.
+    -- That field is present if the package is for a sub library.
+  , dpLicense :: !(Maybe C.License)
+  , dpLibDirs :: ![FilePath]
+    -- ^ The @library-dirs@ field.
+  , dpLibraries :: ![Text]
+    -- ^ The @hs-libraries@ field.
+  , dpHasExposedModules :: !Bool
+  , dpExposedModules :: !(Set ModuleName)
+  , dpDepends :: ![GhcPkgId]
+    -- ^ The @depends@ field (packages on which this package depends).
+  , dpHaddockInterfaces :: ![FilePath]
+  , dpHaddockHtml :: !(Maybe FilePath)
+  , dpIsExposed :: !Bool
+  }
+  deriving (Eq, Read, Show)
+ src/Stack/Types/EnvConfig.hs view
@@ -0,0 +1,319 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.EnvConfig
+  ( EnvConfig (..)
+  , HasEnvConfig (..)
+  , HasSourceMap (..)
+  , actualCompilerVersionL
+  , appropriateGhcColorFlag
+  , bindirCompilerTools
+  , compilerVersionDir
+  , extraBinDirs
+  , hoogleDatabasePath
+  , hoogleRoot
+  , hpcReportDir
+  , installationRootDeps
+  , installationRootLocal
+  , packageDatabaseDeps
+  , packageDatabaseExtra
+  , packageDatabaseLocal
+  , platformGhcRelDir
+  , platformGhcVerOnlyRelDir
+  , platformSnapAndCompilerRel
+  , shouldForceGhcColorFlag
+  , snapshotsDir
+  , useShaPathOnWindows
+  , shaPathForBytes
+  ) where
+
+import           Crypto.Hash ( SHA1 (..), hashWith )
+import qualified Data.ByteArray.Encoding as Mem ( Base(Base16), convertToBase )
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.Text as T
+import qualified Distribution.Text ( display )
+import           Distribution.Version ( mkVersion )
+import           Path
+                   ( (</>), parseAbsDir, parseAbsFile, parseRelDir
+                   , parseRelFile
+                   )
+import           RIO.Process ( HasProcessContext (..) )
+import           Stack.Constants
+                   ( bindirSuffix, ghcColorForceFlag, osIsWindows, relDirCompilerTools
+                   , relDirHoogle, relDirHpc, relDirInstall, relDirPkgdb
+                   , relDirSnapshots, relFileDatabaseHoo
+                   )
+import           Stack.Prelude
+import           Stack.Types.BuildConfig
+                    ( BuildConfig (..), HasBuildConfig (..), getProjectWorkDir )
+import           Stack.Types.BuildOpts ( BuildOptsCLI )
+import           Stack.Types.Compiler
+                   ( ActualCompiler (..), compilerVersionString, getGhcVersion )
+import           Stack.Types.CompilerBuild ( compilerBuildSuffix )
+import           Stack.Types.CompilerPaths
+                   ( CompilerPaths (..), HasCompiler (..) )
+import           Stack.Types.Config ( HasConfig (..), stackRootL )
+import           Stack.Types.GHCVariant ( HasGHCVariant (..), ghcVariantSuffix )
+import           Stack.Types.Platform
+                   ( HasPlatform (..), platformVariantSuffix )
+import           Stack.Types.Runner ( HasRunner (..) )
+import           Stack.Types.SourceMap
+                   ( SourceMap (..), SourceMapHash, smRelDir )
+
+-- | Configuration after the environment has been setup.
+data EnvConfig = EnvConfig
+  { envConfigBuildConfig :: !BuildConfig
+  , envConfigBuildOptsCLI :: !BuildOptsCLI
+  , envConfigSourceMap :: !SourceMap
+  , envConfigSourceMapHash :: !SourceMapHash
+  , envConfigCompilerPaths :: !CompilerPaths
+  }
+
+instance HasConfig EnvConfig where
+  configL = buildConfigL.lens bcConfig (\x y -> x { bcConfig = y })
+  {-# INLINE configL #-}
+
+instance HasBuildConfig EnvConfig where
+  buildConfigL = envConfigL.lens
+    envConfigBuildConfig
+    (\x y -> x { envConfigBuildConfig = y })
+
+instance HasPlatform EnvConfig where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
+instance HasGHCVariant EnvConfig where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
+instance HasProcessContext EnvConfig where
+  processContextL = configL.processContextL
+
+instance HasPantryConfig EnvConfig where
+  pantryConfigL = configL.pantryConfigL
+
+instance HasCompiler EnvConfig where
+  compilerPathsL = to envConfigCompilerPaths
+
+instance HasRunner EnvConfig where
+  runnerL = configL.runnerL
+
+instance HasLogFunc EnvConfig where
+  logFuncL = runnerL.logFuncL
+
+instance HasStylesUpdate EnvConfig where
+  stylesUpdateL = runnerL.stylesUpdateL
+
+instance HasTerm EnvConfig where
+  useColorL = runnerL.useColorL
+  termWidthL = runnerL.termWidthL
+
+class (HasBuildConfig env, HasSourceMap env, HasCompiler env) => HasEnvConfig env where
+  envConfigL :: Lens' env EnvConfig
+
+instance HasEnvConfig EnvConfig where
+  envConfigL = id
+  {-# INLINE envConfigL #-}
+
+class HasSourceMap env where
+  sourceMapL :: Lens' env SourceMap
+
+instance HasSourceMap EnvConfig where
+  sourceMapL = lens envConfigSourceMap (\x y -> x { envConfigSourceMap = y })
+
+shouldForceGhcColorFlag ::
+     (HasEnvConfig env, HasRunner env)
+  => RIO env Bool
+shouldForceGhcColorFlag = do
+  canDoColor <- (>= mkVersion [8, 2, 1]) . getGhcVersion
+            <$> view actualCompilerVersionL
+  shouldDoColor <- view useColorL
+  pure $ canDoColor && shouldDoColor
+
+appropriateGhcColorFlag ::
+     (HasEnvConfig env, HasRunner env)
+  => RIO env (Maybe String)
+appropriateGhcColorFlag = f <$> shouldForceGhcColorFlag
+ where
+  f True = Just ghcColorForceFlag
+  f False = Nothing
+
+-- | Directory containing snapshots
+snapshotsDir ::
+     (HasEnvConfig env, MonadReader env m, MonadThrow m)
+  => m (Path Abs Dir)
+snapshotsDir = do
+  root <- view stackRootL
+  platform <- platformGhcRelDir
+  pure $ root </> relDirSnapshots </> platform
+
+-- | Installation root for dependencies
+installationRootDeps :: HasEnvConfig env => RIO env (Path Abs Dir)
+installationRootDeps = do
+  root <- view stackRootL
+  -- TODO: also useShaPathOnWindows here, once #1173 is resolved.
+  psc <- platformSnapAndCompilerRel
+  pure $ root </> relDirSnapshots </> psc
+
+-- | Installation root for locals
+installationRootLocal :: HasEnvConfig env => RIO env (Path Abs Dir)
+installationRootLocal = do
+  workDir <- getProjectWorkDir
+  psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel
+  pure $ workDir </> relDirInstall </> psc
+
+-- | Get the hoogle database path.
+hoogleDatabasePath :: HasEnvConfig env => RIO env (Path Abs File)
+hoogleDatabasePath = do
+  dir <- hoogleRoot
+  pure (dir </> relFileDatabaseHoo)
+
+-- | Path for platform followed by snapshot name followed by compiler
+-- name.
+platformSnapAndCompilerRel :: HasEnvConfig env => RIO env (Path Rel Dir)
+platformSnapAndCompilerRel = do
+  platform <- platformGhcRelDir
+  smh <- view $ envConfigL.to envConfigSourceMapHash
+  name <- smRelDir smh
+  ghc <- compilerVersionDir
+  useShaPathOnWindows (platform </> name </> ghc)
+
+-- | Relative directory for the platform and GHC identifier
+platformGhcRelDir ::
+     (HasEnvConfig env, MonadReader env m, MonadThrow m)
+  => m (Path Rel Dir)
+platformGhcRelDir = do
+  cp <- view compilerPathsL
+  let cbSuffix = compilerBuildSuffix $ cpBuild cp
+  verOnly <- platformGhcVerOnlyRelDirStr
+  parseRelDir (mconcat [ verOnly, cbSuffix ])
+
+-- | Installation root for compiler tools
+bindirCompilerTools ::
+     (HasEnvConfig env, MonadReader env m, MonadThrow m)
+  => m (Path Abs Dir)
+bindirCompilerTools = do
+  config <- view configL
+  platform <- platformGhcRelDir
+  compilerVersion <- view actualCompilerVersionL
+  compiler <- parseRelDir $ compilerVersionString compilerVersion
+  pure $
+    view stackRootL config </>
+    relDirCompilerTools </>
+    platform </>
+    compiler </>
+    bindirSuffix
+
+-- | Hoogle directory.
+hoogleRoot :: HasEnvConfig env => RIO env (Path Abs Dir)
+hoogleRoot = do
+  workDir <- getProjectWorkDir
+  psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel
+  pure $ workDir </> relDirHoogle </> psc
+
+compilerVersionDir ::
+     (HasEnvConfig env, MonadReader env m, MonadThrow m)
+  => m (Path Rel Dir)
+compilerVersionDir = do
+  compilerVersion <- view actualCompilerVersionL
+  parseRelDir $ case compilerVersion of
+    ACGhc version -> versionString version
+    ACGhcGit {} -> compilerVersionString compilerVersion
+
+-- | Package database for installing dependencies into
+packageDatabaseDeps :: HasEnvConfig env => RIO env (Path Abs Dir)
+packageDatabaseDeps = do
+  root <- installationRootDeps
+  pure $ root </> relDirPkgdb
+
+-- | Package database for installing local packages into
+packageDatabaseLocal :: HasEnvConfig env => RIO env (Path Abs Dir)
+packageDatabaseLocal = do
+  root <- installationRootLocal
+  pure $ root </> relDirPkgdb
+
+-- | Extra package databases
+packageDatabaseExtra ::
+     (HasEnvConfig env, MonadReader env m)
+  => m [Path Abs Dir]
+packageDatabaseExtra = view $ buildConfigL.to bcExtraPackageDBs
+
+-- | Where HPC reports and tix files get stored.
+hpcReportDir :: HasEnvConfig env => RIO env (Path Abs Dir)
+hpcReportDir = do
+  root <- installationRootLocal
+  pure $ root </> relDirHpc
+
+-- | Get the extra bin directories (for the PATH). Puts more local first
+--
+-- Bool indicates whether or not to include the locals
+extraBinDirs :: HasEnvConfig env => RIO env (Bool -> [Path Abs Dir])
+extraBinDirs = do
+  deps <- installationRootDeps
+  local' <- installationRootLocal
+  tools <- bindirCompilerTools
+  pure $ \locals -> if locals
+    then [local' </> bindirSuffix, deps </> bindirSuffix, tools]
+    else [deps </> bindirSuffix, tools]
+
+-- | The version of the compiler which will actually be used. May be different
+-- than that specified in the 'SnapshotDef' and returned by
+-- 'wantedCompilerVersionL'.
+actualCompilerVersionL :: HasSourceMap env => SimpleGetter env ActualCompiler
+actualCompilerVersionL = sourceMapL.to smCompiler
+
+-- | Relative directory for the platform and GHC identifier without GHC bindist
+-- build
+platformGhcVerOnlyRelDir ::
+     (HasGHCVariant env, HasPlatform env, MonadReader env m, MonadThrow m)
+  => m (Path Rel Dir)
+platformGhcVerOnlyRelDir =
+  parseRelDir =<< platformGhcVerOnlyRelDirStr
+
+-- | Relative directory for the platform and GHC identifier without GHC bindist
+-- build (before parsing into a Path)
+platformGhcVerOnlyRelDirStr ::
+     (HasGHCVariant env, HasPlatform env, MonadReader env m)
+  => m FilePath
+platformGhcVerOnlyRelDirStr = do
+  platform <- view platformL
+  platformVariant <- view platformVariantL
+  ghcVariant <- view ghcVariantL
+  pure $ mconcat [ Distribution.Text.display platform
+                   , platformVariantSuffix platformVariant
+                   , ghcVariantSuffix ghcVariant ]
+
+-- | This is an attempt to shorten Stack paths on Windows to decrease our
+-- chances of hitting 260 symbol path limit. The idea is to calculate
+-- SHA1 hash of the path used on other architectures, encode with base
+-- 16 and take first 8 symbols of it.
+useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir)
+useShaPathOnWindows
+  | osIsWindows = shaPath
+  | otherwise = pure
+
+shaPath :: (IsPath Rel t, MonadThrow m) => Path Rel t -> m (Path Rel t)
+shaPath = shaPathForBytes . encodeUtf8 . T.pack . toFilePath
+
+shaPathForBytes :: (IsPath Rel t, MonadThrow m) => ByteString -> m (Path Rel t)
+shaPathForBytes
+  = parsePath . S8.unpack . S8.take 8
+  . Mem.convertToBase Mem.Base16 . hashWith SHA1
+
+-- TODO: Move something like this into the path package. Consider
+-- subsuming path-io's 'AnyPath'?
+class IsPath b t where
+  parsePath :: MonadThrow m => FilePath -> m (Path b t)
+
+instance IsPath Abs Dir where
+  parsePath = parseAbsDir
+
+instance IsPath Rel Dir where
+  parsePath = parseRelDir
+
+instance IsPath Abs File where
+  parsePath = parseAbsFile
+
+instance IsPath Rel File where
+  parsePath = parseRelFile
+ src/Stack/Types/EnvSettings.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.EnvSettings
+  ( EnvSettings (..)
+  , minimalEnvSettings
+  , defaultEnvSettings
+  , plainEnvSettings
+  ) where
+
+import           Stack.Prelude
+
+-- | Controls which version of the environment is used
+data EnvSettings = EnvSettings
+  { esIncludeLocals :: !Bool
+  -- ^ include local project bin directory, GHC_PACKAGE_PATH, etc
+  , esIncludeGhcPackagePath :: !Bool
+  -- ^ include the GHC_PACKAGE_PATH variable
+  , esStackExe :: !Bool
+  -- ^ set the STACK_EXE variable to the current executable name
+  , esLocaleUtf8 :: !Bool
+  -- ^ set the locale to C.UTF-8
+  , esKeepGhcRts :: !Bool
+  -- ^ if True, keep GHCRTS variable in environment
+  }
+  deriving (Eq, Ord, Show)
+
+minimalEnvSettings :: EnvSettings
+minimalEnvSettings =
+  EnvSettings
+  { esIncludeLocals = False
+  , esIncludeGhcPackagePath = False
+  , esStackExe = False
+  , esLocaleUtf8 = False
+  , esKeepGhcRts = False
+  }
+
+-- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH.
+--
+-- Note that this also passes through the GHCRTS environment variable.
+-- See https://github.com/commercialhaskell/stack/issues/3444
+defaultEnvSettings :: EnvSettings
+defaultEnvSettings = EnvSettings
+  { esIncludeLocals = True
+  , esIncludeGhcPackagePath = True
+  , esStackExe = True
+  , esLocaleUtf8 = False
+  , esKeepGhcRts = True
+  }
+
+-- | Environment settings which do not embellish the environment
+--
+-- Note that this also passes through the GHCRTS environment variable.
+-- See https://github.com/commercialhaskell/stack/issues/3444
+plainEnvSettings :: EnvSettings
+plainEnvSettings = EnvSettings
+  { esIncludeLocals = False
+  , esIncludeGhcPackagePath = False
+  , esStackExe = False
+  , esLocaleUtf8 = False
+  , esKeepGhcRts = True
+  }
+ src/Stack/Types/ExtraDirs.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.ExtraDirs
+  ( ExtraDirs (..)
+  ) where
+
+import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import           Stack.Prelude
+
+data ExtraDirs = ExtraDirs
+  { edBins :: ![Path Abs Dir]
+  , edInclude :: ![Path Abs Dir]
+  , edLib :: ![Path Abs Dir]
+  }
+  deriving (Show, Generic)
+
+instance Semigroup ExtraDirs where
+  (<>) = mappenddefault
+
+instance Monoid ExtraDirs where
+  mempty = memptydefault
+  mappend = (<>)
+ src/Stack/Types/GHCDownloadInfo.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.GHCDownloadInfo
+  ( GHCDownloadInfo (..)
+  ) where
+
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), WithJSONWarnings (..), (..:?), (..!=)
+                   , withObjectWarnings
+                   )
+import           Stack.Prelude
+import           Stack.Types.DownloadInfo
+                   ( DownloadInfo, parseDownloadInfoFromObject )
+
+data GHCDownloadInfo = GHCDownloadInfo
+  { gdiConfigureOpts :: [Text]
+  , gdiConfigureEnv :: Map Text Text
+  , gdiDownloadInfo :: DownloadInfo
+  }
+  deriving Show
+
+instance FromJSON (WithJSONWarnings GHCDownloadInfo) where
+  parseJSON = withObjectWarnings "GHCDownloadInfo" $ \o -> do
+    configureOpts <- o ..:? "configure-opts" ..!= mempty
+    configureEnv <- o ..:? "configure-env" ..!= mempty
+    downloadInfo <- parseDownloadInfoFromObject o
+    pure GHCDownloadInfo
+      { gdiConfigureOpts = configureOpts
+      , gdiConfigureEnv = configureEnv
+      , gdiDownloadInfo = downloadInfo
+      }
+ src/Stack/Types/GHCVariant.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.GHCVariant
+  ( GHCVariant (..)
+  , HasGHCVariant (..)
+  , ghcVariantName
+  , ghcVariantSuffix
+  , parseGHCVariant
+  ) where
+
+import           Data.List ( stripPrefix )
+import qualified Data.Text as T
+import           Pantry.Internal.AesonExtended ( FromJSON, parseJSON, withText )
+import           Stack.Prelude
+
+-- | Specialized variant of GHC (e.g. libgmp4 or integer-simple)
+data GHCVariant
+  = GHCStandard
+  -- ^ Standard bindist
+  | GHCIntegerSimple
+  -- ^ Bindist that uses integer-simple
+  | GHCNativeBignum
+  -- ^ Bindist that uses the Haskell-native big-integer backend
+  | GHCCustom String
+  -- ^ Other bindists
+  deriving Show
+
+instance FromJSON GHCVariant where
+  -- Strange structuring is to give consistent error messages
+  parseJSON =
+    withText
+      "GHCVariant"
+      (either (fail . show) pure . parseGHCVariant . T.unpack)
+
+-- | Class for environment values which have a GHCVariant
+class HasGHCVariant env where
+  ghcVariantL :: SimpleGetter env GHCVariant
+
+instance HasGHCVariant GHCVariant where
+  ghcVariantL = id
+  {-# INLINE ghcVariantL #-}
+
+-- | Render a GHC variant to a String.
+ghcVariantName :: GHCVariant -> String
+ghcVariantName GHCStandard = "standard"
+ghcVariantName GHCIntegerSimple = "integersimple"
+ghcVariantName GHCNativeBignum = "int-native"
+ghcVariantName (GHCCustom name) = "custom-" ++ name
+
+-- | Render a GHC variant to a String suffix.
+ghcVariantSuffix :: GHCVariant -> String
+ghcVariantSuffix GHCStandard = ""
+ghcVariantSuffix v = "-" ++ ghcVariantName v
+
+-- | Parse GHC variant from a String.
+parseGHCVariant :: (MonadThrow m) => String -> m GHCVariant
+parseGHCVariant s =
+  case stripPrefix "custom-" s of
+    Just name -> pure (GHCCustom name)
+    Nothing
+      | s == "" -> pure GHCStandard
+      | s == "standard" -> pure GHCStandard
+      | s == "integersimple" -> pure GHCIntegerSimple
+      | s == "int-native" -> pure GHCNativeBignum
+      | otherwise -> pure (GHCCustom s)
+ src/Stack/Types/GhcOptionKey.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.GhcOptionKey
+  ( GhcOptionKey (..)
+  ) where
+
+import qualified Data.Text as T
+import           Pantry.Internal.AesonExtended
+                   ( FromJSONKey (..), FromJSONKeyFunction (..) )
+import           Stack.Prelude
+
+data GhcOptionKey
+  = GOKOldEverything
+  | GOKEverything
+  | GOKLocals
+  | GOKTargets
+  | GOKPackage !PackageName
+  deriving (Eq, Ord)
+
+instance FromJSONKey GhcOptionKey where
+  fromJSONKey = FromJSONKeyTextParser $ \t ->
+    case t of
+      "*" -> pure GOKOldEverything
+      "$everything" -> pure GOKEverything
+      "$locals" -> pure GOKLocals
+      "$targets" -> pure GOKTargets
+      _ ->
+        case parsePackageName $ T.unpack t of
+          Nothing -> fail $ "Invalid package name: " ++ show t
+          Just x -> pure $ GOKPackage x
+  fromJSONKeyList =
+    FromJSONKeyTextParser $ \_ -> fail "GhcOptionKey.fromJSONKeyList"
+ src/Stack/Types/GhcOptions.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.GhcOptions
+  ( GhcOptions (..)
+  ) where
+
+import           Data.Attoparsec.Args ( EscapingMode (Escaping), parseArgs )
+import qualified Data.Text as T
+import           Pantry.Internal.AesonExtended ( FromJSON (..), withText )
+import           Stack.Prelude
+
+newtype GhcOptions = GhcOptions { unGhcOptions :: [Text] }
+
+instance FromJSON GhcOptions where
+  parseJSON = withText "GhcOptions" $ \t ->
+    case parseArgs Escaping t of
+      Left e -> fail e
+      Right opts -> pure $ GhcOptions $ map T.pack opts
src/Stack/Types/GhcPkgId.hs view
@@ -1,7 +1,4 @@ {-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | A ghc-pkg id.
 
@@ -13,12 +10,16 @@   , ghcPkgIdString
   ) where
 
-import           Stack.Prelude
-import           Pantry.Internal.AesonExtended
 import           Data.Attoparsec.Text
+                   ( Parser, choice, digit, endOfInput, letter, many1, parseOnly
+                   , satisfy
+                   )
 import qualified Data.Text as T
 import           Database.Persist.Sql ( PersistField, PersistFieldSql )
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), ToJSON (..), withText )
 import           Prelude ( Read (..) )
+import           Stack.Prelude
 
 -- | A parse fail.
 newtype GhcPkgIdParseFail
@@ -26,21 +27,24 @@   deriving (Show, Typeable)
 
 instance Exception GhcPkgIdParseFail where
-    displayException (GhcPkgIdParseFail bs) = concat
-        [ "Error: [S-5359]\n"
-        , "Invalid package ID: "
-        , show bs
-        ]
+  displayException (GhcPkgIdParseFail bs) = concat
+    [ "Error: [S-5359]\n"
+    , "Invalid package ID: "
+    , show bs
+    ]
 
 -- | A ghc-pkg package identifier.
-newtype GhcPkgId = GhcPkgId Text
-  deriving (Eq,Ord,Data,Typeable,Generic,PersistField,PersistFieldSql)
+newtype GhcPkgId
+  = GhcPkgId Text
+  deriving (Data, Eq, Generic, Ord, PersistField, PersistFieldSql, Typeable)
 
 instance Hashable GhcPkgId
+
 instance NFData GhcPkgId
 
 instance Show GhcPkgId where
   show = show . ghcPkgIdString
+
 instance Read GhcPkgId where
   readsPrec i = map (first (GhcPkgId . T.pack)) . readsPrec i
 
@@ -57,15 +61,17 @@ -- | Convenient way to parse a package name from a 'Text'.
 parseGhcPkgId :: MonadThrow m => Text -> m GhcPkgId
 parseGhcPkgId x = go x
-  where go =
-          either (const (throwM (GhcPkgIdParseFail x))) pure .
-          parseOnly (ghcPkgIdParser <* endOfInput)
+ where
+  go = either
+         (const (throwM (GhcPkgIdParseFail x)))
+         pure . parseOnly (ghcPkgIdParser <* endOfInput)
 
 -- | A parser for a package-version-hash pair.
 ghcPkgIdParser :: Parser GhcPkgId
 ghcPkgIdParser =
-    let elements =  "_.-" :: String in
-    GhcPkgId . T.pack <$> many1 (choice [digit, letter, satisfy (`elem` elements)])
+  let elements = "_.-" :: String
+  in  GhcPkgId . T.pack <$>
+        many1 (choice [digit, letter, satisfy (`elem` elements)])
 
 -- | Get a string representation of GHC package id.
 ghcPkgIdString :: GhcPkgId -> String
+ src/Stack/Types/GlobalOpts.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.GlobalOpts
+  ( GlobalOpts (..)
+  , globalOptsBuildOptsMonoidL
+  ) where
+
+import          Stack.Prelude
+import          Stack.Types.BuildOpts ( BuildOptsMonoid )
+import          Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
+import          Stack.Types.DockerEntrypoint ( DockerEntrypoint )
+import          Stack.Types.LockFileBehavior ( LockFileBehavior )
+import          Stack.Types.Resolver ( AbstractResolver )
+import          Stack.Types.StackYamlLoc ( StackYamlLoc )
+
+-- | Parsed global command-line options.
+data GlobalOpts = GlobalOpts
+  { globalReExecVersion :: !(Maybe String)
+    -- ^ Expected re-exec in container version
+  , globalDockerEntrypoint :: !(Maybe DockerEntrypoint)
+    -- ^ Data used when Stack is acting as a Docker entrypoint (internal use
+    -- only)
+  , globalLogLevel     :: !LogLevel -- ^ Log level
+  , globalTimeInLog    :: !Bool -- ^ Whether to include timings in logs.
+  , globalRSLInLog     :: !Bool
+    -- ^ Whether to include raw snapshot layer (RSL) in logs.
+  , globalConfigMonoid :: !ConfigMonoid
+    -- ^ Config monoid, for passing into 'loadConfig'
+  , globalResolver     :: !(Maybe AbstractResolver) -- ^ Resolver override
+  , globalCompiler     :: !(Maybe WantedCompiler) -- ^ Compiler override
+  , globalTerminal     :: !Bool -- ^ We're in a terminal?
+  , globalStylesUpdate :: !StylesUpdate -- ^ SGR (Ansi) codes for styles
+  , globalTermWidth    :: !(Maybe Int) -- ^ Terminal width override
+  , globalStackYaml    :: !StackYamlLoc -- ^ Override project stack.yaml
+  , globalLockFileBehavior :: !LockFileBehavior
+  }
+  deriving Show
+
+globalOptsBuildOptsMonoidL :: Lens' GlobalOpts BuildOptsMonoid
+globalOptsBuildOptsMonoidL =
+  lens
+    globalConfigMonoid
+    (\x y -> x { globalConfigMonoid = y })
+  .
+  lens
+    configMonoidBuildOpts
+    (\x y -> x { configMonoidBuildOpts = y })
+ src/Stack/Types/GlobalOptsMonoid.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.GlobalOptsMonoid
+  ( GlobalOptsMonoid (..)
+  ) where
+
+import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import           Stack.Prelude
+import           Stack.Types.ConfigMonoid ( ConfigMonoid )
+import           Stack.Types.DockerEntrypoint ( DockerEntrypoint )
+import           Stack.Types.LockFileBehavior ( LockFileBehavior )
+import           Stack.Types.Resolver ( AbstractResolver )
+
+-- | Parsed global command-line options monoid.
+data GlobalOptsMonoid = GlobalOptsMonoid
+  { globalMonoidReExecVersion :: !(First String)
+    -- ^ Expected re-exec in container version
+  , globalMonoidDockerEntrypoint :: !(First DockerEntrypoint)
+    -- ^ Data used when Stack is acting as a Docker entrypoint (internal use
+    -- only)
+  , globalMonoidLogLevel     :: !(First LogLevel)
+    -- ^ Log level
+  , globalMonoidTimeInLog    :: !FirstTrue
+    -- ^ Whether to include timings in logs.
+  , globalMonoidRSLInLog     :: !FirstFalse
+    -- ^ Whether to include raw snapshot layer (RSL) in logs.
+  , globalMonoidConfigMonoid :: !ConfigMonoid
+    -- ^ Config monoid, for passing into 'loadConfig'
+  , globalMonoidResolver     :: !(First (Unresolved AbstractResolver))
+    -- ^ Resolver override
+  , globalMonoidResolverRoot :: !(First FilePath)
+    -- ^ root directory for resolver relative path
+  , globalMonoidCompiler     :: !(First WantedCompiler)
+    -- ^ Compiler override
+  , globalMonoidTerminal     :: !(First Bool)
+    -- ^ We're in a terminal?
+  , globalMonoidStyles       :: !StylesUpdate
+    -- ^ Stack's output styles
+  , globalMonoidTermWidth    :: !(First Int)
+    -- ^ Terminal width override
+  , globalMonoidStackYaml    :: !(First FilePath)
+    -- ^ Override project stack.yaml
+  , globalMonoidLockFileBehavior :: !(First LockFileBehavior)
+    -- ^ See 'globalLockFileBehavior'
+  }
+  deriving Generic
+
+instance Semigroup GlobalOptsMonoid where
+  (<>) = mappenddefault
+
+instance Monoid GlobalOptsMonoid where
+  mempty = memptydefault
+  mappend = (<>)
+ src/Stack/Types/IsMutable.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.IsMutable
+  ( IsMutable (..)
+  ) where
+
+import           Stack.Prelude
+
+data IsMutable
+  = Mutable
+  | Immutable
+  deriving (Eq, Show)
+
+instance Semigroup IsMutable where
+  Mutable <> _ = Mutable
+  _ <> Mutable = Mutable
+  Immutable <> Immutable = Immutable
+
+instance Monoid IsMutable where
+  mempty = Immutable
+  mappend = (<>)
+ src/Stack/Types/LockFileBehavior.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.LockFileBehavior
+  ( LockFileBehavior (..)
+  , readLockFileBehavior
+  ) where
+
+import qualified Data.Map as Map
+import           Options.Applicative ( ReadM )
+import qualified Options.Applicative.Types as OA
+import qualified RIO.List as List
+import           Stack.Prelude
+
+-- | How to interact with lock files
+data LockFileBehavior
+  = LFBReadWrite
+    -- ^ Read and write lock files
+  | LFBReadOnly
+    -- ^ Read lock files, but do not write them
+  | LFBIgnore
+    -- ^ Entirely ignore lock files
+  | LFBErrorOnWrite
+    -- ^ Error out on trying to write a lock file. This can be used to
+    -- ensure that lock files in a repository already ensure
+    -- reproducible builds.
+  deriving (Bounded, Enum, Show)
+
+-- | Parser for 'LockFileBehavior'
+readLockFileBehavior :: ReadM LockFileBehavior
+readLockFileBehavior = do
+  s <- OA.readerAsk
+  case Map.lookup s m of
+    Just x -> pure x
+    Nothing -> OA.readerError $ "Invalid lock file behavior, valid options: " ++
+                                List.intercalate ", " (Map.keys m)
+ where
+  m = Map.fromList $ map (\x -> (render x, x)) [minBound..maxBound]
+  render LFBReadWrite = "read-write"
+  render LFBReadOnly = "read-only"
+  render LFBIgnore = "ignore"
+  render LFBErrorOnWrite = "error-on-write"
src/Stack/Types/NamedComponent.hs view
@@ -19,17 +19,16 @@ 
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import           Pantry
 import           Stack.Prelude
 
 -- | A single, fully resolved component of a package
 data NamedComponent
-    = CLib
-    | CInternalLib !Text
-    | CExe !Text
-    | CTest !Text
-    | CBench !Text
-    deriving (Show, Eq, Ord)
+  = CLib
+  | CInternalLib !Text
+  | CExe !Text
+  | CTest !Text
+  | CBench !Text
+  deriving (Eq, Ord, Show)
 
 renderComponent :: NamedComponent -> Text
 renderComponent CLib = "lib"
@@ -42,31 +41,32 @@ renderPkgComponents = T.intercalate " " . map renderPkgComponent
 
 renderPkgComponent :: (PackageName, NamedComponent) -> Text
-renderPkgComponent (pkg, comp) = fromString (packageNameString pkg) <> ":" <> renderComponent comp
+renderPkgComponent (pkg, comp) =
+  fromString (packageNameString pkg) <> ":" <> renderComponent comp
 
 exeComponents :: Set NamedComponent -> Set Text
 exeComponents = Set.fromList . mapMaybe mExeName . Set.toList
-  where
-    mExeName (CExe name) = Just name
-    mExeName _ = Nothing
+ where
+  mExeName (CExe name) = Just name
+  mExeName _ = Nothing
 
 testComponents :: Set NamedComponent -> Set Text
 testComponents = Set.fromList . mapMaybe mTestName . Set.toList
-  where
-    mTestName (CTest name) = Just name
-    mTestName _ = Nothing
+ where
+  mTestName (CTest name) = Just name
+  mTestName _ = Nothing
 
 benchComponents :: Set NamedComponent -> Set Text
 benchComponents = Set.fromList . mapMaybe mBenchName . Set.toList
-  where
-    mBenchName (CBench name) = Just name
-    mBenchName _ = Nothing
+ where
+  mBenchName (CBench name) = Just name
+  mBenchName _ = Nothing
 
 internalLibComponents :: Set NamedComponent -> Set Text
 internalLibComponents = Set.fromList . mapMaybe mInternalName . Set.toList
-  where
-    mInternalName (CInternalLib name) = Just name
-    mInternalName _ = Nothing
+ where
+  mInternalName (CInternalLib name) = Just name
+  mInternalName _ = Nothing
 
 isCLib :: NamedComponent -> Bool
 isCLib CLib{} = True
src/Stack/Types/Nix.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
 -- | Nix types.
-
 module Stack.Types.Nix
   ( NixOpts (..)
   , NixOptsMonoid (..)
@@ -20,6 +17,9 @@ 
 import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
 import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), WithJSONWarnings, (..:?)
+                   , withObjectWarnings
+                   )
 import           Stack.Prelude
 
 -- | Nix configuration. Parameterize by resolver type to avoid cyclic
@@ -28,33 +28,37 @@   { nixEnable :: !Bool
   , nixPureShell :: !Bool
   , nixPackages :: ![Text]
-     -- ^ The system packages to be installed in the environment before it runs
+    -- ^ The system packages to be installed in the environment before it runs
   , nixInitFile :: !(Maybe FilePath)
-     -- ^ The path of a file containing preconfiguration of the environment (e.g shell.nix)
+    -- ^ The path of a file containing preconfiguration of the environment
+    -- (e.g shell.nix)
   , nixShellOptions :: ![Text]
-     -- ^ Options to be given to the nix-shell command line
+    -- ^ Options to be given to the nix-shell command line
   , nixAddGCRoots :: !Bool
-     -- ^ Should we register gc roots so running nix-collect-garbage doesn't remove nix dependencies
+    -- ^ Should we register gc roots so running nix-collect-garbage doesn't
+    -- remove nix dependencies
   }
-  deriving (Show)
+  deriving Show
 
 -- | An uninterpreted representation of nix options.
 -- Configurations may be "cascaded" using mappend (left-biased).
 data NixOptsMonoid = NixOptsMonoid
   { nixMonoidEnable :: !(First Bool)
-     -- ^ Is using nix-shell enabled?
+    -- ^ Is using nix-shell enabled?
   , nixMonoidPureShell :: !(First Bool)
-     -- ^ Should the nix-shell be pure
+    -- ^ Should the nix-shell be pure
   , nixMonoidPackages :: !(First [Text])
-     -- ^ System packages to use (given to nix-shell)
+    -- ^ System packages to use (given to nix-shell)
   , nixMonoidInitFile :: !(First FilePath)
-     -- ^ The path of a file containing preconfiguration of the environment (e.g shell.nix)
+    -- ^ The path of a file containing preconfiguration of the environment (e.g
+    -- shell.nix)
   , nixMonoidShellOptions :: !(First [Text])
-     -- ^ Options to be given to the nix-shell command line
+    -- ^ Options to be given to the nix-shell command line
   , nixMonoidPath :: !(First [Text])
-     -- ^ Override parts of NIX_PATH (notably 'nixpkgs')
+    -- ^ Override parts of NIX_PATH (notably 'nixpkgs')
   , nixMonoidAddGCRoots :: !FirstFalse
-     -- ^ Should we register gc roots so running nix-collect-garbage doesn't remove nix dependencies
+    -- ^ Should we register gc roots so running nix-collect-garbage doesn't
+    -- remove nix dependencies
   }
   deriving (Eq, Generic, Show)
src/Stack/Types/Package.hs view
@@ -1,51 +1,42 @@ {-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE ConstraintKinds            #-}
 {-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RankNTypes                 #-}
 
 module Stack.Types.Package
- ( BuildInfoOpts (..)
- , ExeName (..)
- , FileCacheInfo (..)
- , GetPackageOpts (..)
- , InstallLocation (..)
- , InstallMap
- , Installed (..)
- , InstalledPackageLocation (..)
- , InstalledMap
- , LocalPackage (..)
- , MemoizedWith (..)
- , Package (..)
- , PackageConfig (..)
- , PackageException (..)
- , PackageLibraries (..)
- , PackageSource (..)
- , dotCabalCFilePath
- , dotCabalGetPath
- , dotCabalMain
- , dotCabalMainPath
- , dotCabalModule
- , dotCabalModulePath
- , installedPackageIdentifier
- , installedVersion
- , lpFiles
- , lpFilesForComponents
- , memoizeRefWith
- , packageDefinedFlags
- , packageIdent
- , packageIdentifier
- , psVersion
- , runMemoizedWith
- ) where
+  ( BuildInfoOpts (..)
+  , ExeName (..)
+  , FileCacheInfo (..)
+  , GetPackageOpts (..)
+  , InstallLocation (..)
+  , InstallMap
+  , Installed (..)
+  , InstalledPackageLocation (..)
+  , InstalledMap
+  , LocalPackage (..)
+  , MemoizedWith (..)
+  , Package (..)
+  , PackageConfig (..)
+  , PackageException (..)
+  , PackageLibraries (..)
+  , PackageSource (..)
+  , dotCabalCFilePath
+  , dotCabalGetPath
+  , dotCabalMain
+  , dotCabalMainPath
+  , dotCabalModule
+  , dotCabalModulePath
+  , installedPackageIdentifier
+  , installedVersion
+  , lpFiles
+  , lpFilesForComponents
+  , memoizeRefWith
+  , packageDefinedFlags
+  , packageIdent
+  , packageIdentifier
+  , psVersion
+  , runMemoizedWith
+  ) where
 
-import           Stack.Prelude
-import qualified RIO.Text as T
 import           Data.Aeson
                    ( ToJSON (..), FromJSON (..), (.=), (.:), object, withObject
                    )
@@ -59,17 +50,19 @@ import           Distribution.PackageDescription
                    ( TestSuiteInterface, BuildType )
 import           Distribution.System ( Platform (..) )
-import           Stack.Types.Compiler
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
-import           Stack.Types.NamedComponent
-import           Stack.Types.SourceMap
-import           Stack.Types.Version
+import qualified RIO.Text as T
+import           Stack.Prelude
+import           Stack.Types.Compiler ( ActualCompiler )
 import           Stack.Types.Dependency ( DepValue )
+import           Stack.Types.EnvConfig ( EnvConfig, HasEnvConfig (..) )
+import           Stack.Types.GhcPkgId ( GhcPkgId )
+import           Stack.Types.NamedComponent ( NamedComponent )
 import           Stack.Types.PackageFile
                    ( GetPackageFiles (..), DotCabalDescriptor (..)
                    , DotCabalPath (..)
                    )
+import           Stack.Types.SourceMap ( CommonPackage, FromSnapshot )
+import           Stack.Types.Version ( VersionRange )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Package" module.
@@ -86,106 +79,130 @@   deriving (Show, Typeable)
 
 instance Exception PackageException where
-    displayException (PackageInvalidCabalFile loc _mversion errs warnings) = concat
-        [ "Error: [S-8072]\n"
-        , "Unable to parse Cabal file "
-        , case loc of
-            Left pir -> "for " ++ T.unpack (utf8BuilderToText (display pir))
-            Right fp -> toFilePath fp
-        {-
-
-         Not actually needed, the errors will indicate if a newer version exists.
-         Also, it seems that this is set to Just the version even if we support it.
-
-        , case mversion of
-            Nothing -> ""
-            Just version -> "\nRequires newer Cabal file parser version: " ++
-                            versionString version
-        -}
-        , "\n\n"
-        , unlines $ map
-            (\(PError pos msg) -> concat
-                [ "- "
-                , showPos pos
-                , ": "
-                , msg
-                ])
-            errs
-        , unlines $ map
-            (\(PWarning _ pos msg) -> concat
-                [ "- "
-                , showPos pos
-                , ": "
-                , msg
-                ])
-            warnings
-        ]
-    displayException (MismatchedCabalIdentifier pir ident) = concat
-        [ "Error: [S-5394]\n"
-        , "Mismatched package identifier."
-        , "\nFound:    "
-        , packageIdentifierString ident
-        , "\nExpected: "
-        , T.unpack $ utf8BuilderToText $ display pir
-        ]
-    displayException (CabalFileNameParseFail fp) = concat
-        [ "Error: [S-2203]\n"
-        , "Invalid file path for Cabal file, must have a .cabal extension: "
-        , fp
-        ]
-    displayException (CabalFileNameInvalidPackageName fp) = concat
-        [ "Error: [S-8854]\n"
-        , "Cabal file names must use valid package names followed by a .cabal \
-          \extension, the following is invalid: "
-        , fp
-        ]
-    displayException ComponentNotParsedBug = bugReport "[S-4623]"
-        "Component names should always parse as directory names."
+  displayException (PackageInvalidCabalFile loc _mversion errs warnings) = concat
+    [ "Error: [S-8072]\n"
+    , "Unable to parse Cabal file "
+    , case loc of
+        Left pir -> "for " ++ T.unpack (utf8BuilderToText (display pir))
+        Right fp -> toFilePath fp
+    {-
+     Not actually needed, the errors will indicate if a newer version exists.
+     Also, it seems that this is set to Just the version even if we support it.
+    , case mversion of
+        Nothing -> ""
+        Just version -> "\nRequires newer Cabal file parser version: " ++
+                        versionString version
+    -}
+    , "\n\n"
+    , unlines $ map
+        (\(PError pos msg) -> concat
+            [ "- "
+            , showPos pos
+            , ": "
+            , msg
+            ])
+        errs
+    , unlines $ map
+        (\(PWarning _ pos msg) -> concat
+            [ "- "
+            , showPos pos
+            , ": "
+            , msg
+            ])
+        warnings
+    ]
+  displayException (MismatchedCabalIdentifier pir ident) = concat
+    [ "Error: [S-5394]\n"
+    , "Mismatched package identifier."
+    , "\nFound:    "
+    , packageIdentifierString ident
+    , "\nExpected: "
+    , T.unpack $ utf8BuilderToText $ display pir
+    ]
+  displayException (CabalFileNameParseFail fp) = concat
+    [ "Error: [S-2203]\n"
+    , "Invalid file path for Cabal file, must have a .cabal extension: "
+    , fp
+    ]
+  displayException (CabalFileNameInvalidPackageName fp) = concat
+    [ "Error: [S-8854]\n"
+    , "Cabal file names must use valid package names followed by a .cabal \
+      \extension, the following is invalid: "
+    , fp
+    ]
+  displayException ComponentNotParsedBug = bugReport "[S-4623]"
+    "Component names should always parse as directory names."
 
 -- | Libraries in a package. Since Cabal 2.0, internal libraries are a
 -- thing.
 data PackageLibraries
   = NoLibraries
-  | HasLibraries !(Set Text) -- ^ the foreign library names, sub libraries get built automatically without explicit component name passing
- deriving (Show,Typeable)
+  | HasLibraries !(Set Text)
+    -- ^ the foreign library names, sub libraries get built automatically
+    -- without explicit component name passing
+ deriving (Show, Typeable)
 
 -- | Name of an executable.
-newtype ExeName = ExeName { unExeName :: Text }
-    deriving (Show, Eq, Ord, Hashable, IsString, Generic, NFData, Data, Typeable)
+newtype ExeName
+  = ExeName { unExeName :: Text }
+  deriving (Data, Eq, Generic, Hashable, IsString, NFData, Ord, Show, Typeable)
 
 -- | Some package info.
-data Package =
-  Package {packageName :: !PackageName                    -- ^ Name of the package.
-          ,packageVersion :: !Version                     -- ^ Version of the package
-          ,packageLicense :: !(Either SPDX.License License) -- ^ The license the package was released under.
-          ,packageFiles :: !GetPackageFiles               -- ^ Get all files of the package.
-          ,packageDeps :: !(Map PackageName DepValue)     -- ^ Packages that the package depends on, both as libraries and build tools.
-          ,packageUnknownTools :: !(Set ExeName)          -- ^ Build tools specified in the legacy manner (build-tools:) that failed the hard-coded lookup.
-          ,packageAllDeps :: !(Set PackageName)           -- ^ Original dependencies (not sieved).
-          ,packageGhcOptions :: ![Text]                   -- ^ Ghc options used on package.
-          ,packageCabalConfigOpts :: ![Text]              -- ^ Additional options passed to ./Setup.hs configure
-          ,packageFlags :: !(Map FlagName Bool)           -- ^ Flags used on package.
-          ,packageDefaultFlags :: !(Map FlagName Bool)    -- ^ Defaults for unspecified flags.
-          ,packageLibraries :: !PackageLibraries          -- ^ does the package have a buildable library stanza?
-          ,packageInternalLibraries :: !(Set Text)        -- ^ names of internal libraries
-          ,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites
-          ,packageBenchmarks :: !(Set Text)               -- ^ names of benchmarks
-          ,packageExes :: !(Set Text)                     -- ^ names of executables
-          ,packageOpts :: !GetPackageOpts                 -- ^ Args to pass to GHC.
-          ,packageHasExposedModules :: !Bool              -- ^ Does the package have exposed modules?
-          ,packageBuildType :: !BuildType                 -- ^ Package build-type.
-          ,packageSetupDeps :: !(Maybe (Map PackageName VersionRange))
-                                                          -- ^ If present: custom-setup dependencies
-          ,packageCabalSpec :: !CabalSpecVersion          -- ^ Cabal spec range
-          }
- deriving (Show,Typeable)
+data Package = Package
+  { packageName :: !PackageName
+    -- ^ Name of the package.
+  , packageVersion :: !Version
+    -- ^ Version of the package
+  , packageLicense :: !(Either SPDX.License License)
+    -- ^ The license the package was released under.
+  , packageFiles :: !GetPackageFiles
+    -- ^ Get all files of the package.
+  , packageDeps :: !(Map PackageName DepValue)
+    -- ^ Packages that the package depends on, both as libraries and build tools.
+  , packageUnknownTools :: !(Set ExeName)
+    -- ^ Build tools specified in the legacy manner (build-tools:) that failed
+    -- the hard-coded lookup.
+  , packageAllDeps :: !(Set PackageName)
+    -- ^ Original dependencies (not sieved).
+  , packageSubLibDeps :: !(Map MungedPackageName DepValue)
+    -- ^ Original sub-library dependencies (not sieved).
+  , packageGhcOptions :: ![Text]
+    -- ^ Ghc options used on package.
+  , packageCabalConfigOpts :: ![Text]
+    -- ^ Additional options passed to ./Setup.hs configure
+  , packageFlags :: !(Map FlagName Bool)
+    -- ^ Flags used on package.
+  , packageDefaultFlags :: !(Map FlagName Bool)
+    -- ^ Defaults for unspecified flags.
+  , packageLibraries :: !PackageLibraries
+    -- ^ does the package have a buildable library stanza?
+  , packageInternalLibraries :: !(Set Text)
+    -- ^ names of internal libraries
+  , packageTests :: !(Map Text TestSuiteInterface)
+    -- ^ names and interfaces of test suites
+  , packageBenchmarks :: !(Set Text)
+    -- ^ names of benchmarks
+  , packageExes :: !(Set Text)
+    -- ^ names of executables
+  , packageOpts :: !GetPackageOpts
+    -- ^ Args to pass to GHC.
+  , packageHasExposedModules :: !Bool
+    -- ^ Does the package have exposed modules?
+  , packageBuildType :: !BuildType
+    -- ^ Package build-type.
+  , packageSetupDeps :: !(Maybe (Map PackageName VersionRange))
+    -- ^ If present: custom-setup dependencies
+  , packageCabalSpec :: !CabalSpecVersion
+    -- ^ Cabal spec range
+  }
+  deriving (Show, Typeable)
 
 packageIdent :: Package -> PackageIdentifier
 packageIdent p = PackageIdentifier (packageName p) (packageVersion p)
 
 packageIdentifier :: Package -> PackageIdentifier
 packageIdentifier pkg =
-    PackageIdentifier (packageName pkg) (packageVersion pkg)
+  PackageIdentifier (packageName pkg) (packageVersion pkg)
 
 packageDefinedFlags :: Package -> Set FlagName
 packageDefinedFlags = M.keysSet . packageDefaultFlags
@@ -195,42 +212,52 @@ -- | Files that the package depends on, relative to package directory.
 -- Argument is the location of the Cabal file
 newtype GetPackageOpts = GetPackageOpts
-    { getPackageOpts :: forall env. HasEnvConfig env
-                     => InstallMap
-                     -> InstalledMap
-                     -> [PackageName]
-                     -> [PackageName]
-                     -> Path Abs File
-                     -> RIO env
-                          (Map NamedComponent (Map ModuleName (Path Abs File))
-                          ,Map NamedComponent [DotCabalPath]
-                          ,Map NamedComponent BuildInfoOpts)
-    }
+  { getPackageOpts :: forall env. HasEnvConfig env
+                   => InstallMap
+                   -> InstalledMap
+                   -> [PackageName]
+                   -> [PackageName]
+                   -> Path Abs File
+                   -> RIO env
+                        ( Map NamedComponent (Map ModuleName (Path Abs File))
+                        , Map NamedComponent [DotCabalPath]
+                        , Map NamedComponent BuildInfoOpts
+                        )
+  }
+
 instance Show GetPackageOpts where
-    show _ = "<GetPackageOpts>"
+  show _ = "<GetPackageOpts>"
 
 -- | GHC options based on cabal information and ghc-options.
 data BuildInfoOpts = BuildInfoOpts
-    { bioOpts :: [String]
-    , bioOneWordOpts :: [String]
-    , bioPackageFlags :: [String]
-    -- ^ These options can safely have 'nubOrd' applied to them, as
-    -- there are no multi-word options (see
+  { bioOpts :: [String]
+  , bioOneWordOpts :: [String]
+  , bioPackageFlags :: [String]
+    -- ^ These options can safely have 'nubOrd' applied to them, as there are no
+    -- multi-word options (see
     -- https://github.com/commercialhaskell/stack/issues/1255)
-    , bioCabalMacros :: Path Abs File
-    } deriving Show
+  , bioCabalMacros :: Path Abs File
+  }
+  deriving Show
 
 -- | Package build configuration
-data PackageConfig =
-  PackageConfig {packageConfigEnableTests :: !Bool                -- ^ Are tests enabled?
-                ,packageConfigEnableBenchmarks :: !Bool           -- ^ Are benchmarks enabled?
-                ,packageConfigFlags :: !(Map FlagName Bool)       -- ^ Configured flags.
-                ,packageConfigGhcOptions :: ![Text]               -- ^ Configured ghc options.
-                ,packageConfigCabalConfigOpts :: ![Text]          -- ^ ./Setup.hs configure options
-                ,packageConfigCompilerVersion :: ActualCompiler   -- ^ GHC version
-                ,packageConfigPlatform :: !Platform               -- ^ host platform
-                }
- deriving (Show,Typeable)
+data PackageConfig = PackageConfig
+  { packageConfigEnableTests :: !Bool
+    -- ^ Are tests enabled?
+  , packageConfigEnableBenchmarks :: !Bool
+    -- ^ Are benchmarks enabled?
+  , packageConfigFlags :: !(Map FlagName Bool)
+    -- ^ Configured flags.
+  , packageConfigGhcOptions :: ![Text]
+    -- ^ Configured ghc options.
+  , packageConfigCabalConfigOpts :: ![Text]
+    -- ^ ./Setup.hs configure options
+  , packageConfigCompilerVersion :: ActualCompiler
+    -- ^ GHC version
+  , packageConfigPlatform :: !Platform
+    -- ^ host platform
+  }
+ deriving (Show, Typeable)
 
 -- | Compares the package name.
 instance Ord Package where
@@ -243,20 +270,20 @@ -- | Where the package's source is located: local directory or package index
 data PackageSource
   = PSFilePath LocalPackage
-  -- ^ Package which exist on the filesystem
+    -- ^ Package which exist on the filesystem
   | PSRemote PackageLocationImmutable Version FromSnapshot CommonPackage
-  -- ^ Package which is downloaded remotely.
+    -- ^ Package which is downloaded remotely.
 
 instance Show PackageSource where
-    show (PSFilePath lp) = concat ["PSFilePath (", show lp, ")"]
-    show (PSRemote pli v fromSnapshot _) =
-        concat
-            [ "PSRemote"
-            , "(", show pli, ")"
-            , "(", show v, ")"
-            , show fromSnapshot
-            , "<CommonPackage>"
-            ]
+  show (PSFilePath lp) = concat ["PSFilePath (", show lp, ")"]
+  show (PSRemote pli v fromSnapshot _) =
+    concat
+      [ "PSRemote"
+      , "(", show pli, ")"
+      , "(", show v, ")"
+      , show fromSnapshot
+      , "<CommonPackage>"
+      ]
 
 
 psVersion :: PackageSource -> Version
@@ -265,36 +292,44 @@ 
 -- | Information on a locally available package of source code
 data LocalPackage = LocalPackage
-    { lpPackage       :: !Package
-    -- ^ The @Package@ info itself, after resolution with package flags,
-    -- with tests and benchmarks disabled
-    , lpComponents    :: !(Set NamedComponent)
+  { lpPackage       :: !Package
+     -- ^ The @Package@ info itself, after resolution with package flags,
+     -- with tests and benchmarks disabled
+  , lpComponents    :: !(Set NamedComponent)
     -- ^ Components to build, not including the library component.
-    , lpUnbuildable   :: !(Set NamedComponent)
+  , lpUnbuildable   :: !(Set NamedComponent)
     -- ^ Components explicitly requested for build, that are marked
     -- "buildable: false".
-    , lpWanted        :: !Bool -- FIXME Should completely drop this "wanted" terminology, it's unclear
+  , lpWanted        :: !Bool -- FIXME Should completely drop this "wanted"
+                             -- terminology, it's unclear
     -- ^ Whether this package is wanted as a target.
-    , lpTestBench     :: !(Maybe Package)
+  , lpTestBench     :: !(Maybe Package)
     -- ^ This stores the 'Package' with tests and benchmarks enabled, if
     -- either is asked for by the user.
-    , lpCabalFile     :: !(Path Abs File)
+  , lpCabalFile     :: !(Path Abs File)
     -- ^ The Cabal file
-    , lpBuildHaddocks :: !Bool
-    , lpForceDirty    :: !Bool
-    , lpDirtyFiles    :: !(MemoizedWith EnvConfig (Maybe (Set FilePath)))
+  , lpBuildHaddocks :: !Bool
+  , lpForceDirty    :: !Bool
+  , lpDirtyFiles    :: !(MemoizedWith EnvConfig (Maybe (Set FilePath)))
     -- ^ Nothing == not dirty, Just == dirty. Note that the Set may be empty if
     -- we forced the build to treat packages as dirty. Also, the Set may not
     -- include all modified files.
-    , lpNewBuildCaches :: !(MemoizedWith EnvConfig (Map NamedComponent (Map FilePath FileCacheInfo)))
+  , lpNewBuildCaches :: !( MemoizedWith
+                             EnvConfig
+                             (Map NamedComponent (Map FilePath FileCacheInfo))
+                         )
     -- ^ current state of the files
-    , lpComponentFiles :: !(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File))))
+  , lpComponentFiles :: !( MemoizedWith
+                             EnvConfig
+                             (Map NamedComponent (Set (Path Abs File)))
+                         )
     -- ^ all files used by this package
-    }
-    deriving Show
+  }
+  deriving Show
 
-newtype MemoizedWith env a = MemoizedWith { unMemoizedWith :: RIO env a }
-  deriving (Functor, Applicative, Monad)
+newtype MemoizedWith env a
+  = MemoizedWith { unMemoizedWith :: RIO env a }
+  deriving (Applicative, Functor, Monad)
 
 memoizeRefWith :: MonadIO m => RIO env a -> m (MemoizedWith env a)
 memoizeRefWith action = do
@@ -333,27 +368,33 @@   pure $ mconcat (M.elems (M.restrictKeys componentFiles components))
 
 -- | A location to install a package into, either snapshot or local
-data InstallLocation = Snap | Local
-    deriving (Show, Eq)
+data InstallLocation
+  = Snap
+  | Local
+  deriving (Eq, Show)
+
 instance Semigroup InstallLocation where
-    Local <> _ = Local
-    _ <> Local = Local
-    Snap <> Snap = Snap
+  Local <> _ = Local
+  _ <> Local = Local
+  Snap <> Snap = Snap
+
 instance Monoid InstallLocation where
-    mempty = Snap
-    mappend = (<>)
+  mempty = Snap
+  mappend = (<>)
 
-data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal
-    deriving (Show, Eq)
+data InstalledPackageLocation
+  = InstalledTo InstallLocation | ExtraGlobal
+  deriving (Eq, Show)
 
 newtype FileCacheInfo = FileCacheInfo
-    { fciHash :: SHA256
-    }
-    deriving (Generic, Show, Eq, Typeable)
+  { fciHash :: SHA256
+  }
+  deriving (Eq, Generic, Show, Typeable)
+
 instance NFData FileCacheInfo
 
--- Provided for storing the BuildCache values in a file. But maybe
--- JSON/YAML isn't the right choice here, worth considering.
+-- Provided for storing the BuildCache values in a file. But maybe JSON/YAML
+-- isn't the right choice here, worth considering.
 instance ToJSON FileCacheInfo where
   toJSON (FileCacheInfo hash') = object
     [ "hash" .= hash'
@@ -390,18 +431,18 @@ -- | Get the path.
 dotCabalGetPath :: DotCabalPath -> Path Abs File
 dotCabalGetPath dcp =
-    case dcp of
-        DotCabalModulePath fp -> fp
-        DotCabalMainPath fp -> fp
-        DotCabalFilePath fp -> fp
-        DotCabalCFilePath fp -> fp
+  case dcp of
+    DotCabalModulePath fp -> fp
+    DotCabalMainPath fp -> fp
+    DotCabalFilePath fp -> fp
+    DotCabalCFilePath fp -> fp
 
 type InstalledMap = Map PackageName (InstallLocation, Installed)
 
 data Installed
-    = Library PackageIdentifier GhcPkgId (Maybe (Either SPDX.License License))
-    | Executable PackageIdentifier
-    deriving (Show, Eq)
+  = Library PackageIdentifier GhcPkgId (Maybe (Either SPDX.License License))
+  | Executable PackageIdentifier
+  deriving (Eq, Show)
 
 installedPackageIdentifier :: Installed -> PackageIdentifier
 installedPackageIdentifier (Library pid _ _) = pid
@@ -411,4 +452,4 @@ installedVersion :: Installed -> Version
 installedVersion i =
   let PackageIdentifier _ version = installedPackageIdentifier i
-   in version
+  in  version
src/Stack/Types/PackageFile.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE ConstraintKinds            #-}
 {-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE RankNTypes                 #-}
 
 -- | The facility for retrieving all files from the main Stack
 -- 'Stack.Types.Package' type. This was moved into its own module to allow
@@ -17,13 +14,16 @@   ) where
 
 import           Distribution.ModuleName ( ModuleName )
-import           RIO.Process ( HasProcessContext (processContextL) )
+import           RIO.Process ( HasProcessContext (..) )
 import           Stack.Prelude
-import           Stack.Types.Config
-                   ( BuildConfig, HasBuildConfig (..), HasConfig (..)
-                   , HasEnvConfig, HasGHCVariant, HasPlatform, HasRunner (..)
-                   )
+import           Stack.Types.BuildConfig
+                   ( BuildConfig (..), HasBuildConfig (..) )
+import           Stack.Types.Config ( HasConfig (..) )
+import           Stack.Types.EnvConfig ( HasEnvConfig )
+import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
 import           Stack.Types.NamedComponent ( NamedComponent )
+import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Runner ( HasRunner (..) )
 
 data GetPackageFileContext = GetPackageFileContext
   { ctxFile :: !(Path Abs File)
@@ -32,24 +32,41 @@   , ctxCabalVer :: !Version
   }
 
-instance HasPlatform GetPackageFileContext
-instance HasGHCVariant GetPackageFileContext
+instance HasPlatform GetPackageFileContext where
+  platformL = configL.platformL
+  {-# INLINE platformL #-}
+  platformVariantL = configL.platformVariantL
+  {-# INLINE platformVariantL #-}
+
+instance HasGHCVariant GetPackageFileContext where
+  ghcVariantL = configL.ghcVariantL
+  {-# INLINE ghcVariantL #-}
+
 instance HasLogFunc GetPackageFileContext where
   logFuncL = configL.logFuncL
+
 instance HasRunner GetPackageFileContext where
   runnerL = configL.runnerL
+
 instance HasStylesUpdate GetPackageFileContext where
   stylesUpdateL = runnerL.stylesUpdateL
+
 instance HasTerm GetPackageFileContext where
   useColorL = runnerL.useColorL
   termWidthL = runnerL.termWidthL
-instance HasConfig GetPackageFileContext
+
+instance HasConfig GetPackageFileContext where
+  configL = buildConfigL.lens bcConfig (\x y -> x { bcConfig = y })
+  {-# INLINE configL #-}
+
+instance HasBuildConfig GetPackageFileContext where
+  buildConfigL = lens ctxBuildConfig (\x y -> x { ctxBuildConfig = y })
+
 instance HasPantryConfig GetPackageFileContext where
   pantryConfigL = configL.pantryConfigL
+
 instance HasProcessContext GetPackageFileContext where
   processContextL = configL.processContextL
-instance HasBuildConfig GetPackageFileContext where
-  buildConfigL = lens ctxBuildConfig (\x y -> x { ctxBuildConfig = y })
 
 -- | A path resolved from the Cabal file, which is either main-is or
 -- an exposed/internal/referenced module.
src/Stack/Types/PackageName.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 -- | Names for packages.
 
@@ -7,24 +6,25 @@   ( packageNameArgument
   ) where
 
-import           Stack.Prelude
 import qualified Options.Applicative as O
-
+import           Stack.Prelude
 
 -- | An argument which accepts a template name of the format
 -- @foo.hsfiles@.
 packageNameArgument :: O.Mod O.ArgumentFields PackageName
                     -> O.Parser PackageName
 packageNameArgument =
-    O.argument
-        (do s <- O.str
-            either O.readerError pure (p s))
-  where
-    p s =
-        case parsePackageName s of
-            Just x -> Right x
-            Nothing -> Left $ unlines
-                [ "Expected valid package name, but got: " ++ s
-                , "Package names consist of one or more alphanumeric words separated by hyphens."
-                , "To avoid ambiguity with version numbers, each of these words must contain at least one letter."
-                ]
+  O.argument
+    (do s <- O.str
+        either O.readerError pure (p s))
+ where
+  p s =
+    case parsePackageName s of
+      Just x -> Right x
+      Nothing -> Left $ unlines
+        [ "Expected valid package name, but got: " ++ s
+        , "Package names consist of one or more alphanumeric words separated \
+          \by hyphens."
+        , "To avoid ambiguity with version numbers, each of these words must \
+          \contain at least one letter."
+        ]
+ src/Stack/Types/ParentMap.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.ParentMap
+  ( ParentMap
+  ) where
+
+import           Data.Monoid.Map ( MonoidMap (..) )
+import           Stack.Prelude
+import           Stack.Types.Version ( VersionRange )
+
+type ParentMap =
+  MonoidMap PackageName (First Version, [(PackageIdentifier, VersionRange)])
+ src/Stack/Types/Platform.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.Platform
+  ( PlatformVariant (..)
+  , HasPlatform (..)
+  , platformVariantSuffix
+  , platformOnlyRelDir
+  ) where
+
+import           Distribution.System ( Platform )
+import           Distribution.Text ( display )
+import           Lens.Micro ( _1, _2 )
+import           Path ( parseRelDir )
+import           Stack.Prelude
+
+-- | A variant of the platform, used to differentiate Docker builds from host
+data PlatformVariant
+  = PlatformVariantNone
+  | PlatformVariant String
+
+-- | Class for environment values which have a Platform
+class HasPlatform env where
+  platformL :: Lens' env Platform
+  platformVariantL :: Lens' env PlatformVariant
+
+instance HasPlatform (Platform, PlatformVariant) where
+  platformL = _1
+  platformVariantL = _2
+
+-- | Render a platform variant to a String suffix.
+platformVariantSuffix :: PlatformVariant -> String
+platformVariantSuffix PlatformVariantNone = ""
+platformVariantSuffix (PlatformVariant v) = "-" ++ v
+
+-- | Relative directory for the platform identifier
+platformOnlyRelDir ::
+     (MonadReader env m, HasPlatform env, MonadThrow m)
+  => m (Path Rel Dir)
+platformOnlyRelDir = do
+  platform <- view platformL
+  platformVariant <- view platformVariantL
+  parseRelDir
+    (  Distribution.Text.display platform
+    ++ platformVariantSuffix platformVariant
+    )
+ src/Stack/Types/Project.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.Project
+  ( Project (..)
+  ) where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import           Pantry.Internal.AesonExtended ( ToJSON (..), (.=), object )
+import           Stack.Prelude
+import           Stack.Types.Curator ( Curator )
+
+-- | A project is a collection of packages. We can have multiple stack.yaml
+-- files, but only one of them may contain project information.
+data Project = Project
+  { projectUserMsg :: !(Maybe String)
+    -- ^ A warning message to display to the user when the auto generated
+    -- config may have issues.
+  , projectPackages :: ![RelFilePath]
+    -- ^ Packages which are actually part of the project (as opposed
+    -- to dependencies).
+  , projectDependencies :: ![RawPackageLocation]
+    -- ^ Dependencies defined within the stack.yaml file, to be applied on top
+    -- of the snapshot.
+  , projectFlags :: !(Map PackageName (Map FlagName Bool))
+    -- ^ Flags to be applied on top of the snapshot flags.
+  , projectResolver :: !RawSnapshotLocation
+    -- ^ How we resolve which @Snapshot@ to use
+  , projectCompiler :: !(Maybe WantedCompiler)
+    -- ^ Override the compiler in 'projectResolver'
+  , projectExtraPackageDBs :: ![FilePath]
+  , projectCurator :: !(Maybe Curator)
+    -- ^ Extra configuration intended exclusively for usage by the curator tool.
+    -- In other words, this is /not/ part of the documented and exposed Stack
+    -- API. SUBJECT TO CHANGE.
+  , projectDropPackages :: !(Set PackageName)
+    -- ^ Packages to drop from the 'projectResolver'.
+  }
+  deriving Show
+
+instance ToJSON Project where
+  -- Expanding the constructor fully to ensure we don't miss any fields.
+  toJSON (Project userMsg packages extraDeps flags resolver mcompiler extraPackageDBs mcurator drops) = object $ concat
+    [ maybe [] (\cv -> ["compiler" .= cv]) mcompiler
+    , maybe [] (\msg -> ["user-message" .= msg]) userMsg
+    , [ "extra-package-dbs" .= extraPackageDBs | not (null extraPackageDBs) ]
+    , [ "extra-deps" .= extraDeps | not (null extraDeps) ]
+    , [ "flags" .= fmap toCabalStringMap (toCabalStringMap flags)
+      | not (Map.null flags)
+      ]
+    , ["packages" .= packages]
+    , ["resolver" .= resolver]
+    , maybe [] (\c -> ["curator" .= c]) mcurator
+    , [ "drop-packages" .= Set.map CabalString drops | not (Set.null drops) ]
+    ]
+ src/Stack/Types/ProjectAndConfigMonoid.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.ProjectAndConfigMonoid
+  ( ProjectAndConfigMonoid (..)
+  , parseProjectAndConfigMonoid
+  ) where
+
+import qualified Data.Set as Set
+import qualified Data.Yaml as Yaml
+import           Pantry.Internal.AesonExtended
+                   ( WithJSONWarnings, Value, (...:), (..:?), (..!=)
+                   , jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT
+                   , withObjectWarnings )
+import           Stack.Prelude
+import           Stack.Types.ConfigMonoid
+                   ( ConfigMonoid, parseConfigMonoidObject )
+import           Stack.Types.Project ( Project (..) )
+
+data ProjectAndConfigMonoid
+  = ProjectAndConfigMonoid !Project !ConfigMonoid
+
+parseProjectAndConfigMonoid ::
+     Path Abs Dir
+  -> Value
+  -> Yaml.Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
+parseProjectAndConfigMonoid rootDir =
+  withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do
+    packages <- o ..:? "packages" ..!= [RelFilePath "."]
+    deps <- jsonSubWarningsTT (o ..:? "extra-deps") ..!= []
+    flags' <- o ..:? "flags" ..!= mempty
+    let flags = unCabalStringMap <$> unCabalStringMap
+                (flags' :: Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
+
+    resolver <- jsonSubWarnings $ o ...: ["snapshot", "resolver"]
+    mcompiler <- o ..:? "compiler"
+    msg <- o ..:? "user-message"
+    config <- parseConfigMonoidObject rootDir o
+    extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
+    mcurator <- jsonSubWarningsT (o ..:? "curator")
+    drops <- o ..:? "drop-packages" ..!= mempty
+    pure $ do
+      deps' <- mapM (resolvePaths (Just rootDir)) deps
+      resolver' <- resolvePaths (Just rootDir) resolver
+      let project = Project
+            { projectUserMsg = msg
+            , projectResolver = resolver'
+            , projectCompiler = mcompiler -- FIXME make sure resolver' isn't SLCompiler
+            , projectExtraPackageDBs = extraPackageDBs
+            , projectPackages = packages
+            , projectDependencies =
+                concatMap toList (deps' :: [NonEmpty RawPackageLocation])
+            , projectFlags = flags
+            , projectCurator = mcurator
+            , projectDropPackages = Set.map unCabalString drops
+            }
+      pure $ ProjectAndConfigMonoid project config
+ src/Stack/Types/ProjectConfig.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.ProjectConfig
+  ( ProjectConfig (..)
+  ) where
+
+import           Stack.Prelude
+
+-- | Project configuration information. Not every run of Stack has a
+-- true local project; see constructors below.
+data ProjectConfig a
+  = PCProject a
+    -- ^ Normal run: we want a project, and have one. This comes from
+    -- either 'SYLDefault' or 'SYLOverride'.
+  | PCGlobalProject
+    -- ^ No project was found when using 'SYLDefault'. Instead, use
+    -- the implicit global.
+  | PCNoProject ![PackageIdentifierRevision]
+    -- ^ Use a no project run. This comes from 'SYLNoProject'.
+ src/Stack/Types/PvpBounds.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.PvpBounds
+  ( PvpBounds (..)
+  , PvpBoundsType (..)
+  , pvpBoundsText
+  , parsePvpBounds
+  ) where
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), ToJSON (..), withText
+                   )
+import           Stack.Prelude
+
+-- | How PVP bounds should be added to .cabal files
+data PvpBoundsType
+  = PvpBoundsNone
+  | PvpBoundsUpper
+  | PvpBoundsLower
+  | PvpBoundsBoth
+  deriving (Bounded, Enum, Eq, Ord, Read, Show, Typeable)
+
+data PvpBounds = PvpBounds
+  { pbType :: !PvpBoundsType
+  , pbAsRevision :: !Bool
+  }
+  deriving (Eq, Ord, Read, Show, Typeable)
+
+pvpBoundsText :: PvpBoundsType -> Text
+pvpBoundsText PvpBoundsNone = "none"
+pvpBoundsText PvpBoundsUpper = "upper"
+pvpBoundsText PvpBoundsLower = "lower"
+pvpBoundsText PvpBoundsBoth = "both"
+
+parsePvpBounds :: Text -> Either String PvpBounds
+parsePvpBounds t = maybe err Right $ do
+  (t', asRevision) <-
+    case T.break (== '-') t of
+      (x, "") -> Just (x, False)
+      (x, "-revision") -> Just (x, True)
+      _ -> Nothing
+  x <- Map.lookup t' m
+  Just PvpBounds
+    { pbType = x
+    , pbAsRevision = asRevision
+    }
+ where
+  m = Map.fromList $ map (pvpBoundsText &&& id) [minBound..maxBound]
+  err = Left $ "Invalid PVP bounds: " ++ T.unpack t
+
+instance ToJSON PvpBounds where
+  toJSON (PvpBounds typ asRevision) =
+    toJSON (pvpBoundsText typ <> (if asRevision then "-revision" else ""))
+
+instance FromJSON PvpBounds where
+  parseJSON = withText "PvpBounds" (either fail pure . parsePvpBounds)
src/Stack/Types/Resolver.hs view
@@ -1,12 +1,7 @@ {-# LANGUAGE NoImplicitPrelude    #-}
-{-# LANGUAGE ConstraintKinds      #-}
 {-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE DeriveDataTypeable   #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE GADTs                #-}
 {-# LANGUAGE OverloadedStrings    #-}
-{-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -31,34 +26,34 @@ -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Types.Resolver" module.
 data TypesResolverException
-    = ParseResolverException !Text
-    | FilepathInDownloadedSnapshot !Text
-    deriving (Show, Typeable)
+  = ParseResolverException !Text
+  | FilepathInDownloadedSnapshot !Text
+  deriving (Show, Typeable)
 
 instance Exception TypesResolverException where
-    displayException (ParseResolverException t) = concat
-        [ "Error: [S-8787]\n"
-        , "Invalid resolver value: "
-        , T.unpack t
-        , ". Possible valid values include lts-2.12, nightly-YYYY-MM-DD, \
-          \ghc-7.10.2, and ghcjs-0.1.0_ghc-7.10.2. See \
-          \https://www.stackage.org/snapshots for a complete list."
-        ]
-    displayException (FilepathInDownloadedSnapshot url) = unlines
-        [ "Error: [S-4865]"
-        , "Downloaded snapshot specified a 'resolver: { location: filepath }' "
-        , "field, but filepaths are not allowed in downloaded snapshots.\n"
-        , "Filepath specified: " ++ T.unpack url
-        ]
+  displayException (ParseResolverException t) = concat
+    [ "Error: [S-8787]\n"
+    , "Invalid resolver value: "
+    , T.unpack t
+    , ". Possible valid values include lts-2.12, nightly-YYYY-MM-DD, \
+      \ghc-7.10.2, and ghcjs-0.1.0_ghc-7.10.2. See \
+      \https://www.stackage.org/snapshots for a complete list."
+    ]
+  displayException (FilepathInDownloadedSnapshot url) = unlines
+    [ "Error: [S-4865]"
+    , "Downloaded snapshot specified a 'resolver: { location: filepath }' "
+    , "field, but filepaths are not allowed in downloaded snapshots.\n"
+    , "Filepath specified: " ++ T.unpack url
+    ]
 
 -- | Either an actual resolver value, or an abstract description of one (e.g.,
 -- latest nightly).
 data AbstractResolver
-    = ARLatestNightly
-    | ARLatestLTS
-    | ARLatestLTSMajor !Int
-    | ARResolver !RawSnapshotLocation
-    | ARGlobal
+  = ARLatestNightly
+  | ARLatestLTS
+  | ARLatestLTSMajor !Int
+  | ARResolver !RawSnapshotLocation
+  | ARGlobal
 
 instance Show AbstractResolver where
   show = T.unpack . utf8BuilderToText . display
@@ -72,38 +67,39 @@ 
 readAbstractResolver :: ReadM (Unresolved AbstractResolver)
 readAbstractResolver = do
-    s <- OA.readerAsk
-    case s of
-        "global" -> pure $ pure ARGlobal
-        "nightly" -> pure $ pure ARLatestNightly
-        "lts" -> pure $ pure ARLatestLTS
-        'l':'t':'s':'-':x | Right (x', "") <- decimal $ T.pack x ->
-            pure $ pure $ ARLatestLTSMajor x'
-        _ -> pure $ ARResolver <$> parseRawSnapshotLocation (T.pack s)
+  s <- OA.readerAsk
+  case s of
+    "global" -> pure $ pure ARGlobal
+    "nightly" -> pure $ pure ARLatestNightly
+    "lts" -> pure $ pure ARLatestLTS
+    'l':'t':'s':'-':x | Right (x', "") <- decimal $ T.pack x ->
+        pure $ pure $ ARLatestLTSMajor x'
+    _ -> pure $ ARResolver <$> parseRawSnapshotLocation (T.pack s)
 
 -- | Most recent Nightly and newest LTS version per major release.
 data Snapshots = Snapshots
-    { snapshotsNightly :: !Day
-    , snapshotsLts     :: !(IntMap Int)
-    }
-    deriving Show
+  { snapshotsNightly :: !Day
+  , snapshotsLts     :: !(IntMap Int)
+  }
+  deriving Show
+
 instance FromJSON Snapshots where
-    parseJSON = withObject "Snapshots" $ \o -> Snapshots
-        <$> (o .: "nightly" >>= parseNightly)
-        <*> fmap IntMap.unions (mapM (parseLTS . snd)
-                $ filter (isLTS . Key.toText . fst)
-                $ KeyMap.toList o)
-      where
-        parseNightly t =
-            case parseSnapName t of
-                Left e -> fail $ displayException e
-                Right (LTS _ _) -> fail "Unexpected LTS value"
-                Right (Nightly d) -> pure d
+  parseJSON = withObject "Snapshots" $ \o -> Snapshots
+    <$> (o .: "nightly" >>= parseNightly)
+    <*> fmap IntMap.unions (mapM (parseLTS . snd)
+          $ filter (isLTS . Key.toText . fst)
+          $ KeyMap.toList o)
+   where
+    parseNightly t =
+      case parseSnapName t of
+        Left e -> fail $ displayException e
+        Right (LTS _ _) -> fail "Unexpected LTS value"
+        Right (Nightly d) -> pure d
 
-        isLTS = ("lts-" `T.isPrefixOf`)
+    isLTS = ("lts-" `T.isPrefixOf`)
 
-        parseLTS = withText "LTS" $ \t ->
-            case parseSnapName t of
-                Left e -> fail $ displayException e
-                Right (LTS x y) -> pure $ IntMap.singleton x y
-                Right (Nightly _) -> fail "Unexpected nightly value"
+    parseLTS = withText "LTS" $ \t ->
+      case parseSnapName t of
+        Left e -> fail $ displayException e
+        Right (LTS x y) -> pure $ IntMap.singleton x y
+        Right (Nightly _) -> fail "Unexpected nightly value"
+ src/Stack/Types/Runner.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.Runner
+  ( Runner (..)
+  , HasRunner (..)
+  , globalOptsL
+  , stackYamlLocL
+  , lockFileBehaviorL
+  , terminalL
+  , reExecL
+  , rslInLogL
+  ) where
+
+import           RIO.Process ( HasProcessContext (..), ProcessContext )
+import           Stack.Prelude
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.LockFileBehavior ( LockFileBehavior )
+import           Stack.Types.StackYamlLoc ( StackYamlLoc )
+
+-- | The base environment that almost everything in Stack runs in,
+-- based off of parsing command line options in 'GlobalOpts'. Provides
+-- logging and process execution.
+data Runner = Runner
+  { runnerGlobalOpts :: !GlobalOpts
+  , runnerUseColor   :: !Bool
+  , runnerLogFunc    :: !LogFunc
+  , runnerTermWidth  :: !Int
+  , runnerProcessContext :: !ProcessContext
+  }
+
+instance HasLogFunc Runner where
+  logFuncL = lens runnerLogFunc (\x y -> x { runnerLogFunc = y })
+
+instance HasProcessContext Runner where
+  processContextL =
+    lens runnerProcessContext (\x y -> x { runnerProcessContext = y })
+
+instance HasRunner Runner where
+  runnerL = id
+
+instance HasStylesUpdate Runner where
+  stylesUpdateL = globalOptsL.
+                  lens globalStylesUpdate (\x y -> x { globalStylesUpdate = y })
+instance HasTerm Runner where
+  useColorL = lens runnerUseColor (\x y -> x { runnerUseColor = y })
+  termWidthL = lens runnerTermWidth (\x y -> x { runnerTermWidth = y })
+
+-- | Class for environment values which have a 'Runner'.
+class (HasProcessContext env, HasLogFunc env) => HasRunner env where
+  runnerL :: Lens' env Runner
+
+stackYamlLocL :: HasRunner env => Lens' env StackYamlLoc
+stackYamlLocL =
+  globalOptsL.lens globalStackYaml (\x y -> x { globalStackYaml = y })
+
+lockFileBehaviorL :: HasRunner env => SimpleGetter env LockFileBehavior
+lockFileBehaviorL = globalOptsL.to globalLockFileBehavior
+
+globalOptsL :: HasRunner env => Lens' env GlobalOpts
+globalOptsL = runnerL.lens runnerGlobalOpts (\x y -> x { runnerGlobalOpts = y })
+
+-- | See 'globalTerminal'
+terminalL :: HasRunner env => Lens' env Bool
+terminalL = globalOptsL.lens globalTerminal (\x y -> x { globalTerminal = y })
+
+-- | See 'globalReExecVersion'
+reExecL :: HasRunner env => SimpleGetter env Bool
+reExecL = globalOptsL.to (isJust . globalReExecVersion)
+
+rslInLogL :: HasRunner env => SimpleGetter env Bool
+rslInLogL = globalOptsL.to globalRSLInLog
+ src/Stack/Types/SCM.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.SCM
+  ( SCM (..)
+  ) where
+
+import           Pantry.Internal.AesonExtended ( FromJSON (..), ToJSON (..) )
+import           Stack.Prelude
+
+-- | A software control system.
+data SCM
+  = Git
+  deriving Show
+
+instance FromJSON SCM where
+  parseJSON v = do
+    s <- parseJSON v
+    case s of
+      "git" -> pure Git
+      _ -> fail ("Unknown or unsupported SCM: " <> s)
+
+instance ToJSON SCM where
+  toJSON Git = toJSON ("git" :: Text)
+ src/Stack/Types/SetupInfo.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+
+module Stack.Types.SetupInfo
+  ( SetupInfo (..)
+  ) where
+
+import qualified Data.Map as Map
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), WithJSONWarnings, (..:?), (..!=)
+                   , jsonSubWarningsT, jsonSubWarningsTT, withObjectWarnings
+                   )
+import           Stack.Prelude
+import           Stack.Types.DownloadInfo ( DownloadInfo )
+import           Stack.Types.VersionedDownloadInfo ( VersionedDownloadInfo )
+import           Stack.Types.GHCDownloadInfo ( GHCDownloadInfo )
+
+data SetupInfo = SetupInfo
+  { siSevenzExe :: Maybe DownloadInfo
+  , siSevenzDll :: Maybe DownloadInfo
+  , siMsys2 :: Map Text VersionedDownloadInfo
+  , siGHCs :: Map Text (Map Version GHCDownloadInfo)
+  , siStack :: Map Text (Map Version DownloadInfo)
+  }
+  deriving Show
+
+instance FromJSON (WithJSONWarnings SetupInfo) where
+  parseJSON = withObjectWarnings "SetupInfo" $ \o -> do
+    siSevenzExe <- jsonSubWarningsT (o ..:? "sevenzexe-info")
+    siSevenzDll <- jsonSubWarningsT (o ..:? "sevenzdll-info")
+    siMsys2 <- jsonSubWarningsT (o ..:? "msys2" ..!= mempty)
+    (fmap unCabalStringMap -> siGHCs) <-
+      jsonSubWarningsTT (o ..:? "ghc" ..!= mempty)
+    (fmap unCabalStringMap -> siStack) <-
+      jsonSubWarningsTT (o ..:? "stack" ..!= mempty)
+    pure SetupInfo {..}
+
+-- | For the @siGHCs@ field maps are deeply merged. For all fields the values
+-- from the first @SetupInfo@ win.
+instance Semigroup SetupInfo where
+  l <> r =
+    SetupInfo
+    { siSevenzExe = siSevenzExe l <|> siSevenzExe r
+    , siSevenzDll = siSevenzDll l <|> siSevenzDll r
+    , siMsys2 = siMsys2 l <> siMsys2 r
+    , siGHCs = Map.unionWith (<>) (siGHCs l) (siGHCs r)
+    , siStack = Map.unionWith (<>) (siStack l) (siStack r) }
+
+instance Monoid SetupInfo where
+  mempty =
+    SetupInfo
+    { siSevenzExe = Nothing
+    , siSevenzDll = Nothing
+    , siMsys2 = Map.empty
+    , siGHCs = Map.empty
+    , siStack = Map.empty
+    }
+  mappend = (<>)
src/Stack/Types/SourceMap.hs view
@@ -1,9 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
--- | A sourcemap maps a package name to how it should be built,
--- including source code, flags, options, etc. This module contains
--- various stages of source map construction. See the
--- @build_overview.md@ doc for details on these stages.
+-- | A sourcemap maps a package name to how it should be built, including source
+-- code, flags, options, etc. This module contains various stages of source map
+-- construction. See the @build_overview.md@ doc for details on these stages.
 module Stack.Types.SourceMap
   ( -- * Different source map types
     SMWanted (..)
@@ -16,6 +15,10 @@   , FromSnapshot (..)
   , DepPackage (..)
   , ProjectPackage (..)
+  , ppComponents
+  , ppGPD
+  , ppRoot
+  , ppVersion
   , CommonPackage (..)
   , GlobalPackageVersion (..)
   , GlobalPackage (..)
@@ -24,42 +27,45 @@   , smRelDir
   ) where
 
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Distribution.PackageDescription ( GenericPackageDescription )
+import qualified Distribution.PackageDescription as C
 import qualified Pantry.SHA256 as SHA256
-import           Path
+import           Path ( parent, parseRelDir )
 import           Stack.Prelude
-import           Stack.Types.Compiler
-import           Stack.Types.NamedComponent
+import           Stack.Types.Compiler ( ActualCompiler )
+import           Stack.Types.NamedComponent ( NamedComponent (..) )
 
 -- | Common settings for both dependency and project package.
 data CommonPackage = CommonPackage
   { cpGPD :: !(IO GenericPackageDescription)
   , cpName :: !PackageName
   , cpFlags :: !(Map FlagName Bool)
-  -- ^ overrides default flags
-  , cpGhcOptions :: ![Text] -- also lets us know if we're doing profiling
+    -- ^ overrides default flags
+  , cpGhcOptions :: ![Text]
+    -- also lets us know if we're doing profiling
   , cpCabalConfigOpts :: ![Text]
   , cpHaddocks :: !Bool
   }
 
--- | Flag showing if package comes from a snapshot
--- needed to ignore dependency bounds between such packages
+-- | Flag showing if package comes from a snapshot needed to ignore dependency
+-- bounds between such packages
 data FromSnapshot
-    = FromSnapshot
-    | NotFromSnapshot
-    deriving (Show)
+  = FromSnapshot
+  | NotFromSnapshot
+  deriving Show
 
 -- | A view of a dependency package, specified in stack.yaml
 data DepPackage = DepPackage
   { dpCommon :: !CommonPackage
   , dpLocation :: !PackageLocation
   , dpHidden :: !Bool
-  -- ^ Should the package be hidden after registering?
-  -- Affects the script interpreter's module name import parser.
+    -- ^ Should the package be hidden after registering? Affects the script
+    -- interpreter's module name import parser.
   , dpFromSnapshot :: !FromSnapshot
-  -- ^ Needed to ignore bounds between snapshot packages
-  -- See https://github.com/commercialhaskell/stackage/issues/3185
+    -- ^ Needed to ignore bounds between snapshot packages
+    -- See https://github.com/commercialhaskell/stackage/issues/3185
   }
 
 -- | A view of a project package needed for resolving components
@@ -69,9 +75,9 @@   , ppResolvedDir :: !(ResolvedPath Dir)
   }
 
--- | A view of a package installed in the global package database also
--- could include marker for a replaced global package (could be replaced
--- because of a replaced dependency)
+-- | A view of a package installed in the global package database also could
+-- include marker for a replaced global package (could be replaced because of a
+-- replaced dependency)
 data GlobalPackage
   = GlobalPackage !Version
   | ReplacedGlobalPackage ![PackageName]
@@ -81,24 +87,24 @@ isReplacedGlobal (ReplacedGlobalPackage _) = True
 isReplacedGlobal (GlobalPackage _) = False
 
--- | A source map with information on the wanted (but not actual)
--- compiler. This is derived by parsing the @stack.yaml@ file for
--- @packages@, @extra-deps@, their configuration (e.g., flags and
--- options), and parsing the snapshot it refers to. It does not
--- include global packages or any information from the command line.
+-- | A source map with information on the wanted (but not actual) compiler. This
+-- is derived by parsing the @stack.yaml@ file for @packages@, @extra-deps@,
+-- their configuration (e.g., flags and options), and parsing the snapshot it
+-- refers to. It does not include global packages or any information from the
+-- command line.
 --
--- Invariant: a @PackageName@ appears in either 'smwProject' or
--- 'smwDeps', but not both.
+-- Invariant: a @PackageName@ appears in either 'smwProject' or 'smwDeps', but
+-- not both.
 data SMWanted = SMWanted
   { smwCompiler :: !WantedCompiler
   , smwProject :: !(Map PackageName ProjectPackage)
   , smwDeps :: !(Map PackageName DepPackage)
   , smwSnapshotLocation :: !RawSnapshotLocation
-  -- ^ Where this snapshot is loaded from.
+    -- ^ Where this snapshot is loaded from.
   }
 
--- | Adds in actual compiler information to 'SMWanted', in particular
--- the contents of the global package database.
+-- | Adds in actual compiler information to 'SMWanted', in particular the
+-- contents of the global package database.
 --
 -- Invariant: a @PackageName@ appears in only one of the @Map@s.
 data SMActual global = SMActual
@@ -108,7 +114,8 @@   , smaGlobal :: !(Map PackageName global)
   }
 
-newtype GlobalPackageVersion = GlobalPackageVersion Version
+newtype GlobalPackageVersion
+  = GlobalPackageVersion Version
 
 -- | How a package is intended to be built
 data Target
@@ -120,41 +127,67 @@ data PackageType = PTProject | PTDependency
   deriving (Eq, Show)
 
--- | Builds on an 'SMActual' by resolving the targets specified on the
--- command line, potentially adding in new dependency packages in the
--- process.
+-- | Builds on an 'SMActual' by resolving the targets specified on the command
+-- line, potentially adding in new dependency packages in the process.
 data SMTargets = SMTargets
   { smtTargets :: !(Map PackageName Target)
   , smtDeps :: !(Map PackageName DepPackage)
   }
 
--- | The final source map, taking an 'SMTargets' and applying all
--- command line flags and GHC options.
+-- | The final source map, taking an 'SMTargets' and applying all command line
+-- flags and GHC options.
 data SourceMap = SourceMap
   { smTargets :: !SMTargets
-    -- ^ Doesn't need to be included in the hash, does not affect the
-    -- source map.
+    -- ^ Doesn't need to be included in the hash, does not affect the source
+    -- map.
   , smCompiler :: !ActualCompiler
-    -- ^ Need to hash the compiler version _and_ its installation
-    -- path.  Ideally there would be some kind of output from GHC
-    -- telling us some unique ID for the compiler itself.
+    -- ^ Need to hash the compiler version _and_ its installation path. Ideally
+    -- there would be some kind of output from GHC telling us some unique ID for
+    -- the compiler itself.
   , smProject :: !(Map PackageName ProjectPackage)
-    -- ^ Doesn't need to be included in hash, doesn't affect any of
-    -- the packages that get stored in the snapshot database.
+    -- ^ Doesn't need to be included in hash, doesn't affect any of the packages
+    -- that get stored in the snapshot database.
   , smDeps :: !(Map PackageName DepPackage)
-    -- ^ Need to hash all of the immutable dependencies, can ignore
-    -- the mutable dependencies.
+    -- ^ Need to hash all of the immutable dependencies, can ignore the mutable
+    -- dependencies.
   , smGlobal :: !(Map PackageName GlobalPackage)
-    -- ^ Doesn't actually need to be hashed, implicitly captured by
-    -- smCompiler. Can be broken if someone installs new global
-    -- packages. We can document that as not supported, _or_ we could
-    -- actually include all of this in the hash and make Stack more
-    -- resilient.
+    -- ^ Doesn't actually need to be hashed, implicitly captured by smCompiler.
+    -- Can be broken if someone installs new global packages. We can document
+    -- that as not supported, _or_ we could actually include all of this in the
+    -- hash and make Stack more resilient.
   }
 
 -- | A unique hash for the immutable portions of a 'SourceMap'.
-newtype SourceMapHash = SourceMapHash SHA256
+newtype SourceMapHash
+  = SourceMapHash SHA256
 
 -- | Returns relative directory name with source map's hash
 smRelDir :: (MonadThrow m) => SourceMapHash -> m (Path Rel Dir)
 smRelDir (SourceMapHash smh) = parseRelDir $ T.unpack $ SHA256.toHexText smh
+
+ppGPD :: MonadIO m => ProjectPackage -> m GenericPackageDescription
+ppGPD = liftIO . cpGPD . ppCommon
+
+-- | Root directory for the given 'ProjectPackage'
+ppRoot :: ProjectPackage -> Path Abs Dir
+ppRoot = parent . ppCabalFP
+
+-- | All components available in the given 'ProjectPackage'
+ppComponents :: MonadIO m => ProjectPackage -> m (Set NamedComponent)
+ppComponents pp = do
+  gpd <- ppGPD pp
+  pure $ Set.fromList $ concat
+    [ maybe []  (const [CLib]) (C.condLibrary gpd)
+    , go CExe   (fst <$> C.condExecutables gpd)
+    , go CTest  (fst <$> C.condTestSuites gpd)
+    , go CBench (fst <$> C.condBenchmarks gpd)
+    ]
+ where
+  go :: (T.Text -> NamedComponent)
+     -> [C.UnqualComponentName]
+     -> [NamedComponent]
+  go wrapper = map (wrapper . T.pack . C.unUnqualComponentName)
+
+-- | Version for the given 'ProjectPackage
+ppVersion :: MonadIO m => ProjectPackage -> m Version
+ppVersion = fmap gpdVersion . ppGPD
+ src/Stack/Types/StackYamlLoc.hs view
@@ -0,0 +1,21 @@+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.StackYamlLoc
+  ( StackYamlLoc (..)
+  ) where
+
+import           Stack.Prelude
+
+-- | Location for the project's stack.yaml file.
+data StackYamlLoc
+  = SYLDefault
+    -- ^ Use the standard parent-directory-checking logic
+  | SYLOverride !(Path Abs File)
+    -- ^ Use a specific stack.yaml file provided
+  | SYLNoProject ![PackageIdentifierRevision]
+    -- ^ Do not load up a project, just user configuration. Include
+    -- the given extra dependencies with the resolver.
+  | SYLGlobalProject
+    -- ^ Do not look for a project configuration, and use the implicit global.
+  deriving Show
src/Stack/Types/Storage.hs view
@@ -4,9 +4,11 @@ -- | Types used by @Stack.Storage@ modules.
 module Stack.Types.Storage
   ( StoragePrettyException (..)
+  , ProjectStorage (..)
+  , UserStorage (..)
   ) where
 
-import           Data.Text
+import           Pantry.Internal ( Storage )
 import           Stack.Prelude
 
 -- | Type representing \'pretty\' exceptions thrown by functions exported by
@@ -19,18 +21,22 @@   pretty (StorageMigrationFailure desc fp ex) =
     "[S-8835]"
     <> line
-    <>     flow "Stack could not migrate the the database"
-       <+> style File (fromString $ show desc)
-       <+> flow "located at"
-       <+> style Dir (pretty fp)
+    <> fillSep
+         [ flow "Stack could not migrate the the database"
+         , style File (fromString $ show desc)
+         , flow "located at"
+         , pretty fp
+         ]
     <> "."
     <> blankLine
     <> flow "While migrating the database, Stack encountered the error:"
     <> blankLine
     <> string exMsg
     <> blankLine
-    <>     flow "Please report this as an issue at"
-       <+> style Url "https://github.com/commercialhaskell/stack/issues"
+    <> fillSep
+         [ flow "Please report this as an issue at"
+         , style Url "https://github.com/commercialhaskell/stack/issues"
+         ]
     <> "."
     <> blankLine
     -- See https://github.com/commercialhaskell/stack/issues/5851
@@ -50,3 +56,13 @@       "\\\\.\\NUL: hDuplicateTo: illegal operation (handles are incompatible)"
 
 instance Exception StoragePrettyException
+
+-- | A bit of type safety to ensure we're talking to the right database.
+newtype UserStorage = UserStorage
+  { unUserStorage :: Storage
+  }
+
+-- | A bit of type safety to ensure we're talking to the right database.
+newtype ProjectStorage = ProjectStorage
+  { unProjectStorage :: Storage
+  }
src/Stack/Types/TemplateName.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-}
 
 -- | Template name handling.
-
 module Stack.Types.TemplateName
   ( TemplateName
   , RepoTemplatePath (..)
@@ -21,93 +20,98 @@ import qualified Data.Text as T
 import           Network.HTTP.StackClient ( parseRequest )
 import qualified Options.Applicative as O
-import           Path
+import           Path ( parseAbsFile, parseRelFile )
 import           Stack.Prelude
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.Types.TemplateName" module.
 newtype TypeTemplateNameException
-    = DefaultTemplateNameNotParsedBug String
-    deriving (Show, Typeable)
+  = DefaultTemplateNameNotParsedBug String
+  deriving (Show, Typeable)
 
 instance Exception TypeTemplateNameException where
-    displayException (DefaultTemplateNameNotParsedBug s) = bugReport "[S-7410]" $
-        "The impossible happened! Cannot parse default template name: "
-        ++ s
+  displayException (DefaultTemplateNameNotParsedBug s) = bugReport "[S-7410]" $
+    "Cannot parse default template name: "
+    ++ s
 
 -- | A template name.
-data TemplateName = TemplateName !Text !TemplatePath
-  deriving (Ord,Eq,Show)
+data TemplateName
+  = TemplateName !Text !TemplatePath
+  deriving (Eq, Ord, Show)
 
-data TemplatePath = AbsPath (Path Abs File)
-                  -- ^ an absolute path on the filesystem
-                  | RelPath String (Path Rel File)
-                  -- ^ a relative path on the filesystem, or relative to
-                  -- the template repository. To avoid path separator conversion
-                  -- on Windows, the raw command-line parameter passed is also
-                  -- given as the first field (possibly with @.hsfiles@ appended).
-                  | UrlPath String
-                  -- ^ a full URL
-                  | RepoPath RepoTemplatePath
+data TemplatePath
+  = AbsPath (Path Abs File)
+    -- ^ an absolute path on the filesystem
+  | RelPath String (Path Rel File)
+    -- ^ a relative path on the filesystem, or relative to the template
+    -- repository. To avoid path separator conversion on Windows, the raw
+    -- command-line parameter passed is also given as the first field (possibly
+    -- with @.hsfiles@ appended).
+  | UrlPath String
+    -- ^ a full URL
+  | RepoPath RepoTemplatePath
   deriving (Eq, Ord, Show)
 
 -- | Details for how to access a template from a remote repo.
 data RepoTemplatePath = RepoTemplatePath
-    { rtpService  :: RepoService
-    , rtpUser     :: Text
-    , rtpTemplate :: Text
-    }
-    deriving (Eq, Ord, Show)
+  { rtpService  :: RepoService
+  , rtpUser     :: Text
+  , rtpTemplate :: Text
+  }
+  deriving (Eq, Ord, Show)
 
 -- | Services from which templates can be retrieved from a repository.
-data RepoService = GitHub | GitLab | Bitbucket
-    deriving (Eq, Ord, Show)
+data RepoService
+  = GitHub
+  | GitLab
+  | Bitbucket
+  deriving (Eq, Ord, Show)
 
 instance FromJSON TemplateName where
-    parseJSON = withText "TemplateName" $
-        either fail pure . parseTemplateNameFromString . T.unpack
+  parseJSON = withText "TemplateName" $
+    either fail pure . parseTemplateNameFromString . T.unpack
 
--- | An argument which accepts a template name of the format
--- @foo.hsfiles@ or @foo@, ultimately normalized to @foo@.
+-- | An argument which accepts a template name of the format @foo.hsfiles@ or
+-- @foo@, ultimately normalized to @foo@.
 templateNameArgument :: O.Mod O.ArgumentFields TemplateName
                      -> O.Parser TemplateName
 templateNameArgument =
-    O.argument
-        (do s <- O.str
-            either O.readerError pure (parseTemplateNameFromString s))
+  O.argument
+    (do s <- O.str
+        either O.readerError pure (parseTemplateNameFromString s))
 
 -- | An argument which accepts a @key:value@ pair for specifying parameters.
 templateParamArgument :: O.Mod O.OptionFields (Text,Text)
                       -> O.Parser (Text,Text)
 templateParamArgument =
-    O.option
-        (do s <- O.str
-            either O.readerError pure (parsePair s))
-  where
-    parsePair :: String -> Either String (Text, Text)
-    parsePair s =
-        case break (==':') s of
-            (key,':':value@(_:_)) -> Right (T.pack key, T.pack value)
-            _ -> Left ("Expected key:value format for argument: " <> s)
+  O.option
+    (do s <- O.str
+        either O.readerError pure (parsePair s))
+ where
+  parsePair :: String -> Either String (Text, Text)
+  parsePair s =
+    case break (==':') s of
+      (key,':':value@(_:_)) -> Right (T.pack key, T.pack value)
+      _ -> Left ("Expected key:value format for argument: " <> s)
 
 -- | Parse a template name from a string.
 parseTemplateNameFromString :: String -> Either String TemplateName
 parseTemplateNameFromString fname =
-    case T.stripSuffix ".hsfiles" (T.pack fname) of
-        Nothing -> parseValidFile (T.pack fname) (fname <> ".hsfiles") fname
-        Just prefix -> parseValidFile prefix fname fname
-  where
-    parseValidFile prefix hsf orig = maybe (Left expected) Right
-                                           $ asum (validParses prefix hsf orig)
-    validParses prefix hsf orig =
-        -- NOTE: order is important
-        [ TemplateName prefix        . RepoPath <$> parseRepoPath hsf
-        , TemplateName (T.pack orig) . UrlPath <$> (parseRequest orig *> Just orig)
-        , TemplateName prefix        . AbsPath <$> parseAbsFile hsf
-        , TemplateName prefix        . RelPath hsf <$> parseRelFile hsf
-        ]
-    expected = "Expected a template like: foo or foo.hsfiles or\
-               \ https://example.com/foo.hsfiles or github:user/foo"
+  case T.stripSuffix ".hsfiles" (T.pack fname) of
+    Nothing -> parseValidFile (T.pack fname) (fname <> ".hsfiles") fname
+    Just prefix -> parseValidFile prefix fname fname
+ where
+  parseValidFile prefix hsf orig =
+    maybe (Left expected) Right $ asum (validParses prefix hsf orig)
+  validParses prefix hsf orig =
+    -- NOTE: order is important
+    [ TemplateName prefix        . RepoPath <$> parseRepoPath hsf
+    , TemplateName (T.pack orig) . UrlPath <$> (parseRequest orig *> Just orig)
+    , TemplateName prefix        . AbsPath <$> parseAbsFile hsf
+    , TemplateName prefix        . RelPath hsf <$> parseRelFile hsf
+    ]
+  expected = "Expected a template like: foo or foo.hsfiles or \
+             \https://example.com/foo.hsfiles or github:user/foo"
 
 -- | The default template name you can use if you don't have one.
 defaultTemplateName :: TemplateName
@@ -142,7 +146,7 @@ parseRepoPathWithService service path =
   case T.splitOn "/" path of
     [user, name] -> Just $ RepoTemplatePath service user name
-    [name]       -> do
-        repoUser <- defaultRepoUserForService service
-        Just $ RepoTemplatePath service repoUser name
-    _            -> Nothing
+    [name] -> do
+      repoUser <- defaultRepoUserForService service
+      Just $ RepoTemplatePath service repoUser name
+    _ -> Nothing
+ src/Stack/Types/UnusedFlags.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.UnusedFlags
+  ( UnusedFlags (..)
+  , FlagSource (..)
+  ) where
+
+import           Stack.Prelude
+
+data FlagSource
+  = FSCommandLine
+  | FSStackYaml
+  deriving (Eq, Ord, Show)
+
+data UnusedFlags
+  = UFNoPackage FlagSource PackageName
+  | UFFlagsNotDefined
+      FlagSource
+      PackageName
+      (Set FlagName) -- defined in package
+      (Set FlagName) -- not defined
+  | UFSnapshot PackageName
+  deriving (Eq, Ord, Show)
src/Stack/Types/Version.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns      #-}
 
 -- | Versions for packages.
-
 module Stack.Types.Version
   ( Cabal.VersionRange -- TODO in the future should have a newtype wrapper
   , IntersectingVersionRange (..)
@@ -52,8 +50,12 @@ versionRangeText = T.pack . render . pretty
 
 -- | A modified intersection which also simplifies, for better display.
-intersectVersionRanges :: Cabal.VersionRange -> Cabal.VersionRange -> Cabal.VersionRange
-intersectVersionRanges x y = Cabal.simplifyVersionRange $ Cabal.intersectVersionRanges x y
+intersectVersionRanges ::
+     Cabal.VersionRange
+  -> Cabal.VersionRange
+  -> Cabal.VersionRange
+intersectVersionRanges x y =
+  Cabal.simplifyVersionRange $ Cabal.intersectVersionRanges x y
 
 -- | Returns the first two components, defaulting to 0 if not present
 toMajorVersion :: Version -> Version
+ src/Stack/Types/VersionedDownloadInfo.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.VersionedDownloadInfo
+  ( VersionedDownloadInfo (..)
+  ) where
+
+import           Pantry.Internal.AesonExtended
+                   ( FromJSON (..), WithJSONWarnings (..), (..:)
+                   , withObjectWarnings
+                   )
+import           Stack.Prelude
+import           Stack.Types.DownloadInfo
+                   ( DownloadInfo, parseDownloadInfoFromObject )
+
+data VersionedDownloadInfo = VersionedDownloadInfo
+  { vdiVersion :: Version
+  , vdiDownloadInfo :: DownloadInfo
+  }
+  deriving Show
+
+instance FromJSON (WithJSONWarnings VersionedDownloadInfo) where
+  parseJSON = withObjectWarnings "VersionedDownloadInfo" $ \o -> do
+    CabalString version <- o ..: "version"
+    downloadInfo <- parseDownloadInfoFromObject o
+    pure VersionedDownloadInfo
+      { vdiVersion = version
+      , vdiDownloadInfo = downloadInfo
+      }
+ src/Stack/Uninstall.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Function related to Stack's @uninstall@ command.
+module Stack.Uninstall
+  ( uninstallCmd
+  ) where
+
+import          Stack.Constants ( osIsWindows )
+import          Stack.Prelude
+import          Stack.Runners ( ShouldReexec (..), withConfig )
+import          Stack.Types.Config
+                  ( configL, configLocalBin, configLocalProgramsBase
+                  , stackGlobalConfigL, stackRootL
+                  )
+import          Stack.Types.Runner ( Runner )
+
+-- | Function underlying the @stack uninstall@ command. Display help for the
+-- command.
+uninstallCmd :: () -> RIO Runner ()
+uninstallCmd () = withConfig NoReexec $ do
+  stackRoot <- view stackRootL
+  globalConfig <- view stackGlobalConfigL
+  programsDir <- view $ configL.to configLocalProgramsBase
+  localBinDir <- view $ configL.to configLocalBin
+  let toStyleDoc = style Dir . fromString . toFilePath
+      stackRoot' = toStyleDoc stackRoot
+      globalConfig' = toStyleDoc globalConfig
+      programsDir' = toStyleDoc programsDir
+      localBinDir' = toStyleDoc localBinDir
+  prettyInfo $
+       vsep
+         [ flow "To uninstall Stack, it should be sufficient to delete:"
+         , hang 4 $ fillSep
+             [ flow "(1) the directory containing Stack's tools"
+             , "(" <> softbreak <> programsDir' <> softbreak <> ");"
+             ]
+         , hang 4 $ fillSep
+             [ flow "(2) the Stack root directory"
+             , "(" <> softbreak <> stackRoot' <> softbreak <> ");"
+             ]
+         , hang 4 $ fillSep
+             [ flow "(3) if different, the directory containing "
+             , flow "Stack's global YAML configuration file"
+             , parens globalConfig' <> ";"
+             , "and"
+             ]
+         , hang 4 $ fillSep
+             [ flow "(4) the 'stack' executable file (see the output"
+             , flow "of command"
+             , howToFindStack <> ","
+             , flow "if Stack is on the PATH;"
+             , flow "Stack is often installed in"
+             , localBinDir' <> softbreak <> ")."
+             ]
+         , fillSep
+             [flow "You may also want to delete"
+             , style File ".stack-work"
+             , flow "directories in any Haskell projects that you have built."
+             ]
+         ]
+      <> blankLine
+      <> vsep
+           [ fillSep
+               [ flow "To uninstall completely a Stack-supplied tool (such as \
+                      \GHC or, on Windows, MSYS2), delete from Stack's tools \
+                      \directory"
+               , parens programsDir' <> ":"
+               ]
+           , hang 4 $ fillSep
+               [ flow "(1) the tool's subdirectory;"
+               ]
+           , hang 4 $ fillSep
+               [ flow "(2) the tool's archive file"
+               , parens (style File "<tool>.tar.xz") <> "; and"
+               ]
+           , hang 4 $ fillSep
+               [ flow "(3) the file marking that the tool is installed"
+               , parens (style File "<tool>.installed") <> "."
+               ]
+           ]
+ where
+  styleShell = style Shell
+  howToFindStack
+    | osIsWindows = styleShell "where.exe stack"
+    | otherwise   = styleShell "which stack"
src/Stack/Unpack.hs view
@@ -1,118 +1,171 @@ {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
+-- | Functions related to Stack's @unpack@ command.
 module Stack.Unpack
-  ( unpackPackages
+  ( unpackCmd
+  , unpackPackages
   ) where
 
 import           Path ( (</>), parseRelDir )
-import           Path.IO ( doesDirExist )
-import           RIO.List ( intercalate )
+import           Path.IO ( doesDirExist, resolveDir' )
+import           Pantry ( loadSnapshot )
 import qualified RIO.Map as Map
 import           RIO.Process ( HasProcessContext )
 import qualified RIO.Set as Set
 import qualified RIO.Text as T
+import           Stack.Config ( makeConcreteResolver )
 import           Stack.Prelude
+import           Stack.Runners ( ShouldReexec (..), withConfig )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Runner ( Runner, globalOptsL )
 
--- | Type representing exceptions thrown by functions exported by the
+-- | Type representing \'pretty\' exceptions thrown by functions exported by the
 -- "Stack.Unpack" module.
-data UnpackException
+data UnpackPrettyException
   = UnpackDirectoryAlreadyExists (Set (Path Abs Dir))
-  | CouldNotParsePackageSelectors [String]
+  | CouldNotParsePackageSelectors [StyleDoc]
   deriving (Show, Typeable)
 
-instance Exception UnpackException where
-    displayException (UnpackDirectoryAlreadyExists dirs) = unlines
-        $ "Error: [S-3515]"
-        : "Unable to unpack due to already present directories:"
-        : map (("    " ++) . toFilePath) (Set.toList dirs)
-    displayException (CouldNotParsePackageSelectors strs) = unlines
-        $ "Error: [S-2628]"
-        : "The following package selectors are not valid package names or \
-          \identifiers:"
-        : map ("- " ++) strs
+instance Pretty UnpackPrettyException where
+  pretty (UnpackDirectoryAlreadyExists dirs) =
+    "[S-3515]"
+    <> line
+    <> flow "Stack was unable to unpack due to directories already being \
+            \present:"
+    <> line
+    <> bulletedList (map pretty $ Set.toList dirs)
+  pretty (CouldNotParsePackageSelectors errs) =
+    "[S-2628]"
+    <> line
+    <> flow "The following package selectors are not valid package names or \
+            \identifiers:"
+    <> line
+    <> bulletedList errs
 
+instance Exception UnpackPrettyException
+
+-- | Function underlying the @stack unpack@ command. Unpack packages to the
+-- filesystem.
+unpackCmd ::
+     ([String], Maybe Text)
+     -- ^ A pair of a list of names or identifiers and an optional destination
+     -- path.
+  -> RIO Runner ()
+unpackCmd (names, Nothing) = unpackCmd (names, Just ".")
+unpackCmd (names, Just dstPath) = withConfig NoReexec $ do
+  mresolver <- view $ globalOptsL.to globalResolver
+  mSnapshot <- forM mresolver $ \resolver -> do
+    concrete <- makeConcreteResolver resolver
+    loc <- completeSnapshotLocation concrete
+    loadSnapshot loc
+  dstPath' <- resolveDir' $ T.unpack dstPath
+  unpackPackages mSnapshot dstPath' names
+
 -- | Intended to work for the command line command.
-unpackPackages
-  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => Maybe RawSnapshot -- ^ when looking up by name, take from this build plan
-  -> Path Abs Dir -- ^ destination
-  -> [String] -- ^ names or identifiers
+unpackPackages ::
+     forall env. (HasPantryConfig env, HasProcessContext env, HasTerm env)
+  => Maybe RawSnapshot -- ^ When looking up by name, take from this build plan.
+  -> Path Abs Dir -- ^ Destination.
+  -> [String] -- ^ Names or identifiers.
   -> RIO env ()
 unpackPackages mSnapshot dest input = do
-    let (errs1, (names, pirs1)) =
-          fmap partitionEithers $ partitionEithers $ map parse input
-    locs1 <- forM pirs1 $ \pir -> do
-      loc <- fmap cplComplete $ completePackageLocation $ RPLIHackage pir Nothing
-      pure (loc, packageLocationIdent loc)
-    (errs2, locs2) <- partitionEithers <$> traverse toLoc names
-    case errs1 ++ errs2 of
-      [] -> pure ()
-      errs -> throwM $ CouldNotParsePackageSelectors errs
-    locs <- Map.fromList <$> mapM
-          (\(pir, ident) -> do
-              suffix <- parseRelDir $ packageIdentifierString ident
-              pure (pir, dest </> suffix)
-          )
-          (locs1 ++ locs2)
+  let (errs1, (names, pirs1)) =
+        fmap partitionEithers $ partitionEithers $ map parse input
+  locs1 <- forM pirs1 $ \pir -> do
+    loc <- fmap cplComplete $ completePackageLocation $ RPLIHackage pir Nothing
+    pure (loc, packageLocationIdent loc)
+  (errs2, locs2) <- partitionEithers <$> traverse toLoc names
+  case errs1 ++ errs2 of
+    [] -> pure ()
+    errs -> prettyThrowM $ CouldNotParsePackageSelectors errs
+  locs <- Map.fromList <$> mapM
+    (\(pir, ident) -> do
+        suffix <- parseRelDir $ packageIdentifierString ident
+        pure (pir, dest </> suffix)
+    )
+    (locs1 ++ locs2)
 
-    alreadyUnpacked <- filterM doesDirExist $ Map.elems locs
+  alreadyUnpacked <- filterM doesDirExist $ Map.elems locs
 
-    unless (null alreadyUnpacked) $
-        throwM $ UnpackDirectoryAlreadyExists $ Set.fromList alreadyUnpacked
+  unless (null alreadyUnpacked) $
+    prettyThrowM $ UnpackDirectoryAlreadyExists $ Set.fromList alreadyUnpacked
 
-    forM_ (Map.toList locs) $ \(loc, dest') -> do
-      unpackPackageLocation dest' loc
-      logInfo $
-        "Unpacked " <>
-        display loc <>
-        " to " <>
-        fromString (toFilePath dest')
-  where
-    toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot
-          | otherwise = toLocNoSnapshot
+  forM_ (Map.toList locs) $ \(loc, dest') -> do
+    unpackPackageLocation dest' loc
+    prettyInfoL
+      [ "Unpacked"
+      , fromString $ T.unpack $ textDisplay loc
+      , "to"
+      , pretty dest' <> "."
+      ]
+ where
+  toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot
+        | otherwise = toLocNoSnapshot
 
-    toLocNoSnapshot :: PackageName -> RIO env (Either String (PackageLocationImmutable, PackageIdentifier))
-    toLocNoSnapshot name = do
-      mloc1 <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
-      mloc <-
-        case mloc1 of
-          Just _ -> pure mloc1
-          Nothing -> do
-            updated <- updateHackageIndex $ Just $ "Could not find package " <> fromString (packageNameString name) <> ", updating"
-            case updated of
-              UpdateOccurred -> getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
-              NoUpdateOccurred -> pure Nothing
-      case mloc of
+  toLocNoSnapshot ::
+       PackageName
+    -> RIO env (Either StyleDoc (PackageLocationImmutable, PackageIdentifier))
+  toLocNoSnapshot name = do
+    mloc1 <- getLatestHackageLocation
+      YesRequireHackageIndex
+      name
+      UsePreferredVersions
+    mloc <-
+      case mloc1 of
+        Just _ -> pure mloc1
         Nothing -> do
-          candidates <- getHackageTypoCorrections name
-          pure $ Left $ concat
-            [ "Could not find package "
-            , packageNameString name
-            , " on Hackage"
-            , if null candidates
-                then ""
-                else ". Perhaps you meant: " ++ intercalate ", " (map packageNameString candidates)
-            ]
-        Just loc -> pure $ Right (loc, packageLocationIdent loc)
+          updated <- updateHackageIndex
+            $ Just
+            $    "Could not find package "
+              <> fromString (packageNameString name)
+              <> ", updating"
+          case updated of
+            UpdateOccurred ->
+              getLatestHackageLocation
+                YesRequireHackageIndex
+                name
+                UsePreferredVersions
+            NoUpdateOccurred -> pure Nothing
+    case mloc of
+      Nothing -> do
+        candidates <- getHackageTypoCorrections name
+        pure $ Left $ fillSep
+          [ flow "Could not find package"
+          , style Current (fromString $ packageNameString name)
+          , flow "on Hackage."
+          , if null candidates
+              then mempty
+              else fillSep $
+                  flow "Perhaps you meant one of:"
+                : mkNarrativeList (Just Good) False
+                    (map (fromString . packageNameString) candidates :: [StyleDoc])
+          ]
+      Just loc -> pure $ Right (loc, packageLocationIdent loc)
 
-    toLocSnapshot :: RawSnapshot -> PackageName -> RIO env (Either String (PackageLocationImmutable, PackageIdentifier))
-    toLocSnapshot snapshot name =
-        case Map.lookup name (rsPackages snapshot) of
-          Nothing ->
-            pure $ Left $ "Package does not appear in snapshot: " ++ packageNameString name
-          Just sp -> do
-            loc <- cplComplete <$> completePackageLocation (rspLocation sp)
-            pure $ Right (loc, packageLocationIdent loc)
+  toLocSnapshot ::
+       RawSnapshot
+    -> PackageName
+    -> RIO env (Either StyleDoc (PackageLocationImmutable, PackageIdentifier))
+  toLocSnapshot snapshot name =
+    case Map.lookup name (rsPackages snapshot) of
+      Nothing ->
+        pure $ Left $ fillSep
+          [ flow "Package does not appear in snapshot:"
+          , style Current (fromString $ packageNameString name) <> "."
+          ]
+      Just sp -> do
+        loc <- cplComplete <$> completePackageLocation (rspLocation sp)
+        pure $ Right (loc, packageLocationIdent loc)
 
-    -- Possible future enhancement: parse names as name + version range
-    parse s =
-        case parsePackageName (T.unpack t) of
-            Just x -> Right $ Left x
-            Nothing ->
-                case parsePackageIdentifierRevision t of
-                    Right x -> Right $ Right x
-                    Left _ -> Left $ "Could not parse as package name or identifier: " ++ s
-      where
-        t = T.pack s
+  -- Possible future enhancement: parse names as name + version range
+  parse s =
+    case parsePackageName s of
+      Just x -> Right $ Left x
+      Nothing ->
+        case parsePackageIdentifierRevision (T.pack s) of
+          Right x -> Right $ Right x
+          Left _ -> Left $ fillSep
+            [ flow "Could not parse as package name or identifier:"
+            , style Current (fromString s) <> "."
+            ]
+ src/Stack/Update.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Functions related to Stack's @update@ command.
+module Stack.Update
+  ( updateCmd
+  ) where
+
+import          Stack.Prelude
+import          Stack.Runners ( ShouldReexec (..), withConfig )
+import          Stack.Types.Runner ( Runner )
+
+-- | Function underlying the @stack update@ command. Update the package index.
+updateCmd :: () -> RIO Runner ()
+updateCmd () = withConfig NoReexec (void (updateHackageIndex Nothing))
src/Stack/Upgrade.hs view
@@ -1,270 +1,295 @@ {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 
+-- | Types and functions related to Stack's @upgrade@ command.
 module Stack.Upgrade
-  ( upgrade
-  , UpgradeOpts
-  , upgradeOpts
+  ( UpgradeOpts (..)
+  , BinaryOpts (..)
+  , SourceOpts (..)
+  , upgradeCmd
+  , upgrade
   ) where
 
 import qualified Data.Text as T
-import           Options.Applicative
-import           Path
-import           RIO.Process
-import           Stack.Build
+import           Path ( (</>), parseRelDir )
+import           RIO.Process ( proc, runProcess_, withWorkingDir )
+import           Stack.Build ( build )
 import           Stack.Build.Target ( NeedTargets (..) )
-import           Stack.Constants
+import           Stack.Constants ( relDirStackProgName, stackDotYaml )
+import           Stack.Internal.BuildInfo ( maybeGitHash )
 import           Stack.Prelude hiding ( force, Display (..) )
 import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withEnvConfig
+                   , withGlobalProject )
 import           Stack.Setup
-import           Stack.Types.Config
-import           System.Console.ANSI ( hSupportsANSIWithoutEmulation )
+                   ( downloadStackExe, downloadStackReleaseInfo
+                   , getDownloadVersion, preferredPlatforms, stackVersion
+                   )
+import           Stack.Types.BuildOpts
+                   ( BuildOptsCLI (..), buildOptsInstallExesL
+                   , defaultBuildOptsCLI
+                   )
+import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Runner ( Runner, globalOptsL )
+import           Stack.Types.StackYamlLoc ( StackYamlLoc (..) )
 import           System.Process ( rawSystem, readProcess )
 
--- | Type representing exceptions thrown by functions exported by the
+-- | Type representing \'pretty\' exceptions thrown by functions in the
 -- "Stack.Upgrade" module.
-data UpgradeException
-    = NeitherBinaryOrSourceSpecified
-    | ExecutableFailure
-    | CommitsNotFound String String
-    | StackInPackageIndexNotFound
-    | VersionWithNoRevision
-    deriving (Show, Typeable)
-
-instance Exception UpgradeException where
-    displayException NeitherBinaryOrSourceSpecified =
-        "Error: [S-3642]\n"
-        ++ "You must allow either binary or source upgrade paths."
-    displayException ExecutableFailure =
-        "Error: [S-8716]\n"
-        ++ "Non-success exit code from running newly downloaded executable."
-    displayException (CommitsNotFound branch repo) = concat
-        [ "Error: [S-7114]\n"
-        , "No commits found for branch "
-        , branch
-        , " on repo "
-        , repo
-        ]
-    displayException StackInPackageIndexNotFound =
-        "Error: [S-9668]\n"
-        ++ "No Stack version found in package indices."
-    displayException VersionWithNoRevision =
-        "Error: [S-6648]\n"
-        ++ "Latest version with no revision."
-
-upgradeOpts :: Parser UpgradeOpts
-upgradeOpts = UpgradeOpts
-    <$> (sourceOnly <|> optional binaryOpts)
-    <*> (binaryOnly <|> optional sourceOpts)
-  where
-    binaryOnly = flag' Nothing (long "binary-only" <> help "Do not use a source upgrade path")
-    sourceOnly = flag' Nothing (long "source-only" <> help "Do not use a binary upgrade path")
+data UpgradePrettyException
+  = ResolverOptionInvalid
+  | NeitherBinaryOrSourceSpecified
+  | ExecutableFailure
+  | CommitsNotFound String String
+  | StackInPackageIndexNotFound
+  | VersionWithNoRevision
+  deriving (Show, Typeable)
 
-    binaryOpts = BinaryOpts
-        <$> optional (strOption
-              ( long "binary-platform"
-             <> help "Platform type for archive to download"
-             <> showDefault))
-        <*> switch
-         (long "force-download" <>
-          help "Download the latest available Stack executable")
-        <*> optional (strOption
-         (long "binary-version" <>
-          help "Download a specific Stack version"))
-        <*> optional (strOption
-         (long "github-org" <>
-          help "GitHub organization name"))
-        <*> optional (strOption
-         (long "github-repo" <>
-          help "GitHub repository name"))
+instance Pretty UpgradePrettyException where
+  pretty ResolverOptionInvalid =
+    "[S-8761]"
+    <> line
+    <> fillSep
+         [ "The"
+         , style Shell "--resolver"
+         , flow "option cannot be used with Stack's"
+         , style Shell "upgrade"
+         , "command."
+         ]
+  pretty NeitherBinaryOrSourceSpecified =
+    "[S-3642]"
+    <> line
+    <> flow "You must allow either binary or source upgrade paths."
+  pretty ExecutableFailure =
+    "[S-8716]"
+    <> line
+    <> flow "Non-success exit code from running newly downloaded executable."
+  pretty (CommitsNotFound branch repo) =
+    "[S-7114]"
+    <> line
+    <> fillSep
+         [ flow "No commits found for branch"
+         , style Current (fromString branch)
+         , flow "on repo"
+         , style Url (fromString repo) <> "."
+         ]
+  pretty StackInPackageIndexNotFound =
+    "[S-9668]"
+    <> line
+    <> flow "No Stack version found in package indices."
+  pretty VersionWithNoRevision =
+    "[S-6648]"
+    <> line
+    <> flow "Latest version with no revision."
 
-    sourceOpts = SourceOpts
-        <$> ((\fromGit repo branch -> if fromGit then Just (repo, branch) else Nothing)
-                <$> switch
-                    ( long "git"
-                    <> help "Clone from Git instead of downloading from Hackage (more dangerous)" )
-                <*> strOption
-                    ( long "git-repo"
-                    <> help "Clone from specified git repository"
-                    <> value "https://github.com/commercialhaskell/stack"
-                    <> showDefault )
-                <*> strOption
-                    ( long "git-branch"
-                   <> help "Clone from this git branch"
-                   <> value "master"
-                   <> showDefault ))
+instance Exception UpgradePrettyException
 
+-- | Type representing options for upgrading Stack with a binary executable
+-- file.
 data BinaryOpts = BinaryOpts
-    { _boPlatform :: !(Maybe String)
-    , _boForce :: !Bool
-    -- ^ force a download, even if the downloaded version is older
-    -- than what we are
-    , _boVersion :: !(Maybe String)
-    -- ^ specific version to download
-    , _boGitHubOrg :: !(Maybe String)
-    , _boGitHubRepo :: !(Maybe String)
-    }
-    deriving Show
-newtype SourceOpts = SourceOpts (Maybe (String, String)) -- repo and branch
-    deriving Show
+  { _boPlatform :: !(Maybe String)
+  , _boForce :: !Bool
+    -- ^ Force a download, even if the downloaded version is older than what we
+    -- are.
+  , _boOnlyLocalBin :: !Bool
+    -- ^ Only download to Stack's local binary directory.
+  , _boVersion :: !(Maybe String)
+    -- ^ Specific version to download
+  , _boGitHubOrg :: !(Maybe String)
+  , _boGitHubRepo :: !(Maybe String)
+  }
+  deriving Show
 
+-- | Type representing options for upgrading Stack from source code.
+newtype SourceOpts
+  = SourceOpts (Maybe (String, String)) -- repo and branch
+  deriving Show
+
+-- | Type representing command line options for the @stack upgrade@ command.
 data UpgradeOpts = UpgradeOpts
-    { _uoBinary :: !(Maybe BinaryOpts)
-    , _uoSource :: !(Maybe SourceOpts)
-    }
-    deriving Show
+  { _uoBinary :: !(Maybe BinaryOpts)
+  , _uoSource :: !(Maybe SourceOpts)
+  }
+  deriving Show
 
-upgrade :: Maybe String -- ^ git hash at time of building, if known
-        -> UpgradeOpts
-        -> RIO Runner ()
-upgrade builtHash (UpgradeOpts mbo mso) =
-    case (mbo, mso) of
-        -- FIXME It would be far nicer to capture this case in the
-        -- options parser itself so we get better error messages, but
-        -- I can't think of a way to make it happen.
-        (Nothing, Nothing) -> throwIO NeitherBinaryOrSourceSpecified
-        (Just bo, Nothing) -> binary bo
-        (Nothing, Just so) -> source so
-        -- See #2977 - if --git or --git-repo is specified, do source upgrade.
-        (_, Just so@(SourceOpts (Just _))) -> source so
-        (Just bo, Just so) -> binary bo `catchAny` \e -> do
-            prettyWarnL
-               [ flow "Exception occurred when trying to perform binary upgrade:"
-               , fromString . show $ e
-               , line <> flow "Falling back to source upgrade"
-               ]
+-- | Function underlying the @stack upgrade@ command.
+upgradeCmd :: UpgradeOpts -> RIO Runner ()
+upgradeCmd upgradeOpts = do
+  go <- view globalOptsL
+  case globalResolver go of
+    Just _ -> prettyThrowIO ResolverOptionInvalid
+    Nothing -> withGlobalProject $ upgrade maybeGitHash upgradeOpts
 
-            source so
-  where
-    binary bo = binaryUpgrade bo
-    source so = sourceUpgrade builtHash so
+upgrade ::
+     Maybe String -- ^ git hash at time of building, if known
+  -> UpgradeOpts
+  -> RIO Runner ()
+upgrade builtHash (UpgradeOpts mbo mso) = case (mbo, mso) of
+  -- FIXME It would be far nicer to capture this case in the options parser
+  -- itself so we get better error messages, but I can't think of a way to
+  -- make it happen.
+  (Nothing, Nothing) -> prettyThrowIO NeitherBinaryOrSourceSpecified
+  (Just bo, Nothing) -> binary bo
+  (Nothing, Just so) -> source so
+  -- See #2977 - if --git or --git-repo is specified, do source upgrade.
+  (_, Just so@(SourceOpts (Just _))) -> source so
+  (Just bo, Just so) -> binary bo `catchAny` \e -> do
+    prettyWarnL
+      [ flow "Exception occurred when trying to perform binary upgrade:"
+      , fromString . show $ e
+      , line <> flow "Falling back to source upgrade."
+      ]
+    source so
+ where
+  binary = binaryUpgrade
+  source = sourceUpgrade builtHash
 
 binaryUpgrade :: BinaryOpts -> RIO Runner ()
-binaryUpgrade (BinaryOpts mplatform force' mver morg mrepo) = withConfig NoReexec $ do
+binaryUpgrade (BinaryOpts mplatform force' onlyLocalBin mver morg mrepo) =
+  withConfig NoReexec $ do
     platforms0 <-
       case mplatform of
         Nothing -> preferredPlatforms
         Just p -> pure [("windows" `T.isInfixOf` T.pack p, p)]
     archiveInfo <- downloadStackReleaseInfo morg mrepo mver
-
     let mdownloadVersion = getDownloadVersion archiveInfo
         force =
           case mver of
             Nothing -> force'
             Just _ -> True -- specifying a version implies we're forcing things
     isNewer <-
-        case mdownloadVersion of
-            Nothing -> do
-                prettyErrorL $
-                    flow "Unable to determine upstream version from GitHub metadata"
-                  :
-                  [ line <> flow "Rerun with --force-download to force an upgrade"
-                    | not force]
-                pure False
-            Just downloadVersion -> do
-                prettyInfoL
-                    [ flow "Current Stack version:"
-                    , fromString (versionString stackVersion) <> ","
-                    , flow "available download version:"
-                    , fromString (versionString downloadVersion)
-                    ]
-                pure $ downloadVersion > stackVersion
-
+      case mdownloadVersion of
+        Nothing -> do
+          prettyError $
+               flow "Unable to determine upstream version from GitHub metadata."
+            <> if force
+                 then mempty
+                 else
+                      line
+                   <> fillSep
+                        [ flow "Rerun with"
+                        , style Shell "--force-download"
+                        , flow "to force an upgrade."
+                        ]
+          pure False
+        Just downloadVersion -> do
+          prettyInfoL
+            [ flow "Current Stack version:"
+            , fromString (versionString stackVersion) <> ";"
+            , flow "available download version:"
+            , fromString (versionString downloadVersion) <> "."
+            ]
+          pure $ downloadVersion > stackVersion
     toUpgrade <- case (force, isNewer) of
-        (False, False) -> do
-            prettyInfoS "Skipping binary upgrade, you are already running the most recent version"
-            pure False
-        (True, False) -> do
-            prettyInfoS "Forcing binary upgrade"
-            pure True
-        (_, True) -> do
-            prettyInfoS "Newer version detected, downloading"
-            pure True
+      (False, False) -> do
+        prettyInfoS "Skipping binary upgrade, you are already running the most \
+                    \recent version."
+        pure False
+      (True, False) -> do
+        prettyInfoS "Forcing binary upgrade."
+        pure True
+      (_, True) -> do
+        prettyInfoS "Newer version detected, downloading."
+        pure True
     when toUpgrade $ do
-        config <- view configL
-        downloadStackExe platforms0 archiveInfo (configLocalBin config) True $ \tmpFile -> do
+      config <- view configL
+      downloadStackExe
+        platforms0 archiveInfo (configLocalBin config) (not onlyLocalBin) $
+          \tmpFile -> do
             -- Sanity check!
             ec <- rawSystem (toFilePath tmpFile) ["--version"]
-            unless (ec == ExitSuccess) (throwIO ExecutableFailure)
+            unless (ec == ExitSuccess) (prettyThrowIO ExecutableFailure)
 
-sourceUpgrade
-  :: Maybe String
+sourceUpgrade ::
+     Maybe String
   -> SourceOpts
   -> RIO Runner ()
 sourceUpgrade builtHash (SourceOpts gitRepo) =
   withSystemTempDir "stack-upgrade" $ \tmp -> do
     mdir <- case gitRepo of
       Just (repo, branch) -> do
-        remote <- liftIO $ System.Process.readProcess "git" ["ls-remote", repo, branch] []
+        remote <- liftIO $ System.Process.readProcess
+          "git"
+          ["ls-remote", repo, branch]
+          []
         latestCommit <-
           case words remote of
-            [] -> throwIO $ CommitsNotFound branch repo
+            [] -> prettyThrowIO $ CommitsNotFound branch repo
             x:_ -> pure x
         when (isNothing builtHash) $
-            prettyWarnS $
-                       "Information about the commit this version of Stack was "
-                    <> "built from is not available due to how it was built. "
-                    <> "Will continue by assuming an upgrade is needed "
-                    <> "because we have no information to the contrary."
+          prettyWarnS
+            "Information about the commit this version of Stack was built from \
+            \is not available due to how it was built. Will continue by \
+            \assuming an upgrade is needed because we have no information to \
+            \the contrary."
         if builtHash == Just latestCommit
             then do
-                prettyInfoS "Already up-to-date, no upgrade required"
-                pure Nothing
+              prettyInfoS "Already up-to-date, no upgrade required."
+              pure Nothing
             else do
-                prettyInfoS "Cloning stack"
-                -- NOTE: "--recursive" was added after v1.0.0 (and before the
-                -- next release).  This means that we can't use submodules in
-                -- the Stack repo until we're comfortable with "stack upgrade
-                -- --git" not working for earlier versions.
-                let args = [ "clone", repo , "stack", "--depth", "1", "--recursive", "--branch", branch]
-                withWorkingDir (toFilePath tmp) $ proc "git" args runProcess_
-                -- On Windows 10, an upstream issue with the `git clone` command
-                -- means that command clears, but does not then restore, the
-                -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals.
-                -- The following hack re-enables the lost ANSI-capability.
-                when osIsWindows $
-                  void $ liftIO $ hSupportsANSIWithoutEmulation stdout
-                pure $ Just $ tmp </> relDirStackProgName
-      -- We need to access the Pantry database to find out about the
-      -- latest Stack available on Hackage. We first use a standard
-      -- Config to do this, and once we have the source load up the
-      -- stack.yaml from inside that source.
+              prettyInfoS "Cloning stack."
+              -- NOTE: "--recursive" was added after v1.0.0 (and before the next
+              -- release).  This means that we can't use submodules in the Stack
+              -- repo until we're comfortable with "stack upgrade --git" not
+              -- working for earlier versions.
+              let args =
+                    [ "clone"
+                    , repo
+                    , "stack"
+                    , "--depth"
+                    , "1"
+                    , "--recursive"
+                    , "--branch"
+                    , branch
+                    ]
+              withWorkingDir (toFilePath tmp) $ proc "git" args runProcess_
+              pure $ Just $ tmp </> relDirStackProgName
+      -- We need to access the Pantry database to find out about the latest
+      -- Stack available on Hackage. We first use a standard Config to do this,
+      -- and once we have the source load up the stack.yaml from inside that
+      -- source.
       Nothing -> withConfig NoReexec $ do
-        void $ updateHackageIndex
-             $ Just "Updating index to make sure we find the latest Stack version"
-        mversion <- getLatestHackageVersion YesRequireHackageIndex "stack" UsePreferredVersions
+        void
+          $ updateHackageIndex
+          $ Just "Updating index to make sure we find the latest Stack version."
+        mversion <- getLatestHackageVersion
+          YesRequireHackageIndex
+          "stack"
+          UsePreferredVersions
         (PackageIdentifierRevision _ version _) <-
           case mversion of
-            Nothing -> throwIO StackInPackageIndexNotFound
+            Nothing -> prettyThrowIO StackInPackageIndexNotFound
             Just version -> pure version
-
         if version <= stackVersion
-            then do
-                prettyInfoS "Already at latest version, no upgrade required"
-                pure Nothing
-            else do
-                suffix <- parseRelDir $ "stack-" ++ versionString version
-                let dir = tmp </> suffix
-                mrev <- getLatestHackageRevision YesRequireHackageIndex "stack" version
-                case mrev of
-                  Nothing -> throwIO VersionWithNoRevision
-                  Just (_rev, cfKey, treeKey) -> do
-                    let ident = PackageIdentifier "stack" version
-                    unpackPackageLocation dir $ PLIHackage ident cfKey treeKey
-                    pure $ Just dir
+          then do
+            prettyInfoS "Already at latest version, no upgrade required."
+            pure Nothing
+          else do
+            suffix <- parseRelDir $ "stack-" ++ versionString version
+            let dir = tmp </> suffix
+            mrev <- getLatestHackageRevision
+              YesRequireHackageIndex
+              "stack"
+              version
+            case mrev of
+              Nothing -> prettyThrowIO VersionWithNoRevision
+              Just (_rev, cfKey, treeKey) -> do
+                let ident = PackageIdentifier "stack" version
+                unpackPackageLocation dir $ PLIHackage ident cfKey treeKey
+                pure $ Just dir
 
     let modifyGO dir go = go
-          { globalResolver = Nothing -- always use the resolver settings in the stack.yaml file
+          { globalResolver = Nothing -- always use the resolver settings in the
+                                     -- stack.yaml file
           , globalStackYaml = SYLOverride $ dir </> stackDotYaml
           }
         boptsCLI = defaultBuildOptsCLI
           { boptsCLITargets = ["stack"]
           }
     forM_ mdir $ \dir ->
-      local (over globalOptsL (modifyGO dir)) $
-      withConfig NoReexec $ withEnvConfig AllowNoTargets boptsCLI $
-      local (set (buildOptsL.buildOptsInstallExesL) True) $
-      build Nothing
+      local (over globalOptsL (modifyGO dir))
+        $ withConfig NoReexec
+        $ withEnvConfig AllowNoTargets boptsCLI
+        $ local (set (buildOptsL.buildOptsInstallExesL) True)
+        $ build Nothing
src/Stack/Upload.hs view
@@ -1,14 +1,13 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
 
--- | Provide ability to upload tarballs to Hackage.
+-- | Types and functions related to Stack's @upload@ command.
 module Stack.Upload
   ( -- * Upload
-    upload
+    UploadOpts (..)
+  , UploadVariant (..)
+  , uploadCmd
+  , upload
   , uploadBytes
   , uploadRevision
     -- * Credentials
@@ -23,8 +22,8 @@ 
 import           Conduit ( mapOutput, sinkList )
 import           Data.Aeson
-                   ( FromJSON (..), ToJSON (..), decode', toEncoding
-                   , fromEncoding, object, withObject, (.:), (.=)
+                   ( FromJSON (..), ToJSON (..), (.:), (.=), decode'
+                   , fromEncoding, object, toEncoding, withObject
                    )
 import           Data.ByteString.Builder ( lazyByteString )
 import qualified Data.ByteString.Char8 as S
@@ -33,84 +32,165 @@ import qualified Data.Text as T
 import           Network.HTTP.StackClient
                    ( Request, RequestBody (RequestBodyLBS), Response
-                   , withResponse, httpNoBody, getGlobalManager
-                   , getResponseStatusCode, getResponseBody, setRequestHeader
-                   , parseRequest, formDataBody, partFileRequestBody, partBS
-                   , partLBS, applyDigestAuth, displayDigestAuthException
+                   , applyDigestAuth, displayDigestAuthException, formDataBody
+                   , getGlobalManager, getResponseBody, getResponseStatusCode
+                   , httpNoBody, parseRequest, partBS, partFileRequestBody
+                   , partLBS, setRequestHeader, withResponse
                    )
-import           Stack.Options.UploadParser
+import           Path.IO ( resolveDir', resolveFile' )
 import           Stack.Prelude
-import           Stack.Types.Config
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
+import           Stack.SDist
+                   ( SDistOpts (..), checkSDistTarball, checkSDistTarball'
+                   , getSDistTarball
+                   )
+import           Stack.Types.Config ( Config (..), configL, stackRootL )
+import           Stack.Types.Runner ( Runner )
 import           System.Directory
-                   ( createDirectoryIfMissing, removeFile, renameFile )
+                   ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
+                   , removeFile, renameFile
+                   )
 import           System.Environment ( lookupEnv )
-import           System.FilePath ( (</>), takeFileName, takeDirectory )
+import           System.FilePath ( (</>), takeDirectory, takeFileName )
 import           System.PosixCompat.Files ( setFileMode )
 
 -- | Type representing \'pretty\' exceptions thrown by functions exported by the
 -- "Stack.Upload" module.
 data UploadPrettyException
-    = AuthenticationFailure
-    | ArchiveUploadFailure Int [String] String
-    deriving (Show, Typeable)
+  = AuthenticationFailure
+  | ArchiveUploadFailure Int [String] String
+  deriving (Show, Typeable)
 
 instance Pretty UploadPrettyException where
-    pretty AuthenticationFailure =
-           "[S-2256]"
-        <> line
-        <> flow "authentification failure"
-        <> line
-        <> flow "Authentication failure uploading to server"
-    pretty (ArchiveUploadFailure code res tarName) =
-           "[S-6108]"
-        <> line
-        <> flow "unhandled status code:" <+> fromString (show code)
-        <> line
-        <> flow "Upload failed on" <+> style File (fromString tarName)
-        <> line
-        <> vsep (map string res)
+  pretty AuthenticationFailure =
+       "[S-2256]"
+    <> line
+    <> flow "authentification failure"
+    <> line
+    <> flow "Authentication failure uploading to server"
+  pretty (ArchiveUploadFailure code res tarName) =
+       "[S-6108]"
+    <> line
+    <> flow "unhandled status code:" <+> fromString (show code)
+    <> line
+    <> flow "Upload failed on" <+> style File (fromString tarName)
+    <> line
+    <> vsep (map string res)
 
 instance Exception UploadPrettyException
 
+-- Type representing variants for uploading to Hackage.
+data UploadVariant
+  = Publishing
+  -- ^ Publish the package
+  | Candidate
+  -- ^ Create a package candidate
+
+-- | Type representing command line options for the @stack upload@ command.
+data UploadOpts = UploadOpts
+  { uoptsSDistOpts :: SDistOpts
+  , uoptsUploadVariant :: UploadVariant
+  -- ^ Says whether to publish the package or upload as a release candidate
+  }
+
+-- | Function underlying the @stack upload@ command. Upload to Hackage.
+uploadCmd :: UploadOpts -> RIO Runner ()
+uploadCmd (UploadOpts (SDistOpts [] _ _ _ _) _) = do
+  prettyErrorL
+    [ flow "To upload the current package, please run"
+    , style Shell "stack upload ."
+    , flow "(with the period at the end)"
+    ]
+  liftIO exitFailure
+uploadCmd uploadOpts = do
+  let partitionM _ [] = pure ([], [])
+      partitionM f (x:xs) = do
+        r <- f x
+        (as, bs) <- partitionM f xs
+        pure $ if r then (x:as, bs) else (as, x:bs)
+      sdistOpts = uoptsSDistOpts uploadOpts
+  (files, nonFiles) <-
+    liftIO $ partitionM doesFileExist (sdoptsDirsToWorkWith sdistOpts)
+  (dirs, invalid) <- liftIO $ partitionM doesDirectoryExist nonFiles
+  withConfig YesReexec $ withDefaultEnvConfig $ do
+    unless (null invalid) $ do
+      let invalidList = bulletedList $ map (style File . fromString) invalid
+      prettyErrorL
+        [ style Shell "stack upload"
+        , flow "expects a list of sdist tarballs or package directories."
+        , flow "Can't find:"
+        , line <> invalidList
+        ]
+      exitFailure
+    when (null files && null dirs) $ do
+      prettyErrorL
+        [ style Shell "stack upload"
+        , flow "expects a list of sdist tarballs or package directories, but none were specified."
+        ]
+      exitFailure
+    config <- view configL
+    let hackageUrl = T.unpack $ configHackageBaseUrl config
+        uploadVariant = uoptsUploadVariant uploadOpts
+    getCreds <- memoizeRef $ loadAuth config
+    mapM_ (resolveFile' >=> checkSDistTarball sdistOpts) files
+    forM_ files $ \file -> do
+      tarFile <- resolveFile' file
+      creds <- runMemoized getCreds
+      upload hackageUrl creds (toFilePath tarFile) uploadVariant
+    forM_ dirs $ \dir -> do
+      pkgDir <- resolveDir' dir
+      (tarName, tarBytes, mcabalRevision) <-
+        getSDistTarball (sdoptsPvpBounds sdistOpts) pkgDir
+      checkSDistTarball' sdistOpts tarName tarBytes
+      creds <- runMemoized getCreds
+      uploadBytes hackageUrl creds tarName uploadVariant tarBytes
+      forM_ mcabalRevision $ uncurry $ uploadRevision hackageUrl creds
+
 newtype HackageKey = HackageKey Text
-    deriving (Eq, Show)
+  deriving (Eq, Show)
 
 -- | Username and password to log into Hackage.
 --
 -- Since 0.1.0.0
 data HackageCreds = HackageCreds
-    { hcUsername :: !Text
-    , hcPassword :: !Text
-    , hcCredsFile :: !FilePath
-    }
-    deriving (Eq, Show)
+  { hcUsername :: !Text
+  , hcPassword :: !Text
+  , hcCredsFile :: !FilePath
+  }
+  deriving (Eq, Show)
 
-data HackageAuth = HAKey HackageKey
-                 | HACreds HackageCreds
-    deriving (Eq, Show)
+data HackageAuth
+  = HAKey HackageKey
+  | HACreds HackageCreds
+  deriving (Eq, Show)
 
 instance ToJSON HackageCreds where
-    toJSON (HackageCreds u p _) = object
-        [ "username" .= u
-        , "password" .= p
-        ]
+  toJSON (HackageCreds u p _) = object
+    [ "username" .= u
+    , "password" .= p
+    ]
+
 instance FromJSON (FilePath -> HackageCreds) where
-    parseJSON = withObject "HackageCreds" $ \o -> HackageCreds
-        <$> o .: "username"
-        <*> o .: "password"
+  parseJSON = withObject "HackageCreds" $ \o -> HackageCreds
+    <$> o .: "username"
+    <*> o .: "password"
 
 withEnvVariable :: Text -> IO Text -> IO Text
-withEnvVariable varName fromPrompt = lookupEnv (T.unpack varName) >>= maybe fromPrompt (pure . T.pack)
+withEnvVariable varName fromPrompt =
+  lookupEnv (T.unpack varName) >>= maybe fromPrompt (pure . T.pack)
 
 maybeGetHackageKey :: RIO m (Maybe HackageKey)
-maybeGetHackageKey = liftIO $ fmap (HackageKey . T.pack) <$> lookupEnv "HACKAGE_KEY"
+maybeGetHackageKey =
+  liftIO $ fmap (HackageKey . T.pack) <$> lookupEnv "HACKAGE_KEY"
 
-loadAuth :: HasLogFunc m => Config -> RIO m HackageAuth
+loadAuth :: (HasLogFunc m, HasTerm m) => Config -> RIO m HackageAuth
 loadAuth config = do
   maybeHackageKey <- maybeGetHackageKey
   case maybeHackageKey of
     Just key -> do
-      logInfo "HACKAGE_KEY found in env, using that for credentials."
+      prettyInfoS
+        "HACKAGE_KEY environment variable found, using that for credentials."
       pure $ HAKey key
     Nothing -> HACreds <$> loadUserAndPassword config
 
@@ -118,7 +198,7 @@ -- line.
 --
 -- Since 0.1.0.0
-loadUserAndPassword :: HasLogFunc m => Config -> RIO m HackageCreds
+loadUserAndPassword :: HasTerm m => Config -> RIO m HackageCreds
 loadUserAndPassword config = do
   fp <- liftIO $ credsFile config
   elbs <- liftIO $ tryIO $ L.readFile fp
@@ -130,31 +210,37 @@       writeFilePrivate fp $ lazyByteString lbs
 
       unless (configSaveHackageCreds config) $ do
-        logWarn "WARNING: You've set save-hackage-creds to false"
-        logWarn "However, credentials were found at:"
-        logWarn $ "  " <> fromString fp
+        prettyWarnL
+          [ flow "You've set save-hackage-creds to false. However, credentials \
+                 \ were found at:"
+          , style File (fromString fp) <> "."
+          ]
       pure $ mkCreds fp
-  where
-    fromPrompt :: HasLogFunc m => FilePath -> RIO m HackageCreds
-    fromPrompt fp = do
-      username <- liftIO $ withEnvVariable "HACKAGE_USERNAME" (prompt "Hackage username: ")
-      password <- liftIO $ withEnvVariable "HACKAGE_PASSWORD" (promptPassword "Hackage password: ")
-      let hc = HackageCreds
-            { hcUsername = username
-            , hcPassword = password
-            , hcCredsFile = fp
-            }
+ where
+  fromPrompt :: HasTerm m => FilePath -> RIO m HackageCreds
+  fromPrompt fp = do
+    username <- liftIO $ withEnvVariable "HACKAGE_USERNAME" (prompt "Hackage username: ")
+    password <- liftIO $ withEnvVariable "HACKAGE_PASSWORD" (promptPassword "Hackage password: ")
+    let hc = HackageCreds
+          { hcUsername = username
+          , hcPassword = password
+          , hcCredsFile = fp
+          }
 
-      when (configSaveHackageCreds config) $ do
-        shouldSave <- promptBool $ T.pack $
-          "Save hackage credentials to file at " ++ fp ++ " [y/n]? "
-        logInfo "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false"
-        when shouldSave $ do
-          writeFilePrivate fp $ fromEncoding $ toEncoding hc
-          logInfo "Saved!"
-          hFlush stdout
+    when (configSaveHackageCreds config) $ do
+      shouldSave <- promptBool $ T.pack $
+        "Save Hackage credentials to file at " ++ fp ++ " [y/n]? "
+      prettyNoteL
+        [ flow "Avoid this prompt in the future by using the configuration \
+               \file option"
+        , style Shell (flow "save-hackage-creds: false") <> "."
+        ]
+      when shouldSave $ do
+        writeFilePrivate fp $ fromEncoding $ toEncoding hc
+        prettyInfoS "Saved!"
+        hFlush stdout
 
-      pure hc
+    pure hc
 
 -- | Write contents to a file which is always private.
 --
@@ -164,37 +250,48 @@ --
 -- * https://github.com/commercialhaskell/stack/pull/4665
 writeFilePrivate :: MonadIO m => FilePath -> Builder -> m ()
-writeFilePrivate fp builder = liftIO $ withTempFile (takeDirectory fp) (takeFileName fp) $ \fpTmp h -> do
-  -- Temp file is created such that only current user can read and write it.
-  -- See docs for openTempFile: https://www.stackage.org/haddock/lts-13.14/base-4.12.0.0/System-IO.html#v:openTempFile
+writeFilePrivate fp builder =
+  liftIO $ withTempFile (takeDirectory fp) (takeFileName fp) $ \fpTmp h -> do
+    -- Temp file is created such that only current user can read and write it.
+    -- See docs for openTempFile:
+    -- https://www.stackage.org/haddock/lts-13.14/base-4.12.0.0/System-IO.html#v:openTempFile
 
-  -- Write to the file and close the handle.
-  hPutBuilder h builder
-  hClose h
+    -- Write to the file and close the handle.
+    hPutBuilder h builder
+    hClose h
 
-  -- Make sure the destination file, if present, is writeable
-  void $ tryIO $ setFileMode fp 0o600
+    -- Make sure the destination file, if present, is writeable
+    void $ tryIO $ setFileMode fp 0o600
 
-  -- And atomically move
-  renameFile fpTmp fp
+    -- And atomically move
+    renameFile fpTmp fp
 
 credsFile :: Config -> IO FilePath
 credsFile config = do
-    let dir = toFilePath (view stackRootL config) </> "upload"
-    createDirectoryIfMissing True dir
-    pure $ dir </> "credentials.json"
+  let dir = toFilePath (view stackRootL config) </> "upload"
+  createDirectoryIfMissing True dir
+  pure $ dir </> "credentials.json"
 
 addAPIKey :: HackageKey -> Request -> Request
-addAPIKey (HackageKey key) req =
-  setRequestHeader "Authorization" [fromString $ "X-ApiKey" ++ " " ++ T.unpack key] req
+addAPIKey (HackageKey key) = setRequestHeader
+  "Authorization"
+  [fromString $ "X-ApiKey" ++ " " ++ T.unpack key]
 
-applyAuth :: HasLogFunc m => HackageAuth -> Request -> RIO m Request
-applyAuth haAuth req0 = do
-    case haAuth of
-        HAKey key -> pure (addAPIKey key req0)
-        HACreds creds -> applyCreds creds req0
+applyAuth ::
+     (HasLogFunc m, HasTerm m)
+  => HackageAuth
+  -> Request
+  -> RIO m Request
+applyAuth haAuth req0 =
+  case haAuth of
+    HAKey key -> pure (addAPIKey key req0)
+    HACreds creds -> applyCreds creds req0
 
-applyCreds :: HasLogFunc m => HackageCreds -> Request -> RIO m Request
+applyCreds ::
+     (HasLogFunc m, HasTerm m)
+  => HackageCreds
+  -> Request
+  -> RIO m Request
 applyCreds creds req0 = do
   manager <- liftIO getGlobalManager
   ereq <- liftIO $ applyDigestAuth
@@ -203,19 +300,23 @@     req0
     manager
   case ereq of
-      Left e -> do
-          logWarn "WARNING: No HTTP digest prompt found, this will probably fail"
-          case fromException e of
-              Just e' -> logWarn $ fromString $ displayDigestAuthException e'
-              Nothing -> logWarn $ fromString $ displayException e
-          pure req0
-      Right req -> pure req
+    Left e -> do
+      prettyWarn $
+           flow "No HTTP digest prompt found, this will probably fail."
+        <> blankLine
+        <> string
+             ( case fromException e of
+                 Just e' -> displayDigestAuthException e'
+                 Nothing -> displayException e
+             )
+      pure req0
+    Right req -> pure req
 
 -- | Upload a single tarball with the given @Uploader@.  Instead of
 -- sending a file like 'upload', this sends a lazy bytestring.
 --
 -- Since 0.1.2.1
-uploadBytes :: HasLogFunc m
+uploadBytes :: HasTerm m
             => String -- ^ Hackage base URL
             -> HackageAuth
             -> String -- ^ tar file name
@@ -223,45 +324,64 @@             -> L.ByteString -- ^ tar file contents
             -> RIO m ()
 uploadBytes baseUrl auth tarName uploadVariant bytes = do
-    let req1 = setRequestHeader "Accept" ["text/plain"]
-               (fromString $ baseUrl
-                          <> "packages/"
-                          <> case uploadVariant of
-                               Publishing -> ""
-                               Candidate -> "candidates/"
+  let req1 = setRequestHeader
+               "Accept"
+               ["text/plain"]
+               (fromString
+                  $  baseUrl
+                  <> "packages/"
+                  <> case uploadVariant of
+                       Publishing -> ""
+                       Candidate -> "candidates/"
                )
-        formData = [partFileRequestBody "package" tarName (RequestBodyLBS bytes)]
-    req2 <- liftIO $ formDataBody formData req1
-    req3 <- applyAuth auth req2
-    logInfo $ "Uploading " <> fromString tarName <> "... "
-    hFlush stdout
-    withRunInIO $ \runInIO -> withResponse req3 (runInIO . inner)
+      formData = [partFileRequestBody "package" tarName (RequestBodyLBS bytes)]
+  req2 <- liftIO $ formDataBody formData req1
+  req3 <- applyAuth auth req2
+  prettyInfoL
+    [ "Uploading"
+    , style Current (fromString tarName) <> "..."
+    ]
+  hFlush stdout
+  withRunInIO $ \runInIO -> withResponse req3 (runInIO . inner)
  where
-    inner :: HasLogFunc m => Response (ConduitM () S.ByteString IO ()) -> RIO m ()
-    inner res =
-        case getResponseStatusCode res of
-            200 -> logInfo "done!"
-            401 -> do
-                case auth of
-                  HACreds creds -> handleIO (const $ pure ()) (liftIO $ removeFile (hcCredsFile creds))
-                  _ -> pure ()
-                throwIO $ PrettyException AuthenticationFailure
-            403 -> do
-                logError "Error: [S-2804]"
-                logError "forbidden upload"
-                logError "Usually means: you've already uploaded this package/version combination"
-                logError "Ignoring error and continuing, full message from Hackage below:\n"
-                liftIO $ printBody res
-            503 -> do
-                logError "Error: [S-4444]"
-                logError "service unavailable"
-                logError "This error some times gets sent even though the upload succeeded"
-                logError "Check on Hackage to see if your package is present"
-                liftIO $ printBody res
-            code -> do
-                let resBody = mapOutput show (getResponseBody res)
-                resBody' <- liftIO $ runConduit $ resBody .| sinkList
-                throwIO $ PrettyException (ArchiveUploadFailure code resBody' tarName)
+  inner :: HasTerm m => Response (ConduitM () S.ByteString IO ()) -> RIO m ()
+  inner res =
+    case getResponseStatusCode res of
+      200 -> prettyInfoS "done!"
+      401 -> do
+        case auth of
+          HACreds creds ->
+            handleIO
+              (const $ pure ())
+              (liftIO $ removeFile (hcCredsFile creds))
+          _ -> pure ()
+        prettyThrowIO AuthenticationFailure
+      403 -> do
+        prettyError $
+          "[S-2804]"
+          <> line
+          <> flow "forbidden upload"
+          <> line
+          <> flow "Usually means: you've already uploaded this package/version \
+                  \combination. Ignoring error and continuing. The full \
+                  \message from Hackage is below:"
+          <> blankLine
+        liftIO $ printBody res
+      503 -> do
+        prettyError $
+          "[S-4444]"
+          <> line
+          <> flow "service unavailable"
+          <> line
+          <> flow "This error some times gets sent even though the upload \
+                  \succeeded. Check on Hackage to see if your package is \
+                  \present. The full message form Hackage is below:"
+          <> blankLine
+        liftIO $ printBody res
+      code -> do
+        let resBody = mapOutput show (getResponseBody res)
+        resBody' <- liftIO $ runConduit $ resBody .| sinkList
+        prettyThrowIO (ArchiveUploadFailure code resBody' tarName)
 
 printBody :: Response (ConduitM () S.ByteString IO ()) -> IO ()
 printBody res = runConduit $ getResponseBody res .| CB.sinkHandle stdout
@@ -269,16 +389,17 @@ -- | Upload a single tarball with the given @Uploader@.
 --
 -- Since 0.1.0.0
-upload :: HasLogFunc m
+upload :: (HasLogFunc m, HasTerm m)
        => String -- ^ Hackage base URL
        -> HackageAuth
        -> FilePath
        -> UploadVariant
        -> RIO m ()
 upload baseUrl auth fp uploadVariant =
-  uploadBytes baseUrl auth (takeFileName fp) uploadVariant =<< liftIO (L.readFile fp)
+  uploadBytes baseUrl auth (takeFileName fp) uploadVariant
+    =<< liftIO (L.readFile fp)
 
-uploadRevision :: HasLogFunc m
+uploadRevision :: (HasLogFunc m, HasTerm m)
                => String -- ^ Hackage base URL
                -> HackageAuth
                -> PackageIdentifier
src/System/Process/Pager.hs view
@@ -1,7 +1,4 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Run external pagers (@$PAGER@, @less@, @more@).
 module System.Process.Pager
@@ -42,29 +39,29 @@ 
 -- | Run pager, providing a function that writes to the pager's input.
 pageWriter :: (Handle -> IO ()) -> IO ()
-pageWriter writer =
-  do mpager <- runMaybeT $ cmdspecFromEnvVar
-                       <|> cmdspecFromExeName "less"
-                       <|> cmdspecFromExeName "more"
-     case mpager of
-       Just pager ->
-         do (Just h,_,_,procHandle) <- createProcess pager
-                                         { std_in = CreatePipe
-                                         , close_fds = True
-                                         , delegate_ctlc = True
-                                         }
-            (_ :: Either IOException ()) <- try (do writer h
-                                                    hClose h)
-            exit <- waitForProcess procHandle
-            case exit of
-              ExitSuccess -> pure ()
-              ExitFailure n -> throwIO (PagerExitFailure (cmdspec pager) n)
-            pure ()
-       Nothing -> writer stdout
-  where
-    cmdspecFromEnvVar = shell <$> MaybeT (lookupEnv "PAGER")
-    cmdspecFromExeName =
-      fmap (\path -> proc path []) . MaybeT . findExecutable
+pageWriter writer = do
+  mpager <- runMaybeT $ cmdspecFromEnvVar
+                    <|> cmdspecFromExeName "less"
+                    <|> cmdspecFromExeName "more"
+  case mpager of
+    Just pager ->
+      do (Just h,_,_,procHandle) <- createProcess pager
+                                      { std_in = CreatePipe
+                                      , close_fds = True
+                                      , delegate_ctlc = True
+                                      }
+         (_ :: Either IOException ()) <- try (do writer h
+                                                 hClose h)
+         exit <- waitForProcess procHandle
+         case exit of
+           ExitSuccess -> pure ()
+           ExitFailure n -> throwIO (PagerExitFailure (cmdspec pager) n)
+         pure ()
+    Nothing -> writer stdout
+ where
+  cmdspecFromEnvVar = shell <$> MaybeT (lookupEnv "PAGER")
+  cmdspecFromExeName =
+    fmap (\command -> proc command []) . MaybeT . findExecutable
 
 -- | Run pager to display a 'Text'
 pageText :: Text -> IO ()
src/main/BuildInfo.hs view
@@ -10,7 +10,6 @@ -- and therefore doesn't need to be recompiled as often.
 module BuildInfo
   ( versionString'
-  , maybeGitHash
   , hpackVersion
   ) where
 
@@ -25,7 +24,7 @@ import           Distribution.System ( buildArch )
 import qualified Distribution.Text as Cabal ( display )
 #ifdef USE_GIT_INFO
-import           GitHash ( giCommitCount, giHash, tGitInfoCwdTry )
+import           GitHash ( giCommitCount, tGitInfoCwdTry )
 #endif
 #ifdef USE_GIT_INFO
 import           Options.Applicative.Simple ( simpleVersion )
@@ -36,54 +35,45 @@ versionString' :: String
 #ifdef USE_GIT_INFO
 versionString' = concat $ concat
-    [ [$(simpleVersion Meta.version)]
-      -- Leave out number of commits for --depth=1 clone
-      -- See https://github.com/commercialhaskell/stack/issues/792
-    , case giCommitCount <$> $$tGitInfoCwdTry of
-        Left _ -> []
-        Right 1 -> []
-        Right count -> [" (", show count, " commits)"]
-    , [afterVersion]
-    ]
+  [ [$(simpleVersion Meta.version)]
+    -- Leave out number of commits for --depth=1 clone
+    -- See https://github.com/commercialhaskell/stack/issues/792
+  , case giCommitCount <$> $$tGitInfoCwdTry of
+      Left _ -> []
+      Right 1 -> []
+      Right count -> [" (", show count, " commits)"]
+  , [afterVersion]
+  ]
 #else
 versionString' = showStackVersion ++ afterVersion
 #endif
-  where
-    afterVersion = concat
-      [ preReleaseString
-      , ' ' : Cabal.display buildArch
-      , depsString
-      , warningString
-      ]
-    preReleaseString =
-      case versionBranch Meta.version of
-        (_:y:_) | even y -> " PRE-RELEASE"
-        (_:_:z:_) | even z -> " RELEASE-CANDIDATE"
-        _ -> ""
+ where
+  afterVersion = concat
+    [ preReleaseString
+    , ' ' : Cabal.display buildArch
+    , depsString
+    , warningString
+    ]
+  preReleaseString =
+    case versionBranch Meta.version of
+      (_:y:_) | even y -> " PRE-RELEASE"
+      (_:_:z:_) | even z -> " RELEASE-CANDIDATE"
+      _ -> ""
 #ifdef HIDE_DEP_VERSIONS
-    depsString = " hpack-" ++ VERSION_hpack
+  depsString = " hpack-" ++ VERSION_hpack
 #else
-    depsString = "\nCompiled with:\n" ++ unlines (map ("- " ++) Build_stack.deps)
+  depsString = "\nCompiled with:\n" ++ unlines (map ("- " ++) Build_stack.deps)
 #endif
 #ifdef SUPPORTED_BUILD
-    warningString = ""
-#else
-    warningString = unlines
-      [ ""
-      , "Warning: this is an unsupported build that may use different versions of"
-      , "dependencies and GHC than the officially released binaries, and therefore may"
-      , "not behave identically.  If you encounter problems, please try the latest"
-      , "official build by running 'stack upgrade --force-download'."
-      ]
-#endif
-
--- | If USE_GIT_INFO is enabled, the Git hash in the build directory, otherwise Nothing.
-maybeGitHash :: Maybe String
-maybeGitHash =
-#ifdef USE_GIT_INFO
-        (either (const Nothing) (Just . giHash) $$tGitInfoCwdTry)
+  warningString = ""
 #else
-        Nothing
+  warningString = unlines
+    [ ""
+    , "Warning: this is an unsupported build that may use different versions of"
+    , "dependencies and GHC than the officially released binaries, and therefore may"
+    , "not behave identically.  If you encounter problems, please try the latest"
+    , "official build by running 'stack upgrade --force-download'."
+    ]
 #endif
 
 -- | Hpack version we're compiled against
src/main/Main.hs view
@@ -1,1106 +1,136 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- | Main Stack tool entry point.
-
-module Main (main) where
-
-import           BuildInfo
-import           Conduit ( runConduitRes, sourceLazy, sinkFileCautious )
-import           Data.Attoparsec.Args ( EscapingMode (Escaping), parseArgs )
-import           Data.Attoparsec.Interpreter ( getInterpreterArgs )
-import qualified Data.List as L
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-import qualified Data.Text as T
-import           RIO.Process
-import           GHC.IO.Encoding ( mkTextEncoding, textEncodingName )
-import           Options.Applicative
-                   ( Parser, ParserFailure, ParserHelp, ParserResult (..), flag
-                   , handleParseResult, help, helpError, idm, long, metavar
-                   , overFailure, renderFailure, strArgument, switch )
-import           Options.Applicative.Help ( errorHelp, stringChunk, vcatChunks )
-import           Options.Applicative.Builder.Extra
-                   ( boolFlags, execExtraHelp, extraHelpOption, textOption )
-import           Options.Applicative.Complicated
-                   ( addCommand, addSubCommands, complicatedOptions )
-import           Pantry ( loadSnapshot )
-import           Path
-import           Path.IO
-import           Stack.Build
-import           Stack.Build.Target ( NeedTargets (..) )
-import           Stack.Clean ( CleanCommand (..), CleanOpts (..), clean )
-import           Stack.Config
-import           Stack.ConfigCmd as ConfigCmd
-import           Stack.Constants
-import           Stack.Constants.Config
-import           Stack.Coverage
-import qualified Stack.Docker as Docker
-import           Stack.Dot
-import           Stack.GhcPkg ( findGhcPkgField )
-import qualified Stack.Nix as Nix
-import           Stack.FileWatch
-import           Stack.Ghci
-import           Stack.Hoogle
-import           Stack.List
-import           Stack.Ls
-import qualified Stack.IDE as IDE
-import           Stack.Init
-import           Stack.New
-import           Stack.Options.BuildParser
-import           Stack.Options.CleanParser
-import           Stack.Options.DockerParser
-import           Stack.Options.DotParser
-import           Stack.Options.ExecParser
-import           Stack.Options.GhciParser
-import           Stack.Options.GlobalParser
-import           Stack.Options.HpcReportParser
-import           Stack.Options.NewParser
-import           Stack.Options.NixParser
-import           Stack.Options.ScriptParser
-import           Stack.Options.SDistParser
-import           Stack.Options.UploadParser
-import           Stack.Options.Utils
-import qualified Stack.Path
-import           Stack.Prelude hiding (Display (..))
-import           Stack.Runners
-import           Stack.Script
-import           Stack.SDist
-                   ( SDistOpts (..), checkSDistTarball, checkSDistTarball'
-                   , getSDistTarball
-                   )
-import           Stack.Setup ( withNewLocalBuildTargets )
-import           Stack.SetupCmd
-import           Stack.Types.Version
-                   ( VersionCheck (..), checkVersion, showStackVersion
-                   , stackVersion
-                   )
-import           Stack.Types.Config
-import           Stack.Types.NamedComponent
-import           Stack.Types.SourceMap
-import           Stack.Unpack
-import           Stack.Upgrade
-import qualified Stack.Upload as Upload
-import qualified System.Directory as D
-import           System.Environment ( getArgs, getProgName, withArgs )
-import           System.FilePath ( isValid, pathSeparator, takeDirectory )
-import qualified System.FilePath as FP
-import           System.IO ( hGetEncoding, hPutStrLn, hSetEncoding )
-import           System.Terminal ( hIsTerminalDeviceOrMinTTY )
-
--- | Type representing exceptions thrown by functions in the "Main" module.
-data MainException
-  = InvalidReExecVersion String String
-  | InvalidPathForExec FilePath
-  deriving (Show, Typeable)
-
-instance Exception MainException where
-  displayException (InvalidReExecVersion expected actual) = concat
-    [ "Error: [S-2186]\n"
-    , "When re-executing '"
-    , stackProgName
-    , "' in a container, the incorrect version was found\nExpected: "
-    , expected
-    , "; found: "
-    , actual
-    ]
-  displayException (InvalidPathForExec path) = concat
-    [ "Error: [S-1541]\n"
-    , "Got an invalid '--cwd' argument for 'stack exec' ("
-    , path
-    , ")."
-    ]
-
--- | Type representing \'pretty\' exceptions thrown by functions in the "Main"
--- module.
-data MainPrettyException
-  = GHCProfOptionInvalid
-  | ResolverOptionInvalid
-  | PackageIdNotFoundBug !String
-  | ExecutableToRunNotFound
-  deriving (Show, Typeable)
-
-instance Pretty MainPrettyException where
-  pretty GHCProfOptionInvalid =
-       "[S-8100]"
-    <> line
-    <> flow "When building with Stack, you should not use GHC's '-prof' \
-            \option. Instead, please use Stack's '--library-profiling' and \
-            \'--executable-profiling' flags. See:" <+>
-            style Url "https://github.com/commercialhaskell/stack/issues/1015"
-    <> "."
-  pretty ResolverOptionInvalid =
-       "[S-8761]"
-    <> line
-    <> flow "The '--resolver' option cannot be used with Stack's 'upgrade' \
-            \command."
-  pretty (PackageIdNotFoundBug name) = bugPrettyReport "[S-8251]" $
-    "Could not find the package id of the package" <+>
-      style Target (fromString name)
-    <> "."
-  pretty ExecutableToRunNotFound =
-       "[S-2483]"
-    <> line
-    <> flow "No executables found."
-
-instance Exception MainPrettyException
-
-main :: IO ()
-main = do
-  -- Line buffer the output by default, particularly for non-terminal runs.
-  -- See https://github.com/commercialhaskell/stack/pull/360
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stdin  LineBuffering
-  hSetBuffering stderr LineBuffering
-  hSetTranslit stdout
-  hSetTranslit stderr
-  args <- getArgs
-  progName <- getProgName
-  isTerminal <- hIsTerminalDeviceOrMinTTY stdout
-  -- On Windows, where applicable, defaultColorWhen has the side effect of
-  -- enabling ANSI for ANSI-capable native (ConHost) terminals, if not already
-  -- ANSI-enabled.
-  execExtraHelp args
-                Docker.dockerHelpOptName
-                (dockerOptsParser False)
-                ("Only showing --" ++ Docker.dockerCmdName ++ "* options.")
-  execExtraHelp args
-                Nix.nixHelpOptName
-                (nixOptsParser False)
-                ("Only showing --" ++ Nix.nixCmdName ++ "* options.")
-
-  currentDir <- D.getCurrentDirectory
-  eGlobalRun <- try $ commandLineHandler currentDir progName False
-  case eGlobalRun of
-    Left (exitCode :: ExitCode) ->
-      throwIO exitCode
-    Right (globalMonoid, run) -> do
-      global <- globalOptsFromMonoid isTerminal globalMonoid
-      when (globalLogLevel global == LevelDebug) $
-        hPutStrLn stderr versionString'
-      case globalReExecVersion global of
-        Just expectVersion -> do
-          expectVersion' <- parseVersionThrowing expectVersion
-          unless (checkVersion MatchMinor expectVersion' stackVersion) $
-            throwIO $
-              InvalidReExecVersion expectVersion showStackVersion
-        _ -> pure ()
-      withRunnerGlobal global $ run `catches`
-        [ Handler handleExitCode
-        , Handler handlePrettyException
-        , Handler handleSomeException
-        ]
-
--- | Change the character encoding of the given Handle to transliterate on
--- unsupported characters instead of throwing an exception
-hSetTranslit :: Handle -> IO ()
-hSetTranslit h = do
-  menc <- hGetEncoding h
-  case fmap textEncodingName menc of
-    Just name
-      | '/' `notElem` name -> do
-          enc' <- mkTextEncoding $ name ++ "//TRANSLIT"
-          hSetEncoding h enc'
-    _ -> pure ()
-
--- | Handle ExitCode exceptions.
-handleExitCode :: ExitCode -> RIO Runner a
-handleExitCode = exitWith
-
--- | Handle PrettyException exceptions.
-handlePrettyException :: PrettyException -> RIO Runner a
-handlePrettyException e = do
-  -- The code below loads the entire Stack configuration, when all that is
-  -- needed are the Stack colours. A tailored approach may be better.
-  result <- tryAny $ withConfig NoReexec $ prettyError $ pretty e
-  case result of
-    -- Falls back to the command line's Stack colours if there is any error in
-    -- loading the entire Stack configuration.
-    Left _ -> prettyError $ pretty e
-    Right _ -> pure ()
-  exitFailure
-
--- | Handle SomeException exceptions. This special handler stops "stack: " from
--- being printed before the exception.
-handleSomeException :: SomeException -> RIO Runner a
-handleSomeException (SomeException e) = do
-  logError $ fromString $ displayException e
-  exitFailure
-
--- Vertically combine only the error component of the first argument with the
--- error component of the second.
-vcatErrorHelp :: ParserHelp -> ParserHelp -> ParserHelp
-vcatErrorHelp h1 h2 = h2 { helpError = vcatChunks [helpError h2, helpError h1] }
-
-commandLineHandler ::
-     FilePath
-  -> String
-  -> Bool
-  -> IO (GlobalOptsMonoid, RIO Runner ())
-commandLineHandler currentDir progName isInterpreter =
-  complicatedOptions
-    stackVersion
-    (Just versionString')
-    hpackVersion
-    "stack - The Haskell Tool Stack"
-    ""
-    "Stack's documentation is available at https://docs.haskellstack.org/. \
-    \Command 'stack COMMAND --help' for help about a Stack command. Stack also \
-    \supports the Haskell Error Index at https://errors.haskell.org/."
-    (globalOpts OuterGlobalOpts)
-    (Just failureCallback)
-    addCommands
- where
-  failureCallback f args =
-    case L.stripPrefix "Invalid argument" (fst (renderFailure f "")) of
-      Just _ -> if isInterpreter
-                  then parseResultHandler args f
-                  else secondaryCommandHandler args f
-                      >>= interpreterHandler currentDir args
-      Nothing -> parseResultHandler args f
-
-  parseResultHandler args f =
-    if isInterpreter
-    then do
-      let hlp = errorHelp $ stringChunk
-            (unwords ["Error executing interpreter command:"
-                      , progName
-                      , unwords args])
-      handleParseResult (overFailure (vcatErrorHelp hlp) (Failure f))
-    else handleParseResult (Failure f)
-
-  addCommands = do
-    unless isInterpreter $ do
-      addBuildCommand'
-        "build"
-        "Build the package(s) in this directory/configuration"
-        buildCmd
-        (buildOptsParser Build)
-      addBuildCommand'
-        "install"
-        "Shortcut for 'build --copy-bins'"
-        buildCmd
-        (buildOptsParser Install)
-      addCommand'
-        "uninstall"
-        "Show how to uninstall Stack. This command does not itself uninstall \
-        \Stack."
-        uninstallCmd
-        (pure ())
-      addBuildCommand'
-        "test"
-        "Shortcut for 'build --test'"
-        buildCmd
-        (buildOptsParser Test)
-      addBuildCommand'
-        "bench"
-        "Shortcut for 'build --bench'"
-        buildCmd
-        (buildOptsParser Bench)
-      addBuildCommand'
-        "haddock"
-        "Shortcut for 'build --haddock'"
-        buildCmd
-        (buildOptsParser Haddock)
-      addCommand'
-        "new"
-        "Create a new project from a template. Run 'stack templates' to see \
-        \available templates. Will also initialise if there is no stack.yaml \
-        \file. Note: you can also specify a local file or a remote URL as a \
-        \template; or force an initialisation."
-        newCmd
-        newOptsParser
-      addCommand'
-        "templates"
-        "Show how to find templates available for 'stack new'. 'stack new' \
-        \can accept a template from a remote repository (default: github), \
-        \local file or remote URL. Note: this downloads the help file."
-        templatesCmd
-        (pure ())
-      addCommand'
-        "init"
-        "Create Stack project configuration from Cabal or Hpack package \
-        \specifications"
-        initCmd
-        initOptsParser
-      addCommand'
-        "setup"
-        "Get the appropriate GHC for your project"
-        setupCmd
-        setupParser
-      addCommand'
-        "path"
-        "Print out handy path information"
-        Stack.Path.path
-        Stack.Path.pathParser
-      addCommand'
-        "ls"
-        "List command. (Supports snapshots, dependencies, Stack's styles and \
-        \installed tools)"
-        lsCmd
-        lsParser
-      addCommand'
-        "unpack"
-        "Unpack one or more packages locally"
-        unpackCmd
-        ( (,)
-            <$> some (strArgument $ metavar "PACKAGE")
-            <*> optional (textOption
-                  (  long "to"
-                  <> help "Optional path to unpack the package into (will \
-                          \unpack into subdirectory)"
-                  ))
-        )
-      addCommand'
-        "update"
-        "Update the package index"
-        updateCmd
-        (pure ())
-      addCommand''
-        "upgrade"
-        "Upgrade Stack, installing to Stack's local-bin directory and, if \
-        \different and permitted, the directory of the current Stack \
-        \executable"
-        upgradeCmd
-        "Warning: if you use GHCup to install Stack, use only GHCup to \
-        \upgrade Stack."
-        upgradeOpts
-      addCommand'
-        "upload"
-        "Upload a package to Hackage"
-        uploadCmd
-        uploadOptsParser
-      addCommand'
-        "sdist"
-        "Create source distribution tarballs"
-        sdistCmd
-        sdistOptsParser
-      addCommand'
-        "dot"
-        "Visualize your project's dependency graph using Graphviz dot"
-        dot
-        (dotOptsParser False) -- Default for --external is False.
-      addCommand'
-        "ghc"
-        "Run ghc"
-        execCmd
-        (execOptsParser $ Just ExecGhc)
-      addCommand'
-        "hoogle"
-        "Run hoogle, the Haskell API search engine. Use the '-- ARGUMENT(S)' \
-        \syntax to pass Hoogle arguments, e.g. 'stack hoogle -- --count=20', \
-        \or 'stack hoogle -- server --local'."
-        hoogleCmd
-        ( (,,,)
-            <$> many (strArgument
-                  ( metavar "-- ARGUMENT(S) (e.g. 'stack hoogle -- server --local')"
-                  ))
-            <*> boolFlags
-                  True
-                  "setup"
-                  "If needed: install hoogle, build haddocks and \
-                  \generate a hoogle database"
-                  idm
-            <*> switch
-                  (  long "rebuild"
-                  <> help "Rebuild the hoogle database"
-                  )
-            <*> switch
-                  (  long "server"
-                  <> help "Start local Hoogle server"
-                  )
-          )
-    -- These are the only commands allowed in interpreter mode as well
-    addCommand'
-      "exec"
-      "Execute a command. If the command is absent, the first of any \
-      \arguments is taken as the command."
-      execCmd
-      (execOptsParser Nothing)
-    addCommand'
-      "run"
-      "Build and run an executable. Defaults to the first available \
-      \executable if none is provided as the first argument."
-      execCmd
-      (execOptsParser $ Just ExecRun)
-    addGhciCommand'
-      "ghci"
-      "Run ghci in the context of package(s) (experimental)"
-      ghciCmd
-      ghciOptsParser
-    addGhciCommand'
-      "repl"
-      "Run ghci in the context of package(s) (experimental) (alias for \
-      \'ghci')"
-      ghciCmd
-      ghciOptsParser
-    addCommand'
-      "runghc"
-      "Run runghc"
-      execCmd
-      (execOptsParser $ Just ExecRunGhc)
-    addCommand'
-      "runhaskell"
-      "Run runghc (alias for 'runghc')"
-      execCmd
-      (execOptsParser $ Just ExecRunGhc)
-    addCommand
-      "script"
-      "Run a Stack Script"
-      globalFooter
-      scriptCmd
-      ( \so gom ->
-          gom
-            { globalMonoidResolverRoot =
-                First $ Just $ takeDirectory $ soFile so
-            }
-      )
-      (globalOpts OtherCmdGlobalOpts)
-      scriptOptsParser
-    unless isInterpreter $ do
-      addCommand'
-        "eval"
-        "Evaluate some haskell code inline. Shortcut for 'stack exec ghc -- \
-        \-e CODE'"
-        evalCmd
-        (evalOptsParser "CODE")
-      addCommand'
-        "clean"
-        "Delete build artefacts for the project packages."
-        cleanCmd
-        (cleanOptsParser Clean)
-      addCommand'
-        "purge"
-        "Delete the project Stack working directories (.stack-work by \
-        \default). Shortcut for 'stack clean --full'"
-        cleanCmd
-        (cleanOptsParser Purge)
-      addCommand'
-        "query"
-        "Query general build information (experimental)"
-        queryCmd
-        (many $ strArgument $ metavar "SELECTOR...")
-      addCommand'
-        "list"
-        "List package id's in snapshot (experimental)"
-        listCmd
-        (many $ strArgument $ metavar "PACKAGE")
-      addSubCommands'
-        "ide"
-        "IDE-specific commands"
-        ( let outputFlag = flag
-                IDE.OutputLogInfo
-                IDE.OutputStdout
-                (  long "stdout"
-                <> help "Send output to stdout instead of the default, stderr"
-                )
-              cabalFileFlag = flag
-                IDE.ListPackageNames
-                IDE.ListPackageCabalFiles
-                (  long "cabal-files"
-                <> help "Print paths to package cabal-files instead of \
-                        \package names"
-                )
-           in  do
-                 addCommand'
-                   "packages"
-                   "List all available local loadable packages"
-                   idePackagesCmd
-                   ((,) <$> outputFlag <*> cabalFileFlag)
-                 addCommand'
-                   "targets"
-                   "List all available Stack targets"
-                   ideTargetsCmd
-                   outputFlag
-        )
-      addSubCommands'
-        Docker.dockerCmdName
-        "Subcommands specific to Docker use"
-        ( do
-            addCommand'
-              Docker.dockerPullCmdName
-              "Pull latest version of Docker image from registry"
-              dockerPullCmd
-              (pure ())
-            addCommand'
-              "reset"
-              "Reset the Docker sandbox"
-              dockerResetCmd
-              ( switch
-                  (  long "keep-home"
-                  <> help "Do not delete sandbox's home directory"
-                  )
-              )
-        )
-      addSubCommands'
-        ConfigCmd.cfgCmdName
-          "Subcommands for accessing and modifying configuration values"
-          ( do
-              addCommand'
-                ConfigCmd.cfgCmdSetName
-                "Sets a key in YAML configuration file to value"
-                (withConfig NoReexec . cfgCmdSet)
-                configCmdSetParser
-              addCommand'
-                ConfigCmd.cfgCmdEnvName
-                "Print environment variables for use in a shell"
-                (withConfig YesReexec . withDefaultEnvConfig . cfgCmdEnv)
-                configCmdEnvParser
-          )
-      addSubCommands'
-        "hpc"
-        "Subcommands specific to Haskell Program Coverage"
-        ( addCommand'
-            "report"
-            "Generate unified HPC coverage report from tix files and project \
-            \targets"
-            hpcReportCmd
-            hpcReportOptsParser
-        )
-     where
-      -- addCommand hiding global options
-      addCommand' ::
-           String
-        -> String
-        -> (a -> RIO Runner ())
-        -> Parser a
-        -> AddCommand
-      addCommand' cmd title constr =
-        addCommand
-          cmd
-          title
-          globalFooter
-          constr
-          (\_ gom -> gom)
-          (globalOpts OtherCmdGlobalOpts)
-      -- addCommand with custom footer hiding global options
-      addCommand'' ::
-           String
-        -> String
-        -> (a -> RIO Runner ())
-        -> String
-        -> Parser a
-        -> AddCommand
-      addCommand'' cmd title constr cmdFooter =
-        addCommand
-          cmd
-          title
-          (globalFooter <> " " <> cmdFooter)
-          constr
-          (\_ gom -> gom)
-          (globalOpts OtherCmdGlobalOpts)
-
-      addSubCommands' ::
-           String
-        -> String
-        -> AddCommand
-        -> AddCommand
-      addSubCommands' cmd title =
-        addSubCommands
-          cmd
-          title
-          globalFooter
-          (globalOpts OtherCmdGlobalOpts)
-
-      -- Additional helper that hides global options and shows build options
-      addBuildCommand' ::
-           String
-        -> String
-        -> (a -> RIO Runner ())
-        -> Parser a
-        -> AddCommand
-      addBuildCommand' cmd title constr =
-          addCommand
-            cmd
-            title
-            globalFooter
-            constr
-            (\_ gom -> gom)
-            (globalOpts BuildCmdGlobalOpts)
-
-      -- Additional helper that hides global options and shows some ghci options
-      addGhciCommand' ::
-           String
-        -> String
-        -> (a -> RIO Runner ())
-        -> Parser a
-        -> AddCommand
-      addGhciCommand' cmd title constr =
-          addCommand
-            cmd
-            title
-            globalFooter
-            constr
-            (\_ gom -> gom)
-            (globalOpts GhciCmdGlobalOpts)
-
-  globalOpts :: GlobalOptsContext -> Parser GlobalOptsMonoid
-  globalOpts kind =
-        extraHelpOption
-          hide
-          progName
-          (Docker.dockerCmdName ++ "*")
-          Docker.dockerHelpOptName
-    <*> extraHelpOption
-          hide
-          progName
-          (Nix.nixCmdName ++ "*")
-          Nix.nixHelpOptName
-    <*> globalOptsParser
-          currentDir kind
-          ( if isInterpreter
-              -- Silent except when errors occur - see #2879
-              then Just LevelError
-              else Nothing
-          )
-   where
-    hide = kind /= OuterGlobalOpts
-
--- | fall-through to external executables in `git` style if they exist
--- (i.e. `stack something` looks for `stack-something` before
--- failing with "Invalid argument `something'")
-secondaryCommandHandler ::
-     [String]
-  -> ParserFailure ParserHelp
-  -> IO (ParserFailure ParserHelp)
-secondaryCommandHandler args f =
-  -- don't even try when the argument looks like a path or flag
-  if elem pathSeparator cmd || "-" `L.isPrefixOf` L.head args
-     then pure f
-  else do
-    mExternalExec <- D.findExecutable cmd
-    case mExternalExec of
-      Just ex -> withProcessContextNoLogging $ do
-        -- TODO show the command in verbose mode
-        -- hPutStrLn stderr $ unwords $
-        --   ["Running", "[" ++ ex, unwords (tail args) ++ "]"]
-        _ <- exec ex (L.tail args)
-        pure f
-      Nothing -> pure $ fmap (vcatErrorHelp (noSuchCmd cmd)) f
- where
-  -- FIXME this is broken when any options are specified before the command
-  -- e.g. stack --verbosity silent cmd
-  cmd = stackProgName ++ "-" ++ L.head args
-  noSuchCmd name = errorHelp $ stringChunk
-    ("Auxiliary command not found in path `" ++ name ++ "'")
-
-interpreterHandler ::
-     Monoid t
-  => FilePath
-  -> [String]
-  -> ParserFailure ParserHelp
-  -> IO (GlobalOptsMonoid, (RIO Runner (), t))
-interpreterHandler currentDir args f = do
-  -- args can include top-level config such as --extra-lib-dirs=... (set by
-  -- nix-shell) - we need to find the first argument which is a file, everything
-  -- afterwards is an argument to the script, everything before is an argument
-  -- to Stack
-  (stackArgs, fileArgs) <- spanM (fmap not . D.doesFileExist) args
-  case fileArgs of
-    (file:fileArgs') -> runInterpreterCommand file stackArgs fileArgs'
-    [] -> parseResultHandler (errorCombine (noSuchFile firstArg))
- where
-  firstArg = L.head args
-
-  spanM _ [] = pure ([], [])
-  spanM p xs@(x:xs') = do
-    r <- p x
-    if r
-    then do
-      (ys, zs) <- spanM p xs'
-      pure (x:ys, zs)
-    else
-      pure ([], xs)
-
-  -- if the first argument contains a path separator then it might be a file,
-  -- or a Stack option referencing a file. In that case we only show the
-  -- interpreter error message and exclude the command related error messages.
-  errorCombine =
-    if pathSeparator `elem` firstArg
-    then overrideErrorHelp
-    else vcatErrorHelp
-
-  overrideErrorHelp h1 h2 = h2 { helpError = helpError h1 }
-
-  parseResultHandler fn = handleParseResult (overFailure fn (Failure f))
-  noSuchFile name = errorHelp $ stringChunk
-    ("File does not exist or is not a regular file `" ++ name ++ "'")
-
-  runInterpreterCommand path stackArgs fileArgs = do
-    progName <- getProgName
-    iargs <- getInterpreterArgs path
-    let parseCmdLine = commandLineHandler currentDir progName True
-        -- Implicit file arguments are put before other arguments that
-        -- occur after "--". See #3658
-        cmdArgs = stackArgs ++ case break (== "--") iargs of
-          (beforeSep, []) -> beforeSep ++ ["--"] ++ [path] ++ fileArgs
-          (beforeSep, optSep : afterSep) ->
-            beforeSep ++ [optSep] ++ [path] ++ fileArgs ++ afterSep
-     -- TODO show the command in verbose mode
-     -- hPutStrLn stderr $ unwords $
-     --   ["Running", "[" ++ progName, unwords cmdArgs ++ "]"]
-    (a,b) <- withArgs cmdArgs parseCmdLine
-    pure (a,(b,mempty))
-
-setupCmd :: SetupCmdOpts -> RIO Runner ()
-setupCmd sco@SetupCmdOpts{..} = withConfig YesReexec $ do
-  installGHC <- view $ configL.to configInstallGHC
-  if installGHC
-    then
-       withBuildConfig $ do
-       (wantedCompiler, compilerCheck, mstack) <-
-         case scoCompilerVersion of
-           Just v -> pure (v, MatchMinor, Nothing)
-           Nothing -> (,,)
-             <$> view wantedCompilerVersionL
-             <*> view (configL.to configCompilerCheck)
-             <*> (Just <$> view stackYamlL)
-       setup sco wantedCompiler compilerCheck mstack
-    else
-      logWarn "The --no-install-ghc flag is inconsistent with 'stack setup'. \
-              \No action taken."
-
-cleanCmd :: CleanOpts -> RIO Runner ()
-cleanCmd = withConfig NoReexec . clean
-
--- | Helper for build and install commands
-buildCmd :: BuildOptsCLI -> RIO Runner ()
-buildCmd opts = do
-  when (any (("-prof" `elem`) . fromRight [] . parseArgs Escaping) (boptsCLIGhcOptions opts)) $ do
-    throwIO $ PrettyException GHCProfOptionInvalid
-  local (over globalOptsL modifyGO) $
-    case boptsCLIFileWatch opts of
-      FileWatchPoll -> fileWatchPoll (inner . Just)
-      FileWatch -> fileWatch (inner . Just)
-      NoFileWatch -> inner Nothing
- where
-  inner
-    :: Maybe (Set (Path Abs File) -> IO ())
-    -> RIO Runner ()
-  inner setLocalFiles = withConfig YesReexec $ withEnvConfig NeedTargets opts $
-      Stack.Build.build setLocalFiles
-  -- Read the build command from the CLI and enable it to run
-  modifyGO =
-    case boptsCLICommand opts of
-      Test -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True)
-      Haddock -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidHaddockL) (Just True)
-      Bench -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True)
-      Install -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidInstallExesL) (Just True)
-      Build -> id -- Default case is just Build
-
--- | Display help for the uninstall command.
-uninstallCmd :: () -> RIO Runner ()
-uninstallCmd () = withConfig NoReexec $ do
-  stackRoot <- view stackRootL
-  globalConfig <- view stackGlobalConfigL
-  programsDir <- view $ configL.to configLocalProgramsBase
-  localBinDir <- view $ configL.to configLocalBin
-  let toStyleDoc = style Dir . fromString . toFilePath
-      stackRoot' = toStyleDoc stackRoot
-      globalConfig' = toStyleDoc globalConfig
-      programsDir' = toStyleDoc programsDir
-      localBinDir' = toStyleDoc localBinDir
-  prettyInfo $ vsep
-    [ flow "To uninstall Stack, it should be sufficient to delete:"
-    , hang 4 $ fillSep [flow "(1) the directory containing Stack's tools",
-      "(" <> softbreak <> programsDir' <> softbreak <> ");"]
-    , hang 4 $ fillSep [flow "(2) the Stack root directory",
-      "(" <> softbreak <> stackRoot' <> softbreak <> ");"]
-    , hang 4 $ fillSep [flow "(3) if different, the directory containing ",
-      flow "Stack's global YAML configuration file",
-      "(" <> softbreak <> globalConfig' <> softbreak <> ");", "and"]
-    , hang 4 $ fillSep [flow "(4) the 'stack' executable file (see the output",
-      flow "of command", howToFindStack <> ",", flow "if Stack is on the PATH;",
-      flow "Stack is often installed in", localBinDir' <> softbreak <> ")."]
-    , fillSep [flow "You may also want to delete", style File ".stack-work",
-      flow "directories in any Haskell projects that you have built."]
-    ]
- where
-  styleShell = style Shell
-  howToFindStack
-    | osIsWindows = styleShell "where.exe stack"
-    | otherwise   = styleShell "which stack"
-
--- | Unpack packages to the filesystem
-unpackCmd :: ([String], Maybe Text) -> RIO Runner ()
-unpackCmd (names, Nothing) = unpackCmd (names, Just ".")
-unpackCmd (names, Just dstPath) = withConfig NoReexec $ do
-  mresolver <- view $ globalOptsL.to globalResolver
-  mSnapshot <- forM mresolver $ \resolver -> do
-    concrete <- makeConcreteResolver resolver
-    loc <- completeSnapshotLocation concrete
-    loadSnapshot loc
-  dstPath' <- resolveDir' $ T.unpack dstPath
-  unpackPackages mSnapshot dstPath' names
-
--- | Update the package index
-updateCmd :: () -> RIO Runner ()
-updateCmd () = withConfig NoReexec (void (updateHackageIndex Nothing))
-
-upgradeCmd :: UpgradeOpts -> RIO Runner ()
-upgradeCmd upgradeOpts' = do
-  go <- view globalOptsL
-  case globalResolver go of
-    Just _ -> throwIO $ PrettyException ResolverOptionInvalid
-    Nothing ->
-      withGlobalProject $
-      upgrade
-        maybeGitHash
-        upgradeOpts'
-
--- | Upload to Hackage
-uploadCmd :: UploadOpts -> RIO Runner ()
-uploadCmd (UploadOpts (SDistOpts [] _ _ _ _) _) = do
-  prettyErrorL
-      [ flow "To upload the current package, please run"
-      , style Shell "stack upload ."
-      , flow "(with the period at the end)"
-      ]
-  liftIO exitFailure
-uploadCmd uploadOpts = do
-  let partitionM _ [] = pure ([], [])
-      partitionM f (x:xs) = do
-          r <- f x
-          (as, bs) <- partitionM f xs
-          pure $ if r then (x:as, bs) else (as, x:bs)
-      sdistOpts = uoptsSDistOpts uploadOpts
-  (files, nonFiles) <- liftIO $ partitionM D.doesFileExist (sdoptsDirsToWorkWith sdistOpts)
-  (dirs, invalid) <- liftIO $ partitionM D.doesDirectoryExist nonFiles
-  withConfig YesReexec $ withDefaultEnvConfig $ do
-      unless (null invalid) $ do
-          let invalidList = bulletedList $ map (style File . fromString) invalid
-          prettyErrorL
-              [ style Shell "stack upload"
-              , flow "expects a list of sdist tarballs or package directories."
-              , flow "Can't find:"
-              , line <> invalidList
-              ]
-          exitFailure
-      when (null files && null dirs) $ do
-          prettyErrorL
-              [ style Shell "stack upload"
-              , flow "expects a list of sdist tarballs or package directories, but none were specified."
-              ]
-          exitFailure
-      config <- view configL
-      let hackageUrl = T.unpack $ configHackageBaseUrl config
-          uploadVariant = uoptsUploadVariant uploadOpts
-      getCreds <- memoizeRef $ Upload.loadAuth config
-      mapM_ (resolveFile' >=> checkSDistTarball sdistOpts) files
-      forM_ files $ \file -> do
-          tarFile <- resolveFile' file
-          creds <- runMemoized getCreds
-          Upload.upload hackageUrl creds (toFilePath tarFile) uploadVariant
-      forM_ dirs $ \dir -> do
-          pkgDir <- resolveDir' dir
-          (tarName, tarBytes, mcabalRevision) <- getSDistTarball (sdoptsPvpBounds sdistOpts) pkgDir
-          checkSDistTarball' sdistOpts tarName tarBytes
-          creds <- runMemoized getCreds
-          Upload.uploadBytes hackageUrl creds tarName uploadVariant tarBytes
-          forM_ mcabalRevision $ uncurry $ Upload.uploadRevision hackageUrl creds
-
-sdistCmd :: SDistOpts -> RIO Runner ()
-sdistCmd sdistOpts =
-    withConfig YesReexec $ withDefaultEnvConfig $ do
-        -- If no directories are specified, build all sdist tarballs.
-        dirs' <- if null (sdoptsDirsToWorkWith sdistOpts)
-            then do
-                dirs <- view $ buildConfigL.to (map ppRoot . Map.elems . smwProject . bcSMWanted)
-                when (null dirs) $ do
-                    stackYaml <- view stackYamlL
-                    prettyErrorL
-                        [ style Shell "stack sdist"
-                        , flow "expects a list of targets, and otherwise defaults to all of the project's packages."
-                        , flow "However, the configuration at"
-                        , pretty stackYaml
-                        , flow "contains no packages, so no sdist tarballs will be generated."
-                        ]
-                    exitFailure
-                pure dirs
-            else mapM resolveDir' (sdoptsDirsToWorkWith sdistOpts)
-        forM_ dirs' $ \dir -> do
-            (tarName, tarBytes, _mcabalRevision) <- getSDistTarball (sdoptsPvpBounds sdistOpts) dir
-            distDir <- distDirFromDir dir
-            tarPath <- (distDir </>) <$> parseRelFile tarName
-            ensureDir (parent tarPath)
-            runConduitRes $
-              sourceLazy tarBytes .|
-              sinkFileCautious (toFilePath tarPath)
-            prettyInfoL [flow "Wrote sdist tarball to", pretty tarPath]
-            checkSDistTarball sdistOpts tarPath
-            forM_ (sdoptsTarPath sdistOpts) $ copyTarToTarPath tarPath tarName
-        where
-          copyTarToTarPath tarPath tarName targetDir = liftIO $ do
-            let targetTarPath = targetDir FP.</> tarName
-            D.createDirectoryIfMissing True $ FP.takeDirectory targetTarPath
-            D.copyFile (toFilePath tarPath) targetTarPath
-
--- | Execute a command.
-execCmd :: ExecOpts -> RIO Runner ()
-execCmd ExecOpts {..} =
-  withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $ do
-    unless (null targets) $ Stack.Build.build Nothing
-
-    config <- view configL
-    menv <- liftIO $ configProcessContextSettings config eoEnvSettings
-    withProcessContext menv $ do
-      -- Add RTS options to arguments
-      let argsWithRts args = if null eoRtsOptions
-                  then args :: [String]
-                  else args ++ ["+RTS"] ++ eoRtsOptions ++ ["-RTS"]
-      (cmd, args) <- case (eoCmd, argsWithRts eoArgs) of
-          (ExecCmd cmd, args) -> pure (cmd, args)
-          (ExecRun, args) -> getRunCmd args
-          (ExecGhc, args) -> getGhcCmd eoPackages args
-          (ExecRunGhc, args) -> getRunGhcCmd eoPackages args
-
-      runWithPath eoCwd $ exec cmd args
- where
-  ExecOptsExtra {..} = eoExtra
-
-  targets = concatMap words eoPackages
-  boptsCLI = defaultBuildOptsCLI
-             { boptsCLITargets = map T.pack targets
-             }
-
-  -- return the package-id of the first package in GHC_PACKAGE_PATH
-  getPkgId name = do
-    pkg <- getGhcPkgExe
-    mId <- findGhcPkgField pkg [] name "id"
-    case mId of
-      Just i -> pure (L.head $ words (T.unpack i))
-      -- should never happen as we have already installed the packages
-      _      -> throwIO $ PrettyException (PackageIdNotFoundBug name)
-
-  getPkgOpts pkgs =
-    map ("-package-id=" ++) <$> mapM getPkgId pkgs
-
-  getRunCmd args = do
-    packages <- view $ buildConfigL.to (smwProject . bcSMWanted)
-    pkgComponents <- for (Map.elems packages) ppComponents
-    let executables = filter isCExe $ concatMap Set.toList pkgComponents
-    let (exe, args') = case args of
-                       []   -> (firstExe, args)
-                       x:xs -> case L.find (\y -> y == CExe (T.pack x)) executables of
-                               Nothing -> (firstExe, args)
-                               argExe -> (argExe, xs)
-                       where
-                          firstExe = listToMaybe executables
-    case exe of
-      Just (CExe exe') -> do
-        withNewLocalBuildTargets [T.cons ':' exe'] $ Stack.Build.build Nothing
-        pure (T.unpack exe', args')
-      _ -> throwIO $ PrettyException ExecutableToRunNotFound
-
-  getGhcCmd pkgs args = do
-    pkgopts <- getPkgOpts pkgs
-    compiler <- view $ compilerPathsL.to cpCompiler
-    pure (toFilePath compiler, pkgopts ++ args)
-
-  getRunGhcCmd pkgs args = do
-    pkgopts <- getPkgOpts pkgs
-    interpret <- view $ compilerPathsL.to cpInterpreter
-    pure (toFilePath interpret, pkgopts ++ args)
-
-  runWithPath :: Maybe FilePath -> RIO EnvConfig () -> RIO EnvConfig ()
-  runWithPath path callback = case path of
-    Nothing                  -> callback
-    Just p | not (isValid p) -> throwIO $ InvalidPathForExec p
-    Just p                   -> withUnliftIO $ \ul -> D.withCurrentDirectory p $ unliftIO ul callback
-
--- | Evaluate some haskell code inline.
-evalCmd :: EvalOpts -> RIO Runner ()
-evalCmd EvalOpts {..} = execCmd execOpts
- where
-  execOpts =
-    ExecOpts { eoCmd = ExecGhc
-             , eoArgs = ["-e", evalArg]
-             , eoExtra = evalExtra
-             }
-
--- | Run GHCi in the context of a project.
-ghciCmd :: GhciOpts -> RIO Runner ()
-ghciCmd ghciOpts =
-  let boptsCLI = defaultBuildOptsCLI
-          -- using only additional packages, targets then get overridden in `ghci`
-          { boptsCLITargets = map T.pack (ghciAdditionalPackages  ghciOpts)
-          , boptsCLIInitialBuildSteps = True
-          , boptsCLIFlags = ghciFlags ghciOpts
-          , boptsCLIGhcOptions = map T.pack (ghciGhcOptions ghciOpts)
-          }
-  in  withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $ do
-        bopts <- view buildOptsL
-        -- override env so running of tests and benchmarks is disabled
-        let boptsLocal = bopts
-              { boptsTestOpts = (boptsTestOpts bopts) { toDisableRun = True }
-              , boptsBenchmarkOpts = (boptsBenchmarkOpts bopts) { beoDisableRun = True }
-              }
-        local (set buildOptsL boptsLocal)
-              (ghci ghciOpts)
-
--- | List packages in the project.
-idePackagesCmd :: (IDE.OutputStream, IDE.ListPackagesCmd) -> RIO Runner ()
-idePackagesCmd = withConfig NoReexec . withBuildConfig . uncurry IDE.listPackages
-
--- | List targets in the project.
-ideTargetsCmd :: IDE.OutputStream -> RIO Runner ()
-ideTargetsCmd = withConfig NoReexec . withBuildConfig . IDE.listTargets
-
--- | Pull the current Docker image.
-dockerPullCmd :: () -> RIO Runner ()
-dockerPullCmd () = withConfig NoReexec $ Docker.preventInContainer Docker.pull
-
--- | Reset the Docker sandbox.
-dockerResetCmd :: Bool -> RIO Runner ()
-dockerResetCmd = withConfig NoReexec . Docker.preventInContainer . Docker.reset
-
--- | Project initialization
-initCmd :: InitOpts -> RIO Runner ()
-initCmd initOpts = do
-  pwd <- getCurrentDir
-  go <- view globalOptsL
-  withGlobalProject $
-    withConfig YesReexec (initProject pwd initOpts (globalResolver go))
-
--- | Create a project directory structure and initialize the Stack config.
-newCmd :: (NewOpts, InitOpts) -> RIO Runner ()
-newCmd (newOpts, initOpts) =
-  withGlobalProject $ withConfig YesReexec $ do
-    dir <- new newOpts (forceOverwrite initOpts)
-    exists <- doesFileExist $ dir </> stackDotYaml
-    when (forceOverwrite initOpts || not exists) $ do
-      go <- view globalOptsL
-      initProject dir initOpts (globalResolver go)
-
--- | Display instructions for how to use templates
-templatesCmd :: () -> RIO Runner ()
-templatesCmd () = withConfig NoReexec templatesHelp
-
--- | Query build information
-queryCmd :: [String] -> RIO Runner ()
-queryCmd selectors = withConfig YesReexec $
-  withDefaultEnvConfig $ queryBuildInfo $ map T.pack selectors
-
--- | List packages
-listCmd :: [String] -> RIO Runner ()
-listCmd names = withConfig NoReexec $ do
-  mresolver <- view $ globalOptsL.to globalResolver
-  mSnapshot <- forM mresolver $ \resolver -> do
-    concrete <- makeConcreteResolver resolver
-    loc <- completeSnapshotLocation concrete
-    loadSnapshot loc
-  listPackages mSnapshot names
-
--- | generate a combined HPC report
-hpcReportCmd :: HpcReportOpts -> RIO Runner ()
-hpcReportCmd hropts = do
-  let (tixFiles, targetNames) = L.partition (".tix" `T.isSuffixOf`) (hroptsInputs hropts)
-      boptsCLI = defaultBuildOptsCLI
-        { boptsCLITargets = if hroptsAll hropts then [] else targetNames }
-  withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $
-      generateHpcReportForTargets hropts tixFiles targetNames
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE OverloadedStrings   #-}
+
+-- | Main Stack tool entry point.
+
+module Main (main) where
+
+import           BuildInfo ( versionString' )
+import           GHC.IO.Encoding ( mkTextEncoding, textEncodingName )
+import           Options.Applicative.Builder.Extra ( execExtraHelp )
+import           Stack.CLI ( commandLineHandler )
+import           Stack.Constants ( stackProgName )
+import           Stack.Docker ( dockerCmdName, dockerHelpOptName )
+import           Stack.Nix ( nixCmdName, nixHelpOptName )
+import           Stack.Options.DockerParser ( dockerOptsParser )
+import           Stack.Options.GlobalParser ( globalOptsFromMonoid )
+import           Stack.Options.NixParser ( nixOptsParser )
+import           Stack.Prelude
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withRunnerGlobal )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Runner ( Runner )
+import           Stack.Types.Version
+                   ( VersionCheck (..), checkVersion, showStackVersion
+                   , stackVersion
+                   )
+import           System.Directory ( getCurrentDirectory )
+import           System.Environment ( getArgs, getProgName )
+import           System.IO ( hGetEncoding, hPutStrLn, hSetEncoding )
+import           System.Terminal ( hIsTerminalDeviceOrMinTTY )
+
+-- | Type representing exceptions thrown by functions in the "Main" module.
+data MainException
+  = InvalidReExecVersion String String
+  deriving (Show, Typeable)
+
+instance Exception MainException where
+  displayException (InvalidReExecVersion expected actual) = concat
+    [ "Error: [S-2186]\n"
+    , "When re-executing '"
+    , stackProgName
+    , "' in a container, the incorrect version was found\nExpected: "
+    , expected
+    , "; found: "
+    , actual
+    ]
+
+main :: IO ()
+main = do
+  -- Line buffer the output by default, particularly for non-terminal runs.
+  -- See https://github.com/commercialhaskell/stack/pull/360
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stderr LineBuffering
+  hSetTranslit stdout
+  hSetTranslit stderr
+  args <- getArgs
+  progName <- getProgName
+  isTerminal <- hIsTerminalDeviceOrMinTTY stdout
+  execExtraHelp
+    args
+    dockerHelpOptName
+    (dockerOptsParser False)
+    ("Only showing --" ++ dockerCmdName ++ "* options.")
+  execExtraHelp
+    args
+    nixHelpOptName
+    (nixOptsParser False)
+    ("Only showing --" ++ nixCmdName ++ "* options.")
+  currentDir <- getCurrentDirectory
+  eGlobalRun <- try $ commandLineHandler currentDir progName False
+  case eGlobalRun of
+    Left (exitCode :: ExitCode) ->
+      throwIO exitCode
+    Right (globalMonoid, run) -> do
+      global <- globalOptsFromMonoid isTerminal globalMonoid
+      when (globalLogLevel global == LevelDebug) $
+        hPutStrLn stderr versionString'
+      case globalReExecVersion global of
+        Just expectVersion -> do
+          expectVersion' <- parseVersionThrowing expectVersion
+          unless (checkVersion MatchMinor expectVersion' stackVersion) $
+            throwIO $
+              InvalidReExecVersion expectVersion showStackVersion
+        _ -> pure ()
+      withRunnerGlobal global $ run `catches`
+        [ Handler handleExitCode
+        , Handler handlePrettyException
+        , Handler handlePantryException
+        , Handler handleSomeException
+        ]
+
+-- | Change the character encoding of the given Handle to transliterate on
+-- unsupported characters instead of throwing an exception
+hSetTranslit :: Handle -> IO ()
+hSetTranslit h = do
+  menc <- hGetEncoding h
+  case fmap textEncodingName menc of
+    Just name
+      | '/' `notElem` name -> do
+          enc' <- mkTextEncoding $ name ++ "//TRANSLIT"
+          hSetEncoding h enc'
+    _ -> pure ()
+
+-- | Handle ExitCode exceptions.
+handleExitCode :: ExitCode -> RIO Runner a
+handleExitCode = exitWith
+
+-- | Handle PrettyException exceptions.
+handlePrettyException :: PrettyException -> RIO Runner a
+handlePrettyException = handleAnyPrettyException
+
+-- | Handle (pretty) PantryException exceptions.
+handlePantryException :: PantryException -> RIO Runner a
+handlePantryException = handleAnyPrettyException
+
+-- | Handle any pretty exception.
+handleAnyPrettyException :: (Exception e, Pretty e) => e -> RIO Runner a
+handleAnyPrettyException e = do
+  -- The code below loads the entire Stack configuration, when all that is
+  -- needed are the Stack colours. A tailored approach may be better.
+  result <- tryAny $ withConfig NoReexec $ prettyError $ pretty e
+  case result of
+    -- Falls back to the command line's Stack colours if there is any error in
+    -- loading the entire Stack configuration.
+    Left _ -> prettyError $ pretty e
+    Right _ -> pure ()
+  exitFailure
+
+-- | Handle SomeException exceptions. This special handler stops "stack: " from
+-- being printed before the exception.
+handleSomeException :: SomeException -> RIO Runner a
+handleSomeException (SomeException e) = do
+  logError $ fromString $ displayException e
+  exitFailure
+ src/main/Stack/CLI.hs view
@@ -0,0 +1,684 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.CLI
+  ( commandLineHandler
+  ) where
+
+import           BuildInfo ( hpackVersion, versionString' )
+import           Data.Attoparsec.Interpreter ( getInterpreterArgs )
+import           Data.Char ( toLower )
+import qualified Data.List as L
+import           Options.Applicative
+                   ( Parser, ParserFailure, ParserHelp, ParserResult (..), flag
+                   , handleParseResult, help, helpError, idm, long, metavar
+                   , overFailure, renderFailure, strArgument, switch )
+import           Options.Applicative.Help ( errorHelp, stringChunk, vcatChunks )
+import           Options.Applicative.Builder.Extra
+                   ( boolFlags, extraHelpOption, textOption )
+import           Options.Applicative.Complicated
+                   ( addCommand, addSubCommands, complicatedOptions )
+import qualified RIO.Process ( exec )
+import           RIO.Process ( withProcessContextNoLogging )
+import           Stack.Build ( buildCmd )
+import           Stack.Clean ( CleanCommand (..), cleanCmd )
+import           Stack.ConfigCmd as ConfigCmd
+import           Stack.Constants ( globalFooter, osIsWindows, stackProgName )
+import           Stack.Coverage ( hpcReportCmd )
+import           Stack.Docker
+                   ( dockerCmdName, dockerHelpOptName, dockerPullCmdName )
+import           Stack.DockerCmd ( dockerPullCmd, dockerResetCmd )
+import qualified Stack.Dot ( dot )
+import           Stack.Exec ( SpecialExecCmd (..), execCmd )
+import           Stack.Eval ( evalCmd )
+import           Stack.Ghci ( ghciCmd )
+import           Stack.Hoogle ( hoogleCmd )
+import           Stack.IDE
+                   ( ListPackagesCmd (..), OutputStream (..), idePackagesCmd
+                   , ideTargetsCmd
+                   )
+import           Stack.Init ( initCmd )
+import           Stack.List ( listCmd )
+import           Stack.Ls ( lsCmd )
+import           Stack.New ( newCmd )
+import qualified Stack.Nix as Nix
+import           Stack.Options.BuildParser ( buildOptsParser )
+import           Stack.Options.CleanParser ( cleanOptsParser )
+import           Stack.Options.DotParser ( dotOptsParser )
+import           Stack.Options.EvalParser ( evalOptsParser )
+import           Stack.Options.ExecParser ( execOptsParser )
+import           Stack.Options.GhciParser ( ghciOptsParser )
+import           Stack.Options.GlobalParser ( globalOptsParser )
+import           Stack.Options.HpcReportParser ( hpcReportOptsParser )
+import           Stack.Options.InitParser ( initOptsParser )
+import           Stack.Options.LsParser ( lsOptsParser )
+import           Stack.Options.NewParser ( newOptsParser )
+import           Stack.Options.PathParser ( pathParser )
+import           Stack.Options.SDistParser ( sdistOptsParser )
+import           Stack.Options.ScriptParser ( scriptOptsParser )
+import           Stack.Options.SetupParser ( setupOptsParser )
+import           Stack.Options.UpgradeParser ( upgradeOptsParser )
+import           Stack.Options.UploadParser ( uploadOptsParser )
+import           Stack.Options.Utils ( GlobalOptsContext (..) )
+import qualified Stack.Path ( path )
+import           Stack.Prelude
+import           Stack.Query ( queryCmd )
+import           Stack.Runners
+                   ( ShouldReexec (..), withConfig, withDefaultEnvConfig )
+import           Stack.SDist ( sdistCmd )
+import           Stack.Script ( ScriptOpts (..), scriptCmd )
+import           Stack.SetupCmd ( setupCmd )
+import           Stack.Templates ( templatesCmd )
+import           Stack.Types.AddCommand ( AddCommand )
+import           Stack.Types.BuildOpts ( BuildCommand (..) )
+import           Stack.Types.GlobalOptsMonoid ( GlobalOptsMonoid (..) )
+import           Stack.Types.Runner ( Runner )
+import           Stack.Types.Version ( stackVersion )
+import           Stack.Uninstall ( uninstallCmd )
+import           Stack.Unpack ( unpackCmd )
+import           Stack.Update ( updateCmd )
+import           Stack.Upgrade ( upgradeCmd )
+import           Stack.Upload ( uploadCmd )
+import qualified System.Directory as D
+import           System.Environment ( getProgName, withArgs )
+import           System.FilePath ( pathSeparator, takeDirectory )
+
+commandLineHandler ::
+     FilePath
+  -> String
+  -> Bool
+  -> IO (GlobalOptsMonoid, RIO Runner ())
+commandLineHandler currentDir progName isInterpreter =
+  -- Append the relevant default (potentially affecting the LogLevel) *after*
+  -- appending the global options of the `stack` command to the global options
+  -- of the subcommand - see #5326.
+  first (<> defaultGlobalOpts) <$> complicatedOptions
+    stackVersion
+    (Just versionString')
+    hpackVersion
+    "stack - The Haskell Tool Stack"
+    ""
+    "Stack's documentation is available at https://docs.haskellstack.org/. \
+    \Command 'stack COMMAND --help' for help about a Stack command. Stack also \
+    \supports the Haskell Error Index at https://errors.haskell.org/."
+    (globalOpts OuterGlobalOpts)
+    (Just failureCallback)
+    addCommands
+ where
+  defaultGlobalOpts = if isInterpreter
+    then
+      -- Silent except when errors occur - see #2879
+      mempty { globalMonoidLogLevel = First (Just LevelError) }
+    else mempty
+  failureCallback f args =
+    case L.stripPrefix "Invalid argument" (fst (renderFailure f "")) of
+      Just _ -> if isInterpreter
+                  then parseResultHandler args f
+                  else secondaryCommandHandler args f
+                      >>= interpreterHandler currentDir args
+      Nothing -> parseResultHandler args f
+
+  parseResultHandler args f =
+    if isInterpreter
+    then do
+      let hlp = errorHelp $ stringChunk
+            (unwords ["Error executing interpreter command:"
+                      , progName
+                      , unwords args])
+      handleParseResult (overFailure (vcatErrorHelp hlp) (Failure f))
+    else handleParseResult (Failure f)
+
+  -- The order of commands below determines the order in which they are listed
+  -- in `stack --help`.
+  addCommands = do
+    unless isInterpreter $ do
+      build
+      install
+      uninstall
+      test
+      bench
+      haddock
+      new
+      templates
+      init
+      setup
+      path
+      ls
+      unpack
+      update
+      upgrade
+      upload
+      sdist
+      dot
+      ghc
+      hoogle
+    -- These are the only commands allowed in interpreter mode as well
+    exec
+    run
+    ghci
+    repl
+    runghc
+    runhaskell
+    script
+    unless isInterpreter $ do
+      eval
+      clean
+      purge
+      query
+      list
+      ide
+      docker
+      config
+      hpc
+
+  -- Stack's subcommands are listed below in alphabetical order
+
+  bench = addBuildCommand'
+    "bench"
+    "Shortcut for 'build --bench'."
+    buildCmd
+    (buildOptsParser Bench)
+
+  build = addBuildCommand'
+    "build"
+    "Build the package(s) in this directory/configuration."
+    buildCmd
+    (buildOptsParser Build)
+
+  clean = addCommand'
+    "clean"
+    "Delete build artefacts for the project packages."
+    cleanCmd
+    (cleanOptsParser Clean)
+
+  config = addSubCommands'
+      ConfigCmd.cfgCmdName
+        "Subcommands for accessing and modifying configuration values."
+        ( do
+            addCommand'
+              ConfigCmd.cfgCmdSetName
+              "Sets a key in YAML configuration file to value."
+              (withConfig NoReexec . cfgCmdSet)
+              configCmdSetParser
+            addCommand'
+              ConfigCmd.cfgCmdEnvName
+              "Print environment variables for use in a shell."
+              (withConfig YesReexec . withDefaultEnvConfig . cfgCmdEnv)
+              configCmdEnvParser
+        )
+
+  docker = addSubCommands'
+    dockerCmdName
+    "Subcommands specific to Docker use."
+    ( do
+        addCommand'
+          dockerPullCmdName
+          "Pull latest version of Docker image from registry."
+          dockerPullCmd
+          (pure ())
+        addCommand'
+          "reset"
+          "Reset the Docker sandbox."
+          dockerResetCmd
+          ( switch
+              (  long "keep-home"
+              <> help "Do not delete sandbox's home directory."
+              )
+          )
+    )
+
+  dot = addCommand'
+    "dot"
+    "Visualize your project's dependency graph using Graphviz dot."
+    Stack.Dot.dot
+    (dotOptsParser False) -- Default for --external is False.
+
+  eval = addCommand'
+    "eval"
+    "Evaluate some Haskell code inline. Shortcut for \
+    \'stack exec ghc -- -e CODE'."
+    evalCmd
+    (evalOptsParser "CODE")
+
+  exec = addCommand'
+    "exec"
+    "Execute a command. If the command is absent, the first of any arguments \
+    \is taken as the command."
+    execCmd
+    (execOptsParser Nothing)
+
+  ghc = addCommand'
+    "ghc"
+    "Run ghc."
+    execCmd
+    (execOptsParser $ Just ExecGhc)
+
+  ghci = addGhciCommand'
+    "ghci"
+    "Run ghci in the context of package(s)."
+    ghciCmd
+    ghciOptsParser
+
+  haddock = addBuildCommand'
+    "haddock"
+    "Shortcut for 'build --haddock'."
+    buildCmd
+    (buildOptsParser Haddock)
+
+  hoogle = addCommand'
+    "hoogle"
+    "Run hoogle, the Haskell API search engine. Use the '-- ARGUMENT(S)' \
+    \syntax to pass Hoogle arguments, e.g. 'stack hoogle -- --count=20', \
+    \or 'stack hoogle -- server --local'."
+    hoogleCmd
+    ( (,,,)
+        <$> many (strArgument
+              ( metavar "-- ARGUMENT(S) (e.g. 'stack hoogle -- server --local')"
+              ))
+        <*> boolFlags
+              True
+              "setup"
+              "If needed: install Hoogle, build Haddock documentation and \
+              \generate a Hoogle database."
+              idm
+        <*> switch
+              (  long "rebuild"
+              <> help "Rebuild the Hoogle database."
+              )
+        <*> switch
+              (  long "server"
+              <> help "Start local Hoogle server."
+              )
+      )
+
+  hpc = addSubCommands'
+    "hpc"
+    "Subcommands specific to Haskell Program Coverage."
+    ( addCommand'
+        "report"
+        "Generate unified HPC coverage report from tix files and project \
+        \targets."
+        hpcReportCmd
+        hpcReportOptsParser
+    )
+
+  ide = addSubCommands'
+    "ide"
+    "IDE-specific commands."
+    ( let outputFlag = flag
+            OutputLogInfo
+            OutputStdout
+            (  long "stdout"
+            <> help "Send output to the standard output stream instead of the \
+                    \default, the standard error stream."
+            )
+          cabalFileFlag = flag
+            ListPackageNames
+            ListPackageCabalFiles
+            (  long "cabal-files"
+            <> help "Print paths to package Cabal files instead of package \
+                    \names."
+            )
+       in  do
+             addCommand'
+               "packages"
+               "List all available local loadable packages."
+               idePackagesCmd
+               ((,) <$> outputFlag <*> cabalFileFlag)
+             addCommand'
+               "targets"
+               "List all available Stack targets."
+               ideTargetsCmd
+               outputFlag
+    )
+
+  init = addCommand'
+    "init"
+    "Create Stack project configuration from Cabal or Hpack package \
+    \specifications."
+    initCmd
+    initOptsParser
+
+  install = addBuildCommand'
+    "install"
+    "Shortcut for 'build --copy-bins'."
+    buildCmd
+    (buildOptsParser Install)
+
+  list = addCommand'
+    "list"
+    "List package id's in snapshot (experimental)."
+    listCmd
+    (many $ strArgument $ metavar "PACKAGE")
+
+  ls = addCommand'
+    "ls"
+    "List command. (Supports snapshots, dependencies, Stack's styles and \
+    \installed tools.)"
+    lsCmd
+    lsOptsParser
+
+  new = addCommand'
+    "new"
+    "Create a new project from a template. Run 'stack templates' to see \
+    \available templates. Will also initialise if there is no stack.yaml \
+    \file. Note: you can also specify a local file or a remote URL as a \
+    \template; or force an initialisation."
+    newCmd
+    newOptsParser
+
+  path = addCommand'
+    "path"
+    "Print out handy path information."
+    Stack.Path.path
+    pathParser
+
+  purge = addCommand'
+    "purge"
+    "Delete the project Stack working directories (.stack-work by \
+    \default). Shortcut for 'stack clean --full'."
+    cleanCmd
+    (cleanOptsParser Purge)
+
+  query = addCommand'
+    "query"
+    "Query general build information (experimental)."
+    queryCmd
+    (many $ strArgument $ metavar "SELECTOR...")
+
+  repl = addGhciCommand'
+    "repl"
+    "Run ghci in the context of package(s) (alias for 'ghci')."
+    ghciCmd
+    ghciOptsParser
+
+  run = addCommand'
+    "run"
+    "Build and run an executable. Defaults to the first available \
+    \executable if none is provided as the first argument."
+    execCmd
+    (execOptsParser $ Just ExecRun)
+
+  runghc = addCommand'
+    "runghc"
+    "Run runghc."
+    execCmd
+    (execOptsParser $ Just ExecRunGhc)
+
+  runhaskell = addCommand'
+    "runhaskell"
+    "Run runghc (alias for 'runghc')."
+    execCmd
+    (execOptsParser $ Just ExecRunGhc)
+
+  script = addCommand
+    "script"
+    "Run a Stack script."
+    globalFooter
+    scriptCmd
+    ( \so gom ->
+        gom
+          { globalMonoidResolverRoot =
+              First $ Just $ takeDirectory $ soFile so
+          }
+    )
+    (globalOpts OtherCmdGlobalOpts)
+    scriptOptsParser
+
+  sdist = addCommand'
+    "sdist"
+    "Create source distribution tarballs."
+    sdistCmd
+    sdistOptsParser
+
+  setup = addCommand'
+    "setup"
+    "Get the appropriate GHC for your project."
+    setupCmd
+    setupOptsParser
+
+  templates = addCommand'
+    "templates"
+    "Show how to find templates available for 'stack new'. 'stack new' \
+    \can accept a template from a remote repository (default: github), \
+    \local file or remote URL. Note: this downloads the help file."
+    templatesCmd
+    (pure ())
+
+  test = addBuildCommand'
+    "test"
+    "Shortcut for 'build --test'."
+    buildCmd
+    (buildOptsParser Test)
+
+  uninstall = addCommand'
+    "uninstall"
+    "Show how to uninstall Stack or a Stack-supplied tool. This command does \
+    \not itself uninstall Stack or a Stack-supplied tool."
+    uninstallCmd
+    (pure ())
+
+  unpack = addCommand'
+    "unpack"
+    "Unpack one or more packages locally."
+    unpackCmd
+    ( (,)
+        <$> some (strArgument $ metavar "PACKAGE")
+        <*> optional (textOption
+              (  long "to"
+              <> help "Optional path to unpack the package into (will \
+                      \unpack into subdirectory)."
+              ))
+    )
+
+  update = addCommand'
+    "update"
+    "Update the package index."
+    updateCmd
+    (pure ())
+
+  upgrade = addCommand''
+    "upgrade"
+    "Upgrade Stack, installing to Stack's local-bin directory and, if \
+    \different and permitted, the directory of the current Stack \
+    \executable."
+    upgradeCmd
+    "Warning: if you use GHCup to install Stack, use only GHCup to \
+    \upgrade Stack."
+    (upgradeOptsParser onlyLocalBins)
+   where
+    onlyLocalBins =
+         (lowercase progName /= lowercase stackProgName)
+      && not ( osIsWindows
+             && lowercase progName == lowercase (stackProgName <> ".EXE")
+             )
+    lowercase = map toLower
+
+  upload = addCommand'
+    "upload"
+    "Upload a package to Hackage."
+    uploadCmd
+    uploadOptsParser
+
+  -- addCommand hiding global options
+  addCommand' ::
+       String
+    -> String
+    -> (a -> RIO Runner ())
+    -> Parser a
+    -> AddCommand
+  addCommand' cmd title constr =
+    addCommand
+      cmd
+      title
+      globalFooter
+      constr
+      (\_ gom -> gom)
+      (globalOpts OtherCmdGlobalOpts)
+
+  -- addCommand with custom footer hiding global options
+  addCommand'' ::
+       String
+    -> String
+    -> (a -> RIO Runner ())
+    -> String
+    -> Parser a
+    -> AddCommand
+  addCommand'' cmd title constr cmdFooter =
+    addCommand
+      cmd
+      title
+      (globalFooter <> " " <> cmdFooter)
+      constr
+      (\_ gom -> gom)
+      (globalOpts OtherCmdGlobalOpts)
+
+  addSubCommands' ::
+       String
+    -> String
+    -> AddCommand
+    -> AddCommand
+  addSubCommands' cmd title =
+    addSubCommands
+      cmd
+      title
+      globalFooter
+      (globalOpts OtherCmdGlobalOpts)
+
+  -- Additional helper that hides global options and shows build options
+  addBuildCommand' ::
+       String
+    -> String
+    -> (a -> RIO Runner ())
+    -> Parser a
+    -> AddCommand
+  addBuildCommand' cmd title constr =
+      addCommand
+        cmd
+        title
+        globalFooter
+        constr
+        (\_ gom -> gom)
+        (globalOpts BuildCmdGlobalOpts)
+
+  -- Additional helper that hides global options and shows some ghci options
+  addGhciCommand' ::
+       String
+    -> String
+    -> (a -> RIO Runner ())
+    -> Parser a
+    -> AddCommand
+  addGhciCommand' cmd title constr =
+      addCommand
+        cmd
+        title
+        globalFooter
+        constr
+        (\_ gom -> gom)
+        (globalOpts GhciCmdGlobalOpts)
+
+  globalOpts :: GlobalOptsContext -> Parser GlobalOptsMonoid
+  globalOpts kind =
+        extraHelpOption
+          hide
+          progName
+          (dockerCmdName ++ "*")
+          dockerHelpOptName
+    <*> extraHelpOption
+          hide
+          progName
+          (Nix.nixCmdName ++ "*")
+          Nix.nixHelpOptName
+    <*> globalOptsParser currentDir kind
+   where
+    hide = kind /= OuterGlobalOpts
+
+-- | fall-through to external executables in `git` style if they exist
+-- (i.e. `stack something` looks for `stack-something` before
+-- failing with "Invalid argument `something'")
+secondaryCommandHandler ::
+     [String]
+  -> ParserFailure ParserHelp
+  -> IO (ParserFailure ParserHelp)
+secondaryCommandHandler args f =
+  -- don't even try when the argument looks like a path or flag
+  if elem pathSeparator cmd || "-" `L.isPrefixOf` L.head args
+     then pure f
+  else do
+    mExternalExec <- D.findExecutable cmd
+    case mExternalExec of
+      Just ex -> withProcessContextNoLogging $ do
+        -- TODO show the command in verbose mode
+        -- hPutStrLn stderr $ unwords $
+        --   ["Running", "[" ++ ex, unwords (tail args) ++ "]"]
+        _ <- RIO.Process.exec ex (L.tail args)
+        pure f
+      Nothing -> pure $ fmap (vcatErrorHelp (noSuchCmd cmd)) f
+ where
+  -- FIXME this is broken when any options are specified before the command
+  -- e.g. stack --verbosity silent cmd
+  cmd = stackProgName ++ "-" ++ L.head args
+  noSuchCmd name = errorHelp $ stringChunk
+    ("Auxiliary command not found in path '" ++ name ++ "'.")
+
+interpreterHandler ::
+     Monoid t
+  => FilePath
+  -> [String]
+  -> ParserFailure ParserHelp
+  -> IO (GlobalOptsMonoid, (RIO Runner (), t))
+interpreterHandler currentDir args f = do
+  -- args can include top-level config such as --extra-lib-dirs=... (set by
+  -- nix-shell) - we need to find the first argument which is a file, everything
+  -- afterwards is an argument to the script, everything before is an argument
+  -- to Stack
+  (stackArgs, fileArgs) <- spanM (fmap not . D.doesFileExist) args
+  case fileArgs of
+    (file:fileArgs') -> runInterpreterCommand file stackArgs fileArgs'
+    [] -> parseResultHandler (errorCombine (noSuchFile firstArg))
+ where
+  firstArg = L.head args
+
+  spanM _ [] = pure ([], [])
+  spanM p xs@(x:xs') = do
+    r <- p x
+    if r
+    then do
+      (ys, zs) <- spanM p xs'
+      pure (x:ys, zs)
+    else
+      pure ([], xs)
+
+  -- if the first argument contains a path separator then it might be a file,
+  -- or a Stack option referencing a file. In that case we only show the
+  -- interpreter error message and exclude the command related error messages.
+  errorCombine =
+    if pathSeparator `elem` firstArg
+    then overrideErrorHelp
+    else vcatErrorHelp
+
+  overrideErrorHelp h1 h2 = h2 { helpError = helpError h1 }
+
+  parseResultHandler fn = handleParseResult (overFailure fn (Failure f))
+  noSuchFile name = errorHelp $ stringChunk
+    ("File does not exist or is not a regular file '" ++ name ++ "'.")
+
+  runInterpreterCommand path stackArgs fileArgs = do
+    progName <- getProgName
+    iargs <- getInterpreterArgs path
+    let parseCmdLine = commandLineHandler currentDir progName True
+        -- Implicit file arguments are put before other arguments that
+        -- occur after "--". See #3658
+        cmdArgs = stackArgs ++ case break (== "--") iargs of
+          (beforeSep, []) -> beforeSep ++ ["--"] ++ [path] ++ fileArgs
+          (beforeSep, optSep : afterSep) ->
+            beforeSep ++ [optSep] ++ [path] ++ fileArgs ++ afterSep
+     -- TODO show the command in verbose mode
+     -- hPutStrLn stderr $ unwords $
+     --   ["Running", "[" ++ progName, unwords cmdArgs ++ "]"]
+    (a,b) <- withArgs cmdArgs parseCmdLine
+    pure (a,(b,mempty))
+
+-- Vertically combine only the error component of the first argument with the
+-- error component of the second.
+vcatErrorHelp :: ParserHelp -> ParserHelp -> ParserHelp
+vcatErrorHelp h1 h2 = h2 { helpError = vcatChunks [helpError h2, helpError h1] }
src/setup-shim/StackSetupShim.hs view
@@ -2,10 +2,14 @@ {-# LANGUAGE PackageImports #-}
 module StackSetupShim where
 import Main
+#if defined(MIN_VERSION_Cabal)
 #if MIN_VERSION_Cabal(3,8,1)
 import Distribution.PackageDescription (PackageDescription, emptyHookedBuildInfo)
 #else
 import "Cabal" Distribution.PackageDescription (PackageDescription, emptyHookedBuildInfo)
+#endif
+#else
+import Distribution.PackageDescription (PackageDescription, emptyHookedBuildInfo)
 #endif
 import Distribution.Simple
 import Distribution.Simple.Build
src/test/Spec.hs view
@@ -1,1 +1,2 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+{-# OPTIONS_GHC -F -pgmF hspec-discover   #-}
src/test/Stack/ArgsSpec.hs view
@@ -2,16 +2,21 @@ 
 -- | Args parser test suite.
 
-module Stack.ArgsSpec where
+module Stack.ArgsSpec
+  ( spec
+  , argsSpec
+  , argsInputOutput
+  , interpreterArgsSpec
+  ) where
 
-import           Control.Monad
 import           Data.Attoparsec.Args ( EscapingMode (..), parseArgsFromString )
 import           Data.Attoparsec.Interpreter ( interpreterArgsParser )
 import qualified Data.Attoparsec.Text as P
 import           Data.Text ( pack )
-import           Stack.Prelude
-import           Test.Hspec
 import           Prelude ( head )
+import           Stack.Constants ( stackProgName )
+import           Stack.Prelude
+import           Test.Hspec ( Spec, describe, it )
 
 -- | Test spec.
 spec :: Spec
@@ -129,15 +134,15 @@         -- just chop the closing chars from a valid block comment
         <|> shebang
             <++> ["\n"]
-            <++> let
-                    c = head (blockComment args)
-                    l = length c - 2
-                 in [assert (drop l c == "-}") (take l c)]
+            <++> let c = head (blockComment args)
+                     l = length c - 2
+                 in  [assert (drop l c == "-}") (take l c)]
         -- nested block comment
         <|> shebang
             <++> ["\n"]
             <++> [head (blockComment "--x {- nested -} --y")]
-        where args = " --x --y"
+       where
+        args = " --x --y"
       (<++>) = liftA2 (++)
 
       -- Generative grammar for the interpreter comments
@@ -150,17 +155,19 @@       -- A command starts with zero or more whitespace followed by "stack"
       makeComment maker space args =
         let makePrefix s = (s <|> [""]) <++> [stackProgName]
-        in (maker <$> (makePrefix space <++> [args])) <++> postComment
+        in  (maker <$> (makePrefix space <++> [args])) <++> postComment
 
       lineSpace = [" "] <|> ["\t"]
       lineComment = makeComment makeLine lineSpace
-        where makeLine s = "--" ++ s
+       where
+        makeLine s = "--" ++ s
 
       literateLineComment = makeComment ("> --" ++) lineSpace
 
       blockSpace = lineSpace <|> newLine
       blockComment = makeComment makeBlock blockSpace
-        where makeBlock s = "{-" ++ s ++ "-}"
+       where
+        makeBlock s = "{-" ++ s ++ "-}"
 
       literateBlockComment = makeComment
         (\s -> "> {-" ++ s ++ "-}")
src/test/Stack/Build/ExecuteSpec.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
-module Stack.Build.ExecuteSpec (main, spec) where
+module Stack.Build.ExecuteSpec
+  ( main
+  , spec
+  ) where
 
 import Stack.Prelude
 import Test.Hspec
src/test/Stack/Build/TargetSpec.hs view
@@ -1,7 +1,10 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Stack.Build.TargetSpec (main, spec) where
+module Stack.Build.TargetSpec
+  ( main
+  , spec
+  ) where
 
 import qualified Data.Text           as T
 import           Distribution.Types.PackageName (mkPackageName)
src/test/Stack/Config/DockerSpec.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Stack.Config.DockerSpec (spec) where
+module Stack.Config.DockerSpec
+  ( spec
+  ) where
 
 import Test.Hspec
 import Stack.Prelude
src/test/Stack/ConfigSpec.hs view
@@ -1,26 +1,53 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
-module Stack.ConfigSpec where
+module Stack.ConfigSpec
+  ( sampleConfig
+  , buildOptsConfig
+  , hpackConfig
+  , resolverConfig
+  , snapshotConfig
+  , resolverSnapshotConfig
+  , stackDotYaml
+  , setup
+  , noException
+  , spec
+  ) where
 
-import Control.Arrow
-import Distribution.Verbosity (verbose)
-import Pantry.Internal.AesonExtended
-import Data.Yaml
-import Pantry.Internal (pcHpackExecutable)
-import Path
-import Path.IO hiding (withSystemTempDir)
-import Stack.Config
-import Stack.Prelude
-import Stack.Runners
-import Stack.Types.Config
-import Stack.Options.GlobalParser (globalOptsFromMonoid)
-import System.Directory
-import System.Environment
-import System.IO (writeFile)
-import Test.Hspec
+import           Control.Arrow ( left )
+import           Data.Yaml ( decodeEither', parseEither )
+import           Distribution.Verbosity ( verbose )
+import           Pantry.Internal ( pcHpackExecutable )
+import           Pantry.Internal.AesonExtended
+import           Path ( (</>), parent, parseAbsDir, parseRelDir, parseRelFile )
+import           Path.IO hiding ( withSystemTempDir )
+import           Stack.Config (defaultConfigYaml, loadConfig, loadConfigYaml )
+import           Stack.Options.GlobalParser ( globalOptsFromMonoid )
+import           Stack.Prelude
+import           Stack.Runners ( withBuildConfig, withRunnerGlobal )
+import           Stack.Types.BuildConfig ( BuildConfig (..), projectRootL )
+import           Stack.Types.BuildOpts
+                   ( BenchmarkOpts (..), BuildOpts (..), CabalVerbosity (..)
+                   , TestOpts (..)
+                   )
+import           Stack.Types.Config ( Config (..) )
+import           Stack.Types.ConfigMonoid
+                   ( ConfigMonoid (..), parseConfigMonoid )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectAndConfigMonoid
+                   ( ProjectAndConfigMonoid (..), parseProjectAndConfigMonoid )
+import           System.Directory
+                   ( createDirectory, createDirectoryIfMissing
+                   , getCurrentDirectory, setCurrentDirectory
+                   )
+import           System.Environment ( lookupEnv, setEnv, unsetEnv )
+import           System.IO ( writeFile )
+import           Test.Hspec
+                   ( Selector, Spec, anyException, beforeAll, describe, example
+                   , it, shouldBe, shouldThrow
+                   )
 
 sampleConfig :: String
 sampleConfig =
src/test/Stack/DotSpec.hs view
@@ -1,22 +1,25 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
 
 -- | Test suite for Stack.Dot
-module Stack.DotSpec where
+module Stack.DotSpec
+  ( dummyPayload
+  , spec
+  , sublistOf
+  , pkgName
+  , stubLoader
+  ) where
 
-import           Data.Functor.Identity
 import           Data.List ((\\))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import           Distribution.License (License (BSD3))
+import           Distribution.License ( License (BSD3) )
 import qualified RIO.Text as T
-import           Stack.Prelude hiding (pkgName)
-import           Test.Hspec
-import           Test.Hspec.QuickCheck (prop)
-import           Test.QuickCheck (forAll,choose,Gen)
-
-import           Stack.Dot
+import           Stack.Dot ( DotPayload (..), pruneGraph, resolveDependencies )
+import           Stack.Prelude hiding ( pkgName )
+import           Test.Hspec ( Spec, describe, it, shouldBe )
+import           Test.Hspec.QuickCheck ( prop )
+import           Test.QuickCheck ( Gen, choose, forAll )
 
 dummyPayload :: DotPayload
 dummyPayload = DotPayload (parseVersion "0.0.0.0") (Just (Right BSD3)) Nothing
@@ -56,7 +59,7 @@           allPackages g = Map.keysSet g `Set.union` foldMap fst g
       forAll (sublistOf (Set.toList (allPackages resolvedGraph))) $ \toPrune ->
         let pruned = pruneGraph [pkgName "one", pkgName "two"] toPrune resolvedGraph
-        in Set.null (allPackages pruned `Set.intersection` Set.fromList toPrune)
+        in  Set.null (allPackages pruned `Set.intersection` Set.fromList toPrune)
 
     prop "pruning removes orphans" $ do
       let resolvedGraph = runIdentity (resolveDependencies Nothing graph stubLoader)
@@ -64,7 +67,7 @@           orphans g = Map.filterWithKey (\k _ -> not (graphElem k g)) g
       forAll (sublistOf (Set.toList (allPackages resolvedGraph))) $ \toPrune ->
         let pruned = pruneGraph [pkgName "one", pkgName "two"] toPrune resolvedGraph
-        in null (Map.keys (orphans (fmap fst pruned)) \\ [pkgName "one", pkgName "two"])
+        in  null (Map.keys (orphans (fmap fst pruned)) \\ [pkgName "one", pkgName "two"])
 
 {- Helper functions below -}
 -- Backport from QuickCheck 2.8 to 2.7.6
@@ -79,43 +82,53 @@ 
 -- Stub, simulates the function to load package dependencies
 stubLoader :: PackageName -> Identity (Set PackageName, DotPayload)
-stubLoader name = pure . (, dummyPayload) . Set.fromList . map pkgName $ case show name of
-  "StateVar" -> ["stm","transformers"]
-  "array" -> []
-  "bifunctors" -> ["semigroupoids","semigroups","tagged"]
-  "binary" -> ["array","bytestring","containers"]
-  "bytestring" -> ["deepseq","ghc-prim","integer-gmp"]
-  "comonad" -> ["containers","contravariant","distributive"
-               ,"semigroups","tagged","transformers","transformers-compat"
-               ]
-  "cont" -> ["StateVar","semigroups","transformers","transformers-compat","void"]
-  "containers" -> ["array","deepseq","ghc-prim"]
-  "deepseq" -> ["array"]
-  "distributive" -> ["ghc-prim","tagged","transformers","transformers-compat"]
-  "free" -> ["bifunctors","comonad","distributive","mtl"
-            ,"prelude-extras","profunctors","semigroupoids"
-            ,"semigroups","template-haskell","transformers"
-            ]
-  "ghc" -> []
-  "hashable" -> ["bytestring","ghc-prim","integer-gmp","text"]
-  "integer" -> []
-  "mtl" -> ["transformers"]
-  "nats" -> []
-  "one" -> ["free"]
-  "prelude" -> []
-  "profunctors" -> ["comonad","distributive","semigroupoids","tagged","transformers"]
-  "semigroupoids" -> ["comonad","containers","contravariant","distributive"
-                     ,"semigroups","transformers","transformers-compat"
+stubLoader name = pure $ (, dummyPayload) . Set.fromList . map pkgName $
+  case show name of
+    "StateVar" -> ["stm", "transformers"]
+    "array" -> []
+    "bifunctors" -> ["semigroupoids", "semigroups", "tagged"]
+    "binary" -> ["array", "bytestring", "containers"]
+    "bytestring" -> ["deepseq", "ghc-prim", "integer-gmp"]
+    "comonad" -> [ "containers", "contravariant", "distributive", "semigroups"
+                 , "tagged","transformers","transformers-compat"
+                 ]
+    "cont" -> [ "StateVar", "semigroups", "transformers", "transformers-compat"
+              , "void"
+              ]
+    "containers" -> ["array", "deepseq", "ghc-prim"]
+    "deepseq" -> ["array"]
+    "distributive" -> [ "ghc-prim", "tagged", "transformers"
+                      , "transformers-compat"
+                      ]
+    "free" -> [ "bifunctors", "comonad", "distributive", "mtl", "prelude-extras"
+              , "profunctors", "semigroupoids", "semigroups", "template-haskell"
+              , "transformers"
+              ]
+    "ghc" -> []
+    "hashable" -> ["bytestring", "ghc-prim", "integer-gmp", "text"]
+    "integer" -> []
+    "mtl" -> ["transformers"]
+    "nats" -> []
+    "one" -> ["free"]
+    "prelude" -> []
+    "profunctors" -> [ "comonad", "distributive", "semigroupoids", "tagged"
+                     , "transformers"
                      ]
-  "semigroups" -> ["bytestring","containers","deepseq","hashable"
-                  ,"nats","text","unordered-containers"
-                  ]
-  "stm" -> ["array"]
-  "tagged" -> ["template-haskell"]
-  "template" -> []
-  "text" -> ["array","binary","bytestring","deepseq","ghc-prim","integer-gmp"]
-  "transformers" -> []
-  "two" -> ["free","mtl","one","transformers"]
-  "unordered" -> ["deepseq","hashable"]
-  "void" -> ["ghc-prim","hashable","semigroups"]
-  _ -> []
+    "semigroupoids" -> [ "comonad", "containers", "contravariant"
+                       , "distributive", "semigroups", "transformers"
+                       , "transformers-compat"
+                       ]
+    "semigroups" -> [ "bytestring", "containers", "deepseq", "hashable", "nats"
+                    , "text", "unordered-containers"
+                    ]
+    "stm" -> ["array"]
+    "tagged" -> ["template-haskell"]
+    "template" -> []
+    "text" -> [ "array", "binary", "bytestring", "deepseq", "ghc-prim"
+              , "integer-gmp"
+              ]
+    "transformers" -> []
+    "two" -> ["free", "mtl", "one", "transformers"]
+    "unordered" -> ["deepseq", "hashable"]
+    "void" -> ["ghc-prim", "hashable", "semigroups"]
+    _ -> []
− src/test/Stack/Ghci/PortableFakePaths.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE CPP #-}
-
--- | Helpers for writing fake paths for test suite for the GhciScript DSL.
--- This must be a separate module because it is used in Template Haskell splices.
-module Stack.Ghci.PortableFakePaths where
-
-defaultDrive :: FilePath
-#ifdef WINDOWS
-defaultDrive = "C:\\"
-#else
-defaultDrive = "/"
-#endif
src/test/Stack/Ghci/ScriptSpec.hs view
@@ -4,13 +4,15 @@ {-# LANGUAGE TemplateHaskell   #-}
 
 -- | Test suite for the GhciScript DSL
-module Stack.Ghci.ScriptSpec where
+module Stack.Ghci.ScriptSpec
+  ( spec
+  ) where
 
 import qualified Data.Set as S
 import           Distribution.ModuleName
 import           Test.Hspec
 import qualified System.FilePath as FP
-import           Stack.Ghci.PortableFakePaths
+import           Stack.Ghci.FakePaths
 import           Stack.Prelude hiding (fromString)
 import           Path
 import           Path.Extra (pathToLazyByteString)
src/test/Stack/GhciSpec.hs view
@@ -3,9 +3,11 @@ -- {-# LANGUAGE TemplateHaskell #-}
 
 -- | Test suite for GHCi like applications including both GHCi and Intero.
-module Stack.GhciSpec where
+module Stack.GhciSpec
+  ( spec
+  ) where
 
-import Test.Hspec
+import           Test.Hspec ( Spec )
 
 spec :: Spec
 spec = pure ()
src/test/Stack/LockSpec.hs view
@@ -1,19 +1,29 @@ {-# LANGUAGE QuasiQuotes         #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
-module Stack.LockSpec where
+module Stack.LockSpec
+  ( toBlobKey
+  , decodeSHA
+  , decodeLocked
+  , spec
+  ) where
 
-import           Pantry.Internal.AesonExtended ( WithJSONWarnings (..) )
 import qualified Data.Yaml as Yaml
 import           Distribution.Types.PackageName ( mkPackageName )
 import           Distribution.Types.Version ( mkVersion )
 import           Pantry
+                   ( BlobKey (..), FileSize (..), PackageIdentifier (..)
+                   , PackageLocationImmutable (..), PackageMetadata (..)
+                   , RawPackageLocationImmutable (..), RawPackageMetadata (..)
+                   , Repo (..), RepoType (..), SHA256, TreeKey (..)
+                   , resolvePaths
+                   )
+import           Pantry.Internal.AesonExtended ( WithJSONWarnings (..) )
 import qualified Pantry.SHA256 as SHA256
-import           RIO
-import           Stack.Lock
-import           Test.Hspec
-import           Text.RawString.QQ
+import           RIO ( ByteString, displayException, throwIO, unless )
+import           Stack.Lock ( Locked (..), LockedLocation (..) )
+import           Test.Hspec ( Spec, it, shouldBe )
+import           Text.RawString.QQ ( r )
 
 toBlobKey :: ByteString -> Word -> BlobKey
 toBlobKey string size = BlobKey (decodeSHA string) (FileSize size)
src/test/Stack/NixSpec.hs view
@@ -1,25 +1,32 @@ {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Stack.NixSpec where
+module Stack.NixSpec
+  ( sampleConfigNixEnabled
+  , sampleConfigNixDisabled
+  , setup
+  , spec
+  ) where
 
-import Data.Maybe (fromJust)
-import Options.Applicative
-import Path
-import Prelude (writeFile)
-import Stack.Config
-import Stack.Config.Nix
-import Stack.Constants
-import Stack.Options.GlobalParser (globalOptsFromMonoid)
-import Stack.Options.NixParser
-import Stack.Prelude
-import Stack.Runners
-import Stack.Types.Config
-import Stack.Types.Nix
-import System.Directory
-import System.Environment
-import Test.Hspec
+import           Data.Maybe ( fromJust )
+import           Options.Applicative
+                   ( defaultPrefs, execParserPure, getParseResult, info )
+import           Prelude ( writeFile )
+import           Stack.Config ( loadConfig )
+import           Stack.Config.Nix ( nixCompiler )
+import           Stack.Constants ( osIsWindows, stackDotYaml )
+import           Stack.Options.GlobalParser ( globalOptsFromMonoid )
+import           Stack.Options.NixParser ( nixOptsParser )
+import           Stack.Prelude
+import           Stack.Runners ( withRunnerGlobal )
+import           Stack.Types.Config ( Config (..) )
+import           Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
+import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.GlobalOptsMonoid ( GlobalOptsMonoid (..) )
+import           Stack.Types.Nix ( NixOpts (..) )
+import           System.Directory ( getCurrentDirectory, setCurrentDirectory )
+import           System.Environment ( unsetEnv )
+import           Test.Hspec ( Spec, around_, beforeAll, describe, it, shouldBe )
 
 sampleConfigNixEnabled :: String
 sampleConfigNixEnabled =
src/test/Stack/PackageDumpSpec.hs view
@@ -1,10 +1,15 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
 
-module Stack.PackageDumpSpec where
+module Stack.PackageDumpSpec
+  ( main
+  , spec
+  , bestPrune
+  , checkDepsPresent
+  , runEnvNoLogging
+  ) where
 
-import           Conduit
+import           Conduit ( withSourceFile, yield )
 import qualified Data.Conduit.List as CL
 import           Data.Conduit.Text ( decodeUtf8 )
 import qualified Data.Map as Map
@@ -13,13 +18,21 @@ import           Distribution.Types.PackageName ( mkPackageName )
 import           Distribution.Version ( mkVersion )
 import           Path ( parseAbsFile )
+import           RIO.PrettyPrint.Simple ( SimplePrettyApp, mkSimplePrettyApp )
+import           RIO.Process
+                   ( envVarsL, findExecutable, mkDefaultProcessContext
+                   , mkProcessContext
+                   )
 import           Stack.PackageDump
+                   ( DumpPackage (..), conduitDumpPackage, eachPair
+                   , eachSection, ghcPkgDump, pruneDeps, sinkMatching
+                   )
 import           Stack.Prelude
-import           Stack.Types.Config
-import           Stack.Types.GhcPkgId
-import           RIO.Process
+import           Stack.Types.CompilerPaths ( GhcPkgExe (..) )
+import           Stack.Types.GhcPkgId ( parseGhcPkgId )
 import           Test.Hspec
-import           Test.Hspec.QuickCheck
+                   ( Spec, describe, hspec, it, shouldBe )
+import           Test.Hspec.QuickCheck ( prop )
 
 main :: IO ()
 main = hspec spec
@@ -240,7 +253,7 @@         prop "invariant holds" $ \prunes' ->
             -- Force uniqueness
             let prunes = Map.toList $ Map.fromList prunes'
-             in checkDepsPresent prunes $ fst <$> pruneDeps fst fst snd bestPrune prunes
+            in  checkDepsPresent prunes $ fst <$> pruneDeps fst fst snd bestPrune prunes
 
 type PruneCheck = ((Int, Char), [(Int, Char)])
 
@@ -261,10 +274,11 @@             Nothing -> error "checkDepsPresent: missing in depMap"
             Just deps -> Set.null $ Set.difference (Set.fromList deps) allIds
 
-runEnvNoLogging :: (GhcPkgExe -> RIO LoggedProcessContext a) -> IO a
+runEnvNoLogging :: (GhcPkgExe -> RIO SimplePrettyApp a) -> IO a
 runEnvNoLogging inner = do
   envVars <- view envVarsL <$> mkDefaultProcessContext
   menv <- mkProcessContext $ Map.delete "GHC_PACKAGE_PATH" envVars
   let find name = runRIO menv (findExecutable name) >>= either throwIO parseAbsFile
   pkg <- GhcPkgExe <$> find "ghc-pkg"
-  runRIO (LoggedProcessContext menv mempty) (inner pkg)
+  app <- mkSimplePrettyApp mempty (Just menv) True 80 mempty
+  runRIO app (inner pkg)
src/test/Stack/Types/TemplateNameSpec.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-}
 
-module Stack.Types.TemplateNameSpec where
+module Stack.Types.TemplateNameSpec
+  ( spec
+  ) where
 
 import Stack.Types.TemplateName
 import Path.Internal
src/test/Stack/UploadSpec.hs view
@@ -1,17 +1,27 @@ {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Stack.UploadSpec (spec) where
+module Stack.UploadSpec
+  ( spec
+  ) where
 
-import RIO
-import RIO.Directory
-import RIO.FilePath ((</>))
-import Stack.Upload
-import Test.Hspec
-import System.Permissions (osIsWindows)
-import System.PosixCompat.Files (getFileStatus, fileMode)
-import System.Environment (setEnv, unsetEnv)
-import Data.Bits ((.&.))
+import           Data.Bits ((.&.))
+import           RIO
+                   ( Bool (..), IO, IsString, Maybe (..), String, ($), finally
+                   , readFileBinary, replicateM_, runRIO, unless
+                   , withSystemTempDirectory
+                   )
+import           RIO.Directory
+                   ( emptyPermissions, getPermissions, setOwnerReadable
+                   , setOwnerWritable
+                   )
+import           RIO.FilePath ( (</>) )
+import           Stack.Upload
+                   ( HackageKey (..), maybeGetHackageKey, writeFilePrivate )
+import           System.Environment ( setEnv, unsetEnv )
+import           System.Permissions ( osIsWindows )
+import           System.PosixCompat.Files ( getFileStatus, fileMode )
+import           Test.Hspec ( Spec, example, it, shouldBe, shouldReturn )
 
 spec :: Spec
 spec = do
+ src/test/unix/Stack/Ghci/FakePaths.hs view
@@ -0,0 +1,8 @@+module Stack.Ghci.FakePaths
+  ( defaultDrive
+  ) where
+
+-- | Helpers for writing fake paths for test suite for the GhciScript DSL. This
+-- must be a separate module because it is used in Template Haskell splices.
+defaultDrive :: FilePath
+defaultDrive = "/"
+ src/test/windows/Stack/Ghci/FakePaths.hs view
@@ -0,0 +1,8 @@+module Stack.Ghci.FakePaths
+  ( defaultDrive
+  ) where
+
+-- | Helpers for writing fake paths for test suite for the GhciScript DSL. This
+-- must be a separate module because it is used in Template Haskell splices.
+defaultDrive :: FilePath
+defaultDrive = "C:\\"
+ src/unix/Stack/Constants/UsrLibDirs.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the non-Windows version.
+module Stack.Constants.UsrLibDirs
+  ( usrLibDirs
+  ) where
+
+import          Path ( mkAbsDir )
+import          Stack.Prelude
+
+-- | Used in Stack.Setup for detecting libtinfo, see comments at use site
+usrLibDirs :: [Path Abs Dir]
+usrLibDirs = [$(mkAbsDir "/usr/lib"), $(mkAbsDir "/usr/lib64")]
+ src/unix/Stack/Docker/Handlers.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE NoImplicitPrelude   #-}
+
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the non-Windows version.
+module Stack.Docker.Handlers
+  ( handleSetGroups
+  , handleSignals
+  ) where
+
+import           RIO.Process
+                   ( ExitCodeException, proc, runProcess_, setDelegateCtlc )
+import           Stack.Prelude
+import           Stack.Types.Config ( HasConfig )
+import           Stack.Types.Docker ( DockerOpts (..) )
+import           System.Posix.Signals
+                   ( Handler (..), installHandler, sigABRT, sigHUP, sigINT
+                   , sigPIPE, sigTERM, sigUSR1, sigUSR2
+                   )
+import qualified System.Posix.User as PosixUser
+import           System.PosixCompat.Types ( GroupID )
+
+handleSetGroups :: [GroupID] -> IO ()
+handleSetGroups = PosixUser.setGroups
+
+-- MSS 2018-08-30 can the CPP below be removed entirely, and instead exec the
+-- `docker` process so that it can handle the signals directly?
+handleSignals ::
+     (Exception e, HasConfig env)
+  => DockerOpts
+  -> Bool
+  -> String
+  -> RIO env (Either e ())
+handleSignals docker keepStdinOpen containerID = do
+  run <- askRunInIO
+  oldHandlers <- forM signals $ \sig -> do
+    let sigHandler = run $ do
+          readProcessNull
+            "docker"
+            ["kill", "--signal=" ++ show sig, containerID]
+          when (sig `elem` [sigTERM, sigABRT]) $ do
+            -- Give the container 30 seconds to exit gracefully, then send a
+            -- sigKILL to force it
+            threadDelay 30000000
+            readProcessNull "docker" ["kill", containerID]
+    oldHandler <- liftIO $ installHandler sig (Catch sigHandler) Nothing
+    pure (sig, oldHandler)
+  let args' = concat
+        [ ["start"]
+        , ["-a" | not (dockerDetach docker)]
+        , ["-i" | keepStdinOpen]
+        , [containerID]
+        ]
+  finally
+    (try $ proc "docker" args' $ runProcess_ . setDelegateCtlc False)
+    ( do unless (dockerPersist docker || dockerDetach docker) $
+           readProcessNull "docker" ["rm", "-f", containerID]
+             `catch` (\(_ :: ExitCodeException) -> pure ())
+         forM_ oldHandlers $ \(sig, oldHandler) ->
+           liftIO $ installHandler sig oldHandler Nothing
+    )
+ where
+  signals = [sigINT, sigABRT, sigHUP, sigPIPE, sigTERM, sigUSR1, sigUSR2]
src/unix/System/Info/ShortPathName.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the non-Windows version.
 module System.Info.ShortPathName
   ( getShortPathName
   ) where
 
-import RIO.FilePath (FilePath)
-import RIO.Prelude (pure)
-import RIO.Prelude.Types (IO)
+import           RIO.FilePath ( FilePath )
+import           RIO.Prelude ( pure )
+import           RIO.Prelude.Types ( IO )
 
 getShortPathName :: FilePath -> IO FilePath
 getShortPathName = pure
src/unix/System/Permissions.hs view
@@ -1,25 +1,27 @@ {-# LANGUAGE NoImplicitPrelude #-}
 
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the non-Windows version.
 module System.Permissions
   ( setScriptPerms
   , osIsWindows
   , setFileExecutable
   ) where
 
+import           RIO
 import qualified System.Posix.Files as Posix
-import RIO
 
 -- | True if using Windows OS.
 osIsWindows :: Bool
 osIsWindows = False
 
 setScriptPerms :: MonadIO m => FilePath -> m ()
-setScriptPerms fp = do
-    liftIO $ Posix.setFileMode fp $
-        Posix.ownerReadMode `Posix.unionFileModes`
-        Posix.ownerWriteMode `Posix.unionFileModes`
-        Posix.groupReadMode `Posix.unionFileModes`
-        Posix.otherReadMode
+setScriptPerms fp =
+  liftIO $ Posix.setFileMode fp $
+    Posix.ownerReadMode `Posix.unionFileModes`
+    Posix.ownerWriteMode `Posix.unionFileModes`
+    Posix.groupReadMode `Posix.unionFileModes`
+    Posix.otherReadMode
 
 setFileExecutable :: MonadIO m => FilePath -> m ()
 setFileExecutable fp = liftIO $ Posix.setFileMode fp 0o755
src/unix/System/Terminal.hsc view
@@ -1,6 +1,7 @@ {-# LANGUAGE CApiFFI                  #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
 
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the non-Windows version.
 module System.Terminal
 ( fixCodePage
 , getTerminalWidth
@@ -9,7 +10,7 @@ 
 import           Foreign
 import           Foreign.C.Types
-import           RIO (MonadIO, Handle, hIsTerminalDevice)
+import           RIO ( Handle, MonadIO, hIsTerminalDevice )
 
 #include <sys/ioctl.h>
 #include <unistd.h>
@@ -32,13 +33,13 @@ 
 getTerminalWidth :: IO (Maybe Int)
 getTerminalWidth =
-    alloca $ \p -> do
-        errno <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) p
-        if errno < 0
-        then return Nothing
-        else do
-            WindowWidth w <- peek p
-            return . Just . fromIntegral $ w
+  alloca $ \p -> do
+    errno <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) p
+    if errno < 0
+    then return Nothing
+    else do
+      WindowWidth w <- peek p
+      return . Just . fromIntegral $ w
 
 fixCodePage :: x -> y -> a -> a
 fixCodePage _ _ = id
src/unix/System/Uname.hsc view
@@ -1,3 +1,5 @@+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the non-Windows version.
 module System.Uname
     ( getRelease
     )
@@ -5,8 +7,8 @@ 
 #include <sys/utsname.h>
 
-import Foreign
-import Foreign.C
+import           Foreign
+import           Foreign.C
 
 getRelease :: IO String
 getRelease = do
@@ -31,10 +33,10 @@ data Utsname
 
 instance Storable Utsname where
-    sizeOf    = const #size struct utsname
-    alignment = const #alignment struct utsname
-    poke      = error "Storable Utsname: peek: unsupported operation"
-    peek      = error "Storable Utsname: poke: unsupported operation"
+  sizeOf    = const #size struct utsname
+  alignment = const #alignment struct utsname
+  poke      = error "Storable Utsname: peek: unsupported operation"
+  peek      = error "Storable Utsname: poke: unsupported operation"
 
 release :: Ptr Utsname -> CString
 release = (#ptr struct utsname, release)
+ src/windows/Stack/Constants/UsrLibDirs.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the Windows version.
+module Stack.Constants.UsrLibDirs
+  ( usrLibDirs
+  ) where
+
+import          Stack.Prelude
+
+-- | Used in Stack.Setup for detecting libtinfo, see comments at use site
+usrLibDirs :: [Path Abs Dir]
+usrLibDirs = []
+ src/windows/Stack/Docker/Handlers.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE NoImplicitPrelude   #-}
+
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the Windows version.
+module Stack.Docker.Handlers
+  ( handleSetGroups
+  , handleSignals
+  ) where
+
+import           RIO.Process
+                   ( ExitCodeException, proc , runProcess_, setDelegateCtlc )
+import           Stack.Types.Config ( HasConfig )
+import           Stack.Types.Docker ( DockerOpts (..))
+import           Stack.Prelude
+import           System.PosixCompat.Types ( GroupID )
+
+handleSetGroups :: [GroupID] -> IO ()
+handleSetGroups _ = pure ()
+
+handleSignals ::
+     (Exception e, HasConfig env)
+  => DockerOpts
+  -> Bool
+  -> String
+  -> RIO env (Either e ())
+handleSignals docker keepStdinOpen containerID = do
+  let args' = concat
+        [ ["start"]
+        , ["-a" | not (dockerDetach docker)]
+        , ["-i" | keepStdinOpen]
+        , [containerID]
+        ]
+  finally
+    (try $ proc "docker" args' $ runProcess_ . setDelegateCtlc False)
+    ( unless (dockerPersist docker || dockerDetach docker) $
+        readProcessNull "docker" ["rm", "-f", containerID]
+          `catch` (\(_ :: ExitCodeException) -> pure ())
+    )
src/windows/System/Info/ShortPathName.hs view
@@ -1,5 +1,7 @@+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the Windows version.
 module System.Info.ShortPathName
   ( getShortPathName
   ) where
 
-import System.Win32.Info (getShortPathName)
+import           System.Win32.Info ( getShortPathName )
src/windows/System/Permissions.hs view
@@ -1,3 +1,5 @@+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the Windows version.
 module System.Permissions
   ( setScriptPerms
   , osIsWindows
src/windows/System/Terminal.hs view
@@ -1,23 +1,30 @@ {-# LANGUAGE NoImplicitPrelude        #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE OverloadedStrings        #-}
 
+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the Windows version.
 module System.Terminal
-( fixCodePage
-, getTerminalWidth
-, hIsTerminalDeviceOrMinTTY
-) where
+  ( fixCodePage
+  , getTerminalWidth
+  , hIsTerminalDeviceOrMinTTY
+  ) where
 
-import Distribution.Types.Version (mkVersion)
-import Foreign.Ptr
-import Foreign.Storable
-import Foreign.Marshal.Alloc
-import Stack.Prelude
-import System.IO hiding (hIsTerminalDevice)
-import System.Process
-import System.Win32 (isMinTTYHandle, withHandleToHANDLE)
-import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP)
-import RIO.Partial (read)
+import           Distribution.Types.Version ( mkVersion )
+import           Foreign.Marshal.Alloc ( allocaBytes )
+import           Foreign.Ptr ( Ptr )
+import           Foreign.Storable ( peekByteOff )
+import           RIO.Partial ( read )
+import           Stack.Prelude
+import           System.IO hiding ( hIsTerminalDevice )
+import           System.Process
+                   ( StdStream (..), createProcess, shell, std_err, std_in
+                   , std_out, waitForProcess
+                   )
+import           System.Win32 ( isMinTTYHandle, withHandleToHANDLE )
+import           System.Win32.Console
+                   ( setConsoleCP, setConsoleOutputCP, getConsoleCP
+                   , getConsoleOutputCP
+                   )
 
 type HANDLE = Ptr ()
 
@@ -33,88 +40,86 @@ c_STD_OUTPUT_HANDLE = -11
 
 foreign import ccall unsafe "windows.h GetConsoleScreenBufferInfo"
-    c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO Bool
+  c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO Bool
 
 foreign import ccall unsafe "windows.h GetStdHandle"
-    c_GetStdHandle :: Int -> IO HANDLE
+  c_GetStdHandle :: Int -> IO HANDLE
 
 
 getTerminalWidth :: IO (Maybe Int)
 getTerminalWidth = do
-    hdl <- c_GetStdHandle c_STD_OUTPUT_HANDLE
-    allocaBytes sizeCONSOLE_SCREEN_BUFFER_INFO $ \p -> do
-        b <- c_GetConsoleScreenBufferInfo hdl p
-        if not b
-            then do -- This could happen on Cygwin or MSYS
-                let stty = (shell "stty size") {
-                      std_in  = UseHandle stdin
-                    , std_out = CreatePipe
-                    , std_err = CreatePipe
-                    }
-                (_, mbStdout, _, rStty) <- createProcess stty
-                exStty <- waitForProcess rStty
-                case exStty of
-                    ExitFailure _ -> pure Nothing
-                    ExitSuccess ->
-                        maybe (pure Nothing)
-                              (\hSize -> do
-                                  sizeStr <- hGetContents hSize
-                                  case map read $ words sizeStr :: [Int] of
-                                    [_r, c] -> pure $ Just c
-                                    _ -> pure Nothing
-                              )
-                              mbStdout
-            else do
-                [left,_top,right,_bottom] <- forM [0..3] $ \i -> do
-                    v <- peekByteOff p ((i*2) + posCONSOLE_SCREEN_BUFFER_INFO_srWindow)
-                    pure $ fromIntegral (v :: Word16)
-                pure $ Just (1+right-left)
+  hdl <- c_GetStdHandle c_STD_OUTPUT_HANDLE
+  allocaBytes sizeCONSOLE_SCREEN_BUFFER_INFO $ \p -> do
+    b <- c_GetConsoleScreenBufferInfo hdl p
+    if not b
+      then do -- This could happen on Cygwin or MSYS
+        let stty = (shell "stty size") {
+              std_in  = UseHandle stdin
+            , std_out = CreatePipe
+            , std_err = CreatePipe
+            }
+        (_, mbStdout, _, rStty) <- createProcess stty
+        exStty <- waitForProcess rStty
+        case exStty of
+          ExitFailure _ -> pure Nothing
+          ExitSuccess ->
+            maybe (pure Nothing)
+                  (\hSize -> do
+                      sizeStr <- hGetContents hSize
+                      case map read $ words sizeStr :: [Int] of
+                        [_r, c] -> pure $ Just c
+                        _ -> pure Nothing
+                  )
+                  mbStdout
+      else do
+        [left,_top,right,_bottom] <- forM [0..3] $ \i -> do
+          v <- peekByteOff p (i * 2 + posCONSOLE_SCREEN_BUFFER_INFO_srWindow)
+          pure $ fromIntegral (v :: Word16)
+        pure $ Just (1 + right - left)
 
 -- | Set the code page for this process as necessary. Only applies to Windows.
 -- See: https://github.com/commercialhaskell/stack/issues/738
-fixCodePage
-  :: HasLogFunc env
+fixCodePage ::
+     HasTerm env
   => Bool -- ^ modify code page?
   -> Version -- ^ GHC version
   -> RIO env a
   -> RIO env a
-fixCodePage mcp ghcVersion inner = do
-    if mcp && ghcVersion < mkVersion [7, 10, 3]
-        then fixCodePage'
-        -- GHC >=7.10.3 doesn't need this code page hack.
-        else inner
-  where
-    fixCodePage' = do
-        origCPI <- liftIO getConsoleCP
-        origCPO <- liftIO getConsoleOutputCP
+fixCodePage mcp ghcVersion inner =
+  if mcp && ghcVersion < mkVersion [7, 10, 3]
+    then fixCodePage'
+    -- GHC >=7.10.3 doesn't need this code page hack.
+    else inner
+ where
+  fixCodePage' = do
+    origCPI <- liftIO getConsoleCP
+    origCPO <- liftIO getConsoleOutputCP
 
-        let setInput = origCPI /= expected
-            setOutput = origCPO /= expected
-            fixInput
-                | setInput = bracket_
-                    (liftIO $ do
-                        setConsoleCP expected)
-                    (liftIO $ setConsoleCP origCPI)
-                | otherwise = id
-            fixOutput
-                | setOutput = bracket_
-                    (liftIO $ do
-                        setConsoleOutputCP expected)
-                    (liftIO $ setConsoleOutputCP origCPO)
-                | otherwise = id
+    let setInput = origCPI /= expected
+        setOutput = origCPO /= expected
+        fixInput
+          | setInput = bracket_
+              (liftIO $ setConsoleCP expected)
+              (liftIO $ setConsoleCP origCPI)
+          | otherwise = id
+        fixOutput
+          | setOutput = bracket_
+              (liftIO $ setConsoleOutputCP expected)
+              (liftIO $ setConsoleOutputCP origCPO)
+          | otherwise = id
 
-        case (setInput, setOutput) of
-            (False, False) -> pure ()
-            (True, True) -> warn ""
-            (True, False) -> warn " input"
-            (False, True) -> warn " output"
+    case (setInput, setOutput) of
+      (False, False) -> pure ()
+      (True, True) -> warn []
+      (True, False) -> warn ["input"]
+      (False, True) -> warn ["output"]
 
-        fixInput $ fixOutput inner
-    expected = 65001 -- UTF-8
-    warn typ = logInfo $
-        "Setting" <>
-        typ <>
-        " codepage to UTF-8 (65001) to ensure correct output from GHC"
+    fixInput $ fixOutput inner
+  expected = 65001 -- UTF-8
+  warn typ = prettyInfoL $
+       "Setting"
+    :  typ
+    <> [ flow "codepage to UTF-8 (65001) to ensure correct output from GHC." ]
 
 -- | hIsTerminaDevice does not recognise handles to mintty terminals as terminal
 -- devices, but isMinTTYHandle does.
src/windows/System/Uname.hs view
@@ -1,3 +1,5 @@+-- | The module of this name differs as between Windows and non-Windows builds.
+-- This is the Windows version.
 module System.Uname
   ( getRelease
   ) where
stack.cabal view
@@ -1,752 +1,846 @@-cabal-version: 2.0
-
--- This file has been generated from package.yaml by hpack version 0.35.2.
---
--- see: https://github.com/sol/hpack
-
-name:           stack
-version:        2.9.3.1
-synopsis:       The Haskell Tool Stack
-description:    Please see the documentation at <https://docs.haskellstack.org>
-                for usage information.
-                .
-                If building a 'stack' executable for distribution, please download the
-                source code from <https://github.com/commercialhaskell/stack/releases>
-                and build it using Stack itself in order to ensure identical behaviour
-                to official binaries.  This package on Hackage is provided for convenience
-                and bootstrapping purposes.
-                .
-                Note that the API for the library is not currently stable, and may
-                change significantly, even between minor releases. It is
-                currently only intended for use by the executable.
-category:       Development
-homepage:       http://haskellstack.org
-bug-reports:    https://github.com/commercialhaskell/stack/issues
-author:         Commercial Haskell SIG
-maintainer:     manny@fpcomplete.com
-license:        BSD3
-license-file:   LICENSE
-build-type:     Custom
-extra-source-files:
-    CONTRIBUTING.md
-    ChangeLog.md
-    README.md
-    stack.yaml
-    doc/azure_ci.md
-    doc/build_command.md
-    doc/build_overview.md
-    doc/ChangeLog.md
-    doc/CI.md
-    doc/clean_command.md
-    doc/config_command.md
-    doc/CONTRIBUTING.md
-    doc/coverage.md
-    doc/custom_snapshot.md
-    doc/debugging.md
-    doc/dependency_visualization.md
-    doc/developing_on_windows.md
-    doc/docker_command.md
-    doc/docker_integration.md
-    doc/dot_command.md
-    doc/editor_integration.md
-    doc/environment_variables.md
-    doc/eval_command.md
-    doc/exec_command.md
-    doc/faq.md
-    doc/ghc_command.md
-    doc/ghci.md
-    doc/global_flags.md
-    doc/glossary.md
-    doc/GUIDE.md
-    doc/GUIDE_advanced.md
-    doc/hoogle_command.md
-    doc/hpc_command.md
-    doc/ide_command.md
-    doc/init_command.md
-    doc/install_and_upgrade.md
-    doc/list_command.md
-    doc/lock_files.md
-    doc/ls_command.md
-    doc/new_command.md
-    doc/nix_integration.md
-    doc/nonstandard_project_init.md
-    doc/other_resources.md
-    doc/pantry.md
-    doc/path_command.md
-    doc/purge_command.md
-    doc/query_command.md
-    doc/README.md
-    doc/run_command.md
-    doc/runghc_command.md
-    doc/script_command.md
-    doc/scripts.md
-    doc/sdist_command.md
-    doc/setup_command.md
-    doc/shell_autocompletion.md
-    doc/SIGNING_KEY.md
-    doc/Stack_and_VS_Code.md
-    doc/stack_yaml_vs_cabal_package_file.md
-    doc/templates_command.md
-    doc/travis_ci.md
-    doc/uninstall_command.md
-    doc/unpack_command.md
-    doc/update_command.md
-    doc/upgrade_command.md
-    doc/upload_command.md
-    doc/yaml_configuration.md
-    src/setup-shim/StackSetupShim.hs
-    test/package-dump/ghc-7.10.txt
-    test/package-dump/ghc-7.8.4-osx.txt
-    test/package-dump/ghc-7.8.txt
-    test/package-dump/ghc-head.txt
-    src/test/Stack/Untar/test1.tar.gz
-    src/test/Stack/Untar/test2.tar.gz
-    cabal.project
-    cabal.config
-
-source-repository head
-  type: git
-  location: https://github.com/commercialhaskell/stack
-
-custom-setup
-  setup-depends:
-      Cabal <3.10
-    , base >=4.14.3.0 && <5
-    , filepath
-
-flag developer-mode
-  description: By default, should extra developer information be output?
-  manual: True
-  default: False
-
-flag disable-git-info
-  description: Disable compile-time inclusion of current git info in stack
-  manual: True
-  default: False
-
-flag hide-dependency-versions
-  description: Hides dependency versions from 'stack --version', used only by building Stack and the default 'stack.yaml'.  Note to packagers/distributors: DO NOT OVERRIDE THIS FLAG IF YOU ARE BUILDING 'stack' ANY OTHER WAY (e.g. using cabal or from Hackage), as it makes debugging support requests more difficult.
-  manual: True
-  default: False
-
-flag integration-tests
-  description: Run the integration test suite
-  manual: True
-  default: False
-
-flag static
-  description: Pass -static/-pthread to ghc when linking the stack binary.
-  manual: True
-  default: False
-
-flag supported-build
-  description: If false, causes 'stack --version' to issue a warning about the build being unsupported.  Should be True only if building with Stack and the default 'stack.yaml'.  Note to packagers/distributors: DO NOT OVERRIDE THIS FLAG IF YOU ARE BUILDING 'stack' ANY OTHER WAY (e.g. using cabal or from Hackage), as it makes debugging support requests more difficult.
-  manual: True
-  default: False
-
-library
-  exposed-modules:
-      Control.Concurrent.Execute
-      Data.Attoparsec.Args
-      Data.Attoparsec.Combinators
-      Data.Attoparsec.Interpreter
-      Data.Monoid.Map
-      Network.HTTP.StackClient
-      Options.Applicative.Args
-      Options.Applicative.Builder.Extra
-      Options.Applicative.Complicated
-      Path.CheckInstall
-      Path.Extra
-      Path.Find
-      Stack.Build
-      Stack.Build.Cache
-      Stack.Build.ConstructPlan
-      Stack.Build.Execute
-      Stack.Build.Haddock
-      Stack.Build.Installed
-      Stack.Build.Source
-      Stack.Build.Target
-      Stack.BuildPlan
-      Stack.Clean
-      Stack.Config
-      Stack.Config.Build
-      Stack.Config.Docker
-      Stack.Config.Nix
-      Stack.ConfigCmd
-      Stack.Constants
-      Stack.Constants.Config
-      Stack.Coverage
-      Stack.DefaultColorWhen
-      Stack.Docker
-      Stack.Dot
-      Stack.FileWatch
-      Stack.GhcPkg
-      Stack.Ghci
-      Stack.Ghci.Script
-      Stack.Hoogle
-      Stack.IDE
-      Stack.Init
-      Stack.List
-      Stack.Ls
-      Stack.Lock
-      Stack.New
-      Stack.Nix
-      Stack.Options.BenchParser
-      Stack.Options.BuildMonoidParser
-      Stack.Options.BuildParser
-      Stack.Options.CleanParser
-      Stack.Options.ConfigParser
-      Stack.Options.Completion
-      Stack.Options.DockerParser
-      Stack.Options.DotParser
-      Stack.Options.ExecParser
-      Stack.Options.GhcBuildParser
-      Stack.Options.GhciParser
-      Stack.Options.GhcVariantParser
-      Stack.Options.GlobalParser
-      Stack.Options.HaddockParser
-      Stack.Options.HpcReportParser
-      Stack.Options.LogLevelParser
-      Stack.Options.NewParser
-      Stack.Options.NixParser
-      Stack.Options.PackageParser
-      Stack.Options.ResolverParser
-      Stack.Options.ScriptParser
-      Stack.Options.SDistParser
-      Stack.Options.TestParser
-      Stack.Options.UploadParser
-      Stack.Options.Utils
-      Stack.Package
-      Stack.PackageDump
-      Stack.Path
-      Stack.Prelude
-      Stack.Runners
-      Stack.Script
-      Stack.SDist
-      Stack.Setup
-      Stack.Setup.Installed
-      Stack.SetupCmd
-      Stack.SourceMap
-      Stack.Storage.Project
-      Stack.Storage.User
-      Stack.Storage.Util
-      Stack.Types.Build
-      Stack.Types.CompilerBuild
-      Stack.Types.Compiler
-      Stack.Types.Config
-      Stack.Types.Config.Build
-      Stack.Types.Docker
-      Stack.Types.GhcPkgId
-      Stack.Types.NamedComponent
-      Stack.Types.Nix
-      Stack.Types.Package
-      Stack.Types.PackageName
-      Stack.Types.Resolver
-      Stack.Types.SourceMap
-      Stack.Types.TemplateName
-      Stack.Types.Version
-      Stack.Unpack
-      Stack.Upgrade
-      Stack.Upload
-      System.Info.ShortPathName
-      System.Permissions
-      System.Process.Pager
-      System.Terminal
-      Paths_stack
-  other-modules:
-      Path.Extended
-      Stack.ComponentFile
-      Stack.PackageFile
-      Stack.Types.Cache
-      Stack.Types.Dependency
-      Stack.Types.PackageFile
-      Stack.Types.Storage
-  autogen-modules:
-      Paths_stack
-  hs-source-dirs:
-      src/
-  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -fwarn-identities
-  build-depends:
-      Cabal >=3.6.3.0
-    , aeson >=2.0.3.0
-    , annotated-wl-pprint
-    , ansi-terminal
-    , array
-    , async
-    , attoparsec
-    , base >=4.14.3.0 && <5
-    , base64-bytestring
-    , bytestring
-    , casa-client
-    , casa-types
-    , colour
-    , conduit
-    , conduit-extra
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , deepseq
-    , directory
-    , echo
-    , exceptions
-    , extra
-    , file-embed
-    , filelock
-    , filepath
-    , fsnotify >=0.4.1
-    , generic-deriving
-    , hackage-security
-    , hashable
-    , hi-file-parser
-    , hpack
-    , hpc
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-download
-    , http-types
-    , memory
-    , microlens
-    , mintty
-    , mono-traversable
-    , mtl
-    , mustache
-    , neat-interpolation
-    , network-uri
-    , open-browser
-    , optparse-applicative >=0.17.0.0
-    , pantry >=0.8.1
-    , path
-    , path-io
-    , persistent >=2.13.3.5 && <2.15
-    , persistent-sqlite
-    , persistent-template
-    , pretty
-    , primitive
-    , process >=1.6.13.2
-    , project-template
-    , random
-    , retry
-    , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.4.0
-    , semigroups
-    , split
-    , stm
-    , streaming-commons
-    , tar
-    , template-haskell
-    , temporary
-    , text
-    , text-metrics
-    , th-reify-many
-    , time
-    , tls
-    , transformers
-    , typed-process
-    , unicode-transforms
-    , unix-compat
-    , unliftio
-    , unordered-containers
-    , vector
-    , yaml
-    , zip-archive
-    , zlib
-  default-language: Haskell2010
-  if os(windows)
-    cpp-options: -DWINDOWS
-    build-depends:
-        Win32
-  else
-    build-depends:
-        unix
-    build-tool-depends:
-        hsc2hs:hsc2hs
-  if flag(developer-mode)
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True
-  else
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False
-  if os(windows)
-    other-modules:
-        System.Posix.User
-        System.Uname
-    hs-source-dirs:
-        src/windows/
-  else
-    other-modules:
-        System.Uname
-    hs-source-dirs:
-        src/unix/
-    c-sources:
-        src/unix/cbits/uname.c
-
-executable stack
-  main-is: Main.hs
-  other-modules:
-      BuildInfo
-      Build_stack
-      Paths_stack
-  autogen-modules:
-      Build_stack
-      Paths_stack
-  hs-source-dirs:
-      src/main
-  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -threaded -rtsopts
-  build-depends:
-      Cabal >=3.6.3.0
-    , aeson >=2.0.3.0
-    , annotated-wl-pprint
-    , ansi-terminal
-    , array
-    , async
-    , attoparsec
-    , base >=4.14.3.0 && <5
-    , base64-bytestring
-    , bytestring
-    , casa-client
-    , casa-types
-    , colour
-    , conduit
-    , conduit-extra
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , deepseq
-    , directory
-    , echo
-    , exceptions
-    , extra
-    , file-embed
-    , filelock
-    , filepath
-    , fsnotify >=0.4.1
-    , generic-deriving
-    , hackage-security
-    , hashable
-    , hi-file-parser
-    , hpack
-    , hpc
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-download
-    , http-types
-    , memory
-    , microlens
-    , mintty
-    , mono-traversable
-    , mtl
-    , mustache
-    , neat-interpolation
-    , network-uri
-    , open-browser
-    , optparse-applicative >=0.17.0.0
-    , pantry >=0.8.1
-    , path
-    , path-io
-    , persistent >=2.13.3.5 && <2.15
-    , persistent-sqlite
-    , persistent-template
-    , pretty
-    , primitive
-    , process >=1.6.13.2
-    , project-template
-    , random
-    , retry
-    , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.4.0
-    , semigroups
-    , split
-    , stack
-    , stm
-    , streaming-commons
-    , tar
-    , template-haskell
-    , temporary
-    , text
-    , text-metrics
-    , th-reify-many
-    , time
-    , tls
-    , transformers
-    , typed-process
-    , unicode-transforms
-    , unix-compat
-    , unliftio
-    , unordered-containers
-    , vector
-    , yaml
-    , zip-archive
-    , zlib
-  default-language: Haskell2010
-  if os(windows)
-    cpp-options: -DWINDOWS
-    build-depends:
-        Win32
-  else
-    build-depends:
-        unix
-    build-tool-depends:
-        hsc2hs:hsc2hs
-  if flag(developer-mode)
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True
-  else
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False
-  if flag(static)
-    ld-options: -static -pthread
-  if !(flag(disable-git-info))
-    cpp-options: -DUSE_GIT_INFO
-    build-depends:
-        githash
-      , optparse-simple
-  if flag(hide-dependency-versions)
-    cpp-options: -DHIDE_DEP_VERSIONS
-  if flag(supported-build)
-    cpp-options: -DSUPPORTED_BUILD
-
-executable stack-integration-test
-  main-is: IntegrationSpec.hs
-  other-modules:
-      StackTest
-      Paths_stack
-  autogen-modules:
-      Paths_stack
-  hs-source-dirs:
-      test/integration
-      test/integration/lib
-  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-      Cabal >=3.6.3.0
-    , aeson >=2.0.3.0
-    , annotated-wl-pprint
-    , ansi-terminal
-    , array
-    , async
-    , attoparsec
-    , base >=4.14.3.0 && <5
-    , base64-bytestring
-    , bytestring
-    , casa-client
-    , casa-types
-    , colour
-    , conduit
-    , conduit-extra
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , deepseq
-    , directory
-    , echo
-    , exceptions
-    , extra
-    , file-embed
-    , filelock
-    , filepath
-    , fsnotify >=0.4.1
-    , generic-deriving
-    , hackage-security
-    , hashable
-    , hi-file-parser
-    , hpack
-    , hpc
-    , hspec
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-download
-    , http-types
-    , memory
-    , microlens
-    , mintty
-    , mono-traversable
-    , mtl
-    , mustache
-    , neat-interpolation
-    , network-uri
-    , open-browser
-    , optparse-applicative >=0.17.0.0
-    , optparse-generic
-    , pantry >=0.8.1
-    , path
-    , path-io
-    , persistent >=2.13.3.5 && <2.15
-    , persistent-sqlite
-    , persistent-template
-    , pretty
-    , primitive
-    , process >=1.6.13.2
-    , project-template
-    , random
-    , retry
-    , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.4.0
-    , semigroups
-    , split
-    , stm
-    , streaming-commons
-    , tar
-    , template-haskell
-    , temporary
-    , text
-    , text-metrics
-    , th-reify-many
-    , time
-    , tls
-    , transformers
-    , typed-process
-    , unicode-transforms
-    , unix-compat
-    , unliftio
-    , unordered-containers
-    , vector
-    , yaml
-    , zip-archive
-    , zlib
-  default-language: Haskell2010
-  if os(windows)
-    cpp-options: -DWINDOWS
-    build-depends:
-        Win32
-  else
-    build-depends:
-        unix
-    build-tool-depends:
-        hsc2hs:hsc2hs
-  if flag(developer-mode)
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True
-  else
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False
-  if !(flag(integration-tests))
-    buildable: False
-  if flag(static)
-    ld-options: -static -pthread
-
-test-suite stack-test
-  type: exitcode-stdio-1.0
-  main-is: Spec.hs
-  other-modules:
-      Stack.ArgsSpec
-      Stack.Build.ExecuteSpec
-      Stack.Build.TargetSpec
-      Stack.Config.DockerSpec
-      Stack.ConfigSpec
-      Stack.DotSpec
-      Stack.Ghci.PortableFakePaths
-      Stack.Ghci.ScriptSpec
-      Stack.GhciSpec
-      Stack.LockSpec
-      Stack.NixSpec
-      Stack.PackageDumpSpec
-      Stack.Types.TemplateNameSpec
-      Stack.UploadSpec
-      Paths_stack
-  autogen-modules:
-      Paths_stack
-  hs-source-dirs:
-      src/test
-  ghc-options: -fwrite-ide-info -hiedir=.hie -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -threaded
-  build-depends:
-      Cabal >=3.6.3.0
-    , QuickCheck
-    , aeson >=2.0.3.0
-    , annotated-wl-pprint
-    , ansi-terminal
-    , array
-    , async
-    , attoparsec
-    , base >=4.14.3.0 && <5
-    , base64-bytestring
-    , bytestring
-    , casa-client
-    , casa-types
-    , colour
-    , conduit
-    , conduit-extra
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , deepseq
-    , directory
-    , echo
-    , exceptions
-    , extra
-    , file-embed
-    , filelock
-    , filepath
-    , fsnotify >=0.4.1
-    , generic-deriving
-    , hackage-security
-    , hashable
-    , hi-file-parser
-    , hpack
-    , hpc
-    , hspec
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-download
-    , http-types
-    , memory
-    , microlens
-    , mintty
-    , mono-traversable
-    , mtl
-    , mustache
-    , neat-interpolation
-    , network-uri
-    , open-browser
-    , optparse-applicative >=0.17.0.0
-    , pantry >=0.8.1
-    , path
-    , path-io
-    , persistent >=2.13.3.5 && <2.15
-    , persistent-sqlite
-    , persistent-template
-    , pretty
-    , primitive
-    , process >=1.6.13.2
-    , project-template
-    , random
-    , raw-strings-qq
-    , retry
-    , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.4.0
-    , semigroups
-    , smallcheck
-    , split
-    , stack
-    , stm
-    , streaming-commons
-    , tar
-    , template-haskell
-    , temporary
-    , text
-    , text-metrics
-    , th-reify-many
-    , time
-    , tls
-    , transformers
-    , typed-process
-    , unicode-transforms
-    , unix-compat
-    , unliftio
-    , unordered-containers
-    , vector
-    , yaml
-    , zip-archive
-    , zlib
-  default-language: Haskell2010
-  if os(windows)
-    cpp-options: -DWINDOWS
-    build-depends:
-        Win32
-  else
-    build-depends:
-        unix
-    build-tool-depends:
-        hsc2hs:hsc2hs
-  if flag(developer-mode)
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True
-  else
-    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False
-  build-tool-depends:
-      hspec-discover:hspec-discover
+cabal-version:      2.0+name:               stack+version:            2.11.1+license:            BSD3+license-file:       LICENSE+maintainer:         manny@fpcomplete.com+author:             Commercial Haskell SIG+homepage:           http://haskellstack.org+bug-reports:        https://github.com/commercialhaskell/stack/issues+synopsis:           The Haskell Tool Stack+description:+    Please see the documentation at <https://docs.haskellstack.org>+    for usage information.+    .+    If building a 'stack' executable for distribution, please download the+    source code from <https://github.com/commercialhaskell/stack/releases>+    and build it using Stack itself in order to ensure identical behaviour+    to official binaries. This package on Hackage is provided for convenience+    and bootstrapping purposes.+    .+    Note that the API for the library is not currently stable, and may+    change significantly, even between minor releases. It is+    currently only intended for use by the executable.++category:           Development+build-type:         Custom+extra-source-files:+    CONTRIBUTING.md+    ChangeLog.md+    README.md+    stack.yaml+    doc/azure_ci.md+    doc/build_command.md+    doc/build_overview.md+    doc/ChangeLog.md+    doc/CI.md+    doc/clean_command.md+    doc/config_command.md+    doc/CONTRIBUTING.md+    doc/coverage.md+    doc/custom_snapshot.md+    doc/debugging.md+    doc/dependency_visualization.md+    doc/developing_on_windows.md+    doc/docker_command.md+    doc/docker_integration.md+    doc/dot_command.md+    doc/editor_integration.md+    doc/environment_variables.md+    doc/eval_command.md+    doc/exec_command.md+    doc/faq.md+    doc/ghc_command.md+    doc/ghci.md+    doc/global_flags.md+    doc/glossary.md+    doc/GUIDE.md+    doc/GUIDE_advanced.md+    doc/hoogle_command.md+    doc/hpc_command.md+    doc/ide_command.md+    doc/init_command.md+    doc/install_and_upgrade.md+    doc/list_command.md+    doc/lock_files.md+    doc/ls_command.md+    doc/new_command.md+    doc/nix_integration.md+    doc/nonstandard_project_init.md+    doc/other_resources.md+    doc/pantry.md+    doc/path_command.md+    doc/purge_command.md+    doc/query_command.md+    doc/README.md+    doc/run_command.md+    doc/runghc_command.md+    doc/script_command.md+    doc/scripts.md+    doc/sdist_command.md+    doc/setup_command.md+    doc/shell_autocompletion.md+    doc/SIGNING_KEY.md+    doc/Stack_and_VS_Code.md+    doc/stack_root.md+    doc/stack_yaml_vs_cabal_package_file.md+    doc/templates_command.md+    doc/travis_ci.md+    doc/uninstall_command.md+    doc/unpack_command.md+    doc/update_command.md+    doc/upgrade_command.md+    doc/upload_command.md+    doc/yaml_configuration.md+    src/setup-shim/StackSetupShim.hs+    test/package-dump/ghc-7.10.txt+    test/package-dump/ghc-7.8.4-osx.txt+    test/package-dump/ghc-7.8.txt+    test/package-dump/ghc-head.txt+    src/test/Stack/Untar/test1.tar.gz+    src/test/Stack/Untar/test2.tar.gz++source-repository head+    type:     git+    location: https://github.com/commercialhaskell/stack++custom-setup+    setup-depends:+        Cabal >=3.8.1.0 && <3.10,+        base >=4.14.3.0 && <5,+        filepath++flag developer-mode+    description: By default, should extra developer information be output?+    default:     False+    manual:      True++flag disable-git-info+    description: Disable compile-time inclusion of current git info in stack+    default:     False+    manual:      True++flag hide-dependency-versions+    description:+        Hides dependency versions from 'stack --version', used only by building Stack and the default 'stack.yaml'.  Note to packagers/distributors: DO NOT OVERRIDE THIS FLAG IF YOU ARE BUILDING 'stack' ANY OTHER WAY (e.g. using cabal or from Hackage), as it makes debugging support requests more difficult.++    default:     False+    manual:      True++flag integration-tests+    description: Run the integration test suite+    default:     False+    manual:      True++flag static+    description: Pass -static/-pthread to ghc when linking the stack binary.+    default:     False+    manual:      True++flag supported-build+    description:+        If false, causes 'stack --version' to issue a warning about the build being unsupported.  Should be True only if building with Stack and the default 'stack.yaml'.  Note to packagers/distributors: DO NOT OVERRIDE THIS FLAG IF YOU ARE BUILDING 'stack' ANY OTHER WAY (e.g. using cabal or from Hackage), as it makes debugging support requests more difficult.++    default:     False+    manual:      True++library+    exposed-modules:+        Control.Concurrent.Execute+        Data.Attoparsec.Args+        Data.Attoparsec.Combinators+        Data.Attoparsec.Interpreter+        Data.Monoid.Map+        Network.HTTP.StackClient+        Options.Applicative.Args+        Options.Applicative.Builder.Extra+        Options.Applicative.Complicated+        Path.CheckInstall+        Path.Extra+        Path.Find+        Stack.Build+        Stack.Build.Cache+        Stack.Build.ConstructPlan+        Stack.Build.Execute+        Stack.Build.Haddock+        Stack.Build.Installed+        Stack.Build.Source+        Stack.Build.Target+        Stack.BuildPlan+        Stack.Clean+        Stack.Config+        Stack.Config.Build+        Stack.Config.Docker+        Stack.Config.Nix+        Stack.ConfigCmd+        Stack.Constants+        Stack.Constants.Config+        Stack.Coverage+        Stack.DefaultColorWhen+        Stack.Docker+        Stack.DockerCmd+        Stack.Dot+        Stack.Eval+        Stack.Exec+        Stack.FileWatch+        Stack.GhcPkg+        Stack.Ghci+        Stack.Ghci.Script+        Stack.Hoogle+        Stack.IDE+        Stack.Init+        Stack.List+        Stack.Ls+        Stack.Lock+        Stack.New+        Stack.Nix+        Stack.Options.BenchParser+        Stack.Options.BuildMonoidParser+        Stack.Options.BuildParser+        Stack.Options.CleanParser+        Stack.Options.ConfigParser+        Stack.Options.Completion+        Stack.Options.DockerParser+        Stack.Options.DotParser+        Stack.Options.EvalParser+        Stack.Options.ExecParser+        Stack.Options.GhcBuildParser+        Stack.Options.GhciParser+        Stack.Options.GhcVariantParser+        Stack.Options.GlobalParser+        Stack.Options.HaddockParser+        Stack.Options.HpcReportParser+        Stack.Options.InitParser+        Stack.Options.LogLevelParser+        Stack.Options.LsParser+        Stack.Options.NewParser+        Stack.Options.NixParser+        Stack.Options.PackageParser+        Stack.Options.PathParser+        Stack.Options.ResolverParser+        Stack.Options.SDistParser+        Stack.Options.ScriptParser+        Stack.Options.SetupParser+        Stack.Options.TestParser+        Stack.Options.UpgradeParser+        Stack.Options.UploadParser+        Stack.Options.Utils+        Stack.Package+        Stack.PackageDump+        Stack.Path+        Stack.Prelude+        Stack.Query+        Stack.Runners+        Stack.Script+        Stack.SDist+        Stack.Setup+        Stack.Setup.Installed+        Stack.SetupCmd+        Stack.SourceMap+        Stack.Storage.Project+        Stack.Storage.User+        Stack.Storage.Util+        Stack.Templates+        Stack.Types.AddCommand+        Stack.Types.AllowNewerDeps+        Stack.Types.ApplyGhcOptions+        Stack.Types.ApplyProgOptions+        Stack.Types.Build+        Stack.Types.Build.Exception+        Stack.Types.BuildConfig+        Stack.Types.BuildOpts+        Stack.Types.CabalConfigKey+        Stack.Types.ColorWhen+        Stack.Types.CompilerBuild+        Stack.Types.CompilerPaths+        Stack.Types.Compiler+        Stack.Types.Config+        Stack.Types.Config.Exception+        Stack.Types.ConfigMonoid+        Stack.Types.ConfigureOpts+        Stack.Types.Curator+        Stack.Types.Docker+        Stack.Types.DockerEntrypoint+        Stack.Types.DownloadInfo+        Stack.Types.DumpLogs+        Stack.Types.DumpPackage+        Stack.Types.EnvConfig+        Stack.Types.EnvSettings+        Stack.Types.ExtraDirs+        Stack.Types.GHCDownloadInfo+        Stack.Types.GHCVariant+        Stack.Types.GhcOptionKey+        Stack.Types.GhcOptions+        Stack.Types.GhcPkgId+        Stack.Types.GlobalOpts+        Stack.Types.GlobalOptsMonoid+        Stack.Types.IsMutable+        Stack.Types.LockFileBehavior+        Stack.Types.NamedComponent+        Stack.Types.Nix+        Stack.Types.Package+        Stack.Types.PackageName+        Stack.Types.ParentMap+        Stack.Types.Platform+        Stack.Types.Project+        Stack.Types.ProjectAndConfigMonoid+        Stack.Types.ProjectConfig+        Stack.Types.PvpBounds+        Stack.Types.Resolver+        Stack.Types.Runner+        Stack.Types.SCM+        Stack.Types.SetupInfo+        Stack.Types.SourceMap+        Stack.Types.StackYamlLoc+        Stack.Types.TemplateName+        Stack.Types.UnusedFlags+        Stack.Types.Version+        Stack.Types.VersionedDownloadInfo+        Stack.Uninstall+        Stack.Unpack+        Stack.Update+        Stack.Upgrade+        Stack.Upload+        System.Info.ShortPathName+        System.Permissions+        System.Process.Pager+        System.Terminal+        Paths_stack++    hs-source-dirs:   src/+    other-modules:+        Path.Extended+        Stack.ComponentFile+        Stack.Constants.StackProgName+        Stack.Internal.BuildInfo+        Stack.PackageFile+        Stack.Types.Cache+        Stack.Types.Dependency+        Stack.Types.PackageFile+        Stack.Types.Storage++    autogen-modules:  Paths_stack+    default-language: GHC2021+    ghc-options:+        -fwrite-ide-info -hiedir=.hie -Wall -Wmissing-export-lists+        -optP-Wno-nonportable-include-path -Widentities++    build-depends:+        Cabal >=3.8.1.0,+        aeson >=2.0.3.0,+        annotated-wl-pprint,+        ansi-terminal >=1.0,+        array,+        async,+        attoparsec,+        base >=4.14.3.0 && <5,+        base64-bytestring,+        bytestring,+        casa-client,+        casa-types,+        colour,+        conduit,+        conduit-extra,+        containers,+        cryptonite,+        cryptonite-conduit,+        deepseq,+        directory,+        echo,+        exceptions,+        extra,+        file-embed,+        filelock,+        filepath,+        fsnotify >=0.4.1,+        generic-deriving,+        hackage-security,+        hashable,+        hi-file-parser >=0.1.4.0,+        hpack,+        hpc,+        http-client,+        http-client-tls,+        http-conduit,+        http-download,+        http-types,+        memory,+        microlens,+        mintty,+        mono-traversable,+        mtl,+        mustache,+        neat-interpolation,+        network-uri,+        open-browser,+        optparse-applicative >=0.17.0.0,+        pantry >=0.8.2.2,+        path,+        path-io,+        persistent >=2.14.0.0 && <2.15,+        persistent-sqlite,+        persistent-template,+        pretty,+        primitive,+        process >=1.6.13.2,+        project-template,+        random,+        retry,+        rio >=0.1.22.0,+        rio-prettyprint >=0.1.4.0,+        semigroups,+        split,+        stm,+        streaming-commons,+        tar,+        template-haskell,+        text,+        text-metrics,+        th-reify-many,+        time,+        tls,+        transformers,+        typed-process,+        unicode-transforms,+        unix-compat,+        unliftio,+        unordered-containers,+        vector,+        yaml,+        zip-archive,+        zlib++    if os(windows)+        cpp-options:   -DWINDOWS+        build-depends: Win32++    else+        build-tool-depends: hsc2hs:hsc2hs+        build-depends:      unix++    if (impl(ghc >=9.4.5) && os(windows))+        build-depends: network >=3.1.2.9++    if flag(developer-mode)+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True++    else+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False++    if os(windows)+        hs-source-dirs: src/windows/+        other-modules:+            Stack.Constants.UsrLibDirs+            Stack.Docker.Handlers+            System.Posix.User+            System.Uname++    else+        c-sources:      src/unix/cbits/uname.c+        hs-source-dirs: src/unix/+        other-modules:+            Stack.Constants.UsrLibDirs+            Stack.Docker.Handlers+            System.Uname++executable stack+    main-is:          Main.hs+    hs-source-dirs:   src/main+    other-modules:+        BuildInfo+        Stack.CLI+        Build_stack+        Paths_stack++    autogen-modules:+        Build_stack+        Paths_stack++    default-language: GHC2021+    ghc-options:+        -fwrite-ide-info -hiedir=.hie -Wall -Wmissing-export-lists+        -optP-Wno-nonportable-include-path -threaded -rtsopts++    build-depends:+        Cabal >=3.8.1.0,+        aeson >=2.0.3.0,+        annotated-wl-pprint,+        ansi-terminal >=1.0,+        array,+        async,+        attoparsec,+        base >=4.14.3.0 && <5,+        base64-bytestring,+        bytestring,+        casa-client,+        casa-types,+        colour,+        conduit,+        conduit-extra,+        containers,+        cryptonite,+        cryptonite-conduit,+        deepseq,+        directory,+        echo,+        exceptions,+        extra,+        file-embed,+        filelock,+        filepath,+        fsnotify >=0.4.1,+        generic-deriving,+        hackage-security,+        hashable,+        hi-file-parser >=0.1.4.0,+        hpack,+        hpc,+        http-client,+        http-client-tls,+        http-conduit,+        http-download,+        http-types,+        memory,+        microlens,+        mintty,+        mono-traversable,+        mtl,+        mustache,+        neat-interpolation,+        network-uri,+        open-browser,+        optparse-applicative >=0.17.0.0,+        pantry >=0.8.2.2,+        path,+        path-io,+        persistent >=2.14.0.0 && <2.15,+        persistent-sqlite,+        persistent-template,+        pretty,+        primitive,+        process >=1.6.13.2,+        project-template,+        random,+        retry,+        rio >=0.1.22.0,+        rio-prettyprint >=0.1.4.0,+        semigroups,+        split,+        stack,+        stm,+        streaming-commons,+        tar,+        template-haskell,+        text,+        text-metrics,+        th-reify-many,+        time,+        tls,+        transformers,+        typed-process,+        unicode-transforms,+        unix-compat,+        unliftio,+        unordered-containers,+        vector,+        yaml,+        zip-archive,+        zlib++    if os(windows)+        cpp-options:   -DWINDOWS+        build-depends: Win32++    else+        build-tool-depends: hsc2hs:hsc2hs+        build-depends:      unix++    if (impl(ghc >=9.4.5) && os(windows))+        build-depends: network >=3.1.2.9++    if flag(developer-mode)+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True++    else+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False++    if flag(static)+        ld-options: -static -pthread++    if !flag(disable-git-info)+        cpp-options:   -DUSE_GIT_INFO+        build-depends:+            githash,+            optparse-simple++    if flag(hide-dependency-versions)+        cpp-options: -DHIDE_DEP_VERSIONS++    if flag(supported-build)+        cpp-options: -DSUPPORTED_BUILD++executable stack-integration-test+    main-is:          IntegrationSpec.hs+    hs-source-dirs:   test/integration test/integration/lib+    other-modules:+        StackTest+        Paths_stack++    autogen-modules:  Paths_stack+    default-language: GHC2021+    ghc-options:+        -fwrite-ide-info -hiedir=.hie -Wall -Wmissing-export-lists+        -optP-Wno-nonportable-include-path -threaded -rtsopts+        -with-rtsopts=-N++    build-depends:+        Cabal >=3.8.1.0,+        aeson >=2.0.3.0,+        annotated-wl-pprint,+        ansi-terminal >=1.0,+        array,+        async,+        attoparsec,+        base >=4.14.3.0 && <5,+        base64-bytestring,+        bytestring,+        casa-client,+        casa-types,+        colour,+        conduit,+        conduit-extra,+        containers,+        cryptonite,+        cryptonite-conduit,+        deepseq,+        directory,+        echo,+        exceptions,+        extra,+        file-embed,+        filelock,+        filepath,+        fsnotify >=0.4.1,+        generic-deriving,+        hackage-security,+        hashable,+        hi-file-parser >=0.1.4.0,+        hpack,+        hpc,+        hspec,+        http-client,+        http-client-tls,+        http-conduit,+        http-download,+        http-types,+        memory,+        microlens,+        mintty,+        mono-traversable,+        mtl,+        mustache,+        neat-interpolation,+        network-uri,+        open-browser,+        optparse-applicative >=0.17.0.0,+        optparse-generic,+        pantry >=0.8.2.2,+        path,+        path-io,+        persistent >=2.14.0.0 && <2.15,+        persistent-sqlite,+        persistent-template,+        pretty,+        primitive,+        process >=1.6.13.2,+        project-template,+        random,+        retry,+        rio >=0.1.22.0,+        rio-prettyprint >=0.1.4.0,+        semigroups,+        split,+        stm,+        streaming-commons,+        tar,+        template-haskell,+        text,+        text-metrics,+        th-reify-many,+        time,+        tls,+        transformers,+        typed-process,+        unicode-transforms,+        unix-compat,+        unliftio,+        unordered-containers,+        vector,+        yaml,+        zip-archive,+        zlib++    if os(windows)+        cpp-options:   -DWINDOWS+        build-depends: Win32++    else+        build-tool-depends: hsc2hs:hsc2hs+        build-depends:      unix++    if (impl(ghc >=9.4.5) && os(windows))+        build-depends: network >=3.1.2.9++    if flag(developer-mode)+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True++    else+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False++    if !flag(integration-tests)+        buildable: False++    if flag(static)+        ld-options: -static -pthread++test-suite stack-test+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: hspec-discover:hspec-discover+    hs-source-dirs:     src/test+    other-modules:+        Stack.ArgsSpec+        Stack.Build.ExecuteSpec+        Stack.Build.TargetSpec+        Stack.Config.DockerSpec+        Stack.ConfigSpec+        Stack.DotSpec+        Stack.Ghci.ScriptSpec+        Stack.GhciSpec+        Stack.LockSpec+        Stack.NixSpec+        Stack.PackageDumpSpec+        Stack.Types.TemplateNameSpec+        Stack.UploadSpec+        Paths_stack++    autogen-modules:    Paths_stack+    default-language:   GHC2021+    ghc-options:+        -fwrite-ide-info -hiedir=.hie -Wall -Wmissing-export-lists+        -optP-Wno-nonportable-include-path -threaded++    build-depends:+        Cabal >=3.8.1.0,+        QuickCheck,+        aeson >=2.0.3.0,+        annotated-wl-pprint,+        ansi-terminal >=1.0,+        array,+        async,+        attoparsec,+        base >=4.14.3.0 && <5,+        base64-bytestring,+        bytestring,+        casa-client,+        casa-types,+        colour,+        conduit,+        conduit-extra,+        containers,+        cryptonite,+        cryptonite-conduit,+        deepseq,+        directory,+        echo,+        exceptions,+        extra,+        file-embed,+        filelock,+        filepath,+        fsnotify >=0.4.1,+        generic-deriving,+        hackage-security,+        hashable,+        hi-file-parser >=0.1.4.0,+        hpack,+        hpc,+        hspec,+        http-client,+        http-client-tls,+        http-conduit,+        http-download,+        http-types,+        memory,+        microlens,+        mintty,+        mono-traversable,+        mtl,+        mustache,+        neat-interpolation,+        network-uri,+        open-browser,+        optparse-applicative >=0.17.0.0,+        pantry >=0.8.2.2,+        path,+        path-io,+        persistent >=2.14.0.0 && <2.15,+        persistent-sqlite,+        persistent-template,+        pretty,+        primitive,+        process >=1.6.13.2,+        project-template,+        random,+        raw-strings-qq,+        retry,+        rio >=0.1.22.0,+        rio-prettyprint >=0.1.4.0,+        semigroups,+        smallcheck,+        split,+        stack,+        stm,+        streaming-commons,+        tar,+        template-haskell,+        text,+        text-metrics,+        th-reify-many,+        time,+        tls,+        transformers,+        typed-process,+        unicode-transforms,+        unix-compat,+        unliftio,+        unordered-containers,+        vector,+        yaml,+        zip-archive,+        zlib++    if os(windows)+        cpp-options:   -DWINDOWS+        build-depends: Win32++    else+        build-tool-depends: hsc2hs:hsc2hs+        build-depends:      unix++    if (impl(ghc >=9.4.5) && os(windows))+        build-depends: network >=3.1.2.9++    if flag(developer-mode)+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True++    else+        cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False++    if os(windows)+        hs-source-dirs: src/test/windows/+        other-modules:  Stack.Ghci.FakePaths++    else+        hs-source-dirs: src/test/unix/+        other-modules:  Stack.Ghci.FakePaths
stack.yaml view
@@ -1,16 +1,35 @@-# GHC 9.4.5
-resolver: lts-21.0
+# GHC 9.2.7
+resolver: lts-20.21
 
 packages:
 - .
 
+extra-deps:
+- ansi-terminal-1.0@sha256:640ffecfd95471388d939fcacb57bdc0cef15f0457746c234a12cdd5a6c6d1e8,2706
+- ansi-terminal-types-0.11.5@sha256:f78440dfd95c4509e88855ac7cc2d9566ddf956a92c1290404cac93ad1a1b00a,1482
+- fsnotify-0.4.1.0@sha256:44540beabea36aeeef930aa4d5f28091d431904bc9923b6ac4d358831c651235,2854
+- pantry-0.8.2.2@sha256:579aa8538c0fde65f9c08fb97d1d5aee8f59e5cc44e5f8feb350ec54bd2b14a6,6026
+- persistent-2.14.5.0@sha256:c3c7a6a200930f956b2a6bb15b9d2cd512980692f6a2d95368a6db335c34c916,7199
+- rio-prettyprint-0.1.4.0@sha256:1f8eb3ead0ef33d3736d53e1de5e9b2c91a0c207cdca23321bd74c401e85f23a,1301
+# lts-20.21 specifies Cabal-3.6.3.0
+- Cabal-3.8.1.0@sha256:155d64beeecbae2b19e5d67844532494af88bc8795d4db4146a0c29296f59967,12220
+# lts-20.21 specifies Cabal-syntax-3.6.0.0
+- Cabal-syntax-3.8.1.0@sha256:4936765e9a7a8ecbf8fdbe9067f6d972bc0299220063abb2632a9950af64b966,7619
+
+allow-newer: true
+
+allow-newer-deps:
+# Required because ansi-wl-pprint-0.6.9 specifies ansi-terminal < 0.12. See:
+# https://github.com/ekmett/ansi-wl-pprint/issues/29
+- ansi-wl-pprint
+
 drop-packages:
 # See https://github.com/commercialhaskell/stack/pull/4712
 - cabal-install
 
 docker:
   enable: false
-  repo: fpco/alpine-haskell-stack:9.2.5
+  repo: fpco/alpine-haskell-stack:9.2.7
 
 nix:
   # --nix on the command-line to enable.
@@ -19,6 +38,10 @@   - unzip
 
 flags:
+  hackage-security:
+    Cabal-syntax: true
+  mintty:
+    win32-2-13-1: false
   stack:
     developer-mode: true
test/integration/IntegrationSpec.hs view
@@ -1,25 +1,36 @@ {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE BangPatterns        #-}
-{-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 import           Conduit
-import           Data.List                (stripPrefix)
+                   ( (.|), connect, filterC, filterMC, foldMapC, mapM_C
+                   , runConduit, runConduitRes, runResourceT, sourceDirectory
+                   , sourceDirectoryDeep, stderrC, withSourceFile
+                   )
+import           Data.List ( stripPrefix )
 import           Options.Generic
+                   ( ParseField, ParseRecord (..), defaultModifiers
+                   , fieldNameModifier, firstLetter, getRecord
+                   , parseRecordWithModifiers, shortNameModifier
+                   )
 import           RIO
-import           RIO.Char                 (toLower)
-import           RIO.Directory            hiding (findExecutable)
+import           RIO.Char ( toLower )
+import           RIO.Directory hiding ( findExecutable )
 import           RIO.FilePath
-import           RIO.List                 (isInfixOf, partition)
-import qualified RIO.Map                  as Map
+                   ( (</>), (<.>), isPathSeparator, takeDirectory
+                   , takeExtensions, takeFileName
+                   )
+import           RIO.List ( isInfixOf, partition )
+import qualified RIO.Map as Map
 import           RIO.Process
-import qualified RIO.Set                  as Set
-import qualified RIO.Text                 as T
-import           System.Environment       (lookupEnv, getExecutablePath)
-import           System.Info (os)
-import           System.PosixCompat.Files
+                   ( HasProcessContext (..), closed, findExecutable, proc
+                   , runProcess, runProcess_, setStderr, setStdin, setStdout
+                   , useHandleOpen, withModifyEnvVars, withWorkingDir
+                   )
+import qualified RIO.Set as Set
+import qualified RIO.Text as T
+import           System.Environment ( getExecutablePath, lookupEnv )
+import           System.Info ( os )
+import           System.PosixCompat.Files ( createSymbolicLink )
 
 -- This code does not use a test framework so that we get direct
 -- control of how the output is displayed.
@@ -67,7 +78,9 @@ data Options = Options
   { optSpeed :: Maybe Speed
   , optMatch :: Maybe String
-  } deriving Generic
+  , optNot :: [String]
+  }
+  deriving Generic
 
 instance ParseRecord Options where
   parseRecord = parseRecordWithModifiers modifiers
@@ -104,9 +117,10 @@   logInfo $ "Using runghc located at " <> fromString runghc
   proc runghc ["--version"] runProcess_
 
-  let matchTest = case optMatch options of
-        Nothing -> const True
-        Just str -> (str `isInfixOf`)
+  let matchTest = case (optMatch options, optNot options) of
+        (Just str, _) -> (str `isInfixOf`)
+        (_, []) -> const True
+        (_, nl) -> \a -> all (\b -> not $ b `isInfixOf` a) nl
   testDirs
     <- runConduitRes
      $ sourceDirectory (testsRoot </> "tests")
test/integration/lib/StackTest.hs view
@@ -1,21 +1,84 @@ {-# LANGUAGE ScopedTypeVariables #-}
 
-module StackTest where
+module StackTest
+  ( run'
+  , run
+  , runShell
+  , runWithCwd
+  , stackExe
+  , stackSrc
+  , testDir
+  , stack'
+  , stack
+  , stackCleanFull
+  , stackIgnoreException
+  , stackErr
+  , Repl
+  , ReplConnection (..)
+  , nextPrompt
+  , replCommand
+  , replGetChar
+  , replGetLine
+  , runRepl
+  , repl
+  , stackStderr
+  , stackCheckStderr
+  , stackErrStderr
+  , runEx
+  , runEx'
+  , stackCheckStdout
+  , doesNotExist
+  , doesExist
+  , doesFileOrDirExist
+  , copy
+  , fileContentsMatch
+  , logInfo
+  , showProcessArgDebug
+  , exeExt
+  , isWindows
+  , isLinux
+  , getIsAlpine
+  , isARM
+  , isAarch64
+  , isMacOSX
+  , defaultResolverArg
+  , removeFileIgnore
+  , removeDirIgnore
+  , withCwd
+  , withSourceDirectory
+  , superslow
+  ) where
 
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Reader
-import Control.Concurrent
-import Control.Exception
-import Data.Maybe (fromMaybe)
-import System.Environment
-import System.Directory
-import System.IO
-import System.IO.Error
-import System.Process
-import System.Exit
-import System.Info (arch, os)
-import GHC.Stack (HasCallStack)
+import           Control.Monad ( forever, unless, void, when )
+import           Control.Monad.IO.Class ( liftIO )
+import           Control.Monad.Trans.Reader ( ReaderT, ask, runReaderT )
+import           Control.Concurrent ( forkIO )
+import           Control.Exception
+                   ( Exception (..), IOException, bracket_, catch, throw
+                   , throwIO
+                   )
+import           Data.Maybe ( fromMaybe )
+import           GHC.Stack ( HasCallStack )
+import           System.Environment ( getEnv, lookupEnv )
+import           System.Directory
+                   ( copyFile, doesDirectoryExist, doesFileExist
+                   , getCurrentDirectory, removeDirectoryRecursive, removeFile
+                   , setCurrentDirectory
+                   )
+import           System.IO
+                   ( BufferMode (..), Handle, IOMode (..), hGetChar, hGetLine
+                   , hPutChar, hPutStr, hPutStrLn, hSetBuffering, stderr
+                   , withFile
+                   )
+import           System.IO.Error
+                   ( isDoesNotExistError, isEOFError )
+import           System.Process
+                   ( CreateProcess (..), StdStream (..), createProcess, proc
+                   , readCreateProcessWithExitCode, readProcessWithExitCode
+                   , shell, waitForProcess
+                   )
+import           System.Exit ( ExitCode (..) )
+import           System.Info ( arch, os )
 
 run' :: HasCallStack => FilePath -> [String] -> IO ExitCode
 run' cmd args = do
@@ -250,9 +313,10 @@ showProcessArgDebug x
     | any special x = show x
     | otherwise = x
-  where special '"' = True
-        special ' ' = True
-        special _ = False
+  where
+    special '"' = True
+    special ' ' = True
+    special _ = False
 
 -- | Extension of executables
 exeExt :: String
@@ -273,6 +337,10 @@ isARM :: Bool
 isARM = arch == "arm"
 
+-- | Is the architecture Aarch64?
+isAarch64 :: Bool
+isAarch64 = arch == "aarch64"
+
 -- | Is the OS Mac OS X?
 isMacOSX :: Bool
 isMacOSX = os == "darwin"
@@ -283,7 +351,7 @@ -- the main @stack.yaml@.
 --
 defaultResolverArg :: String
-defaultResolverArg = "--resolver=nightly-2022-11-14"
+defaultResolverArg = "--resolver=lts-20.13"
 
 -- | Remove a file and ignore any warnings about missing files.
 removeFileIgnore :: HasCallStack => FilePath -> IO ()