packages feed

stack 1.3.2 → 1.4.0

raw patch · 89 files changed

+3099/−1377 lines, 89 filesdep +cryptonitedep +cryptonite-conduitdep +hackage-securitydep −base16-bytestringdep −byteabledep −cryptohashdep ~Cabaldep ~basedep ~conduit-extra

Dependencies added: cryptonite, cryptonite-conduit, hackage-security, memory, microlens-mtl, network-uri

Dependencies removed: base16-bytestring, byteable, cryptohash, cryptohash-conduit

Dependency ranges changed: Cabal, base, conduit-extra, hashable, hpack, http-client-tls, path, stack, template-haskell, unicode-transforms, unordered-containers

Files

ChangeLog.md view
@@ -1,5 +1,119 @@ # Changelog +## 1.4.0++Release notes:++* Docker images:+  [fpco/stack-full](https://hub.docker.com/r/fpco/stack-full/) and+  [fpco/stack-run](https://hub.docker.com/r/fpco/stack-run/)+  are no longer being built for LTS 8.0 and above.+  [fpco/stack-build](https://hub.docker.com/r/fpco/stack-build/)+  images continue to be built with a+  [simplified process](https://github.com/commercialhaskell/stack/tree/master/etc/dockerfiles/stack-build).+  [#624](https://github.com/commercialhaskell/stack/issues/624)++Major changes:++* A new command, `script`, has been added, intended to make the script+  interpreter workflow more reliable, easier to use, and more+  efficient. This command forces the user to provide a `--resolver`+  value, ignores all config files for more reproducible results, and+  optimizes the existing package check to make the common case of all+  packages already being present much faster. This mode does require+  that all packages be present in a snapshot, however.+  [#2805](https://github.com/commercialhaskell/stack/issues/2805)++Behavior changes:++* The default package metadata backend has been changed from Git to+  the 01-index.tar.gz file, from the hackage-security project. This is+  intended to address some download speed issues from Github for+  people in certain geographic regions. There is now full support for+  checking out specific cabal file revisions from downloaded tarballs+  as well. If you manually specify a package index with only a Git+  URL, Git will still be used. See+  [#2780](https://github.com/commercialhaskell/stack/issues/2780)+* When you provide the `--resolver` argument to the `stack unpack`+  command, any packages passed in by name only will be looked up in+  the given snapshot instead of taking the latest version. For+  example, `stack --resolver lts-7.14 unpack mtl` will get version+  2.2.1 of `mtl`, regardless of the latest version available in the+  package indices. This will also force the same cabal file revision+  to be used as is specified in the snapshot.++    Unpacking via a package identifier (e.g. `stack --resolver lts-7.14+    unpack mtl-2.2.1`) will ignore any settings in the snapshot and take+    the most recent revision.++    For backwards compatibility with tools relying on the presence of a+    `00-index.tar`, Stack will copy the `01-index.tar` file to+    `00-index.tar`. Note, however, that these files are different; most+    importantly, 00-index contains only the newest revisions of cabal+    files, while 01-index contains all versions. You may still need to+    update your tooling.+* Passing `--(no-)nix-*` options now no longer implies `--nix`, except for+  `--nix-pure`, so that the user preference whether or not to use Nix is+  honored even in the presence of options that change the Nix behavior.++Other enhancements:++* Internal cleanup: configuration types are now based much more on lenses+* `stack build` and related commands now allow the user to disable debug symbol stripping+  with new `--no-strip`, `--no-library-stripping`, and `--no-executable-shipping` flags,+  closing [#877](https://github.com/commercialhaskell/stack/issues/877).+  Also turned error message for missing targets more readable ([#2384](https://github.com/commercialhaskell/stack/issues/2384))+* `stack haddock` now shows index.html paths when documentation is already up to+  date. Resolved [#781](https://github.com/commercialhaskell/stack/issues/781)+* Respects the `custom-setup` field introduced in Cabal 1.24. This+  supercedes any `explicit-setup-deps` settings in your `stack.yaml`+  and trusts the package's `.cabal` file to explicitly state all its+  dependencies.+* If system package installation fails, `get-stack.sh` will fail as well. Also+  shows warning suggesting to run `apt-get update` or similar, depending on the+  OS.+  ([#2898](https://github.com/commercialhaskell/stack/issues/2898))+* When `stack ghci` is run with a config with no packages (e.g. global project),+  it will now look for source files in the current work dir.+  ([#2878](https://github.com/commercialhaskell/stack/issues/2878))+* Bump to hpack 0.17.0 to allow `custom-setup` and `!include "..."` in `package.yaml`.+* The script interpreter will now output error logging.  In particular,+  this means it will output info about plan construction errors.+  ([#2879](https://github.com/commercialhaskell/stack/issues/2879))+* `stack ghci` now takes `--flag` and `--ghc-options` again (inadverently+  removed in 1.3.0).+  ([#2986](https://github.com/commercialhaskell/stack/issues/2986))+* `stack exec` now takes `--rts-options` which passes the given arguments inside of+  `+RTS ... args .. -RTS` to the executable. This works around stack itself consuming+  the RTS flags on Windows. ([#2986](https://github.com/commercialhaskell/stack/issues/2640))+* Upgraded `http-client-tls` version, which now offers support for the+  `socks5://` and `socks5h://` values in the `http_proxy` and `https_proxy`+  environment variables.++Bug fixes:++* Bump to hpack 0.16.0 to avoid character encoding issues when reading and+  writing on non-UTF8 systems.+* `stack ghci` will no longer ignore hsSourceDirs that contain `..`. ([#2895](https://github.com/commercialhaskell/stack/issues/2895))+* `stack list-dependencies --license` now works for wired-in-packages,+  like base. ([#2871](https://github.com/commercialhaskell/stack/issues/2871))+* `stack setup` now correctly indicates when it uses system ghc+  ([#2963](https://github.com/commercialhaskell/stack/issues/2963))+* Fix to `stack config set`, in 1.3.2 it always applied to+  the global project.+  ([#2709](https://github.com/commercialhaskell/stack/issues/2709))+* Previously, cabal files without exe or lib would fail on the "copy" step.+  ([#2862](https://github.com/commercialhaskell/stack/issues/2862))+* `stack upgrade --git` now works properly.  Workaround for affected+  versions (>= 1.3.0) is to instead run `stack upgrade --git --source-only`.+  ([#2977](https://github.com/commercialhaskell/stack/issues/2977))+* Added support for GHC 8's slightly different warning format for+  dumping warnings from logs.+* Work around a bug in Cabal/GHC in which package IDs are not unique+  for different source code, leading to Stack not always rebuilding+  packages depending on local packages which have+  changed. ([#2904](https://github.com/commercialhaskell/stack/issues/2904))+ ## 1.3.2  Bug fixes:
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2016, Stack contributors+Copyright (c) 2015-2017, Stack contributors All rights reserved.  Redistribution and use in source and binary forms, with or without
doc/ChangeLog.md view
@@ -1,5 +1,119 @@ # Changelog +## 1.4.0++Release notes:++* Docker images:+  [fpco/stack-full](https://hub.docker.com/r/fpco/stack-full/) and+  [fpco/stack-run](https://hub.docker.com/r/fpco/stack-run/)+  are no longer being built for LTS 8.0 and above.+  [fpco/stack-build](https://hub.docker.com/r/fpco/stack-build/)+  images continue to be built with a+  [simplified process](https://github.com/commercialhaskell/stack/tree/master/etc/dockerfiles/stack-build).+  [#624](https://github.com/commercialhaskell/stack/issues/624)++Major changes:++* A new command, `script`, has been added, intended to make the script+  interpreter workflow more reliable, easier to use, and more+  efficient. This command forces the user to provide a `--resolver`+  value, ignores all config files for more reproducible results, and+  optimizes the existing package check to make the common case of all+  packages already being present much faster. This mode does require+  that all packages be present in a snapshot, however.+  [#2805](https://github.com/commercialhaskell/stack/issues/2805)++Behavior changes:++* The default package metadata backend has been changed from Git to+  the 01-index.tar.gz file, from the hackage-security project. This is+  intended to address some download speed issues from Github for+  people in certain geographic regions. There is now full support for+  checking out specific cabal file revisions from downloaded tarballs+  as well. If you manually specify a package index with only a Git+  URL, Git will still be used. See+  [#2780](https://github.com/commercialhaskell/stack/issues/2780)+* When you provide the `--resolver` argument to the `stack unpack`+  command, any packages passed in by name only will be looked up in+  the given snapshot instead of taking the latest version. For+  example, `stack --resolver lts-7.14 unpack mtl` will get version+  2.2.1 of `mtl`, regardless of the latest version available in the+  package indices. This will also force the same cabal file revision+  to be used as is specified in the snapshot.++    Unpacking via a package identifier (e.g. `stack --resolver lts-7.14+    unpack mtl-2.2.1`) will ignore any settings in the snapshot and take+    the most recent revision.++    For backwards compatibility with tools relying on the presence of a+    `00-index.tar`, Stack will copy the `01-index.tar` file to+    `00-index.tar`. Note, however, that these files are different; most+    importantly, 00-index contains only the newest revisions of cabal+    files, while 01-index contains all versions. You may still need to+    update your tooling.+* Passing `--(no-)nix-*` options now no longer implies `--nix`, except for+  `--nix-pure`, so that the user preference whether or not to use Nix is+  honored even in the presence of options that change the Nix behavior.++Other enhancements:++* Internal cleanup: configuration types are now based much more on lenses+* `stack build` and related commands now allow the user to disable debug symbol stripping+  with new `--no-strip`, `--no-library-stripping`, and `--no-executable-shipping` flags,+  closing [#877](https://github.com/commercialhaskell/stack/issues/877).+  Also turned error message for missing targets more readable ([#2384](https://github.com/commercialhaskell/stack/issues/2384))+* `stack haddock` now shows index.html paths when documentation is already up to+  date. Resolved [#781](https://github.com/commercialhaskell/stack/issues/781)+* Respects the `custom-setup` field introduced in Cabal 1.24. This+  supercedes any `explicit-setup-deps` settings in your `stack.yaml`+  and trusts the package's `.cabal` file to explicitly state all its+  dependencies.+* If system package installation fails, `get-stack.sh` will fail as well. Also+  shows warning suggesting to run `apt-get update` or similar, depending on the+  OS.+  ([#2898](https://github.com/commercialhaskell/stack/issues/2898))+* When `stack ghci` is run with a config with no packages (e.g. global project),+  it will now look for source files in the current work dir.+  ([#2878](https://github.com/commercialhaskell/stack/issues/2878))+* Bump to hpack 0.17.0 to allow `custom-setup` and `!include "..."` in `package.yaml`.+* The script interpreter will now output error logging.  In particular,+  this means it will output info about plan construction errors.+  ([#2879](https://github.com/commercialhaskell/stack/issues/2879))+* `stack ghci` now takes `--flag` and `--ghc-options` again (inadverently+  removed in 1.3.0).+  ([#2986](https://github.com/commercialhaskell/stack/issues/2986))+* `stack exec` now takes `--rts-options` which passes the given arguments inside of+  `+RTS ... args .. -RTS` to the executable. This works around stack itself consuming+  the RTS flags on Windows. ([#2986](https://github.com/commercialhaskell/stack/issues/2640))+* Upgraded `http-client-tls` version, which now offers support for the+  `socks5://` and `socks5h://` values in the `http_proxy` and `https_proxy`+  environment variables.++Bug fixes:++* Bump to hpack 0.16.0 to avoid character encoding issues when reading and+  writing on non-UTF8 systems.+* `stack ghci` will no longer ignore hsSourceDirs that contain `..`. ([#2895](https://github.com/commercialhaskell/stack/issues/2895))+* `stack list-dependencies --license` now works for wired-in-packages,+  like base. ([#2871](https://github.com/commercialhaskell/stack/issues/2871))+* `stack setup` now correctly indicates when it uses system ghc+  ([#2963](https://github.com/commercialhaskell/stack/issues/2963))+* Fix to `stack config set`, in 1.3.2 it always applied to+  the global project.+  ([#2709](https://github.com/commercialhaskell/stack/issues/2709))+* Previously, cabal files without exe or lib would fail on the "copy" step.+  ([#2862](https://github.com/commercialhaskell/stack/issues/2862))+* `stack upgrade --git` now works properly.  Workaround for affected+  versions (>= 1.3.0) is to instead run `stack upgrade --git --source-only`.+  ([#2977](https://github.com/commercialhaskell/stack/issues/2977))+* Added support for GHC 8's slightly different warning format for+  dumping warnings from logs.+* Work around a bug in Cabal/GHC in which package IDs are not unique+  for different source code, leading to Stack not always rebuilding+  packages depending on local packages which have+  changed. ([#2904](https://github.com/commercialhaskell/stack/issues/2904))+ ## 1.3.2  Bug fixes:
doc/GUIDE.md view
@@ -16,8 +16,8 @@  ### What makes stack special? -The primary stack design point is __reproducible builds__. If you run `stack-build` today, you should get the same result running `stack build` tomorrow.+The primary stack design point is __reproducible builds__. If you run `stack build`+today, you should get the same result running `stack build` tomorrow. There are some cases that can break that rule (changes in your operating system configuration, for example), but, overall, stack follows this design philosophy closely. To make this a simple process, stack uses curated package sets@@ -195,7 +195,7 @@ Looking closely at the output of the previous command, you can see that it built both a library called "helloworld" and an executable called "helloworld-exe". We'll explain more in the next section, but, for now, just notice that the-executables are installed in our project's `./stack-work` directory.+executables are installed in our project's `./.stack-work` directory.  Now, Let's use `stack exec` to run our executable (which just outputs the string "someFunc"):@@ -207,7 +207,7 @@  `stack exec` works by providing the same reproducible environment that was used to build your project to the command that you are running. Thus, it knew where-to find `helloworld-exe` even though it is hidden in the `./stack-work`+to find `helloworld-exe` even though it is hidden in the `./.stack-work` directory.  ### stack test@@ -264,11 +264,11 @@  The `app/Main.hs`, `src/Lib.hs`, and `test/Spec.hs` files are all Haskell source files that compose the actual functionality of our project (we won't dwell on-them here). The LICENSE file has no impact on the build, but is there for-informational/legal purposes only. The files of interest here are Setup.hs,-helloworld.cabal, and stack.yaml.+them here). The `LICENSE` file has no impact on the build, but is there for+informational/legal purposes only. The files of interest here are `Setup.hs`,+`helloworld.cabal`, and `stack.yaml`. -The Setup.hs file is a component of the Cabal build system which stack uses.+The `Setup.hs` file is a component of the Cabal build system which stack uses. It's technically not needed by stack, but it is still considered good practice in the Haskell world to include it. The file we're using is straight boilerplate:@@ -278,7 +278,7 @@ main = defaultMain ``` -Next, let's look at our stack.yaml file, which gives our project-level settings:+Next, let's look at our `stack.yaml` file, which gives our project-level settings:  ```yaml flags: {}@@ -296,22 +296,22 @@ has powerful support for multi-package projects, which we'll elaborate on as this guide progresses. -The final field is resolver. This tells stack *how* to build your package:+The final field is `resolver`. This 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 version 3.2](https://www.stackage.org/lts-3.2), which implies GHC 7.10.2 (which is why `stack setup` installs that version of GHC). There are a number of values you-can use for resolver, which we'll cover later.+can use for `resolver`, which we'll cover later. -The final file of import is helloworld.cabal. stack is built on top of the+The final file of import is `helloworld.cabal`. stack is built on top of the Cabal build system. In Cabal, we have individual *packages*, each of which-contains a single .cabal file. The .cabal file can define 1 or more+contains a single `.cabal` file. The `.cabal` file can define 1 or more *components*: a library, executables, test suites, and benchmarks. It also specifies additional information such as library dependencies, default language pragmas, and so on.  In this guide, we'll discuss the bare minimum necessary to understand how to-modify a .cabal file. Haskell.org has the definitive [reference for the .cabal+modify a `.cabal` file. Haskell.org has the definitive [reference for the `.cabal` file format](https://www.haskell.org/cabal/users-guide/developing-packages.html).  ### The setup command@@ -328,8 +328,8 @@ ```  Thankfully, the command is smart enough to know not to perform an installation-twice. As the command output above indicates, you can use `stack-path` for quite a bit of path information (which we'll play with more later).+twice. As the command output above indicates, you can use `stack path`+for quite a bit of path information (which we'll play with more later). For now, we'll just look at where GHC is installed:  ```@@ -392,7 +392,7 @@  Notice that it says "Could not find module." This means that the package containing the module in question is not available. To tell stack to use text,-you need to add it to your .cabal file — specifically in your build-depends+you need to add it to your `.cabal` file — specifically in your build-depends section, like this:  ```@@ -496,7 +496,7 @@ someFunc = launchMissiles ``` -Again, we add this new dependency to the .cabal file like this:+Again, we add this new dependency to the `.cabal` file like this:  ``` library@@ -538,9 +538,9 @@ text package, it just worked, because it was part of the lts-3.2 *package set*. But acme-missiles is not part of that package set, so building failed. -To add this new dependency, we'll use the `extra-deps` field in stack.yaml to+To add this new dependency, we'll use the `extra-deps` field in `stack.yaml` to define extra dependencies not present in the resolver. With that change, our-stack.yaml looks like:+`stack.yaml` looks like:  ```yaml flags: {}@@ -564,7 +564,7 @@ * The ability to perform a Hoogle search on the packages in this snapshot * A [list of all modules](https://www.stackage.org/lts-3.2/docs) in a snapshot,   which can be useful when trying to determine which package to add to your-  .cabal file+  `.cabal` file  You can also see a [list of all available snapshots](https://www.stackage.org/snapshots). You'll notice two flavors: LTS@@ -576,7 +576,7 @@ ## Resolvers and changing your compiler version  Let's explore package sets a bit further. Instead of lts-3.2, let's change our-stack.yaml file to use+`stack.yaml` file to use [nightly-2015-08-26](https://www.stackage.org/nightly-2015-08-26). Rerunning `stack build` will produce: @@ -621,7 +621,7 @@ versions of resolvers: `--resolver nightly` will use the newest Nightly resolver available, `--resolver lts` will use the newest LTS, and `--resolver lts-2` will use the newest LTS in the 2.X series. The reason these are only available on the-command line and not in your stack.yaml file is that using them:+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    the latest available LTS each time it builds)@@ -685,8 +685,8 @@ Alright, enough playing around with simple projects. Let's take an open source package and try to build it. We'll be ambitious and use [yackage](https://www.stackage.org/package/yackage), a local package server-using [Yesod](http://www.yesodweb.com/). To get the code, we'll use the `stack-unpack` command:+using [Yesod](http://www.yesodweb.com/). To get the code, we'll use the+`stack unpack` command:  ``` cueball:~$ stack unpack yackage-0.8.0@@ -695,7 +695,7 @@ ```  ### stack init-This new directory does not have a stack.yaml file, so we need to make one+This new directory does not have a `stack.yaml` file, so we need to make one first. We could do it by hand, but let's be lazy instead with the `stack init` command: @@ -717,7 +717,7 @@  stack init does quite a few things for you behind the scenes: -* Finds all of the .cabal files in your current directory and subdirectories+* Finds all of the `.cabal` files in your current directory and subdirectories   (unless you use `--ignore-subdirs`) and determines the packages and versions   they require * Finds the best combination of snapshot and package flags that allows everything to@@ -725,7 +725,7 @@ * It tries to look for the best matching snapshot from latest LTS, latest   nightly, other LTS versions in that order -Assuming it finds a match, it will write your stack.yaml file, and everything+Assuming it finds a match, it will write your `stack.yaml` file, and everything will work.  #### External Dependencies@@ -813,7 +813,7 @@ All done. ``` -As you can verify by viewing stack.yaml, three external dependencies were added+As you can verify by viewing `stack.yaml`, three external dependencies were added by stack init:  ```@@ -825,20 +825,20 @@ ```  Of course, you could have added the external dependencies by manually editing-stack.yaml but stack init does the hard work for you.+`stack.yaml` but stack init does the hard work for you.  #### Excluded Packages  Sometimes multiple packages in your project may have conflicting requirements. In that case `stack init` will fail, so what do you do? -You could manually create stack.yaml by omitting some packages to resolve the+You could manually create `stack.yaml` by omitting some packages to resolve the conflict. Alternatively you can ask `stack init` to do that for you by specifying `--omit-packages` flag on the command line. Let's see how that works.  To simulate a conflict we will use acme-missiles-0.3 in yackage and we will-also copy yackage.cabal to another directory and change the name of the file+also copy `yackage.cabal` to another directory and change the name of the file and package to yackage-test. In this new package we will use acme-missiles-0.2 instead. Let's see what happens when we run solver: @@ -908,8 +908,8 @@ #### Using a specific resolver  Sometimes you may want to use a specific resolver for your project instead of-`stack init` picking one for you. You can do that by using `stack init---resolver <resolver>`.+`stack init` picking one for you. You can do that by using+`stack init --resolver <resolver>`.  You can also init with a compiler resolver if you do not want to use a snapshot. That will result in all of your project's dependencies being put@@ -930,7 +930,7 @@ same name, stack init will report those and automatically ignore one of them.  _Ignore subdirectories_: By default stack init searches all the subdirectories-for .cabal files. If you do not want that then you can use `--ignore-subdirs`+for `.cabal` files. If you do not want that then you can use `--ignore-subdirs` command line switch.  _Cabal warnings_: stack init will show warnings if there were issues in reading@@ -1039,7 +1039,7 @@ By default it does not make changes to the config. As it suggested you can use `--update-config` to make changes to the config. -NOTE: You should probably back up your stack.yaml before doing this, such as+NOTE: You should probably back up your `stack.yaml` before doing this, such as committing to Git/Mercurial/Darcs.  Sometimes, you may want to use specific versions of certain packages for your@@ -1047,8 +1047,8 @@ extra-deps section and then use `stack solver` to figure out whether it is feasible to use those or what other dependencies are needed as a result. -If you want to change the resolver for your project, you can run `stack solver---resolver <resolver name>` and it will figure out the changes needed for you.+If you want to change the resolver for your project, you can run+`stack solver --resolver <resolver name>` and it will figure out the changes needed for you.  Let's see what happens if we change the resolver to lts-2.22: @@ -1252,8 +1252,8 @@  That's why the download page recommends adding that directory to your `PATH` environment variable. This feature is convenient, because now you can simply-run `executable-name` in your shell instead of having to run `stack exec-executable-name` from inside your project directory.+run `executable-name` in your shell instead of having to run+`stack exec executable-name` from inside your project directory.  Since it's such a point of confusion, let me list a number of things stack does *not* do specially for the install command:@@ -1402,7 +1402,7 @@ # Goes off to build a whole bunch of packages ``` -If you look at the stack.yaml, you'll see exactly what you'd expect:+If you look at the `stack.yaml`, you'll see exactly what you'd expect:  ```yaml flags:@@ -1435,7 +1435,7 @@  ### Cabal flag management -In the stack.yaml file above, you can see that `stack init` has detected that —+In the `stack.yaml` file above, you can see that `stack init` has detected that — for the yackage package — the upload flag can be set to true, and for wai-app-static, the print flag to false (it's chosen those values because they're the default flag values, and their dependencies are compatible with the@@ -1512,7 +1512,7 @@ confusion.  Final point: if you have GHC options that you'll be regularly passing to your-packages, you can add them to your stack.yaml file (starting with+packages, you can add them to your `stack.yaml` file (starting with stack-0.1.4.0). See [the documentation section on ghc-options](yaml_configuration.md#ghc-options) for more information.@@ -1618,7 +1618,7 @@  IMPORTANT NOTE: If you have added upstream packages to your project please make sure to mark them as *dependency package*s for faster and reliable usage of-`stack gchi`. Otherwise GHCi may have trouble due to conflicts of compilation+`stack ghci`. Otherwise GHCi may have trouble due to conflicts of compilation flags or having to unnecessarily interpret too many modules. See [stack.yaml documentation](yaml_configuration.md#packages) to learn how to mark a package as a *dependency package*.@@ -1626,8 +1626,8 @@ ## ghc/runghc  You'll sometimes want to just compile (or run) a single Haskell source file,-instead of creating an entire Cabal package for it. You can use `stack exec-ghc` or `stack exec runghc` for that. As simple helpers, we also provide the+instead of creating an entire Cabal package for it. You can use `stack exec ghc`+or `stack exec runghc` for that. As simple helpers, we also provide the `stack ghc` and `stack runghc` commands, for these common cases.  ## script interpreter@@ -1646,23 +1646,17 @@ An example will be easiest to understand:  ```-michael@d30748af6d3d:~$ cat turtle.hs+michael@d30748af6d3d:~$ cat turtle-example.hs #!/usr/bin/env stack--- stack --resolver lts-3.2 --install-ghc runghc --package turtle+-- stack --resolver lts-6.25 script --package turtle {-# LANGUAGE OverloadedStrings #-} import Turtle main = echo "Hello World!"-michael@d30748af6d3d:~$ chmod +x turtle.hs-michael@d30748af6d3d:~$ ./turtle.hs-Run from outside a project, using implicit global project config-Using resolver: lts-3.2 specified on command line-hashable-1.2.3.3: configure-# installs some more dependencies-Completed all 22 actions.+michael@d30748af6d3d:~$ chmod +x turtle-example.hs+michael@d30748af6d3d:~$ ./turtle-example.hs+Completed 5 action(s). Hello World!-michael@d30748af6d3d:~$ ./turtle.hs-Run from outside a project, using implicit global project config-Using resolver: lts-3.2 specified on command line+michael@d30748af6d3d:~$ ./turtle-example.hs Hello World! ``` @@ -1680,11 +1674,30 @@ If you're on Windows: you can run `stack turtle.hs` instead of `./turtle.hs`. The shebang line is not required in that case. +### Using multiple packages++You can also specify multiple packages, either with multiple `--package`+arguments, or by providing a comma or space separated list. For example:++```+#!/usr/bin/env stack+{- stack+  script+  --resolver lts-6.25+  --package turtle+  --package "stm async"+  --package http-client,http-conduit+-}+```+ ### Stack configuration for scripts -If the current working directory is inside a project then that project's stack-configuration is effective when running the script. Otherwise the script uses-the global project configuration specified in+With the `script` command, all Stack configuration files are ignored to provide a+completely reliable script running experience. However, see the example below+with `runghc` for an approach to scripts which will respect your configuration+files. When using `runghc`, if the current working directory is inside a+project then that project's stack configuration is effective when running the+script. Otherwise the script uses the global project configuration specified in `~/.stack/global-project/stack.yaml`.  ### Specifying interpreter options@@ -1703,53 +1716,64 @@ a multi line block comment with ghc options:  ```-  #!/usr/bin/env stack-  {- stack-    --resolver lts-3.2-    --install-ghc-    runghc-    --package turtle-    ---    -hide-all-packages-  -}+#!/usr/bin/env stack+{- stack+  script+  --resolver lts-6.25+  --package turtle+  --+  +RTS -s -RTS+-} ```  ### Writing independent and reliable scripts -Independent means that the script is independent of any prior deployment-specific configuration. If required, the script will install everything it-needs automatically on any machine that it runs on. To make a script always-work irrespective of any specific environment configuration you can do the-following:+With the release of Stack 1.2.1, there is a new command, `script`, which will+automatically: +* Install GHC and libraries if missing+* 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+all packages every time it runs so that the script does not break by+accidentally using incompatible package versions.++In previous versions of Stack, the `runghc` command was used for scripts+instead. In order to achieve the same effect with the `runghc` command, you can+do the following:+ 1. Use the `--install-ghc` option to install the compiler automatically 2. Explicitly specify all packages required by the script using the `--package` option. Use `-hide-all-packages` ghc option to force explicit specification of all packages.+3. Use the `--resolver` Stack option to ensure a specific GHC version and+   package set is used. -Reliable means the script will use exactly the same version of all packages-every time it runs so that the script does not break by accidentally using-incompatible package versions. To achieve that use an explicit `--resolver`-stack option.+Even with this configuration, it is still possible for configuration+files to impact `stack runghc`, which is why `stack script` is strongly+recommended in general. For those curious, here is an example with `runghc`: -Here is an interpreter comment for a completely self-contained and reproducible-version of our toy example: ```-  #!/usr/bin/env stack-  {- stack-    --resolver lts-3.2-    --install-ghc-    runghc-    --package base-    --package turtle-    ---    -hide-all-packages+#!/usr/bin/env stack+{- stack+  --resolver lts-6.25+  --install-ghc+  runghc+  --package base+  --package turtle+  --+  -hide-all-packages   -} ``` +The `runghc` command is still very useful, especially when you're working on a+project and want to access the package databases and configurations used by+that project. See the next section for more information on configuration files.+ ## Finding project configs, and the implicit global -Whenever you run something with stack, it needs a stack.yaml project file. The+Whenever you run something with stack, it needs a `stack.yaml` project file. The algorithm stack uses to find this is:  1. Check for a `--stack-yaml` option on the command line@@ -1759,11 +1783,11 @@ The first two provide a convenient method for using an alternate configuration. For example: `stack build --stack-yaml stack-7.8.yaml` can be used by your CI system to check your code against GHC 7.8. Setting the `STACK_YAML` environment-variable can be convenient if you're going to be running commands like `stack-ghc` in other directories, but you want to use the configuration you defined in+variable can be convenient if you're going to be running commands like `stack ghc`+in other directories, but you want to use the configuration you defined in a specific project. -If stack does not find a stack.yaml in any of the three specified locations,+If stack does not find a `stack.yaml` in any of the three specified locations, the *implicit global* logic kicks in. You've probably noticed that phrase a few times in the output from commands above. Implicit global is essentially a hack to allow stack to be useful in a non-project setting. When no implicit global@@ -1778,20 +1802,20 @@ 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. -## stack.yaml vs .cabal files+## `stack.yaml` vs `.cabal` files  Now that we've covered a lot of stack use cases, this quick summary of-stack.yaml vs .cabal files will hopefully make sense and be a good reminder for+`stack.yaml` vs `.cabal` files will hopefully make sense and be a good reminder for future uses of stack:  * A project can have multiple packages.-* Each project has a stack.yaml.-* Each package has a .cabal file.-* The .cabal file specifies which packages are dependencies.-* The stack.yaml file specifies which packages are available to be used.-* .cabal specifies the components, modules, and build flags provided by a package-* stack.yaml can override the flag settings for individual packages-* stack.yaml specifies which packages to include+* Each project has a `stack.yaml`.+* Each package has a `.cabal` file.+* The `.cabal` file specifies which packages are dependencies.+* The `stack.yaml` file specifies which packages are available to be used.+* `.cabal` specifies the components, modules, and build flags provided by a package+* `stack.yaml` can override the flag settings for individual packages+* `stack.yaml` specifies which packages to include  ## Comparison to other tools @@ -1810,7 +1834,7 @@ Before jumping into the differences, let me clarify an important similarity:  __Same package format.__ stack, cabal-install, and presumably all other tools-share the same underlying Cabal package format, consisting of a .cabal file,+share the same underlying Cabal package format, consisting of a `.cabal` file, modules, etc. This is a Good Thing: we can share the same set of upstream libraries, and collaboratively work on the same project with stack, cabal-install, and NixOS. In that sense, we're sharing the same ecosystem.@@ -1839,8 +1863,8 @@       packages. So for example, in stack, `stack test` does the same job as       `cabal install --run-tests`, though the latter *additionally* performs an       installation that you may not want. The closer command equivalent is-      `cabal install --enable-tests --only-dependencies && cabal configure-      --enable-tests && cabal build && cabal test` (newer versions of+      `cabal install --enable-tests --only-dependencies && cabal configure --enable-tests && cabal build && cabal test`+      (newer versions of       cabal-install may make this command shorter). * __Isolated by default__.     * This has been a pain point for new stack users. In cabal, the@@ -2038,12 +2062,12 @@   most users won't use it regularly. It does what you'd expect: downloads a   tarball and unpacks it. * `stack sdist` generates an uploading tarball containing your package code-* `stack upload` uploads an sdist to Hackage. In the future, it will also-  perform automatic GPG signing of your packages for additional security, when-  configured.-    * `--sign` provides a way to GPG sign your package & submit the result to-      sig.commercialhaskell.org for storage in the sig-archive git-      repo. (Signatures will be used later to verify package integrity.)+* `stack upload` uploads an sdist to Hackage. As of+  version [1.1.0](https://docs.haskellstack.org/en/latest/ChangeLog/#110) stack+  will also attempt to GPG sign your packages as+  per+  [our blog post](https://www.fpcomplete.com/blog/2016/05/stack-security-gnupg-keys).+    * `--no-signature` disables signing of packages * `stack upgrade` will build a new version of stack from source.     * `--git` is a convenient way to get the most recent version from master for       those testing and living on the bleeding edge.@@ -2101,10 +2125,11 @@  ### DWARF -`stack` currently doesn't support debugging and profiling with-[DWARF information](https://ghc.haskell.org/trac/ghc/wiki/DWARF)-as it strips executables automatically. This may change in the future (see-[#877](https://github.com/commercialhaskell/stack/issues/877)).+`stack` now supports debugging and profiling with+[DWARF information](https://ghc.haskell.org/trac/ghc/wiki/DWARF),+using the `--no-strip`, `--no-library-stripping`, and `--no-executable-shipping`+flags to disable the default behavior of removing such information from compiled+libraries and executables.  ### Further reading
doc/MAINTAINER_GUIDE.md view
@@ -2,18 +2,17 @@  ## Next release: -* Stop building Linux distro-  packages [#2534](https://github.com/commercialhaskell/stack/issues/2534)- ## Pre-release steps  * Ensure `release` and `stable` branches merged to `master`-* Check compatibility with latest stackage snapshot+* Check compatibility with latest nightly stackage snapshot:+    * Update `stack-nightly.yaml` with latest nightly and remove extra-deps+    * Run `stack --stack-yaml=stack-nightly.yaml test` * Ensure integration tests pass on a representative Windows, macOS, and Linux (Linux-  is handled by Jenkins automatically): `stack install --pedantic && stack test-  --pedantic --flag stack:integration-tests` . The actual release script will-  perform a more thorough test for every platform/variant prior to uploading, so-  this is just a pre-check+  is handled by Jenkins automatically):+  `stack install --pedantic && stack test --pedantic --flag stack:integration-tests`.+  The actual release script will perform a more thorough test for every platform/variant+  prior to uploading, so this is just a pre-check * Ensure `stack haddock` works (Travis CI now does this) * Stack builds with `stack-7.8.yaml` (Travis CI now does this) * stack can build the wai repo@@ -43,10 +42,10 @@         * Look for any links to "latest" documentation, replace with version tag         * Ensure all documentation pages listed in `mkdocs.yaml`     * Update the ISSUE_TEMPLATE.md to point at the new version.-    * Check that any new Linux distribution versions added to+    * (SKIP) Check that any new Linux distribution versions added to       `etc/scripts/release.hs` and `etc/scripts/vagrant-releases.sh`         * [Ubuntu](https://wiki.ubuntu.com/Releases)-        * [Debian](https://www.debian.org/releases/) (keep at least latest two)+        * [Debian](https://www.debian.org/releases/)         * [CentOS](https://wiki.centos.org/Download)         * [Fedora](https://fedoraproject.org/wiki/Releases)     * Check for new [FreeBSD release](https://www.freebsd.org/releases/).@@ -55,9 +54,16 @@       [install_and_upgrade.md](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md),       and       `README.md`-    * Remove unsupported/obsolete distribution versions from-      [install_and_upgrade.md](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md),-      and perhaps from the release process.+    * Remove unsupported/obsolete distribution versions from the release process.+        * [Ubuntu](https://wiki.ubuntu.com/Releases)+            * 12.04 EOL 2017-APR+            * 16.10 EOL 2017-JUL+            * 14.04 EOL 2019-APR+            * 16.04 EOL 2021-APR+        * [Debian](https://www.debian.org/releases/)+        * [CentOS](https://wiki.centos.org/Download) +            * 6 EOL 2020-NOV-30+            * 7 EOL 2024-JUN-30  ## Release process @@ -67,8 +73,8 @@  A note about the `etc/scripts/*-releases.sh` scripts: if you run them from a different working tree than the scripts themselves (e.g. if you have `stack1`-and `stack2` trees, and run `cd stack1;-../stack2/etc/scripts/vagrant-release.sh`) the scripts and Vagrantfiles from the+and `stack2` trees, and run `cd stack1; ../stack2/etc/scripts/vagrant-release.sh`)+the scripts and Vagrantfiles from the tree containing the script will be used to build the stack code in the current directory. That allows you to iterate on the release process while building a consistent and clean stack version.@@ -104,8 +110,8 @@ * Build sdist using `stack sdist . --pvp-bounds=both`, and upload it to the   Github release with a name like `stack-X.Y.Z-sdist-0.tar.gz`. -* Publish Github release. Use e.g. `git shortlog -s v1.1.2..rc/v1.2.0|sed-  's/^[0-9 ]*/* /'|sort -f` to get the list of contributors.+* Publish Github release. Use e.g. `git shortlog -s v1.1.2..rc/v1.2.0|sed 's/^[0-9 ]*/* /'|sort -f`+  to get the list of contributors.  * Upload package to Hackage: `stack upload . --pvp-bounds=both` @@ -120,11 +126,9 @@  * (SKIP) [Flag the Arch Linux package as out-of-date](https://www.archlinux.org/packages/community/x86_64/stack/flag/) -* Push signed Git tag, matching Github release tag name, e.g.: `git tag -d vX.Y.Z; git tag -u-  0x575159689BEFB442 vX.Y.Z && git push -f origin vX.Y.Z`+* Push signed Git tag, matching Github release tag name, e.g.: `git tag -d vX.Y.Z; git tag -u 0x575159689BEFB442 vX.Y.Z && git push -f origin vX.Y.Z` -* Reset the `release` branch to the released commit, e.g.: `git checkout release-  && git merge --ff-only vX.Y.Z && git push origin release`+* Reset the `release` branch to the released commit, e.g.: `git checkout release && git merge --ff-only vX.Y.Z && git push origin release`  * Update the `stable` branch similarly @@ -368,6 +372,9 @@     In the case of macOS, repackage the `.xz` bindist as a `.bz2`, since macOS does     not include `xz` by default or provide an easy way to install it. +    The script at `etc/scripts/mirror-ghc-bindists-to-github.sh` will help with+    this. See the comments within the script.+   * Build any additional required bindists (see below for instructions)        * tinfo6 (`etc/vagrant/fedora24-x86_64`)@@ -384,9 +391,10 @@  For GHC >= 7.10.2, set the `GHC_VERSION` environment variable to the version to build: -    * `export GHC_VERSION=8.0.1`-    * `export GHC_VERSION=7.10.3a`-    * `export GHC_VERSION=7.10.2`+  * `export GHC_VERSION=8.0.2`+  * `export GHC_VERSION=8.0.1`+  * `export GHC_VERSION=7.10.3a`+  * `export GHC_VERSION=7.10.2`  then, run (from [here](https://ghc.haskell.org/trac/ghc/wiki/Newcomers)):
doc/README.md view
@@ -27,7 +27,7 @@ operating system/distribution:  * [Windows](install_and_upgrade.md#windows)-* [macOS](install_and_upgrade.md#mac-os-x)+* [macOS](install_and_upgrade.md#macos) * [Ubuntu](install_and_upgrade.md#ubuntu) * [Debian](install_and_upgrade.md#debian) * [CentOS / Red Hat / Amazon Linux](install_and_upgrade.md#centos)
doc/build_command.md view
@@ -22,8 +22,8 @@ * `stack install` is the same as `stack build --copy-bins`  The advantage of the synonym commands is that they're convenient and short. The-advantage of the options is that they compose. For example, `stack build --test---copy-bins` will build libraries, executables, and test suites, run the test+advantage of the options 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). @@ -56,8 +56,8 @@  ## Target syntax -In addition to a number of options (like the aforementioned `--test`), `stack-build` takes a list of zero or more *targets* to be built. There are a number+In addition to a number of options (like the aforementioned `--test`), `stack build`+takes a list of zero or more *targets* to be built. There are a number of different syntaxes supported for this list:  *   *package*, e.g. `stack build foobar`, is the most commonly used target. It@@ -94,8 +94,7 @@       have a component with the same name. To continue the above example,       `stack build :mytestsuite`.         * Side note: the commonly requested `run` command is not available-          because it's a simple combination of `stack build :exename && stack-          exec exename`+          because it's a simple combination of `stack build :exename && stack exec exename`  * *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@@ -106,8 +105,7 @@  Finally: if you provide no targets (e.g., running `stack build`), stack will implicitly pass in all of your local packages. If you only want to target-packages in the current directory or deeper, you can pass in `.`, e.g. `stack-build .`.+packages in the current directory or deeper, you can pass in `.`, e.g. `stack build .`.  To get a list of the available targets in your project, use `stack ide targets`.
doc/coverage.md view
@@ -22,8 +22,8 @@ 2) A unified textual and HTML report, considering the coverage on all local   libraries, based on all of the tests that were run. -3) An index of all generated HTML reports, at `$(stack path-   --local-hpc-root)/index.html`.+3) An index of all generated HTML reports, at+  `$(stack path --local-hpc-root)/index.html`.  ## "stack hpc report" command @@ -81,8 +81,8 @@    When switching on this flag, it will usually cause all local packages to be    rebuilt (see [#1940](https://github.com/commercialhaskell/stack/issues/1940). -2. Before the build runs with `--coverage`, the contents of `stack path-   --local-hpc-root` gets deleted. This prevents old reports from getting mixed+2. Before the build runs with `--coverage`, the contents of `stack path --local-hpc-root`+   gets deleted. This prevents old reports from getting mixed    with new reports. If you want to preserve report information from multiple    runs, copy the contents of this path to a new folder. @@ -90,8 +90,8 @@    it will be deleted.  4. After a test run, it will expect a `test-name.tix` file to exist. This file-   will then get loaded, modified, and outputted to `$(stack path-   --local-hpc-root)/pkg-name/test-name/test-name.tix)`.+   will then get loaded, modified, and outputted to+   `$(stack path --local-hpc-root)/pkg-name/test-name/test-name.tix)`.     The `.tix` file gets modified to remove coverage file that isn't associated    with a library. So, this means that you won't get coverage information for@@ -107,8 +107,8 @@  5. Once we have a `.tix` file for a test, we also generate a textual and HTML    report for it. The textual report is sent to the terminal. The index of the-   test-specific HTML report is available at `$(stack path-   --local-hpc-root)/pkg-name/test-name/index.html`+   test-specific HTML report is available at+   `$(stack path --local-hpc-root)/pkg-name/test-name/index.html`  6. After the build completes, if there are multiple output `*.tix` files, they    get combined into a unified report. The index of this report will be@@ -116,5 +116,4 @@  7. Finally, an index of the resulting coverage reports is generated. It links to    the individual coverage reports (one for each test-suite), as well as the-   unified report. This index is available at `$(stack path-   --local-hpc-root)/index.html`+   unified report. This index is available at `$(stack path --local-hpc-root)/index.html`
doc/docker_integration.md view
@@ -137,8 +137,8 @@ ### reset - Reset the Docker "sandbox"  In order to preserve the contents of the in-container home directory between-runs, a special "sandbox" directory is volume-mounted into the container. `stack-docker reset` will reset that sandbox to its defaults.+runs, a special "sandbox" directory is volume-mounted into the container.+`stack docker reset` will reset that sandbox to its defaults.  Note: `~/.stack` is separately volume-mounted, and is left alone during reset. @@ -268,19 +268,6 @@ - [fpco/stack-build](https://registry.hub.docker.com/u/fpco/stack-build/) (the   default) - GHC (patched), tools (stack, cabal-install, happy, alex, etc.), and   system developer libraries required to build all Stackage packages.-- [fpco/stack-ghcjs-build](https://registry.hub.docker.com/u/fpco/stack-ghcjs-build/) --  Like `stack-build`, but adds GHCJS.-- [fpco/stack-full](https://registry.hub.docker.com/u/fpco/stack-full/) --  Includes all Stackage packages pre-installed in GHC's global package database.-  These images are over 10 GB!-- [fpco/stack-ghcjs-full](https://registry.hub.docker.com/u/fpco/stack-ghcjs-full/) --  Like `stack-full`, but adds GHCJS.-- [fpco/stack-run](https://registry.hub.docker.com/u/fpco/stack-run/) --  Runtime environment for binaries built with Stackage. Includes system shared-  libraries required by all Stackage packages. Does not necessarily include all-  data required for every use (e.g. has texlive-binaries for HaTeX, but does not-  include LaTeX fonts), as that would be prohibitively large. Based on-  [phusion/baseimage](https://registry.hub.docker.com/u/phusion/baseimage/).  FP Complete also builds custom variants of these images for their clients. @@ -323,8 +310,8 @@ ### Volume-mounts and ephemeral containers  Since filesystem changes outside of the volume-mounted project directory are not-persisted across runs, this means that if you `stack exec sudo apt-get install-some-ubuntu-package`, that package will be installed but then the container it's+persisted across runs, this means that if you `stack exec sudo apt-get install some-ubuntu-package`,+that package will be installed but then the container it's installed in will disappear, thus causing it to have no effect. If you wish to make this kind of change permanent, see later instructions for how to create a [derivative Docker image](#derivative-image).@@ -353,8 +340,8 @@  If you do want to do all your work, including editing, in the container, it might be better to use a persistent container in which you can install Ubuntu-packages. You could get that by running something like `stack---docker-container-name=NAME --docker-persist exec --plain bash`. This+packages. You could get that by running something like+`stack --docker-container-name=NAME --docker-persist exec --plain bash`. This means when the container exits, it won't be deleted. You can then restart it using `docker start -a -i NAME`. It's also possible to detach from a container while it continues running in the background using by pressing Ctrl-P Ctrl-Q,@@ -419,17 +406,16 @@ ### "No Space Left on Device", but 'df' shows plenty of disk space  This is likely due to the storage driver Docker is using, in combination with-the large size and number of files in these images. Use `docker info|grep-'Storage Driver'` to determine the current storage driver.+the large size and number of files in these images. Use `docker info|grep 'Storage Driver'`+to determine the current storage driver.  We recommend using either the `overlay` or `aufs` storage driver for stack, as they are least likely to give you trouble.  On Ubuntu, `aufs` is the default for new installations, but older installations sometimes used `devicemapper`. -The `devicemapper` storage driver's default configuration limits it to a 10 GB-file system, which the "full" images exceed. We have experienced other-instabilities with it as well on Ubuntu, and recommend against its use for this-purpose.+The `devicemapper` storage driver's doesn't work well with large filesystems,+and we have experienced other instabilities with it as well. We recommend+against its use.  The `btrfs` storage driver has problems running out of metadata space long before running out of actual disk space, which requires rebalancing or adding@@ -467,9 +453,8 @@ <small> The above commands turn off `dnsmasq` usage in NetworkManager configuration and restart network manager.  They can be reversed by executing-`sudo sed 's@#dns=dnsmasq@dns=dnsmasq@' -i-/etc/NetworkManager/NetworkManager.conf && sudo service network-manager-restart`.  These instructions are adapted from+`sudo sed 's@#dns=dnsmasq@dns=dnsmasq@' -i /etc/NetworkManager/NetworkManager.conf && sudo service network-manager restart`.+These instructions are adapted from [the Shipyard Project's QuickStart guide](https://github.com/shipyard/shipyard/wiki/QuickStart#127011-dns-server-problem-on-ubuntu). </small>
doc/faq.md view
@@ -191,9 +191,8 @@  ## How do I upgrade to GHC 7.10.2 with stack? -If you already have a prior version of GHC use `stack --resolver ghc-7.10 setup---reinstall`. If you don't have any GHC installed, you can skip the-`--reinstall`.+If you already have a prior version of GHC use `stack --resolver ghc-7.10 setup --reinstall`.+If you don't have any GHC installed, you can skip the `--reinstall`.  ## How do I get extra build tools? @@ -201,8 +200,8 @@ dependencies, in particular alex and happy.  __NOTE__: This works when using lts or nightly resolvers, not with ghc or-custom resolvers. You can manually install build tools by running, e.g., `stack-build alex happy`.+custom resolvers. You can manually install build tools by running, e.g.,+`stack build alex happy`.  ## How does stack choose which snapshot to use when creating a new config file? @@ -402,7 +401,7 @@ The issue may be related to the use of hardening flags in some cases, specifically those related to producing position independent executables (PIE). This is tracked upstream in the [following-ticket](https://ghc.haskell.org/trac/ghc/ticket/9007). Some distributions add+ticket](https://ghc.haskell.org/trac/ghc/ticket/12759). Some distributions add such hardening flags by default which may be the cause of some instances of the problem. Therefore, a possible workaround might be to turn off PIE related flags.@@ -418,8 +417,8 @@ ## Where does the output from `--ghc-options=-ddump-splices` (and other `-ddump*` options) go?  These are written to `*.dump-*` files inside the package's `.stack-work`-directory. Specifically, they will be available at `PKG-DIR/$(stack path---dist-dir)/build/SOURCE-PATH`, where `SOURCE-PATH` is the path to the source+directory. Specifically, they will be available at+`PKG-DIR/$(stack path --dist-dir)/build/SOURCE-PATH`, where `SOURCE-PATH` is the path to the source file, relative to the location of the `*.cabal` file. When building named components such as test-suites, `SOURCE-PATH` will also include `COMPONENT/COMPONENT-tmp`, where `COMPONENT` is the name of the component.@@ -488,3 +487,10 @@  Use the `SYSTEM_CERTIFICATE_PATH` environment variable to point at the directory where you keep your SSL certificates.++## How do I get `verbose` output from GHC when I build with cabal?++Unfortunately `stack build` does not have an obvious equivalent to `cabal build -vN` which shows verbose output from GHC when building. The easiest workaround is to add `ghc-options: -vN` to the .cabal file or pass it via `stack build --ghc-options="-v"`.++## Does Stack support the Hpack specification?+Yes. You can run `stack init` as usual and Stack will create a matching `stack.yaml`.
doc/ghcjs.md view
@@ -9,9 +9,9 @@ You can also build existing stack projects which target GHC, and instead build them with GHCJS.  For example: `stack build --compiler ghcjs-0.2.0.9006020_ghc-7.10.3` -Sidenote: If you receive a message like `The program 'ghcjs' version >=0.1 is-required but the version of .../ghcjs could not be determined.`, then you may-need to install a different version of `node`. See+Sidenote: If you receive a message like+`The program 'ghcjs' version >=0.1 is required but the version of .../ghcjs could not be determined.`,+then you may need to install a different version of `node`. See [issue #1496](https://github.com/commercialhaskell/stack/issues/1496).  ## Example Configurations@@ -25,52 +25,55 @@  For `ghcjs` based on `ghc-7.10.3` one could try: ```yaml-resolver: lts-6.25-compiler: ghcjs-0.2.0.9006025_ghc-7.10.3+resolver: lts-6.30+compiler: ghcjs-0.2.0.9006030_ghc-7.10.3 compiler-check: match-exact  setup-info:   ghcjs:     source:-      ghcjs-0.2.0.9006025_ghc-7.10.3:-         url: http://ghcjs.tolysz.org/lts-6.25-9006025.tar.gz-         sha1: 3c87228579b55c05e227a7876682c2a7d4c9c007+      ghcjs-0.2.0.9006030_ghc-7.10.3:+         url: http://ghcjs.tolysz.org/lts-6.30-9006030.tar.gz+         sha1: 2371e2ffe9e8781808b7a04313e6a0065b64ee51 ```  Or for the latest one based on `ghc-8.0.1` (with more features): ```yaml-resolver: lts-7.14-compiler: ghcjs-0.2.1.9007014_ghc-8.0.1+resolver: lts-7.19+compiler: ghcjs-0.2.1.9007019_ghc-8.0.1 compiler-check: match-exact  setup-info:   ghcjs:     source:-      ghcjs-0.2.1.9007014_ghc-8.0.1:-           url: http://ghcjs.tolysz.org/ghc-8.0-2016-12-25-lts-7.14-9007014.tar.gz-           sha1: 0d2ebe0931b29adca7cb9d9b9f77d60095bfb864+      ghcjs-0.2.1.9007019_ghc-8.0.1:+           url: http://ghcjs.tolysz.org/ghc-8.0-2017-02-05-lts-7.19-9007019.tar.gz+           sha1: d2cfc25f9cda32a25a87d9af68891b2186ee52f9 ``` The later can be generated via: https://github.com/tolysz/prepare-ghcjs-the fromer is a bit more manual. Those bundles are only tested against the latest `node-7.2.1`.+the fromer is a bit more manual. Those bundles are only tested against the latest `node-7.4.0`.  In order to corrrectly boot and use ghcjs, one might need to install `alex` `happy` `hscolour` `hsc2hs` with the normal ghc.  Older resolvers: -|resolver|url|sha1|-|---|---|---|-| lts-7.13 | http://ghcjs.tolysz.org/ghc-8.0-2016-12-18-lts-7.13-9007013.tar.gz | 530c4ee5e19e2874e128431c7ad421e336df0303 |-| lts-7.8 | http://ghcjs.tolysz.org/ghc-8.0-2016-11-07-lts-7.8-9007008.tar.gz | 190300a3725cde44b2a08be9ef829f2077bf8825 |-| lts-7.7 | http://ghcjs.tolysz.org/ghc-8.0-2016-11-03-lts-7.7-9007007.tar.gz | ce169f85f1c49ad613ae77fc494d5565452ff59a |-| lts-7.5 | http://ghcjs.tolysz.org/ghc-8.0-2016-10-24-lts-7.5-9007005.tar.gz | 450e81028d7f1eb82a16bc4b0809f30730c3e173 |-| lts-7.4 | http://ghcjs.tolysz.org/ghc-8.0-2016-10-22-lts-7.4-9007004.tar.gz | ed77b3c15fedbadad5ab0e0afe1bd42c0a8695b4 |-| lts-7.3 | http://ghcjs.tolysz.org/ghc-8.0-2016-10-11-lts-7.3-9007003.tar.gz | 3196fd5eaed670416083cf3678396d02c50096de |-| lts-7.2 | http://ghcjs.tolysz.org/ghc-8.0-2016-10-01-lts-7.2-9007002.tar.gz | a41ae415328e2b257d40724d13d1386390c26322 | -| lts-7.1 | http://ghcjs.tolysz.org/ghc-8.0-2016-09-26-lts-7.1-9007001-mem.tar.gz | e640724883238593e2d2f7f03991cb413ec0347b |-| lts-6.21 | http://ghcjs.tolysz.org/lts-6.21-9006021.tar.gz | 80b83f85dcec182093418e843979f4cee092fa85 |-| lts-6.20 | http://ghcjs.tolysz.org/lts-6.20-9006020.tar.gz | a6cea90cd8121eee3afb201183c6e9bd6bacd94a |-| lts-6.19 | http://ghcjs.tolysz.org/lts-6.19-9006019.tar.gz | ef4264d5a93b269ee4ec8f9d5139da030331d65a |-| lts-6.18 | http://ghcjs.tolysz.org/lts-6.18-9006018.tar.gz | 3e9f345116c851349a5a551ffd94f7e0b74bfabb |+|resolver|ghcjs|url|sha1|+|---|---|---|---|+| lts-7.15 |0.2.1| http://ghcjs.tolysz.org/ghc-8.0-2017-01-11-lts-7.15-9007015.tar.gz | 30d34e9d704bdb799066387dfa1ba98b8884d932 |+| lts-7.14 |0.2.1| http://ghcjs.tolysz.org/ghc-8.0-2016-12-25-lts-7.14-9007014.tar.gz | 530c4ee5e19e2874e128431c7ad421e336df0303 |+| lts-7.13 |0.2.1| http://ghcjs.tolysz.org/ghc-8.0-2016-12-18-lts-7.13-9007013.tar.gz | 0d2ebe0931b29adca7cb9d9b9f77d60095bfb864 |+| lts-7.8 || http://ghcjs.tolysz.org/ghc-8.0-2016-11-07-lts-7.8-9007008.tar.gz | 190300a3725cde44b2a08be9ef829f2077bf8825 |+| lts-7.7 || http://ghcjs.tolysz.org/ghc-8.0-2016-11-03-lts-7.7-9007007.tar.gz | ce169f85f1c49ad613ae77fc494d5565452ff59a |+| lts-7.5 || http://ghcjs.tolysz.org/ghc-8.0-2016-10-24-lts-7.5-9007005.tar.gz | 450e81028d7f1eb82a16bc4b0809f30730c3e173 |+| lts-7.4 || http://ghcjs.tolysz.org/ghc-8.0-2016-10-22-lts-7.4-9007004.tar.gz | ed77b3c15fedbadad5ab0e0afe1bd42c0a8695b4 |+| lts-7.3 || http://ghcjs.tolysz.org/ghc-8.0-2016-10-11-lts-7.3-9007003.tar.gz | 3196fd5eaed670416083cf3678396d02c50096de |+| lts-7.2 || http://ghcjs.tolysz.org/ghc-8.0-2016-10-01-lts-7.2-9007002.tar.gz | a41ae415328e2b257d40724d13d1386390c26322 | +| lts-7.1 || http://ghcjs.tolysz.org/ghc-8.0-2016-09-26-lts-7.1-9007001-mem.tar.gz | e640724883238593e2d2f7f03991cb413ec0347b |+| lts-6.25 | 0.2.0 | http://ghcjs.tolysz.org/lts-6.25-9006025.tar.gz | 3c87228579b55c05e227a7876682c2a7d4c9c007 |+| lts-6.21 || http://ghcjs.tolysz.org/lts-6.21-9006021.tar.gz | 80b83f85dcec182093418e843979f4cee092fa85 |+| lts-6.20 || http://ghcjs.tolysz.org/lts-6.20-9006020.tar.gz | a6cea90cd8121eee3afb201183c6e9bd6bacd94a |+| lts-6.19 || http://ghcjs.tolysz.org/lts-6.19-9006019.tar.gz | ef4264d5a93b269ee4ec8f9d5139da030331d65a |+| lts-6.18 || http://ghcjs.tolysz.org/lts-6.18-9006018.tar.gz | 3e9f345116c851349a5a551ffd94f7e0b74bfabb |  If you do not use the same resolver, say, an older LTS snapshot, you will get some warnings like this:
doc/install_and_upgrade.md view
@@ -67,8 +67,8 @@ versions (YMMV).  **macOS Sierra warning**: There are new limitations in the dynamic linker that-are causing problems for GHC when building projects with many-dependencies. See+are causing problems for GHC versions earlier than 8.0.2 when building projects with many+dependencies. GHC 8.0.2 is first used in LTS 8.0. See [#2577](https://github.com/commercialhaskell/stack/issues/2577) for more information. @@ -138,6 +138,11 @@  Use the [generic Linux option](#linux). +There is also an unofficial+[Copr repo](https://copr.fedoraproject.org/coprs/petersen/stack/).+Note that this Stack version may lag behind,+so we recommend running `stack upgrade` after installing it.+ ## Fedora  Use the [generic Linux option](#linux).@@ -177,8 +182,18 @@  ## Arch Linux -Use the [generic Linux option](#linux).+There is an official package in the Arch community repository. So you can+install it by simply doing: +    sudo pacman -S stack++Note that this version may slightly lag behind, but it should be updated within+the day. The package is also always rebuilt and updated when one of it's+dependencies gets an update.++  - [stack](https://www.archlinux.org/packages/community/x86_64/stack/) _latest stable version_+  - [haskell-stack-git](https://aur.archlinux.org/packages/haskell-stack-git/) _git version_+ In order to use `stack setup` with older versions of GHC or on a 32-bit system, you may need the [ncurses5-compat-libs](https://aur.archlinux.org/packages/ncurses5-compat-libs/)@@ -188,13 +203,6 @@ If you use the [ArchHaskell repository](https://wiki.archlinux.org/index.php/ArchHaskell), you can also get the `haskell-stack-tool` package from there.--There is also an unofficial package in the Arch community repository.  Note that this Stack-version may lag behind, so we recommend running `stack upgrade` after installing-it.--  - [stack](https://www.archlinux.org/packages/community/x86_64/stack/) _latest stable version_-  - [haskell-stack-git](https://aur.archlinux.org/packages/haskell-stack-git/) _git version_  ## NixOS
doc/nix_integration.md view
@@ -115,6 +115,12 @@ launch themselves in a local build environment (using `nix-shell` behind the scenes). +`stack setup` will start a nix-shell, so it will gather all the required+packages, but given nix handles GHC installation, instead of stack, this will+happen when running `stack build` if no setup has been performed+before. Therefore it is not longer necessary to run `stack setup` unless you+want to cache a GHC installation before running the build.+ If `enable:` is omitted or set to `false`, you can still build in a nix-shell by passing the `--nix` flag to stack, for instance `stack --nix build`.  Passing any `--nix*` option to the command line will do the same.@@ -125,13 +131,18 @@  ### The Nix shell -By default, stack will run the build in a pure Nix build environment-(or *shell*), which means the build should fail if you haven't-specified all the dependencies in the `packages:` section of the-`stack.yaml` file, even if these dependencies are installed elsewhere-on your system. This behaviour enforces a complete description of the-build environment to facilitate reproducibility. To override this-behaviour, add `pure: false` to your `stack.yaml` or pass the+By default, stack will run the build in a *pure* Nix build environment (or+*shell*), which means two important things:++- basically **no environment variable will be forwarded** from your user session+  to the nix-shell (variables like `HTTP_PROXY` or `PATH` notably will not be+  available),+- the build should fail if you haven't specified all the dependencies in the+  `packages:` section of the `stack.yaml` file, even if these dependencies are+  installed elsewhere on your system. This behaviour enforces a complete+  description of the build environment to facilitate reproducibility.++To override this behaviour, add `pure: false` to your `stack.yaml` or pass the `--no-nix-pure` option to the command line.  **Note:** On macOS shells are non-pure by default currently. This is
doc/nonstandard_project_init.md view
@@ -36,8 +36,8 @@     manual: true ``` -It is also possible to pass the same flag to multiple packages, i.e. `stack-build --flag *:necessary`+It is also possible to pass the same flag to multiple packages, i.e.+`stack build --flag *:necessary`  Currently one needs to list all of your modules that interpret flags in the `other-modules` section of a cabal file. `cabal-install` has a different
doc/yaml_configuration.md view
@@ -5,11 +5,11 @@ sometimes *inaccurate*. If you see such cases, please update the page, and if you're not sure how, open an issue labeled "question". -The stack.yaml configuration options break down into [project-specific](#project-config) options in:+The stack.yaml configuration options break down into [project-specific](#project-specific-config) options in:  - `<project dir>/stack.yaml` -and [non-project-specific](#non-project-config) options in:+and [non-project-specific](#non-project-specific-config) options in:  - `/etc/stack/config.yaml` -- for system global non-project default options -  `~/.stack/config.yaml` -- for user non-project default options@@ -206,8 +206,8 @@  ### image -The image settings are used for the creation of container images using `stack-image container`, e.g.+The image settings are used for the creation of container images using+`stack image container`, e.g.  ```yaml image:@@ -321,6 +321,11 @@   # optional fields, both default to false   gpg-verify: false   require-hashes: false++  # Starting with stack 1.4, we default to using Hackage Security+  hackage-security:+    keyids: ["deadbeef", "12345"] # list of all approved keys+    key-threshold: 3 # number of keys required ```  One thing you should be aware of: if you change the contents of package-version@@ -563,6 +568,11 @@     entropy: false # override the new default for one package ``` +NOTE: since 1.4.0, Stack has support for Cabal's `custom-setup` block+(introduced in Cabal 1.24). If a `custom-setup` block is provided in a `.cabal`+file, it will override the setting of `explicit-setup-deps`, and instead rely+on the stated dependencies.+ ### allow-newer  (Since 0.1.7)@@ -610,7 +620,10 @@   # NOTE: global usage of haddock can cause build failures when documentation is   # incorrectly formatted.  This could also affect scripts which use stack.   haddock: false-  haddock-arguments: ""+  haddock-arguments:+    haddock-args: []      # Additional arguments passed to haddock, --haddock-arguments+    # haddock-args:+    # - "--css=/home/user/my-css"   open-haddocks: false    # --open   haddock-deps: false     # if unspecified, defaults to true if haddock is set   haddock-internal: false@@ -618,11 +631,22 @@   # These are inadvisable to use in your global configuration, as they make the   # stack build CLI behave quite differently.   test: false-  test-arguments: ""+  test-arguments:+    rerun-tests: true   # Rerun successful tests+    additional-args: [] # --test-arguments+    # additional-args:+    # - "--fail-fast"+    coverage: false+    no-run-tests: false   bench: false-  benchmark-opts: ""+  benchmark-opts:+    benchmark-arguments: ""+    # benchmark-arguments: "--csv bench.csv"+    no-run-benchmarks: false   force-dirty: false   reconfigure: false+  cabal-verbose: false+  split-objs: false ```  The meanings of these settings correspond directly with the CLI flags of the@@ -665,8 +689,8 @@   name of the holder of the copyright on the package and the year(s) from which   copyright is claimed. For example: `Copyright: (c) 2006-2007 Joe Bloggs` * _github-username_ - used to generate `homepage` and `source-repository` in-  cabal. For instance `github-username: myusername` and `stack new my-project-  new-template` would result:+  cabal. For instance `github-username: myusername` and `stack new my-project new-template`+  would result:  ```yaml homepage: http://github.com/myusername/my-project#readme@@ -683,7 +707,7 @@     author-name: Your Name     author-email: youremail@example.com     category: Your Projects Category-    copyright: 'Copyright: (c) 2016 Your Name'+    copyright: 'Copyright: (c) 2017 Your Name'     github-username: yourusername ```
+ src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- Taken from+-- https://github.com/well-typed/hackage-security/tree/master/hackage-security-http-client+-- to avoid extra dependencies+module Hackage.Security.Client.Repository.HttpLib.HttpClient (+    withClient+  , makeHttpLib+    -- ** Re-exports+  , Manager -- opaque+  ) where++import Control.Exception+import Control.Monad (void)+import Data.ByteString (ByteString)+import Network.URI+import Network.HTTP.Client (Manager)+import qualified Data.ByteString              as BS+import qualified Data.ByteString.Char8        as BS.C8+import qualified Network.HTTP.Client          as HttpClient+import qualified Network.HTTP.Client.Internal as HttpClient+import qualified Network.HTTP.Types           as HttpClient++import Hackage.Security.Client hiding (Header)+import Hackage.Security.Client.Repository.HttpLib+import Hackage.Security.Util.Checked+import qualified Hackage.Security.Util.Lens as Lens++{-------------------------------------------------------------------------------+  Top-level API+-------------------------------------------------------------------------------}++-- | Initialization+--+-- The proxy must be specified at initialization because @http-client@ does not+-- allow to change the proxy once the 'Manager' is created.+withClient :: ProxyConfig HttpClient.Proxy -> (Manager -> HttpLib -> IO a) -> IO a+withClient proxyConfig callback = do+    manager <- HttpClient.newManager (setProxy HttpClient.defaultManagerSettings)+    callback manager $ makeHttpLib manager+  where+    setProxy = HttpClient.managerSetProxy $+      case proxyConfig of+        ProxyConfigNone  -> HttpClient.noProxy+        ProxyConfigUse p -> HttpClient.useProxy p+        ProxyConfigAuto  -> HttpClient.proxyEnvironment Nothing++-- | Create an 'HttpLib' value from a preexisting 'Manager'.+makeHttpLib :: Manager -> HttpLib+makeHttpLib manager = HttpLib+    { httpGet      = get      manager+    , httpGetRange = getRange manager+    }++{-------------------------------------------------------------------------------+  Individual methods+-------------------------------------------------------------------------------}++get :: Throws SomeRemoteError+    => Manager+    -> [HttpRequestHeader] -> URI+    -> ([HttpResponseHeader] -> BodyReader -> IO a)+    -> IO a+get manager reqHeaders uri callback = wrapCustomEx $ do+    -- TODO: setUri fails under certain circumstances; in particular, when+    -- the URI contains URL auth. Not sure if this is a concern.+    request' <- HttpClient.setUri HttpClient.defaultRequest uri+    let request = setRequestHeaders reqHeaders request'+    checkHttpException $ HttpClient.withResponse request manager $ \response -> do+      let br = wrapCustomEx $ HttpClient.responseBody response+      callback (getResponseHeaders response) br++getRange :: Throws SomeRemoteError+         => Manager+         -> [HttpRequestHeader] -> URI -> (Int, Int)+         -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)+         -> IO a+getRange manager reqHeaders uri (from, to) callback = wrapCustomEx $ do+    request' <- HttpClient.setUri HttpClient.defaultRequest uri+    let request = setRange from to+                $ setRequestHeaders reqHeaders request'+    checkHttpException $ HttpClient.withResponse request manager $ \response -> do+      let br = wrapCustomEx $ HttpClient.responseBody response+      case () of+         () | HttpClient.responseStatus response == HttpClient.partialContent206 ->+           callback HttpStatus206PartialContent (getResponseHeaders response) br+         () | HttpClient.responseStatus response == HttpClient.ok200 ->+           callback HttpStatus200OK (getResponseHeaders response) br+         _otherwise ->+           throwChecked $ HttpClient.HttpExceptionRequest request+                        $ HttpClient.StatusCodeException (void response) ""++-- | Wrap custom exceptions+--+-- NOTE: The only other exception defined in @http-client@ is @TimeoutTriggered@+-- but it is currently disabled <https://github.com/snoyberg/http-client/issues/116>+wrapCustomEx :: (Throws HttpClient.HttpException => IO a)+             -> (Throws SomeRemoteError => IO a)+wrapCustomEx act = handleChecked (\(ex :: HttpClient.HttpException) -> go ex) act+  where+    go ex = throwChecked (SomeRemoteError ex)++checkHttpException :: Throws HttpClient.HttpException => IO a -> IO a+checkHttpException = handle $ \(ex :: HttpClient.HttpException) ->+                       throwChecked ex++{-------------------------------------------------------------------------------+  http-client auxiliary+-------------------------------------------------------------------------------}++hAcceptRanges :: HttpClient.HeaderName+hAcceptRanges = "Accept-Ranges"++hAcceptEncoding :: HttpClient.HeaderName+hAcceptEncoding = "Accept-Encoding"++setRange :: Int -> Int+         -> HttpClient.Request -> HttpClient.Request+setRange from to req = req {+      HttpClient.requestHeaders = (HttpClient.hRange, rangeHeader)+                                : HttpClient.requestHeaders req+    }+  where+    -- Content-Range header uses inclusive rather than exclusive bounds+    -- See <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html>+    rangeHeader = BS.C8.pack $ "bytes=" ++ show from ++ "-" ++ show (to - 1)++-- | Set request headers+setRequestHeaders :: [HttpRequestHeader]+                  -> HttpClient.Request -> HttpClient.Request+setRequestHeaders opts req = req {+      HttpClient.requestHeaders = trOpt disallowCompressionByDefault opts+    }+  where+    trOpt :: [(HttpClient.HeaderName, [ByteString])]+          -> [HttpRequestHeader]+          -> [HttpClient.Header]+    trOpt acc [] =+      concatMap finalizeHeader acc+    trOpt acc (HttpRequestMaxAge0:os) =+      trOpt (insert HttpClient.hCacheControl ["max-age=0"] acc) os+    trOpt acc (HttpRequestNoTransform:os) =+      trOpt (insert HttpClient.hCacheControl ["no-transform"] acc) os++    -- disable content compression (potential security issue)+    disallowCompressionByDefault :: [(HttpClient.HeaderName, [ByteString])]+    disallowCompressionByDefault = [(hAcceptEncoding, [])]++    -- Some headers are comma-separated, others need multiple headers for+    -- multiple options.+    --+    -- TODO: Right we we just comma-separate all of them.+    finalizeHeader :: (HttpClient.HeaderName, [ByteString])+                   -> [HttpClient.Header]+    finalizeHeader (name, strs) = [(name, BS.intercalate ", " (reverse strs))]++    insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]+    insert x y = Lens.modify (Lens.lookupM x) (++ y)++-- | Extract the response headers+getResponseHeaders :: HttpClient.Response a -> [HttpResponseHeader]+getResponseHeaders response = concat [+      [ HttpResponseAcceptRangesBytes+      | (hAcceptRanges, "bytes") `elem` headers+      ]+    ]+  where+    headers = HttpClient.responseHeaders response
src/Network/HTTP/Download/Verified.hs view
@@ -34,9 +34,10 @@ import              Control.Monad.IO.Class import              Control.Monad.Logger (logDebug, MonadLogger) import              Control.Retry (recovering,limitRetries,RetryPolicy,constantDelay)-import "cryptohash" Crypto.Hash+import              Crypto.Hash import              Crypto.Hash.Conduit (sinkHash)-import              Data.Byteable (toBytes)+import              Data.ByteArray as Mem (convert)+import              Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16)) import              Data.ByteString (ByteString) import              Data.ByteString.Char8 (readInteger) import              Data.Conduit@@ -153,8 +154,8 @@ sinkCheckHash req HashCheck{..} = do     digest <- sinkHashUsing hashCheckAlgorithm     let actualDigestString = show digest-    let actualDigestHexByteString = digestToHexByteString digest-    let actualDigestBytes = toBytes digest+    let actualDigestHexByteString = Mem.convertToBase Mem.Base16 digest+    let actualDigestBytes = Mem.convert digest      let passedCheck = case hashCheckHexDigest of           CheckHexDigestString s -> s == actualDigestString
src/Path/Extra.hs view
@@ -7,6 +7,7 @@   ,dropRoot   ,parseCollapsedAbsDir   ,parseCollapsedAbsFile+  ,concatAndColapseAbsDir   ,rejectMissingFile   ,rejectMissingDir   ,pathToByteString@@ -42,6 +43,12 @@ -- (probably should be moved to the Path module) parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File) parseCollapsedAbsFile = parseAbsFile . collapseFilePath++-- | 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)+concatAndColapseAbsDir :: MonadThrow m => Path Abs Dir -> FilePath -> m (Path Abs Dir)+concatAndColapseAbsDir base rel = parseCollapsedAbsDir (toFilePath base FP.</> rel)  -- | Collapse intermediate "." and ".." directories from a path. --
src/Stack/Build.hs view
@@ -24,7 +24,7 @@ import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (MonadReader, asks)+import           Control.Monad.Reader (MonadReader) import           Control.Monad.Trans.Resource import           Control.Monad.Trans.Unlift (MonadBaseUnlift) import           Data.Aeson (Value (Object, Array), (.=), object)@@ -92,14 +92,15 @@       -> BuildOptsCLI       -> m () build setLocalFiles mbuildLk boptsCli = fixCodePage $ do-    bopts <- asks (configBuild . getConfig)+    bopts <- view buildOptsL     let profiling = boptsLibProfile bopts || boptsExeProfile bopts+    let symbols = not (boptsLibStrip bopts || boptsExeStrip bopts)     menv <- getMinimalEnvOverride -    (targets, mbp, locals, extraToBuild, extraDeps, sourceMap) <- loadSourceMapFull NeedTargets boptsCli+    (targets, mbp, locals, extraToBuild, extraDeps, sourceMap) <- loadSourceMapFull True NeedTargets boptsCli      -- Set local files, necessary for file watching-    stackYaml <- asks $ bcStackYaml . getBuildConfig+    stackYaml <- view stackYamlL     liftIO $ setLocalFiles            $ Set.insert stackYaml            $ Set.unions@@ -109,7 +110,8 @@         getInstalled menv                      GetInstalledOpts                          { getInstalledProfiling = profiling-                         , getInstalledHaddock   = shouldHaddockDeps bopts }+                         , getInstalledHaddock   = shouldHaddockDeps bopts+                         , getInstalledSymbols   = symbols }                      sourceMap      warnMissingExtraDeps installedMap extraDeps@@ -118,6 +120,11 @@     plan <- withLoadPackage menv $ \loadPackage ->         constructPlan mbp baseConfigOpts locals extraToBuild localDumpPkgs loadPackage sourceMap installedMap +    allowLocals <- view $ configL.to configAllowLocals+    unless allowLocals $ case justLocals plan of+      [] -> return ()+      localsIdents -> throwM $ LocalPackagesPresent localsIdents+     -- If our work to do is all local, let someone else have a turn with the snapshot.     -- They won't damage what's already in there.     case (mbuildLk, allLocal plan) of@@ -153,10 +160,17 @@     Map.elems .     planTasks +justLocals :: Plan -> [PackageIdentifier]+justLocals =+    map taskProvides .+    filter ((== Local) . taskLocation) .+    Map.elems .+    planTasks+ checkCabalVersion :: (StackM env m, HasEnvConfig env) => m () checkCabalVersion = do-    allowNewer <- asks (configAllowNewer . getConfig)-    cabalVer <- asks (envConfigCabalVersion . getEnvConfig)+    allowNewer <- view $ configL.to configAllowNewer+    cabalVer <- view cabalVersionL     -- https://github.com/haskell/cabal/issues/2023     when (allowNewer && cabalVer < $(mkVersion "1.22")) $ throwM $         CabalVersionException $@@ -164,7 +178,7 @@             versionString cabalVer ++             " was found." -data CabalVersionException = CabalVersionException { unCabalVersionException :: String }+newtype CabalVersionException = CabalVersionException { unCabalVersionException :: String }     deriving (Typeable)  instance Show CabalVersionException where show = unCabalVersionException@@ -280,7 +294,7 @@ mkBaseConfigOpts :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m)                  => BuildOptsCLI -> m BaseConfigOpts mkBaseConfigOpts boptsCli = do-    bopts <- asks (configBuild . getConfig)+    bopts <- view buildOptsL     snapDBPath <- packageDatabaseDeps     localDBPath <- packageDatabaseLocal     snapInstallRoot <- installationRootDeps@@ -302,7 +316,7 @@                 -> ((PackageName -> Version -> Map FlagName Bool -> [Text] -> IO Package) -> m a)                 -> m a withLoadPackage menv inner = do-    econfig <- asks getEnvConfig+    econfig <- view envConfigL     withCabalLoader menv $ \cabalLoader ->         inner $ \name version flags ghcOptions -> do             bs <- cabalLoader $ PackageIdentifier name version@@ -320,8 +334,8 @@         , packageConfigEnableBenchmarks = False         , packageConfigFlags = flags         , packageConfigGhcOptions = ghcOptions-        , packageConfigCompilerVersion = envConfigCompilerVersion econfig-        , packageConfigPlatform = configPlatform (getConfig econfig)+        , packageConfigCompilerVersion = view actualCompilerVersionL econfig+        , packageConfigPlatform = view platformL econfig         }  -- | Set the code page for this process as necessary. Only applies to Windows.@@ -329,9 +343,9 @@ #ifdef WINDOWS fixCodePage :: (StackM env m, HasBuildConfig env, HasEnvConfig env) => m a -> m a fixCodePage inner = do-    mcp <- asks $ configModifyCodePage . getConfig-    ec <- asks getEnvConfig-    if mcp && getGhcVersion (envConfigCompilerVersion ec) < $(mkVersion "7.10.3")+    mcp <- view $ configL.to configModifyCodePage+    ghcVersion <- view $ actualCompilerVersionL.to getGhcVersion+    if mcp && ghcVersion < $(mkVersion "7.10.3")         then fixCodePage'         -- GHC >=7.10.3 doesn't need this code page hack.         else inner@@ -349,7 +363,7 @@                     (liftIO $ setConsoleCP origCPI)                 | otherwise = id             fixOutput-                | setInput = Catch.bracket_+                | setOutput = Catch.bracket_                     (liftIO $ do                         setConsoleOutputCP expected)                     (liftIO $ setConsoleOutputCP origCPO)
src/Stack/Build/Cache.hs view
@@ -38,14 +38,15 @@ import           Control.Monad.Catch (MonadThrow, MonadCatch) import           Control.Monad.IO.Class import           Control.Monad.Logger (MonadLogger, logDebug)-import           Control.Monad.Reader (MonadReader, asks)+import           Control.Monad.Reader (MonadReader) import           Control.Monad.Trans.Control (MonadBaseControl)-import qualified Crypto.Hash.SHA256 as SHA256+import           Crypto.Hash (hashWith, SHA256(..)) import           Data.Binary (Binary (..)) import qualified Data.Binary as Binary import           Data.Binary.Tagged (HasStructuralInfo, HasSemanticVersion) import qualified Data.Binary.Tagged as BinaryTagged-import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteArray as Mem (convert)+import qualified Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16)) import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as LBS@@ -251,10 +252,10 @@                      -> Set GhcPkgId -- ^ dependencies                      -> m (Path Abs File, m (Path Abs File)) precompiledCacheFile pkgident copts installedPackageIDs = do-    ec <- asks getEnvConfig+    ec <- view envConfigL -    compiler <- parseRelDir $ compilerVersionString $ envConfigCompilerVersion ec-    cabal <- parseRelDir $ versionString $ envConfigCabalVersion ec+    compiler <- view actualCompilerVersionL >>= parseRelDir . compilerVersionString+    cabal <- view cabalVersionL >>= parseRelDir . versionString     pkg <- parseRelDir $ packageIdentifierString pkgident     platformRelDir <- platformGhcRelDir @@ -265,13 +266,13 @@     -- Unfortunately, earlier Cabals don't have the information, so we must     -- supplement it with the installed package IDs directly.     -- See issue: https://github.com/commercialhaskell/stack/issues/1103-    let oldHash = B16.encode $ SHA256.hash $ LBS.toStrict $-            if envConfigCabalVersion ec >= $(mkVersion "1.22")+    let oldHash = Mem.convertToBase Mem.Base16 $ hashWith SHA256 $ LBS.toStrict $+            if view cabalVersionL ec >= $(mkVersion "1.22")                 then Binary.encode (coNoDirs copts)                 else Binary.encode input         hashToPath hash = do             hashPath <- parseRelFile $ S8.unpack hash-            return $ getStackRoot ec+            return $ view stackRootL ec                  </> $(mkRelDir "precompiled")                  </> platformRelDir                  </> compiler@@ -280,7 +281,7 @@                  </> hashPath      $logDebug $ "Precompiled cache input = " <> T.pack (show input)-    newPath <- hashToPath $ B64URL.encode $ SHA256.hash $ Store.encode input+    newPath <- hashToPath $ B64URL.encode $ Mem.convert $ hashWith SHA256 $ Store.encode input     return (newPath, hashToPath oldHash)  -- | Write out information about a newly built package@@ -295,8 +296,8 @@ writePrecompiledCache baseConfigOpts pkgident copts depIDs mghcPkgId exes = do     (file, _) <- precompiledCacheFile pkgident copts depIDs     ensureDir (parent file)-    ec <- asks getEnvConfig-    let stackRootRelative = makeRelative (getStackRoot ec)+    ec <- view envConfigL+    let stackRootRelative = makeRelative (view stackRootL ec)     mlibpath <-         case mghcPkgId of             Executable _ -> return Nothing@@ -321,11 +322,11 @@                      -> Set GhcPkgId -- ^ dependencies                      -> m (Maybe PrecompiledCache) readPrecompiledCache pkgident copts depIDs = do-    ec <- asks getEnvConfig+    ec <- view envConfigL     let toAbsPath path = do           if FilePath.isAbsolute path               then path -- Only older version store absolute path-              else toFilePath (getStackRoot ec) FilePath.</> path+              else toFilePath (view stackRootL ec) FilePath.</> path     let toAbsPC pc =             PrecompiledCache                   { pcLibrary = fmap toAbsPath (pcLibrary pc)
src/Stack/Build/ConstructPlan.hs view
@@ -15,12 +15,12 @@     ( constructPlan     ) where -import           Control.Arrow ((&&&)) import           Control.Exception.Lifted import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Logger import           Control.Monad.RWS.Strict+import           Control.Monad.State.Strict (execState) import           Control.Monad.Trans.Resource import           Data.Either import           Data.Function@@ -42,6 +42,7 @@ import qualified Distribution.Version as Cabal import           GHC.Generics (Generic) import           Generics.Deriving.Monoid (memptydefault, mappenddefault)+import           Lens.Micro (lens) import           Path import           Prelude hiding (pi, writeFile) import           Stack.Build.Cache@@ -136,31 +137,28 @@     , logFunc        :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()     } -instance HasStackRoot Ctx instance HasPlatform Ctx instance HasGHCVariant Ctx instance HasConfig Ctx-instance HasBuildConfig Ctx where-    getBuildConfig = getBuildConfig . getEnvConfig+instance HasBuildConfig Ctx instance HasEnvConfig Ctx where-    getEnvConfig = ctxEnvConfig+    envConfigL = lens ctxEnvConfig (\x y -> x { ctxEnvConfig = y })  constructPlan :: forall env m. (StackM env m, HasEnvConfig env)               => MiniBuildPlan               -> BaseConfigOpts               -> [LocalPackage]               -> Set PackageName -- ^ additional packages that must be built-              -> [DumpPackage () ()] -- ^ locally registered+              -> [DumpPackage () () ()] -- ^ locally registered               -> (PackageName -> Version -> Map FlagName Bool -> [Text] -> IO Package) -- ^ load upstream package               -> SourceMap               -> InstalledMap               -> m Plan constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackage0 sourceMap installedMap = do     $logDebug "Constructing the build plan"-    let locallyRegistered = Map.fromList $ map (dpGhcPkgId &&& dpPackageIdent) localDumpPkgs     getVersions0 <- getPackageVersionsIO -    econfig <- asks getEnvConfig+    econfig <- view envConfigL     let onWanted = void . addDep False . packageName . lpPackage     let inner = do             mapM_ onWanted $ filter lpWanted locals@@ -187,7 +185,7 @@             return $ takeSubset Plan                 { planTasks = tasks                 , planFinals = M.fromList finals-                , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap+                , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap                 , planInstallExes =                     if boptsInstallExes $ bcoBuildOpts baseConfigOpts0                         then installExes@@ -195,7 +193,8 @@                 }         else do             planDebug $ show errs-            $prettyError $ pprintExceptions errs (bcStackYaml (getBuildConfig econfig)) parents (wantedLocalPackages locals)+            stackYaml <- view stackYamlL+            $prettyError $ pprintExceptions errs stackYaml parents (wantedLocalPackages locals)             throwM $ ConstructPlanFailed "Plan construction failed."   where     ctx econfig getVersions0 lf = Ctx@@ -219,30 +218,79 @@     -- or local packages.     toolMap = getToolMap mbp0 +-- | 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-                  -> Map GhcPkgId PackageIdentifier+                  -- ^ Reasons why packages are dirty and must be rebuilt+                  -> [DumpPackage () () ()]+                  -- ^ Local package database dump                   -> SourceMap-                  -> Map GhcPkgId (PackageIdentifier, Maybe Text)-mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap =-    Map.unions $ map toUnregisterMap $ Map.toList locallyRegistered+                  -> Map GhcPkgId (PackageIdentifier, Text)+mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap =+    -- 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-    toUnregisterMap (gid, ident) =-        case M.lookup name tasks of-            Nothing ->-                case M.lookup name sourceMap of-                    Just (PSUpstream _ Snap _ _ _) -> Map.singleton gid-                        ( ident-                        , Just "Switching to snapshot installed package"-                        )-                    _ -> Map.empty-            Just _ -> Map.singleton gid-                ( ident-                , Map.lookup name dirtyReason-                )+    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+      | Just _ <- Map.lookup name tasks+          = Just $ fromMaybe "" $ Map.lookup name dirtyReason+      -- Check if we're no longer using the local version+      | Just (PSUpstream _ Snap _ _ _) <- Map.lookup name sourceMap+          = Just "Switching to snapshot installed package"+      -- Check if a dependency is going to be unregistered+      | (dep, _):_ <- mapMaybe (`Map.lookup` toUnregister) deps+          = Just $ "Dependency being unregistered: " <> packageIdentifierText dep+      -- None of the above, keep it!+      | otherwise = Nothing+      where         name = packageIdentifierName ident  addFinal :: LocalPackage -> Package -> Bool -> M ()@@ -259,7 +307,7 @@                 , taskConfigOpts = TaskConfigOpts missing $ \missing' ->                     let allDeps = Map.union present missing'                      in configureOpts-                            (getEnvConfig ctx)+                            (view envConfigL ctx)                             (baseConfigOpts ctx)                             allDeps                             True -- local@@ -440,7 +488,7 @@                 let allDeps = Map.union present missing'                     destLoc = piiLocation ps <> minLoc                  in configureOpts-                        (getEnvConfig ctx)+                        (view envConfigL ctx)                         (baseConfigOpts ctx)                         allDeps                         (psLocal ps)@@ -506,7 +554,7 @@                                     , " requires: "                                     , versionRangeText range                                     ]-                        allowNewer <- asks $ configAllowNewer . getConfig+                        allowNewer <- view $ configL.to configAllowNewer                         if allowNewer                             then do                                 warn_ " (allow-newer enabled)"@@ -552,7 +600,7 @@     ctx <- ask     moldOpts <- flip runLoggingT (logFunc ctx) $ tryGetFlagCache installed     let configOpts = configureOpts-            (getEnvConfig ctx)+            (view envConfigL ctx)             (baseConfigOpts ctx)             present             (psLocal ps)@@ -580,7 +628,7 @@                     | Just files <- psDirty ps -> Just $ "local file changes: " <>                                                          addEllipsis (T.pack $ unwords $ Set.toList files)                     | otherwise -> Nothing-        config = getConfig ctx+        config = view configL ctx     case mreason of         Nothing -> return False         Just reason -> do@@ -678,7 +726,7 @@         let toolName = case warning of                 NoToolFound tool _ -> tool                 AmbiguousToolsFound tool _ _ -> tool-        config <- asks getConfig+        config <- view configL         menv <- liftIO $ configEnvOverride config minimalEnvSettings { esIncludeLocals = True }         mfound <- findExecutable menv toolName         case mfound of
src/Stack/Build/Execute.hs view
@@ -30,11 +30,11 @@ import           Control.Monad.Extra (anyM, (&&^)) import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import           Control.Monad.Trans.Control (liftBaseWith) import           Control.Monad.Trans.Resource-import qualified Crypto.Hash.SHA256 as SHA256+import           Crypto.Hash import           Data.Attoparsec.Text hiding (try)+import qualified Data.ByteArray as Mem (convert) import qualified Data.ByteString as S import qualified Data.ByteString.Base64.URL as B64URL import           Data.Char (isSpace)@@ -65,6 +65,7 @@ import           Data.Traversable (forM) import           Data.Tuple 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@@ -139,11 +140,11 @@         [] -> $logInfo "No packages would be unregistered."         xs -> do             $logInfo "Would unregister locally:"-            forM_ xs $ \(ident, mreason) -> $logInfo $ T.concat+            forM_ xs $ \(ident, reason) -> $logInfo $ T.concat                 [ T.pack $ packageIdentifierString ident-                , case mreason of-                    Nothing -> ""-                    Just reason -> T.concat+                , if T.null reason+                    then ""+                    else T.concat                         [ " ("                         , reason                         , ")"@@ -226,9 +227,9 @@     , eeWanted         :: !(Set PackageName)     , eeLocals         :: ![LocalPackage]     , eeGlobalDB       :: !(Path Abs Dir)-    , eeGlobalDumpPkgs :: !(Map GhcPkgId (DumpPackage () ()))-    , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId (DumpPackage () ())))-    , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId (DumpPackage () ())))+    , eeGlobalDumpPkgs :: !(Map GhcPkgId (DumpPackage () () ()))+    , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId (DumpPackage () () ())))+    , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId (DumpPackage () () ())))     , eeLogFiles       :: !(TChan (Path Abs Dir, Path Abs File))     } @@ -255,7 +256,7 @@  simpleSetupHash :: String simpleSetupHash =-    T.unpack $ decodeUtf8 $ S.take 8 $ B64URL.encode $ SHA256.hash $+    T.unpack $ decodeUtf8 $ S.take 8 $ B64URL.encode $ Mem.convert $ hashWith SHA256 $     encodeUtf8 (T.pack (unwords buildSetupArgs)) <> setupGhciShimCode <> simpleSetupCode  -- | Get a compiled Setup exe@@ -265,20 +266,22 @@             -> Path Abs Dir -- ^ temporary directory             -> m (Maybe (Path Abs File)) getSetupExe setupHs setupShimHs tmpdir = do-    wc <- getWhichCompiler-    econfig <- asks getEnvConfig+    wc <- view $ actualCompilerVersionL.whichCompilerL     platformDir <- platformGhcRelDir-    let config = getConfig econfig-        baseNameS = concat+    config <- view configL+    cabalVersionString <- view $ cabalVersionL.to versionString+    actualCompilerVersionString <- view $ actualCompilerVersionL.to compilerVersionString+    platform <- view platformL+    let baseNameS = concat             [ "Cabal-simple_"             , simpleSetupHash             , "_"-            , versionString $ envConfigCabalVersion econfig+            , cabalVersionString             , "_"-            , compilerVersionString $ envConfigCompilerVersion econfig+            , actualCompilerVersionString             ]         exeNameS = baseNameS ++-            case configPlatform config of+            case platform of                 Platform _ Windows -> ".exe"                 _ -> ""         outputNameS =@@ -307,7 +310,7 @@             menv <- getMinimalEnvOverride             let args = buildSetupArgs ++                     [ "-package"-                    , "Cabal-" ++ versionString (envConfigCabalVersion econfig)+                    , "Cabal-" ++ cabalVersionString                     , toFilePath setupHs                     , toFilePath setupShimHs                     , "-o"@@ -326,9 +329,9 @@                -> BuildOptsCLI                -> BaseConfigOpts                -> [LocalPackage]-               -> [DumpPackage () ()] -- ^ global packages-               -> [DumpPackage () ()] -- ^ snapshot packages-               -> [DumpPackage () ()] -- ^ local packages+               -> [DumpPackage () () ()] -- ^ global packages+               -> [DumpPackage () () ()] -- ^ snapshot packages+               -> [DumpPackage () () ()] -- ^ local packages                -> (ExecuteEnv -> m a)                -> m a withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages inner = do@@ -336,7 +339,7 @@         configLock <- newMVar ()         installLock <- newMVar ()         idMap <- liftIO $ newTVarIO Map.empty-        config <- asks (getConfig . getEnvConfig)+        config <- view configL          -- Create files for simple setup and setup shim, if necessary         let setupSrcDir =@@ -353,8 +356,8 @@         unless setupShimHsExists $ liftIO $ S.writeFile (toFilePath setupShimHs) setupGhciShimCode         setupExe <- getSetupExe setupHs setupShimHs tmpdir -        cabalPkgVer <- asks (envConfigCabalVersion . getEnvConfig)-        globalDB <- getGlobalDB menv =<< getWhichCompiler+        cabalPkgVer <- view cabalVersionL+        globalDB <- getGlobalDB menv =<< view (actualCompilerVersionL.whichCompilerL)         snapshotPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId snapshotPackages)         localPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId localPackages)         logFilesTChan <- liftIO $ atomically newTChan@@ -394,7 +397,7 @@             -- No log files generated, nothing to dump             [] -> return ()             firstLog:_ -> do-                toDump <- asks (configDumpLogs . getConfig)+                toDump <- view $ configL.to configDumpLogs                 case toDump of                     DumpAllLogs -> mapM_ (dumpLog "") allLogs                     DumpWarningLogs -> mapM_ dumpLogIfWarning allLogs@@ -426,7 +429,8 @@          =$ CL.take 1       unless (null firstWarning) $ dumpLog " due to warnings" (pkgDir, filepath) -    isWarning t = ": Warning:" `T.isSuffixOf` t+    isWarning t = ": Warning:" `T.isSuffixOf` t -- prior to GHC 8+               || ": warning:" `T.isInfixOf` t -- GHC 8 is slightly different      dumpLog msgSuffix (pkgDir, filepath) = do         $logInfo $ T.pack $ concat ["\n--  Dumping log file", msgSuffix, ": ", toFilePath filepath, "\n"]@@ -443,27 +447,27 @@             -> BuildOptsCLI             -> BaseConfigOpts             -> [LocalPackage]-            -> [DumpPackage () ()] -- ^ global packages-            -> [DumpPackage () ()] -- ^ snapshot packages-            -> [DumpPackage () ()] -- ^ local packages+            -> [DumpPackage () () ()] -- ^ global packages+            -> [DumpPackage () () ()] -- ^ snapshot packages+            -> [DumpPackage () () ()] -- ^ local packages             -> InstalledMap             -> Map PackageName SimpleTarget             -> Plan             -> m () executePlan menv boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = do     $logDebug "Executing the build plan"-    bopts <- asks (configBuild . getConfig)+    bopts <- view buildOptsL     withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages (executePlan' installedMap targets plan)      unless (Map.null $ planInstallExes plan) $ do         snapBin <- (</> bindirSuffix) `liftM` installationRootDeps         localBin <- (</> bindirSuffix) `liftM` installationRootLocal-        destDir <- asks $ configLocalBin . getConfig+        destDir <- view $ configL.to configLocalBin         ensureDir destDir          destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir -        platform <- asks getPlatform+        platform <- view platformL         let ext =                 case platform of                     Platform _ Windows -> ".exe"@@ -550,7 +554,7 @@                     , " not found on the PATH environment variable"                     ] -    config <- asks getConfig+    config <- view configL     menv' <- liftIO $ configEnvOverride config EnvSettings                     { esIncludeLocals = True                     , esIncludeGhcPackagePath = True@@ -581,19 +585,19 @@              -> m () executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do     when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports-    wc <- getWhichCompiler-    cv <- asks $ envConfigCompilerVersion . getEnvConfig+    cv <- view actualCompilerVersionL+    let wc = view whichCompilerL cv     case Map.toList $ planUnregisterLocal plan of         [] -> return ()         ids -> do             localDB <- packageDatabaseLocal-            forM_ ids $ \(id', (ident, mreason)) -> do+            forM_ ids $ \(id', (ident, reason)) -> do                 $logInfo $ T.concat                     [ T.pack $ packageIdentifierString ident                     , ": unregistering"-                    , case mreason of-                        Nothing -> ""-                        Just reason -> T.concat+                    , if T.null reason+                        then ""+                        else T.concat                             [ " ("                             , reason                             , ")"@@ -616,8 +620,8 @@             (fmap (\f -> (Nothing, Just f)))             (planTasks plan)             (planFinals plan)-    threads <- asks $ configJobs . getConfig-    concurrentTests <- asks $ configConcurrentTests . getConfig+    threads <- view $ configL.to configJobs+    concurrentTests <- view $ configL.to configConcurrentTests     let keepGoing =             fromMaybe (boptsTests eeBuildOpts || boptsBenchmarks eeBuildOpts) (boptsKeepGoing eeBuildOpts)         concurrentFinal =@@ -627,7 +631,7 @@             if boptsTests eeBuildOpts                 then concurrentTests                 else True-    terminal <- asks getTerminal+    terminal <- view terminalL     errs <- liftIO $ runActions threads keepGoing concurrentFinal actions $ \doneVar -> do         let total = length actions             loop prev@@ -727,7 +731,7 @@                => ExecuteEnv -> Task -> InstalledMap -> Bool -> Bool                -> m (Map PackageIdentifier GhcPkgId, ConfigCache) getConfigCache ExecuteEnv {..} Task {..} installedMap enableTest enableBench = do-    useExactConf <- asks (configAllowNewer . getConfig)+    useExactConf <- view $ configL.to configAllowNewer     let extra =             -- We enable tests if the test suite dependencies are already             -- installed, so that we avoid unnecessary recompilation based on@@ -900,7 +904,7 @@                 $ \h -> inner (Just (logPath, h))      withCabal package pkgDir mlogFile inner = do-        config <- asks getConfig+        config <- view configL          unless (configAllowDifferentUser config) $             checkOwnership (pkgDir </> configWorkDir config)@@ -932,29 +936,71 @@                         ["-package=" ++ packageIdentifierString                                             (PackageIdentifier cabalPackageName                                                               eeCabalPkgVer)]-                packageArgs =-                    case mdeps of+                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"]+                    )++                getPackageArgs setupDir =+                    case (packageSetupDeps package, mdeps) 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+                            allDeps <-+                                case mdeps of+                                    Just x -> return x+                                    Nothing -> do+                                        $logWarn "In getPackageArgs: custom-setup in use, but no dependency map present"+                                        return Map.empty+                            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 (T.pack ("Found multiple installed packages for custom-setup dep: " ++ packageNameString name)))+                                        return ("-package-id=" ++ ghcPkgIdString (snd x), Just (toCabalPackageIdentifier (fst x)))+                                    [] -> do+                                        $logWarn (T.pack ("Could not find custom-setup dep: " ++ packageNameString name))+                                        return ("-package=" ++ packageNameString name, Nothing)+                            let depsArgs = map fst matchedDeps+                            -- Generate setup_macros.h and provide it to ghc+                            let macroDeps = mapMaybe snd matchedDeps+                                cppMacrosFile = toFilePath $ setupDir </> $(mkRelFile "setup_macros.h")+                                cppArgs = ["-optP-include", "-optP" ++ cppMacrosFile]+                            liftIO $ S.writeFile cppMacrosFile (encodeUtf8 (T.pack (C.generatePackageVersionMacros macroDeps)))+                            return (packageDBArgs ++ depsArgs ++ cppArgs)+                         -- This branch is taken when                         -- 'explicit-setup-deps' is requested in your                         -- stack.yaml file.-                        Just deps | explicitSetupDeps (packageName package) config ->+                        (Nothing, Just deps) | explicitSetupDeps (packageName package) config -> do+                            $logWarn $ T.pack $ concat+                                [ "Package "+                                , packageNameString $ packageName package+                                , " uses a custom Cabal build, but does not use a custom-setup stanza"+                                ]+                            $logWarn "Using the explicit setup deps approach based on configuration"+                            $logWarn "Strongly recommend fixing the package's cabal file"                             -- Stack always builds with the global Cabal for various                             -- reproducibility issues.                             let depsMinusCabal                                  = map ghcPkgIdString                                  $ Set.toList                                  $ addGlobalPackages deps (Map.elems eeGlobalDumpPkgs)-                            in-                                ( "-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"]-                                ) +++                            return (+                                packageDBArgs ++                                 cabalPackageArg ++-                                map ("-package-id=" ++) depsMinusCabal+                                map ("-package-id=" ++) depsMinusCabal)                         -- This branch is usually taken for builds, and                         -- is always taken for `stack sdist`.                         --@@ -972,12 +1018,23 @@                         -- Currently, this branch is only taken via `stack                         -- sdist` or when explicitly requested in the                         -- stack.yaml file.-                        _ ->-                              cabalPackageArg ++-                            ("-clear-package-db"-                            : "-global-package-db"-                            : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts)-                           ++ ["-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)])+                        (Nothing, _) -> do+                            $logWarn $ T.pack $ concat+                                [ "Package "+                                , packageNameString $ packageName package+                                , " uses a custom Cabal build, but does not use a custom-setup stanza"+                                ]+                            $logWarn "Not using the explicit setup deps approach based on configuration"+                            $logWarn "Strongly recommend fixing the package's cabal file"+                            return $ 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 exeName fullArgs =@@ -1014,7 +1071,7 @@                     -- If users want control, we should add a config option for this                     makeAbsolute = stripTHLoading -            wc <- getWhichCompiler+            wc <- view $ actualCompilerVersionL.whichCompilerL             (exeName, fullArgs) <- case (esetupexehs, wc) of                 (Left setupExe, _) -> return (setupExe, setupArgs)                 (Right setuphs, compiler) -> do@@ -1026,6 +1083,7 @@                         case compiler of                             Ghc -> getGhcPath                             Ghcjs -> getGhcjsPath+                    packageArgs <- getPackageArgs setupDir                     runExe compilerPath $                         [ "--make"                         , "-odir", toFilePathNoTrailingSep setupDir@@ -1120,7 +1178,7 @@             _ -> return Nothing      copyPreCompiled (PrecompiledCache mlib exes) = do-        wc <- getWhichCompiler+        wc <- view $ actualCompilerVersionL.whichCompilerL         announceTask task "using precompiled package"         forM_ mlib $ \libpath -> do             menv <- getMinimalEnvOverride@@ -1202,7 +1260,7 @@         cabal False ["repl", "stack-initial-build-steps"]      realBuild cache package pkgDir cabal announce = do-        wc <- getWhichCompiler+        wc <- view $ actualCompilerVersionL.whichCompilerL          markExeNotInstalled (taskLocation task) taskProvides         case taskType of@@ -1238,7 +1296,7 @@                         "Missing modules in the cabal file are likely to cause undefined reference errors from the linker, along with other problems."          () <- announce ("build" <> annSuffix)-        config <- asks getConfig+        config <- view configL         extraOpts <- extraBuildOptions wc eeBuildOpts         cabal (configHideTHLoading config) (("build" :) $ (++ extraOpts) $             case (taskType, taskAllInOne, isFinalBuild) of@@ -1271,7 +1329,8 @@             cabal False (concat [["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"]                                 ,sourceFlag, ["--internal" | boptsHaddockInternal eeBuildOpts]]) -        unless isFinalBuild $ withMVar eeInstallLock $ \() -> do+        let shouldCopy = not isFinalBuild && (packageHasLibrary package || not (Set.null (packageExes package)))+        when shouldCopy $ withMVar eeInstallLock $ \() -> do             announce "copy/register"             eres <- try $ cabal False ["copy"]             case eres of@@ -1355,7 +1414,7 @@     -- fullblown 'withSingleContext'.     (allDepsMap, _cache) <- getConfigCache ee task installedMap True False     withSingleContext runInBase ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce _console mlogFile -> do-        config <- asks getConfig+        config <- view configL         let needHpc = toCoverage topts          toRun <-@@ -1641,7 +1700,7 @@ -- -- * https://github.com/commercialhaskell/stack/issues/949 addGlobalPackages :: Map PackageIdentifier GhcPkgId -- ^ dependencies of the package-                  -> [DumpPackage () ()] -- ^ global packages+                  -> [DumpPackage () () ()] -- ^ global packages                   -> Set GhcPkgId addGlobalPackages deps globals0 =     res
src/Stack/Build/Haddock.hs view
@@ -122,7 +122,7 @@     => EnvOverride     -> WhichCompiler     -> BaseConfigOpts-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Local package dump+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Local package dump     -> [LocalPackage]     -> m () generateLocalHaddockIndex envOverride wc bco localDumpPkgs locals = do@@ -148,9 +148,9 @@     => EnvOverride     -> WhichCompiler     -> BaseConfigOpts-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Global dump information-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Snapshot dump information-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Local dump information+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Global dump information+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Snapshot dump information+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Local dump information     -> [LocalPackage]     -> m () generateDepsHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs localDumpPkgs locals = do@@ -193,8 +193,8 @@     => EnvOverride     -> WhichCompiler     -> BaseConfigOpts-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Global package dump-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Snapshot package dump+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Global package dump+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Snapshot package dump     -> m () generateSnapHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs =     generateHaddockIndex@@ -213,7 +213,7 @@     -> EnvOverride     -> WhichCompiler     -> HaddockOpts-    -> [DumpPackage () ()]+    -> [DumpPackage () () ()]     -> FilePath     -> Path Abs Dir     -> m ()@@ -228,20 +228,25 @@                     Left _ -> True                     Right indexModTime ->                         or [mt > indexModTime | (_,mt,_,_) <- interfaceOpts]-        when needUpdate $ do-            $logInfo-                (T.concat ["Updating Haddock index for ", descr, " in\n",-                           T.pack (toFilePath destIndexFile)])-            liftIO (mapM_ copyPkgDocs interfaceOpts)-            readProcessNull-                (Just destDir)-                envOverride-                (haddockExeName wc)-                (hoAdditionalArgs hdopts ++-                 ["--gen-contents", "--gen-index"] ++-                 [x | (xs,_,_,_) <- interfaceOpts, x <- xs])+        if needUpdate+            then do+                $logInfo+                    (T.concat ["Updating Haddock index for ", descr, " in\n",+                               T.pack (toFilePath destIndexFile)])+                liftIO (mapM_ copyPkgDocs interfaceOpts)+                readProcessNull+                    (Just destDir)+                    envOverride+                    (haddockExeName wc)+                    (hoAdditionalArgs hdopts +++                     ["--gen-contents", "--gen-index"] +++                     [x | (xs,_,_,_) <- interfaceOpts, x <- xs])+            else+              $logInfo+                    (T.concat ["Haddock index for ", descr, " already up to date at:\n",+                               T.pack (toFilePath destIndexFile)])   where-    toInterfaceOpt :: DumpPackage a b -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File))+    toInterfaceOpt :: DumpPackage a b c -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File))     toInterfaceOpt DumpPackage {..} =         case dpHaddockInterfaces of             [] -> return Nothing@@ -294,8 +299,8 @@  -- | Find first DumpPackage matching the GhcPkgId lookupDumpPackage :: GhcPkgId-                  -> [Map GhcPkgId (DumpPackage () ())]-                  -> Maybe (DumpPackage () ())+                  -> [Map GhcPkgId (DumpPackage () () ())]+                  -> Maybe (DumpPackage () () ()) lookupDumpPackage ghcPkgId dumpPkgs =     listToMaybe $ mapMaybe (Map.lookup ghcPkgId) dumpPkgs
src/Stack/Build/Installed.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE TemplateHaskell       #-} -- Determine which packages are already installed module Stack.Build.Installed@@ -15,7 +15,6 @@ import           Control.Arrow import           Control.Monad import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import           Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Foldable as F@@ -52,6 +51,8 @@       -- ^ Require profiling libraries?     , getInstalledHaddock   :: !Bool       -- ^ Require haddocks?+    , getInstalledSymbols   :: !Bool+      -- ^ Require debugging symbols?     }  -- | Returns the new InstalledMap and all of the locally registered packages.@@ -60,9 +61,9 @@              -> GetInstalledOpts              -> Map PackageName pii -- ^ does not contain any installed information              -> m ( InstalledMap-                  , [DumpPackage () ()] -- globally installed-                  , [DumpPackage () ()] -- snapshot installed-                  , [DumpPackage () ()] -- locally installed+                  , [DumpPackage () () ()] -- globally installed+                  , [DumpPackage () () ()] -- snapshot installed+                  , [DumpPackage () () ()] -- locally installed                   ) getInstalled menv opts sourceMap = do     $logDebug "Finding out which packages are already installed"@@ -70,11 +71,9 @@     localDBPath <- packageDatabaseLocal     extraDBPaths <- packageDatabaseExtra -    bconfig <- asks getBuildConfig-     mcache <-         if getInstalledProfiling opts || getInstalledHaddock opts-            then liftM Just $ loadInstalledCache $ configInstalledCache bconfig+            then configInstalledCache >>= liftM Just . loadInstalledCache             else return Nothing      let loadDatabase' = loadDatabase menv opts mcache sourceMap@@ -90,7 +89,9 @@         loadDatabase' (Just (InstalledTo Local, localDBPath)) installedLibs2     let installedLibs = M.fromList $ map lhPair installedLibs3 -    F.forM_ mcache (saveInstalledCache (configInstalledCache bconfig))+    F.forM_ mcache $ \cache -> do+        icache <- configInstalledCache+        saveInstalledCache icache cache      -- Add in the executables that are installed, making sure to only trust a     -- listed installation under the right circumstances (see below)@@ -132,9 +133,9 @@              -> Map PackageName pii -- ^ to determine which installed things we should include              -> Maybe (InstalledPackageLocation, Path Abs Dir) -- ^ package database, Nothing for global              -> [LoadHelper] -- ^ from parent databases-             -> m ([LoadHelper], [DumpPackage () ()])+             -> m ([LoadHelper], [DumpPackage () () ()]) loadDatabase menv opts mcache sourceMap mdb lhs0 = do-    wc <- getWhichCompiler+    wc <- view $ actualCompilerVersionL.to whichCompiler     (lhs1', dps) <- ghcPkgDump menv wc (fmap snd (maybeToList mdb))                 $ conduitDumpPackage =$ sink     let ghcjsHack = wc == Ghcjs && isNothing mdb@@ -159,11 +160,18 @@             -- Just an optimization to avoid calculating the haddock             -- values when they aren't necessary             _ -> CL.map (\dp -> dp { dpHaddock = False })+    conduitSymbolsCache =+        case mcache of+            Just cache | getInstalledSymbols opts -> addSymbols cache+            -- Just an optimization to avoid calculating the debugging+            -- symbol values when they aren't necessary+            _ -> CL.map (\dp -> dp { dpSymbols = False })     mloc = fmap fst mdb     sinkDP = conduitProfilingCache-          =$ conduitHaddockCache-          =$ CL.map (isAllowed opts mcache sourceMap mloc &&& toLoadHelper mloc)-          =$ CL.consume+           =$ conduitHaddockCache+           =$ conduitSymbolsCache+           =$ CL.map (isAllowed opts mcache sourceMap mloc &&& toLoadHelper mloc)+           =$ CL.consume     sink = getZipSink $ (,)         <$> ZipSink sinkDP         <*> ZipSink CL.consume@@ -198,6 +206,7 @@             Allowed -> " the impossible?!?!"             NeedsProfiling -> " it needing profiling."             NeedsHaddock -> " it needing haddocks."+            NeedsSymbols -> " it needing debugging symbols."             UnknownPkg -> " it being unknown to the resolver / extra-deps."             WrongLocation mloc loc -> " wrong location: " <> T.pack (show (mloc, loc))             WrongVersion actual wanted -> T.concat@@ -213,6 +222,7 @@     = Allowed     | NeedsProfiling     | NeedsHaddock+    | NeedsSymbols     | UnknownPkg     | WrongLocation (Maybe InstalledPackageLocation) InstallLocation     | WrongVersion Version Version@@ -226,13 +236,15 @@           -> Maybe InstalledCache           -> Map PackageName pii           -> Maybe InstalledPackageLocation-          -> DumpPackage Bool Bool+          -> DumpPackage Bool Bool Bool           -> Allowed isAllowed opts mcache sourceMap mloc dp     -- Check that it can do profiling if necessary     | getInstalledProfiling opts && isJust mcache && not (dpProfiling dp) = NeedsProfiling     -- Check that it has haddocks if necessary     | getInstalledHaddock opts && isJust mcache && not (dpHaddock dp) = NeedsHaddock+    -- Check that it has haddocks if necessary+    | getInstalledSymbols opts && isJust mcache && not (dpSymbols dp) = NeedsSymbols     | otherwise =         case Map.lookup name sourceMap of             Nothing ->@@ -263,7 +275,7 @@     }     deriving Show -toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage Bool Bool -> LoadHelper+toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage Bool Bool Bool -> LoadHelper toLoadHelper mloc dp = LoadHelper     { lhId = gid     , lhDeps =
src/Stack/Build/Source.hs view
@@ -29,12 +29,12 @@ import              Control.Monad hiding (sequence) import              Control.Monad.IO.Class import              Control.Monad.Logger-import              Control.Monad.Reader (MonadReader, asks)+import              Control.Monad.Reader (MonadReader) import              Control.Monad.Trans.Resource-import "cryptohash" Crypto.Hash (Digest, SHA256)+import              Crypto.Hash (Digest, SHA256(..)) import              Crypto.Hash.Conduit (sinkHash)+import qualified    Data.ByteArray as Mem (convert) import qualified    Data.ByteString as S-import              Data.Byteable (toBytes) import              Data.Conduit (($$), ZipSink (..)) import qualified    Data.Conduit.Binary as CB import qualified    Data.Conduit.List as CL@@ -88,11 +88,12 @@                    , SourceMap                    ) loadSourceMap needTargets boptsCli = do-    (_, _, locals, _, _, sourceMap) <- loadSourceMapFull needTargets boptsCli+    (_, _, locals, _, _, sourceMap) <- loadSourceMapFull True needTargets boptsCli     return (locals, sourceMap)  loadSourceMapFull :: (StackM env m, HasEnvConfig env)-                  => NeedTargets+                  => Bool+                  -> NeedTargets                   -> BuildOptsCLI                   -> m ( Map PackageName SimpleTarget                        , MiniBuildPlan@@ -101,8 +102,8 @@                        , Map PackageName Version -- extra-deps from configuration and cli                        , SourceMap                        )-loadSourceMapFull needTargets boptsCli = do-    bconfig <- asks getBuildConfig+loadSourceMapFull omitWiredIn needTargets boptsCli = do+    bconfig <- view buildConfigL     rawLocals <- getLocalPackageViews     (mbp0, cliExtraDeps, targets) <- parseTargetsFromBuildOptsWith rawLocals needTargets boptsCli     -- Extend extra-deps to encompass targets requested on the command line@@ -173,9 +174,17 @@             , flip Map.mapWithKey (mbpPackages mbp) $ \n mpi ->                 let configOpts = getGhcOptions bconfig boptsCli n False False                  in PSUpstream (mpiVersion mpi) Snap (mpiFlags mpi) (mpiGhcOptions mpi ++ configOpts) (mpiGitSHA1 mpi)-            ] `Map.difference` Map.fromList (map (, ()) (HashSet.toList wiredInPackages))+            ]+        -- This conditional was introduced in order to fix "stack+        -- list-dependencies --license" (#2871) for wired-in-packages.+        -- Normally, they are omitted as they shouldn't be considered+        -- as packages available for installation.+        sourceMap' =+            if omitWiredIn+                then sourceMap `Map.difference` Map.fromList (map (, ()) (HashSet.toList wiredInPackages))+                else sourceMap -    return (targets, mbp, locals, nonLocalTargets, extraDeps0, sourceMap)+    return (targets, mbp, locals, nonLocalTargets, extraDeps0, sourceMap')  -- | All flags for a local package getLocalFlags@@ -198,13 +207,16 @@     , if boptsLibProfile bopts || boptsExeProfile bopts          then ["-auto-all","-caf-all"]          else []+    , if not $ boptsLibStrip bopts || boptsExeStrip bopts+         then ["-g"]+         else []     , if includeExtraOptions          then boptsCLIGhcOptions boptsCli          else []     ]   where     bopts = configBuild config-    config = bcConfig bconfig+    config = view configL bconfig     includeExtraOptions =         case configApplyGhcOptions config of             AGOTargets -> isTarget@@ -233,14 +245,14 @@     -> m (MiniBuildPlan, M.Map PackageName Version, M.Map PackageName SimpleTarget) parseTargetsFromBuildOptsWith rawLocals needTargets boptscli = do     $logDebug "Parsing the targets"-    bconfig <- asks getBuildConfig+    bconfig <- view buildConfigL     mbp0 <-         case bcResolver bconfig of             ResolverCompiler _ -> do                 -- We ignore the resolver version, as it might be                 -- GhcMajorVersion, and we want the exact version                 -- we're using.-                version <- asks (envConfigCompilerVersion . getEnvConfig)+                version <- view actualCompilerVersionL                 return MiniBuildPlan                     { mbpCompilerVersion = version                     , mbpPackages = Map.empty@@ -358,7 +370,7 @@ loadLocalPackage boptsCli targets (name, (lpv, gpkg)) = do     let mtarget = Map.lookup name targets     config  <- getPackageConfig boptsCli name (isJust mtarget) True-    bopts <- asks (configBuild . getConfig)+    bopts <- view buildOptsL     let pkg = resolvePackage config gpkg          (exes, tests, benches) =@@ -447,7 +459,7 @@                -> Map PackageName snapshot -- ^ snapshot, for error messages                -> m () checkFlagsUsed boptsCli lps extraDeps snapshot = do-    bconfig <- asks getBuildConfig+    bconfig <- view buildConfigL          -- Check if flags specified in stack.yaml and the command line are         -- used, see https://github.com/commercialhaskell/stack/issues/617@@ -499,7 +511,7 @@     case errs of         [] -> return $ Map.unions $ extraDeps1 : unknowns'         _ -> do-            bconfig <- asks getBuildConfig+            bconfig <- view buildConfigL             throwM $ UnknownTargets                 (Set.fromList errs)                 Map.empty -- TODO check the cliExtraDeps for presence in index@@ -620,7 +632,7 @@         return FileCacheInfo             { fciModTime = modTime'             , fciSize = size-            , fciHash = toBytes (digest :: Digest SHA256)+            , fciHash = Mem.convert (digest :: Digest SHA256)             }  checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m ()@@ -636,15 +648,15 @@ getDefaultPackageConfig :: (MonadIO m, MonadReader env m, HasEnvConfig env)   => m PackageConfig getDefaultPackageConfig = do-  econfig <- asks getEnvConfig-  bconfig <- asks getBuildConfig+  platform <- view platformL+  compilerVersion <- view actualCompilerVersionL   return PackageConfig     { packageConfigEnableTests = False     , packageConfigEnableBenchmarks = False     , packageConfigFlags = M.empty     , packageConfigGhcOptions = []-    , packageConfigCompilerVersion = envConfigCompilerVersion econfig-    , packageConfigPlatform = configPlatform $ getConfig bconfig+    , packageConfigCompilerVersion = compilerVersion+    , packageConfigPlatform = platform     }  -- | Get 'PackageConfig' for package given its name.@@ -655,13 +667,14 @@   -> Bool   -> m PackageConfig getPackageConfig boptsCli name isTarget isLocal = do-  econfig <- asks getEnvConfig-  bconfig <- asks getBuildConfig+  bconfig <- view buildConfigL+  platform <- view platformL+  compilerVersion <- view actualCompilerVersionL   return PackageConfig     { packageConfigEnableTests = False     , packageConfigEnableBenchmarks = False     , packageConfigFlags = getLocalFlags bconfig boptsCli name     , packageConfigGhcOptions = getGhcOptions bconfig boptsCli name isTarget isLocal-    , packageConfigCompilerVersion = envConfigCompilerVersion econfig-    , packageConfigPlatform = configPlatform $ getConfig bconfig+    , packageConfigCompilerVersion = compilerVersion+    , packageConfigPlatform = platform     }
src/Stack/Build/Target.hs view
@@ -220,7 +220,7 @@                 (\(name, lpv) -> map (name,) $ Set.toList $ lpvComponents lpv)                 (Map.toList locals)          in case filter (isCompNamed cname . snd) allPairs of-                [] -> Left $ "Could not find a component named " `T.append` cname+                [] -> 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 (name, (ri, STLocalComps $ Set.singleton comp))                 matches -> Left $ T.concat
src/Stack/BuildPlan.hs view
@@ -32,6 +32,7 @@     , showItems     , showPackageFlags     , parseCustomMiniBuildPlan+    , loadBuildPlan     ) where  import           Control.Applicative@@ -40,12 +41,13 @@ import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (MonadReader, asks)+import           Control.Monad.Reader (MonadReader) import           Control.Monad.State.Strict      (State, execState, get, modify,                                                   put)-import qualified Crypto.Hash.SHA256 as SHA256+import           Crypto.Hash (hashWith, SHA256(..)) import           Data.Aeson.Extended (WithJSONWarnings(..), logJSONWarnings) import           Data.Store.VersionTagged+import qualified Data.ByteArray as Mem (convert) import qualified Data.ByteString as S import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.ByteString.Char8 as S8@@ -207,8 +209,8 @@ resolveBuildPlan mbp isShadowed packages     | Map.null (rsUnknown rs) && Map.null (rsShadowed rs) = return (rsToInstall rs, rsUsedBy rs)     | otherwise = do-        bconfig <- asks getBuildConfig-        caches <- getPackageCaches+        bconfig <- view buildConfigL+        (caches, _gitShaCaches) <- getPackageCaches         let maxVer =                 Map.fromListWith max $                 map toTuple $@@ -280,29 +282,24 @@     -> m (Map PackageName MiniPackageInfo, Set PackageIdentifier) addDeps allowMissing compilerVersion toCalc = do     menv <- getMinimalEnvOverride-    platform <- asks $ configPlatform . getConfig+    platform <- view platformL     (resolvedMap, missingIdents) <-         if allowMissing             then do                 (missingNames, missingIdents, m) <--                    resolvePackagesAllowMissing shaMap Set.empty+                    resolvePackagesAllowMissing menv Nothing shaMap Set.empty                 assert (Set.null missingNames)                     $ return (m, missingIdents)             else do-                m <- resolvePackages menv shaMap Set.empty+                m <- resolvePackages menv Nothing shaMap Set.empty                 return (m, Set.empty)-    let byIndex = Map.fromListWith (++) $ flip map (Map.toList resolvedMap)-            $ \(ident, rp) ->+    let byIndex = Map.fromListWith (++) $ flip map resolvedMap+            $ \rp ->                 let (cache, ghcOptions, sha) =-                        case Map.lookup (packageIdentifierName ident) toCalc of+                        case Map.lookup (packageIdentifierName (rpIdent rp)) toCalc of                             Nothing -> (Map.empty, [], Nothing)                             Just (_, x, y, z) -> (x, y, z)-                 in (indexName $ rpIndex rp,-                    [( ident-                    , rpCache rp-                    , sha-                    , (cache, ghcOptions, sha)-                    )])+                 in (indexName $ rpIndex rp, [(rp, (cache, ghcOptions, sha))])     res <- forM (Map.toList byIndex) $ \(indexName', pkgs) -> withCabalFiles indexName' pkgs         $ \ident (flags, ghcOptions, mgitSha) cabalBS -> do             (_warnings,gpd) <- readPackageUnresolvedBS Nothing cabalBS@@ -490,7 +487,7 @@ -- if available, otherwise downloading from Github. loadBuildPlan :: (StackMiniM env m, HasConfig env) => SnapName -> m BuildPlan loadBuildPlan name = do-    stackage <- asks getStackRoot+    stackage <- view stackRootL     file' <- parseRelFile $ T.unpack file     let fp = buildPlanDir stackage </> file'     $logDebug $ "Decoding build plan from: " <> T.pack (toFilePath fp)@@ -513,7 +510,7 @@  buildBuildPlanUrl :: (MonadReader env m, HasConfig env) => SnapName -> Text -> m Text buildBuildPlanUrl name file = do-    urls <- asks (configUrls . getConfig)+    urls <- view $ configL.to configUrls     return $         case name of              LTS _ _ -> urlsLtsBuildPlans urls <> "/" <> file@@ -729,7 +726,7 @@     -> SnapName     -> m BuildPlanCheck checkSnapBuildPlan gpds flags snap = do-    platform <- asks (configPlatform . getConfig)+    platform <- view platformL     mbp <- loadMiniBuildPlan snap      let@@ -1064,9 +1061,9 @@          , mbpPackages = mempty          }     getCustomPlanDir = do-        root <- asks $ configStackRoot . getConfig+        root <- view stackRootL         return $ root </> $(mkRelDir "custom-plan")-    doHash = SnapshotHash . B64URL.encode . SHA256.hash+    doHash = SnapshotHash . B64URL.encode . Mem.convert . hashWith SHA256  applyCustomSnapshot     :: (StackMiniM env m, HasConfig env)
src/Stack/Config.hs view
@@ -1,5 +1,8 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-}@@ -38,6 +41,8 @@   ,getInContainer   ,getInNixShell   ,defaultConfigYaml+  ,getProjectConfig+  ,LocalConfigStatus(..)   ) where  import qualified Codec.Archive.Tar as Tar@@ -51,9 +56,10 @@ import           Control.Monad.Extra (firstJustM) import           Control.Monad.IO.Class import           Control.Monad.Logger hiding (Loc)-import           Control.Monad.Reader (ask, asks, runReaderT)-import qualified Crypto.Hash.SHA256 as SHA256+import           Control.Monad.Reader (ask, runReaderT)+import           Crypto.Hash (hashWith, SHA256(..)) import           Data.Aeson.Extended+import qualified Data.ByteArray as Mem (convert) import qualified Data.ByteString as S import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.ByteString.Lazy as L@@ -70,6 +76,7 @@ import qualified Distribution.Text import           Distribution.Version (simplifyVersionRange) import           GHC.Conc (getNumProcessors)+import           Lens.Micro (lens) import           Network.HTTP.Client (parseUrlThrow) import           Network.HTTP.Download (download) import           Network.HTTP.Simple (httpJSON, getResponseBody)@@ -92,6 +99,7 @@ import           Stack.Types.Docker import           Stack.Types.Internal import           Stack.Types.Nix+import           Stack.Types.PackageIndex (HttpType (HTHackageSecurity), HackageSecurity (..)) import           Stack.Types.Resolver import           Stack.Types.StackT import           Stack.Types.Urls@@ -154,7 +162,7 @@     :: (StackMiniM env m, HasConfig env)     => m (Path Abs File) getStackYaml = do-    config <- asks getConfig+    config <- view configL     case configMaybeProject config of         Just (_project, stackYaml) -> return stackYaml         Nothing -> liftM (</> stackDotYaml) (getImplicitGlobalProjectDir config)@@ -183,7 +191,7 @@         case ar of             ARResolver r -> assert False $ return r             ARGlobal -> do-                config <- asks getConfig+                config <- view configL                 implicitGlobalDir <- getImplicitGlobalProjectDir config                 let fp = implicitGlobalDir </> stackDotYaml                 WithJSONWarnings (ProjectAndConfigMonoid project _) _warnings <-@@ -213,16 +221,38 @@         snap = fromMaybe (Nightly (snapshotsNightly snapshots)) mlts     return (ResolverSnapshot snap) +-- | Create a 'Config' value when we're not using any local+-- configuration files (e.g., the script command)+configNoLocalConfig+    :: (MonadLogger m, MonadIO m, MonadCatch m)+    => Path Abs Dir -- ^ stack root+    -> Maybe AbstractResolver+    -> ConfigMonoid+    -> m Config+configNoLocalConfig _ Nothing _ = throwM NoResolverWhenUsingNoLocalConfig+configNoLocalConfig stackRoot (Just resolver) configMonoid = do+    userConfigPath <- getFakeConfigPath stackRoot resolver+    configFromConfigMonoid+      stackRoot+      userConfigPath+      False+      (Just resolver)+      Nothing -- project+      configMonoid+ -- Interprets ConfigMonoid options. configFromConfigMonoid     :: (MonadLogger m, MonadIO m, MonadCatch m)     => Path Abs Dir -- ^ stack root, e.g. ~/.stack     -> Path Abs File -- ^ user config file path, e.g. ~/.stack/config.yaml+    -> Bool -- ^ allow locals?     -> Maybe AbstractResolver     -> Maybe (Project, Path Abs File)     -> ConfigMonoid     -> m Config-configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject ConfigMonoid{..} = do+configFromConfigMonoid+    configStackRoot configUserConfigPath configAllowLocals mresolver+    mproject ConfigMonoid{..} = do      let configWorkDir = fromFirst $(mkRelDir ".stack-work") configMonoidWorkDir      -- This code is to handle the deprecation of latest-snapshot-url      configUrls <- case (getFirst configMonoidLatestSnapshotUrl, getFirst (urlsMonoidLatestSnapshot configMonoidUrls)) of@@ -237,7 +267,21 @@                 { indexName = IndexName "Hackage"                 , indexLocation = ILGitHttp                         "https://github.com/commercialhaskell/all-cabal-hashes.git"-                        "https://s3.amazonaws.com/hackage.fpcomplete.com/00-index.tar.gz"+                        "https://s3.amazonaws.com/hackage.fpcomplete.com/"+                        (HTHackageSecurity HackageSecurity+                            { hsKeyIds =+                                [ "0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d"+                                , "1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42"+                                , "280b10153a522681163658cb49f632cde3f38d768b736ddbc901d99a1a772833"+                                , "2a96b1889dc221c17296fcc2bb34b908ca9734376f0f361660200935916ef201"+                                , "2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3"+                                , "51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921"+                                , "772e9f4c7db33d251d5c6e357199c819e569d130857dc225549b40845ff0890d"+                                , "aa315286e6ad281ad61182235533c41e806e5a787e0b6d1e7eef3f09d137d2e9"+                                , "fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0"+                                ]+                            , hsKeyThreshold = 3+                            })                 , indexDownloadPrefix = "https://s3.amazonaws.com/hackage.fpcomplete.com/package/"                 , indexGpgVerify = False                 , indexRequireHashes = False@@ -372,21 +416,21 @@       _ -> return defaultBase  -- | An environment with a subset of BuildConfig used for setup.-data MiniConfig = MiniConfig GHCVariant Config+data MiniConfig = MiniConfig+    { mcGHCVariant :: !GHCVariant+    , mcConfig :: !Config+    } instance HasConfig MiniConfig where-    getConfig (MiniConfig _ c) = c-instance HasStackRoot MiniConfig+    configL = lens mcConfig (\x y -> x { mcConfig = y }) instance HasPlatform MiniConfig instance HasGHCVariant MiniConfig where-    getGHCVariant (MiniConfig v _) = v+    ghcVariantL = lens mcGHCVariant (\x y -> x { mcGHCVariant = y })  -- | Load the 'MiniConfig'.-loadMiniConfig-    :: MonadIO m-    => Config -> m MiniConfig-loadMiniConfig config = do+loadMiniConfig :: Config -> MiniConfig+loadMiniConfig config =     let ghcVariant = fromMaybe GHCStandard (configGHCVariant0 config)-    return (MiniConfig ghcVariant config)+     in MiniConfig ghcVariant config  -- Load the configuration, using environment variables, and defaults as -- necessary.@@ -396,24 +440,36 @@     -- ^ Config monoid from parsed command-line arguments     -> Maybe AbstractResolver     -- ^ Override resolver-    -> Maybe (Project, Path Abs File, ConfigMonoid)+    -> LocalConfigStatus (Project, Path Abs File, ConfigMonoid)     -- ^ Project config to use, if any     -> m (LoadConfig m) loadConfigMaybeProject configArgs mresolver mproject = do     (stackRoot, userOwnsStackRoot) <- determineStackRootAndOwnership configArgs-    userConfigPath <- getDefaultUserConfigPath stackRoot-    extraConfigs0 <- getExtraConfigs userConfigPath >>= mapM loadConfigYaml-    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 mproject' = (\(project, stackYaml, _) -> (project, stackYaml)) <$> mproject-    config <- configFromConfigMonoid stackRoot userConfigPath mresolver mproject' $ mconcat $++    let loadHelper mproject' = do+          userConfigPath <- getDefaultUserConfigPath stackRoot+          extraConfigs0 <- getExtraConfigs userConfigPath >>= mapM loadConfigYaml+          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++          configFromConfigMonoid+            stackRoot+            userConfigPath+            True -- allow locals+            mresolver+            (fmap (\(x, y, _) -> (x, y)) mproject')+            $ mconcat $ configArgs+            : maybe id (\(_, _, projectConfig) -> (projectConfig:)) mproject' extraConfigs++    config <-         case mproject of-            Nothing -> configArgs : extraConfigs-            Just (_, _, projectConfig) -> configArgs : projectConfig : extraConfigs+          LCSNoConfig -> configNoLocalConfig stackRoot mresolver configArgs+          LCSProject project -> loadHelper $ Just project+          LCSNoProject -> loadHelper Nothing     unless (fromCabalVersion Meta.version `withinRange` configRequireStackVersion config)         (throwM (BadStackVersionException (configRequireStackVersion config))) @@ -427,7 +483,11 @@     return LoadConfig         { lcConfig          = config         , lcLoadBuildConfig = loadBuildConfig mproject config mresolver-        , lcProjectRoot     = mprojectRoot+        , lcProjectRoot     =+            case mprojectRoot of+              LCSProject fp -> Just fp+              LCSNoProject  -> Nothing+              LCSNoConfig   -> Nothing         }  -- | Load the configuration, using current directory, environment variables,@@ -438,7 +498,7 @@            -- ^ Config monoid from parsed command-line arguments            -> Maybe AbstractResolver            -- ^ Override resolver-           -> Maybe (Path Abs File)+           -> StackYamlLoc (Path Abs File)            -- ^ Override stack.yaml            -> m (LoadConfig m) loadConfig configArgs mresolver mstackYaml =@@ -447,20 +507,22 @@ -- | Load the build configuration, adds build-specific values to config loaded by @loadConfig@. -- values. loadBuildConfig :: StackM env m-                => Maybe (Project, Path Abs File, ConfigMonoid)+                => LocalConfigStatus (Project, Path Abs File, ConfigMonoid)                 -> Config                 -> Maybe AbstractResolver -- override resolver                 -> Maybe CompilerVersion -- override compiler                 -> m BuildConfig loadBuildConfig mproject config mresolver mcompiler = do     env <- ask-    miniConfig <- loadMiniConfig config      (project', stackYamlFP) <- case mproject of-      Just (project, fp, _) -> do+      LCSProject (project, fp, _) -> do           forM_ (projectUserMsg project) ($logWarn . T.pack)           return (project, fp)-      Nothing -> do+      LCSNoConfig -> do+          p <- getEmptyProject+          return (p, configUserConfigPath config)+      LCSNoProject -> do             $logDebug "Run from outside a project, using implicit global project config"             destDir <- getImplicitGlobalProjectDir config             let dest :: Path Abs File@@ -472,7 +534,7 @@             if exists                then do                    ProjectAndConfigMonoid project _ <- loadConfigYaml dest-                   when (getTerminal env) $+                   when (view terminalL env) $                        case mresolver of                            Nothing ->                                $logDebug ("Using resolver: " <> resolverName (projectResolver project) <>@@ -489,26 +551,9 @@                                          " specified on command line")                    return (project, dest)                else do-                   r <- case mresolver of-                       Just aresolver -> do-                           r' <- runReaderT (makeConcreteResolver aresolver) miniConfig-                           $logInfo ("Using resolver: " <> resolverName r' <> " specified on command line")-                           return r'-                       Nothing -> do-                           r'' <- runReaderT getLatestResolver miniConfig-                           $logInfo ("Using latest snapshot resolver: " <> resolverName r'')-                           return r''                    $logInfo ("Writing implicit global project config file to: " <> T.pack dest')                    $logInfo "Note: You can change the snapshot via the resolver field there."-                   let p = Project-                           { projectUserMsg = Nothing-                           , projectPackages = mempty-                           , projectExtraDeps = mempty-                           , projectFlags = mempty-                           , projectResolver = r-                           , projectCompiler = Nothing-                           , projectExtraPackageDBs = []-                           }+                   p <- getEmptyProject                    liftIO $ do                        S.writeFile dest' $ S.concat                            [ "# This is the implicit global project's config file, which is only used when\n"@@ -546,31 +591,58 @@         { bcConfig = config         , bcResolver = loadedResolver         , bcWantedMiniBuildPlan = mbp+        , bcGHCVariant = view ghcVariantL miniConfig         , bcPackageEntries = projectPackages project         , bcExtraDeps = projectExtraDeps project         , bcExtraPackageDBs = extraPackageDBs         , bcStackYaml = stackYamlFP         , bcFlags = projectFlags project-        , bcImplicitGlobal = isNothing mproject-        , bcGHCVariant = getGHCVariant miniConfig+        , bcImplicitGlobal =+            case mproject of+                LCSNoProject -> True+                LCSProject _ -> False+                LCSNoConfig  -> False         }+  where+    miniConfig = loadMiniConfig config +    getEmptyProject = do+      r <- case mresolver of+            Just aresolver -> do+                r' <- runReaderT (makeConcreteResolver aresolver) miniConfig+                $logInfo ("Using resolver: " <> resolverName r' <> " specified on command line")+                return r'+            Nothing -> do+                r'' <- runReaderT getLatestResolver miniConfig+                $logInfo ("Using latest snapshot resolver: " <> resolverName r'')+                return r''+      return Project+        { projectUserMsg = Nothing+        , projectPackages = mempty+        , projectExtraDeps = mempty+        , projectFlags = mempty+        , projectResolver = r+        , projectCompiler = Nothing+        , projectExtraPackageDBs = []+        }+ -- | Get packages from EnvConfig, downloading and cloning as necessary. -- If the packages have already been downloaded, this uses a cached value ( getLocalPackages     :: (StackMiniM env m, HasEnvConfig env)     => m (Map.Map (Path Abs Dir) TreatLikeExtraDep) getLocalPackages = do-    cacheRef <- asks (envConfigPackagesRef . getEnvConfig)+    cacheRef <- view $ envConfigL.to envConfigPackagesRef     mcached <- liftIO $ readIORef cacheRef     case mcached of         Just cached -> return cached         Nothing -> do             menv <- getMinimalEnvOverride-            bconfig <- asks getBuildConfig+            root <- view projectRootL+            entries <- view $ buildConfigL.to bcPackageEntries             liftM (Map.fromList . concat) $ mapM-                (resolvePackageEntry menv (bcRoot bconfig))-                (bcPackageEntries bconfig)+                (resolvePackageEntry menv root)+                entries  -- | Resolve a PackageEntry into a list of paths, downloading and cloning as -- necessary.@@ -618,19 +690,19 @@     -> m (Path Abs Dir) resolvePackageLocation _ projRoot (PLFilePath fp) = resolveDir projRoot fp resolvePackageLocation menv projRoot (PLRemote url remotePackageType) = do-    workDir <- getWorkDir+    workDir <- view workDirL     let nameBeforeHashing = case remotePackageType of             RPTHttp{} -> url             RPTGit commit -> T.unwords [url, commit]             RPTHg commit -> T.unwords [url, commit, "hg"]         -- TODO: dedupe with code for snapshot hash?-        name = T.unpack $ decodeUtf8 $ S.take 12 $ B64URL.encode $ SHA256.hash $ encodeUtf8 nameBeforeHashing+        name = T.unpack $ decodeUtf8 $ S.take 12 $ B64URL.encode $ Mem.convert $ hashWith SHA256 $ encodeUtf8 nameBeforeHashing         root = projRoot </> workDir </> $(mkRelDir "downloaded")-        fileExtension = case remotePackageType of+        fileExtension' = case remotePackageType of             RPTHttp -> ".http-archive"             _       -> ".unused" -    fileRel <- parseRelFile $ name ++ fileExtension+    fileRel <- parseRelFile $ name ++ fileExtension'     dirRel <- parseRelDir name     dirRelTmp <- parseRelDir $ name ++ ".tmp"     let file = root </> fileRel@@ -818,7 +890,7 @@         $ fromMaybe userConfigPath mstackConfig         : maybe [] return (mstackGlobalConfig <|> defaultStackGlobalConfigPath) --- | Load and parse YAML from the given conig file. Throws+-- | Load and parse YAML from the given config file. Throws -- 'ParseConfigFileException' when there's a decoding error. loadConfigYaml     :: (FromJSON (WithJSONWarnings a), MonadIO m, MonadLogger m)@@ -843,19 +915,19 @@  -- | Get the location of the project config file, if it exists. getProjectConfig :: (MonadIO m, MonadThrow m, MonadLogger m)-                 => Maybe (Path Abs File)+                 => StackYamlLoc (Path Abs File)                  -- ^ Override stack.yaml-                 -> m (Maybe (Path Abs File))-getProjectConfig (Just stackYaml) = return $ Just stackYaml-getProjectConfig Nothing = do+                 -> m (LocalConfigStatus (Path Abs File))+getProjectConfig (SYLOverride stackYaml) = return $ LCSProject stackYaml+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 Just $ resolveFile' fp+            liftM LCSProject $ resolveFile' fp         Nothing -> do             currDir <- getCurrentDir-            findInParents getStackDotYaml currDir+            maybe LCSNoProject LCSProject <$> findInParents getStackDotYaml currDir   where     getStackDotYaml dir = do         let fp = dir </> stackDotYaml@@ -865,29 +937,39 @@         if exists             then return $ Just fp             else return Nothing+getProjectConfig SYLNoConfig = return LCSNoConfig +data LocalConfigStatus a+    = LCSNoProject+    | LCSProject a+    | LCSNoConfig+    deriving (Show,Functor,Foldable,Traversable)+ -- | 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 :: (MonadIO m, MonadThrow m, MonadLogger m)-                  => Maybe (Path Abs File)+                  => StackYamlLoc (Path Abs File)                   -- ^ Override stack.yaml-                  -> m (Maybe (Project, Path Abs File, ConfigMonoid))+                  -> m (LocalConfigStatus (Project, Path Abs File, ConfigMonoid)) loadProjectConfig mstackYaml = do     mfp <- getProjectConfig mstackYaml     case mfp of-        Just fp -> do+        LCSProject fp -> do             currDir <- getCurrentDir             $logDebug $ "Loading project config file " <>                         T.pack (maybe (toFilePath fp) toFilePath (stripDir currDir fp))-            load fp-        Nothing -> do+            LCSProject <$> load fp+        LCSNoProject -> do             $logDebug $ "No project config file found, using defaults."-            return Nothing+            return LCSNoProject+        LCSNoConfig -> do+            $logDebug "Ignoring config files"+            return LCSNoConfig   where     load fp = do         ProjectAndConfigMonoid project config <- loadConfigYaml fp-        return $ Just (project, fp, config)+        return (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.@@ -923,6 +1005,23 @@         ensureDir (parent path)         liftIO $ S.writeFile (toFilePath path) defaultConfigYaml     return path++-- | Get a fake configuration file location, used when doing a "no+-- config" run (the script command).+getFakeConfigPath+    :: (MonadIO m, MonadThrow m)+    => Path Abs Dir -- ^ stack root+    -> AbstractResolver+    -> m (Path Abs File)+getFakeConfigPath stackRoot ar = do+  asString <-+    case ar of+      ARResolver r -> return $ T.unpack $ resolverName r+      _ -> throwM $ InvalidResolverForNoLocalConfig $ show ar+  asDir <- parseRelDir asString+  let full = stackRoot </> $(mkRelDir "script") </> asDir </> $(mkRelFile "config.yaml")+  ensureDir (parent full)+  return full  packagesParser :: Parser [String] packagesParser = many (strOption (long "package" <> help "Additional packages that must be installed"))
src/Stack/Config/Build.hs view
@@ -15,6 +15,12 @@     , boptsExeProfile = fromFirst           (boptsExeProfile defaultBuildOpts)           buildMonoidExeProfile+    , boptsLibStrip = fromFirst+          (boptsLibStrip defaultBuildOpts)+          buildMonoidLibStrip+    , boptsExeStrip = fromFirst+          (boptsExeStrip defaultBuildOpts)+          buildMonoidExeStrip     , boptsHaddock = fromFirst           (boptsHaddock defaultBuildOpts)           buildMonoidHaddock
src/Stack/ConfigCmd.hs view
@@ -18,7 +18,6 @@ import           Control.Monad.Catch (throwM) import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import qualified Data.ByteString as S import qualified Data.HashMap.Strict as HMap import           Data.Monoid@@ -28,9 +27,11 @@ import qualified Options.Applicative as OA import qualified Options.Applicative.Types as OA import           Path+import           Path.IO import           Prelude -- Silence redundant import warnings import           Stack.BuildPlan-import           Stack.Config (makeConcreteResolver, getStackYaml)+import           Stack.Config (makeConcreteResolver, getProjectConfig, getImplicitGlobalProjectDir, LocalConfigStatus(..))+import           Stack.Constants import           Stack.Types.Config import           Stack.Types.Resolver @@ -55,14 +56,21 @@  cfgCmdSet     :: (StackMiniM env m, HasConfig env, HasGHCVariant env)-    => ConfigCmdSet -> m ()-cfgCmdSet cmd = do+    => GlobalOpts -> ConfigCmdSet -> m ()+cfgCmdSet go cmd = do+    conf <- view configL     configFilePath <-         liftM             toFilePath             (case configCmdSetScope cmd of-                 CommandScopeProject -> getStackYaml-                 CommandScopeGlobal -> asks (configUserConfigPath . getConfig))+                 CommandScopeProject -> do+                     mstackYamlOption <- forM (globalStackYaml go) resolveFile'+                     mstackYaml <- getProjectConfig mstackYamlOption+                     case mstackYaml of+                         LCSProject stackYaml -> return stackYaml+                         LCSNoProject -> liftM (</> stackDotYaml) (getImplicitGlobalProjectDir conf)+                         LCSNoConfig -> error "config command used when no local configuration available"+                 CommandScopeGlobal -> return (configUserConfigPath conf))     -- We don't need to worry about checking for a valid yaml here     (config :: Yaml.Object) <-         liftIO (Yaml.decodeFileEither configFilePath) >>= either throwM return
src/Stack/Constants.hs view
@@ -31,7 +31,7 @@     ,implicitGlobalProjectDir     ,hpcRelativeDir     ,hpcDirFromDir-    ,objectInterfaceDir+    ,objectInterfaceDirL     ,templatesDir     ,defaultUserConfigPathDeprecated     ,defaultUserConfigPath@@ -48,6 +48,7 @@ import           Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import           Data.Text (Text)+import           Lens.Micro (Getting) import           Path as FL import           Prelude import           Stack.Types.Compiler@@ -68,11 +69,11 @@ haskellPreprocessorExts = ["gc", "chs", "hsc", "x", "y", "ly", "cpphs"]  -- | Output .o/.hi directory.-objectInterfaceDir :: (MonadReader env m, HasConfig env)-  => BuildConfig -> m (Path Abs Dir)-objectInterfaceDir bconfig = do-  bcwd <- bcWorkDir bconfig-  return (bcwd </> $(mkRelDir "odir/"))+objectInterfaceDirL :: HasBuildConfig env => Getting r env (Path Abs Dir)+objectInterfaceDirL = to $ \env -> -- FIXME is this idomatic lens code?+  let workDir = view workDirL env+      root = view projectRootL env+   in root </> workDir </> $(mkRelDir "odir/")  -- | The filename used for dirtiness check of source files. buildCacheFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env)@@ -141,11 +142,10 @@     liftM (fp </>) distRelativeDir  -- | Package's working directory.-workDirFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)+workDirFromDir :: (MonadReader env m, HasEnvConfig env)                => Path Abs Dir                -> m (Path Abs Dir)-workDirFromDir fp =-    liftM (fp </>) getWorkDir+workDirFromDir fp = view $ workDirL.to (fp </>)  -- | Directory for project templates. templatesDir :: Config -> Path Abs Dir@@ -155,9 +155,9 @@ distRelativeDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env)                 => m (Path Rel Dir) distRelativeDir = do-    cabalPkgVer <- asks (envConfigCabalVersion . getEnvConfig)+    cabalPkgVer <- view cabalVersionL     platform <- platformGhcRelDir-    wc <- getWhichCompiler+    wc <- view $ actualCompilerVersionL.to whichCompiler     -- Cabal version, suffixed with "_ghcjs" if we're using GHCJS.     envDir <-         parseRelDir $@@ -165,7 +165,7 @@         packageIdentifierString $         PackageIdentifier cabalPackageName cabalPkgVer     platformAndCabal <- useShaPathOnWindows (platform </> envDir)-    workDir <- getWorkDir+    workDir <- view workDirL     return $         workDir </>         $(mkRelDir "dist") </>@@ -176,7 +176,7 @@   => Path Abs Dir      -- ^ Project root   -> m (Path Abs Dir)  -- ^ Docker sandbox projectDockerSandboxDir projectRoot = do-  workDir <- getWorkDir+  workDir <- view workDirL   return $ projectRoot </> workDir </> $(mkRelDir "docker/")  -- | Image staging dir from project root.@@ -185,7 +185,7 @@   -> Int               -- ^ Index of image   -> m (Path Abs Dir)  -- ^ Docker sandbox imageStagingDir projectRoot imageIdx = do-  workDir <- getWorkDir+  workDir <- view workDirL   idxRelDir <- parseRelDir (show imageIdx)   return $ projectRoot </> workDir </> $(mkRelDir "image") </> idxRelDir
src/Stack/Coverage.hs view
@@ -21,7 +21,6 @@ import           Control.Monad (liftM, when, unless, void, (<=<)) import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import           Control.Monad.Trans.Resource import qualified Data.ByteString.Char8 as S8 import           Data.Foldable (forM_, asum, toList)@@ -112,7 +111,7 @@ generateHpcReport :: (StackM env m, HasEnvConfig env)                   => Path Abs Dir -> Package -> [Text] -> m () generateHpcReport pkgDir package tests = do-    compilerVersion <- asks (envConfigCompilerVersion . getEnvConfig)+    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 = packageNameText (packageName package)@@ -439,7 +438,7 @@             case asum (map (T.stripPrefix (field <> ": ")) (T.lines contents)) of                 Just result -> return $ Right result                 Nothing -> notFoundErr-    cabalVer <- asks (envConfigCabalVersion . getEnvConfig)+    cabalVer <- view cabalVersionL     if cabalVer < $(mkVersion "1.24")         then do             path <- liftM (inplaceDir </>) $ parseRelFile (pkgIdStr ++ "-inplace.conf")
src/Stack/Docker.hs view
@@ -27,10 +27,10 @@ import           Control.Monad.Catch (MonadThrow,throwM,MonadCatch) import           Control.Monad.IO.Class (MonadIO,liftIO) import           Control.Monad.Logger (MonadLogger,logError,logInfo,logWarn)-import           Control.Monad.Reader (MonadReader,asks,runReaderT)+import           Control.Monad.Reader (MonadReader,runReaderT) import           Control.Monad.Trans.Control (MonadBaseControl) import           Control.Monad.Writer (execWriter,runWriter,tell)-import qualified "cryptohash" Crypto.Hash as Hash+import qualified Crypto.Hash as Hash (Digest, MD5, hash) import           Data.Aeson.Extended (FromJSON(..),(.:),(.:?),(.!=),eitherDecode) import           Data.ByteString.Builder (stringUtf8,charUtf8,toLazyByteString) import qualified Data.ByteString.Char8 as BS@@ -106,7 +106,7 @@     execWithOptionalContainer mprojectRoot getCmdArgs   where     getCmdArgs docker envOverride imageInfo isRemoteDocker = do-        config <- asks getConfig+        config <- view configL         deUser <-             if fromMaybe (not isRemoteDocker) (dockerSetUser docker)                 then liftIO $ do@@ -206,9 +206,9 @@     -> Maybe (m ())     -> m () execWithOptionalContainer mprojectRoot getCmdArgs mbefore inner mafter mrelease =-  do config <- asks getConfig+  do config <- view configL      inContainer <- getInContainer-     isReExec <- asks getReExec+     isReExec <- view reExecL      if | inContainer && not isReExec && (isJust mbefore || isJust mafter) ->             throwM OnlyOnHostException         | inContainer ->@@ -249,7 +249,7 @@                     mprojectRoot                     before                     after =-  do config <- asks getConfig+  do config <- view configL      let docker = configDocker config      envOverride <- getEnvOverride (configPlatform config)      checkDockerVersion envOverride docker@@ -259,7 +259,7 @@        <*> hIsTerminalDevice stdin        <*> hIsTerminalDevice stderr        <*> (parseAbsDir =<< getHomeDirectory)-     isStdoutTerminal <- asks getTerminal+     isStdoutTerminal <- view terminalL      let dockerHost = lookup "DOCKER_HOST" env          dockerCertPath = lookup "DOCKER_CERT_PATH" env          bamboo = lookup "bamboo_buildKey" env@@ -285,7 +285,7 @@      sandboxDir <- projectDockerSandboxDir projectRoot      let ImageConfig {..} = iiConfig          imageEnvVars = map (break (== '=')) icEnv-         platformVariant = BS.unpack $ Hash.digestToHexByteString $ hashRepoName image+         platformVariant = show $ hashRepoName image          stackRoot = configStackRoot config          sandboxHomeDir = sandboxDir </> homeDirName          isTerm = not (dockerDetach docker) &&@@ -417,7 +417,7 @@ cleanup :: (StackM env m, HasConfig env)         => CleanupOpts -> m () cleanup opts =-  do config <- asks getConfig+  do config <- view configL      let docker = configDocker config      envOverride <- getEnvOverride (configPlatform config)      checkDockerVersion envOverride docker@@ -670,7 +670,7 @@ -- | Pull latest version of configured Docker image from registry. pull :: (StackM env m, HasConfig env) => m () pull =-  do config <- asks getConfig+  do config <- view configL      let docker = configDocker config      envOverride <- getEnvOverride (configPlatform config)      checkDockerVersion envOverride docker
src/Stack/Dot.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}  module Stack.Dot (dot                  ,listDependencies@@ -30,7 +31,7 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text import qualified Data.Traversable as T-import           Distribution.License (License)+import           Distribution.License (License(BSD3)) import           Prelude -- Fix redundant import warnings import           Stack.Build (withLoadPackage) import           Stack.Build.Installed (getInstalled, GetInstalledOpts(..))@@ -115,26 +116,26 @@                        => DotOpts                        -> m (Map PackageName (Set PackageName, DotPayload)) createDependencyGraph dotOpts = do-  (locals,sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI+  (_, _, locals, _, _, sourceMap) <- loadSourceMapFull False NeedTargets defaultBuildOptsCLI       { boptsCLITargets = dotTargets dotOpts       , boptsCLIFlags = dotFlags dotOpts       }   let graph = Map.fromList (localDependencies dotOpts (filter lpWanted locals))   menv <- getMinimalEnvOverride   installedMap <- fmap snd . fst4 <$> getInstalled menv-                                                   (GetInstalledOpts False False)+                                                   (GetInstalledOpts False False False)                                                    sourceMap   withLoadPackage menv (\loader -> do-    let depLoader =-          createDepLoader sourceMap-                          installedMap-                          (fmap4 (packageAllDeps &&& makePayload) loader)+    let depLoader = createDepLoader sourceMap installedMap loadPackageDeps+        loadPackageDeps name version flags ghcOptions+            -- Skip packages that can't be loaded - see+            -- https://github.com/commercialhaskell/stack/issues/2967+            | name `elem` [$(mkPackageName "rts"), $(mkPackageName "ghc")] =+                return (Set.empty, DotPayload (Just version) (Just BSD3))+            | otherwise = fmap (packageAllDeps &&& makePayload)+                               (loader name version flags ghcOptions)     liftIO $ resolveDependencies (dotDependencyDepth dotOpts) graph depLoader)-  where -- fmap a function over the result of a function with 3 arguments-        fmap4 :: Functor f => (r -> r') -> (a -> b -> c -> d -> f r) -> a -> b -> c -> d -> f r'-        fmap4 f g a b c d = f <$> g a b c d--        fst4 :: (a,b,c,d) -> a+  where fst4 :: (a,b,c,d) -> a         fst4 (x,_,_,_) = x          makePayload pkg = DotPayload (Just $ packageVersion pkg) (Just $ packageLicense pkg)@@ -275,7 +276,7 @@  -- | Print an edge between the two package names printEdge :: MonadIO m => PackageName -> PackageName -> m ()-printEdge from to = liftIO $ Text.putStrLn (Text.concat [ nodeName from, " -> ", nodeName to, ";"])+printEdge from to' = liftIO $ Text.putStrLn (Text.concat [ nodeName from, " -> ", nodeName to', ";"])  -- | Convert a package name to a graph node name. nodeName :: PackageName -> Text
src/Stack/Fetch.hs view
@@ -39,10 +39,10 @@ import              Control.Monad.Catch import              Control.Monad.IO.Class import              Control.Monad.Logger-import              Control.Monad.Reader (ask, asks, runReaderT)+import              Control.Monad.Reader (ask, runReaderT) import              Control.Monad.Trans.Control import              Control.Monad.Trans.Unlift (MonadBaseUnlift, askRunBase)-import "cryptohash" Crypto.Hash (SHA512 (..))+import              Crypto.Hash (SHA256 (..)) import              Data.ByteString (ByteString) import qualified    Data.ByteString as S import qualified    Data.ByteString.Lazy as L@@ -53,6 +53,7 @@ import qualified    Data.Git.Ref as Git import qualified    Data.Git.Storage as Git import qualified    Data.Git.Storage.Object as Git+import qualified    Data.HashMap.Strict as HashMap import              Data.List (intercalate) import              Data.List.NonEmpty (NonEmpty) import qualified    Data.List.NonEmpty as NE@@ -131,7 +132,7 @@               -> Set PackageIdentifier               -> m () fetchPackages menv idents' = do-    resolved <- resolvePackages menv idents Set.empty+    resolved <- resolvePackages menv Nothing idents Set.empty     ToFetchResult toFetch alreadyUnpacked <- getToFetch Nothing resolved     assert (Map.null alreadyUnpacked) (return ())     nowUnpacked <- fetchPackages' Nothing toFetch@@ -144,15 +145,16 @@ -- | Intended to work for the command line command. unpackPackages :: (StackMiniM env m, HasConfig env)                => EnvOverride+               -> Maybe MiniBuildPlan -- ^ when looking up by name, take from this build plan                -> FilePath -- ^ destination                -> [String] -- ^ names or identifiers                -> m ()-unpackPackages menv dest input = do+unpackPackages menv mMiniBuildPlan dest input = do     dest' <- resolveDir' dest     (names, idents) <- case partitionEithers $ map parse input of         ([], x) -> return $ partitionEithers x         (errs, _) -> throwM $ CouldNotParsePackageSelectors errs-    resolved <- resolvePackages menv+    resolved <- resolvePackages menv mMiniBuildPlan         (Map.fromList $ map (, Nothing) idents)         (Set.fromList names)     ToFetchResult toFetch alreadyUnpacked <- getToFetch (Just dest') resolved@@ -185,24 +187,28 @@     -> Map PackageIdentifier (Maybe GitSHA1)     -> m (Map PackageIdentifier (Path Abs Dir)) unpackPackageIdents menv unpackDir mdistDir idents = do-    resolved <- resolvePackages menv idents Set.empty+    resolved <- resolvePackages menv Nothing idents Set.empty     ToFetchResult toFetch alreadyUnpacked <- getToFetch (Just unpackDir) resolved     nowUnpacked <- fetchPackages' mdistDir toFetch     return $ alreadyUnpacked <> nowUnpacked  data ResolvedPackage = ResolvedPackage-    { rpCache :: !PackageCache+    { rpIdent :: !PackageIdentifier+    , rpCache :: !PackageCache     , rpIndex :: !PackageIndex     , rpGitSHA1 :: !(Maybe GitSHA1)+    , rpMissingGitSHA :: !Bool     }+    deriving Show  -- | Resolve a set of package names and identifiers into @FetchPackage@ values. resolvePackages :: (StackMiniM env m, HasConfig env)                 => EnvOverride+                -> Maybe MiniBuildPlan -- ^ when looking up by name, take from this build plan                 -> Map PackageIdentifier (Maybe GitSHA1)                 -> Set PackageName-                -> m (Map PackageIdentifier ResolvedPackage)-resolvePackages menv idents0 names0 = do+                -> m [ResolvedPackage]+resolvePackages menv mMiniBuildPlan idents0 names0 = do     eres <- go     case eres of         Left _ -> do@@ -210,7 +216,7 @@             go >>= either throwM return         Right x -> return x   where-    go = r <$> resolvePackagesAllowMissing idents0 names0+    go = r <$> resolvePackagesAllowMissing menv mMiniBuildPlan idents0 names0     r (missingNames, missingIdents, idents)       | not $ Set.null missingNames  = Left $ UnknownPackageNames       missingNames       | not $ Set.null missingIdents = Left $ UnknownPackageIdentifiers missingIdents ""@@ -218,36 +224,105 @@  resolvePackagesAllowMissing     :: (StackMiniM env m, HasConfig env)-    => Map PackageIdentifier (Maybe GitSHA1)+    => EnvOverride+    -> Maybe MiniBuildPlan -- ^ when looking up by name, take from this build plan+    -> Map PackageIdentifier (Maybe GitSHA1)     -> Set PackageName-    -> m (Set PackageName, Set PackageIdentifier, Map PackageIdentifier ResolvedPackage)-resolvePackagesAllowMissing idents0 names0 = do-    caches <- getPackageCaches-    let versions = Map.fromListWith max $ map toTuple $ Map.keys caches-        (missingNames, idents1) = partitionEithers $ map-            (\name -> maybe (Left name ) (Right . PackageIdentifier name)-                (Map.lookup name versions))-            (Set.toList names0)-        (missingIdents, resolved) = partitionEithers $ map (goIdent caches)-                                  $ Map.toList-                                  $ idents0 <> Map.fromList (map (, Nothing) idents1)-    return (Set.fromList missingNames, Set.fromList missingIdents, Map.fromList resolved)+    -> m (Set PackageName, Set PackageIdentifier, [ResolvedPackage])+resolvePackagesAllowMissing menv mMiniBuildPlan idents0 names0 = do+    res@(_, _, resolved) <- inner+    if any rpMissingGitSHA resolved+        then do+            $logInfo "Missing some cabal revision files, updating indices"+            updateAllIndices menv+            res'@(_, _, resolved') <- inner++            -- Print an error message if any SHAs are still missing.+            F.forM_ (filter rpMissingGitSHA resolved')+                $ \rp -> F.forM_ (rpGitSHA1 rp) $ \(GitSHA1 sha) ->+                $logWarn $ mconcat+                    [ "Did not find .cabal file for "+                    , T.pack $ packageIdentifierString $ rpIdent rp+                    , " with SHA of "+                    , decodeUtf8 sha+                    , " in tarball-based cache"+                    ]++            return res'+        else return res   where-    goIdent caches (ident, mgitsha) =+    inner = do+        (caches, shaCaches) <- getPackageCaches++        let versions = Map.fromListWith max $ map toTuple $ Map.keys caches++            getNamed :: PackageName -> Maybe (PackageIdentifier, Maybe GitSHA1)+            getNamed =+                case mMiniBuildPlan of+                    Nothing -> getNamedFromIndex+                    Just mbp -> getNamedFromBuildPlan mbp++            getNamedFromBuildPlan mbp name = do+                mpi <- Map.lookup name $ mbpPackages mbp+                Just (PackageIdentifier name (mpiVersion mpi), mpiGitSHA1 mpi)+            getNamedFromIndex name = fmap+                (\ver -> (PackageIdentifier name ver, Nothing))+                (Map.lookup name versions)++            (missingNames, idents1) = partitionEithers $ map+                (\name -> maybe (Left name) Right (getNamed name))+                (Set.toList names0)+        let (missingIdents, resolved) = partitionEithers $ map (goIdent caches shaCaches)+                                    $ Map.toList+                                    $ idents0 <> Map.fromList idents1+        return (Set.fromList missingNames, Set.fromList missingIdents, resolved)++    goIdent caches shaCaches (ident, mgitsha) =         case Map.lookup ident caches of             Nothing -> Left ident-            Just (index, cache) -> Right (ident, ResolvedPackage-                { rpCache = cache-                , rpIndex = index-                , rpGitSHA1 = mgitsha-                })+            Just (index, cache) ->+                let (index', cache', mgitsha', missingGitSHA) =+                      case mgitsha of+                        Nothing -> (index, cache, mgitsha, False)+                        Just gitsha ->+                            case HashMap.lookup gitsha shaCaches of+                                Just (index'', offsetSize) ->+                                        ( index''+                                        , cache { pcOffsetSize = offsetSize }+                                        -- we already got the info+                                        -- about this SHA, don't do+                                        -- any lookups later+                                        , Nothing+                                        , False -- not missing, we found the Git SHA+                                        )+                                Nothing -> (index, cache, mgitsha,+                                    case simplifyIndexLocation (indexLocation index) of+                                        -- No surprise that there's+                                        -- nothing in the cache about+                                        -- the SHA, since this package+                                        -- comes from a Git+                                        -- repo. We'll look it up+                                        -- later when we've opened up+                                        -- the Git repo itself for+                                        -- reading.+                                        SILGit _ -> False +                                        -- Index using HTTP, so we're missing the Git SHA+                                        SILHttp _ _ -> True)+                 in Right ResolvedPackage+                    { rpIdent = ident+                    , rpCache = cache'+                    , rpIndex = index'+                    , rpGitSHA1 = mgitsha'+                    , rpMissingGitSHA = missingGitSHA+                    }+ data ToFetch = ToFetch     { tfTarball :: !(Path Abs File)     , tfDestDir :: !(Maybe (Path Abs Dir))     , tfUrl     :: !T.Text     , tfSize    :: !(Maybe Word64)-    , tfSHA512  :: !(Maybe ByteString)+    , tfSHA256  :: !(Maybe ByteString)     , tfCabal   :: !ByteString     -- ^ Contents of the .cabal file     }@@ -261,7 +336,7 @@ withCabalFiles     :: (StackMiniM env m, HasConfig env)     => IndexName-    -> [(PackageIdentifier, PackageCache, Maybe GitSHA1, a)]+    -> [(ResolvedPackage, a)]     -> (PackageIdentifier -> a -> ByteString -> IO b)     -> m [b] withCabalFiles name pkgs f = do@@ -280,7 +355,7 @@                         (liftIO . Git.closeRepo)                         (inner . Just)   where-    goPkg h (Just git) (ident, pc, Just (GitSHA1 sha), tf) = do+    goPkg h (Just git) (rp@(ResolvedPackage ident _pc _index (Just (GitSHA1 sha)) _missing), tf) = do         let ref = Git.fromHex sha         mobj <- liftIO $ tryIO $ Git.getObject git ref True         case mobj of@@ -290,15 +365,19 @@                 $logWarn $ mconcat                     [ "Did not find .cabal file for "                     , T.pack $ packageIdentifierString ident-                    , " with Git SHA of "+                    , " with SHA of "                     , decodeUtf8 sha+                    , " in the Git repository"                     ]                 $logDebug (T.pack (show e))-                goPkg h Nothing (ident, pc, Nothing, tf)-    goPkg h _mgit (ident, pc, _mgitsha, tf) = liftIO $ do-        hSeek h AbsoluteSeek $ fromIntegral $ pcOffset pc-        cabalBS <- S.hGet h $ fromIntegral $ pcSize pc-        f ident tf cabalBS+                goPkg h Nothing (rp { rpGitSHA1 = Nothing }, tf)+    goPkg h _mgit (ResolvedPackage ident pc _index _mgitsha _missing, tf) = do+        -- Did not find warning for tarballs is handled above+        let OffsetSize offset size = pcOffsetSize pc+        liftIO $ do+            hSeek h AbsoluteSeek $ fromIntegral offset+            cabalBS <- S.hGet h $ fromIntegral size+            f ident tf cabalBS  -- | Provide a function which will load up a cabal @ByteString@ from the -- package indices.@@ -325,7 +404,7 @@     let doLookup :: PackageIdentifier                  -> IO ByteString         doLookup ident = do-            caches <- loadCaches+            (caches, _gitSHACaches) <- loadCaches             eres <- unlift $ lookupPackageIdentifierExact ident env caches             case eres of                 Just bs -> return bs@@ -370,7 +449,14 @@         Nothing -> return Nothing         Just (index, cache) -> do             [bs] <- flip runReaderT env-                  $ withCabalFiles (indexName index) [(ident, cache, Nothing, ())]+                  $ withCabalFiles (indexName index)+                        [(ResolvedPackage+                            { rpIdent = ident+                            , rpCache = cache+                            , rpIndex = index+                            , rpGitSHA1 = Nothing+                            , rpMissingGitSHA = False+                            }, ())]                   $ \_ _ bs -> return bs             return $ Just bs @@ -407,17 +493,18 @@ -- | Figure out where to fetch from. getToFetch :: (StackMiniM env m, HasConfig env)            => Maybe (Path Abs Dir) -- ^ directory to unpack into, @Nothing@ means no unpack-           -> Map PackageIdentifier ResolvedPackage+           -> [ResolvedPackage]            -> m ToFetchResult getToFetch mdest resolvedAll = do-    (toFetch0, unpacked) <- liftM partitionEithers $ mapM checkUnpacked $ Map.toList resolvedAll+    (toFetch0, unpacked) <- liftM partitionEithers $ mapM checkUnpacked resolvedAll     toFetch1 <- mapM goIndex $ Map.toList $ Map.fromListWith (++) toFetch0     return ToFetchResult         { tfrToFetch = Map.unions toFetch1         , tfrAlreadyUnpacked = Map.fromList unpacked         }   where-    checkUnpacked (ident, resolved) = do+    checkUnpacked resolved = do+        let ident = rpIdent resolved         dirRel <- parseRelDir $ packageIdentifierString ident         let mdestDir = (</> dirRel) <$> mdest         mexists <-@@ -433,14 +520,14 @@                     d = pcDownload $ rpCache resolved                     targz = T.pack $ packageIdentifierString ident ++ ".tar.gz"                 tarball <- configPackageTarball (indexName index) ident-                return $ Left (indexName index, [(ident, rpCache resolved, rpGitSHA1 resolved, ToFetch+                return $ Left (indexName index, [(resolved, ToFetch                     { tfTarball = tarball                     , tfDestDir = mdestDir-                    , tfUrl = case d of-                        Just d' -> decodeUtf8 $ pdUrl d'-                        Nothing -> indexDownloadPrefix index <> targz+                    , tfUrl = case fmap pdUrl d of+                        Just url | not (S.null url) -> decodeUtf8 url+                        _ -> indexDownloadPrefix index <> targz                     , tfSize = fmap pdSize d-                    , tfSHA512 = fmap pdSHA512 d+                    , tfSHA256 = fmap pdSHA256 d                     , tfCabal = S.empty -- filled in by goIndex                     })]) @@ -468,7 +555,7 @@                -> Map PackageIdentifier ToFetch                -> m (Map PackageIdentifier (Path Abs Dir)) fetchPackages' mdistDir toFetchAll = do-    connCount <- asks $ configConnectionCount . getConfig+    connCount <- view $ configL.to configConnectionCount     outputVar <- liftIO $ newTVarIO Map.empty      runInBase <- liftBaseWith $ \run -> return (void . run)@@ -488,10 +575,10 @@         req <- parseUrlThrow $ T.unpack $ tfUrl toFetch         let destpath = tfTarball toFetch -        let toHashCheck bs = HashCheck SHA512 (CheckHexDigestByteString bs)+        let toHashCheck bs = HashCheck SHA256 (CheckHexDigestByteString bs)         let downloadReq = DownloadRequest                 { drRequest = req-                , drHashChecks = map toHashCheck $ maybeToList (tfSHA512 toFetch)+                , drHashChecks = map toHashCheck $ maybeToList (tfSHA256 toFetch)                 , drLengthCheck = fromIntegral <$> tfSize toFetch                 , drRetryPolicy = drRetryPolicyDefault                 }
src/Stack/Ghci.hs view
@@ -27,7 +27,6 @@ import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import           Control.Monad.State.Strict (State, execState, get, modify) import           Control.Monad.Trans.Unlift (MonadBaseUnlift) import qualified Data.ByteString.Char8 as S8@@ -66,6 +65,7 @@ import           Stack.Types.Build import           Stack.Types.Compiler import           Stack.Types.Config+import           Stack.Types.FlagName import           Stack.Types.Package import           Stack.Types.PackageIdentifier import           Stack.Types.PackageName@@ -80,6 +80,8 @@ data GhciOpts = GhciOpts     { ghciTargets            :: ![Text]     , ghciArgs               :: ![String]+    , ghciGhcOptions         :: ![Text]+    , ghciFlags              :: !(Map (Maybe PackageName) (Map FlagName Bool))     , ghciGhcCommand         :: !(Maybe FilePath)     , ghciNoLoadModules      :: !Bool     , ghciAdditionalPackages :: ![String]@@ -132,11 +134,14 @@ -- of those targets. ghci :: (StackM r m, HasEnvConfig r, MonadBaseUnlift IO m) => GhciOpts -> m () ghci opts@GhciOpts{..} = do+    let buildOptsCLI = defaultBuildOptsCLI+            { boptsCLITargets = []+            , boptsCLIFlags = ghciFlags+            }     -- Load source map, without explicit targets, to collect all info.-    (locals, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI-        { boptsCLITargets = [] }+    (locals, sourceMap) <- loadSourceMap AllowNoTargets buildOptsCLI     -- Parse --main-is argument.-    mainIsTargets <- parseMainIsTargets ghciMainIs+    mainIsTargets <- parseMainIsTargets buildOptsCLI ghciMainIs     -- Parse to either file targets or build targets     etargets <- preprocessTargets ghciTargets     (inputTargets, mfileTargets) <- case etargets of@@ -148,7 +153,7 @@             (targetMap, fileInfo, extraFiles) <- findFileTargets locals rawFileTargets             return (targetMap, Just (fileInfo, extraFiles))         Right rawTargets -> do-            (_,_,normalTargets) <- parseTargetsFromBuildOpts AllowNoTargets defaultBuildOptsCLI+            (_,_,normalTargets) <- parseTargetsFromBuildOpts AllowNoTargets buildOptsCLI                 { boptsCLITargets = rawTargets }             return (normalTargets, Nothing)     -- Make sure the targets are known.@@ -160,7 +165,7 @@     -- Build required dependencies and setup local packages.     buildDepsAndInitialSteps opts (map (packageNameText . fst) localTargets)     -- Load the list of modules _after_ building, to catch changes in unlisted dependencies (#1180)-    pkgs <- getGhciPkgInfos sourceMap addPkgs (fmap fst mfileTargets) localTargets+    pkgs <- getGhciPkgInfos buildOptsCLI sourceMap addPkgs (fmap fst mfileTargets) localTargets     checkForIssues pkgs     -- Finally, do the invocation of ghci     runGhci opts localTargets mainIsTargets pkgs@@ -181,9 +186,9 @@         (False, _) -> return (Left fileTargets)         _ -> return (Right normalTargets) -parseMainIsTargets :: (StackM r m, HasEnvConfig r) => Maybe Text -> m (Maybe (Map PackageName SimpleTarget))-parseMainIsTargets mtarget = forM mtarget $ \target -> do-     (_,_,targets) <- parseTargetsFromBuildOpts AllowNoTargets defaultBuildOptsCLI+parseMainIsTargets :: (StackM r m, HasEnvConfig r) => BuildOptsCLI -> Maybe Text -> m (Maybe (Map PackageName SimpleTarget))+parseMainIsTargets buildOptsCLI mtarget = forM mtarget $ \target -> do+     (_,_,targets) <- parseTargetsFromBuildOpts AllowNoTargets buildOptsCLI          { boptsCLITargets = [target] }      return targets @@ -241,7 +246,7 @@ checkTargets mp = do     let filtered = M.filter (== STUnknown) mp     unless (M.null filtered) $ do-        bconfig <- asks getBuildConfig+        bconfig <- view buildConfigL         throwM $ UnknownTargets (M.keysSet filtered) M.empty (bcStackYaml bconfig)  getAllLocalTargets@@ -300,6 +305,8 @@         eres <- tryAny $ build (const (return ())) Nothing defaultBuildOptsCLI             { boptsCLITargets = targets             , boptsCLIInitialBuildSteps = True+            , boptsCLIFlags = ghciFlags+            , boptsCLIGhcOptions = ghciGhcOptions             }         case eres of             Right () -> return ()@@ -321,9 +328,8 @@     -> [GhciPkgInfo]     -> m () runGhci GhciOpts{..} targets mainIsTargets pkgs = do-    config <- asks getConfig-    bconfig <- asks getBuildConfig-    wc <- getWhichCompiler+    config <- view configL+    wc <- view $ actualCompilerVersionL.whichCompilerL     let pkgopts = hidePkgOpt ++ genOpts ++ ghcOpts         hidePkgOpt = if null pkgs || not ghciHidePackages then [] else ["-hide-all-packages"]         oneWordOpts bio@@ -342,7 +348,7 @@         $logWarn             ("The following GHC options are incompatible with GHCi and have not been passed to it: " <>              T.unwords (map T.pack (nubOrd omittedOpts)))-    oiDir <- objectInterfaceDir bconfig+    oiDir <- view objectInterfaceDirL     let odir =             [ "-odir=" <> toFilePathNoTrailingSep oiDir             , "-hidir=" <> toFilePathNoTrailingSep oiDir ]@@ -353,11 +359,12 @@             menv <- liftIO $ configEnvOverride config defaultEnvSettings             execSpawn menv                  (fromMaybe (compilerExeName wc) ghciGhcCommand)-                 ("--interactive" :-                 -- This initial "-i" resets the include directories to not-                 -- include CWD.-                  "-i" :-                  odir <> pkgopts <> ghciArgs <> extras)+                 (("--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 <> map T.unpack ghciGhcOptions <> ghciArgs <> extras)         interrogateExeForRenderFunction = do             menv <- liftIO $ configEnvOverride config defaultEnvSettings             output <- execObserve menv (fromMaybe (compilerExeName wc) ghciGhcCommand) ["--version"]@@ -371,7 +378,7 @@             else do                 checkForDuplicateModules pkgs                 renderFn <- interrogateExeForRenderFunction-                bopts <- asks (configBuild . getConfig)+                bopts <- view buildOptsL                 mainFile <- figureOutMainFile bopts mainIsTargets targets pkgs                 scriptPath <- writeGhciScript tmpDirectory (renderFn pkgs mainFile)                 execGhci (macrosOptions ++ ["-ghci-script=" <> toFilePath scriptPath])@@ -520,28 +527,31 @@  getGhciPkgInfos     :: (StackM r m, HasEnvConfig r)-    => SourceMap+    => BuildOptsCLI+    -> SourceMap     -> [PackageName]     -> Maybe (Map PackageName (Set (Path Abs File)))     -> [(PackageName, (Path Abs File, SimpleTarget))]     -> m [GhciPkgInfo]-getGhciPkgInfos sourceMap addPkgs mfileTargets localTargets = do+getGhciPkgInfos buildOptsCLI sourceMap addPkgs mfileTargets localTargets = do     menv <- getMinimalEnvOverride     (installedMap, _, _, _) <- getInstalled         menv         GetInstalledOpts             { getInstalledProfiling = False             , getInstalledHaddock   = False+            , getInstalledSymbols   = False             }         sourceMap     let localLibs = [name | (name, (_, target)) <- localTargets, hasLocalComp isCLib target]     forM localTargets $ \(name, (cabalfp, target)) ->-        makeGhciPkgInfo sourceMap installedMap localLibs addPkgs mfileTargets name cabalfp target+        makeGhciPkgInfo buildOptsCLI sourceMap installedMap localLibs addPkgs mfileTargets name cabalfp target  -- | Make information necessary to load the given package in GHCi. makeGhciPkgInfo     :: (StackM r m, HasEnvConfig r)-    => SourceMap+    => BuildOptsCLI+    -> SourceMap     -> InstalledMap     -> [PackageName]     -> [PackageName]@@ -550,18 +560,19 @@     -> Path Abs File     -> SimpleTarget     -> m GhciPkgInfo-makeGhciPkgInfo sourceMap installedMap locals addPkgs mfileTargets name cabalfp target = do-    bopts <- asks (configBuild . getConfig)-    econfig <- asks getEnvConfig-    bconfig <- asks getBuildConfig+makeGhciPkgInfo buildOptsCLI sourceMap installedMap locals addPkgs mfileTargets name cabalfp target = do+    bopts <- view buildOptsL+    econfig <- view envConfigL+    bconfig <- view buildConfigL+    compilerVersion <- view actualCompilerVersionL     let config =             PackageConfig             { packageConfigEnableTests = True             , packageConfigEnableBenchmarks = True-            , packageConfigFlags = getLocalFlags bconfig defaultBuildOptsCLI name-            , packageConfigGhcOptions = getGhcOptions bconfig defaultBuildOptsCLI name True True-            , packageConfigCompilerVersion = envConfigCompilerVersion econfig-            , packageConfigPlatform = configPlatform (getConfig bconfig)+            , packageConfigFlags = getLocalFlags bconfig buildOptsCLI name+            , packageConfigGhcOptions = getGhcOptions bconfig buildOptsCLI name True True+            , packageConfigCompilerVersion = compilerVersion+            , packageConfigPlatform = view platformL econfig             }     (warnings,gpkgdesc) <- readPackageUnresolved cabalfp
src/Stack/Hoogle.hs view
@@ -10,10 +10,8 @@ import           Control.Exception import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader import qualified Data.ByteString.Char8 as S8 import           Data.List (find)-import qualified Data.Map.Strict as Map import           Data.Monoid import qualified Data.Set as Set import           Lens.Micro@@ -23,7 +21,6 @@ import           Stack.Fetch import           Stack.Runners import           Stack.Types.Config-import           Stack.Types.Internal import           Stack.Types.PackageIdentifier import           Stack.Types.PackageName import           Stack.Types.StackT@@ -83,7 +80,7 @@             (catch                  (withBuildConfigAndLock                       (set-                           (globalOptsBuildOptsMonoid . buildOptsMonoidHaddock)+                           (globalOptsBuildOptsMonoidL . buildOptsMonoidHaddockL)                            (Just True)                            go)                       (\lk ->@@ -100,14 +97,27 @@             hoogleMinIdent =                 PackageIdentifier hooglePackageName hoogleMinVersion         hooglePackageIdentifier <--            do (_,_,resolved) <-+            do menv <- getMinimalEnvOverride+               (_,_,resolved) <-                    resolvePackagesAllowMissing+                       menv++                       -- FIXME this Nothing means "do not follow any+                       -- specific snapshot", which matches old+                       -- behavior. However, since introducing the+                       -- logic to pin a name to a package in a+                       -- snapshot, we may arguably want to ensure+                       -- that we're grabbing the version of Hoogle+                       -- present in the snapshot currently being+                       -- used.+                       Nothing+                        mempty                        (Set.fromList [hooglePackageName])                return                    (case find                              ((== hooglePackageName) . packageIdentifierName)-                             (Map.keys resolved) of+                             (map rpIdent resolved) of                         Just ident@(PackageIdentifier _ ver)                           | ver >= hoogleMinVersion -> Right ident                         _ -> Left hoogleMinIdent)@@ -122,7 +132,7 @@                      ". Found acceptable " <>                      packageIdentifierText ident <>                      " in your index, installing it.")-        config <- asks getConfig+        config <- view configL         menv <- liftIO $ configEnvOverride config envSettings         liftIO             (catch@@ -145,7 +155,7 @@                            _ -> throwIO e))     runHoogle :: [String] -> StackT EnvConfig IO ()     runHoogle hoogleArgs = do-        config <- asks getConfig+        config <- view configL         menv <- liftIO $ configEnvOverride config envSettings         dbpath <- hoogleDatabasePath         let databaseArg = ["--database=" ++ toFilePath dbpath]@@ -163,7 +173,7 @@         path <- hoogleDatabasePath         liftIO (doesFileExist path)     checkHoogleInPath = do-        config <- asks getConfig+        config <- view configL         menv <- liftIO $ configEnvOverride config envSettings         result <- tryProcessStdout Nothing menv "hoogle" ["--numeric-version"]         case fmap (reads . S8.unpack) result of
src/Stack/IDE.hs view
@@ -49,5 +49,5 @@                           toNameAndComponent                           (Map.toList (Map.map fst rawLocals)))))   where-    toNameAndComponent (pkgName,view) =-        map (pkgName, ) (Set.toList (lpvComponents view))+    toNameAndComponent (pkgName,view') =+        map (pkgName, ) (Set.toList (lpvComponents view'))
src/Stack/Image.hs view
@@ -15,7 +15,6 @@ import           Control.Monad import           Control.Monad.Catch hiding (bracket) import           Control.Monad.IO.Class-import           Control.Monad.Reader import           Data.Char (toLower) import qualified Data.Map.Strict as Map import           Data.Maybe@@ -37,7 +36,7 @@     :: (StackM env m, HasEnvConfig env)     => Maybe (Path Abs Dir) -> [Text] -> m () stageContainerImageArtifacts mProjectRoot imageNames = do-    config <- asks getConfig+    config <- view configL     forM_         (zip              [0 ..]@@ -60,7 +59,7 @@     :: (StackM env m, HasConfig env)     => Maybe (Path Abs Dir) -> [Text] -> m () createContainerImageFromStage mProjectRoot imageNames = do-    config <- asks getConfig+    config <- view configL     forM_         (zip              [0 ..]@@ -105,12 +104,12 @@     :: (StackM env m, HasEnvConfig env)     => ImageDockerOpts -> Path Abs Dir -> m () syncAddContentToDir opts dir = do-    bconfig <- asks getBuildConfig+    root <- view projectRootL     let imgAdd = imgDockerAdd opts     forM_         (Map.toList imgAdd)         (\(source,destPath) ->-              do sourcePath <- resolveDir (bcRoot bconfig) source+              do sourcePath <- resolveDir root source                  let destFullPath = dir </> dropRoot destPath                  ensureDir destFullPath                  copyDirRecur sourcePath destFullPath)
src/Stack/Init.hs view
@@ -8,36 +8,36 @@     , InitOpts (..)     ) where -import           Control.Exception (assert)-import           Control.Exception.Safe (catchAny)+import           Control.Exception               (assert)+import           Control.Exception.Safe          (catchAny) import           Control.Monad-import           Control.Monad.Catch (throwM)+import           Control.Monad.Catch             (throwM) import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks)-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Char8 as BC-import qualified Data.ByteString.Lazy as L-import qualified Data.Foldable as F-import           Data.Function (on)-import qualified Data.HashMap.Strict as HM-import qualified Data.IntMap as IntMap-import           Data.List                       ( intercalate, intersect-                                                 , maximumBy)-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NonEmpty-import           Data.Map (Map)-import qualified Data.Map as Map+import qualified Data.ByteString.Builder         as B+import qualified Data.ByteString.Char8           as BC+import qualified Data.ByteString.Lazy            as L+import qualified Data.Foldable                   as F+import           Data.Function                   (on)+import qualified Data.HashMap.Strict             as HM+import qualified Data.IntMap                     as IntMap+import           Data.List                       (intercalate, intersect,+                                                  maximumBy)+import           Data.List.NonEmpty              (NonEmpty (..))+import qualified Data.List.NonEmpty              as NonEmpty+import           Data.Map                        (Map)+import qualified Data.Map                        as Map import           Data.Maybe import           Data.Monoid-import qualified Data.Text as T-import qualified Data.Yaml as Yaml+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 qualified Distribution.Text               as C+import qualified Distribution.Version            as C import           Path+import           Path.Extra                      (toFilePathNoTrailingSep) import           Path.IO-import qualified Paths_stack as Meta+import qualified Paths_stack                     as Meta import           Stack.BuildPlan import           Stack.Config                    (getSnapshots,                                                   makeConcreteResolver)@@ -49,9 +49,9 @@ import           Stack.Types.FlagName import           Stack.Types.PackageName import           Stack.Types.Resolver-import           Stack.Types.StackT (StackM)+import           Stack.Types.StackT              (StackM) import           Stack.Types.Version-import qualified System.FilePath as FP+import qualified System.FilePath                 as FP  -- | Generate stack.yaml initProject@@ -105,7 +105,6 @@                 \satisfy all dependencies. Some external packages have been \                 \added as dependencies.\n"             | otherwise = ""-         makeUserMsg msgs =             let msg = concat msgs             in if msg /= "" then@@ -130,8 +129,8 @@             case stripDir currDir dir of                 Nothing                     | currDir == dir -> "."-                    | otherwise -> assert False $ toFilePath dir-                Just rel -> toFilePath rel+                    | otherwise -> assert False $ toFilePathNoTrailingSep dir+                Just rel -> toFilePathNoTrailingSep rel          makeRel = fmap toFilePath . makeRelativeToCurrentDir @@ -469,7 +468,7 @@       -- the list of packages when there is conflict in dependencies among this       -- set of packages.       findOneIndependent packages flags = do-          platform <- asks (configPlatform . getConfig)+          platform <- view platformL           (compiler, _) <- getResolverConstraints stackYaml resolver           let getGpd pkg = snd (fromJust (Map.lookup pkg bundle))               getFlags pkg = fromJust (Map.lookup pkg flags)
src/Stack/New.hs view
@@ -22,7 +22,6 @@ import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader import           Control.Monad.Trans.Writer.Strict import           Data.Aeson import           Data.Aeson.Types@@ -90,7 +89,7 @@                       else do relDir <- parseRelDir (packageNameString project)                               liftM (pwd </>) (return relDir)     exists <- doesDirExist absDir-    configTemplate <- asks (configDefaultTemplate . getConfig)+    configTemplate <- view $ configL.to configDefaultTemplate     let template = fromMaybe defaultTemplateName $ asum [ cliOptionTemplate                                                         , configTemplate                                                         ]@@ -134,7 +133,7 @@     :: forall env m. (StackM env m, HasConfig env)     => TemplateName -> (TemplateFrom -> m ()) -> m Text loadTemplate name logIt = do-    templateDir <- asks (templatesDir . getConfig)+    templateDir <- view $ configL.to templatesDir     case templatePath name of         AbsPath absFile -> logIt LocalTemp >> loadLocalFile absFile         UrlPath s -> do@@ -183,7 +182,7 @@     -> Text     -> m (Map (Path Abs File) LB.ByteString) applyTemplate project template nonceParams dir templateText = do-    config <- asks getConfig+    config <- view configL     currentYear <- do       now <- liftIO getCurrentTime       (year, _, _) <- return $ toGregorian . utctDay $ now@@ -265,7 +264,7 @@     => Path Abs Dir -> m () runTemplateInits dir = do     menv <- getMinimalEnvOverride-    config <- asks getConfig+    config <- view configL     case configScmInit config of         Nothing -> return ()         Just Git ->
src/Stack/Nix.hs view
@@ -16,7 +16,6 @@ import           Control.Monad hiding (mapM) import           Control.Monad.IO.Class (liftIO) import           Control.Monad.Logger (logDebug)-import           Control.Monad.Reader (asks) import           Data.Maybe import           Data.Monoid import qualified Data.Text as T@@ -50,10 +49,10 @@     -> IO ()     -> m () reexecWithOptionalShell mprojectRoot getCompilerVersion inner =-  do config <- asks getConfig+  do config <- view configL      inShell <- getInNixShell      inContainer <- getInContainer-     isReExec <- asks getReExec+     isReExec <- view reExecL      let getCmdArgs = do            origArgs <- liftIO getArgs            let args | inContainer = origArgs  -- internal-re-exec version already passed@@ -74,7 +73,7 @@     -> m (String, [String])     -> m () runShellAndExit mprojectRoot getCompilerVersion getCmdArgs = do-     config <- asks getConfig+     config <- view configL      envOverride <- getEnvOverride (configPlatform config)      (cmnd,args) <- fmap (escape *** map escape) getCmdArgs      mshellFile <-
src/Stack/Options/BuildMonoidParser.hs view
@@ -13,14 +13,14 @@  buildOptsMonoidParser :: GlobalOptsContext -> Parser BuildOptsMonoid buildOptsMonoidParser hide0 =-    transform <$> trace <*> profile <*> options+    transform <$> trace <*> profile <*> noStrip <*> options   where     hideBool = hide0 /= BuildCmdGlobalOpts     hide =         hideMods hideBool     hideExceptGhci =         hideMods (hide0 `notElem` [BuildCmdGlobalOpts, GhciCmdGlobalOpts])-    transform tracing profiling =+    transform tracing profiling noStripping =         enable       where         enable opts@@ -37,6 +37,11 @@                   additionalArgs                 }               }+          | noStripping = +              opts+              { buildMonoidLibStrip = First (Just False)+              , buildMonoidExeStrip = First (Just False)+              }           | otherwise =               opts           where@@ -75,13 +80,28 @@                     \for all expressions and generate a backtrace on \                     \exception" <>             hideExceptGhci)++    noStrip =+        flag+            False+            True+            (long "no-strip" <>+             help+                 "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." <>+             hideExceptGhci)+     options =-        BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> haddock <*>-        haddockOptsParser hideBool <*> openHaddocks <*> haddockDeps <*>-        haddockInternal <*> copyBins <*> preFetch <*> keepGoing <*>-        forceDirty <*> tests <*> testOptsParser hideBool <*> benches <*>-        benchOptsParser hideBool <*> reconfigure <*>-        cabalVerbose <*> splitObjs+        BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> libStripping <*>+        exeStripping <*> haddock <*> haddockOptsParser hideBool <*> +        openHaddocks <*> haddockDeps <*> haddockInternal <*> copyBins <*>+        preFetch <*> keepGoing <*> forceDirty <*> tests <*>+        testOptsParser hideBool <*> benches <*> benchOptsParser hideBool <*>+        reconfigure <*> cabalVerbose <*> splitObjs+     libProfiling =         firstBoolFlags             "library-profiling"@@ -91,6 +111,16 @@         firstBoolFlags             "executable-profiling"             "executable profiling for TARGETs and all its dependencies"+            hide+    libStripping =+        firstBoolFlags+            "library-stripping"+            "library stripping for TARGETs and all its dependencies"+            hide+    exeStripping =+        firstBoolFlags+            "executable-stripping"+            "executable stripping for TARGETs and all its dependencies"             hide     haddock =         firstBoolFlags
src/Stack/Options/ConfigParser.hs view
@@ -1,10 +1,12 @@ module Stack.Options.ConfigParser where  import           Data.Char+import           Data.Either.Combinators import           Data.Monoid.Extra import qualified Data.Set                          as Set import           Options.Applicative import           Options.Applicative.Builder.Extra+import           Path import           Stack.Constants import           Stack.Options.BuildMonoidParser import           Stack.Options.DockerParser@@ -46,7 +48,7 @@                      "(Overrides any STACK_ROOT environment variable)")             <> hide             ))-    <*> optionalFirst (relDirOption+    <*> optionalFirst (option (eitherReader (mapLeft showWorkDirError . parseRelDir))             ( long "work-dir"             <> metavar "WORK-DIR"             <> help "Override work directory (default: .stack-work)"@@ -129,3 +131,6 @@     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"
src/Stack/Options/ExecParser.hs view
@@ -3,6 +3,7 @@ import           Data.Monoid.Extra import           Options.Applicative import           Options.Applicative.Builder.Extra+import           Options.Applicative.Args import           Stack.Types.Config  -- | Parser for exec command@@ -32,6 +33,7 @@                       ExecOptsEmbellished                          <$> eoEnvSettingsParser                          <*> eoPackagesParser+                         <*> eoRtsOptionsParser   where     eoEnvSettingsParser :: Parser EnvSettings     eoEnvSettingsParser = EnvSettings@@ -48,6 +50,12 @@      eoPackagesParser :: Parser [String]     eoPackagesParser = many (strOption (long "package" <> help "Additional packages that must be installed"))++    eoRtsOptionsParser :: Parser [String]+    eoRtsOptionsParser = concat <$> many (argsOption +        ( long "rts-options"+        <> help "Explicit RTS options to pass to application"+        <> metavar "RTSFLAG"))      eoPlainParser :: Parser ExecOptsExtra     eoPlainParser = flag' ExecOptsPlain
src/Stack/Options/GhciParser.hs view
@@ -1,13 +1,14 @@ module Stack.Options.GhciParser where -import Data.Monoid.Extra-import Data.Version (showVersion)-import Options.Applicative-import Options.Applicative.Args-import Options.Applicative.Builder.Extra-import Paths_stack as Meta-import Stack.Config (packagesParser)-import Stack.Ghci (GhciOpts (..))+import           Data.Monoid.Extra+import           Data.Version                      (showVersion)+import           Options.Applicative+import           Options.Applicative.Args+import           Options.Applicative.Builder.Extra+import           Paths_stack                       as Meta+import           Stack.Config                      (packagesParser)+import           Stack.Ghci                        (GhciOpts (..))+import           Stack.Options.BuildParser         (flagsParser)  -- | Parser for GHCI options ghciOptsParser :: Parser GhciOpts@@ -23,6 +24,12 @@              <*> fmap concat (many (argsOption (long "ghci-options" <>                                     metavar "OPTION" <>                                     help "Additional options passed to GHCi")))+             <*> many+                     (textOption+                          (long "ghc-options" <>+                           metavar "OPTION" <>+                           help "Additional options passed to both GHC and GHCi"))+             <*> flagsParser              <*> optional                      (strOption (long "with-ghc" <>                                  metavar "GHC" <>
src/Stack/Options/GlobalParser.hs view
@@ -61,7 +61,7 @@     , globalCompiler = getFirst globalMonoidCompiler     , globalTerminal = fromFirst defaultTerminal globalMonoidTerminal     , globalColorWhen = fromFirst ColorAuto globalMonoidColorWhen-    , globalStackYaml = getFirst globalMonoidStackYaml }+    , globalStackYaml = maybe SYLDefault SYLOverride $ getFirst globalMonoidStackYaml }  initOptsParser :: Parser InitOpts initOptsParser =
src/Stack/Options/NixParser.hs view
@@ -17,7 +17,7 @@                      "use of a Nix-shell. Implies 'system-ghc: true'"                      hide   <*> firstBoolFlags "nix-pure"-                     "use of a pure Nix-shell. Implies 'system-ghc: true'"+                     "use of a pure Nix-shell. Implies '--nix' and 'system-ghc: true'"                      hide   <*> optionalFirst           (textArgsOption@@ -51,6 +51,7 @@   where     hide = hideMods hide0     overrideActivation m =-      if m /= mempty then m { nixMonoidEnable = (First . Just . fromFirst True) (nixMonoidEnable m) }-      else m+      if fromFirst False (nixMonoidPureShell m)+        then m { nixMonoidEnable = (First . Just . fromFirst True) (nixMonoidEnable m) }+        else m     textArgsOption = fmap (map T.pack) . argsOption
+ src/Stack/Options/ScriptParser.hs view
@@ -0,0 +1,33 @@+module Stack.Options.ScriptParser where++import           Data.Monoid ((<>))+import           Options.Applicative++data ScriptOpts = ScriptOpts+  { soPackages :: ![String]+  , soFile :: !FilePath+  , soArgs :: ![String]+  , soCompile :: !ScriptExecute+  }+  deriving Show++data ScriptExecute+  = SEInterpret+  | SECompile+  | SEOptimize+  deriving Show++scriptOptsParser :: Parser ScriptOpts+scriptOptsParser = ScriptOpts+    <$> many (strOption (long "package" <> help "Additional packages that must be installed"))+    <*> strArgument (metavar "FILENAME")+    <*> many (strArgument (metavar "-- ARGS (e.g. stack ghc -- X.hs -o x)"))+    <*> (flag' SECompile+            ( long "compile"+           <> help "Compile the script without optimization and run the executable"+            ) <|>+         flag' SEOptimize+            ( long "optimize"+           <> help "Compile the script with optimization and run the executable"+            ) <|>+         pure SEInterpret)
src/Stack/Package.hs view
@@ -244,6 +244,7 @@           (not . null . exposedModules)           (library pkg)     , packageSimpleType = buildType pkg == Just Simple+    , packageSetupDeps = msetupDeps     }   where     pkgFiles = GetPackageFiles $@@ -271,7 +272,17 @@              return (componentModules, componentFiles, buildFiles <> dataFiles', warnings)     pkgId = package pkg     name = fromCabalPackageName (pkgName pkgId)-    deps = M.filterWithKey (const . (/= name)) (packageDependencies pkg)+    deps = M.filterWithKey (const . (/= name)) (M.union+        (packageDependencies 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.+        (fromMaybe M.empty msetupDeps))+    msetupDeps = fmap+        (M.fromList . map (depName &&& depRange) . setupDepends)+        (setupBuildInfo pkg)  -- | Generate GHC options for the package's components, and a list of -- options which apply generally to the package, not one specific@@ -287,7 +298,7 @@     -> Map NamedComponent (Set DotCabalPath)     -> m (Map NamedComponent BuildInfoOpts) generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do-    config <- asks getConfig+    config <- view configL     distDir <- distDirFromDir cabalDir     let cabalMacros = autogenDir distDir </> $(mkRelFile "cabal_macros.h")     exists <- doesFileExist cabalMacros@@ -409,7 +420,7 @@              | Just makeGenDir <- [fileGenDirFromComponentName biComponentName]]) ++         ["-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir)]     toIncludeDir "." = Just biCabalDir-    toIncludeDir x = fmap (biCabalDir </>) (parseRelDir x)+    toIncludeDir relDir = concatAndColapseAbsDir biCabalDir relDir     includeOpts =         map ("-I" <>) (configExtraIncludeDirs <> pkgIncludeOpts)     configExtraIncludeDirs =@@ -504,11 +515,11 @@  -- | Get all dependencies of the package (buildable targets only). packageDependencies :: PackageDescription -> Map PackageName VersionRange-packageDependencies =-  M.fromListWith intersectVersionRanges .-  concatMap (fmap (depName &&& depRange) .-             targetBuildDepends) .-  allBuildInfo'+packageDependencies pkg =+  M.fromListWith intersectVersionRanges $+  map (depName &&& depRange) $+  concatMap targetBuildDepends (allBuildInfo' pkg) +++  maybe [] setupDepends (setupBuildInfo pkg)  -- | Get all build tool dependencies of the package (buildable targets only). packageToolDependencies :: PackageDescription -> Map Text VersionRange@@ -758,11 +769,7 @@  -- | Get the target's JS sources. targetJsSources :: BuildInfo -> [FilePath]-#if MIN_VERSION_Cabal(1, 22, 0) targetJsSources = jsSources-#else-targetJsSources = const []-#endif  -- | Get all dependencies of a package, including library, -- executables, tests, benchmarks.@@ -868,11 +875,7 @@                       case (flavor, rcCompilerVersion rc) of                         (GHC, GhcVersion vghc) -> vghc `withinRange` range                         (GHC, GhcjsVersion _ vghc) -> vghc `withinRange` range-#if MIN_VERSION_Cabal(1, 22, 0)                         (GHCJS, GhcjsVersion vghcjs _) ->-#else-                        (OtherCompiler "ghcjs", GhcjsVersion vghcjs _) ->-#endif                           vghcjs `withinRange` range                         _ -> False @@ -1010,7 +1013,7 @@     thDepsResolved <- liftM catMaybes $ forM thDeps $ \x -> do         mresolved <- forgivingAbsence (resolveFile dir x) >>= rejectMissingFile         when (isNothing mresolved) $-            $logWarn $ "Warning: qAddDepedency path listed in " <> T.pack dumpHIPath <>+            $logWarn $ "Warning: addDependentFile path (Template Haskell) listed in " <> T.pack dumpHIPath <>                 " does not exist: " <> T.pack x         return mresolved     return (moduleDeps, thDepsResolved)
src/Stack/PackageDump.hs view
@@ -19,6 +19,7 @@     , saveInstalledCache     , addProfiling     , addHaddock+    , addSymbols     , sinkMatching     , pruneDeps     ) where@@ -38,6 +39,7 @@ import qualified Data.Conduit.Text as CT import           Data.Either (partitionEithers) import           Data.IORef+import           Data.List (isPrefixOf) import           Data.Map (Map) import qualified Data.Map as Map import           Data.Maybe (catMaybes, listToMaybe)@@ -47,6 +49,7 @@ import           Data.Text (Text) import qualified Data.Text as T import           Data.Typeable (Typeable)+import qualified Distribution.System as OS import           Path import           Path.Extra (toFilePathNoTrailingSep) import           Prelude -- Fix AMP warning@@ -168,14 +171,16 @@ sinkMatching :: Monad m              => Bool -- ^ require profiling?              -> Bool -- ^ require haddock?+             -> Bool -- ^ require debugging symbols?              -> Map PackageName Version -- ^ allowed versions-             -> Consumer (DumpPackage Bool Bool)+             -> Consumer (DumpPackage Bool Bool Bool)                          m-                         (Map PackageName (DumpPackage Bool Bool))-sinkMatching reqProfiling reqHaddock allowed = do+                         (Map PackageName (DumpPackage Bool Bool Bool))+sinkMatching reqProfiling reqHaddock reqSymbols allowed = do     dps <- CL.filter (\dp -> isAllowed (dpPackageIdent dp) &&                              (not reqProfiling || dpProfiling dp) &&-                             (not reqHaddock || dpHaddock dp))+                             (not reqHaddock || dpHaddock dp) &&+                             (not reqSymbols || dpSymbols dp))        =$= CL.consume     return $ Map.fromList $ map (packageIdentifierName . dpPackageIdent &&& id) $ Map.elems $ pruneDeps         id@@ -192,7 +197,7 @@ -- | Add profiling information to the stream of @DumpPackage@s addProfiling :: MonadIO m              => InstalledCache-             -> Conduit (DumpPackage a b) m (DumpPackage Bool b)+             -> Conduit (DumpPackage a b c) m (DumpPackage Bool b c) addProfiling (InstalledCache ref) =     CL.mapM go   where@@ -227,7 +232,7 @@ -- | Add haddock information to the stream of @DumpPackage@s addHaddock :: MonadIO m            => InstalledCache-           -> Conduit (DumpPackage a b) m (DumpPackage a Bool)+           -> Conduit (DumpPackage a b c) m (DumpPackage a Bool c) addHaddock (InstalledCache ref) =     CL.mapM go   where@@ -247,8 +252,44 @@                 loop $ dpHaddockInterfaces dp         return dp { dpHaddock = h } +-- | Add debugging symbol information to the stream of @DumpPackage@s+addSymbols :: MonadIO m+           => InstalledCache+           -> Conduit (DumpPackage a b c) m (DumpPackage a b Bool)+addSymbols (InstalledCache ref) =+    CL.mapM go+  where+    go dp = do+        InstalledCacheInner m <- liftIO $ readIORef ref+        let gid = dpGhcPkgId dp+        s <- case Map.lookup gid m of+            Just installed -> return (installedCacheSymbols installed)+            Nothing | null (dpLibraries dp) -> return True+            Nothing -> do+                let lib = T.unpack . head $ dpLibraries dp+                liftM or . mapM (\dir -> liftIO $ hasDebuggingSymbols dir lib) $ dpLibDirs dp+        return dp { dpSymbols = s }++hasDebuggingSymbols :: FilePath -- ^ library directory+                    -> String   -- ^ name of library+                    -> IO Bool+hasDebuggingSymbols dir lib = do+    let path = concat [dir, "/lib", lib, ".a"]+    exists <- doesFileExist path+    if not exists then return False+    else case OS.buildOS of+        OS.OSX     -> liftM (any (isPrefixOf "0x") . lines) $+            readProcess "dwarfdump" [path] ""+        OS.Linux   -> liftM (any (isPrefixOf "Contents") . lines) $+            readProcess "readelf" ["--debug-dump=info", "--dwarf-depth=1", path] ""+        OS.FreeBSD -> liftM (any (isPrefixOf "Contents") . lines) $+            readProcess "readelf" ["--debug-dump=info", "--dwarf-depth=1", path] ""+        OS.Windows -> return False -- No support, so it can't be there.+        _          -> return False++ -- | Dump information for a single package-data DumpPackage profiling haddock = DumpPackage+data DumpPackage profiling haddock symbols = DumpPackage     { dpGhcPkgId :: !GhcPkgId     , dpPackageIdent :: !PackageIdentifier     , dpLibDirs :: ![FilePath]@@ -259,6 +300,7 @@     , dpHaddockHtml :: !(Maybe FilePath)     , dpProfiling :: !profiling     , dpHaddock :: !haddock+    , dpSymbols :: !symbols     , dpIsExposed :: !Bool     }     deriving (Show, Eq, Ord)@@ -280,7 +322,7 @@  -- | Convert a stream of bytes into a stream of @DumpPackage@s conduitDumpPackage :: MonadThrow m-                   => Conduit Text m (DumpPackage () ())+                   => Conduit Text m (DumpPackage () () ()) conduitDumpPackage = (=$= CL.catMaybes) $ eachSection $ do     pairs <- eachPair (\k -> (k, ) <$> CL.consume) =$= CL.consume     let m = Map.fromList pairs@@ -339,6 +381,7 @@                 , dpHaddockHtml = listToMaybe haddockHtml                 , dpProfiling = ()                 , dpHaddock = ()+                , dpSymbols = ()                 , dpIsExposed = exposed == ["True"]                 }
src/Stack/PackageIndex.hs view
@@ -17,7 +17,7 @@ {-# LANGUAGE ViewPatterns               #-} {-# LANGUAGE ScopedTypeVariables        #-} --- | Dealing with the 00-index file and all its cabal files.+-- | Dealing with the 01-index file and all its cabal files. module Stack.PackageIndex     ( updateAllIndices     , getPackageCaches@@ -30,21 +30,25 @@ import qualified Codec.Archive.Tar as Tar import           Control.Exception (Exception) import           Control.Exception.Safe (tryIO)-import           Control.Monad (unless, when, liftM, void)+import           Control.Monad (unless, when, liftM, void, guard) import           Control.Monad.Catch (throwM) import qualified Control.Monad.Catch as C import           Control.Monad.IO.Class (MonadIO, liftIO) import           Control.Monad.Logger (logDebug, logInfo, logWarn, logError)-import           Control.Monad.Reader (asks) import           Control.Monad.Trans.Control+import           Crypto.Hash as Hash (hashlazy, Digest, SHA1) import           Data.Aeson.Extended+import qualified Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16))+import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L-import           Data.Conduit (($$), (=$))-import           Data.Conduit.Binary (sinkHandle, sourceHandle)+import           Data.Conduit (($$), (=$), (.|), runConduitRes)+import           Data.Conduit.Binary (sinkHandle, sourceHandle, sourceFile, sinkFile) import           Data.Conduit.Zlib (ungzip) import           Data.Foldable (forM_) import           Data.IORef import           Data.Int (Int64)+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap import           Data.Map (Map) import qualified Data.Map.Strict as Map import           Data.Monoid@@ -56,18 +60,29 @@ import           Data.Text (Text) import qualified Data.Text as T import           Data.Text.Unsafe (unsafeTail)+import           Data.Time (getCurrentTime) import           Data.Traversable (forM) import           Data.Typeable (Typeable)+import qualified Hackage.Security.Client as HS+import qualified Hackage.Security.Client.Repository.Cache as HS+import qualified Hackage.Security.Client.Repository.Remote as HS+import qualified Hackage.Security.Client.Repository.HttpLib.HttpClient as HS+import qualified Hackage.Security.Util.Path as HS+import qualified Hackage.Security.Util.Pretty as HS+import           Network.HTTP.Client.TLS (getGlobalManager) import           Network.HTTP.Download+import           Network.URI (parseURI) import           Path (mkRelDir, mkRelFile, parent, parseRelDir, toFilePath, parseAbsFile, (</>)) import           Path.IO import           Prelude -- Fix AMP warning+import           Stack.Types.BuildPlan (GitSHA1 (..)) import           Stack.Types.Config import           Stack.Types.PackageIdentifier import           Stack.Types.PackageIndex import           Stack.Types.PackageName import           Stack.Types.StackT import           Stack.Types.Version+import qualified System.Directory as D import           System.FilePath (takeBaseName, (<.>)) import           System.IO (IOMode (ReadMode, WriteMode), withBinaryFile) import           System.Process.Read (EnvOverride, ReadProcessException(..), doesExecutableExist, readProcessNull, tryProcessStdout)@@ -79,7 +94,7 @@     :: (StackMiniM env m, HasConfig env)     => EnvOverride     -> PackageIndex-    -> m (Map PackageIdentifier PackageCache)+    -> m PackageCacheMap populateCache menv index = do     requireIndex menv index     -- This uses full on lazy I/O instead of ResourceT to provide some@@ -88,8 +103,8 @@     let loadPIS = do             $logSticky "Populating index cache ..."             lbs <- liftIO $ L.readFile $ Path.toFilePath path-            loop 0 Map.empty (Tar.read lbs)-    pis <- loadPIS `C.catch` \e -> do+            loop 0 (Map.empty, HashMap.empty) (Tar.read lbs)+    (pis, gitPIs) <- loadPIS `C.catch` \e -> do         $logWarn $ "Exception encountered when parsing index tarball: "                 <> T.pack (show (e :: Tar.FormatError))         $logWarn "Automatically updating index and trying again"@@ -103,42 +118,68 @@      $logStickyDone "Populated index cache." -    return pis+    return $ PackageCacheMap pis gitPIs   where-    loop !blockNo !m (Tar.Next e es) =-        loop (blockNo + entrySizeInBlocks e) (goE blockNo m e) es-    loop _ m Tar.Done = return m+    loop !blockNo (!m, !hm) (Tar.Next e es) =+        loop (blockNo + entrySizeInBlocks e) (goE blockNo m hm e) es+    loop _ (m, hm) Tar.Done = return (m, hm)     loop _ _ (Tar.Fail e) = throwM e -    goE blockNo m e =+    goE blockNo m hm e =         case Tar.entryContent e of             Tar.NormalFile lbs size ->-                case parseNameVersion $ Tar.entryPath e of-                    Just (ident, ".cabal") -> addCabal ident size-                    Just (ident, ".json") -> addJSON ident lbs-                    _ -> m-            _ -> m+                case parseNameVersionSuffix $ Tar.entryPath e of+                    Just (ident, ".cabal") -> addCabal lbs ident size+                    Just (ident, ".json") -> (addJSON id ident lbs, hm)+                    _ ->+                        case parsePackageJSON $ Tar.entryPath e of+                            Just ident -> (addJSON unHSPackageDownload ident lbs, hm)+                            Nothing -> (m, hm)+            _ -> (m, hm)       where-        addCabal ident size = Map.insertWith-            (\_ pcOld -> pcNew { pcDownload = pcDownload pcOld })-            ident-            pcNew-            m+        addCabal lbs ident size =+            ( Map.insertWith+                (\_ pcOld -> pcNew { pcDownload = pcDownload pcOld })+                ident+                pcNew+                m+            , HashMap.insert gitSHA1 offsetSize hm+            )           where             pcNew = PackageCache-                { pcOffset = (blockNo + 1) * 512-                , pcSize = size+                { pcOffsetSize = offsetSize                 , pcDownload = Nothing                 }-        addJSON ident lbs =+            offsetSize = OffsetSize+                    ((blockNo + 1) * 512)+                    size++            -- Calculate the Git SHA1 of the contents. This uses the+            -- Git algorithm of prepending "blob <size>\0" to the raw+            -- contents. We use this to be able to share the same SHA+            -- information between the Git and tarball backends.+            gitSHA1 = GitSHA1 $ Mem.convertToBase Mem.Base16 $ hashSHA1 $ L.fromChunks+                $ "blob "+                : S8.pack (show $ L.length lbs)+                : "\0"+                : L.toChunks lbs++        hashSHA1 :: L.ByteString -> Hash.Digest Hash.SHA1+        hashSHA1 = Hash.hashlazy++        addJSON :: FromJSON a+                => (a -> PackageDownload)+                -> PackageIdentifier+                -> L.ByteString+                -> Map PackageIdentifier PackageCache+        addJSON unwrap ident lbs =             case decode lbs of                 Nothing -> m-                Just !pd -> Map.insertWith+                Just (unwrap -> pd) -> Map.insertWith                     (\_ pc -> pc { pcDownload = Just pd })                     ident                     PackageCache-                        { pcOffset = 0-                        , pcSize = 0+                        { pcOffsetSize = OffsetSize 0 0                         , pcDownload = Just pd                         }                     m@@ -156,11 +197,19 @@         p <- parsePackageName p'         (v', t5) <- breakSlash t3         v <- parseVersion v'+        return (p', p, v, t5)++    parseNameVersionSuffix t1 = do+        (p', p, v, t5) <- parseNameVersion t1         let (t6, suffix) = T.break (== '.') t5-        if t6 == p'-            then return (PackageIdentifier p v, suffix)-            else Nothing+        guard $ t6 == p'+        return (PackageIdentifier p v, suffix) +    parsePackageJSON t1 = do+        (_, p, v, t5) <- parseNameVersion t1+        guard $ t5 == "package.json"+        return $ PackageIdentifier p v+ data PackageIndexException   = GitNotAvailable IndexName   | MissingRequiredHashes IndexName PackageIdentifier@@ -194,22 +243,36 @@                  => EnvOverride -> m () updateAllIndices menv = do     clearPackageCaches-    asks (configPackageIndices . getConfig) >>= mapM_ (updateIndex menv)+    view packageIndicesL >>= mapM_ (updateIndex menv)  -- | Update the index tarball updateIndex :: (StackMiniM env m, HasConfig env)             => EnvOverride -> PackageIndex -> m () updateIndex menv index =   do let name = indexName index-         logUpdate mirror = $logSticky $ "Updating package index " <> indexNameText (indexName index) <> " (mirrored at " <> mirror  <> ") ..."+         sloc = simplifyIndexLocation $ indexLocation index+     $logSticky $ "Updating package index "+               <> indexNameText (indexName index)+               <> " (mirrored at "+               <> (case sloc of+                     SILGit url -> url+                     SILHttp url _ -> url)+               <> ") ..."      git <- isGitInstalled menv-     case (git, indexLocation index) of-        (True, ILGit url) -> logUpdate url >> updateIndexGit menv name index url-        (True, ILGitHttp url _) -> logUpdate url >> updateIndexGit menv name index url-        (_, ILHttp url) -> logUpdate url >> updateIndexHTTP name index url-        (False, ILGitHttp _ url) -> logUpdate url >> updateIndexHTTP name index url-        (False, ILGit url) -> logUpdate url >> throwM (GitNotAvailable name)+     case (git, sloc) of+        (True, SILGit url) -> updateIndexGit menv name index url+        (False, SILGit _) -> throwM (GitNotAvailable name)+        (_, SILHttp url HTVanilla) -> updateIndexHTTP name index url+        (_, SILHttp url (HTHackageSecurity hs)) -> updateIndexHackageSecurity name index url hs +     -- Copy to the 00-index.tar filename for backwards+     -- compatibility. First wipe out the cache file if present.+     tarFile <- configPackageIndex name+     oldTarFile <- configPackageIndexOld name+     oldCacheFile <- configPackageIndexCacheOld name+     ignoringAbsence (removeFile oldCacheFile)+     runConduitRes $ sourceFile (toFilePath tarFile) .| sinkFile (toFilePath oldTarFile)+ -- | Update the index Git repo and the index tarball updateIndexGit :: (StackMiniM env m, HasConfig env)                => EnvOverride@@ -341,6 +404,64 @@         $ "You have enabled GPG verification of the package index, " <>           "but GPG verification only works with Git downloading" +-- | Update the index tarball via Hackage Security+updateIndexHackageSecurity+    :: (StackMiniM env m, HasConfig env)+    => IndexName+    -> PackageIndex+    -> Text -- ^ base URL+    -> HackageSecurity+    -> m ()+updateIndexHackageSecurity indexName' index url (HackageSecurity keyIds threshold) = do+    baseURI <-+        case parseURI $ T.unpack url of+            Nothing -> error $ "Invalid Hackage Security base URL: " ++ T.unpack url+            Just x -> return x+    manager <- liftIO getGlobalManager+    root <- configPackageIndexRoot indexName'+    logTUF <- embed_ ($logInfo . T.pack . HS.pretty)+    let withRepo = HS.withRepository+            (HS.makeHttpLib manager)+            [baseURI]+            HS.defaultRepoOpts+            HS.Cache+                { HS.cacheRoot = HS.fromAbsoluteFilePath $ toFilePath root+                , HS.cacheLayout = HS.cabalCacheLayout+                    -- Have Hackage Security write to a temporary file+                    -- to avoid invalidating the cache... continued+                    -- below at case didUpdate+                    { HS.cacheLayoutIndexTar = HS.rootPath $ HS.fragment "01-index.tar-tmp"+                    }+                }+            HS.hackageRepoLayout+            HS.hackageIndexLayout+            logTUF+    didUpdate <- liftIO $ withRepo $ \repo -> HS.uncheckClientErrors $ do+        needBootstrap <- HS.requiresBootstrap repo+        when needBootstrap $ do+            HS.bootstrap+                repo+                (map (HS.KeyId . T.unpack) keyIds)+                (HS.KeyThreshold (fromIntegral threshold))+        now <- getCurrentTime+        HS.checkForUpdates repo (Just now)++    case didUpdate of+        HS.HasUpdates -> do+            -- The index actually updated. Delete the old cache, and+            -- then move the temporary unpacked file to its real+            -- location+            tar <- configPackageIndex indexName'+            deleteCache indexName'+            liftIO $ D.renameFile (toFilePath tar ++ "-tmp") (toFilePath tar)+            $logInfo "Updated package list downloaded"+        HS.NoUpdates -> $logInfo "No updates to your package list were found"++    when (indexGpgVerify index)+        $ $logWarn+        $ "You have enabled GPG verification of the package index, " <>+          "but GPG verification only works with Git downloading"+ -- | Is the git executable installed? isGitInstalled :: MonadIO m                => EnvOverride@@ -365,7 +486,7 @@ getPackageVersionsIO = do     getCaches <- getPackageCachesIO     return $ \name ->-        fmap (lookupPackageVersions name) getCaches+        fmap (lookupPackageVersions name . fst) getCaches  -- | Get the known versions for a given package from the package caches. --@@ -375,7 +496,7 @@     => PackageName     -> m (Set Version) getPackageVersions pkgName =-    fmap (lookupPackageVersions pkgName) getPackageCaches+    fmap (lookupPackageVersions pkgName . fst) getPackageCaches  lookupPackageVersions :: PackageName -> Map PackageIdentifier a -> Set Version lookupPackageVersions pkgName pkgCaches =@@ -388,7 +509,8 @@ -- has been found. getPackageCachesIO     :: (StackMiniM env m, HasConfig env)-    => m (IO (Map PackageIdentifier (PackageIndex, PackageCache)))+    => m (IO ( Map PackageIdentifier (PackageIndex, PackageCache)+             , HashMap GitSHA1 (PackageIndex, OffsetSize))) getPackageCachesIO = toIO getPackageCaches   where     toIO :: (MonadIO m, MonadBaseControl IO m) => m a -> m (IO a)@@ -407,22 +529,24 @@ -- feel free to call this function multiple times. getPackageCaches     :: (StackMiniM env m, HasConfig env)-    => m (Map PackageIdentifier (PackageIndex, PackageCache))+    => m ( Map PackageIdentifier (PackageIndex, PackageCache)+         , HashMap GitSHA1 (PackageIndex, OffsetSize)+         ) getPackageCaches = do     menv <- getMinimalEnvOverride-    config <- askConfig+    config <- view configL     mcached <- liftIO $ readIORef (configPackageCaches config)     case mcached of         Just cached -> return cached         Nothing -> do             result <- liftM mconcat $ forM (configPackageIndices config) $ \index -> do                 fp <- configPackageIndexCache (indexName index)-                PackageCacheMap pis' <--                    $(versionedDecodeOrLoad (storeVersionConfig "pkg-v1" "aHzcZ6_w3rL6NtEJUqEfh6fcjAc="+                PackageCacheMap pis' gitPIs <-+                    $(versionedDecodeOrLoad (storeVersionConfig "pkg-v2" "WlAvAaRXlIMkjSmg5G3dD16UpT8="                                              :: VersionConfig PackageCacheMap))                     fp-                    (liftM PackageCacheMap (populateCache menv index))-                return (fmap (index,) pis')+                    (populateCache menv index)+                return (fmap (index,) pis', fmap (index,) gitPIs)             liftIO $ writeIORef (configPackageCaches config) (Just result)             return result @@ -430,7 +554,7 @@ -- hackage index is updated. clearPackageCaches :: (StackMiniM env m, HasConfig env) => m () clearPackageCaches = do-    cacheRef <- asks (configPackageCaches . getConfig)+    cacheRef <- view packageCachesL     liftIO $ writeIORef cacheRef Nothing  --------------- Lifted from cabal-install, Distribution.Client.Tar:
src/Stack/Path.hs view
@@ -18,6 +18,7 @@ import           Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T+import           Lens.Micro (lens) import qualified Options.Applicative as OA import           Path import           Path.Extra@@ -38,7 +39,7 @@ path keys =     do -- We must use a BuildConfig from an EnvConfig to ensure that it contains the        -- full environment info including GHC paths etc.-       bc <- asks (getBuildConfig . getEnvConfig)+       bc <- view $ envConfigL.buildConfigL        -- This is the modified 'bin-path',        -- including the local GHC or MSYS if not configured to operate on        -- global GHC.@@ -48,12 +49,13 @@        snap <- packageDatabaseDeps        plocal <- packageDatabaseLocal        extra <- packageDatabaseExtra-       global <- GhcPkg.getGlobalDB menv =<< getWhichCompiler+       whichCompiler <- view $ actualCompilerVersionL.whichCompilerL+       global <- GhcPkg.getGlobalDB menv whichCompiler        snaproot <- installationRootDeps        localroot <- installationRootLocal        distDir <- distRelativeDir        hpcDir <- hpcReportDir-       compiler <- getCompilerPath =<< getWhichCompiler+       compiler <- getCompilerPath whichCompiler        let deprecated = filter ((`elem` keys) . fst) deprecatedPathKeys        liftIO $ forM_ deprecated $ \(oldOption, newOption) -> T.hPutStrLn stderr $ T.unlines            [ ""@@ -114,6 +116,12 @@     , piCompiler     :: Path Abs File     } +instance HasPlatform PathInfo+instance HasConfig PathInfo+instance HasBuildConfig PathInfo where+    buildConfigL = lens piBuildConfig (\x y -> x { piBuildConfig = y })+                 . buildConfigL+ -- | 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@@ -127,19 +135,19 @@ paths =     [ ( "Global stack root directory"       , T.pack stackRootOptionName-      , T.pack . toFilePathNoTrailingSep . configStackRoot . bcConfig . piBuildConfig )+      , view $ stackRootL.to toFilePathNoTrailingSep.to T.pack)     , ( "Project root (derived from stack.yaml file)"       , "project-root"-      , T.pack . toFilePathNoTrailingSep . bcRoot . piBuildConfig )+      , view $ projectRootL.to toFilePathNoTrailingSep.to T.pack)     , ( "Configuration location (where the stack.yaml file is)"       , "config-location"-      , T.pack . toFilePath . bcStackYaml . piBuildConfig )+      , view $ stackYamlL.to toFilePath.to T.pack)     , ( "PATH environment variable"       , "bin-path"       , T.pack . intercalate [FP.searchPathSeparator] . eoPath . piEnvOverride )     , ( "Install location for GHC and other core tools"       , "programs"-      , T.pack . toFilePathNoTrailingSep . configLocalPrograms . bcConfig . piBuildConfig )+      , view $ configL.to configLocalPrograms.to toFilePathNoTrailingSep.to T.pack)     , ( "Compiler binary (e.g. ghc)"       , "compiler-exe"       , T.pack . toFilePath . piCompiler )@@ -148,13 +156,13 @@       , T.pack . toFilePathNoTrailingSep . parent . piCompiler )     , ( "Local bin dir where stack installs executables (e.g. ~/.local/bin)"       , "local-bin"-      , T.pack . toFilePathNoTrailingSep . configLocalBin . bcConfig . piBuildConfig )+      , view $ configL.to configLocalBin.to toFilePathNoTrailingSep.to T.pack)     , ( "Extra include directories"       , "extra-include-dirs"-      , T.intercalate ", " . map (T.pack . toFilePathNoTrailingSep) . Set.elems . configExtraIncludeDirs . bcConfig . piBuildConfig )+      , T.intercalate ", " . map (T.pack . toFilePathNoTrailingSep) . Set.elems . configExtraIncludeDirs . view configL )     , ( "Extra library directories"       , "extra-library-dirs"-      , T.intercalate ", " . map (T.pack . toFilePathNoTrailingSep) . Set.elems . configExtraLibDirs . bcConfig . piBuildConfig )+      , T.intercalate ", " . map (T.pack . toFilePathNoTrailingSep) . Set.elems . configExtraLibDirs . view configL )     , ( "Snapshot package database"       , "snapshot-pkg-db"       , T.pack . toFilePathNoTrailingSep . piSnapDb )@@ -187,13 +195,13 @@       , T.pack . toFilePathNoTrailingSep . piHpcDir )     , ( "DEPRECATED: Use '--local-bin' instead"       , "local-bin-path"-      , T.pack . toFilePathNoTrailingSep . configLocalBin . bcConfig . piBuildConfig )+      , T.pack . toFilePathNoTrailingSep . configLocalBin . view configL )     , ( "DEPRECATED: Use '--programs' instead"       , "ghc-paths"-      , T.pack . toFilePathNoTrailingSep . configLocalPrograms . bcConfig . piBuildConfig )+      , T.pack . toFilePathNoTrailingSep . configLocalPrograms . view configL )     , ( "DEPRECATED: Use '--" <> stackRootOptionName <> "' instead"       , T.pack deprecatedStackRootOptionName-      , T.pack . toFilePathNoTrailingSep . configStackRoot . bcConfig . piBuildConfig )+      , T.pack . toFilePathNoTrailingSep . view stackRootL )     ]  deprecatedPathKeys :: [(Text, Text)]
src/Stack/PrettyPrint.hs view
@@ -50,7 +50,7 @@     :: (HasLogOptions env, MonadReader env m, Display a, HasAnsiAnn (Ann a))     => a -> m T.Text displayWithColor x = do-    useAnsi <- asks (logUseColor . getLogOptions)+    useAnsi <- liftM logUseColor $ view logOptionsL     return $ if useAnsi then displayAnsi x else displayPlain x  -- TODO: switch to using implicit callstacks once 7.8 support is dropped
src/Stack/Runners.hs view
@@ -43,7 +43,7 @@ loadCompilerVersion go lc = do     bconfig <- runStackTGlobal () go $       lcLoadBuildConfig lc (globalCompiler go)-    return $ bcWantedCompiler bconfig+    return $ view wantedCompilerVersionL bconfig  -- | Enforce mutual exclusion of every action running via this -- function, on this path, on this users account.@@ -108,7 +108,10 @@     -> IO () withGlobalConfigAndLock go@GlobalOpts{..} inner = do     lc <- runStackTGlobal () go $-        loadConfigMaybeProject globalConfigMonoid Nothing Nothing+        loadConfigMaybeProject+            globalConfigMonoid+            Nothing+            LCSNoProject     withUserFileLock go (configStackRoot $ lcConfig lc) $ \_lk ->         runStackTGlobal (lcConfig lc) go inner @@ -207,9 +210,13 @@     -> StackT MiniConfig IO ()     -> IO () withMiniConfigAndLock go@GlobalOpts{..} inner = do-    miniConfig <- runStackTGlobal () go $ do-        lc <- loadConfigMaybeProject globalConfigMonoid globalResolver Nothing-        loadMiniConfig (lcConfig lc)+    miniConfig <-+        runStackTGlobal () go $+        (loadMiniConfig . lcConfig) <$>+        loadConfigMaybeProject+          globalConfigMonoid+          globalResolver+          LCSNoProject     runStackTGlobal miniConfig go inner  -- | Unlock a lock file, if the value is Just
src/Stack/SDist.hs view
@@ -22,7 +22,6 @@ import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import           Control.Monad.Trans.Control (liftBaseWith) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8@@ -69,7 +68,7 @@ -- | Special exception to throw when you want to fail because of bad results -- of package check. -data CheckException+newtype CheckException   = CheckException (NonEmpty Check.PackageCheck)   deriving (Typeable) @@ -92,7 +91,7 @@   -> Path Abs Dir               -- ^ Path to local package   -> m (FilePath, L.ByteString) -- ^ Filename and tarball contents getSDistTarball mpvpBounds pkgDir = do-    config <- asks getConfig+    config <- view configL     let pvpBounds = fromMaybe (configPvpBounds config) mpvpBounds         tweakCabal = pvpBounds /= PvpBoundsNone         pkgFp = toFilePath pkgDir@@ -137,6 +136,7 @@     (installedMap, _, _, _) <- getInstalled menv GetInstalledOpts                                 { getInstalledProfiling = False                                 , getInstalledHaddock = False+                                , getInstalledSymbols = False                                 }                                 sourceMap     let gpd' = gtraverseT (addBounds sourceMap installedMap) gpd
+ src/Stack/Script.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+module Stack.Script+    ( scriptCmd+    ) where++import           Control.Exception          (assert)+import           Control.Exception.Safe     (throwM)+import           Control.Monad              (unless, forM)+import           Control.Monad.IO.Class     (liftIO)+import           Control.Monad.Logger+import           Data.ByteString            (ByteString)+import qualified Data.ByteString.Char8      as S8+import qualified Data.Conduit.List          as CL+import           Data.Foldable              (fold)+import           Data.List.Split            (splitWhen)+import qualified Data.Map.Strict            as Map+import           Data.Maybe                 (fromMaybe, mapMaybe)+import           Data.Monoid+import           Data.Set                   (Set)+import qualified Data.Set                   as Set+import           Data.Store.VersionTagged   (versionedDecodeOrLoad)+import qualified Data.Text                  as T+import           Data.Text.Encoding         (encodeUtf8)+import           Path+import           Path.IO+import qualified Stack.Build+import           Stack.BuildPlan            (loadBuildPlan)+import           Stack.Exec+import           Stack.GhcPkg               (ghcPkgExeName)+import           Stack.Options.ScriptParser+import           Stack.Runners+import           Stack.Types.BuildPlan+import           Stack.Types.Compiler+import           Stack.Types.Config+import           Stack.Types.PackageName+import           Stack.Types.Resolver+import           Stack.Types.StackT+import           System.FilePath            (dropExtension, replaceExtension)+import           System.Process.Read++-- | Run a Stack Script+scriptCmd :: ScriptOpts -> GlobalOpts -> IO ()+scriptCmd opts go' = do+    let go = go'+            { globalConfigMonoid = (globalConfigMonoid go')+                { configMonoidInstallGHC = First $ Just True+                }+            , globalStackYaml = SYLNoConfig+            }+    withBuildConfigAndLock go $ \lk -> 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+        case globalStackYaml go' of+          SYLOverride fp -> $logError $ T.pack+            $ "Ignoring override stack.yaml file for script command: " ++ fp+          SYLDefault -> return ()+          SYLNoConfig -> assert False (return ())++        config <- view configL+        menv <- liftIO $ configEnvOverride config defaultEnvSettings+        wc <- view $ actualCompilerVersionL.whichCompilerL++        (targetsSet, coresSet) <-+            case soPackages opts of+                [] -> do+                    $logError "No packages provided, using experimental import parser"+                    getPackagesFromImports (globalResolver go) (soFile opts)+                packages -> do+                    let targets = concatMap wordsComma packages+                    targets' <- mapM parsePackageNameFromString targets+                    return (Set.fromList targets', Set.empty)++        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.+            bss <- sinkProcessStdout+                Nothing menv (ghcPkgExeName wc)+                ["list", "--simple-output"] 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"+                    Stack.Build.build (const $ return ()) lk defaultBuildOptsCLI+                        { boptsCLITargets = map packageNameText $ Set.toList targetsSet+                        }++        let ghcArgs = concat+                [ ["-hide-all-packages"]+                , map (\x -> "-package" ++ x)+                    $ Set.toList+                    $ Set.insert "base"+                    $ Set.map packageNameString (Set.union targetsSet coresSet)+                , case soCompile opts of+                    SEInterpret -> []+                    SECompile -> []+                    SEOptimize -> ["-O2"]+                ]+        munlockFile lk -- Unlock before transferring control away.+        case soCompile opts of+          SEInterpret -> exec menv ("run" ++ compilerExeName wc)+                (ghcArgs ++ soFile opts : soArgs opts)+          _ -> do+            file <- resolveFile' $ soFile opts+            let dir = parent file+            -- use sinkProcessStdout to ensure a ProcessFailed+            -- exception is generated for better error messages+            sinkProcessStdout+              (Just dir)+              menv+              (compilerExeName wc)+              (ghcArgs ++ [soFile opts])+              CL.sinkNull+            exec menv (toExeName $ toFilePath file) (soArgs opts)+  where+    toPackageName = reverse . drop 1 . dropWhile (/= '-') . reverse++    -- Like words, but splits on both commas and spaces+    wordsComma = splitWhen (\c -> c == ' ' || c == ',')++    toExeName fp =+      if isWindows+        then replaceExtension fp "exe"+        else dropExtension fp++isWindows :: Bool+#ifdef WINDOWS+isWindows = True+#else+isWindows = False+#endif++-- | Returns packages that need to be installed, and all of the core+-- packages. Reason for the core packages:++-- Ideally we'd have the list of modules per core package listed in+-- the build plan, but that doesn't exist yet. Next best would be to+-- list the modules available at runtime, but that gets tricky with when we install GHC. Instead, we'll just list all core packages+getPackagesFromImports :: Maybe AbstractResolver+                       -> FilePath+                       -> StackT EnvConfig IO (Set PackageName, Set PackageName)+getPackagesFromImports Nothing _ = throwM NoResolverWhenUsingNoLocalConfig+getPackagesFromImports (Just (ARResolver (ResolverSnapshot name))) scriptFP = do+    (pns1, mns) <- liftIO $ parseImports <$> S8.readFile scriptFP+    mi <- loadModuleInfo name+    pns2 <-+        if Set.null mns+            then return Set.empty+            else do+                pns <- forM (Set.toList mns) $ \mn ->+                    case Map.lookup mn $ miModules mi of+                        Just pns ->+                            case Set.toList pns of+                                [] -> assert False $ return Set.empty+                                [pn] -> return $ Set.singleton pn+                                pns' -> error $ concat+                                    [ "Module "+                                    , S8.unpack $ unModuleName mn+                                    , " appears in multiple packages: "+                                    , unwords $ map packageNameString pns'+                                    ]+                        Nothing -> return Set.empty+                return $ Set.unions pns `Set.difference` blacklist+    return (Set.union pns1 pns2, modifyForWindows $ miCorePackages mi)+  where+    modifyForWindows+        | isWindows = Set.insert $(mkPackageName "Win32") . Set.delete $(mkPackageName "unix")+        | otherwise = id++getPackagesFromImports (Just (ARResolver (ResolverCompiler _))) _ = return (Set.empty, Set.empty)+getPackagesFromImports (Just aresolver) _ = throwM $ InvalidResolverForNoLocalConfig $ show aresolver++-- | 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")+    ]++toModuleInfo :: BuildPlan -> ModuleInfo+toModuleInfo bp = ModuleInfo+    { miCorePackages = Map.keysSet $ siCorePackages $ bpSystemInfo bp+    , miModules =+              Map.unionsWith Set.union+            $ map ((\(pn, mns) ->+                    Map.fromList+                  $ map (\mn -> (ModuleName $ encodeUtf8 mn, Set.singleton pn))+                  $ Set.toList mns) . fmap (sdModules . ppDesc))+            $ filter (\(pn, pp) ->+                    not (pcHide $ ppConstraints pp) &&+                    pn `Set.notMember` blacklist)+            $ Map.toList (bpPackages bp)+    }++-- | Where to store module info caches+moduleInfoCache :: SnapName -> StackT EnvConfig IO (Path Abs File)+moduleInfoCache name = do+    root <- view stackRootL+    platform <- platformGhcVerOnlyRelDir+    name' <- parseRelDir $ T.unpack $ renderSnapName name+    -- These probably can't vary at all based on platform, even in the+    -- future, so it's safe to call this unnecessarily paranoid.+    return (root </> $(mkRelDir "script") </> name' </> platform </> $(mkRelFile "module-info.cache"))++loadModuleInfo :: SnapName -> StackT EnvConfig IO ModuleInfo+loadModuleInfo name = do+    path <- moduleInfoCache name+    $(versionedDecodeOrLoad moduleInfoVC) path $ toModuleInfo <$> loadBuildPlan name++parseImports :: ByteString -> (Set PackageName, Set ModuleName)+parseImports =+    fold . mapMaybe parseLine . S8.lines+  where+    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 <- parsePackageNameFromString $ S8.unpack $ S8.takeWhile (/= '"') bs4+                Just (Set.singleton pn, Set.empty)+            Nothing -> Just+                ( Set.empty+                , Set.singleton+                    $ ModuleName+                    $ S8.takeWhile (\c -> c /= ' ' && c /= '(') bs3+                )
src/Stack/Setup.hs view
@@ -38,10 +38,10 @@ import              Control.Monad.Catch import              Control.Monad.IO.Class (MonadIO, liftIO) import              Control.Monad.Logger-import              Control.Monad.Reader (MonadReader, ReaderT (..), asks)+import              Control.Monad.Reader (MonadReader, ReaderT (..)) import              Control.Monad.State (get, put, modify) import              Control.Monad.Trans.Control-import "cryptohash" Crypto.Hash (SHA1(SHA1))+import "cryptonite" Crypto.Hash (SHA1(..)) import              Data.Aeson.Extended import qualified    Data.ByteString as S import qualified    Data.ByteString.Char8 as S8@@ -98,7 +98,6 @@ import              Stack.Types.CompilerBuild import              Stack.Types.Config import              Stack.Types.Docker-import              Stack.Types.Internal (envConfigBuildOpts, buildOptsInstallExes, buildOptsHaddock) import              Stack.Types.PackageIdentifier import              Stack.Types.PackageName import              Stack.Types.StackT@@ -216,26 +215,29 @@          => Maybe Text -- ^ Message to give user when necessary GHC is not available          -> m EnvConfig setupEnv mResolveMissingGHC = do-    bconfig <- asks getBuildConfig-    let platform = getPlatform bconfig-        wc = whichCompiler (bcWantedCompiler bconfig)-        sopts = SetupOpts-            { soptsInstallIfMissing = configInstallGHC $ bcConfig bconfig-            , soptsUseSystem = configSystemGHC $ bcConfig bconfig-            , soptsWantedCompiler = bcWantedCompiler bconfig-            , soptsCompilerCheck = configCompilerCheck $ bcConfig bconfig-            , soptsStackYaml = Just $ bcStackYaml bconfig+    config <- view configL+    bconfig <- view buildConfigL+    let stackYaml = bcStackYaml bconfig+    platform <- view platformL+    wcVersion <- view wantedCompilerVersionL+    wc <- view $ wantedCompilerVersionL.whichCompilerL+    let sopts = SetupOpts+            { soptsInstallIfMissing = configInstallGHC config+            , soptsUseSystem = configSystemGHC config+            , soptsWantedCompiler = wcVersion+            , soptsCompilerCheck = configCompilerCheck config+            , soptsStackYaml = Just stackYaml             , soptsForceReinstall = False             , soptsSanityCheck = False-            , soptsSkipGhcCheck = configSkipGHCCheck $ bcConfig bconfig-            , soptsSkipMsys = configSkipMsys $ bcConfig bconfig+            , soptsSkipGhcCheck = configSkipGHCCheck config+            , soptsSkipMsys = configSkipMsys config             , soptsUpgradeCabal = False             , soptsResolveMissingGHC = mResolveMissingGHC             , soptsSetupInfoYaml = defaultSetupInfoYaml             , soptsGHCBindistURL = Nothing             } -    (mghcBin, compilerBuild) <- ensureCompiler sopts+    (mghcBin, compilerBuild, _) <- ensureCompiler sopts      -- Modify the initial environment to include the GHC path, if a local GHC     -- is being used@@ -251,8 +253,9 @@      $logDebug "Resolving package entries"     packagesRef <- liftIO $ newIORef Nothing+    bc <- view buildConfigL     let envConfig0 = EnvConfig-            { envConfigBuildConfig = bconfig+            { envConfigBuildConfig = bc             , envConfigCabalVersion = cabalVer             , envConfigCompilerVersion = compilerVer             , envConfigCompilerBuild = compilerBuild@@ -329,7 +332,7 @@     return EnvConfig         { envConfigBuildConfig = bconfig             { bcConfig = maybe id addIncludeLib mghcBin-                          (bcConfig bconfig)+                        (view configL bconfig)                 { configEnvOverride = getEnvOverride' }             }         , envConfigCabalVersion = cabalVer@@ -352,7 +355,7 @@ -- | Ensure compiler (ghc or ghcjs) is installed and provide the PATHs to add if necessary ensureCompiler :: (StackM env m, HasConfig env, HasGHCVariant env)                => SetupOpts-               -> m (Maybe ExtraDirs, CompilerBuild)+               -> m (Maybe ExtraDirs, CompilerBuild, Bool) ensureCompiler sopts = do     let wc = whichCompiler (soptsWantedCompiler sopts)     when (getGhcVersion (soptsWantedCompiler sopts) < $(mkVersion "7.8")) $ do@@ -371,7 +374,7 @@                 getSystemCompiler menv0 wc             else return Nothing -    Platform expectedArch _ <- asks getPlatform+    Platform expectedArch _ <- view platformL      let canUseCompiler compilerVersion arch             | soptsSkipGhcCheck sopts = True@@ -382,8 +385,8 @@     getSetupInfo' <- runOnce (getSetupInfo (soptsSetupInfoYaml sopts))      let getMmsys2Tool = do-            platform <- asks getPlatform-            localPrograms <- asks $ configLocalPrograms . getConfig+            platform <- view platformL+            localPrograms <- view $ configL.to configLocalPrograms             installed <- listInstalled localPrograms              case platform of@@ -394,7 +397,7 @@                             | soptsInstallIfMissing sopts -> do                                 si <- getSetupInfo'                                 osKey <- getOSKey platform-                                config <- asks getConfig+                                config <- view configL                                 VersionedDownloadInfo version info <-                                     case Map.lookup osKey $ siMsys2 si of                                         Just x -> return x@@ -412,12 +415,12 @@     (mtools, compilerBuild) <- if needLocal         then do -            localPrograms <- asks $ configLocalPrograms . getConfig+            -- Install GHC+            ghcVariant <- view ghcVariantL+            config <- view configL+            let localPrograms = configLocalPrograms config             installed <- listInstalled localPrograms -            -- Install GHC-            ghcVariant <- asks getGHCVariant-            config <- asks getConfig             (installedCompiler, compilerBuild) <-                     case wc of                         Ghc -> do@@ -482,7 +485,7 @@         case mpaths of             Nothing -> return menv0             Just ed -> do-                config <- asks getConfig+                config <- view configL                 m <- augmentPathMap (edBins ed) (unEnvOverride menv0)                 mkEnvOverride (configPlatform config) (removeHaskellEnvVars m) @@ -498,7 +501,7 @@      when (soptsSanityCheck sopts) $ sanityCheck menv wc -    return (mpaths, compilerBuild)+    return (mpaths, compilerBuild, needLocal)  -- | Determine which GHC build to use depending on which shared libraries are available -- on the system.@@ -507,7 +510,7 @@     => EnvOverride -> m CompilerBuild getGhcBuild menv = do -    config <- asks getConfig+    config <- view configL     case configGHCBuild config of         Just ghcBuild -> return ghcBuild         Nothing -> determineGhcBuild@@ -531,7 +534,7 @@         --         -- Of course, could also try to make a static GHC bindist instead of all this rigamarole. -        platform <- asks getPlatform+        platform <- view platformL         case platform of             Platform _ Linux -> do                 -- Some systems don't have ldconfig in the PATH, so make sure to look in /sbin and /usr/sbin as well@@ -605,7 +608,7 @@     :: (StackM env m, HasConfig env)     => Platform -> m (Path Abs File) ensureDockerStackExe containerPlatform = do-    config <- asks getConfig+    config <- view configL     containerPlatformDir <- runReaderT platformOnlyRelDir (containerPlatform,PlatformVariantNone)     let programsPath = configLocalProgramsBase config </> containerPlatformDir         tool = Tool (PackageIdentifier $(mkPackageName "stack") stackVersion)@@ -626,9 +629,9 @@              -> m () upgradeCabal menv wc = do     let name = $(mkPackageName "Cabal")-    rmap <- resolvePackages menv Map.empty (Set.singleton name)+    rmap <- resolvePackages menv Nothing Map.empty (Set.singleton name)     newest <--        case Map.keys rmap of+        case map rpIdent rmap of             [] -> error "No Cabal library found in index, cannot upgrade"             [PackageIdentifier name' version]                 | name == name' -> return version@@ -665,7 +668,7 @@                     Just dir -> return dir              runCmd (Cmd (Just dir) (compilerExeName wc) menv ["Setup.hs"]) Nothing-            platform <- asks getPlatform+            platform <- view platformL             let setupExe = toFilePath $ dir </>                   (case platform of                      Platform _ Cabal.Windows -> $(mkRelFile "Setup.exe")@@ -713,7 +716,7 @@     :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader env m, HasConfig env)     => String -> m SetupInfo getSetupInfo stackSetupYaml = do-    config <- asks getConfig+    config <- view configL     setupInfos <-         mapM             loadSetupInfo@@ -789,7 +792,7 @@                            -> Maybe String                            -> m Tool downloadAndInstallCompiler ghcBuild si wanted@GhcVersion{} versionCheck mbindistURL = do-    ghcVariant <- asks getGHCVariant+    ghcVariant <- view ghcVariantL     (selectedVersion, downloadInfo) <- case mbindistURL of         Just bindistURL -> do             case ghcVariant of@@ -805,7 +808,7 @@             case Map.lookup ghcKey $ siGHCs si of                 Nothing -> throwM $ UnknownOSKey ghcKey                 Just pairs_ -> getWantedCompilerInfo ghcKey versionCheck wanted GhcVersion pairs_-    config <- asks getConfig+    config <- view configL     let installer =             case configPlatform config of                 Platform _ Cabal.Windows -> installGHCWindows selectedVersion@@ -824,8 +827,8 @@     let tool = Tool $ PackageIdentifier ghcPkgName selectedVersion     downloadAndInstallTool (configLocalPrograms config) si (gdiDownloadInfo downloadInfo) tool installer downloadAndInstallCompiler compilerBuild si wanted versionCheck _mbindistUrl = do-    config <- asks getConfig-    ghcVariant <- asks getGHCVariant+    config <- view configL+    ghcVariant <- view ghcVariantL     case (ghcVariant, compilerBuild) of         (GHCStandard, CompilerBuildStandard) -> return ()         _ -> throwM GHCJSRequiresStandardVariant@@ -857,8 +860,8 @@ getGhcKey :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadCatch m)           => CompilerBuild -> m Text getGhcKey ghcBuild = do-    ghcVariant <- asks getGHCVariant-    platform <- asks getPlatform+    ghcVariant <- view ghcVariantL+    platform <- view platformL     osKey <- getOSKey platform     return $ osKey <> T.pack (ghcVariantSuffix ghcVariant) <> T.pack (compilerBuildSuffix ghcBuild) @@ -936,7 +939,7 @@                 -> Path Abs Dir                 -> m () installGHCPosix version downloadInfo _ archiveFile archiveType tempDir destDir = do-    platform <- asks getPlatform+    platform <- view platformL     menv0 <- getMinimalEnvOverride     menv <- mkEnvOverride platform (removeHaskellEnvVars (unEnvOverride menv0))     $logDebug $ "menv = " <> T.pack (show (unEnvOverride menv))@@ -1009,7 +1012,7 @@              -> Path Abs Dir              -> m () installGHCJS si archiveFile archiveType _tempDir destDir = do-    platform <- asks getPlatform+    platform <- view platformL     menv0 <- getMinimalEnvOverride     -- This ensures that locking is disabled for the invocations of     -- stack below.@@ -1070,8 +1073,8 @@         _ -> return Nothing      $logSticky "Installing GHCJS (this will take a long time) ..."-    runInnerStackT (set (envConfigBuildOpts.buildOptsInstallExes) True $-                    set (envConfigBuildOpts.buildOptsHaddock) False envConfig') $+    runInnerStackT (set (buildOptsL.buildOptsInstallExesL) True $+                    set (buildOptsL.buildOptsHaddockL) False envConfig') $         build (\_ -> return ()) Nothing defaultBuildOptsCLI     -- Copy over *.options files needed on windows.     forM_ mwindowsInstallDir $ \dir -> do@@ -1092,7 +1095,7 @@             return ()         Left (ProcessFailed _ _ _ err) | "ghcjs_boot.completed" `S.isInfixOf` LBS.toStrict err ->             if not shouldBoot then throwM GHCJSNotBooted else do-                config <- asks getConfig+                config <- view configL                 destDir <- installDir (configLocalPrograms config) (ToolGhcjs cv)                 let stackYaml = destDir </> $(mkRelFile "src/stack.yaml")                 -- TODO: Remove 'actualStackYaml' and just use@@ -1121,7 +1124,7 @@           => Version -> Path Abs File -> Path Abs Dir -> m () bootGhcjs ghcjsVersion stackYaml destDir = do     envConfig <- loadGhcjsEnvConfig stackYaml (destDir </> $(mkRelDir "bin"))-    menv <- liftIO $ configEnvOverride (getConfig envConfig) defaultEnvSettings+    menv <- liftIO $ configEnvOverride (view configL envConfig) defaultEnvSettings     -- Install cabal-install if missing, or if the installed one is old.     mcabal <- getCabalInstallVersion menv     shouldInstallCabal <- case mcabal of@@ -1152,7 +1155,7 @@                 return True             | otherwise -> return False     let envSettings = defaultEnvSettings { esIncludeGhcPackagePath = False }-    menv' <- liftIO $ configEnvOverride (getConfig envConfig) envSettings+    menv' <- liftIO $ configEnvOverride (view configL envConfig) envSettings     when shouldInstallCabal $ do         $logInfo "Building a local copy of cabal-install from source."         runInnerStackT envConfig $@@ -1184,7 +1187,7 @@             , configMonoidLocalBinPath = First (Just (toFilePath binPath))             })         Nothing-        (Just stackYaml)+        (SYLOverride stackYaml)     bconfig <- lcLoadBuildConfig lc Nothing     runInnerStackT bconfig $ setupEnv Nothing @@ -1266,7 +1269,7 @@     -- 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.-    platform <- asks getPlatform+    platform <- view platformL     menv0 <- getMinimalEnvOverride     newEnv0 <- modifyEnvOverride menv0 $ Map.insert "MSYSTEM" "MSYS"     newEnv <- augmentPathMap [destDir </> $(mkRelDir "usr") </> $(mkRelDir "bin")]@@ -1335,7 +1338,7 @@         => SetupInfo         -> m (Path Abs Dir -> Path Abs File -> n ()) setup7z si = do-    dir <- asks $ configLocalPrograms . getConfig+    dir <- view $ configL.to configLocalPrograms     ensureDir dir     let exe = dir </> $(mkRelFile "7z.exe")         dll = dir </> $(mkRelFile "7z.dll")@@ -1524,7 +1527,7 @@         else legacyLocale   where     legacyLocale = do-        Platform _ os <- asks getPlatform+        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@@ -1673,7 +1676,7 @@ preferredPlatforms :: (MonadReader env m, HasPlatform env)                    => m [(Bool, String)] preferredPlatforms = do-    Platform arch' os' <- asks getPlatform+    Platform arch' os' <- view platformL     (isWindows, os) <-       case os' of         Cabal.Linux -> return (False, "linux")@@ -1733,7 +1736,7 @@      $logInfo "Download complete, testing executable" -    platform <- asks getPlatform+    platform <- view platformL      liftIO $ do #if !WINDOWS
src/Stack/Setup/Installed.hs view
@@ -25,7 +25,7 @@ import           Control.Monad.Catch import           Control.Monad.IO.Class (MonadIO, liftIO) import           Control.Monad.Logger-import           Control.Monad.Reader (MonadReader, asks)+import           Control.Monad.Reader (MonadReader) import           Control.Monad.Trans.Control import qualified Data.ByteString.Char8 as S8 import           Data.List hiding (concat, elem, maximumBy)@@ -122,7 +122,7 @@           => Tool           -> m ExtraDirs extraDirs tool = do-    config <- asks getConfig+    config <- view configL     dir <- installDir (configLocalPrograms config) tool     case (configPlatform config, toolNameString tool) of         (Platform _ Cabal.Windows, isGHC -> True) -> return mempty
src/Stack/SetupCmd.hs view
@@ -85,8 +85,8 @@     -> Maybe (Path Abs File)     -> m () setup SetupCmdOpts{..} wantedCompiler compilerCheck mstack = do-    Config{..} <- asks getConfig-    mpaths <- fst <$> ensureCompiler SetupOpts+    Config{..} <- view configL+    (_, _, sandboxedGhc) <- ensureCompiler SetupOpts         { soptsInstallIfMissing = True         , soptsUseSystem = configSystemGHC && not scoForceReinstall         , soptsWantedCompiler = wantedCompiler@@ -104,9 +104,9 @@     let compiler = case wantedCompiler of             GhcVersion _ -> "GHC"             GhcjsVersion {} -> "GHCJS"-    case mpaths of-        Nothing -> $logInfo $ "stack will use the " <> compiler <> " on your PATH"-        Just _ -> $logInfo $ "stack will use a sandboxed " <> compiler <> " it installed"+    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"
src/Stack/Solver.hs view
@@ -27,7 +27,6 @@ import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks) import           Data.Aeson.Extended         ( WithJSONWarnings(..), object, (.=), toJSON                                              , logJSONWarnings) import qualified Data.ByteString as S@@ -241,7 +240,7 @@                -> Map PackageName Version -- ^ constraints                -> m [Text] getCabalConfig dir constraintType constraints = do-    indices <- asks $ configPackageIndices . getConfig+    indices <- view $ configL.to configPackageIndices     remotes <- mapM goIndex indices     let cache = T.pack $ "remote-repo-cache: " ++ dir     return $ cache : remotes ++ map goConstraint (Map.toList constraints)@@ -249,10 +248,15 @@     goIndex index = do         src <- configPackageIndex $ indexName index         let dstdir = dir FP.</> T.unpack (indexNameText $ indexName index)-            dst = dstdir FP.</> "00-index.tar"+            -- NOTE: see https://github.com/commercialhaskell/stack/issues/2888+            -- for why we are pretending that a 01-index.tar is actually a+            -- 00-index.tar file.+            dst0 = dstdir FP.</> "00-index.tar"+            dst1 = dstdir FP.</> "01-index.tar"         liftIO $ void $ tryIO $ do             D.createDirectoryIfMissing True dstdir-            D.copyFile (toFilePath src) dst+            D.copyFile (toFilePath src) dst0+            D.copyFile (toFilePath src) dst1         return $ T.concat             [ "remote-repo: "             , indexNameText $ indexName index@@ -283,8 +287,8 @@           , "install the compiler or '--system-ghc' to use a suitable "           , "compiler available on your PATH." ] -    config <- asks getConfig-    fst <$> ensureCompiler SetupOpts+    config <- view configL+    (dirs, _, _) <- ensureCompiler SetupOpts         { soptsInstallIfMissing  = configInstallGHC config         , soptsUseSystem         = configSystemGHC config         , soptsWantedCompiler    = compiler@@ -300,6 +304,7 @@         , soptsSetupInfoYaml    = defaultSetupInfoYaml         , soptsGHCBindistURL     = Nothing         }+    return dirs  setupCabalEnv     :: (StackM env m, HasConfig env, HasGHCVariant env)@@ -311,7 +316,7 @@     envMap <- removeHaskellEnvVars               <$> augmentPathMap (maybe [] edBins mpaths)                                  (unEnvOverride menv0)-    platform <- asks getPlatform+    platform <- view platformL     menv <- mkEnvOverride platform envMap      mcabal <- findExecutable menv "cabal"@@ -617,7 +622,7 @@     => Bool -- ^ modify stack.yaml?     -> m () solveExtraDeps modStackYaml = do-    bconfig <- asks getBuildConfig+    bconfig <- view buildConfigL      let stackYaml = bcStackYaml bconfig     relStackYaml <- prettyPath stackYaml@@ -667,7 +672,7 @@         Nothing -> throwM (SolverGiveUp giveUpMsg)         Just x -> return x -    mOldResolver <- asks (fmap (projectResolver . fst) . configMaybeProject . getConfig)+    mOldResolver <- view $ configL.to (fmap (projectResolver . fst) . configMaybeProject)      let         flags = removeSrcPkgDefaultFlags gpds (fmap snd (Map.union srcs edeps))
src/Stack/Types/Build.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE ViewPatterns               #-}  -- | Build-specific types. @@ -46,37 +45,42 @@  import           Control.DeepSeq import           Control.Exception-import           Data.Binary (Binary)-import           Data.Binary.Tagged (HasSemanticVersion, HasStructuralInfo)-import qualified Data.ByteString as S-import           Data.Char (isSpace)+import           Data.Binary                     (Binary)+import           Data.Binary.Tagged              (HasSemanticVersion,+                                                  HasStructuralInfo)+import qualified Data.ByteString                 as S+import           Data.Char                       (isSpace) import           Data.Data import           Data.Hashable import           Data.List.Extra-import qualified Data.Map as Map-import           Data.Map.Strict (Map)+import qualified Data.Map                        as Map+import           Data.Map.Strict                 (Map) import           Data.Maybe import           Data.Monoid-import           Data.Set (Set)-import qualified Data.Set as Set-import           Data.Store.Internal (Store)+import           Data.Set                        (Set)+import qualified Data.Set                        as Set+import           Data.Store.Internal             (Store) import           Data.Store.Version import           Data.Store.VersionTagged-import           Data.Text (Text)-import qualified Data.Text as T-import           Data.Text.Encoding (decodeUtf8With)-import           Data.Text.Encoding.Error (lenientDecode)+import           Data.Text                       (Text)+import qualified Data.Text                       as T+import           Data.Text.Encoding              (decodeUtf8With)+import           Data.Text.Encoding.Error        (lenientDecode) import           Data.Time.Calendar import           Data.Time.Clock+import           Data.Version                    (showVersion) import           Distribution.PackageDescription (TestSuiteInterface)-import           Distribution.System (Arch)-import qualified Distribution.Text as C-import           GHC.Generics (Generic)-import           Path (Path, Abs, File, Dir, mkRelDir, toFilePath, parseRelDir, (</>))-import           Path.Extra (toFilePathNoTrailingSep)+import           Distribution.System             (Arch)+import qualified Distribution.Text               as C+import           GHC.Generics                    (Generic)+import           Path                            (Abs, Dir, File, Path,+                                                  mkRelDir, parseRelDir,+                                                  toFilePath, (</>))+import           Path.Extra                      (toFilePathNoTrailingSep)+import           Paths_stack                     as Meta import           Prelude import           Stack.Constants-import           Stack.Types.BuildPlan (GitSHA1)+import           Stack.Types.BuildPlan           (GitSHA1) import           Stack.Types.Compiler import           Stack.Types.CompilerBuild import           Stack.Types.Config@@ -86,9 +90,9 @@ import           Stack.Types.PackageIdentifier import           Stack.Types.PackageName import           Stack.Types.Version-import           System.Exit (ExitCode (ExitFailure))-import           System.FilePath (pathSeparator)-import           System.Process.Log (showProcessArgDebug)+import           System.Exit                     (ExitCode (ExitFailure))+import           System.FilePath                 (pathSeparator)+import           System.Process.Log              (showProcessArgDebug)  ---------------------------------------------- -- Exceptions@@ -131,6 +135,7 @@   | SomeTargetsNotBuildable [(PackageName, NamedComponent)]   | TestSuiteExeMissing Bool String String String   | CabalCopyFailed Bool String+  | LocalPackagesPresent [PackageIdentifier]   deriving Typeable  data FlagSource = FSCommandLine | FSStackYaml@@ -184,7 +189,10 @@             | Set.null noKnown = []             | otherwise = return $                 "The following target packages were not found: " ++-                intercalate ", " (map packageNameString $ Set.toList noKnown)+                intercalate ", " (map packageNameString $ Set.toList noKnown) +++                "\nSee https://docs.haskellstack.org/en/v"+                <> showVersion Meta.version <>+                "/build_command/#target-syntax for details."         notInSnapshot'             | Map.null notInSnapshot = []             | otherwise =@@ -195,8 +203,8 @@                 : "but there's no guarantee that they'll build together)."                 : ""                 : map-                    (\(name, version) -> "- " ++ packageIdentifierString-                        (PackageIdentifier name version))+                    (\(name, version') -> "- " ++ packageIdentifierString+                        (PackageIdentifier name version'))                     (Map.toList notInSnapshot)     show (TestSuiteFailure ident codes mlogFile bs) = unlines $ concat         [ ["Test suite failure for package " ++ packageIdentifierString ident]@@ -331,6 +339,9 @@             , "\n"             ]     show (ConstructPlanFailed msg) = msg+    show (LocalPackagesPresent locals) = unlines+      $ "Local packages are not allowed when using the script command. Packages found:"+      : map (\ident -> "- " ++ packageIdentifierString ident) locals  missingExeError :: Bool -> String -> String missingExeError isSimpleBuildType msg =@@ -356,8 +367,8 @@     deriving (Show,Typeable,Eq,Hashable,Store,NFData)  -- | Stored on disk to know whether the files have changed.-data BuildCache = BuildCache-    { buildCacheTimes :: !(Map FilePath FileCacheInfo)+newtype BuildCache = BuildCache+    { buildCacheTimes :: Map FilePath FileCacheInfo       -- ^ Modification times of files.     }     deriving (Generic, Eq, Show, Data, Typeable)@@ -436,7 +447,7 @@     { planTasks :: !(Map PackageName Task)     , planFinals :: !(Map PackageName Task)     -- ^ Final actions to be taken (test, benchmark, etc)-    , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Maybe Text))+    , 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@@ -536,6 +547,8 @@     , 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@@ -547,12 +560,12 @@     , map (("--extra-include-dirs=" ++) . toFilePathNoTrailingSep) (Set.toList (configExtraIncludeDirs config))     , map (("--extra-lib-dirs=" ++) . toFilePathNoTrailingSep) (Set.toList (configExtraLibDirs config))     , maybe [] (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc]) (configOverrideGccPath config)-    , ["--ghcjs" | whichCompiler (envConfigCompilerVersion econfig) == Ghcjs]+    , ["--ghcjs" | wc == Ghcjs]     , ["--exact-configuration" | useExactConf]     ]   where-    wc = whichCompiler (envConfigCompilerVersion econfig)-    config = getConfig econfig+    wc = view (actualCompilerVersionL.to whichCompiler) econfig+    config = view configL econfig     bopts = bcoBuildOpts bco      -- TODO: instead always enable this when the cabal version is new@@ -560,7 +573,7 @@     -- earlier. Cabal also might do less work then.     useExactConf = configAllowNewer config -    newerCabal = envConfigCabalVersion econfig >= $(mkVersion "1.22")+    newerCabal = view cabalVersionL econfig >= $(mkVersion "1.22")      -- Unioning atop defaults is needed so that all flags are specified     -- with --exact-configuration.@@ -582,10 +595,10 @@         [ "--constraint="         , packageNameString name         , "=="-        , versionString version+        , versionString version'         ]       where-        PackageIdentifier name version = ident+        PackageIdentifier name version' = ident  -- | Get set of wanted package names from locals. wantedLocalPackages :: [LocalPackage] -> Set PackageName
src/Stack/Types/BuildPlan.hs view
@@ -30,6 +30,9 @@     , parseSnapName     , SnapshotHash (..)     , trimmedSnapshotHash+    , ModuleName (..)+    , ModuleInfo (..)+    , moduleInfoVC     ) where  import           Control.Applicative@@ -195,6 +198,7 @@     , pcBuildBenchmarks  :: Bool     , pcFlagOverrides    :: Map FlagName Bool     , pcEnableLibProfile :: Bool+    , pcHide             :: Bool     }     deriving (Show, Eq) instance ToJSON PackageConstraints where@@ -205,6 +209,7 @@         , "build-benchmarks" .= pcBuildBenchmarks         , "flags" .= pcFlagOverrides         , "library-profiling" .= pcEnableLibProfile+        , "hide" .= pcHide         ]       where         addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer@@ -218,6 +223,7 @@         pcFlagOverrides <- o .: "flags"         pcMaintainer <- o .:? "maintainer"         pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")+        pcHide <- o .:? "hide" .!= False         return PackageConstraints {..}  data TestState = ExpectSuccess@@ -428,7 +434,7 @@ instance NFData MiniBuildPlan  miniBuildPlanVC :: VersionConfig MiniBuildPlan-miniBuildPlanVC = storeVersionConfig "mbp-v1" "C8q73RrYq3plf9hDCapjWpnm_yc="+miniBuildPlanVC = storeVersionConfig "mbp-v2" "C8q73RrYq3plf9hDCapjWpnm_yc="  -- | Information on a single package for the 'MiniBuildPlan'. data MiniPackageInfo = MiniPackageInfo@@ -455,10 +461,24 @@ instance NFData MiniPackageInfo  newtype GitSHA1 = GitSHA1 ByteString-    deriving (Generic, Show, Eq, NFData, Store, Data, Typeable)+    deriving (Generic, Show, Eq, NFData, Store, Data, Typeable, Ord, Hashable)  newtype SnapshotHash = SnapshotHash { unShapshotHash :: ByteString }     deriving (Generic, Show, Eq)  trimmedSnapshotHash :: SnapshotHash -> ByteString trimmedSnapshotHash = BS.take 12 . unShapshotHash++newtype ModuleName = ModuleName { unModuleName :: ByteString }+  deriving (Show, Eq, Ord, Generic, Store, NFData, Typeable, Data)++data ModuleInfo = ModuleInfo+    { miCorePackages :: !(Set PackageName)+    , miModules      :: !(Map ModuleName (Set PackageName))+    }+  deriving (Show, Eq, Ord, Generic, Typeable, Data)+instance Store ModuleInfo+instance NFData ModuleInfo++moduleInfoVC :: VersionConfig ModuleInfo+moduleInfoVC = storeVersionConfig "mi-v1" "zyCpzzGXA8fTeBmKEWLa_6kF2_s="
src/Stack/Types/Config.hs view
@@ -2,7 +2,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -24,20 +27,17 @@   -- * Main configuration types and classes   -- ** HasPlatform & HasStackRoot    HasPlatform(..)-  ,HasStackRoot(..)   ,PlatformVariant(..)   -- ** Config & HasConfig   ,Config(..)   ,HasConfig(..)-  ,askConfig   ,askLatestSnapshotUrl   ,explicitSetupDeps   ,getMinimalEnvOverride   -- ** BuildConfig & HasBuildConfig   ,BuildConfig(..)-  ,bcRoot-  ,bcWorkDir-  ,bcWantedCompiler+  ,stackYamlL+  ,projectRootL   ,HasBuildConfig(..)   -- ** GHCVariant & HasGHCVariant   ,GHCVariant(..)@@ -51,7 +51,6 @@   -- ** EnvConfig & HasEnvConfig   ,EnvConfig(..)   ,HasEnvConfig(..)-  ,getWhichCompiler   ,getCompilerPath   -- * Details   -- ** ApplyGhcOptions@@ -72,6 +71,7 @@   -- ** GlobalOpts & GlobalOptsMonoid   ,GlobalOpts(..)   ,GlobalOptsMonoid(..)+  ,StackYamlLoc(..)   ,defaultLogLevel   -- ** LoadConfig   ,LoadConfig(..)@@ -89,7 +89,9 @@   ,IndexLocation(..)   -- Config fields   ,configPackageIndex+  ,configPackageIndexOld   ,configPackageIndexCache+  ,configPackageIndexCacheOld   ,configPackageIndexGz   ,configPackageIndexRoot   ,configPackageIndexRepo@@ -130,8 +132,9 @@   ,packageDatabaseLocal   ,platformOnlyRelDir   ,platformGhcRelDir+  ,platformGhcVerOnlyRelDir   ,useShaPathOnWindows-  ,getWorkDir+  ,workDirL   -- * Command-specific types   -- ** Eval   ,EvalOpts(..)@@ -149,6 +152,27 @@   ,DockerEntrypoint(..)   ,DockerUser(..)   ,module X+  -- * Lens helpers+  ,wantedCompilerVersionL+  ,actualCompilerVersionL+  ,buildOptsL+  ,globalOptsL+  ,buildOptsInstallExesL+  ,buildOptsMonoidHaddockL+  ,buildOptsMonoidTestsL+  ,buildOptsMonoidBenchmarksL+  ,buildOptsMonoidInstallExesL+  ,buildOptsHaddockL+  ,globalOptsBuildOptsMonoidL+  ,packageIndicesL+  ,packageCachesL+  ,stackRootL+  ,configUrlsL+  ,cabalVersionL+  ,whichCompilerL+  -- * Lens reexport+  ,view+  ,to   ) where  import           Control.Applicative@@ -157,7 +181,7 @@ import           Control.Monad (liftM, mzero, join) import           Control.Monad.Catch (MonadThrow, MonadMask) import           Control.Monad.Logger (LogLevel(..), MonadLoggerIO)-import           Control.Monad.Reader (MonadReader, ask, asks, MonadIO, liftIO)+import           Control.Monad.Reader (MonadReader, MonadIO, liftIO) import           Control.Monad.Trans.Control import           Data.Aeson.Extended                  (ToJSON, toJSON, FromJSON, parseJSON, withText, object,@@ -168,6 +192,7 @@ import           Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import           Data.Either (partitionEithers)+import           Data.HashMap.Strict (HashMap) import           Data.IORef (IORef) import           Data.List (stripPrefix) import           Data.List.NonEmpty (NonEmpty)@@ -190,13 +215,15 @@ import           Distribution.Version (anyVersion) import           GHC.Generics (Generic) import           Generics.Deriving.Monoid (memptydefault, mappenddefault)+import           Lens.Micro (Lens', lens, _1, _2, to, Getting)+import           Lens.Micro.Mtl (view) import           Network.HTTP.Client (parseRequest) import           Options.Applicative (ReadM) import qualified Options.Applicative as OA import qualified Options.Applicative.Types as OA import           Path import qualified Paths_stack as Meta-import           Stack.Types.BuildPlan (MiniBuildPlan(..), SnapName, renderSnapName)+import           Stack.Types.BuildPlan (GitSHA1, MiniBuildPlan(..), SnapName, renderSnapName) import           Stack.Types.Compiler import           Stack.Types.CompilerBuild import           Stack.Types.Docker@@ -218,8 +245,8 @@ import           Stack.Types.Config.Build as X  #ifdef mingw32_HOST_OS-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Data.ByteString.Base16 as B16+import           Crypto.Hash (hashWith, SHA1(..))+import qualified Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16)) #endif  -- | The top-level Stackage configuration.@@ -333,13 +360,17 @@          ,configAllowDifferentUser  :: !Bool          -- ^ Allow users other than the stack root owner to use the stack          -- installation.-         ,configPackageCaches       :: !(IORef (Maybe (Map PackageIdentifier (PackageIndex, PackageCache))))+         ,configPackageCaches       :: !(IORef (Maybe (Map PackageIdentifier (PackageIndex, PackageCache),+                                                       HashMap GitSHA1 (PackageIndex, OffsetSize))))          -- ^ In memory cache of hackage index.          ,configDumpLogs            :: !DumpLogs          -- ^ Dump logs of local non-dependencies when doing a build.          ,configMaybeProject        :: !(Maybe (Project, Path Abs File))          -- ^ 'Just' when a local project can be found, 'Nothing' when stack must          -- fall back on the implicit global project.+         ,configAllowLocals         :: !Bool+         -- ^ Are we allowed to build local packages? The script+         -- command disallows this.          }  -- | Which packages do ghc-options on the command line apply to?@@ -406,6 +437,7 @@     | ExecOptsEmbellished         { eoEnvSettings :: !EnvSettings         , eoPackages :: ![String]+        , eoRtsOptions :: ![String]         }     deriving (Show) @@ -426,9 +458,15 @@     , globalCompiler     :: !(Maybe CompilerVersion) -- ^ Compiler override     , globalTerminal     :: !Bool -- ^ We're in a terminal?     , globalColorWhen    :: !ColorWhen -- ^ When to use ansi terminal colors-    , globalStackYaml    :: !(Maybe FilePath) -- ^ Override project stack.yaml+    , globalStackYaml    :: !(StackYamlLoc FilePath) -- ^ Override project stack.yaml     } deriving (Show) +data StackYamlLoc filepath+    = SYLDefault+    | SYLOverride !filepath+    | SYLNoConfig+    deriving (Show,Functor,Foldable,Traversable)+ -- | Parsed global command-line options monoid. data GlobalOptsMonoid = GlobalOptsMonoid     { globalMonoidReExecVersion :: !(First String) -- ^ Expected re-exec in container version@@ -467,13 +505,17 @@ -- | 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     , bcResolver   :: !LoadedResolver       -- ^ How we resolve which dependencies to install given a set of       -- packages.     , bcWantedMiniBuildPlan :: !MiniBuildPlan-      -- ^ Compiler version wanted for this build+      -- ^ Build plan wanted for this build+    , bcGHCVariant :: !GHCVariant+      -- ^ The variant of GHC used to select a GHC bindist.     , bcPackageEntries :: ![PackageEntry]       -- ^ Local packages     , bcExtraDeps  :: !(Map PackageName Version)@@ -487,28 +529,23 @@       -- ^ Location of the stack.yaml file.       --       -- Note: if the STACK_YAML environment variable is used, this may be-      -- different from bcRoot </> "stack.yaml"+      -- different from projectRootL </> "stack.yaml"+      --+      -- FIXME MSS 2016-12-08: is the above comment still true? projectRootL+      -- is defined in terms of bcStackYaml     , bcFlags      :: !PackageFlags       -- ^ Per-package flag overrides     , bcImplicitGlobal :: !Bool       -- ^ Are we loading from the implicit global stack.yaml? This is useful       -- for providing better error messages.-    , bcGHCVariant :: !GHCVariant-      -- ^ The variant of GHC used to select a GHC bindist.     } --- | Directory containing the project's stack.yaml file-bcRoot :: BuildConfig -> Path Abs Dir-bcRoot = parent . bcStackYaml---- | @"'bcRoot'/.stack-work"@-bcWorkDir :: (MonadReader env m, HasConfig env) => BuildConfig -> m (Path Abs Dir)-bcWorkDir bconfig = do-  workDir <- getWorkDir-  return (bcRoot bconfig </> workDir)+stackYamlL :: HasBuildConfig env => Lens' env (Path Abs File)+stackYamlL = buildConfigL.lens bcStackYaml (\x y -> x { bcStackYaml = y }) -bcWantedCompiler :: BuildConfig -> CompilerVersion-bcWantedCompiler = mbpCompilerVersion . bcWantedMiniBuildPlan+-- | 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@@ -521,22 +558,14 @@     -- depends on as a library and which is displayed when running     -- @stack list-dependencies | grep Cabal@ in the stack project.     ,envConfigCompilerVersion :: !CompilerVersion+    -- ^ The actual version of the compiler to be used, as opposed to+    -- 'wantedCompilerL', which provides the version specified by the+    -- build plan.     ,envConfigCompilerBuild :: !CompilerBuild     ,envConfigPackagesRef :: !(IORef (Maybe (Map (Path Abs Dir) TreatLikeExtraDep)))     -- ^ Cache for 'getLocalPackages'.     } -instance HasBuildConfig EnvConfig where-    getBuildConfig = envConfigBuildConfig-instance HasConfig EnvConfig-instance HasPlatform EnvConfig-instance HasGHCVariant EnvConfig-instance HasStackRoot EnvConfig-class (HasBuildConfig r, HasGHCVariant r) => HasEnvConfig r where-    getEnvConfig :: r -> EnvConfig-instance HasEnvConfig EnvConfig where-    getEnvConfig = id- -- | Value returned by 'Stack.Config.loadConfig'. data LoadConfig m = LoadConfig     { lcConfig          :: !Config@@ -661,59 +690,6 @@         , "extra-package-dbs" .= projectExtraPackageDBs p         ] --- | Class for environment values which have access to the stack root-class HasStackRoot env where-    getStackRoot :: env -> Path Abs Dir-    default getStackRoot :: HasConfig env => env -> Path Abs Dir-    getStackRoot = configStackRoot . getConfig-    {-# INLINE getStackRoot #-}---- | Class for environment values which have a Platform-class HasPlatform env where-    getPlatform :: env -> Platform-    default getPlatform :: HasConfig env => env -> Platform-    getPlatform = configPlatform . getConfig-    {-# INLINE getPlatform #-}-    getPlatformVariant :: env -> PlatformVariant-    default getPlatformVariant :: HasConfig env => env -> PlatformVariant-    getPlatformVariant = configPlatformVariant . getConfig-    {-# INLINE getPlatformVariant #-}-instance HasPlatform (Platform,PlatformVariant) where-    getPlatform (p,_) = p-    getPlatformVariant (_,v) = v---- | Class for environment values which have a GHCVariant-class HasGHCVariant env where-    getGHCVariant :: env -> GHCVariant-    default getGHCVariant :: HasBuildConfig env => env -> GHCVariant-    getGHCVariant = bcGHCVariant . getBuildConfig-    {-# INLINE getGHCVariant #-}-instance HasGHCVariant GHCVariant where-    getGHCVariant = id---- | Class for environment values that can provide a 'Config'.-class (HasStackRoot env, HasPlatform env) => HasConfig env where-    getConfig :: env -> Config-    default getConfig :: HasBuildConfig env => env -> Config-    getConfig = bcConfig . getBuildConfig-    {-# INLINE getConfig #-}-instance HasStackRoot Config-instance HasPlatform Config-instance HasConfig Config where-    getConfig = id-    {-# INLINE getConfig #-}---- | Class for environment values that can provide a 'BuildConfig'.-class HasConfig env => HasBuildConfig env where-    getBuildConfig :: env -> BuildConfig-instance HasStackRoot BuildConfig-instance HasPlatform BuildConfig-instance HasGHCVariant BuildConfig-instance HasConfig BuildConfig-instance HasBuildConfig BuildConfig where-    getBuildConfig = id-    {-# INLINE getBuildConfig #-}- -- | Constraint synonym for constraints satisfied by a 'MiniConfig' -- environment. type StackMiniM r m =@@ -1029,6 +1005,8 @@   | FailedToCloneRepo String   | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC   | NixRequiresSystemGhc+  | NoResolverWhenUsingNoLocalConfig+  | InvalidResolverForNoLocalConfig String   deriving Typeable instance Show ConfigException where     show (ParseConfigFileException configFile exception) = concat@@ -1147,6 +1125,8 @@         , configMonoidSystemGHCName         , "' or disable the Nix integration."         ]+    show NoResolverWhenUsingNoLocalConfig = "When using the script command, you must provide a resolver argument"+    show (InvalidResolverForNoLocalConfig ar) = "The script command requires a specific resolver, you provided " ++ ar instance Exception ConfigException  showOptions :: WhichSolverCmd -> SuggestSolver -> String@@ -1169,33 +1149,28 @@  data SuggestSolver = SuggestSolver | Don'tSuggestSolver --- | Helper function to ask the environment and apply getConfig-askConfig :: (MonadReader env m, HasConfig env) => m Config-askConfig = liftM getConfig ask- -- | Get the URL to request the information on the latest snapshots askLatestSnapshotUrl :: (MonadReader env m, HasConfig env) => m Text-askLatestSnapshotUrl = asks (urlsLatestSnapshot . configUrls . getConfig)+askLatestSnapshotUrl = view $ configL.to configUrls.to urlsLatestSnapshot  -- | Root for a specific package index configPackageIndexRoot :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs Dir) configPackageIndexRoot (IndexName name) = do-    config <- asks getConfig+    root <- view stackRootL     dir <- parseRelDir $ S8.unpack name-    return (configStackRoot config </> $(mkRelDir "indices") </> dir)+    return (root </> $(mkRelDir "indices") </> dir)  -- | Git repo directory for a specific package index, returns 'Nothing' if not -- a Git repo configPackageIndexRepo :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Maybe (Path Abs Dir)) configPackageIndexRepo name = do-    indices <- asks $ configPackageIndices . getConfig+    indices <- view packageIndicesL     case filter (\p -> indexName p == name) indices of         [index] -> do             let murl =-                    case indexLocation index of-                        ILGit x -> Just x-                        ILHttp _ -> Nothing-                        ILGitHttp x _ -> Just x+                    case simplifyIndexLocation $ indexLocation index of+                        SILGit x -> Just x+                        SILHttp _ _ -> Nothing             case murl of                 Nothing -> return Nothing                 Just url -> do@@ -1207,17 +1182,27 @@                     return $ Just $ suDir </> repoName         _ -> assert False $ return Nothing --- | Location of the 00-index.cache file+-- | Location of the 01-index.cache file configPackageIndexCache :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File)-configPackageIndexCache = liftM (</> $(mkRelFile "00-index.cache")) . configPackageIndexRoot+configPackageIndexCache = liftM (</> $(mkRelFile "01-index.cache")) . configPackageIndexRoot --- | Location of the 00-index.tar file+-- | Location of the 00-index.cache file+configPackageIndexCacheOld :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File)+configPackageIndexCacheOld = liftM (</> $(mkRelFile "00-index.cache")) . configPackageIndexRoot++-- | Location of the 01-index.tar file configPackageIndex :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File)-configPackageIndex = liftM (</> $(mkRelFile "00-index.tar")) . configPackageIndexRoot+configPackageIndex = liftM (</> $(mkRelFile "01-index.tar")) . configPackageIndexRoot --- | Location of the 00-index.tar.gz file+-- | Location of the 00-index.tar file. This file is just a copy of+-- the 01-index.tar file, provided for tools which still look for the+-- 00-index.tar file.+configPackageIndexOld :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File)+configPackageIndexOld = liftM (</> $(mkRelFile "00-index.tar")) . configPackageIndexRoot++-- | Location of the 01-index.tar.gz file configPackageIndexGz :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File)-configPackageIndexGz = liftM (</> $(mkRelFile "00-index.tar.gz")) . configPackageIndexRoot+configPackageIndexGz = liftM (</> $(mkRelFile "01-index.tar.gz")) . configPackageIndexRoot  -- | Location of a package tarball configPackageTarball :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> PackageIdentifier -> m (Path Abs File)@@ -1229,15 +1214,15 @@     return (root </> $(mkRelDir "packages") </> name </> ver </> base)  -- | @".stack-work"@-getWorkDir :: (MonadReader env m, HasConfig env) => m (Path Rel Dir)-getWorkDir = configWorkDir `liftM` asks getConfig+workDirL :: HasConfig env => Lens' env (Path Rel Dir)+workDirL = configL.lens configWorkDir (\x y -> x { configWorkDir = y })  -- | Per-project work dir getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir) getProjectWorkDir = do-    bc      <- asks getBuildConfig-    workDir <- getWorkDir-    return (bcRoot bc </> workDir)+    root    <- view projectRootL+    workDir <- view workDirL+    return (root </> workDir)  -- | File containing the installed cache, see "Stack.PackageDump" configInstalledCache :: (HasBuildConfig env, MonadReader env m) => m (Path Abs File)@@ -1248,38 +1233,38 @@     :: (MonadReader env m, HasPlatform env, MonadThrow m)     => m (Path Rel Dir) platformOnlyRelDir = do-    platform <- asks getPlatform-    platformVariant <- asks getPlatformVariant+    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-    config <- asks getConfig+    root <- view stackRootL     platform <- platformGhcRelDir-    return $ configStackRoot config </> $(mkRelDir "snapshots") </> platform+    return $ root </> $(mkRelDir "snapshots") </> platform  -- | Installation root for dependencies installationRootDeps :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) installationRootDeps = do-    config <- asks getConfig+    root <- view stackRootL     -- TODO: also useShaPathOnWindows here, once #1173 is resolved.     psc <- platformSnapAndCompilerRel-    return $ configStackRoot config </> $(mkRelDir "snapshots") </> psc+    return $ root </> $(mkRelDir "snapshots") </> psc  -- | Installation root for locals installationRootLocal :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) installationRootLocal = do-    bc <- asks getBuildConfig+    workDir <- getProjectWorkDir     psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel-    return $ getProjectWorkDir bc </> $(mkRelDir "install") </> psc+    return $ workDir </> $(mkRelDir "install") </> psc  -- | Hoogle directory. hoogleRoot :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) hoogleRoot = do-    bc <- asks getBuildConfig+    workDir <- getProjectWorkDir     psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel-    return $ getProjectWorkDir bc </> $(mkRelDir "hoogle") </> psc+    return $ workDir </> $(mkRelDir "hoogle") </> psc  -- | Get the hoogle database path. hoogleDatabasePath :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs File)@@ -1293,9 +1278,9 @@     :: (MonadReader env m, HasEnvConfig env, MonadThrow m)     => m (Path Rel Dir) platformSnapAndCompilerRel = do-    bc <- asks getBuildConfig+    resolver' <- view loadedResolverL     platform <- platformGhcRelDir-    name <- parseRelDir $ T.unpack $ resolverDirName $ bcResolver bc+    name <- parseRelDir $ T.unpack $ resolverDirName resolver'     ghc <- compilerVersionDir     useShaPathOnWindows (platform </> name </> ghc) @@ -1304,10 +1289,10 @@     :: (MonadReader env m, HasEnvConfig env, MonadThrow m)     => m (Path Rel Dir) platformGhcRelDir = do-    envConfig <- asks getEnvConfig+    ec <- view envConfigL     verOnly <- platformGhcVerOnlyRelDirStr     parseRelDir (mconcat [ verOnly-                         , compilerBuildSuffix (envConfigCompilerBuild envConfig)])+                         , compilerBuildSuffix (envConfigCompilerBuild ec)])  -- | Relative directory for the platform and GHC identifier without GHC bindist build platformGhcVerOnlyRelDir@@ -1322,9 +1307,9 @@     :: (MonadReader env m, HasPlatform env, HasGHCVariant env)     => m FilePath platformGhcVerOnlyRelDirStr = do-    platform <- asks getPlatform-    platformVariant <- asks getPlatformVariant-    ghcVariant <- asks getGHCVariant+    platform <- view platformL+    platformVariant <- view platformVariantL+    ghcVariant <- view ghcVariantL     return $ mconcat [ Distribution.Text.display platform                      , platformVariantSuffix platformVariant                      , ghcVariantSuffix ghcVariant ]@@ -1336,14 +1321,14 @@ useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir) useShaPathOnWindows = #ifdef mingw32_HOST_OS-    parseRelDir . S8.unpack . S8.take 8 . B16.encode . SHA1.hash . encodeUtf8 . T.pack . toFilePath+    parseRelDir . S8.unpack . S8.take 8 . Mem.convertToBase Mem.Base16 . hashWith SHA1 . encodeUtf8 . T.pack . toFilePath #else     return #endif  compilerVersionDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Rel Dir) compilerVersionDir = do-    compilerVersion <- asks (envConfigCompilerVersion . getEnvConfig)+    compilerVersion <- view actualCompilerVersionL     parseRelDir $ case compilerVersion of         GhcVersion version -> versionString version         GhcjsVersion {} -> compilerVersionString compilerVersion@@ -1361,10 +1346,8 @@     return $ root </> $(mkRelDir "pkgdb")  -- | Extra package databases-packageDatabaseExtra :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m [Path Abs Dir]-packageDatabaseExtra = do-    bc <- asks getBuildConfig-    return $ bcExtraPackageDBs bc+packageDatabaseExtra :: (MonadReader env m, HasEnvConfig env) => m [Path Abs Dir]+packageDatabaseExtra = view $ buildConfigL.to bcExtraPackageDBs  -- | Directory for holding flag cache information flagCacheLocal :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir)@@ -1377,7 +1360,7 @@                          => SnapName                          -> m (Path Abs File) configMiniBuildPlanCache name = do-    root <- asks getStackRoot+    root <- view stackRootL     platform <- platformGhcVerOnlyRelDir     file <- parseRelFile $ T.unpack (renderSnapName name) ++ ".cache"     -- Yes, cached plans differ based on platform@@ -1414,8 +1397,8 @@ -- processes like git or ghc getMinimalEnvOverride :: (MonadReader env m, HasConfig env, MonadIO m) => m EnvOverride getMinimalEnvOverride = do-    config <- asks getConfig-    liftIO $ configEnvOverride config minimalEnvSettings+    config' <- view configL+    liftIO $ configEnvOverride config' minimalEnvSettings  minimalEnvSettings :: EnvSettings minimalEnvSettings =@@ -1426,9 +1409,6 @@     , esLocaleUtf8 = False     } -getWhichCompiler :: (MonadReader env m, HasEnvConfig env) => m WhichCompiler-getWhichCompiler = asks (whichCompiler . envConfigCompilerVersion . getEnvConfig)- -- | Get the path for the given compiler ignoring any local binaries. -- -- https://github.com/commercialhaskell/stack/issues/1052@@ -1437,9 +1417,9 @@     => WhichCompiler     -> m (Path Abs File) getCompilerPath wc = do-    config <- asks getConfig+    config' <- view configL     eoWithoutLocals <- liftIO $-        configEnvOverride config minimalEnvSettings { esLocaleUtf8 = True }+        configEnvOverride config' minimalEnvSettings { esLocaleUtf8 = True }     join (findExecutable eoWithoutLocals (compilerExeName wc))  data ProjectAndConfigMonoid@@ -1700,7 +1680,7 @@ -- | Provide an explicit list of package dependencies when running a custom Setup.hs explicitSetupDeps :: (MonadReader env m, HasConfig env) => PackageName -> m Bool explicitSetupDeps name = do-    m <- asks $ configExplicitSetupDeps . getConfig+    m <- view $ configL.to configExplicitSetupDeps     return $         -- Yes there are far cleverer ways to write this. I honestly consider         -- the explicit pattern matching much easier to parse at a glance.@@ -1712,8 +1692,8 @@                     Nothing -> False -- default value  -- | Data passed into Docker container for the Docker entrypoint's use-data DockerEntrypoint = DockerEntrypoint-    { deUser :: !(Maybe DockerUser)+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) @@ -1800,3 +1780,171 @@     mempty = PackageFlags mempty     mappend (PackageFlags l) (PackageFlags r) =         PackageFlags (Map.unionWith Map.union l r)++-----------------------------------+-- 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 :: Lens' env GHCVariant+    default ghcVariantL :: HasBuildConfig env => Lens' env GHCVariant+    ghcVariantL = buildConfigL.ghcVariantL+    {-# INLINE ghcVariantL #-}++-- | Class for environment values that can provide a 'Config'.+class HasPlatform 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, HasGHCVariant 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 BuildConfig where+    ghcVariantL = lens bcGHCVariant (\x y -> x { bcGHCVariant = y })+instance HasGHCVariant EnvConfig++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 HasEnvConfig EnvConfig where+    envConfigL = id+    {-# INLINE envConfigL #-}++-----------------------------------+-- Helper lenses+-----------------------------------++stackRootL :: HasConfig s => Lens' s (Path Abs Dir)+stackRootL = configL.lens configStackRoot (\x y -> x { configStackRoot = y })++-- | The compiler specified by the @MiniBuildPlan@. This may be+-- different from the actual compiler used!+wantedCompilerVersionL :: HasBuildConfig s => Lens' s CompilerVersion+wantedCompilerVersionL = miniBuildPlanL.lens+    mbpCompilerVersion+    (\x y -> x { mbpCompilerVersion = y })++-- | The version of the compiler which will actually be used. May be+-- different than that specified in the 'MiniBuildPlan' and returned+-- by 'wantedCompilerVersionL'.+actualCompilerVersionL :: HasEnvConfig s => Lens' s CompilerVersion+actualCompilerVersionL = envConfigL.lens+    envConfigCompilerVersion+    (\x y -> x { envConfigCompilerVersion = y })++loadedResolverL :: HasBuildConfig s => Lens' s LoadedResolver+loadedResolverL = buildConfigL.lens+    bcResolver+    (\x y -> x { bcResolver = y })++miniBuildPlanL :: HasBuildConfig s => Lens' s MiniBuildPlan+miniBuildPlanL = buildConfigL.lens+    bcWantedMiniBuildPlan+    (\x y -> x { bcWantedMiniBuildPlan = y })++packageIndicesL :: HasConfig s => Lens' s [PackageIndex]+packageIndicesL = configL.lens+    configPackageIndices+    (\x y -> x { configPackageIndices = y })++buildOptsL :: HasConfig s => Lens' s BuildOpts+buildOptsL = configL.lens+    configBuild+    (\x y -> x { configBuild = y })++buildOptsMonoidHaddockL :: Lens' BuildOptsMonoid (Maybe Bool)+buildOptsMonoidHaddockL = lens (getFirst . buildMonoidHaddock)+                            (\buildMonoid t -> buildMonoid {buildMonoidHaddock = First t})++buildOptsMonoidTestsL :: Lens' BuildOptsMonoid (Maybe Bool)+buildOptsMonoidTestsL = lens (getFirst . buildMonoidTests)+                            (\buildMonoid t -> buildMonoid {buildMonoidTests = First t})++buildOptsMonoidBenchmarksL :: Lens' BuildOptsMonoid (Maybe Bool)+buildOptsMonoidBenchmarksL = lens (getFirst . buildMonoidBenchmarks)+                            (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = First t})++buildOptsMonoidInstallExesL :: Lens' BuildOptsMonoid (Maybe Bool)+buildOptsMonoidInstallExesL =+  lens (getFirst . buildMonoidInstallExes)+       (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = First 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})++globalOptsL :: Lens' GlobalOpts ConfigMonoid+globalOptsL = lens globalConfigMonoid (\x y -> x { globalConfigMonoid = y })++globalOptsBuildOptsMonoidL :: Lens' GlobalOpts BuildOptsMonoid+globalOptsBuildOptsMonoidL = globalOptsL.lens+    configMonoidBuildOpts+    (\x y -> x { configMonoidBuildOpts = y })++packageCachesL :: HasConfig env => Lens' env+    (IORef (Maybe (Map PackageIdentifier (PackageIndex, PackageCache)+                  ,HashMap GitSHA1 (PackageIndex, OffsetSize))))+packageCachesL = configL.lens configPackageCaches (\x y -> x { configPackageCaches = y })++configUrlsL :: HasConfig env => Lens' env Urls+configUrlsL = configL.lens configUrls (\x y -> x { configUrls = y })++cabalVersionL :: HasEnvConfig env => Lens' env Version+cabalVersionL = envConfigL.lens+    envConfigCabalVersion+    (\x y -> x { envConfigCabalVersion = y })++whichCompilerL :: Getting r CompilerVersion WhichCompiler+whichCompilerL = to whichCompiler
src/Stack/Types/Config.hs-boot view
@@ -32,4 +32,6 @@   | FailedToCloneRepo String   | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC   | NixRequiresSystemGhc+  | NoResolverWhenUsingNoLocalConfig+  | InvalidResolverForNoLocalConfig String instance Exception ConfigException
src/Stack/Types/Config/Build.hs view
@@ -44,6 +44,8 @@ data BuildOpts =   BuildOpts {boptsLibProfile :: !Bool             ,boptsExeProfile :: !Bool+            ,boptsLibStrip :: !Bool+            ,boptsExeStrip :: !Bool             ,boptsHaddock :: !Bool             -- ^ Build haddocks?             ,boptsHaddockOpts :: !HaddockOpts@@ -88,6 +90,8 @@ defaultBuildOpts = BuildOpts     { boptsLibProfile = False     , boptsExeProfile = False+    , boptsLibStrip = True+    , boptsExeStrip = True     , boptsHaddock = False     , boptsHaddockOpts = defaultHaddockOpts     , boptsOpenHaddocks = False@@ -147,6 +151,8 @@ data BuildOptsMonoid = BuildOptsMonoid     { buildMonoidLibProfile :: !(First Bool)     , buildMonoidExeProfile :: !(First Bool)+    , buildMonoidLibStrip :: !(First Bool)+    , buildMonoidExeStrip :: !(First Bool)     , buildMonoidHaddock :: !(First Bool)     , buildMonoidHaddockOpts :: !HaddockOptsMonoid     , buildMonoidOpenHaddocks :: !(First Bool)@@ -169,6 +175,8 @@   parseJSON = withObjectWarnings "BuildOptsMonoid"     (\o -> do buildMonoidLibProfile <- First <$> o ..:? buildMonoidLibProfileArgName               buildMonoidExeProfile <-First <$>  o ..:? buildMonoidExeProfileArgName+              buildMonoidLibStrip <- First <$> o ..:? buildMonoidLibStripArgName+              buildMonoidExeStrip <-First <$>  o ..:? buildMonoidExeStripArgName               buildMonoidHaddock <- First <$> o ..:? buildMonoidHaddockArgName               buildMonoidHaddockOpts <- jsonSubWarnings (o ..:? buildMonoidHaddockOptsArgName ..!= mempty)               buildMonoidOpenHaddocks <- First <$> o ..:? buildMonoidOpenHaddocksArgName@@ -193,6 +201,12 @@ buildMonoidExeProfileArgName :: Text buildMonoidExeProfileArgName = "executable-profiling" +buildMonoidLibStripArgName :: Text+buildMonoidLibStripArgName = "library-stripping"++buildMonoidExeStripArgName :: Text+buildMonoidExeStripArgName = "executable-stripping"+ buildMonoidHaddockArgName :: Text buildMonoidHaddockArgName = "haddock" @@ -305,12 +319,12 @@   -- | Haddock Options-data HaddockOpts =-  HaddockOpts { hoAdditionalArgs :: ![String] -- ^ Arguments passed to haddock program+newtype HaddockOpts =+  HaddockOpts { hoAdditionalArgs :: [String] -- ^ Arguments passed to haddock program               } deriving (Eq,Show) -data HaddockOptsMonoid =-  HaddockOptsMonoid {hoMonoidAdditionalArgs :: ![String]+newtype HaddockOptsMonoid =+  HaddockOptsMonoid {hoMonoidAdditionalArgs :: [String]                     } deriving (Show, Generic)  defaultHaddockOpts :: HaddockOpts
src/Stack/Types/FlagName.hs view
@@ -40,7 +40,7 @@ import           Language.Haskell.TH.Syntax  -- | A parse fail.-data FlagNameParseFail+newtype FlagNameParseFail   = FlagNameParseFail Text   deriving (Typeable) instance Exception FlagNameParseFail
src/Stack/Types/GhcPkgId.hs view
@@ -26,7 +26,7 @@ import           Prelude -- Fix AMP warning  -- | A parse fail.-data GhcPkgIdParseFail+newtype GhcPkgIdParseFail   = GhcPkgIdParseFail Text   deriving Typeable instance Show GhcPkgIdParseFail where
src/Stack/Types/Image.hs view
@@ -18,8 +18,8 @@ import Prelude -- Fix redundant import warnings  -- | Image options. Currently only Docker image options.-data ImageOpts = ImageOpts-    { imgDockers :: ![ImageDockerOpts]+newtype ImageOpts = ImageOpts+    { imgDockers :: [ImageDockerOpts]       -- ^ One or more stanzas for docker image settings.     } deriving (Show) @@ -39,8 +39,8 @@       -- ^ Filenames of executables to add (if Nothing, add them all)     } deriving (Show) -data ImageOptsMonoid = ImageOptsMonoid-    { imgMonoidDockers :: ![ImageDockerOpts]+newtype ImageOptsMonoid = ImageOptsMonoid+    { imgMonoidDockers :: [ImageDockerOpts]     } deriving (Show, Generic)  instance FromJSON (WithJSONWarnings ImageOptsMonoid) where
src/Stack/Types/Internal.hs view
@@ -2,11 +2,19 @@  -- | Internal types to the library. -module Stack.Types.Internal where+module Stack.Types.Internal+    ( Env (..)+    , HasTerminal (..)+    , HasReExec (..)+    , Sticky (..)+    , HasSticky (..)+    , LogOptions (..)+    , HasLogOptions (..)+    , view+    ) where  import Control.Concurrent.MVar import Control.Monad.Logger (LogLevel)-import Data.Monoid.Extra import Data.Text (Text) import Lens.Micro import Stack.Types.Config@@ -20,41 +28,42 @@       ,envSticky :: !Sticky       } -instance HasStackRoot config => HasStackRoot (Env config) where-    getStackRoot = getStackRoot . envConfig+envConfL :: Lens (Env a) (Env b) a b+envConfL = lens envConfig (\x y -> x { envConfig = y })+ instance HasPlatform config => HasPlatform (Env config) where-    getPlatform = getPlatform . envConfig-    getPlatformVariant = getPlatformVariant . envConfig+    platformL = envConfL.platformL+    platformVariantL = envConfL.platformVariantL instance HasGHCVariant config => HasGHCVariant (Env config) where-    getGHCVariant = getGHCVariant . envConfig+    ghcVariantL = envConfL.ghcVariantL instance HasConfig config => HasConfig (Env config) where-    getConfig = getConfig . envConfig+    configL = envConfL.configL instance HasBuildConfig config => HasBuildConfig (Env config) where-    getBuildConfig = getBuildConfig . envConfig+    buildConfigL = envConfL.buildConfigL instance HasEnvConfig config => HasEnvConfig (Env config) where-    getEnvConfig = getEnvConfig . envConfig+    envConfigL = envConfL.envConfigL -class HasTerminal r where-  getTerminal :: r -> Bool+class HasTerminal env where+  terminalL :: Lens' env Bool  instance HasTerminal (Env config) where-  getTerminal = envTerminal+  terminalL = lens envTerminal (\x y -> x { envTerminal = y }) -class HasReExec r where-  getReExec :: r -> Bool+class HasReExec env where+  reExecL :: Lens' env Bool  instance HasReExec (Env config) where-  getReExec = envReExec+  reExecL = lens envReExec (\x y -> x { envReExec = y })  newtype Sticky = Sticky   { unSticky :: Maybe (MVar (Maybe Text))   } -class HasSticky r where-  getSticky :: r -> Sticky+class HasSticky env where+  stickyL :: Lens' env Sticky  instance HasSticky (Env config) where-  getSticky = envSticky+  stickyL = lens envSticky (\x y -> x { envSticky = y })  data LogOptions = LogOptions   { logUseColor :: Bool@@ -64,63 +73,8 @@   , logVerboseFormat :: Bool   } -class HasLogOptions r where-  getLogOptions :: r -> LogOptions+class HasLogOptions env where+  logOptionsL :: Lens' env LogOptions  instance HasLogOptions (Env config) where-  getLogOptions = envLogOptions--envEnvConfig :: Lens' (Env EnvConfig) EnvConfig-envEnvConfig = lens envConfig-                    (\s t -> s {envConfig = t})--buildOptsMonoidHaddock :: Lens' BuildOptsMonoid (Maybe Bool)-buildOptsMonoidHaddock = lens (getFirst . buildMonoidHaddock)-                            (\buildMonoid t -> buildMonoid {buildMonoidHaddock = First t})--buildOptsMonoidTests :: Lens' BuildOptsMonoid (Maybe Bool)-buildOptsMonoidTests = lens (getFirst . buildMonoidTests)-                            (\buildMonoid t -> buildMonoid {buildMonoidTests = First t})--buildOptsMonoidBenchmarks :: Lens' BuildOptsMonoid (Maybe Bool)-buildOptsMonoidBenchmarks = lens (getFirst . buildMonoidBenchmarks)-                            (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = First t})--buildOptsMonoidInstallExes :: Lens' BuildOptsMonoid (Maybe Bool)-buildOptsMonoidInstallExes =-  lens (getFirst . buildMonoidInstallExes)-       (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = First t})--buildOptsInstallExes :: Lens' BuildOpts Bool-buildOptsInstallExes =-  lens boptsInstallExes-       (\bopts t -> bopts {boptsInstallExes = t})--buildOptsHaddock :: Lens' BuildOpts Bool-buildOptsHaddock =-  lens boptsHaddock-       (\bopts t -> bopts {boptsHaddock = t})--envConfigBuildOpts :: Lens' EnvConfig BuildOpts-envConfigBuildOpts =-    lens-        (configBuild . bcConfig . envConfigBuildConfig)-        (\envCfg bopts ->-              envCfg-              { envConfigBuildConfig = (envConfigBuildConfig envCfg)-                { bcConfig = (bcConfig (envConfigBuildConfig envCfg))-                  { configBuild = bopts-                  }-                }-              })--globalOptsBuildOptsMonoid :: Lens' GlobalOpts BuildOptsMonoid-globalOptsBuildOptsMonoid =-    lens-        (configMonoidBuildOpts . globalConfigMonoid)-        (\globalOpts boptsMonoid ->-              globalOpts-              { globalConfigMonoid = (globalConfigMonoid globalOpts)-                { configMonoidBuildOpts = boptsMonoid-                }-              })+  logOptionsL = lens envLogOptions (\x y -> x { envLogOptions = y })
src/Stack/Types/Package.hs view
@@ -102,6 +102,8 @@           ,packageOpts :: !GetPackageOpts                 -- ^ Args to pass to GHC.           ,packageHasExposedModules :: !Bool              -- ^ Does the package have exposed modules?           ,packageSimpleType :: !Bool                     -- ^ Does the package of build-type: Simple+          ,packageSetupDeps :: !(Maybe (Map PackageName VersionRange))+                                                          -- ^ If present: custom-setup dependencies           }  deriving (Show,Typeable)
src/Stack/Types/PackageDump.hs view
@@ -27,9 +27,10 @@ data InstalledCacheEntry = InstalledCacheEntry     { installedCacheProfiling :: !Bool     , installedCacheHaddock :: !Bool+    , installedCacheSymbols :: !Bool     , installedCacheIdent :: !PackageIdentifier }     deriving (Eq, Generic, Show, Data, Typeable) instance Store InstalledCacheEntry  installedCacheVC :: VersionConfig InstalledCacheInner-installedCacheVC = storeVersionConfig "installed-v1" "5yL7Ngpy4YKWDDCTUI6zAJ9UySI="+installedCacheVC = storeVersionConfig "installed-v1" "GGyaE6qY9FOqeWtozuadKqS7_QM="
src/Stack/Types/PackageIdentifier.hs view
@@ -13,7 +13,8 @@   , parsePackageIdentifierFromString   , packageIdentifierParser   , packageIdentifierString-  , packageIdentifierText )+  , packageIdentifierText+  , toCabalPackageIdentifier )   where  import           Control.Applicative@@ -27,13 +28,14 @@ import           Data.Store (Store) import           Data.Text (Text) import qualified Data.Text as T+import qualified Distribution.Package as C import           GHC.Generics import           Prelude hiding (FilePath) import           Stack.Types.PackageName import           Stack.Types.Version  -- | A parse fail.-data PackageIdentifierParseFail+newtype PackageIdentifierParseFail   = PackageIdentifierParseFail Text   deriving (Typeable) instance Show PackageIdentifierParseFail where@@ -101,3 +103,9 @@ -- | Get a Text representation of the package identifier; name-ver. packageIdentifierText :: PackageIdentifier -> Text packageIdentifierText = T.pack .  packageIdentifierString++toCabalPackageIdentifier :: PackageIdentifier -> C.PackageIdentifier+toCabalPackageIdentifier x =+    C.PackageIdentifier+        (toCabalPackageName (packageIdentifierName x))+        (toCabalVersion (packageIdentifierVersion x))
src/Stack/Types/PackageIndex.hs view
@@ -8,21 +8,29 @@  module Stack.Types.PackageIndex     ( PackageDownload (..)+    , HSPackageDownload (..)     , PackageCache (..)     , PackageCacheMap (..)+    , OffsetSize (..)     -- ** PackageIndex, IndexName & IndexLocation     , PackageIndex(..)     , IndexName(..)     , indexNameText     , IndexLocation(..)+    , SimplifiedIndexLocation (..)+    , simplifyIndexLocation+    , HttpType (..)+    , HackageSecurity (..)     ) where  import           Control.DeepSeq (NFData) import           Control.Monad (mzero) import           Data.Aeson.Extended import           Data.ByteString (ByteString)+import qualified Data.Foldable as F import           Data.Hashable (Hashable) import           Data.Data (Data, Typeable)+import           Data.HashMap.Strict (HashMap) import           Data.Int (Int64) import           Data.Map (Map) import qualified Data.Map.Strict as Map@@ -33,13 +41,11 @@ import           Data.Word (Word64) import           GHC.Generics (Generic) import           Path+import           Stack.Types.BuildPlan (GitSHA1) import           Stack.Types.PackageIdentifier  data PackageCache = PackageCache-    { pcOffset :: !Int64-    -- ^ offset in bytes into the 00-index.tar file for the .cabal file contents-    , pcSize :: !Int64-    -- ^ size in bytes of the .cabal file+    { pcOffsetSize :: {-# UNPACK #-}!OffsetSize     , pcDownload :: !(Maybe PackageDownload)     }     deriving (Generic, Eq, Show, Data, Typeable)@@ -47,11 +53,26 @@ instance Store PackageCache instance NFData PackageCache -newtype PackageCacheMap = PackageCacheMap (Map PackageIdentifier PackageCache)-    deriving (Generic, Store, NFData, Eq, Show, Data, Typeable)+-- | offset in bytes into the 01-index.tar file for the .cabal file+-- contents, and size in bytes of the .cabal file+data OffsetSize = OffsetSize !Int64 !Int64+    deriving (Generic, Eq, Show, Data, Typeable) +instance Store OffsetSize+instance NFData OffsetSize++data PackageCacheMap = PackageCacheMap+    { pcmIdent :: !(Map PackageIdentifier PackageCache)+    -- ^ most recent revision of the package+    , pcmSHA :: !(HashMap GitSHA1 OffsetSize)+    -- ^ lookup via the GitSHA1 of the cabal file contents+    }+    deriving (Generic, Eq, Show, Data, Typeable)+instance Store PackageCacheMap+instance NFData PackageCacheMap+ data PackageDownload = PackageDownload-    { pdSHA512 :: !ByteString+    { pdSHA256 :: !ByteString     , pdUrl    :: !ByteString     , pdSize   :: !Word64     }@@ -59,9 +80,9 @@ instance Store PackageDownload instance NFData PackageDownload instance FromJSON PackageDownload where-    parseJSON = withObject "Package" $ \o -> do+    parseJSON = withObject "PackageDownload" $ \o -> do         hashes <- o .: "package-hashes"-        sha512 <- maybe mzero return (Map.lookup ("SHA512" :: Text) hashes)+        sha256 <- maybe mzero return (Map.lookup ("SHA256" :: Text) hashes)         locs <- o .: "package-locations"         url <-             case reverse locs of@@ -69,11 +90,28 @@                 x:_ -> return x         size <- o .: "package-size"         return PackageDownload-            { pdSHA512 = encodeUtf8 sha512+            { pdSHA256 = encodeUtf8 sha256             , pdUrl = encodeUtf8 url             , pdSize = size             } +-- | Hackage Security provides a different JSON format, we'll have our+-- own JSON parser for it.+newtype HSPackageDownload = HSPackageDownload { unHSPackageDownload :: PackageDownload }+instance FromJSON HSPackageDownload where+    parseJSON = withObject "HSPackageDownload" $ \o1 -> do+        o2 <- o1 .: "signed"+        Object o3 <- o2 .: "targets"+        Object o4:_ <- return $ F.toList o3+        len <- o4 .: "length"+        hashes <- o4 .: "hashes"+        sha256 <- hashes .: "sha256"+        return $ HSPackageDownload PackageDownload+            { pdSHA256 = encodeUtf8 sha256+            , pdSize = len+            , pdUrl = ""+            }+ -- | Unique name for a package index newtype IndexName = IndexName { unIndexName :: ByteString }     deriving (Show, Eq, Ord, Hashable, Store)@@ -88,12 +126,37 @@             Left e -> fail $ "Invalid index name: " ++ show e             Right _ -> return $ IndexName $ encodeUtf8 t +data HttpType = HTHackageSecurity !HackageSecurity | HTVanilla+    deriving (Show, Eq, Ord)++data HackageSecurity = HackageSecurity+    { hsKeyIds :: ![Text]+    , hsKeyThreshold :: !Int+    }+    deriving (Show, Eq, Ord)+instance FromJSON HackageSecurity where+    parseJSON = withObject "HackageSecurity" $ \o -> HackageSecurity+        <$> o .: "keyids"+        <*> o .: "key-threshold"+ -- | Location of the package index. This ensures that at least one of Git or -- HTTP is available.-data IndexLocation = ILGit !Text | ILHttp !Text | ILGitHttp !Text !Text+data IndexLocation+    = ILGit !Text+    | ILHttp !Text !HttpType+    | ILGitHttp !Text !Text !HttpType     deriving (Show, Eq, Ord) +-- | Simplified 'IndexLocation', which will either be a Git repo or HTTP URL.+data SimplifiedIndexLocation = SILGit !Text | SILHttp !Text !HttpType+    deriving (Show, Eq, Ord) +simplifyIndexLocation :: IndexLocation -> SimplifiedIndexLocation+simplifyIndexLocation (ILGit t) = SILGit t+simplifyIndexLocation (ILHttp t ht) = SILHttp t ht+-- Prefer HTTP over Git+simplifyIndexLocation (ILGitHttp _ t ht) = SILHttp t ht+ -- | Information on a single package index data PackageIndex = PackageIndex     { indexName :: !IndexName@@ -113,14 +176,16 @@         prefix <- o ..: "download-prefix"         mgit <- o ..:? "git"         mhttp <- o ..:? "http"+        mhackageSecurity <- o ..:? "hackage-security"+        let httpType = maybe HTVanilla HTHackageSecurity mhackageSecurity         loc <-             case (mgit, mhttp) of                 (Nothing, Nothing) -> fail $                     "Must provide either Git or HTTP URL for " ++                     T.unpack (indexNameText name)                 (Just git, Nothing) -> return $ ILGit git-                (Nothing, Just http) -> return $ ILHttp http-                (Just git, Just http) -> return $ ILGitHttp git http+                (Nothing, Just http) -> return $ ILHttp http httpType+                (Just git, Just http) -> return $ ILGitHttp git http httpType         gpgVerify <- o ..:? "gpg-verify" ..!= False         reqHashes <- o ..:? "require-hashes" ..!= False         return PackageIndex
src/Stack/Types/StackT.hs view
@@ -138,10 +138,10 @@ runInnerStackT :: (HasEnv r, MonadReader r m, MonadIO m)                => config -> StackT config IO a -> m a runInnerStackT config inner = do-    reExec <- asks getReExec-    logOptions <- asks getLogOptions-    terminal <- asks getTerminal-    sticky <- asks getSticky+    reExec <- view reExecL+    logOptions <- view logOptionsL+    terminal <- view terminalL+    sticky <- view stickyL     liftIO $ runReaderT (unStackT inner) Env         { envConfig = config         , envReExec = reExec@@ -163,8 +163,8 @@     :: (HasEnv r, ToLogStr msg, MonadReader r m)     => m (Loc -> LogSource -> LogLevel -> msg -> IO ()) getStickyLoggerFunc = do-    sticky <- asks getSticky-    lo <- asks getLogOptions+    sticky <- view stickyL+    lo <- view logOptionsL     return $ stickyLoggerFuncImpl sticky lo  stickyLoggerFuncImpl@@ -184,8 +184,7 @@                      LevelOther "sticky" -> LevelInfo                      _ -> level)                 msg-        Just ref -> do-            sticky <- takeMVar ref+        Just ref -> modifyMVar_ ref $ \sticky -> do             let backSpaceChar = '\8'                 repeating = S8.replicate (maybe 0 T.length sticky)                 clear = S8.hPutStr out@@ -198,31 +197,29 @@                     | logUseUnicode lo = msgTextRaw                     | otherwise = T.map replaceUnicode msgTextRaw -            newState <--                case level of-                    LevelOther "sticky-done" -> do-                        clear-                        T.hPutStrLn out msgText-                        hFlush out-                        return Nothing-                    LevelOther "sticky" -> do+            case level of+                LevelOther "sticky-done" -> do+                    clear+                    T.hPutStrLn out msgText+                    hFlush out+                    return Nothing+                LevelOther "sticky" -> do+                    clear+                    T.hPutStr out msgText+                    hFlush out+                    return (Just msgText)+                _+                    | level >= logMinLevel lo -> do                         clear-                        T.hPutStr out msgText-                        hFlush out-                        return (Just msgText)-                    _-                      | level >= logMinLevel lo -> do-                          clear-                          loggerFunc lo out loc src level $ toLogStr msgText-                          case sticky of-                              Nothing ->-                                  return Nothing-                              Just line -> do-                                  T.hPutStr out line >> hFlush out-                                  return sticky-                      | otherwise ->-                          return sticky-            putMVar ref newState+                        loggerFunc lo out loc src level $ toLogStr msgText+                        case sticky of+                            Nothing ->+                                return Nothing+                            Just line -> do+                                T.hPutStr out line >> hFlush out+                                return sticky+                    | otherwise ->+                        return sticky   where     out = stderr     msgTextRaw = T.decodeUtf8With T.lenientDecode msgBytes
src/Stack/Types/Version.hs view
@@ -57,7 +57,7 @@ import           Text.PrettyPrint (render)  -- | A parse fail.-data VersionParseFail =+newtype VersionParseFail =   VersionParseFail Text   deriving (Typeable) instance Exception VersionParseFail
src/Stack/Upgrade.hs view
@@ -34,7 +34,6 @@ import           Stack.Types.PackageName import           Stack.Types.Version import           Stack.Types.Config-import           Stack.Types.Internal import           Stack.Types.Resolver import           Stack.Types.StackT import           System.Exit                 (ExitCode (ExitSuccess))@@ -89,8 +88,8 @@     , _boGithubRepo :: !(Maybe String)     }     deriving Show-data SourceOpts = SourceOpts-    { _soRepo :: !(Maybe String)+newtype SourceOpts = SourceOpts+    { _soRepo :: Maybe String     }     deriving Show @@ -114,6 +113,8 @@         (Nothing, Nothing) -> error "You must allow either binary or source upgrade paths"         (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             $logWarn "Exception occured when trying to perform binary upgrade:"             $logWarn $ T.pack $ show e@@ -167,7 +168,7 @@             $logInfo "Newer version detected, downloading"             return True     when toUpgrade $ do-        config <- askConfig+        config <- view configL         downloadStackExe platforms0 archiveInfo (configLocalBin config) $ \tmpFile -> do             -- Sanity check!             ec <- rawSystem (toFilePath tmpFile) ["--version"]@@ -209,7 +210,7 @@                 return $ Just $ tmp </> $(mkRelDir "stack")       Nothing -> do         updateAllIndices menv-        caches <- getPackageCaches+        (caches, _gitShaCaches) <- getPackageCaches         let latest = Map.fromListWith max                    $ map toTuple                    $ Map.keys@@ -238,12 +239,12 @@         lc <- loadConfig             gConfigMonoid             mresolver-            (Just $ dir </> $(mkRelFile "stack.yaml"))+            (SYLOverride $ dir </> $(mkRelFile "stack.yaml"))         bconfig <- lcLoadBuildConfig lc Nothing         envConfig1 <- runInnerStackT bconfig $ setupEnv $ Just $             "Try rerunning with --install-ghc to install the correct GHC into " <>-            T.pack (toFilePath (configLocalPrograms (getConfig bconfig)))-        runInnerStackT (set (envConfigBuildOpts.buildOptsInstallExes) True envConfig1) $+            T.pack (toFilePath (configLocalPrograms (view configL bconfig)))+        runInnerStackT (set (buildOptsL.buildOptsInstallExesL) True envConfig1) $             build (const $ return ()) Nothing defaultBuildOptsCLI                 { boptsCLITargets = ["stack"]                 }
src/Stack/Upload.hs view
@@ -248,8 +248,8 @@ -- Typically, you want to use this with 'upload'. -- -- Since 0.1.0.0-data Uploader = Uploader-    { upload_ :: !(String -> L.ByteString -> IO ())+newtype Uploader = Uploader+    { upload_ :: String -> L.ByteString -> IO ()     }  -- | Upload a single tarball with the given @Uploader@.
src/System/Process/Read.hs view
@@ -423,7 +423,7 @@           mkEnvOverride platform         . Map.fromList . map (T.pack *** T.pack) -data PathException = PathsInvalidInPath [FilePath]+newtype PathException = PathsInvalidInPath [FilePath]     deriving Typeable  instance Exception PathException
src/main/Main.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -18,7 +19,7 @@ import           Control.Monad hiding (mapM, forM) import           Control.Monad.IO.Class import           Control.Monad.Logger-import           Control.Monad.Reader (asks, local)+import           Control.Monad.Reader (local) import           Control.Monad.Trans.Either (EitherT) import           Control.Monad.Writer.Lazy (Writer) import           Data.Attoparsec.Args (parseArgs, EscapingMode (Escaping))@@ -54,6 +55,7 @@ import qualified Paths_stack as Meta import           Prelude hiding (pi, mapM) import           Stack.Build+import           Stack.BuildPlan import           Stack.Clean (CleanOpts, clean) import           Stack.Config import           Stack.ConfigCmd as ConfigCmd@@ -82,11 +84,13 @@ import           Stack.Options.HpcReportParser import           Stack.Options.NewParser import           Stack.Options.NixParser+import           Stack.Options.ScriptParser import           Stack.Options.SolverParser import           Stack.Options.Utils import qualified Stack.PackageIndex import qualified Stack.Path import           Stack.Runners+import           Stack.Script import           Stack.SDist (getSDistTarball, checkSDistTarball, checkSDistTarball') import           Stack.SetupCmd import qualified Stack.Sig as Sig@@ -94,7 +98,8 @@ import           Stack.Types.Version import           Stack.Types.Config import           Stack.Types.Compiler-import           Stack.Types.Internal+import           Stack.Types.Resolver+import           Stack.Types.Nix import           Stack.Types.StackT import           Stack.Upgrade import qualified Stack.Upload as Upload@@ -319,13 +324,14 @@                     execCmd                     (execOptsParser $ Just ExecGhc)         addCommand' "hoogle"-                    "Run hoogle in the context of the current Stack config"+                    ("Run hoogle, the Haskell API search engine. Use 'stack exec' syntax " +++                     "to pass Hoogle arguments, e.g. stack hoogle -- --count=20")                     hoogleCmd                     ((,,) <$> many (strArgument (metavar "ARG"))                           <*> boolFlags                                   True                                   "setup"-                                  "If needed: Install hoogle, build haddocks, generate a hoogle database"+                                  "If needed: install hoogle, build haddocks and generate a hoogle database"                                   idm                           <*> switch                                   (long "rebuild" <>@@ -353,6 +359,10 @@                   "Run runghc (alias for 'runghc')"                   execCmd                   (execOptsParser $ Just ExecRunGhc)+      addCommand' "script"+                  "Run a Stack Script"+                  scriptCmd+                  scriptOptsParser        unless isInterpreter (do         addCommand' "eval"@@ -465,7 +475,8 @@         extraHelpOption hide progName (Docker.dockerCmdName ++ "*") Docker.dockerHelpOptName <*>         extraHelpOption hide progName (Nix.nixCmdName ++ "*") Nix.nixHelpOptName <*>         globalOptsParser kind (if isInterpreter-                                then Just $ LevelOther "silent"+                                -- Silent except when errors occur - see #2879+                                then Just LevelError                                 else Nothing)         where hide = kind /= OuterGlobalOpts @@ -563,6 +574,8 @@ setupCmd :: SetupCmdOpts -> GlobalOpts -> IO () setupCmd sco@SetupCmdOpts{..} go@GlobalOpts{..} = do   lc <- loadConfigWithOpts go+  when (scoUpgradeCabal && nixEnable (configNix (lcConfig lc))) $ do+    throwIO UpgradeCabalUnusable   withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> do     let getCompilerVersion = loadCompilerVersion go lc     runStackTGlobal (lcConfig lc) go $@@ -577,11 +590,11 @@                       Just v -> return (v, MatchMinor, Nothing)                       Nothing -> do                           bc <- lcLoadBuildConfig lc globalCompiler-                          return ( bcWantedCompiler bc+                          return ( view wantedCompilerVersionL bc                                  , configCompilerCheck (lcConfig lc)-                                 , Just $ bcStackYaml bc+                                 , Just $ view stackYamlL bc                                  )-              miniConfig <- loadMiniConfig (lcConfig lc)+              let miniConfig = loadMiniConfig (lcConfig lc)               runStackTGlobal miniConfig go $                   setup sco wantedCompiler compilerCheck mstack               )@@ -608,10 +621,10 @@         Stack.Build.build setLocalFiles lk opts     -- Read the build command from the CLI and enable it to run     go' = case boptsCLICommand opts of-               Test -> set (globalOptsBuildOptsMonoid.buildOptsMonoidTests) (Just True) go-               Haddock -> set (globalOptsBuildOptsMonoid.buildOptsMonoidHaddock) (Just True) go-               Bench -> set (globalOptsBuildOptsMonoid.buildOptsMonoidBenchmarks) (Just True) go-               Install -> set (globalOptsBuildOptsMonoid.buildOptsMonoidInstallExes) (Just True) go+               Test -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True) go+               Haddock -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidHaddockL) (Just True) go+               Bench -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True) go+               Install -> set (globalOptsBuildOptsMonoidL.buildOptsMonoidInstallExesL) (Just True) go                Build -> go -- Default case is just Build  uninstallCmd :: [String] -> GlobalOpts -> IO ()@@ -624,7 +637,19 @@ unpackCmd :: [String] -> GlobalOpts -> IO () unpackCmd names go = withConfigAndLock go $ do     menv <- getMinimalEnvOverride-    Stack.Fetch.unpackPackages menv "." names+    mMiniBuildPlan <-+        case globalResolver go of+            Nothing -> return Nothing+            Just ar -> fmap Just $ do+                r <- makeConcreteResolver ar+                case r of+                    ResolverSnapshot snapName -> do+                        config <- view configL+                        let miniConfig = loadMiniConfig config+                        runInnerStackT miniConfig (loadMiniBuildPlan snapName)+                    ResolverCompiler _ -> error "unpack does not work with compiler resolvers"+                    ResolverCustom _ _ -> error "unpack does not work with custom resolvers"+    Stack.Fetch.unpackPackages menv mMiniBuildPlan "." names  -- | Update the package index updateCmd :: () -> GlobalOpts -> IO ()@@ -658,7 +683,7 @@         show invalid     let getUploader :: (HasConfig config) => StackT config IO Upload.Uploader         getUploader = do-            config <- asks getConfig+            config <- view configL             liftIO $ Upload.mkUploader config Upload.defaultUploadSettings     withBuildConfigAndLock go $ \_ -> do         uploader <- getUploader@@ -714,9 +739,9 @@     case eoExtra of         ExecOptsPlain -> do             (cmd, args) <- case (eoCmd, eoArgs) of-                 (ExecCmd cmd, args) -> return (cmd, args)-                 (ExecGhc, args) -> return ("ghc", args)-                 (ExecRunGhc, args) -> return ("runghc", args)+                (ExecCmd cmd, args) -> return (cmd, args)+                (ExecGhc, args) -> return ("ghc", args)+                (ExecRunGhc, args) -> return ("runghc", args)             lc <- liftIO $ loadConfigWithOpts go             withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> do               let getCompilerVersion = loadCompilerVersion go lc@@ -726,7 +751,7 @@                     -- Unlock before transferring control away, whether using docker or not:                     (Just $ munlockFile lk)                     (runStackTGlobal (lcConfig lc) go $ do-                        config <- asks getConfig+                        config <- view configL                         menv <- liftIO $ configEnvOverride config plainEnvSettings                         Nix.reexecWithOptionalShell                             (lcProjectRoot lc)@@ -736,24 +761,28 @@                     Nothing                     Nothing -- Unlocked already above.         ExecOptsEmbellished {..} ->-           withBuildConfigAndLock go $ \lk -> do-               let targets = concatMap words eoPackages-               unless (null targets) $-                   Stack.Build.build (const $ return ()) lk defaultBuildOptsCLI-                       { boptsCLITargets = map T.pack targets-                       }+            withBuildConfigAndLock go $ \lk -> do+                let targets = concatMap words eoPackages+                unless (null targets) $+                    Stack.Build.build (const $ return ()) lk defaultBuildOptsCLI+                        { boptsCLITargets = map T.pack targets+                        } -               config <- asks getConfig-               menv <- liftIO $ configEnvOverride config eoEnvSettings-               (cmd, args) <- case (eoCmd, eoArgs) of-                   (ExecCmd cmd, args) -> return (cmd, args)-                   (ExecGhc, args) -> getGhcCmd "" menv eoPackages args+                config <- view configL+                menv <- liftIO $ configEnvOverride config eoEnvSettings+                -- 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) -> return (cmd, args)+                    (ExecGhc, args) -> getGhcCmd "" menv eoPackages args                     -- NOTE: this won't currently work for GHCJS, because it doesn't have                     -- a runghcjs binary. It probably will someday, though.-                   (ExecRunGhc, args) ->-                       getGhcCmd "run" menv eoPackages args-               munlockFile lk -- Unlock before transferring control away.-               exec menv cmd args+                    (ExecRunGhc, args) ->+                        getGhcCmd "run" menv eoPackages args+                munlockFile lk -- Unlock before transferring control away.+                exec menv cmd args   where       -- return the package-id of the first package in GHC_PACKAGE_PATH       getPkgId menv wc name = do@@ -768,9 +797,10 @@           return $ map ("-package-id=" ++) ids        getGhcCmd prefix menv pkgs args = do-          wc <- getWhichCompiler+          wc <- view $ actualCompilerVersionL.whichCompilerL           pkgopts <- getPkgOpts menv wc pkgs           return (prefix ++ compilerExeName wc, pkgopts ++ args)+      -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO ()@@ -787,13 +817,13 @@ ghciCmd ghciOpts go@GlobalOpts{..} =   withBuildConfigAndLock go $ \lk -> do     munlockFile lk -- Don't hold the lock while in the GHCI.-    bopts <- asks (configBuild . getConfig)+    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 (envEnvConfig.envConfigBuildOpts) boptsLocal)+    local (set buildOptsL boptsLocal)           (ghci ghciOpts)  -- | List packages in the project.@@ -838,7 +868,7 @@ cfgSetCmd co go@GlobalOpts{..} =     withMiniConfigAndLock         go-        (cfgCmdSet co)+        (cfgCmdSet go co)  imgDockerCmd :: (Bool, [Text]) -> GlobalOpts -> IO () imgDockerCmd (rebuild,images) go@GlobalOpts{..} = do@@ -892,8 +922,8 @@ withBuildConfigDot opts go f = withBuildConfig go' f   where     go' =-        (if dotTestTargets opts then set (globalOptsBuildOptsMonoid.buildOptsMonoidTests) (Just True) else id) $-        (if dotBenchTargets opts then set (globalOptsBuildOptsMonoid.buildOptsMonoidBenchmarks) (Just True) else id)+        (if dotTestTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True) else id) $+        (if dotBenchTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True) else id)         go  -- | Query build information@@ -905,6 +935,7 @@ hpcReportCmd hropts go = withBuildConfig go $ generateHpcReportForTargets hropts  data MainException = InvalidReExecVersion String String+                   | UpgradeCabalUnusable      deriving (Typeable) instance Exception MainException instance Show MainException where@@ -915,3 +946,4 @@         , expected         , "; found: "         , actual]+    show UpgradeCabalUnusable = "--upgrade-cabal cannot be used when nix is activated"
src/test/Network/HTTP/Download/VerifiedSpec.hs view
@@ -1,15 +1,11 @@-{-# LANGUAGE RecordWildCards #-} module Network.HTTP.Download.VerifiedSpec where  import           Control.Applicative-import           Control.Monad.IO.Class         (MonadIO)-import           Control.Monad.Logger           (LoggingT, runStdoutLoggingT)-import           Control.Monad.Trans.Reader+import           Control.Monad.Logger           (runStdoutLoggingT) import           Control.Retry                  (limitRetries) import           Crypto.Hash import           Data.Maybe import           Network.HTTP.Client.Conduit-import           Network.HTTP.Client.TLS        (getGlobalManager) import           Network.HTTP.Download.Verified import           Path import           Path.IO@@ -65,76 +61,61 @@ isWrongDigest WrongDigest{} = True isWrongDigest _ = False -data T = T-  { manager :: Manager-  }--runWith :: MonadIO m => Manager -> ReaderT Manager (LoggingT m) r -> m r-runWith manager = runStdoutLoggingT . flip runReaderT manager--setup :: IO T-setup = do-  manager <- getGlobalManager-  return T{..}--teardown :: T -> IO ()-teardown _ = return ()- spec :: Spec-spec = beforeAll setup $ afterAll teardown $ do+spec = do   let exampleProgressHook _ = return ()    describe "verifiedDownload" $ do     -- Preconditions:     -- * the exampleReq server is running     -- * the test runner has working internet access to it-    it "downloads the file correctly" $ \T{..} -> withTempDir' $ \dir -> do+    it "downloads the file correctly" $ withTempDir' $ \dir -> do       examplePath <- getExamplePath dir       doesFileExist examplePath `shouldReturn` False-      let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook+      let go = runStdoutLoggingT $ verifiedDownload exampleReq examplePath exampleProgressHook       go `shouldReturn` True       doesFileExist examplePath `shouldReturn` True -    it "is idempotent, and doesn't redownload unnecessarily" $ \T{..} -> withTempDir' $ \dir -> do+    it "is idempotent, and doesn't redownload unnecessarily" $ withTempDir' $ \dir -> do       examplePath <- getExamplePath dir       doesFileExist examplePath `shouldReturn` False-      let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook+      let go = runStdoutLoggingT $ verifiedDownload exampleReq examplePath exampleProgressHook       go `shouldReturn` True       doesFileExist examplePath `shouldReturn` True       go `shouldReturn` False       doesFileExist examplePath `shouldReturn` True      -- https://github.com/commercialhaskell/stack/issues/372-    it "does redownload when the destination file is wrong" $ \T{..} -> withTempDir' $ \dir -> do+    it "does redownload when the destination file is wrong" $ withTempDir' $ \dir -> do       examplePath <- getExamplePath dir       let exampleFilePath = toFilePath examplePath       writeFile exampleFilePath exampleWrongContent       doesFileExist examplePath `shouldReturn` True       readFile exampleFilePath `shouldReturn` exampleWrongContent-      let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook+      let go = runStdoutLoggingT $ verifiedDownload exampleReq examplePath exampleProgressHook       go `shouldReturn` True       doesFileExist examplePath `shouldReturn` True       readFile exampleFilePath `shouldNotReturn` exampleWrongContent -    it "rejects incorrect content length" $ \T{..} -> withTempDir' $ \dir -> do+    it "rejects incorrect content length" $ withTempDir' $ \dir -> do       examplePath <- getExamplePath dir       let wrongContentLengthReq = exampleReq             { drLengthCheck = Just exampleWrongContentLength             }-      let go = runWith manager $ verifiedDownload wrongContentLengthReq examplePath exampleProgressHook+      let go = runStdoutLoggingT $ verifiedDownload wrongContentLengthReq examplePath exampleProgressHook       go `shouldThrow` isWrongContentLength       doesFileExist examplePath `shouldReturn` False -    it "rejects incorrect digest" $ \T{..} -> withTempDir' $ \dir -> do+    it "rejects incorrect digest" $ withTempDir' $ \dir -> do       examplePath <- getExamplePath dir       let wrongHashCheck = exampleHashCheck { hashCheckHexDigest = exampleWrongDigest }       let wrongDigestReq = exampleReq { drHashChecks = [wrongHashCheck] }-      let go = runWith manager $ verifiedDownload wrongDigestReq examplePath exampleProgressHook+      let go = runStdoutLoggingT $ verifiedDownload wrongDigestReq examplePath exampleProgressHook       go `shouldThrow` isWrongDigest       doesFileExist examplePath `shouldReturn` False      -- https://github.com/commercialhaskell/stack/issues/240-    it "can download hackage tarballs" $ \T{..} -> withTempDir' $ \dir -> do+    it "can download hackage tarballs" $ withTempDir' $ \dir -> do       dest <- (dir </>) <$> parseRelFile "acme-missiles-0.3.tar.gz"       let req = parseRequest_ "http://hackage.haskell.org/package/acme-missiles-0.3/acme-missiles-0.3.tar.gz"       let dReq = DownloadRequest@@ -143,7 +124,7 @@             , drLengthCheck = Nothing             , drRetryPolicy = limitRetries 1             }-      let go = runWith manager $ verifiedDownload dReq dest exampleProgressHook+      let go = runStdoutLoggingT $ verifiedDownload dReq dest exampleProgressHook       doesFileExist dest `shouldReturn` False       go `shouldReturn` True       doesFileExist dest `shouldReturn` True
src/test/Stack/BuildPlanSpec.hs view
@@ -33,7 +33,7 @@ spec :: Spec spec = beforeAll setup $ do     let logLevel = LevelDebug-    let loadConfig' = runStackT () logLevel True False ColorAuto False (loadConfig mempty Nothing Nothing)+    let loadConfig' = runStackT () logLevel True False ColorAuto False (loadConfig mempty Nothing SYLDefault)     let loadBuildConfigRest = runStackT () logLevel True False ColorAuto False     let inTempDir action = do             currentDirectory <- getCurrentDirectory
src/test/Stack/ConfigSpec.hs view
@@ -80,7 +80,7 @@         bracket_ setVar resetVar action    describe "loadConfig" $ do-    let loadConfig' = runStackT () logLevel True False ColorAuto False (loadConfig mempty Nothing Nothing)+    let loadConfig' = runStackT () logLevel True False ColorAuto False (loadConfig mempty Nothing SYLDefault)     let loadBuildConfigRest = runStackT () logLevel True False ColorAuto False     -- TODO(danburton): make sure parent dirs also don't have config file     it "works even if no config file exists" $ example $ do@@ -121,9 +121,8 @@       createDirectory childDir       setCurrentDirectory childDir       LoadConfig{..} <- loadConfig'-      bc@BuildConfig{..} <- loadBuildConfigRest-                            (lcLoadBuildConfig Nothing)-      bcRoot bc `shouldBe` parentDir+      bc <- loadBuildConfigRest (lcLoadBuildConfig Nothing)+      view projectRootL bc `shouldBe` parentDir      it "respects the STACK_YAML env variable" $ inTempDir $ do       withSystemTempDir "config-is-here" $ \dir -> do
src/test/Stack/GhciSpec.hs view
@@ -221,6 +221,7 @@       , packageOpts = GetPackageOpts undefined       , packageHasExposedModules = True       , packageSimpleType = True+      , packageSetupDeps = Nothing       }     }   ]@@ -255,6 +256,7 @@       , packageOpts = GetPackageOpts undefined       , packageHasExposedModules = True       , packageSimpleType = True+      , packageSetupDeps = Nothing       }     }   , GhciPkgInfo@@ -285,6 +287,7 @@       , packageOpts = GetPackageOpts undefined       , packageHasExposedModules = True       , packageSimpleType = True+      , packageSetupDeps = Nothing       }     }   ]
src/test/Stack/NixSpec.hs view
@@ -5,13 +5,16 @@  import Control.Exception import Control.Monad.Logger+import Data.Maybe import Data.Monoid+import Options.Applicative import Path import Prelude -- to remove the warning about Data.Monoid being redundant on GHC 7.10 import Stack.Config+import Stack.Options.NixParser import Stack.Config.Nix-import Stack.Types.Config import Stack.Types.Compiler+import Stack.Types.Config import Stack.Types.Nix import Stack.Types.StackT import Stack.Types.Version@@ -20,8 +23,8 @@ import System.IO.Temp (withSystemTempDirectory) import Test.Hspec -sampleConfig :: String-sampleConfig =+sampleConfigNixEnabled :: String+sampleConfigNixEnabled =   "resolver: lts-2.10\n" ++   "packages: ['.']\n" ++   "system-ghc: true\n" ++@@ -29,6 +32,13 @@   "   enable: True\n" ++   "   packages: [glpk]" +sampleConfigNixDisabled :: String+sampleConfigNixDisabled =+  "resolver: lts-2.10\n" +++  "packages: ['.']\n" +++  "nix:\n" +++  "   enable: False"+ stackDotYaml :: Path Rel File stackDotYaml = $(mkRelFile "stack.yaml") @@ -37,22 +47,61 @@  spec :: Spec spec = beforeAll setup $ do-  let loadConfig' = runStackT () LevelDebug True False ColorAuto False (loadConfig mempty Nothing Nothing)-      inTempDir action = do+  let loadConfig' cmdLineArgs = runStackT () LevelDebug True False ColorAuto False (loadConfig cmdLineArgs Nothing SYLDefault)+      inTempDir test = do         currentDirectory <- getCurrentDirectory         withSystemTempDirectory "Stack_ConfigSpec" $ \tempDir -> do           let enterDir = setCurrentDirectory tempDir               exitDir = setCurrentDirectory currentDirectory-          bracket_ enterDir exitDir action-  describe "nix" $ do-    it "sees that the nix shell is enabled" $ inTempDir $ do-      writeFile (toFilePath stackDotYaml) sampleConfig-      lc <- loadConfig'-      nixEnable (configNix $ lcConfig lc) `shouldBe` True-    it "sees that the only package asked for is glpk and asks for the correct GHC derivation" $-      inTempDir $ do-        writeFile (toFilePath stackDotYaml) sampleConfig-        lc <- loadConfig'+          bracket_ enterDir exitDir test+      withStackDotYaml config test = inTempDir $ do+        writeFile (toFilePath stackDotYaml) config+        test+      parseNixOpts cmdLineOpts = fromJust $ getParseResult $ execParserPure+        defaultPrefs+        (info (nixOptsParser False) mempty)+        cmdLineOpts+      parseOpts cmdLineOpts = mempty { configMonoidNixOpts = parseNixOpts cmdLineOpts }+  describe "nix disabled in config file" $+    around_ (withStackDotYaml sampleConfigNixDisabled) $ do+      it "sees that the nix shell is not enabled" $ do+        lc <- loadConfig' mempty+        nixEnable (configNix $ lcConfig lc) `shouldBe` False+      describe "--nix given on command line" $+        it "sees that the nix shell is enabled" $ do+          lc <- loadConfig' (parseOpts ["--nix"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` True+      describe "--nix-pure given on command line" $+        it "sees that the nix shell is enabled" $ do+          lc <- loadConfig' (parseOpts ["--nix-pure"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` True+      describe "--no-nix given on command line" $+        it "sees that the nix shell is not enabled" $ do+          lc <- loadConfig' (parseOpts ["--no-nix"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` False+      describe "--no-nix-pure given on command line" $+        it "sees that the nix shell is not enabled" $ do+          lc <- loadConfig' (parseOpts ["--no-nix-pure"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` False+  describe "nix enabled in config file" $+    around_ (withStackDotYaml sampleConfigNixEnabled) $ do+      it "sees that the nix shell is enabled" $ do+        lc <- loadConfig' mempty+        nixEnable (configNix $ lcConfig lc) `shouldBe` True+      describe "--no-nix given on command line" $+        it "sees that the nix shell is not enabled" $ do+          lc <- loadConfig' (parseOpts ["--no-nix"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` False+      describe "--nix-pure given on command line" $+        it "sees that the nix shell is enabled" $ do+          lc <- loadConfig' (parseOpts ["--nix-pure"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` True+      describe "--no-nix-pure given on command line" $+        it "sees that the nix shell is enabled" $ do+          lc <- loadConfig' (parseOpts ["--no-nix-pure"])+          nixEnable (configNix $ lcConfig lc) `shouldBe` True+      it "sees that the only package asked for is glpk and asks for the correct GHC derivation" $ do+        lc <- loadConfig' mempty         nixPackages (configNix $ lcConfig lc) `shouldBe` ["glpk"]         v <- parseVersion "7.10.3"         nixCompiler (GhcVersion v) `shouldBe` "haskell.compiler.ghc7103"
src/test/Stack/PackageDumpSpec.hs view
@@ -91,6 +91,7 @@                 , dpHaddockHtml = Just "/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0"                 , dpProfiling = ()                 , dpHaddock = ()+                , dpSymbols = ()                 , dpIsExposed = False                 } @@ -129,6 +130,7 @@                 , dpHasExposedModules = True                 , dpProfiling = ()                 , dpHaddock = ()+                , dpSymbols = ()                 , dpIsExposed = False                 }         it "ghc 7.8.4 (osx)" $ do@@ -164,6 +166,7 @@                 , dpHasExposedModules = True                 , dpProfiling = ()                 , dpHaddock = ()+                , dpSymbols = ()                 , dpIsExposed = True                 }         it "ghc HEAD" $ do@@ -193,6 +196,7 @@             , dpHasExposedModules = True             , dpProfiling = ()             , dpHaddock = ()+            , dpSymbols = ()             , dpIsExposed = True             } @@ -205,6 +209,7 @@             $  conduitDumpPackage             =$ addProfiling icache             =$ addHaddock icache+            =$ fakeAddSymbols             =$ CL.sinkNull      it "sinkMatching" $ do@@ -215,7 +220,8 @@             $  conduitDumpPackage             =$ addProfiling icache             =$ addHaddock icache-            =$ sinkMatching False False (Map.singleton $(mkPackageName "transformers") $(mkVersion "0.0.0.0.0.0.1"))+            =$ fakeAddSymbols+            =$ sinkMatching False False False (Map.singleton $(mkPackageName "transformers") $(mkVersion "0.0.0.0.0.0.1"))         case Map.lookup $(mkPackageName "base") m of             Nothing -> error "base not present"             Just _ -> return ()@@ -262,3 +268,7 @@         case Map.lookup ident depMap of             Nothing -> error "checkDepsPresent: missing in depMap"             Just deps -> Set.null $ Set.difference (Set.fromList deps) allIds++-- addSymbols can't be reasonably tested like this+fakeAddSymbols :: Monad m => Conduit (DumpPackage a b c) m (DumpPackage a b Bool)+fakeAddSymbols = CL.map (\dp -> dp { dpSymbols = False })
src/test/Stack/StoreSpec.hs view
@@ -10,6 +10,8 @@ import           Control.Applicative import qualified Data.ByteString as BS import           Data.Containers (mapFromList, setFromList)+import           Data.Hashable (Hashable)+import           Data.HashMap.Strict (HashMap) import           Data.Int import           Data.Map (Map) import           Data.Sequences (fromList)@@ -32,6 +34,9 @@ -- smallcheck.  instance (Monad m, Serial m k, Serial m a, Ord k) => Serial m (Map k a) where+    series = fmap mapFromList series++instance (Monad m, Serial m k, Serial m a, Eq k, Hashable k) => Serial m (HashMap k a) where     series = fmap mapFromList series  instance Monad m => Serial m Text where
stack.cabal view
@@ -1,5 +1,5 @@ name: stack-version: 1.3.2+version: 1.4.0 cabal-version: >=1.10 build-type: Custom license: BSD3@@ -136,6 +136,7 @@         Stack.Options.NixParser         Stack.Options.PackageParser         Stack.Options.ResolverParser+        Stack.Options.ScriptParser         Stack.Options.SolverParser         Stack.Options.TestParser         Stack.Options.Utils@@ -145,6 +146,7 @@         Stack.Path         Stack.PrettyPrint         Stack.Runners+        Stack.Script         Stack.SDist         Stack.Setup         Stack.Setup.Installed@@ -184,27 +186,25 @@         System.Process.Read         System.Process.Run     build-depends:-        Cabal >=1.18.1.5 && <1.25,-        aeson ==1.0.*,+        Cabal ==1.24.*,+        aeson >=1.0 && <1.2,         ansi-terminal >=0.6.2.3 && <0.7,         async >=2.0.2 && <2.2,         attoparsec >=0.12.1.5 && <0.14,-        base >=4.7 && <5,+        base >=4.8 && <5,         base-compat >=0.6 && <0.10,-        base16-bytestring >=0.1.1.6 && <0.2,         base64-bytestring >=1.0.0.1 && <1.1,         binary >=0.7 && <0.9,         binary-tagged >=0.1.1 && <0.2,         blaze-builder >=0.4.0.2 && <0.5,-        byteable >=0.1.1 && <0.2,         bytestring >=0.10.4.0 && <0.11,         clock >=0.7.2 && <0.8,         conduit >=1.2.8 && <1.3,-        conduit-extra >=1.1.7.1 && <1.2,+        conduit-extra >=1.1.14 && <1.2,         containers >=0.5.5.1 && <0.6,-        cryptohash >=0.11.6 && <0.12,-        cryptohash-conduit >=0.1.1 && <0.2,-        directory >=1.2.1.0 && <1.3,+        cryptonite ==0.19.*,+        cryptonite-conduit ==0.1.*,+        directory >=1.2.1.0 && <1.4,         either >=4.4.1.1 && <4.5,         errors >=2.1.2 && <2.2,         exceptions >=0.8.0.2 && <0.9,@@ -214,20 +214,24 @@         filepath >=1.3.0.2 && <1.5,         fsnotify >=0.2.1 && <0.3,         generic-deriving >=1.10.5 && <1.12,+        hackage-security >=0.5.2.2 && <0.6,         hashable >=1.2.3.2 && <1.3,         hit >=0.6.3 && <0.7,         hpc >=0.6.0.2 && <0.7,         http-client >=0.5.3.3 && <0.6,-        http-client-tls >=0.3.3 && <0.4,+        http-client-tls >=0.3.4 && <0.4,         http-conduit >=2.2.3 && <2.3,         http-types >=0.8.6 && <0.10,         lifted-async >=0.9.0 && <0.10,         lifted-base >=0.2.3.8 && <0.3,+        memory ==0.13.*,         microlens >=0.3.0.0 && <0.5,+        microlens-mtl >=0.1.10.0 && <0.2,         monad-control >=1.0.1.0 && <1.1,         monad-logger >=0.3.13.1 && <0.4,         monad-unlift >=0.2.0 && <0.3,         mtl >=2.1.3.1 && <2.3,+        network-uri >=2.6.1.0 && <2.7,         open-browser >=0.2.1 && <0.3,         optparse-applicative ==0.13.*,         path >=0.5.8 && <0.6,@@ -256,10 +260,10 @@         tls >=1.3.8 && <1.4,         transformers >=0.3.0.0 && <0.6,         transformers-base >=0.4.4 && <0.5,-        unicode-transforms >=0.1 && <0.3,+        unicode-transforms >=0.1 && <0.4,         unix-compat >=0.4.1.4 && <0.5,         unordered-containers >=0.2.5.1 && <0.3,-        vector >=0.10.12.3 && <0.12,+        vector >=0.10.12.3 && <0.13,         vector-binary-instances >=0.2.3.2 && <0.3,         yaml >=0.8.20 && <0.9,         zlib >=0.5.4.2 && <0.7,@@ -267,12 +271,14 @@         hastache >=0.6.1 && <0.7,         project-template ==0.2.*,         zip-archive >=0.2.3.7 && <0.4,-        hpack >=0.14.0 && <0.16,+        hpack >=0.17.0 && <0.18,         store >=0.2.1.0 && <0.4,         annotated-wl-pprint >=0.7.0 && <0.8,         file-embed >=0.0.10 && <0.1     default-language: Haskell2010     hs-source-dirs: src/+    other-modules:+        Hackage.Security.Client.Repository.HttpLib.HttpClient     ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-identities  executable stack@@ -298,12 +304,13 @@         Cabal >=1.18.1.5 && <1.25,         base >=4.7 && <5,         bytestring >=0.10.4.0 && <0.11,+        conduit >=1.2.8 && <1.3,         containers >=0.5.5.1 && <0.6,-        directory >=1.2.1.0 && <1.3,+        directory >=1.2.1.0 && <1.4,         either >=4.4.1.1 && <4.5,         filelock >=0.1.0.1 && <0.2,         filepath >=1.3.0.2 && <1.5,-        hpack >=0.14.0 && <0.16,+        hpack >=0.17.0 && <0.18,         http-client >=0.5.3.3 && <0.6,         lifted-base >=0.2.3.8 && <0.3,         microlens >=0.3.0.0 && <0.5,@@ -311,9 +318,10 @@         monad-logger >=0.3.13.1 && <0.4,         mtl >=2.1.3.1 && <2.3,         optparse-applicative ==0.13.*,-        path >=0.5.9 && <0.6,+        path >=0.5.8 && <0.6,         path-io >=1.1.0 && <2.0.0,-        stack >=1.3.2 && <1.4,+        split >=0.2.3.1 && <0.3,+        stack >=1.4.0 && <1.5,         text >=1.2.0.4 && <1.3,         transformers >=0.3.0.0 && <0.6     default-language: Haskell2010@@ -336,29 +344,32 @@         conduit >=1.2.8 && <1.3,         conduit-extra >=1.1.14 && <1.2,         containers >=0.5.5.1 && <0.6,-        cryptohash >=0.11.9 && <0.12,-        directory >=1.2.1.0 && <1.3,+        cryptonite ==0.19.*,+        directory >=1.2.1.0 && <1.4,         exceptions >=0.8.3 && <0.9,         filepath >=1.4.0.0 && <1.5,-        hspec >=2.2 && <2.4,-        http-client-tls >=0.3.3 && <0.4,+        hspec >=2.2 && <2.5,+        hashable >=1.2.4.0 && <1.3,+        http-client-tls >=0.3.4 && <0.4,         http-conduit >=2.2.3 && <2.3,         monad-logger >=0.3.20.1 && <0.4,         neat-interpolation ==0.3.*,-        path >=0.5.7 && <0.6,+        optparse-applicative ==0.13.*,+        path >=0.5.8 && <0.6,         path-io >=1.1.0 && <2.0.0,         resourcet >=1.1.8.1 && <1.2,         retry >=0.6 && <0.8,-        stack >=1.3.2 && <1.4,+        stack >=1.4.0 && <1.5,         temporary >=1.2.0.4 && <1.3,         text >=1.2.2.1 && <1.3,         transformers >=0.3.0.0 && <0.6,-        mono-traversable >=0.10.2 && <0.11,+        mono-traversable >=0.10.2 && <1.1,         th-reify-many >=0.1.6 && <0.2,         smallcheck >=1.1.1 && <1.2,         bytestring >=0.10.6.0 && <0.11,         store >=0.2.1.0 && <0.4,-        vector >=0.11.0.0 && <0.12,+        vector >=0.10.12.3 && <0.13,+        unordered-containers >=0.2.7.1 && <0.3,         template-haskell >=2.10.0.0 && <2.11,         yaml >=0.8.20 && <0.9     default-language: Haskell2010@@ -394,9 +405,9 @@         conduit >=1.2.8 && <1.3,         conduit-extra >=1.1.14 && <1.2,         containers >=0.5.5.1 && <0.6,-        directory >=1.2.1.0 && <1.3,+        directory >=1.2.1.0 && <1.4,         filepath >=1.3.0.2 && <1.5,-        hspec >=2.2 && <2.4,+        hspec >=2.2 && <2.5,         process >=1.2.0.0 && <1.5,         resourcet >=1.1.8.1 && <1.2,         temporary >=1.2.0.4 && <1.3,
stack.yaml view
@@ -12,21 +12,25 @@   packages:     - zlib extra-deps:+- Cabal-1.24.2.0 - th-utilities-0.2.0.1 - store-0.3 - store-core-0.3 - th-orphans-0.13.1 - http-client-0.5.3.3-- http-client-tls-0.3.3+- http-client-tls-0.3.4 - http-conduit-2.2.3 - optparse-applicative-0.13.0.0 - text-metrics-0.1.0 - pid1-0.1.0.0 - aeson-1.0.2.1-- hpack-0.15.0+- hpack-0.17.0 - persistent-2.6 - persistent-template-2.5.1.6 - persistent-sqlite-2.6+- cryptohash-sha256-0.11.100.1+- ed25519-0.0.5.0+- hackage-security-0.5.2.2 flags:   stack:     hide-dependency-versions: true