diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,157 @@ # Changelog +## v1.9.1 + +Release notes: + +* Statically linked Linux bindists are back again, thanks to [@nh2](https://github.com/nh2). +* We will be deleting the Ubuntu, Debian, CentOS, Fedora, and Arch package repos from `download.fpcomplete.com` soon. These have been deprecated for over a year and have not received new releases, but were left in place for compatibility with older scripts. + +Major changes: + +* Upgrade to Cabal 2.4 + * Note that, in this process, the behavior of file globbing has + been modified to match that of Cabal. In particular, this means + that for Cabal spec versions less than 2.4, `*.txt` will + match `foo.txt`, but not `foo.2.txt`. +* `GHCJS` support is being downgraded to 'experimental'. A warning notifying the user of the experimental status of `GHCJS` will be displayed. + +Behavior changes: + +* `ghc-options` from `stack.yaml` are now appended to `ghc-options` from + `config.yaml`, whereas before they would be replaced. +* `stack build` will now announce when sublibraries of a package are being + build, in the same way executables, tests, benchmarks and libraries are + announced +* `stack sdist` will now announce the destination of the generated tarball, + regardless of whether or not it passed the sanity checks +* The `--upgrade-cabal` option to `stack setup` has been + deprecated. This feature no longer works with GHC 8.2 and + later. Furthermore, the reason for this flag originally being + implemented was drastically lessened once Stack started using the + snapshot's `Cabal` library for custom setups. See: + [#4070](https://github.com/commercialhaskell/stack/issues/4070). +* With the new namespaced template feature, `stack templates` is no + longer able to meaningfully display a list of all templates + available. Instead, the command will download and display a + [help file](https://github.com/commercialhaskell/stack-templates/blob/master/STACK_HELP.md) + with more information on how to discover templates. See: + [#4039](https://github.com/commercialhaskell/stack/issues/4039) +* Build tools are now handled in a similar way to `cabal-install`. In + particular, for legacy `build-tools` fields, we use a hard-coded + list of build tools in place of looking up build tool packages in a + tool map. This both brings Stack's behavior closer into line with + `cabal-install`, avoids some bugs, and opens up some possible + optimizations/laziness. See: + [#4125](https://github.com/commercialhaskell/stack/issues/4125). +* Mustache templating is not applied to large files (over 50kb) to + avoid performance degredation. See: + [#4133](https://github.com/commercialhaskell/stack/issues/4133). +* `stack upload` signs the package by default, as documented. `--no-signature` + turns the signing off. + [#3739](https://github.com/commercialhaskell/stack/issues/3739) +* In case there is a network connectivity issue while trying to + download a template, stack will check whether that template had + been downloaded before. In that case, the cached version will be + used. See [#3850](https://github.com/commercialhaskell/stack/issues/3739). + +Other enhancements: + +* On Windows before Windows 10, --color=never is the default on terminals that + can support ANSI color codes in output only by emulation +* On Windows, recognise a 'mintty' (false) terminal as a terminal, by default +* `stack build` issues a warning when `base` is explicitly listed in + `extra-deps` of `stack.yaml` +* `stack build` suggests trying another GHC version should the build + plan end up requiring unattainable `base` version. +* A new sub command `run` has been introduced to build and run a specified executable + similar to `cabal run`. If no executable is provided as the first argument, it + defaults to the first available executable in the project. +* `stack build` missing dependency suggestions (on failure to construct a valid + build plan because of missing deps) are now printed with their latest + cabal file revision hash. See + [#4068](https://github.com/commercialhaskell/stack/pull/4068). +* Added new `--tar-dir` option to `stack sdist`, that allows to copy + the resulting tarball to the specified directory. +* Introduced the `--interleaved-output` command line option and + `build.interleaved-output` config value which causes multiple concurrent + builds to dump to stderr at the same time with a `packagename> ` prefix. See + [#3225](https://github.com/commercialhaskell/stack/issues/3225). +* The default retry strategy has changed to exponential backoff. + This should help with + [#3510](https://github.com/commercialhaskell/stack/issues/3510). +* `stack new` now allows template names of the form `username/foo` to + download from a user other than `commercialstack` on Github, and can be prefixed + with the service `github:`, `gitlab:`, or `bitbucket:`. [#4039](https://github.com/commercialhaskell/stack/issues/4039) +* Switch to `githash` to include some unmerged bugfixes in `gitrev` + Suggestion to add `'allow-newer': true` now shows path to user config + file where this flag should be put into [#3685](https://github.com/commercialhaskell/stack/issues/3685) +* `stack ghci` now asks which main target to load before doing the build, + rather than after +* Bump to hpack 0.29.0 +* With GHC 8.4 and later, Haddock is given the `--quickjump` flag. +* It is possible to specify the Hackage base URL to upload packages to, instead + of the default of `https://hackage.haskell.org/`, by using `hackage-base-url` + configuration option. +* When using Nix, if a specific minor version of GHC is not requested, the + latest minor version in the given major branch will be used automatically. + +Bug fixes: + +* `stack ghci` now does not invalidate `.o` files on repeated runs, + meaning any modules compiled with `-fobject-code` will be cached + between ghci runs. See + [#4038](https://github.com/commercialhaskell/stack/pull/4038). +* `~/.stack/config.yaml` and `stack.yaml` terminating by newline +* The previous released caused a regression where some `stderr` from the + `ghc-pkg` command showed up in the terminal. This output is now silenced. +* A regression in recompilation checking introduced in v1.7.1 has been fixed. + See [#4001](https://github.com/commercialhaskell/stack/issues/4001) +* `stack ghci` on a package with internal libraries was erroneously looking + for a wrong package corresponding to the internal library and failing to + load any module. This has been fixed now and changes to the code in the + library and the sublibrary are properly tracked. See + [#3926](https://github.com/commercialhaskell/stack/issues/3926). +* For packages with internal libraries not depended upon, `stack build` used + to fail the build process since the internal library was not built but it + was tried to be registered. This is now fixed by always building internal + libraries. See + [#3996](https://github.com/commercialhaskell/stack/issues/3996). +* `--no-nix` was not respected under NixOS +* Fix a regression which might use a lot of RAM. See + [#4027](https://github.com/commercialhaskell/stack/issues/4027). +* Order of commandline arguments does not matter anymore. + See [#3959](https://github.com/commercialhaskell/stack/issues/3959) +* When prompting users about saving their Hackage credentials on upload, + flush to stdout before waiting for the response so the prompt actually + displays. Also fixes a similar issue with ghci target selection prompt. +* If `cabal` is not on PATH, running `stack solver` now prompts the user + to run `stack install cabal-install` +* `stack build` now succeeds in building packages which contain sublibraries + which are dependencies of executables, tests or benchmarks but not of the + main library. See + [#3787](https://github.com/commercialhaskell/stack/issues/3959). +* Sublibraries are now properly considered for coverage reports when the test + suite depends on the internal library. Before, stack was erroring when + trying to generate the coverage report, see + [#4105](https://github.com/commercialhaskell/stack/issues/4105). +* Sublibraries are now added to the precompiled cache and recovered from there + when the snapshot gets updated. Previously, updating the snapshot when there + was a package with a sublibrary in the snapshot resulted in broken builds. + This is now fixed, see + [#4071](https://github.com/commercialhaskell/stack/issues/4071). +* [#4114] Stack pretty prints error messages with proper `error` logging + level instead of `warning` now. This also fixes self-executing scripts + not piping plan construction errors from runhaskell to terminal (issue + #3942). +* Fix invalid "While building Setup.hs" when Cabal calls fail. See: + [#3934](https://github.com/commercialhaskell/stack/issues/3934) +* `stack upload` signs the package by default, as documented. `--no-signature` + turns the signing off. + [#3739](https://github.com/commercialhaskell/stack/issues/3739) + + ## v1.7.1 Release notes: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,8 +3,13 @@ [![Build Status](https://travis-ci.org/commercialhaskell/stack.svg?branch=master)](https://travis-ci.org/commercialhaskell/stack) [![Windows build status](https://ci.appveyor.com/api/projects/status/c1c7uvmw6x1dupcl?svg=true)](https://ci.appveyor.com/project/snoyberg/stack) [![Release](https://img.shields.io/github/release/commercialhaskell/stack.svg)](https://github.com/commercialhaskell/stack/releases) +[![Join the chat at https://gitter.im/commercialhaskell/stack](https://badges.gitter.im/commercialhaskell/stack.svg)](https://gitter.im/commercialhaskell/stack?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) Stack is a cross-platform program for developing Haskell projects. It is intended for Haskellers both new and experienced. See [haskellstack.org](http://haskellstack.org) or the [doc](./doc) directory for more information. + +### Subsystem maintainers + +* GHCJS - [Matchwood](https://github.com/matchwood) diff --git a/doc/ChangeLog.md b/doc/ChangeLog.md --- a/doc/ChangeLog.md +++ b/doc/ChangeLog.md @@ -1,6 +1,157 @@ # Changelog +## v1.9.1 + +Release notes: + +* Statically linked Linux bindists are back again, thanks to [@nh2](https://github.com/nh2). +* We will be deleting the Ubuntu, Debian, CentOS, Fedora, and Arch package repos from `download.fpcomplete.com` soon. These have been deprecated for over a year and have not received new releases, but were left in place for compatibility with older scripts. + +Major changes: + +* Upgrade to Cabal 2.4 + * Note that, in this process, the behavior of file globbing has + been modified to match that of Cabal. In particular, this means + that for Cabal spec versions less than 2.4, `*.txt` will + match `foo.txt`, but not `foo.2.txt`. +* `GHCJS` support is being downgraded to 'experimental'. A warning notifying the user of the experimental status of `GHCJS` will be displayed. + +Behavior changes: + +* `ghc-options` from `stack.yaml` are now appended to `ghc-options` from + `config.yaml`, whereas before they would be replaced. +* `stack build` will now announce when sublibraries of a package are being + build, in the same way executables, tests, benchmarks and libraries are + announced +* `stack sdist` will now announce the destination of the generated tarball, + regardless of whether or not it passed the sanity checks +* The `--upgrade-cabal` option to `stack setup` has been + deprecated. This feature no longer works with GHC 8.2 and + later. Furthermore, the reason for this flag originally being + implemented was drastically lessened once Stack started using the + snapshot's `Cabal` library for custom setups. See: + [#4070](https://github.com/commercialhaskell/stack/issues/4070). +* With the new namespaced template feature, `stack templates` is no + longer able to meaningfully display a list of all templates + available. Instead, the command will download and display a + [help file](https://github.com/commercialhaskell/stack-templates/blob/master/STACK_HELP.md) + with more information on how to discover templates. See: + [#4039](https://github.com/commercialhaskell/stack/issues/4039) +* Build tools are now handled in a similar way to `cabal-install`. In + particular, for legacy `build-tools` fields, we use a hard-coded + list of build tools in place of looking up build tool packages in a + tool map. This both brings Stack's behavior closer into line with + `cabal-install`, avoids some bugs, and opens up some possible + optimizations/laziness. See: + [#4125](https://github.com/commercialhaskell/stack/issues/4125). +* Mustache templating is not applied to large files (over 50kb) to + avoid performance degredation. See: + [#4133](https://github.com/commercialhaskell/stack/issues/4133). +* `stack upload` signs the package by default, as documented. `--no-signature` + turns the signing off. + [#3739](https://github.com/commercialhaskell/stack/issues/3739) +* In case there is a network connectivity issue while trying to + download a template, stack will check whether that template had + been downloaded before. In that case, the cached version will be + used. See [#3850](https://github.com/commercialhaskell/stack/issues/3739). + +Other enhancements: + +* On Windows before Windows 10, --color=never is the default on terminals that + can support ANSI color codes in output only by emulation +* On Windows, recognise a 'mintty' (false) terminal as a terminal, by default +* `stack build` issues a warning when `base` is explicitly listed in + `extra-deps` of `stack.yaml` +* `stack build` suggests trying another GHC version should the build + plan end up requiring unattainable `base` version. +* A new sub command `run` has been introduced to build and run a specified executable + similar to `cabal run`. If no executable is provided as the first argument, it + defaults to the first available executable in the project. +* `stack build` missing dependency suggestions (on failure to construct a valid + build plan because of missing deps) are now printed with their latest + cabal file revision hash. See + [#4068](https://github.com/commercialhaskell/stack/pull/4068). +* Added new `--tar-dir` option to `stack sdist`, that allows to copy + the resulting tarball to the specified directory. +* Introduced the `--interleaved-output` command line option and + `build.interleaved-output` config value which causes multiple concurrent + builds to dump to stderr at the same time with a `packagename> ` prefix. See + [#3225](https://github.com/commercialhaskell/stack/issues/3225). +* The default retry strategy has changed to exponential backoff. + This should help with + [#3510](https://github.com/commercialhaskell/stack/issues/3510). +* `stack new` now allows template names of the form `username/foo` to + download from a user other than `commercialstack` on Github, and can be prefixed + with the service `github:`, `gitlab:`, or `bitbucket:`. [#4039](https://github.com/commercialhaskell/stack/issues/4039) +* Switch to `githash` to include some unmerged bugfixes in `gitrev` + Suggestion to add `'allow-newer': true` now shows path to user config + file where this flag should be put into [#3685](https://github.com/commercialhaskell/stack/issues/3685) +* `stack ghci` now asks which main target to load before doing the build, + rather than after +* Bump to hpack 0.29.0 +* With GHC 8.4 and later, Haddock is given the `--quickjump` flag. +* It is possible to specify the Hackage base URL to upload packages to, instead + of the default of `https://hackage.haskell.org/`, by using `hackage-base-url` + configuration option. +* When using Nix, if a specific minor version of GHC is not requested, the + latest minor version in the given major branch will be used automatically. + +Bug fixes: + +* `stack ghci` now does not invalidate `.o` files on repeated runs, + meaning any modules compiled with `-fobject-code` will be cached + between ghci runs. See + [#4038](https://github.com/commercialhaskell/stack/pull/4038). +* `~/.stack/config.yaml` and `stack.yaml` terminating by newline +* The previous released caused a regression where some `stderr` from the + `ghc-pkg` command showed up in the terminal. This output is now silenced. +* A regression in recompilation checking introduced in v1.7.1 has been fixed. + See [#4001](https://github.com/commercialhaskell/stack/issues/4001) +* `stack ghci` on a package with internal libraries was erroneously looking + for a wrong package corresponding to the internal library and failing to + load any module. This has been fixed now and changes to the code in the + library and the sublibrary are properly tracked. See + [#3926](https://github.com/commercialhaskell/stack/issues/3926). +* For packages with internal libraries not depended upon, `stack build` used + to fail the build process since the internal library was not built but it + was tried to be registered. This is now fixed by always building internal + libraries. See + [#3996](https://github.com/commercialhaskell/stack/issues/3996). +* `--no-nix` was not respected under NixOS +* Fix a regression which might use a lot of RAM. See + [#4027](https://github.com/commercialhaskell/stack/issues/4027). +* Order of commandline arguments does not matter anymore. + See [#3959](https://github.com/commercialhaskell/stack/issues/3959) +* When prompting users about saving their Hackage credentials on upload, + flush to stdout before waiting for the response so the prompt actually + displays. Also fixes a similar issue with ghci target selection prompt. +* If `cabal` is not on PATH, running `stack solver` now prompts the user + to run `stack install cabal-install` +* `stack build` now succeeds in building packages which contain sublibraries + which are dependencies of executables, tests or benchmarks but not of the + main library. See + [#3787](https://github.com/commercialhaskell/stack/issues/3959). +* Sublibraries are now properly considered for coverage reports when the test + suite depends on the internal library. Before, stack was erroring when + trying to generate the coverage report, see + [#4105](https://github.com/commercialhaskell/stack/issues/4105). +* Sublibraries are now added to the precompiled cache and recovered from there + when the snapshot gets updated. Previously, updating the snapshot when there + was a package with a sublibrary in the snapshot resulted in broken builds. + This is now fixed, see + [#4071](https://github.com/commercialhaskell/stack/issues/4071). +* [#4114] Stack pretty prints error messages with proper `error` logging + level instead of `warning` now. This also fixes self-executing scripts + not piping plan construction errors from runhaskell to terminal (issue + #3942). +* Fix invalid "While building Setup.hs" when Cabal calls fail. See: + [#3934](https://github.com/commercialhaskell/stack/issues/3934) +* `stack upload` signs the package by default, as documented. `--no-signature` + turns the signing off. + [#3739](https://github.com/commercialhaskell/stack/issues/3739) + + ## v1.7.1 Release notes: diff --git a/doc/GUIDE.md b/doc/GUIDE.md --- a/doc/GUIDE.md +++ b/doc/GUIDE.md @@ -359,10 +359,10 @@ # build output ... ``` -Finally, to find out which versions of these libraries stack installed, we can ask stack to `list-dependencies`: +Finally, to find out which versions of these libraries stack installed, we can ask stack to `ls dependencies`: ``` -michael@d30748af6d3d:~/helloworld$ stack list-dependencies +michael@d30748af6d3d:~/helloworld$ stack ls dependencies # dependency output ... ``` @@ -427,7 +427,7 @@ also known as *snapshots*. We mentioned the LTS resolvers, and you can get quite a bit of information about it at [https://www.stackage.org/lts](https://www.stackage.org/lts), including: -* The appropriate resolver value (`resolver: lts-11.6`, as is currently the latest LTS) +* The appropriate resolver value (`resolver: lts-11.19`, as is currently the latest LTS) * The GHC version used * A full list of all packages available in this snapshot * The ability to perform a Hoogle search on the packages in this snapshot @@ -444,15 +444,15 @@ ## Resolvers and changing your compiler version -Let's explore package sets a bit further. Instead of lts-11.6, let's change our +Let's explore package sets a bit further. Instead of lts-11.19, let's change our `stack.yaml` file to use [the latest nightly](https://www.stackage.org/nightly). Right now, -this is currently 2017-12-19 - please see the resolve from the link above to get the latest. +this is currently 2018-07-25 - please see the resolve from the link above to get the latest. Then, Rerunning `stack build` will produce: ``` michael@d30748af6d3d:~/helloworld$ stack build -Downloaded nightly-2017-12-19 build plan. +Downloaded nightly-2018-07-31 build plan. # build output ... ``` @@ -460,8 +460,8 @@ Continuous Integration (CI) setting, like on Travis. For example: ``` -michael@d30748af6d3d:~/helloworld$ stack --resolver lts-11.6 build -Downloaded lts-11.6 build plan. +michael@d30748af6d3d:~/helloworld$ stack --resolver lts-11.19 build +Downloaded lts-11.19 build plan. # build output ... ``` @@ -1203,7 +1203,7 @@ ## exec -We've already used `stack exec` used multiple times in this guide. As you've +We've already used `stack exec` multiple times in this guide. As you've likely already guessed, it allows you to run executables, but with a slightly modified environment. In particular: `stack exec` looks for executables on stack's bin paths, and sets a few additional environment variables (like adding @@ -1548,18 +1548,37 @@ ``` michael@d30748af6d3d:~$ stack templates -chrisdone -hakyll-template -new-template -simple -yesod-minimal -yesod-mongo -yesod-mysql -yesod-postgres -yesod-postgres-fay -yesod-simple -yesod-sqlite -michael@d30748af6d3d:~$ stack new my-yesod-project yesod-simple +# Stack Templates + +The `stack new` command will create a new project based on a project template. +Templates can be located on the local filesystem, on Github, or arbitrary URLs. +For more information, please see the user guide: + +https://docs.haskellstack.org/en/stable/GUIDE/#templates + +There are many templates available, some simple examples: + + stack new myproj # uses the default template + stack new myproj2 rio # uses the rio template + stack new website yesodweb/sqlite # Yesod server with SQLite DB + +For more information and other templates, please see the `stack-templates` +Wiki: + +https://github.com/commercialhaskell/stack-templates/wiki + +Please feel free to add your own templates to the Wiki for discoverability. + +Want to improve this text? Send us a PR! + +https://github.com/commercialhaskell/stack-templates/edit/master/STACK_HELP.md +``` + +You can specify one of these templates following your project name +in the `stack new` command: + +``` +michael@d30748af6d3d:~$ stack new my-yesod-project yesodweb/simple Downloading template "yesod-simple" to create project "my-yesod-project" in my-yesod-project/ ... Using the following authorship configuration: author-email: example@example.com @@ -1574,13 +1593,42 @@ Wrote project config to: /home/michael/my-yesod-project/stack.yaml ``` -Alternatively you can use your own templates by specifying the path: +The default `stack-templates` repository is on [Github](https://github.com/commercialhaskell/stack-templates), +under the user account `commercialstack`. You can download templates from a +different Github user by prefixing the username and a slash: ``` +stack new my-yesod-project yesodweb/simple +``` + +Then it would be downloaded from Github, user account `yesodweb`, +repo `stack-templates`, and file `yesod-simple.hsfiles`. + +You can even download templates from a service other that Github, such as +[Gitlab](https://gitlab.com) or [Bitbucket](https://bitbucket.com): + +``` +stack new my-project gitlab:user29/foo +``` + +That template would be downloaded from Gitlab, user account `user29`, +repo `stack-templates`, and file `foo.hsfiles`. + +If you need more flexibility, you can specify the full URL of the template: + +``` +stack new my-project https://my-site.com/content/template9.hsfiles +``` + +(The `.hsfiles` extension is optional; it will be added if it's not specified.) + +Alternatively you can use a local template by specifying the path: + +``` stack new project ~/location/of/your/template.hsfiles ``` -As a starting point you can use [the "simple" template](https://github.com/commercialhaskell/stack-templates/blob/master/simple.hsfiles). +As a starting point for creating your own templates, you can use [the "simple" template](https://github.com/commercialhaskell/stack-templates/blob/master/simple.hsfiles). An introduction into template-writing and a place for submitting official templates, you will find at [the stack-templates repository](https://github.com/commercialhaskell/stack-templates#readme). @@ -1613,21 +1661,19 @@ ### Docker -stack provides two built-in Docker integrations. Firstly, you can build your -code inside a Docker image, which means: +stack provides two built-in Docker integrations. The first way is to +build your code inside a Docker image, which means: * even more reproducibility to your builds, since you and the rest of your team will always have the same system libraries * the Docker images ship with entire precompiled snapshots. That means you have a large initial download, but much faster builds -For more information, see -[the Docker-integration documentation](docker_integration.md). - -stack can also generate Docker images for you containing your built executables. -This feature is great for automating deployments from CI. This feature is not -yet well-documented, but the basics are to add a section like the following -to stack.yaml: +The second way is to generate Docker images for you containing your +built executables (the executable is built in your local machine and +copied into the image) . This feature is great for automating +deployments from CI. This feature is not yet well-documented, but the +basics are to add a section like the following to stack.yaml: ```yaml image: @@ -1663,9 +1709,10 @@ Note that the executable will be built in the development environment and copied to the container, so the dev OS must match that of the -container OS. This is easily accomplished using [Docker integration](docker_integration.md), -under which the exe emitted by `stack build` will be built on the -Docker container, not the local OS. +container OS. Note that you can use the `--docker` option to build +your code inside the Docker container in case you have a different +development environment or if you specifically want to build on the +container. The executable will be stored under `/usr/local/bin/-exe` in the running container. @@ -1678,6 +1725,23 @@ - -exe ``` +The difference between the first and second integration methods is +that in the first one your Haskell code is actually built in the +container whereas in the second one the executable built in your host +machine is copied to the container. The presence of the following +configuration in `stack.yaml` informs stack to switch to the first +integration method: + +```yaml +docker: + enable: true +``` + +Alternatively, instead of the above configuration, you can use the +`--docker` option to achieve the same. You can find more details +about the first integration method [in the Docker integration +documentation](./docker_integration.md). + ### Nix stack provides an integration with [Nix](http://nixos.org/nix), @@ -1736,10 +1800,6 @@ * `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. -* `stack setup --upgrade-cabal` can install a newer version of the Cabal - library, used for performing actual builds. You shouldn't generally do this, - since new Cabal versions may introduce incompatibilities with package sets, - but it can be useful if you're trying to test a specific bugfix. * `stack ls snapshots` will list all the local snapshots by default. You can also view the remote snapshots using `stack ls snapshots remote`. It also supports option for viewing only lts @@ -1817,7 +1877,7 @@ * `--verbose` (or `-v`) — much more info about internal operations (useful for bug reports) * The [home page](http://haskellstack.org) * The [stack mailing list](https://groups.google.com/d/forum/haskell-stack) -* The [the FAQ](faq.md) +* The [FAQ](faq.md) * The [stack wiki](https://github.com/commercialhaskell/stack/wiki) * The [haskell-stack tag on Stack Overflow](http://stackoverflow.com/questions/tagged/haskell-stack) * [Another getting started with stack tutorial](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html) diff --git a/doc/MAINTAINER_GUIDE.md b/doc/MAINTAINER_GUIDE.md deleted file mode 100644 --- a/doc/MAINTAINER_GUIDE.md +++ /dev/null @@ -1,439 +0,0 @@ -
- -# Maintainer guide - -## Next release: - -* Create release candidate process (maybe switch to GHC-style versioning) -* Maybe drop 32-bit CentOS 6 bindists, since GHC 8.2.1 seems to have dropped them. -* Replace non-static Linux bindists with static (but keep old links active so - links don't break and 'stack upgrade' in old versions still work) - -## Pre-release steps - -* Check for any P0 and P1 issues. -* Ensure `release` and `stable` branches merged to `master` -* Check compatibility with latest Stackage snapshots - * stack-*.yaml (where `*` is not `nightly`): bump to use latest LTS minor - version (be sure any extra-deps that exist only for custom flags have - versions matching the snapshot) - * Check for any redundant extra-deps - * Run `stack --stack-yaml=stack-*.yaml test --pedantic` (replace `*` with - the actual file) -* Check compatibility with latest nightly stackage snapshot: - * Update `stack-nightly.yaml` with latest nightly and remove extra-deps (be - sure any extra-deps that exist only for custom flags have versions - matching the snapshot) - * Run `stack --stack-yaml=stack-nightly.yaml test --pedantic` -* Check pvp-bounds compatibility with Stackage snapshots: - * Create an sdist using `stack sdist --pvp-bounds=both` - * Temporarily replace `stack.cabal` with the `stack.cabal` in that sdist - * Run `stack --stack-yaml=stack-*.yaml test --pedantic` for each - `stack-*.yaml` and adjust upper bounds in original `stack.cabal` until it - works with pvp-bounds. -* Ensure integration tests pass on a Windows, macOS, and Linux (Linux - integration tests are run - by - [Gitlab](http://gitlab.fpcomplete.com/fpco-mirrors/stack/pipelines)): - `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 -* In master branch: - * stack.cabal: bump the version number to release (even third - component) - * ChangeLog: rename the "Unreleased changes" section to the new version -* Cut a release candidate branch `rc/vX.Y.Z` from master -* In master branch: - * stack.cabal: bump version number to unstable (odd third component) - * Changelog: add new "unreleased changes" section -* In RC branch: - * Update the ChangeLog: - * Check for any important changes that missed getting an entry in - Changelog (`git log origin/stable...HEAD`) - * Check for any entries that snuck into the previous version's changes - due to merges (`git diff origin/stable HEAD ChangeLog.md`) - * Review documentation for any changes that need to be made - * Search for old Stack version, unstable stack version, and the next - "obvious" version in sequence (if doing a non-obvious jump), and - `UNRELEASED` and replace with new version - * Look for any links to "latest" documentation, replace with version tag - * Ensure all documentation pages listed in `mkdocs.yaml` - * Update `.github/ISSUE_TEMPLATE.md` to point at the new version. - * Check for new [FreeBSD release](https://www.freebsd.org/releases/). - * Check that no new entries need to be added to - [releases.yaml](https://github.com/fpco/stackage-content/blob/master/stack/releases.yaml), - [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 the release process. - * [Ubuntu](https://wiki.ubuntu.com/Releases) - * 14.04 EOL 2019-APR - * 16.04 EOL 2021-APR - * [CentOS](https://wiki.centos.org/Download) - * 6 EOL 2020-NOV-30 - * 7 EOL 2024-JUN-30 - -## Release process - -See -[stack-release-script's README](https://github.com/commercialhaskell/stack/blob/master/etc/scripts/README.md#prerequisites) -for requirements to perform the release, and more details about the tool. - -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 -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. - -* Create a - [new draft Github release](https://github.com/commercialhaskell/stack/releases/new) - with tag and name `vX.Y.Z` (where X.Y.Z is the stack package's version), targeting the - RC branch - -* On each machine you'll be releasing from, set environment variables: - `GITHUB_AUTHORIZATION_TOKEN`, `AWS_ACCESS_KEY_ID`, `AWS_SECRET_ACCESS_KEY`, - `AWS_DEFAULT_REGION`. - - Note: since one of the tools (rpm-s3 on CentOS) doesn't support AWS - temporary credentials, you can't use MFA with the AWS credentials - (`AWS_SECURITY_TOKEN` is ignored). - -* On a machine with Vagrant installed: - * Run `etc/scripts/vagrant-releases.sh` - -* On macOS: - * Run `etc/scripts/osx-release.sh` - -* On Windows: - * Ensure your working tree is in `C:\stack` (or a similarly short path) - * Run `etc\scripts\windows-releases.bat` - * Release Windows installers. See - [stack-installer README](https://github.com/borsboom/stack-installer#readme) - -* On Linux ARMv7: - * Run `etc/scripts/linux-armv7-release.sh` - -* 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 release..HEAD|sed $'s/^[0-9 \t]*/* /'|sort -f` - to get the list of contributors. - -* Upload package to Hackage: `stack upload . --pvp-bounds=both` - -* Push signed Git tag, matching Github release tag name, e.g.: `git tag -d vX.Y.Z; git tag -u 0x575159689BEFB442 -m vX.Y.Z 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` - -* Update the `stable` branch similarly - -* Delete the RC branch and any RC tags (locally and on origin) - -* Activate version for new release tag on - [readthedocs.org](https://readthedocs.org/dashboard/stack/versions/), and - ensure that stable documentation has updated - -* Merge any changes made in the RC/release/stable branches to master. - -* On a machine with Vagrant installed: - * Make sure you are on the same commit as when `vagrant-release.sh` was run. - * Run `etc/scripts/vagrant-distros.sh` - -* Upload haddocks to Hackage: `etc/scripts/upload-haddocks.sh` (if they weren't auto-built) - -* Announce to haskell-cafe@haskell.org, haskell-stack@googlegroups.com, - commercialhaskell@googlegroups.com mailing lists - -* Keep an eye on the - [Hackage matrix builder](http://matrix.hackage.haskell.org/package/stack) - -## Setting up a Windows VM for releases - -These instructions are a bit rough, but has the steps to get the Windows machine -set up. - - 1. Download VM image: - https://developer.microsoft.com/en-us/microsoft-edge/tools/vms/mac/ - - 2. Launch the VM using Virtualbox and the image downloaded - - 3. Adjust settings: - * Number of CPUs: match the host - * Memory: at least 3 GB - * Video RAM: the minimum recommended by Virtualbox - * Enable 3D and 2D accelerated mode - * Enabled shared clipboard (both directions) - - 4. Install the VMware guest additions, and reboot - - 5. In **Settings**->**Update & Security**->**Windows Update**->**Advanced options**: - * Change **Choose how updates are installed** to **Notify to schedule restart** - * Check **Defer upgrades** - - 6. Configure a shared folder for your home directory on the host, and mount it on Z: - - 7. Install Windows SDK (for signtool): - http://microsoft.com/en-us/download/confirmation.aspx?id=8279 - - 8. Install msysgit: https://msysgit.github.io/ - - 9. Install nsis-2.46.5-Unicode-setup.exe from http://www.scratchpaper.com/ - -10: Install Stack using the Windows 64-bit installer - -11. Visit https://hackage.haskell.org/ in Edge to ensure system has correct CA - certificates - -12. Get the object code certificate from - [password-store](https://github.com/fpco/password-store), in - `certificates/code_signing/fpcomplete_corporation_startssl_2015-09-22.pfx`. - Double click it in explorer and import it - -13. Run in command prompt: - - md C:\p - md C:\p\tmp - cd \p - md c:\tmp - -14. Create `C:\p\env.bat`: - - SET STACK_ROOT=C:\p\.sr - SET TEMP=C:\p\tmp - SET TMP=C:\p\tmp - SET PATH=C:\Users\IEUser\AppData\Roaming\local\bin;"c:\Program Files\Git\usr\bin";"C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin";%PATH% - -15. Run `C:\p\env.bat` (do this every time you open a new command prompt) - -16. Import the `dev@fpcomplete.com` (0x575159689BEFB442) GPG secret key - -17. Run in command prompt (adjust the `user.email` and `user.name` settings): - - stack setup - stack install cabal-install - md %HOMEPATH%\.ssh - copy z:\.ssh\id_rsa %HOMEPATH%\.ssh - git config --global user.email manny@fpcomplete.com - git config --global user.name "Emanuel Borsboom" - git config --global push.default simple - git config --global core.autocrlf true - git clone git@github.com:commercialhaskell/stack.git - git clone git@github.com:borsboom/stack-installer.git - -## Setting up an ARM VM for releases - -These instructions assume the host system is running macOS. Some steps will vary -with a different host OS. - -### Install qemu on host - - brew install qemu - -### Install fuse-ext2 - - brew install e2fsprogs m4 automake autoconf libtool && \ - git clone https://github.com/alperakcan/fuse-ext2.git && \ - cd fuse-ext2 && \ - -Add `m4_ifdef([AM_PROG_AR], [AM_PROG_AR])` to the `configure.ac` after -`m4_ifdef([AC_PROG_LIB],[AC_PROG_LIB],[m4_warn(portability,[Missing AC_PROJ_LIB])])` -line. - - PKG_CONFIG_PATH="$(brew --prefix e2fsprogs)/lib/pkgconfig" \ - CFLAGS="-idirafter/$(brew --prefix e2fsprogs)/include -idirafter/usr/local/include/osxfuse" \ - LDFLAGS="-L$(brew --prefix e2fsprogs)/lib" \ - ./configure - -### Create VM and install Debian in it - - wget http://ftp.de.debian.org/debian/dists/jessie/main/installer-armhf/current/images/netboot/initrd.gz && \ - wget http://ftp.de.debian.org/debian/dists/jessie/main/installer-armhf/current/images/netboot/vmlinuz && \ - wget http://ftp.de.debian.org/debian/dists/jessie/main/installer-armhf/current/images/device-tree/vexpress-v2p-ca9.dtb && \ - qemu-img create -f raw armdisk.raw 15G && \ - qemu-system-arm -M vexpress-a9 -cpu cortex-a9 -kernel vmlinuz -initrd initrd.gz -sd armdisk.raw -append "root=/dev/mmcblk0p2" -m 1024M -redir tcp:2223::22 -dtb vexpress-v2p-ca9.dtb -append "console=ttyAMA0,115200" -serial stdio - -Now the Debian installer will run. Don't use LVM for partitioning (it won't -boot), and add at least 4 GB swap during installation. - -### Get boot files after install - -Adjust the disk number `/dev/disk3` below to match the output from `hdiutil attach`. - - hdiutil attach -imagekey diskimage-class=CRawDiskImage -nomount armdisk.raw && \ - sudo mkdir -p /Volumes/debarm && \ - sudo fuse-ext2 /dev/disk3s1 /Volumes/debarm/ && \ - sleep 5 && \ - cp /Volumes/debarm/vmlinuz-3.16.0-4-armmp . && \ - cp /Volumes/debarm/initrd.img-3.16.0-4-armmp . && \ - sudo umount /Volumes/debarm && \ - hdiutil detach /dev/disk3 - -### Boot VM - -Adjust `/dev/mmcblk0p3` below to the root partition you created during installation. - - qemu-system-arm -M vexpress-a9 -cpu cortex-a9 -kernel vmlinuz-3.16.0-4-armmp -initrd initrd.img-3.16.0-4-armmp -sd armdisk.raw -m 1024M -dtb vexpress-v2p-ca9.dtb -append "root=/dev/mmcblk0p3 console=ttyAMA0,115200" -serial stdio -redir tcp:2223::22 - -### Setup rest of system - -Log onto the VM as root, then (replace `<<>>` with the user you set up -during Debian installation): - - apt-get update && \ - apt-get install -y sudo && \ - adduser <<>> sudo - -Now you can SSH to the VM using `ssh -p 2223 <<>>@localhost` and use `sudo` in -the shell. - -### Install build tools and dependencies packages - - sudo apt-get install -y g++ gcc libc6-dev libffi-dev libgmp-dev make xz-utils zlib1g-dev git gnupg - -### Install clang+llvm - -NOTE: the Debian jessie `llvm` package does not work (executables built with it -just exit with "schedule: re-entered unsafely."). - -The version of LLVM needed depends on the version of GHC you need. - -#### GHC 8.0.2 (the standard for building Stack) - - wget http://llvm.org/releases/3.7.1/clang+llvm-3.7.1-armv7a-linux-gnueabihf.tar.xz && \ - sudo tar xvf clang+llvm-3.7.1-armv7a-linux-gnueabihf.tar.xz -C /opt - -Run this now and add it to the `.profile`: - - export PATH="$HOME/.local/bin:/opt/clang+llvm-3.7.1-armv7a-linux-gnueabihf/bin:$PATH" - -#### GHC 7.10.3 - - wget http://llvm.org/releases/3.5.2/clang+llvm-3.5.2-armv7a-linux-gnueabihf.tar.xz && \ - sudo tar xvf clang+llvm-3.5.2-armv7a-linux-gnueabihf.tar.xz -C /opt - -Run this now and add it to the `.profile`: - - export PATH="$HOME/.local/bin:/opt/clang+llvm-3.5.2-armv7a-linux-gnueabihf/bin:$PATH" - -### Install Stack - -#### Binary - -Get an [existing `stack` binary](https://github.com/commercialhaskell/stack/releases) -and put it in `~/.local/bin`. - -#### From source (using cabal-install): - - wget http://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-armv7-deb8-linux.tar.xz && \ - tar xvf ghc-7.10.3-armv7-deb8-linux.tar.xz && \ - cd ghc-7.10.3 && \ - ./configure --prefix=/opt/ghc-7.10.3 && \ - sudo make install && \ - cd .. - export PATH="/opt/ghc-7.10.3/bin:$PATH" - wget https://www.haskell.org/cabal/release/cabal-install-1.24.0.0/cabal-install-1.24.0.0.tar.gz &&&&& \ - tar xvf cabal-install-1.24.0.0.tar.gz && \ - cd cabal-install-1.24.0.0 && \ - EXTRA_CONFIGURE_OPTS="" ./bootstrap.sh && \ - cd .. && \ - export PATH="$HOME/.cabal/bin:$PATH" && \ - cabal update - -Edit `~/.cabal/config`, and set `executable-stripping: False` and -`library-stripping: False`. - - cabal unpack stack && \ - cd stack-* && \ - cabal install && \ - mv ~/.cabal/bin/stack ~/.local/bin - -### Import GPG private key - -Import the `dev@fpcomplete.com` (0x575159689BEFB442) GPG secret key - -### Resources - - - http://mashu.github.io/2015/08/12/QEMU-Debian-armhf.html - - https://www.aurel32.net/info/debian_arm_qemu.php - - http://linuxdeveloper.blogspot.ca/2011/08/how-to-install-arm-debian-on-ubuntu.html - - http://www.macworld.com/article/2855038/how-to-mount-and-manage-non-native-file-systems-in-os-x-with-fuse.html - - https://github.com/alperakcan/fuse-ext2#mac-os - - https://github.com/alperakcan/fuse-ext2/issues/31#issuecomment-214713801 - - https://github.com/alperakcan/fuse-ext2/issues/33#issuecomment-216758378 - - https://github.com/alperakcan/fuse-ext2/issues/32#issuecomment-216758019 - - http://osxdaily.com/2007/03/23/create-a-ram-disk-in-mac-os-x/ - -## Adding a new GHC version - - * Push new tag to our fork: - - git clone git@github.com:commercialhaskell/ghc.git - cd ghc - git remote add upstream git@github.com:ghc/ghc.git - git fetch upstream - git push origin ghc-X.Y.Z-release - - * [Publish a new Github release](https://github.com/commercialhaskell/ghc/releases/new) - with tag `ghc-X.Y.Z-release` and same name. - - * Down all the relevant GHC bindists from https://www.haskell.org/ghc/download_ghc_X_Y_Z and upload them to the just-created Github release (see - [stack-setup-2.yaml](https://github.com/fpco/stackage-content/blob/master/stack/stack-setup-2.yaml) - for the ones we used in the last GHC release). - - 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`) - * ncurses6 (`etc/vagrant/arch-x86_64`) - - * [Edit stack-setup-2.yaml](https://github.com/fpco/stackage-content/edit/master/stack/stack-setup-2.yaml) - and add the new bindists, pointing to the Github release version. Be sure to - update the `content-length` and `sha1` values. - -### Building GHC - -On systems with a small `/tmp`, you should set TMP and TEMP to an alternate -location. - -For GHC >= 7.10.2, set the `GHC_VERSION` environment variable to the version to build: - - * `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)): - - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ && \ - git clone -b ghc-${GHC_VERSION}-release --recursive git://github.com/ghc/ghc ghc-${GHC_VERSION} && \ - cd ghc-${GHC_VERSION}/ && \ - cp mk/build.mk.sample mk/build.mk && \ - sed -i 's/^#BuildFlavour *= *perf$/BuildFlavour = perf/' mk/build.mk && \ - ./boot && \ - ./configure --enable-tarballs-autodownload && \ - sed -i 's/^TAR_COMP *= *bzip2$/TAR_COMP = xz/' mk/config.mk && \ - make -j$(cat /proc/cpuinfo|grep processor|wc -l) && \ - make binary-dist - -GHC 7.8.4 is slightly different: - - export GHC_VERSION=7.8.4 && \ - git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ && \ - git clone -b ghc-${GHC_VERSION}-release --recursive git://github.com/ghc/ghc ghc-${GHC_VERSION} && \ - cd ghc-${GHC_VERSION}/ && \ - ./sync-all --extra --nofib -r git://git.haskell.org get -b ghc-7.8 && \ - cp mk/build.mk.sample mk/build.mk && \ - sed -i 's/^#BuildFlavour *= *perf$/BuildFlavour = perf/' mk/build.mk && \ - perl boot && \ - ./configure && \ - sed -i 's/^TAR_COMP *= *bzip2$/TAR_COMP = xz/' mk/config.mk && \ - make -j$(cat /proc/cpuinfo|grep processor|wc -l) && \ - make binary-dist diff --git a/doc/README.md b/doc/README.md --- a/doc/README.md +++ b/doc/README.md @@ -95,9 +95,12 @@ 2. If you need to include another library (for example the package [`text`](https://hackage.haskell.org/package/text)): - - Add the package `text` to the file `my-project.cabal` - in the section `build-depends: ...`. + - Add the package `text` to the file `package.yaml` + in the section `dependencies: ...`. - Run `stack build` another time. + - `stack build` will update my-project.cabal for you. + If desired you can update the .cabal file manually + and stack will use .cabal instead of package.yaml. 3. If you get an error that tells you your package isn't in the LTS. Just try to add a new version in the `stack.yaml` file in the `extra-deps` section. @@ -191,3 +194,7 @@ If you'd like to get involved with Stack, check out the [newcomer friendly](https://github.com/commercialhaskell/stack/issues?q=is%3Aopen+is%3Aissue+label%3a%22newcomer+friendly%22) label on the Github issue tracker. + +#### How to uninstall +Removing ``~/.stack`` and ``/usr/local/bin/stack`` should be sufficient. You may want to delete ``.stack-work`` folders in any Haskell projects that you have built. + diff --git a/doc/architecture.md b/doc/architecture.md --- a/doc/architecture.md +++ b/doc/architecture.md @@ -96,7 +96,7 @@ When running a build, we know which packages we want installed (inventively called "wanteds"), which packages are available to install, and which are -already installed. In plan construction, we put them information together to +already installed. In plan construction, we put this information together to decide which packages must be built. The code in Stack.Build.ConstructPlan is authoritative on this and should be consulted. The basic idea though is: diff --git a/doc/build_command.md b/doc/build_command.md --- a/doc/build_command.md +++ b/doc/build_command.md @@ -161,7 +161,7 @@ * `--exec "cmd [args]"` will run a command after a successful build To come back to the composable approach described above, consider this final -example (which uses the [wai repository](https://github.com/yesodweb/wai/): +example (which uses the [wai repository](https://github.com/yesodweb/wai/)): ``` stack build --file-watch --test --copy-bins --haddock wai-extra :warp warp:doctest --exec 'echo Yay, it worked!' @@ -194,3 +194,9 @@ warnings, to avoid problems of interleaved output and decrease console noise. If you would like to see this content instead, you can use the `--dump-logs` command line option, or add `dump-logs: all` to your `stack.yaml` file. + +Alternatively, starting with Stack 1.8, you can pass `--interleaved-output` to +see output of all packages being built scroll by in a streaming fashion. The +output from each package built will be prefixed by the package name, e.g. `mtl> +Building ...`. Note that, unlike the default output, this will include the +output from dependencies being built, not just targets. diff --git a/doc/ghci.md b/doc/ghci.md --- a/doc/ghci.md +++ b/doc/ghci.md @@ -75,3 +75,10 @@ it may be useful to run ghci plainly like `stack exec ghci`. This will run a plain `ghci` in an environment which includes `GHC_PACKAGE_PATH`, and so will have access to your databases. + +*Note*: Running `stack ghci` on a pristine copy of the code doesn't currently +build libraries +([#2790](https://github.com/commercialhaskell/stack/issues/2790)) or internal +libraries ([#4148](https://github.com/commercialhaskell/stack/issues/4148)). +It is recommended to always run a `stack build` before running `stack ghci`, +until these two issues are closed. diff --git a/doc/ghcjs.md b/doc/ghcjs.md --- a/doc/ghcjs.md +++ b/doc/ghcjs.md @@ -1,8 +1,8 @@
-# GHCJS +# GHCJS (experimental) -To use GHCJS with stack, place a GHCJS version in the [`compiler`](yaml_configuration.md#compiler) field of `stack.yaml`. After this, all stack commands should work with GHCJS! In particular: +To use GHCJS with stack, place a GHCJS version in the [`compiler`](yaml_configuration.md#compiler) field of `stack.yaml`. After this, some stack commands should work with GHCJS. In particular: * `stack setup` will install GHCJS from source and boot it, which takes a long time. @@ -21,8 +21,14 @@ ## Example Configurations -### Recent versions of GHCJS, repacked for stack +### GHCJS repacked for snapsnots lts-8 and lts-9 +Please see the [ghcjs-stack-dist repository](https://github.com/matchwood/ghcjs-stack-dist) for `lts-8` and `lts-9` configurations and refer to the [README](https://github.com/matchwood/ghcjs-stack-dist/blob/master/README.md) for common issues. + +Support for `> lts-9` snapshots (`GHC 8.2` and above) is currently [work in progress](https://github.com/matchwood/ghcjs-stack-dist/issues/10). + +### GHCJS repacked for snapsnots < lts-8 + These versions of GHCJS were created by [Marcin Tolysz](https://github.com/tolysz), and were particularly crafted to include package versions which match those expected by particular stackage @@ -55,7 +61,7 @@ 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 latter can be generated via: https://github.com/tolysz/prepare-ghcjs the former is a bit more manual. Those bundles are only tested against the latest `node-7.4.0`. In order to correctly boot and use ghcjs, one might need to install `alex` `happy` `hscolour` `hsc2hs` with the normal ghc. @@ -64,6 +70,7 @@ |resolver|ghcjs|url|sha1| |---|---|---|---| +| lts-7.19 |0.2.1| http://ghcjs.tolysz.org/ghc-8.0-2017-02-05-lts-7.19-9007019.tar.gz | d2cfc25f9cda32a25a87d9af68891b2186ee52f9 | | 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 | diff --git a/doc/install_and_upgrade.md b/doc/install_and_upgrade.md --- a/doc/install_and_upgrade.md +++ b/doc/install_and_upgrade.md @@ -73,7 +73,7 @@ If you have the popular [brew](https://brew.sh/) tool installed, you can just do: - brew install haskell-stack + brew install stack * The Homebrew formula and bottles are **unofficial** and lag slightly behind new Stack releases, but tend to be updated within a day or two. @@ -104,8 +104,8 @@ There is also a [Ubuntu package](http://packages.ubuntu.com/search?keywords=haskell-stack&searchon=names&suite=all§ion=all) for Ubuntu 16.10 and up, but the distribution's Stack version lags behind, so we -recommend running `stack upgrade --binary` after installing it. For older stack -versions which do not support `--binary`, just `stack upgrade` may work too. The +recommend running `stack upgrade --binary-only` after installing it. For older stack +versions which do not support `--binary-only`, just `stack upgrade` may work too. The version in Ubuntu 16.04 is too old to upgrade successfully, and so in that case stack should be installed from a [release tarball](https://github.com/commercialhaskell/stack/releases). @@ -117,8 +117,8 @@ There is also a [Debian package](https://packages.debian.org/search?keywords=haskell-stack&searchon=names&suite=all§ion=all) for Stretch and up, but the distribution's Stack version lags behind, so running -`stack upgrade --binary` is recommended after installing it. For older stack -versions which do not support `--binary`, just `stack upgrade` may work too. +`stack upgrade --binary-only` is recommended after installing it. For older stack +versions which do not support `--binary-only`, just `stack upgrade` may work too. ## CentOS / Red Hat / Amazon Linux diff --git a/doc/nix_integration.md b/doc/nix_integration.md --- a/doc/nix_integration.md +++ b/doc/nix_integration.md @@ -54,7 +54,7 @@ support means packages will always be built using a GHC available inside the shell, rather than your globally installed one if any. -Note that in this mode `stack` can use only GHC versions than have +Note that in this mode `stack` can use only GHC versions that have already been mirrored into the Nix package repository. The [Nixpkgs master branch](https://github.com/NixOS/nixpkgs/tree/master/pkgs/development/haskell-modules) usually picks up new versions quickly, but it takes two or three @@ -186,9 +186,10 @@ ```yaml nix: - # false by default. Must be present and set to `true` to enable Nix. - # You can set set it in your `$HOME/.stack/config.yaml` to enable - # Nix for all your projects without having to repeat it + # false by default. Must be present and set to `true` to enable Nix, except on + # NixOS where it is enabled by default (see #3938). You can set set it in your + # `$HOME/.stack/config.yaml` to enable Nix for all your projects without having + # to repeat it # enable: true # true by default. Tells Nix whether to run in a pure shell or not. diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md --- a/doc/yaml_configuration.md +++ b/doc/yaml_configuration.md @@ -199,6 +199,8 @@ extra-deps: - git: git@github.com:commercialhaskell/stack.git commit: 6a86ee32e5b869a877151f74064572225e1a0398 +- git: git@github.com:snoyberg/http-client.git + commit: "a5f4f3" - hg: https://example.com/hg/repo commit: da39a3ee5e6b4b0d3255bfef95601890afd80709 ``` @@ -226,6 +228,14 @@ - wai ``` +Since v1.7.1, you can specify packages from GitHub repository name using `github`: + +```yaml +extra-deps: +- github: snoyberg/http-client + commit: a5f4f30f01366738f913968163d856366d7e0342 +``` + If unspecified, `subdirs` defaults to `['.']` meaning looking for a package in the root of the repo.. Note that if you specify a value of `subdirs`, then `'.'` is _not_ included by default and needs to be @@ -548,7 +558,7 @@ command line parameters. NOTE: Prior to version 1.6.0, the `$locals`, `$targets`, and -`$everything` keys were not support. Instead, you could use `"*"` for +`$everything` keys were not supported. Instead, you could use `"*"` for the behavior represented now by `$everything`. It is highly recommended to switch to the new, more expressive, keys. @@ -777,6 +787,9 @@ reconfigure: false cabal-verbose: false split-objs: false + + # Since 1.8 + interleaved-output: false ``` The meanings of these settings correspond directly with the CLI flags of the @@ -865,6 +878,17 @@ Since 1.5.0 +### hackage-base-url + +Sets the address of the Hackage server to upload the package to. Default is +`https://hackage.haskell.org/`. + +```yaml +hackage-base-url: https://hackage.example.com/ +``` + +Since 1.9.1 + ### ignore-revision-mismatch Cabal files in packages can be specified via exact revisions to deal @@ -956,7 +980,7 @@ variable. These will be used when resolving the location of executables, and will also be visible in the `PATH` variable of processes run by stack. -For example, to prepend `/path-to-some-dep/bin` to your PATh: +For example, to prepend `/path-to-some-dep/bin` to your PATH: ```yaml extra-path: @@ -986,3 +1010,33 @@ This option specifies which template to use with `stack new`, when none is specified. The default is called `new-template`. The other templates are listed in [the stack-templates repo](https://github.com/commercialhaskell/stack-templates/). + +### stack-colors + +Stack uses styles to format some of its output. The default styles do not work +well with every terminal theme. This option specifies stack's output styles, +allowing new styles to replace the defaults. The option is used as +`stack-colors: `, where `` is a colon-delimited sequence of +key=value, 'key' is a style name and 'value' is a semicolon-delimited list of +'ANSI' SGR (Select Graphic Rendition) control codes (in decimal). Use the +command `stack ls stack-colors --basic` to see the current sequence. + +The 'ANSI' standards refer to (1) standard ECMA-48 'Control Functions for Coded +Character Sets' (5th edition, 1991); (2) extensions in ITU-T Recommendation +(previously CCITT Recommendation) T.416 (03/93) 'Information Technology – Open +Document Architecture (ODA) and Interchange Format: Character Content +Architectures' (also published as ISO/IEC International Standard 8613-6); and +(3) further extensions used by 'XTerm', a terminal emulator for the X Window +System. The 'ANSI' SGR codes are described in a +[Wikipedia article](http://en.wikipedia.org/wiki/ANSI_escape_code) +and those codes supported on current versions of Windows in +[Microsoft's documentation](https://docs.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences). + +For example, users of the popular +[Solarized Dark](https://ethanschoonover.com/solarized/) +terminal theme might wish to set the styles as follows: + +```yaml +stack-colors: error=31:good=32:shell=35:dir=34:recommendation=32:target=95:module=35:package-component=95 +``` +The styles can also be set at the command line using the equivalent `--stack-colors=` global option. Styles set at the command line take precedence over those set in a yaml configuration file. diff --git a/src/Data/Monoid/Map.hs b/src/Data/Monoid/Map.hs new file mode 100644 --- /dev/null +++ b/src/Data/Monoid/Map.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Data.Monoid.Map where + +import qualified Data.Map as M +import Stack.Prelude + +-- | Utility newtype wrapper to make make Map's Monoid also use the +-- element's Monoid. +newtype MonoidMap k a = MonoidMap (Map k a) + deriving (Eq, Ord, Read, Show, Generic, Functor) + +instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where + MonoidMap mp1 <> MonoidMap mp2 = MonoidMap (M.unionWith (<>) mp1 mp2) + +instance (Ord k, Semigroup a) => Monoid (MonoidMap k a) where + mappend = (<>) + mempty = MonoidMap mempty diff --git a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs --- a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs +++ b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs @@ -7,8 +7,7 @@ -- 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 + makeHttpLib -- ** Re-exports , Manager -- opaque ) where @@ -17,13 +16,10 @@ 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 Network.HTTP.StackClient (Manager) import qualified Network.HTTP.StackClient as StackClient -import qualified Network.HTTP.Types as HttpClient import Hackage.Security.Client hiding (Header) import Hackage.Security.Client.Repository.HttpLib @@ -34,21 +30,6 @@ 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 @@ -68,10 +49,10 @@ 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 + request' <- StackClient.setUri StackClient.defaultRequest uri let request = setRequestHeaders reqHeaders request' checkHttpException $ StackClient.withResponseByManager request manager $ \response -> do - let br = wrapCustomEx $ HttpClient.responseBody response + let br = wrapCustomEx $ StackClient.responseBody response callback (getResponseHeaders response) br getRange :: Throws SomeRemoteError @@ -80,49 +61,49 @@ -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a) -> IO a getRange manager reqHeaders uri (from, to) callback = wrapCustomEx $ do - request' <- HttpClient.setUri HttpClient.defaultRequest uri + request' <- StackClient.setUri StackClient.defaultRequest uri let request = setRange from to $ setRequestHeaders reqHeaders request' checkHttpException $ StackClient.withResponseByManager request manager $ \response -> do - let br = wrapCustomEx $ HttpClient.responseBody response + let br = wrapCustomEx $ StackClient.responseBody response case () of - () | HttpClient.responseStatus response == HttpClient.partialContent206 -> + () | StackClient.responseStatus response == StackClient.partialContent206 -> callback HttpStatus206PartialContent (getResponseHeaders response) br - () | HttpClient.responseStatus response == HttpClient.ok200 -> + () | StackClient.responseStatus response == StackClient.ok200 -> callback HttpStatus200OK (getResponseHeaders response) br _otherwise -> - throwChecked $ HttpClient.HttpExceptionRequest request - $ HttpClient.StatusCodeException (void response) "" + throwChecked $ StackClient.HttpExceptionRequest request + $ StackClient.StatusCodeException (void response) "" -- | Wrap custom exceptions -- -- NOTE: The only other exception defined in @http-client@ is @TimeoutTriggered@ -- but it is currently disabled -wrapCustomEx :: (Throws HttpClient.HttpException => IO a) +wrapCustomEx :: (Throws StackClient.HttpException => IO a) -> (Throws SomeRemoteError => IO a) -wrapCustomEx act = handleChecked (\(ex :: HttpClient.HttpException) -> go ex) act +wrapCustomEx act = handleChecked (\(ex :: StackClient.HttpException) -> go ex) act where go ex = throwChecked (SomeRemoteError ex) -checkHttpException :: Throws HttpClient.HttpException => IO a -> IO a -checkHttpException = handle $ \(ex :: HttpClient.HttpException) -> +checkHttpException :: Throws StackClient.HttpException => IO a -> IO a +checkHttpException = handle $ \(ex :: StackClient.HttpException) -> throwChecked ex {------------------------------------------------------------------------------- http-client auxiliary -------------------------------------------------------------------------------} -hAcceptRanges :: HttpClient.HeaderName +hAcceptRanges :: StackClient.HeaderName hAcceptRanges = "Accept-Ranges" -hAcceptEncoding :: HttpClient.HeaderName +hAcceptEncoding :: StackClient.HeaderName hAcceptEncoding = "Accept-Encoding" setRange :: Int -> Int - -> HttpClient.Request -> HttpClient.Request + -> StackClient.Request -> StackClient.Request setRange from to req = req { - HttpClient.requestHeaders = (HttpClient.hRange, rangeHeader) - : HttpClient.requestHeaders req + StackClient.requestHeaders = (StackClient.hRange, rangeHeader) + : StackClient.requestHeaders req } where -- Content-Range header uses inclusive rather than exclusive bounds @@ -131,42 +112,42 @@ -- | Set request headers setRequestHeaders :: [HttpRequestHeader] - -> HttpClient.Request -> HttpClient.Request + -> StackClient.Request -> StackClient.Request setRequestHeaders opts req = req { - HttpClient.requestHeaders = trOpt disallowCompressionByDefault opts + StackClient.requestHeaders = trOpt disallowCompressionByDefault opts } where - trOpt :: [(HttpClient.HeaderName, [ByteString])] + trOpt :: [(StackClient.HeaderName, [ByteString])] -> [HttpRequestHeader] - -> [HttpClient.Header] + -> [StackClient.Header] trOpt acc [] = concatMap finalizeHeader acc trOpt acc (HttpRequestMaxAge0:os) = - trOpt (insert HttpClient.hCacheControl ["max-age=0"] acc) os + trOpt (insert StackClient.hCacheControl ["max-age=0"] acc) os trOpt acc (HttpRequestNoTransform:os) = - trOpt (insert HttpClient.hCacheControl ["no-transform"] acc) os + trOpt (insert StackClient.hCacheControl ["no-transform"] acc) os -- disable content compression (potential security issue) - disallowCompressionByDefault :: [(HttpClient.HeaderName, [ByteString])] + disallowCompressionByDefault :: [(StackClient.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 :: (StackClient.HeaderName, [ByteString]) + -> [StackClient.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 :: StackClient.Response a -> [HttpResponseHeader] getResponseHeaders response = concat [ [ HttpResponseAcceptRangesBytes | (hAcceptRanges, "bytes") `elem` headers ] ] where - headers = HttpClient.responseHeaders response + headers = StackClient.responseHeaders response diff --git a/src/Network/HTTP/Download.hs b/src/Network/HTTP/Download.hs --- a/src/Network/HTTP/Download.hs +++ b/src/Network/HTTP/Download.hs @@ -30,12 +30,8 @@ import qualified Data.Conduit.Binary as CB import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding (decodeUtf8With) -import Network.HTTP.Client (Request, Response, path, checkResponse, parseUrlThrow, parseRequest) -import Network.HTTP.Client.Conduit (requestHeaders) import Network.HTTP.Download.Verified -import Network.HTTP.StackClient (httpJSON, httpLbs, httpLBS, withResponse) -import Network.HTTP.Simple (getResponseBody, getResponseHeaders, getResponseStatusCode, - setRequestHeader) +import Network.HTTP.StackClient (Request, Response, HttpException, httpJSON, httpLbs, httpLBS, withResponse, path, checkResponse, parseUrlThrow, parseRequest, setRequestHeader, getResponseHeaders, requestHeaders, getResponseBody, getResponseStatusCode) import Path.IO (doesFileExist) import System.Directory (createDirectoryIfMissing, removeFile) @@ -89,7 +85,7 @@ [("If-None-Match", L.toStrict etag)] } req2 = req1 { checkResponse = \_ _ -> return () } - recoveringHttp drRetryPolicyDefault $ liftIO $ + recoveringHttp drRetryPolicyDefault $ catchingHttpExceptions $ liftIO $ withResponse req2 $ \res -> case getResponseStatusCode res of 200 -> do createDirectoryIfMissing True $ takeDirectory destFilePath @@ -108,9 +104,15 @@ return True 304 -> return False - _ -> throwM $ RedownloadFailed req2 dest $ void res + _ -> throwM $ RedownloadInvalidResponse req2 dest $ void res -data DownloadException = RedownloadFailed Request (Path Abs File) (Response ()) + where + catchingHttpExceptions :: RIO env a -> RIO env a + catchingHttpExceptions action = catch action (throwM . RedownloadHttpError) + +data DownloadException = RedownloadInvalidResponse Request (Path Abs File) (Response ()) + | RedownloadHttpError HttpException + deriving (Show, Typeable) instance Exception DownloadException diff --git a/src/Network/HTTP/Download/Verified.hs b/src/Network/HTTP/Download/Verified.hs --- a/src/Network/HTTP/Download/Verified.hs +++ b/src/Network/HTTP/Download/Verified.hs @@ -30,7 +30,7 @@ import Control.Monad import Control.Monad.Catch (Handler (..)) -- would be nice if retry exported this itself import Stack.Prelude hiding (Handler (..)) -import Control.Retry (recovering,limitRetries,RetryPolicy,constantDelay,RetryStatus(..)) +import Control.Retry (recovering,limitRetries,RetryPolicy,exponentialBackoff,RetryStatus(..)) import Crypto.Hash import Crypto.Hash.Conduit (sinkHash) import Data.ByteArray as Mem (convert) @@ -41,10 +41,7 @@ import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import GHC.IO.Exception (IOException(..),IOErrorType(..)) -import Network.HTTP.Client (getUri, path) -import Network.HTTP.StackClient (httpSink) -import Network.HTTP.Simple (Request, HttpException, getResponseHeaders) -import Network.HTTP.Types.Header (hContentLength, hContentMD5) +import Network.HTTP.StackClient (Request, HttpException, httpSink, getUri, path, getResponseHeaders, hContentLength, hContentMD5) import Path import Stack.Types.Runner import Stack.PrettyPrint @@ -59,9 +56,20 @@ , drRetryPolicy :: RetryPolicy } --- | Default to retrying thrice with a short constant delay. +-- | Default to retrying seven times with exponential backoff starting from +-- one hundred milliseconds. +-- +-- This means the tries will occur after these delays if necessary: +-- +-- * 0.1s +-- * 0.2s +-- * 0.4s +-- * 0.8s +-- * 1.6s +-- * 3.2s +-- * 6.4s drRetryPolicyDefault :: RetryPolicy -drRetryPolicyDefault = limitRetries 3 <> constantDelay onehundredMilliseconds +drRetryPolicyDefault = limitRetries 7 <> exponentialBackoff onehundredMilliseconds where onehundredMilliseconds = 100000 data HashCheck = forall a. (Show a, HashAlgorithm a) => HashCheck @@ -210,6 +218,7 @@ [ "If you see this warning and stack fails to download," , "but running the command again solves the problem," , "please report here: https://github.com/commercialhaskell/stack/issues/3510" + , "Make sure to paste the output of 'stack --version'" ] ] return True diff --git a/src/Network/HTTP/StackClient.hs b/src/Network/HTTP/StackClient.hs --- a/src/Network/HTTP/StackClient.hs +++ b/src/Network/HTTP/StackClient.hs @@ -13,6 +13,54 @@ , setUserAgent , withResponse , withResponseByManager + , setRequestMethod + , setRequestHeader + , addRequestHeader + , setRequestBody + , setRequestManager + , getResponseHeaders + , getResponseBody + , getResponseStatusCode + , Network.HTTP.Client.responseHeaders + , Network.HTTP.Client.responseStatus + , Network.HTTP.Client.responseBody + , parseRequest + , parseRequest_ + , defaultRequest + , setUri + , getUri + , path + , checkResponse + , parseUrlThrow + , requestHeaders + , getGlobalManager + , applyDigestAuth + , displayDigestAuthException + , Request + , RequestBody(RequestBodyBS, RequestBodyLBS) + , Response + , Manager + , Header + , HeaderName + , HttpException(HttpExceptionRequest) + , HttpExceptionContent(StatusCodeException) + , hAccept + , hContentLength + , hContentMD5 + , hCacheControl + , hRange + , methodPut + , ok200 + , partialContent206 + , Proxy + , useProxy + , noProxy + , proxyEnvironment + , managerSetProxy + , formDataBody + , partFileRequestBody + , partBS + , partLBS ) where import Data.Aeson (FromJSON) @@ -21,9 +69,14 @@ import Data.Conduit (ConduitM, transPipe) import Data.Void (Void) import qualified Network.HTTP.Client -import Network.HTTP.Client (BodyReader, Manager, Request, Response) -import Network.HTTP.Simple (setRequestHeader) +import Network.HTTP.Client (BodyReader, Manager, Request, RequestBody(..), Response, Manager, HttpExceptionContent(..), parseRequest, parseRequest_, defaultRequest, getUri, path, checkResponse, parseUrlThrow, responseStatus, responseBody, useProxy, noProxy, proxyEnvironment, managerSetProxy, Proxy) +import Network.HTTP.Client.Internal (setUri) +import Network.HTTP.Simple (setRequestMethod, setRequestBody, setRequestHeader, addRequestHeader, setRequestManager, HttpException(..), getResponseBody, getResponseStatusCode, getResponseHeaders) +import Network.HTTP.Types (hAccept, hContentLength, hContentMD5, hCacheControl, hRange, methodPut, Header, HeaderName, ok200, partialContent206) +import Network.HTTP.Conduit (requestHeaders) +import Network.HTTP.Client.TLS (getGlobalManager, applyDigestAuth, displayDigestAuthException) import qualified Network.HTTP.Simple +import Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody, partBS, partLBS) import UnliftIO (MonadIO, MonadUnliftIO, withRunInIO, withUnliftIO, unliftIO) diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -324,29 +324,33 @@ -> ConfigureOpts -> Set GhcPkgId -- ^ dependencies -> Installed -- ^ library + -> [GhcPkgId] -- ^ sublibraries, in the GhcPkgId format -> Set Text -- ^ executables -> RIO env () -writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId exes = do +writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId sublibs exes = do mfile <- precompiledCacheFile loc copts depIDs forM_ mfile $ \file -> do ensureDir (parent file) ec <- view envConfigL let stackRootRelative = makeRelative (view stackRootL ec) - mlibpath <- - case mghcPkgId of - Executable _ -> return Nothing - Library _ ipid _ -> liftM Just $ do - ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf" - relPath <- stackRootRelative $ bcoSnapDB baseConfigOpts ipid' - return $ toFilePath relPath + mlibpath <- case mghcPkgId of + Executable _ -> return Nothing + Library _ ipid _ -> liftM Just $ pathFromPkgId stackRootRelative ipid + sublibpaths <- mapM (pathFromPkgId stackRootRelative) sublibs exes' <- forM (Set.toList exes) $ \exe -> do name <- parseRelFile $ T.unpack exe relPath <- stackRootRelative $ bcoSnapInstallRoot baseConfigOpts bindirSuffix name return $ toFilePath relPath $(versionedEncodeFile precompiledCacheVC) file PrecompiledCache { pcLibrary = mlibpath + , pcSubLibs = sublibpaths , pcExes = exes' } + where + pathFromPkgId stackRootRelative ipid = do + ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf" + relPath <- stackRootRelative $ bcoSnapDB baseConfigOpts ipid' + return $ toFilePath relPath -- | Check the cache for a precompiled package matching the given -- configuration. @@ -372,6 +376,7 @@ let mkAbs' = (toFilePath stackRoot FP.) return PrecompiledCache { pcLibrary = mkAbs' <$> pcLibrary pc0 + , pcSubLibs = mkAbs' <$> pcSubLibs pc0 , pcExes = mkAbs' <$> pcExes pc0 } diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -22,9 +22,11 @@ import Control.Monad.RWS.Strict hiding ((<>)) import Control.Monad.State.Strict (execState) import qualified Data.HashSet as HashSet +import qualified Data.HashMap.Strict as HashMap import Data.List import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map +import Data.Monoid.Map (MonoidMap(..)) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8, decodeUtf8With) @@ -38,8 +40,6 @@ import Stack.Build.Haddock import Stack.Build.Installed import Stack.Build.Source -import Stack.BuildPlan -import Stack.Config (getLocalPackages) import Stack.Constants import Stack.Package import Stack.PackageDump @@ -131,11 +131,10 @@ , baseConfigOpts :: !BaseConfigOpts , loadPackage :: !(PackageLocationIndex FilePath -> Map FlagName Bool -> [Text] -> M Package) , combinedMap :: !CombinedMap - , toolToPackages :: !(ExeName -> Map PackageName VersionRange) , ctxEnvConfig :: !EnvConfig , callStack :: ![PackageName] , extraToBuild :: !(Set PackageName) - , getVersions :: !(PackageName -> IO (Set Version)) + , getVersions :: !(PackageName -> IO (HashMap Version (Maybe CabalHash))) , wanted :: !(Set PackageName) , localNames :: !(Set PackageName) } @@ -185,13 +184,16 @@ constructPlan ls0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackage0 sourceMap installedMap initialBuildSteps = do logDebug "Constructing the build plan" + bconfig <- view buildConfigL + when (hasBaseInDeps bconfig) $ + prettyWarn $ flow "You are trying to upgrade/downgrade base, which is almost certainly not what you really want. Please, consider using another GHC version if you need a certain version of base, or removing base from extra-deps. See more at https://github.com/commercialhaskell/stack/issues/3940." <> line + econfig <- view envConfigL let onWanted = void . addDep False . packageName . lpPackage let inner = do mapM_ onWanted $ filter lpWanted locals mapM_ (addDep False) $ Set.toList extraToBuild0 - lp <- getLocalPackages - let ctx = mkCtx econfig lp + let ctx = mkCtx econfig ((), m, W efinals installExes dirtyReason deps warnings parents) <- liftIO $ runRWST inner ctx M.empty mapM_ (logWarn . RIO.display) (warnings []) @@ -223,17 +225,19 @@ else do planDebug $ show errs stackYaml <- view stackYamlL - prettyErrorNoIndent $ pprintExceptions errs stackYaml parents (wanted ctx) + stackRoot <- view stackRootL + prettyErrorNoIndent $ pprintExceptions errs stackYaml stackRoot parents (wanted ctx) throwM $ ConstructPlanFailed "Plan construction failed." where - mkCtx econfig lp = Ctx + hasBaseInDeps bconfig = + elem $(mkPackageName "base") + $ map (packageIdentifierName . pirIdent) [i | (PLIndex i) <- bcDependencies bconfig] + + mkCtx econfig = Ctx { ls = ls0 , baseConfigOpts = baseConfigOpts0 , loadPackage = \x y z -> runRIO econfig $ loadPackage0 x y z , combinedMap = combineMap sourceMap installedMap - , toolToPackages = \name -> - maybe Map.empty (Map.fromSet (const Cabal.anyVersion)) $ - Map.lookup name toolMap , ctxEnvConfig = econfig , callStack = [] , extraToBuild = extraToBuild0 @@ -241,8 +245,6 @@ , wanted = wantedLocalPackages locals <> extraToBuild0 , localNames = Set.fromList $ map (packageName . lpPackage) locals } - where - toolMap = getToolMap ls0 lp -- | State to be maintained during the calculation of local packages -- to unregister. @@ -365,13 +367,6 @@ } tell mempty { wFinals = Map.singleton (packageName package) res } --- | Is this package being used as a library, or just as a build tool? --- If the former, we need to ensure that a library actually --- exists. See --- -data DepType = AsLibrary | AsBuildTool - deriving (Show, Eq) - -- | Given a 'PackageName', adds all of the build tasks to build the -- package, if needed. -- @@ -613,11 +608,16 @@ addPackageDeps treatAsDep package = do ctx <- ask deps' <- packageDepsWithTools package - deps <- forM (Map.toList deps') $ \(depname, (range, depType)) -> do + deps <- forM (Map.toList deps') $ \(depname, DepValue range depType) -> do eres <- addDep treatAsDep depname - let getLatestApplicable = do - vs <- liftIO $ getVersions ctx depname - return (latestApplicableVersion range vs) + let getLatestApplicableVersionAndRev = do + vsAndRevs <- liftIO $ getVersions ctx depname + let vs = Set.fromList (HashMap.keys vsAndRevs) + case latestApplicableVersion range vs of + Nothing -> pure Nothing + Just lappVer -> do + let mlappRev = join (HashMap.lookup lappVer vsAndRevs) + pure $ (lappVer,) <$> mlappRev case eres of Left e -> do addParent depname range Nothing @@ -625,7 +625,7 @@ case e of UnknownPackage name -> assert (name == depname) NotInBuildPlan _ -> Couldn'tResolveItsDependencies (packageVersion package) - mlatestApplicable <- getLatestApplicable + mlatestApplicable <- getLatestApplicableVersionAndRev return $ Left (depname, (range, mlatestApplicable, bd)) Right adr | depType == AsLibrary && not (adrHasLibrary adr) -> return $ Left (depname, (range, Nothing, HasNoLibrary)) @@ -669,7 +669,7 @@ ADRFound loc (Library ident gid _) -> return $ Right (Set.empty, Map.singleton ident gid, loc) else do - mlatestApplicable <- getLatestApplicable + mlatestApplicable <- getLatestApplicableVersionAndRev return $ Left (depname, (range, mlatestApplicable, DependencyMismatch $ adrVersion adr)) case partitionEithers deps of -- Note that the Monoid for 'InstallLocation' means that if any @@ -701,8 +701,10 @@ TTFiles lp _ -> packageHasLibrary $ lpPackage lp TTIndex p _ _ -> packageHasLibrary p + -- make sure we consider internal libraries as libraries too packageHasLibrary :: Package -> Bool packageHasLibrary p = + not (Set.null (packageInternalLibraries p)) || case packageLibraries p of HasLibraries _ -> True NoLibraries -> False @@ -833,61 +835,32 @@ -- | Get all of the dependencies for a given package, including build -- tool dependencies. -packageDepsWithTools :: Package -> M (Map PackageName (VersionRange, DepType)) +packageDepsWithTools :: Package -> M (Map PackageName DepValue) packageDepsWithTools p = do - ctx <- ask - let toEither name mp = - case Map.toList mp of - [] -> Left (ToolWarning name (packageName p) Nothing) - [_] -> Right mp - ((x, _):(y, _):zs) -> - Left (ToolWarning name (packageName p) (Just (x, y, map fst zs))) - (warnings0, toolDeps) = - partitionEithers $ - map (\dep -> toEither dep (toolToPackages ctx dep)) (Map.keys (packageTools p)) -- Check whether the tool is on the PATH before warning about it. - warnings <- fmap catMaybes $ forM warnings0 $ \warning@(ToolWarning (ExeName toolName) _ _) -> do + warnings <- fmap catMaybes $ forM (Set.toList $ packageUnknownTools p) $ + \name@(ExeName toolName) -> do let settings = minimalEnvSettings { esIncludeLocals = True } config <- view configL menv <- liftIO $ configProcessContextSettings config settings mfound <- runRIO menv $ findExecutable $ T.unpack toolName case mfound of - Left _ -> return (Just warning) + Left _ -> return $ Just $ ToolWarning name (packageName p) Right _ -> return Nothing tell mempty { wWarnings = (map toolWarningText warnings ++) } - return $ Map.unionsWith - (\(vr1, dt1) (vr2, dt2) -> - ( intersectVersionRanges vr1 vr2 - , case dt1 of - AsLibrary -> AsLibrary - AsBuildTool -> dt2 - ) - ) - $ ((, AsLibrary) <$> packageDeps p) - : (Map.map (, AsBuildTool) <$> toolDeps) + return $ packageDeps p -- | Warn about tools in the snapshot definition. States the tool name --- expected, the package name using it, and found packages. If the --- last value is Nothing, it means the tool was not found --- anywhere. For a Just value, it was found in at least two packages. -data ToolWarning = ToolWarning ExeName PackageName (Maybe (PackageName, PackageName, [PackageName])) +-- expected and the package name using it. +data ToolWarning = ToolWarning ExeName PackageName deriving Show toolWarningText :: ToolWarning -> Text -toolWarningText (ToolWarning (ExeName toolName) pkgName Nothing) = +toolWarningText (ToolWarning (ExeName toolName) pkgName) = "No packages found in snapshot which provide a " <> T.pack (show toolName) <> " executable, which is a build-tool dependency of " <> T.pack (show (packageNameString pkgName)) -toolWarningText (ToolWarning (ExeName toolName) pkgName (Just (option1, option2, options))) = - "Multiple packages found in snapshot which provide a " <> - T.pack (show toolName) <> - " executable, which is a build-tool dependency of " <> - T.pack (show (packageNameString pkgName)) <> - ", so none will be installed.\n" <> - "Here's the list of packages which provide it: " <> - T.intercalate ", " (map packageNameText (option1:option2:options)) <> - "\nSince there's no good way to choose, you may need to install it manually." -- | Strip out anything from the @Plan@ intended for the local database stripLocals :: Plan -> Plan @@ -931,8 +904,9 @@ deriving instance Ord VersionRange --- | For display purposes only, Nothing if package not found -type LatestApplicableVersion = Maybe Version +-- | The latest applicable version and it's latest cabal file revision. +-- For display purposes only, Nothing if package not found +type LatestApplicableVersion = Maybe (Version, CabalHash) -- | Reason why a dependency was not used data BadDependency @@ -949,10 +923,11 @@ pprintExceptions :: [ConstructPlanException] -> Path Abs File + -> Path Abs Dir -> ParentMap -> Set PackageName -> AnsiDoc -pprintExceptions exceptions stackYaml parentMap wanted = +pprintExceptions exceptions stackYaml stackRoot parentMap wanted = mconcat $ [ flow "While constructing the build plan, the following exceptions were encountered:" , line <> line @@ -962,14 +937,24 @@ , line <> line ] ++ (if not onlyHasDependencyMismatches then [] else - [ " *" <+> align (flow "Set 'allow-newer: true' to ignore all version constraints and build anyway.") + [ " *" <+> align (flow "Set 'allow-newer: true' in " <+> toAnsiDoc (display (defaultUserConfigPath stackRoot)) <+> "to ignore all version constraints and build anyway.") , line <> line ] ) ++ [ " *" <+> align (flow "Consider trying 'stack solver', which uses the cabal-install solver to attempt to find some working build configuration. This can be convenient when dealing with many complicated constraint errors, but results may be unpredictable.") , line <> line - ] ++ - (if Map.null extras then [] else + ] ++ addExtraDepsRecommendations + + where + exceptions' = nubOrd exceptions + + addExtraDepsRecommendations + | Map.null extras = [] + | (Just _) <- Map.lookup $(mkPackageName "base") extras = + [ " *" <+> align (flow "Build requires unattainable version of base. Since base is a part of GHC, you most likely need to use a different GHC version with the matching base.") + , line + ] + | otherwise = [ " *" <+> align (styleRecommendation (flow "Recommended action:") <+> flow "try adding the following to your extra-deps in" <+> @@ -978,9 +963,6 @@ , vsep (map pprintExtra (Map.toList extras)) , line ] - ) - where - exceptions' = nubOrd exceptions extras = Map.unions $ map getExtras exceptions' getExtras DependencyCycleDetected{} = Map.empty @@ -989,13 +971,16 @@ Map.unions $ map go $ Map.toList m where -- TODO: Likely a good idea to distinguish these to the user. In particular, for DependencyMismatch - go (name, (_range, Just version, NotInBuildPlan)) = - Map.singleton name version - go (name, (_range, Just version, DependencyMismatch{})) = - Map.singleton name version + go (name, (_range, Just (version,cabalHash), NotInBuildPlan)) = + Map.singleton name (version,cabalHash) + go (name, (_range, Just (version,cabalHash), DependencyMismatch{})) = + Map.singleton name (version, cabalHash) go _ = Map.empty - pprintExtra (name, version) = - fromString (concat ["- ", packageNameString name, "-", versionString version]) + pprintExtra (name, (version, cabalHash)) = + let cfInfo = CFIHash Nothing cabalHash + packageId = PackageIdentifier name version + packageIdRev = PackageIdentifierRevision packageId cfInfo + in fromString $ packageIdentifierRevisionString packageIdRev allNotInBuildPlan = Set.fromList $ concatMap toNotInBuildPlan exceptions' toNotInBuildPlan (DependencyPlanFailures _ pDeps) = @@ -1076,11 +1061,11 @@ | isNothing mversion -> flow "(no package with that name found, perhaps there is a typo in a package's build-depends or an omission from the stack.yaml packages list?)" | otherwise -> "" - Just la - | mlatestApplicable == mversion -> softline <> + Just (laVer, _) + | Just laVer == mversion -> softline <> flow "(latest matching version is specified)" | otherwise -> softline <> - flow "(latest matching version is" <+> styleGood (display la) <> ")" + flow "(latest matching version is" <+> styleGood (display laVer) <> ")" -- | Get the shortest reason for the package to be in the build plan. In -- other words, trace the parent dependencies back to a 'wanted' @@ -1143,19 +1128,6 @@ , dpNameLength = dpNameLength dp + T.length (packageNameText (packageIdentifierName ident)) , dpPath = [ident] } - --- Utility newtype wrapper to make make Map's Monoid also use the --- element's Monoid. - -newtype MonoidMap k a = MonoidMap (Map k a) - deriving (Eq, Ord, Read, Show, Generic, Functor) - -instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where - MonoidMap mp1 <> MonoidMap mp2 = MonoidMap (M.unionWith (<>) mp1 mp2) - -instance (Ord k, Monoid a, Semigroup a) => Monoid (MonoidMap k a) where - mappend = (<>) - mempty = MonoidMap mempty -- Switch this to 'True' to enable some debugging putStrLn in this module planDebug :: MonadIO m => String -> m () diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} -- | Perform a build module Stack.Build.Execute ( printPlan @@ -875,6 +876,12 @@ ": " <> RIO.display x +-- | How we deal with output from GHC, either dumping to a log file or the +-- console (with some prefix). +data OutputType + = OTLogFile !(Path Abs File) !Handle + | OTConsole !Utf8Builder + -- | This sets up a context for executing build steps which need to run -- Cabal (via a compiled Setup.hs). In particular it does the following: -- @@ -901,15 +908,14 @@ -> (ExcludeTHLoading -> [String] -> RIO env ()) -- Function to run Cabal with args -> (Text -> RIO env ()) -- An 'announce' function, for different build phases - -> Bool -- Whether output should be directed to the console - -> Maybe (Path Abs File, Handle) -- Log file + -> OutputType -> RIO env a) -> RIO env a withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffix inner0 = withPackage $ \package cabalfp pkgDir -> - withLogFile pkgDir package $ \mlogFile -> - withCabal package pkgDir mlogFile $ \cabal -> - inner0 package cabalfp pkgDir cabal announce console mlogFile + withOutputType pkgDir package $ \outputType -> + withCabal package pkgDir outputType $ \cabal -> + inner0 package cabalfp pkgDir cabal announce outputType where announce = announceTask task @@ -944,8 +950,16 @@ let cabalfp = dir cabalfpRel inner package cabalfp dir - withLogFile pkgDir package inner - | console = inner Nothing + withOutputType pkgDir package inner + -- If the user requested interleaved output, dump to the console with a + -- prefix. + | boptsInterleavedOutput eeBuildOpts = inner $ OTConsole $ RIO.display (packageName package) <> "> " + + -- Not in interleaved mode. When building a single wanted package, dump + -- to the console with no prefix. + | console = inner $ OTConsole mempty + + -- Neither condition applies, dump to a file. | otherwise = do logPath <- buildLogPath package msuffix ensureDir (parent logPath) @@ -957,15 +971,15 @@ liftIO $ atomically $ writeTChan eeLogFiles (pkgDir, logPath) _ -> return () - withBinaryFile fp WriteMode $ \h -> inner (Just (logPath, h)) + withBinaryFile fp WriteMode $ \h -> inner $ OTLogFile logPath h withCabal :: Package -> Path Abs Dir - -> Maybe (Path Abs File, Handle) + -> OutputType -> ((ExcludeTHLoading -> [String] -> RIO env ()) -> RIO env a) -> RIO env a - withCabal package pkgDir mlogFile inner = do + withCabal package pkgDir outputType inner = do config <- view configL unless (configAllowDifferentUser config) $ @@ -1108,47 +1122,48 @@ runExe exeName fullArgs = do compilerVer <- view actualCompilerVersionL runAndOutput compilerVer `catch` \ece -> do - bss <- - case mlogFile of - Nothing -> return [] - Just (logFile, h) -> do + (mlogFile, bss) <- + case outputType of + OTConsole _ -> return (Nothing, []) + OTLogFile logFile h -> do liftIO $ hClose h - withSourceFile (toFilePath logFile) $ \src -> + fmap (Just logFile,) $ withSourceFile (toFilePath logFile) $ \src -> runConduit $ src .| CT.decodeUtf8Lenient .| mungeBuildOutput stripTHLoading makeAbsolute pkgDir compilerVer .| CL.consume - throwM $ SetupHsBuildFailure + throwM $ CabalExitedUnsuccessfully (eceExitCode ece) - (Just taskProvides) + taskProvides exeName fullArgs - (fmap fst mlogFile) + mlogFile bss where runAndOutput :: CompilerVersion 'CVActual -> RIO env () - runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $ withProcessContext menv $ case mlogFile of - Just (_, h) -> + runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $ withProcessContext menv $ case outputType of + OTLogFile _ h -> proc (toFilePath exeName) fullArgs $ runProcess_ . setStdin (byteStringInput "") . setStdout (useHandleOpen h) . setStderr (useHandleOpen h) - Nothing -> + OTConsole prefix -> void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs - (outputSink KeepTHLoading LevelWarn compilerVer) - (outputSink stripTHLoading LevelInfo compilerVer) + (outputSink KeepTHLoading LevelWarn compilerVer prefix) + (outputSink stripTHLoading LevelInfo compilerVer prefix) outputSink :: HasCallStack => ExcludeTHLoading -> LogLevel -> CompilerVersion 'CVActual + -> Utf8Builder -> ConduitM S.ByteString Void (RIO env) () - outputSink excludeTH level compilerVer = + outputSink excludeTH level compilerVer prefix = CT.decodeUtf8Lenient .| mungeBuildOutput excludeTH makeAbsolute pkgDir compilerVer - .| CL.mapM_ (logGeneric "" level . RIO.display) + .| CL.mapM_ (logGeneric "" level . (prefix <>) . RIO.display) -- If users want control, we should add a config option for this makeAbsolute :: ConvertPathsToAbsolute makeAbsolute = case stripTHLoading of @@ -1245,20 +1260,24 @@ where result = T.intercalate " + " $ concat [ ["lib" | taskAllInOne && hasLib] + , ["internal-lib" | taskAllInOne && hasSubLib] , ["exe" | taskAllInOne && hasExe] , ["test" | enableTests] , ["bench" | enableBenchmarks] ] - (hasLib, hasExe) = case taskType of + (hasLib, hasSubLib, hasExe) = case taskType of TTFiles lp Local -> - let hasLibrary = - case packageLibraries (lpPackage lp) of + let package = lpPackage lp + hasLibrary = + case packageLibraries package of NoLibraries -> False HasLibraries _ -> True - in (hasLibrary, not (Set.null (exesToBuild executableBuildStatuses lp))) + hasSubLibrary = not . Set.null $ packageInternalLibraries package + hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp + in (hasLibrary, hasSubLibrary, hasExecutables) -- This isn't true, but we don't want to have this info for -- upstream deps. - _ -> (False, False) + _ -> (False, False, False) getPrecompiled cache = case taskLocation task of @@ -1291,10 +1310,27 @@ return $ if b then Just pc else Nothing _ -> return Nothing - copyPreCompiled (PrecompiledCache mlib exes) = do + copyPreCompiled (PrecompiledCache mlib sublibs exes) = do wc <- view $ actualCompilerVersionL.whichCompilerL announceTask task "using precompiled package" - forM_ mlib $ \libpath -> do + + -- We need to copy .conf files for the main library and all sublibraries which exist in the cache, + -- from their old snapshot to the new one. However, we must unregister any such library in the new + -- snapshot, in case it was built with different flags. + let + subLibNames = map T.unpack . Set.toList $ case taskType of + TTFiles lp _ -> packageInternalLibraries $ lpPackage lp + TTIndex p _ _ -> packageInternalLibraries p + (name, version) = toTuple taskProvides + mainLibName = packageNameString name + mainLibVersion = versionString version + pkgName = mainLibName ++ "-" ++ mainLibVersion + -- z-package-z-internal for internal lib internal of package package + toCabalInternalLibName n = concat ["z-", mainLibName, "-z-", n, "-", mainLibVersion] + allToUnregister = map (const pkgName) (maybeToList mlib) ++ map toCabalInternalLibName subLibNames + allToRegister = maybeToList mlib ++ sublibs + + unless (null allToRegister) $ do withMVar eeInstallLock $ \() -> do -- We want to ignore the global and user databases. -- Unfortunately, ghc-pkg doesn't take such arguments on the @@ -1306,23 +1342,17 @@ (T.pack $ toFilePathNoTrailingSep $ bcoSnapDB eeBaseConfigOpts) withModifyEnvVars modifyEnv $ do - -- In case a build of the library with different flags already exists, unregister it - -- before copying. let ghcPkgExe = ghcPkgExeName wc - catchAny - (readProcessNull ghcPkgExe - [ "unregister" - , "--force" - , packageIdentifierString taskProvides - ]) + + -- first unregister everything that needs to be unregistered + forM_ allToUnregister $ \packageName -> catchAny + (readProcessNull ghcPkgExe [ "unregister", "--force", packageName]) (const (return ())) - void $ proc ghcPkgExe - [ "register" - , "--force" - , libpath - ] - readProcess_ + -- now, register the cached conf files + forM_ allToRegister $ \libpath -> + proc ghcPkgExe [ "register", "--force", libpath] readProcess_ + liftIO $ forM_ exes $ \exe -> do D.createDirectoryIfMissing True bindir let dst = bindir FP. FP.takeFileName exe @@ -1347,7 +1377,7 @@ bindir = toFilePath $ bcoSnapInstallRoot eeBaseConfigOpts bindirSuffix realConfigAndBuild cache allDepsMap = withSingleContext ac ee task (Just allDepsMap) Nothing - $ \package cabalfp pkgDir cabal announce _console _mlogFile -> do + $ \package cabalfp pkgDir cabal announce _outputType -> do executableBuildStatuses <- getExecutableBuildStatuses package pkgDir when (not (cabalIsSatisfied executableBuildStatuses) && taskIsTarget task) (logInfo @@ -1421,7 +1451,7 @@ unless (null warnings) $ prettyWarn $ "The following modules should be added to exposed-modules or other-modules in" <+> display cabalfp <> ":" <> line <> - indent 4 (mconcat $ map showModuleWarning warnings) <> + indent 4 (mconcat $ intersperse line $ map showModuleWarning warnings) <> line <> line <> "Missing modules in the cabal file are likely to cause undefined reference errors from the linker, along with other problems." @@ -1466,19 +1496,32 @@ ("Warning: haddock not generating hyperlinked sources because 'HsColour' not\n" <> "found on PATH (use 'stack install hscolour' to install).") return ["--hyperlink-source" | hscolourExists] + + -- For GHC 8.4 and later, provide the --quickjump option. + actualCompiler <- view actualCompilerVersionL + let quickjump = + case actualCompiler of + GhcVersion ghcVer + | ghcVer >= $(mkVersion "8.4") -> ["--haddock-option=--quickjump"] + _ -> [] + cabal KeepTHLoading $ concat [ ["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"] , sourceFlag , ["--internal" | boptsHaddockInternal eeBuildOpts] , [ "--haddock-option=" <> opt | opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ] + , quickjump ] let hasLibrary = case packageLibraries package of NoLibraries -> False HasLibraries _ -> True - shouldCopy = not isFinalBuild && (hasLibrary || not (Set.null (packageExes package))) + packageHasComponentSet f = not $ Set.null $ f package + hasInternalLibrary = packageHasComponentSet packageInternalLibraries + hasExecutables = packageHasComponentSet packageExes + shouldCopy = not isFinalBuild && (hasLibrary || hasInternalLibrary || hasExecutables) when shouldCopy $ withMVar eeInstallLock $ \() -> do announce "copy/register" eres <- try $ cabal KeepTHLoading ["copy"] @@ -1497,15 +1540,24 @@ ( bcoLocalDB eeBaseConfigOpts , eeLocalDumpPkgs ) let ident = PackageIdentifier (packageName package) (packageVersion package) - mpkgid <- case packageLibraries package of + -- only return the sublibs to cache them if we also cache the main lib (that is, if it exists) + (mpkgid, sublibsPkgIds) <- case packageLibraries package of HasLibraries _ -> do + sublibsPkgIds <- fmap catMaybes $ + forM (Set.toList $ packageInternalLibraries package) $ \sublib -> do + -- z-haddock-library-z-attoparsec for internal lib attoparsec of haddock-library + let sublibName = T.concat ["z-", packageNameText $ packageName package, "-z-", sublib] + case parsePackageName sublibName of + Nothing -> return Nothing -- invalid lib, ignored + Just subLibName -> loadInstalledPkg wc [installedPkgDb] installedDumpPkgsTVar subLibName + mpkgid <- loadInstalledPkg wc [installedPkgDb] installedDumpPkgsTVar (packageName package) case mpkgid of Nothing -> throwM $ Couldn'tFindPkgId $ packageName package - Just pkgid -> return $ Library ident pkgid Nothing + Just pkgid -> return (Library ident pkgid Nothing, sublibsPkgIds) NoLibraries -> do markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache? - return $ Executable ident + return (Executable ident, []) -- don't return sublibs in this case case taskLocation task of Snap -> @@ -1514,7 +1566,7 @@ (ttPackageLocation taskType) (configCacheOpts cache) (configCacheDeps cache) - mpkgid (packageExes package) + mpkgid sublibsPkgIds (packageExes package) _ -> return () case taskType of @@ -1627,7 +1679,7 @@ -- FIXME: Since this doesn't use cabal, we should be able to avoid using a -- fullblown 'withSingleContext'. (allDepsMap, _cache) <- getConfigCache ee task installedMap True False - withSingleContext ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce _console mlogFile -> do + withSingleContext ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce outputType -> do config <- view configL let needHpc = toCoverage topts @@ -1697,15 +1749,17 @@ -- Clear "Progress: ..." message before -- redirecting output. - when (isNothing mlogFile) $ do + case outputType of + OTConsole _ -> do logStickyDone "" liftIO $ hFlush stdout liftIO $ hFlush stderr + OTLogFile _ _ -> pure () let output setter = - case mlogFile of - Nothing -> id - Just (_, h) -> setter (useHandleOpen h) + case outputType of + OTConsole _ -> id + OTLogFile _ h -> setter (useHandleOpen h) ec <- withWorkingDir (toFilePath pkgDir) $ proc (toFilePath exePath) args $ \pc0 -> do @@ -1721,7 +1775,9 @@ waitExitCode p -- Add a trailing newline, incase the test -- output didn't finish with a newline. - when (isNothing mlogFile) (logInfo "") + case outputType of + OTConsole _ -> logInfo "" + OTLogFile _ _ -> pure () -- Move the .tix file out of the package -- directory into the hpc work dir, for -- tidiness. @@ -1752,16 +1808,18 @@ generateHpcReport pkgDir package testsToRun' bs <- liftIO $ - case mlogFile of - Nothing -> return "" - Just (logFile, h) -> do + case outputType of + OTConsole _ -> return "" + OTLogFile logFile h -> do hClose h S.readFile $ toFilePath logFile unless (Map.null errs) $ throwM $ TestSuiteFailure (taskProvides task) errs - (fmap fst mlogFile) + (case outputType of + OTLogFile fp _ -> Just fp + OTConsole _ -> Nothing) bs setTestSuccess pkgDir @@ -1777,7 +1835,7 @@ -> RIO env () singleBench beopts benchesToRun ac ee task installedMap = do (allDepsMap, _cache) <- getConfigCache ee task installedMap False True - withSingleContext ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _console _mlogFile -> do + withSingleContext ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _outputType -> do let args = map T.unpack benchesToRun <> maybe [] ((:[]) . ("--benchmark-options=" <>)) (beoAdditionalArgs beopts) @@ -1899,19 +1957,22 @@ else return [optsFlag, baseOpts] --- Library and executable build components. +-- Library, internal and foreign libraries and executable build components. primaryComponentOptions :: Map Text ExecutableBuildStatus -> LocalPackage -> [String] primaryComponentOptions executableBuildStatuses lp = -- TODO: get this information from target parsing instead, -- which will allow users to turn off library building if -- desired - (case packageLibraries (lpPackage lp) of + (case packageLibraries package of NoLibraries -> [] HasLibraries names -> map T.unpack - $ T.append "lib:" (packageNameText (packageName (lpPackage lp))) + $ T.append "lib:" (packageNameText (packageName package)) : map (T.append "flib:") (Set.toList names)) ++ + map (T.unpack . T.append "lib:") (Set.toList $ packageInternalLibraries package) ++ map (T.unpack . T.append "exe:") (Set.toList $ exesToBuild executableBuildStatuses lp) + where + package = lpPackage lp -- | History of this function: -- diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs --- a/src/Stack/Build/Installed.hs +++ b/src/Stack/Build/Installed.hs @@ -16,7 +16,6 @@ import qualified Data.Foldable as F import qualified Data.HashSet as HashSet import Data.List -import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import Path import Stack.Build.Cache @@ -75,7 +74,7 @@ loadDatabase' (Just (InstalledTo Snap, snapDBPath)) installedLibs1 (installedLibs3, localDumpPkgs) <- loadDatabase' (Just (InstalledTo Local, localDBPath)) installedLibs2 - let installedLibs = M.fromList $ map lhPair installedLibs3 + let installedLibs = Map.fromList $ map lhPair installedLibs3 F.forM_ mcache $ \cache -> do icache <- configInstalledCache diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -214,7 +214,9 @@ case packageLibraries pkg of NoLibraries -> False HasLibraries _ -> True - in hasLibrary || not (Set.null nonLibComponents) + in hasLibrary + || not (Set.null nonLibComponents) + || not (Set.null $ packageInternalLibraries pkg) filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts)) @@ -284,8 +286,8 @@ return LocalPackage { lpPackage = pkg - , lpTestDeps = packageDeps testpkg - , lpBenchDeps = packageDeps benchpkg + , lpTestDeps = dvVersionRange <$> packageDeps testpkg + , lpBenchDeps = dvVersionRange <$> packageDeps benchpkg , lpTestBench = btpkg , lpComponentFiles = componentFiles , lpForceDirty = boptsForceDirty bopts @@ -437,7 +439,8 @@ getPackageFilesForTargets pkg cabalFP nonLibComponents = do (components',compFiles,otherFiles,warnings) <- getPackageFiles (packageFiles pkg) cabalFP - let components = M.keysSet components' `Set.union` nonLibComponents + let necessaryComponents = Set.insert CLib $ Set.filter isCInternalLib (M.keysSet components') + components = necessaryComponents `Set.union` nonLibComponents componentsFiles = M.map (\files -> Set.union otherFiles (Set.map dotCabalGetPath files)) $ M.filterWithKey (\component _ -> component `Set.member` components) compFiles diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -71,6 +71,7 @@ ) where import Stack.Prelude +import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T @@ -342,7 +343,7 @@ } where getLatestVersion pn = - fmap fst . Set.maxView <$> getPackageVersions pn + fmap fst . Set.maxView . Set.fromList . HashMap.keys <$> getPackageVersions pn go (RTPackageIdentifier ident@(PackageIdentifier name version)) | Map.member name locals = return $ Left $ T.concat diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -20,7 +20,6 @@ , gpdPackages , removeSrcPkgDefaultFlags , selectBestSnapshot - , getToolMap , showItems ) where @@ -36,10 +35,8 @@ import qualified Distribution.Package as C import Distribution.PackageDescription (GenericPackageDescription, flagDefault, flagManual, - flagName, genPackageFlags, - condExecutables) + flagName, genPackageFlags) import qualified Distribution.PackageDescription as C -import qualified Distribution.Types.UnqualComponentName as C import Distribution.System (Platform) import Distribution.Text (display) import qualified Distribution.Version as C @@ -49,7 +46,6 @@ import Stack.Snapshot import Stack.Types.BuildPlan import Stack.Types.FlagName -import Stack.Types.NamedComponent import Stack.Types.PackageIdentifier import Stack.Types.PackageName import Stack.Types.Version @@ -144,47 +140,6 @@ "Failed to load custom snapshot at " ++ T.unpack url ++ ", because no 'compiler' or 'resolver' is specified." - --- | Map from tool name to package providing it. This accounts for --- both snapshot and local packages (deps and project packages). -getToolMap :: LoadedSnapshot - -> LocalPackages - -> Map ExeName (Set PackageName) -getToolMap ls locals = - - {- We no longer do this, following discussion at: - - https://github.com/commercialhaskell/stack/issues/308#issuecomment-112076704 - - -- First grab all of the package names, for times where a build tool is - -- identified by package name - $ Map.fromList (map (packageNameByteString &&& Set.singleton) (Map.keys ps)) - -} - - Map.unionsWith Set.union $ concat - [ concatMap goSnap $ Map.toList $ lsPackages ls - , concatMap goLocalProj $ Map.toList $ lpProject locals - , concatMap goLocalDep $ Map.toList $ lpDependencies locals - ] - where - goSnap (pname, lpi) = - map (flip Map.singleton (Set.singleton pname)) - $ Set.toList - $ lpiProvidedExes lpi - - goLocalProj (pname, lpv) = - map (flip Map.singleton (Set.singleton pname)) - [ExeName t | CExe t <- Set.toList (lpvComponents lpv)] - - goLocalDep (pname, (gpd, _loc)) = - map (flip Map.singleton (Set.singleton pname)) - $ gpdExes gpd - - -- TODO consider doing buildable checking. Not a big deal though: - -- worse case scenario is we build an extra package that wasn't - -- strictly needed. - gpdExes :: GenericPackageDescription -> [ExeName] - gpdExes = map (ExeName . T.pack . C.unUnqualComponentName . fst) . condExecutables gpdPackages :: [GenericPackageDescription] -> Map PackageName Version gpdPackages gpds = Map.fromList $ diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -51,8 +51,11 @@ import Stack.Prelude import Data.Aeson.Extended import qualified Data.ByteString as S +import Data.Coerce (coerce) import qualified Data.IntMap as IntMap import qualified Data.Map as Map +import qualified Data.Monoid +import Data.Monoid.Map (MonoidMap(..)) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Yaml as Yaml @@ -62,9 +65,7 @@ import Distribution.Version (simplifyVersionRange, mkVersion') import GHC.Conc (getNumProcessors) import Lens.Micro (lens, set) -import Network.HTTP.Client (parseUrlThrow) -import Network.HTTP.StackClient (httpJSON) -import Network.HTTP.Simple (getResponseBody) +import Network.HTTP.StackClient (httpJSON, parseUrlThrow, getResponseBody) import Options.Applicative (Parser, strOption, long, help) import Path import Path.Extra (toFilePathNoTrailingSep) @@ -360,8 +361,8 @@ let configTemplateParams = configMonoidTemplateParameters configScmInit = getFirst configMonoidScmInit - configGhcOptionsByName = configMonoidGhcOptionsByName - configGhcOptionsByCat = configMonoidGhcOptionsByCat + configGhcOptionsByName = coerce configMonoidGhcOptionsByName + configGhcOptionsByCat = coerce configMonoidGhcOptionsByCat configSetupInfoLocations = configMonoidSetupInfoLocations configPvpBounds = fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds configModifyCodePage = fromFirst True configMonoidModifyCodePage @@ -372,6 +373,7 @@ configDefaultTemplate = getFirst configMonoidDefaultTemplate configDumpLogs = fromFirst DumpWarningLogs configMonoidDumpLogs configSaveHackageCreds = fromFirst True configMonoidSaveHackageCreds + configHackageBaseUrl = fromFirst "https://hackage.haskell.org/" configMonoidHackageBaseUrl clIgnoreRevisionMismatch = fromFirst False configMonoidIgnoreRevisionMismatch configAllowDifferentUser <- @@ -964,4 +966,5 @@ , "# author-email:" , "# copyright:" , "# github-username:" + , "" ] diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs --- a/src/Stack/Config/Build.hs +++ b/src/Stack/Config/Build.hs @@ -72,6 +72,9 @@ (boptsSplitObjs defaultBuildOpts) buildMonoidSplitObjs , boptsSkipComponents = buildMonoidSkipComponents + , boptsInterleavedOutput = fromFirst + (boptsInterleavedOutput defaultBuildOpts) + buildMonoidInterleavedOutput } where -- These options are not directly used in bopts, instead they diff --git a/src/Stack/Config/Nix.hs b/src/Stack/Config/Nix.hs --- a/src/Stack/Config/Nix.hs +++ b/src/Stack/Config/Nix.hs @@ -27,8 +27,7 @@ -> OS -> RIO env NixOpts nixOptsFromMonoid NixOptsMonoid{..} os = do - let nixEnable0 = fromFirst False nixMonoidEnable - defaultPure = case os of + let defaultPure = case os of OSX -> False _ -> True nixPureShell = fromFirst defaultPure nixMonoidPureShell @@ -38,14 +37,14 @@ ++ prefixAll (T.pack "-I") (fromFirst [] nixMonoidPath) nixAddGCRoots = fromFirst False nixMonoidAddGCRoots + -- Enable Nix-mode by default on NixOS, unless Docker-mode was specified osIsNixOS <- isNixOS + let nixEnable0 = fromFirst osIsNixOS nixMonoidEnable + nixEnable <- case () of _ | nixEnable0 && osIsWindows -> do logInfo "Note: Disabling nix integration, since this is being run in Windows" return False - | not nixEnable0 && osIsNixOS -> do - logInfo "Note: Enabling Nix integration, as it is required under NixOS" - return True | otherwise -> return nixEnable0 when (not (null nixPackages) && isJust nixInitFile) $ @@ -56,23 +55,28 @@ nixCompiler :: CompilerVersion a -> Either StringException T.Text nixCompiler compilerVersion = - let -- These are the latest minor versions for each respective major version available in nixpkgs - fixMinor "8.2" = "8.2.1" - fixMinor "8.0" = "8.0.2" - fixMinor "7.10" = "7.10.3" - fixMinor "7.8" = "7.8.4" - fixMinor "7.6" = "7.6.3" - fixMinor "7.4" = "7.4.2" - fixMinor "7.2" = "7.2.2" - fixMinor "6.12" = "6.12.3" - fixMinor "6.10" = "6.10.4" - fixMinor v = v - nixCompilerFromVersion v = T.append (T.pack "haskell.compiler.ghc") - (T.filter (/= '.') - (fixMinor (versionText v))) - in case compilerVersion of - GhcVersion v -> Right $ nixCompilerFromVersion v - _ -> Left $ stringException "Only GHC is supported by stack --nix" + case compilerVersion of + GhcVersion version -> + case T.split (== '.') (versionText version) of + x : y : minor -> + Right $ + case minor of + [] -> + -- The minor version is not specified. Select the latest minor + -- version in Nixpkgs corresponding to the requested major + -- version. + let major = T.concat [x, y] in + "(let compilers = builtins.filter \ + \(name: builtins.match \ + \\"ghc" <> major <> "[[:digit:]]*\" name != null) \ + \(lib.attrNames haskell.compiler); in \ + \if compilers == [] \ + \then abort \"No compiler found for GHC " + <> versionText version <> "\"\ + \else haskell.compiler.${builtins.head compilers})" + _ -> "haskell.compiler.ghc" <> T.concat (x : y : minor) + _ -> Left $ stringException "GHC major version not specified" + _ -> Left $ stringException "Only GHC is supported by stack --nix" -- Exceptions thown specifically by Stack.Nix data StackNixException diff --git a/src/Stack/Constants/Config.hs b/src/Stack/Constants/Config.hs --- a/src/Stack/Constants/Config.hs +++ b/src/Stack/Constants/Config.hs @@ -15,6 +15,7 @@ , hpcRelativeDir , hpcDirFromDir , objectInterfaceDirL + , ghciDirL , templatesDir ) where @@ -32,11 +33,18 @@ root = view projectRootL env in root workDir $(mkRelDir "odir/") +-- | GHCi files directory. +ghciDirL :: HasBuildConfig env => Getting r env (Path Abs Dir) +ghciDirL = to $ \env -> -- FIXME is this idomatic lens code? + let workDir = view workDirL env + root = view projectRootL env + in root workDir $(mkRelDir "ghci/") + -- | The directory containing the files used for dirtiness check of source files. buildCachesDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory. -> m (Path Abs Dir) -buildCachesDir dir = +buildCachesDir dir = liftM ( $(mkRelDir "stack-build-caches")) (distDirFromDir dir) diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -7,6 +7,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + -- | Generate HPC (Haskell Program Coverage) reports module Stack.Coverage ( deleteHpcReports @@ -23,6 +25,7 @@ import qualified Data.ByteString.Lazy as BL import Data.List import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT @@ -106,23 +109,24 @@ case packageLibraries package of NoLibraries -> False HasLibraries _ -> True + internalLibs = packageInternalLibraries package eincludeName <- -- Pre-7.8 uses plain PKG-version in tix files. - if ghcVersion < $(mkVersion "7.10") then return $ Right $ Just pkgId + if ghcVersion < $(mkVersion "7.10") then return $ Right $ Just [pkgId] -- We don't expect to find a package key if there is no library. - else if not hasLibrary then return $ Right Nothing + else if not hasLibrary && Set.null internalLibs then return $ Right Nothing -- Look in the inplace DB for the package key. -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986 else do -- GHC 8.0 uses package id instead of package key. -- See https://github.com/commercialhaskell/stack/issues/2424 let hpcNameField = if ghcVersion >= $(mkVersion "8.0") then "id" else "key" - eincludeName <- findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) hpcNameField + eincludeName <- findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) internalLibs hpcNameField case eincludeName of Left err -> do logError $ RIO.display err return $ Left err - Right includeName -> return $ Right $ Just $ T.unpack includeName + Right includeNames -> return $ Right $ Just $ map T.unpack includeNames forM_ tests $ \testName -> do tixSrc <- tixFilePath (packageName package) (T.unpack testName) let report = "coverage report for " <> pkgName <> "'s test-suite \"" <> testName <> "\"" @@ -133,7 +137,7 @@ -- #634 - this will likely be customizable in the future) Right mincludeName -> do let extraArgs = case mincludeName of - Just includeName -> ["--include", includeName ++ ":"] + Just includeNames -> "--include" : intersperse "--include" (map (\n -> n ++ ":") includeNames) Nothing -> [] mreportPath <- generateHpcReportInternal tixSrc reportDir report extraArgs extraArgs forM_ mreportPath (displayReportPath report . display) @@ -168,13 +172,13 @@ -- Look for index files in the correct dir (relative to each pkgdir). ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"] logInfo $ "Generating " <> RIO.display report - outputLines <- liftM (map (S8.filter (/= '\r')) . S8.lines . BL.toStrict) $ + outputLines <- liftM (map (S8.filter (/= '\r')) . S8.lines . BL.toStrict . fst) $ proc "hpc" ( "report" : toFilePath tixSrc : (args ++ extraReportArgs) ) - readProcessStdout_ + readProcess_ if all ("(0/0)" `S8.isSuffixOf`) outputLines then do let msg html = @@ -202,7 +206,7 @@ : ("--destdir=" ++ toFilePathNoTrailingSep reportDir) : (args ++ extraMarkupArgs) ) - readProcessStdout_ + readProcess_ return (Just reportPath) data HpcReportOpts = HpcReportOpts @@ -425,9 +429,9 @@ findPackageFieldForBuiltPackage :: HasEnvConfig env - => Path Abs Dir -> PackageIdentifier -> Text - -> RIO env (Either Text Text) -findPackageFieldForBuiltPackage pkgDir pkgId field = do + => Path Abs Dir -> PackageIdentifier -> Set.Set Text -> Text + -> RIO env (Either Text [Text]) +findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do distDir <- distDirFromDir pkgDir let inplaceDir = distDir $(mkRelDir "package.conf.inplace") pkgIdStr = packageIdentifierString pkgId @@ -440,20 +444,42 @@ cabalVer <- view cabalVersionL if cabalVer < $(mkVersion "1.24") then do + -- here we don't need to handle internal libs path <- liftM (inplaceDir ) $ parseRelFile (pkgIdStr ++ "-inplace.conf") logDebug $ "Parsing config in Cabal < 1.24 location: " <> fromString (toFilePath path) exists <- doesFileExist path - if exists then extractField path else notFoundErr + if exists then fmap (:[]) <$> extractField path else notFoundErr else do -- With Cabal-1.24, it's in a different location. logDebug $ "Scanning " <> fromString (toFilePath inplaceDir) <> " for files matching " <> fromString pkgIdStr (_, files) <- handleIO (const $ return ([], [])) $ listDir inplaceDir logDebug $ displayShow files - case mapMaybe (\file -> fmap (const file) . (T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-"))) - . T.pack . toFilePath . filename $ file) files of + -- From all the files obtained from the scanning process above, we + -- need to identify which are .conf files and then ensure that + -- there is at most one .conf file for each library and internal + -- library (some might be missing if that component has not been + -- built yet). We should error if there are more than one .conf + -- file for a component or if there are no .conf files at all in + -- the searched location. + let toFilename = T.pack . toFilePath . filename + -- strip known prefix and suffix from the found files to determine only the conf files + stripKnown = T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-")) + stripped = mapMaybe (\file -> fmap (,file) . stripKnown . toFilename $ file) files + -- which component could have generated each of these conf files + stripHash n = let z = T.dropWhile (/= '-') n in if T.null z then "" else T.tail z + matchedComponents = map (\(n, f) -> (stripHash n, [f])) stripped + byComponents = Map.restrictKeys (Map.fromListWith (++) matchedComponents) $ Set.insert "" internalLibs + logDebug $ displayShow byComponents + if Map.null $ Map.filter (\fs -> length fs > 1) byComponents + then case concat $ Map.elems byComponents of [] -> notFoundErr - [path] -> extractField path - _ -> return $ Left $ "Multiple files matching " <> T.pack (pkgIdStr ++ "-*.conf") <> " found in " <> + -- for each of these files, we need to extract the requested field + paths -> do + (errors, keys) <- partitionEithers <$> traverse extractField paths + case errors of + (a:_) -> return $ Left a -- the first error only, since they're repeated anyway + [] -> return $ Right keys + else return $ Left $ "Multiple files matching " <> T.pack (pkgIdStr ++ "-*.conf") <> " found in " <> T.pack (toFilePath inplaceDir) <> ". Maybe try 'stack clean' on this package?" displayReportPath :: (HasRunner env) diff --git a/src/Stack/Docker.hs b/src/Stack/Docker.hs --- a/src/Stack/Docker.hs +++ b/src/Stack/Docker.hs @@ -243,8 +243,8 @@ (env,isStdinTerminal,isStderrTerminal,homeDir) <- liftIO $ (,,,) <$> getEnvironment - <*> hIsTerminalDevice stdin - <*> hIsTerminalDevice stderr + <*> hIsTerminalDeviceOrMinTTY stdin + <*> hIsTerminalDeviceOrMinTTY stderr <*> (parseAbsDir =<< getHomeDirectory) isStdoutTerminal <- view terminalL let dockerHost = lookup "DOCKER_HOST" env diff --git a/src/Stack/Fetch.hs b/src/Stack/Fetch.hs --- a/src/Stack/Fetch.hs +++ b/src/Stack/Fetch.hs @@ -377,9 +377,13 @@ -> RIO env (Maybe ByteString) lookupPackageIdentifierExact identRev cache = do cl <- view cabalLoaderL - forM (lookupResolvedPackage cl identRev cache) $ \rp -> do - [bs] <- withCabalFiles (indexName (rpIndex rp)) [(rp, ())] $ \_ _ bs -> return bs - return bs + case lookupResolvedPackage cl identRev cache of + Nothing -> return Nothing + Just rp -> do + bss <- withCabalFiles (indexName (rpIndex rp)) [(rp, ())] $ \_ _ bs -> return bs + case bss of + [bs] -> return (Just bs) + _ -> return Nothing data FuzzyResults = FRNameNotFound !(Maybe (NonEmpty T.Text)) diff --git a/src/Stack/FileWatch.hs b/src/Stack/FileWatch.hs --- a/src/Stack/FileWatch.hs +++ b/src/Stack/FileWatch.hs @@ -35,7 +35,7 @@ -> IO () fileWatchConf cfg out inner = withManagerConf cfg $ \manager -> do let putLn = hPutStrLn out - outputIsTerminal <- hIsTerminalDevice out + outputIsTerminal <- hIsTerminalDeviceOrMinTTY out let withColor color str = putLn $ do if outputIsTerminal then concat [color, str, reset] diff --git a/src/Stack/GhcPkg.hs b/src/Stack/GhcPkg.hs --- a/src/Stack/GhcPkg.hs +++ b/src/Stack/GhcPkg.hs @@ -71,9 +71,9 @@ go Right _ -> return eres where - go = fmap (fmap BL.toStrict) - $ tryAny - $ proc (ghcPkgExeName wc) args' readProcessStdout_ + go = tryAny + $ BL.toStrict . fst + <$> proc (ghcPkgExeName wc) args' readProcess_ args' = packageDbFlags pkgDbs ++ args -- | Create a package database in the given directory, if it doesn't exist. @@ -102,7 +102,7 @@ ensureDir (parent db) return ["init", toFilePath db] void $ proc (ghcPkgExeName wc) args $ \pc -> - readProcessStdout_ pc `onException` + readProcess_ pc `onException` logError ("Unable to create package database at " <> fromString (toFilePath db)) -- | Get the name to use for "ghc-pkg", given the compiler version. diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -51,7 +51,7 @@ import Stack.Types.PackageIdentifier import Stack.Types.PackageName import Stack.Types.Runner -import System.IO (putStrLn, putStr, getLine) +import System.IO (putStrLn) import System.IO.Temp (getCanonicalTemporaryDirectory) #ifndef WINDOWS @@ -87,6 +87,13 @@ , ghciPkgPackage :: !Package } deriving Show +-- | Loaded package description and related info. +data GhciPkgDesc = GhciPkgDesc + { ghciDescPkg :: !Package + , ghciDescCabalFp :: !(Path Abs File) + , ghciDescTarget :: !Target + } + -- Mapping from a module name to a map with all of the paths that use -- that name. Each of those paths is associated with a set of components -- that contain it. Purpose of this complex structure is for use in @@ -154,15 +161,31 @@ nonLocalTargets <- getAllNonLocalTargets inputTargets -- Check if additional package arguments are sensible. addPkgs <- checkAdditionalPackages ghciAdditionalPackages + -- Load package descriptions. + pkgDescs <- loadGhciPkgDescs buildOptsCLI localTargets + -- If necessary, ask user about which main module to load. + bopts <- view buildOptsL + mainFile <- + if ghciNoLoadModules + then return Nothing + else do + -- Figure out package files, in order to ask the user + -- about which main module to load. See the note below for + -- why this is done again after the build. This could + -- potentially be done more efficiently, because all we + -- need is the location of main modules, not the rest. + pkgs0 <- getGhciPkgInfos sourceMap addPkgs (fmap fst mfileTargets) pkgDescs + figureOutMainFile bopts mainIsTargets localTargets pkgs0 -- Build required dependencies and setup local packages. stackYaml <- view stackYamlL buildDepsAndInitialSteps opts (map (packageNameText . fst) localTargets) targetWarnings stackYaml localTargets nonLocalTargets mfileTargets - -- Load the list of modules _after_ building, to catch changes in unlisted dependencies (#1180) - pkgs <- getGhciPkgInfos buildOptsCLI sourceMap addPkgs (fmap fst mfileTargets) localTargets + -- Load the list of modules _after_ building, to catch changes in + -- unlisted dependencies (#1180) + pkgs <- getGhciPkgInfos sourceMap addPkgs (fmap fst mfileTargets) pkgDescs checkForIssues pkgs -- Finally, do the invocation of ghci - runGhci opts localTargets mainIsTargets pkgs (maybe [] snd mfileTargets) (nonLocalTargets ++ addPkgs) + runGhci opts localTargets mainFile pkgs (maybe [] snd mfileTargets) (nonLocalTargets ++ addPkgs) preprocessTargets :: HasEnvConfig env => BuildOptsCLI -> [Text] -> RIO env (Either [Path Abs File] (Map PackageName Target)) preprocessTargets buildOptsCLI rawTargets = do @@ -321,12 +344,12 @@ :: HasEnvConfig env => GhciOpts -> [(PackageName, (Path Abs File, Target))] - -> Maybe (Map PackageName Target) + -> Maybe (Path Abs File) -> [GhciPkgInfo] -> [Path Abs File] -> [PackageName] -> RIO env () -runGhci GhciOpts{..} targets mainIsTargets pkgs extraFiles exposePackages = do +runGhci GhciOpts{..} targets mainFile pkgs extraFiles exposePackages = do config <- view configL wc <- view $ actualCompilerVersionL.whichCompilerL let pkgopts = hidePkgOpts ++ genOpts ++ ghcOpts @@ -398,20 +421,20 @@ tmpDirectory <- ( $(mkRelDir "haskell-stack-ghci")) <$> (parseAbsDir =<< liftIO getCanonicalTemporaryDirectory) + ghciDir <- view ghciDirL + ensureDir ghciDir ensureDir tmpDirectory - macrosOptions <- writeMacrosFile tmpDirectory pkgs + macrosOptions <- writeMacrosFile ghciDir pkgs if ghciNoLoadModules then execGhci macrosOptions else do checkForDuplicateModules pkgs isIntero <- checkIsIntero - bopts <- view buildOptsL - mainFile <- figureOutMainFile bopts mainIsTargets targets pkgs scriptOptions <- writeGhciScript tmpDirectory (renderScript isIntero pkgs mainFile ghciOnlyMain extraFiles) execGhci (macrosOptions ++ scriptOptions) writeMacrosFile :: HasRunner env => Path Abs Dir -> [GhciPkgInfo] -> RIO env [String] -writeMacrosFile tmpDirectory pkgs = do +writeMacrosFile outputDirectory pkgs = do fps <- fmap (nubOrd . catMaybes . concat) $ forM pkgs $ \pkg -> forM (ghciPkgOpts pkg) $ \(_, bio) -> do let cabalMacros = bioCabalMacros bio @@ -423,22 +446,22 @@ return Nothing files <- liftIO $ mapM (S8.readFile . toFilePath) fps if null files then return [] else do - out <- liftIO $ writeHashedFile tmpDirectory $(mkRelFile "cabal_macros.h") $ + out <- liftIO $ writeHashedFile outputDirectory $(mkRelFile "cabal_macros.h") $ S8.concat $ map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files return ["-optP-include", "-optP" <> toFilePath out] writeGhciScript :: (MonadIO m) => Path Abs Dir -> GhciScript -> m [String] -writeGhciScript tmpDirectory script = do - scriptPath <- liftIO $ writeHashedFile tmpDirectory $(mkRelFile "ghci-script") $ +writeGhciScript outputDirectory script = do + scriptPath <- liftIO $ writeHashedFile outputDirectory $(mkRelFile "ghci-script") $ LBS.toStrict $ scriptToLazyByteString script let scriptFilePath = toFilePath scriptPath setScriptPerms scriptFilePath return ["-ghci-script=" <> scriptFilePath] writeHashedFile :: Path Abs Dir -> Path Rel File -> ByteString -> IO (Path Abs File) -writeHashedFile tmpDirectory relFile contents = do +writeHashedFile outputDirectory relFile contents = do relSha <- shaPathForBytes contents - let outDir = tmpDirectory relSha + let outDir = outputDirectory relSha outFile = outDir relFile alreadyExists <- doesFileExist outFile unless alreadyExists $ do @@ -472,9 +495,8 @@ getFileTargets :: [GhciPkgInfo] -> [Path Abs File] getFileTargets = concatMap (concatMap S.toList . maybeToList . ghciPkgTargetFiles) --- | Figure out the main-is file to load based on the targets. Sometimes there --- is none, sometimes it's unambiguous, sometimes it's --- ambiguous. Warns and returns nothing if it's ambiguous. +-- | Figure out the main-is file to load based on the targets. Asks the +-- user for input if there is more than one candidate main-is file. figureOutMainFile :: HasRunner env => BuildOpts @@ -530,11 +552,10 @@ T.pack (toFilePath mainIs) candidateIndices = take (length candidates) [1 :: Int ..] userOption = do - putStr "Specify main module to use (press enter to load none): " - option <- getLine + option <- prompt "Specify main module to use (press enter to load none): " let selected = fromMaybe ((+1) $ length candidateIndices) - (readMaybe option :: Maybe Int) + (readMaybe (T.unpack option) :: Maybe Int) case elemIndex selected candidateIndices of Nothing -> do putStrLn @@ -561,41 +582,24 @@ sampleMainIsArg (pkg,comp,_) = "--main-is " <> packageNameText pkg <> ":" <> renderComp comp -getGhciPkgInfos +loadGhciPkgDescs :: HasEnvConfig env => BuildOptsCLI - -> SourceMap - -> [PackageName] - -> Maybe (Map PackageName (Set (Path Abs File))) -> [(PackageName, (Path Abs File, Target))] - -> RIO env [GhciPkgInfo] -getGhciPkgInfos buildOptsCLI sourceMap addPkgs mfileTargets localTargets = do - (installedMap, _, _, _) <- getInstalled - GetInstalledOpts - { getInstalledProfiling = False - , getInstalledHaddock = False - , getInstalledSymbols = False - } - sourceMap - let localLibs = [name | (name, (_, target)) <- localTargets, hasLocalComp isCLib target] + -> RIO env [GhciPkgDesc] +loadGhciPkgDescs buildOptsCLI localTargets = forM localTargets $ \(name, (cabalfp, target)) -> - makeGhciPkgInfo buildOptsCLI sourceMap installedMap localLibs addPkgs mfileTargets name cabalfp target + loadGhciPkgDesc buildOptsCLI name cabalfp target --- | Make information necessary to load the given package in GHCi. -makeGhciPkgInfo +-- | Load package description information for a ghci target. +loadGhciPkgDesc :: HasEnvConfig env => BuildOptsCLI - -> SourceMap - -> InstalledMap - -> [PackageName] - -> [PackageName] - -> Maybe (Map PackageName (Set (Path Abs File))) -> PackageName -> Path Abs File -> Target - -> RIO env GhciPkgInfo -makeGhciPkgInfo buildOptsCLI sourceMap installedMap locals addPkgs mfileTargets name cabalfp target = do - bopts <- view buildOptsL + -> RIO env GhciPkgDesc +loadGhciPkgDesc buildOptsCLI name cabalfp target = do econfig <- view envConfigL bconfig <- view buildConfigL compilerVersion <- view actualCompilerVersionL @@ -633,7 +637,51 @@ (C.updatePackageDescription bi x) (C.updatePackageDescription bi y)) mbuildinfo + return GhciPkgDesc + { ghciDescPkg = pkg + , ghciDescCabalFp = cabalfp + , ghciDescTarget = target + } +getGhciPkgInfos + :: HasEnvConfig env + => SourceMap + -> [PackageName] + -> Maybe (Map PackageName (Set (Path Abs File))) + -> [GhciPkgDesc] + -> RIO env [GhciPkgInfo] +getGhciPkgInfos sourceMap addPkgs mfileTargets localTargets = do + (installedMap, _, _, _) <- getInstalled + GetInstalledOpts + { getInstalledProfiling = False + , getInstalledHaddock = False + , getInstalledSymbols = False + } + sourceMap + let localLibs = + [ packageName (ghciDescPkg desc) + | desc <- localTargets + , hasLocalComp isCLib (ghciDescTarget desc) + ] + forM localTargets $ \pkgDesc -> + makeGhciPkgInfo sourceMap installedMap localLibs addPkgs mfileTargets pkgDesc + +-- | Make information necessary to load the given package in GHCi. +makeGhciPkgInfo + :: HasEnvConfig env + => SourceMap + -> InstalledMap + -> [PackageName] + -> [PackageName] + -> Maybe (Map PackageName (Set (Path Abs File))) + -> GhciPkgDesc + -> RIO env GhciPkgInfo +makeGhciPkgInfo sourceMap installedMap locals addPkgs mfileTargets pkgDesc = do + bopts <- view buildOptsL + let pkg = ghciDescPkg pkgDesc + cabalfp = ghciDescCabalFp pkgDesc + target = ghciDescTarget pkgDesc + name = packageName pkg (mods,files,opts) <- getPackageOpts (packageOpts pkg) sourceMap installedMap locals addPkgs cabalfp let filteredOpts = filterWanted opts filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted) @@ -641,7 +689,7 @@ setMapMaybe f = S.fromList . mapMaybe f . S.toList return GhciPkgInfo - { ghciPkgName = packageName pkg + { ghciPkgName = name , ghciPkgOpts = M.toList filteredOpts , ghciPkgDir = parent cabalfp , ghciPkgModules = unionModuleMaps $ @@ -661,8 +709,9 @@ wantedPackageComponents bopts (TargetAll ProjectPackage) pkg = S.fromList $ (case packageLibraries pkg of NoLibraries -> [] - HasLibraries _names -> [CLib]) ++ -- FIXME. This ignores sub libraries and foreign libraries. Is that OK? + HasLibraries names -> CLib : map CInternalLib (S.toList names)) ++ map CExe (S.toList (packageExes pkg)) <> + map CInternalLib (S.toList $ packageInternalLibraries pkg) <> (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <> (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else []) wantedPackageComponents _ _ _ = S.empty diff --git a/src/Stack/Hoogle.hs b/src/Stack/Hoogle.hs --- a/src/Stack/Hoogle.hs +++ b/src/Stack/Hoogle.hs @@ -164,7 +164,7 @@ Right hooglePath -> do result <- withProcessContext menv $ proc hooglePath ["--numeric-version"] - $ tryAny . readProcessStdout_ + $ tryAny . fmap fst . readProcess_ let unexpectedResult got = Left $ T.concat [ "'" , T.pack hooglePath diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs --- a/src/Stack/Init.hs +++ b/src/Stack/Init.hs @@ -185,6 +185,7 @@ <> F.foldMap (goComment o) comments <> goOthers (o `HM.difference` HM.fromList comments) <> B.byteString footerHelp + <> "\n" goComment o (name, comment) = case (convert <$> HM.lookup name o) <|> nonPresentValue name of @@ -261,7 +262,6 @@ , "resolver: lts-3.5" , "resolver: nightly-2015-09-21" , "resolver: ghc-7.10.2" - , "resolver: ghcjs-0.1.0_ghc-7.10.2" , "" , "The location of a snapshot can be provided as a file or url. Stack assumes" , "a snapshot provided as a file might change, whereas a url resource does not." diff --git a/src/Stack/Ls.hs b/src/Stack/Ls.hs --- a/src/Stack/Ls.hs +++ b/src/Stack/Ls.hs @@ -24,11 +24,8 @@ import qualified Data.Text.IO as T import Data.Typeable (Typeable) import qualified Data.Vector as V -import Network.HTTP.StackClient (httpJSON) -import Network.HTTP.Simple - (addRequestHeader, getResponseBody, parseRequest, - setRequestManager) -import Network.HTTP.Types.Header (hAccept) +import Network.HTTP.StackClient (httpJSON, getGlobalManager, addRequestHeader, getResponseBody, parseRequest, + setRequestManager, hAccept) import qualified Options.Applicative as OA import Options.Applicative ((<|>)) import Path @@ -39,7 +36,6 @@ import System.Process.PagerEditor (pageText) import System.Directory (listDirectory) import System.IO (stderr, hPutStrLn) -import Network.HTTP.Client.TLS (getGlobalManager) data LsView = Local diff --git a/src/Stack/New.hs b/src/Stack/New.hs --- a/src/Stack/New.hs +++ b/src/Stack/New.hs @@ -12,33 +12,26 @@ module Stack.New ( new , NewOpts(..) - , defaultTemplateName - , templateNameArgument - , getTemplates , TemplateName - , listTemplates) - where + , templatesHelp + ) where import Stack.Prelude import Control.Monad.Trans.Writer.Strict -import Data.Aeson -import Data.Aeson.Types -import qualified Data.ByteString as SB +import Control.Monad (void) import qualified Data.ByteString.Lazy as LB import Data.Conduit -import qualified Data.HashMap.Strict as HM import Data.List import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as T -import qualified Data.Text.Encoding.Error as T (lenientDecode) -import qualified Data.Text.IO as T +import qualified Data.Text.Lazy.Encoding as TLE import Data.Time.Calendar import Data.Time.Clock -import qualified Data.Yaml as Yaml import Network.HTTP.Download -import Network.HTTP.Simple (Request, HttpException, getResponseStatusCode, getResponseBody) +import Network.HTTP.StackClient (Request, HttpException, getResponseStatusCode, getResponseBody) import Path import Path.IO import Stack.Constants @@ -49,7 +42,6 @@ import RIO.Process import qualified Text.Mustache as Mustache import qualified Text.Mustache.Render as Mustache -import Text.Printf import Text.ProjectTemplate -------------------------------------------------------------------------------- @@ -126,10 +118,7 @@ templateDir <- view $ configL.to templatesDir case templatePath name of AbsPath absFile -> logIt LocalTemp >> loadLocalFile absFile - UrlPath s -> do - req <- parseRequest s - let rel = fromMaybe backupUrlRelPath (parseRelFile s) - downloadTemplate req (templateDir rel) + UrlPath s -> downloadFromUrl s templateDir RelPath relFile -> catch (do f <- loadLocalFile relFile @@ -141,6 +130,10 @@ (templateDir relFile) Nothing -> throwM e ) + RepoPath rtp -> do + let url = urlFromRepoTemplatePath rtp + downloadFromUrl (T.unpack url) templateDir + where loadLocalFile :: Path b File -> RIO env Text loadLocalFile path = do @@ -148,20 +141,46 @@ <> "\"") exists <- doesFileExist path if exists - then liftIO (fmap (T.decodeUtf8With T.lenientDecode) (SB.readFile (toFilePath path))) + then readFileUtf8 (toFilePath path) else throwM (FailedToLoadTemplate name (toFilePath path)) - relRequest :: MonadThrow n => Path Rel File -> n Request - relRequest rel = parseRequest (defaultTemplateUrl <> "/" <> toFilePath rel) + relRequest :: Path Rel File -> Maybe Request + relRequest rel = do + rtp <- parseRepoPathWithService defaultRepoService (T.pack (toFilePath rel)) + let url = urlFromRepoTemplatePath rtp + parseRequest (T.unpack url) + downloadFromUrl :: String -> Path Abs Dir -> RIO env Text + downloadFromUrl s templateDir = do + req <- parseRequest s + let rel = fromMaybe backupUrlRelPath (parseRelFile s) + downloadTemplate req (templateDir rel) downloadTemplate :: Request -> Path Abs File -> RIO env Text downloadTemplate req path = do logIt RemoteTemp - _ <- - catch - (redownload req path) - (throwM . FailedToDownloadTemplate name) + catch + (void $ redownload req path) + (useCachedVersionOrThrow path) + loadLocalFile path + useCachedVersionOrThrow :: Path Abs File -> DownloadException -> RIO env () + useCachedVersionOrThrow path exception = do + exists <- doesFileExist path + + if exists + then do logWarn "Tried to download the template but an error was found." + logWarn "Using cached local version. It may not be the most recent version though." + else throwM (FailedToDownloadTemplate name exception) + backupUrlRelPath = $(mkRelFile "downloaded.template.file.hsfiles") +-- | Construct a URL for downloading from a repo. +urlFromRepoTemplatePath :: RepoTemplatePath -> Text +urlFromRepoTemplatePath (RepoTemplatePath Github user name) = + T.concat ["https://raw.githubusercontent.com", "/", user, "/stack-templates/master/", name] +urlFromRepoTemplatePath (RepoTemplatePath Gitlab user name) = + T.concat ["https://gitlab.com", "/", user, "/stack-templates/raw/master/", name] +urlFromRepoTemplatePath (RepoTemplatePath Bitbucket user name) = + T.concat ["https://bitbucket.org", "/", user, "/stack-templates/raw/master/", name] + -- | Apply and unpack a template into a directory. applyTemplate :: HasConfig env @@ -186,17 +205,9 @@ , ("name-as-module", nameAsModule) ] configParams = configTemplateParams config yearParam = M.singleton "year" currentYear - etemplateCompiled = Mustache.compileTemplate (T.unpack (templateName template)) templateText - templateCompiled <- case etemplateCompiled of - Left e -> throwM $ InvalidTemplate template (show e) - Right t -> return t - let (substitutionErrors, applied) = Mustache.checkedSubstitute templateCompiled context - missingKeys = S.fromList $ concatMap onlyMissingKeys substitutionErrors - unless (S.null missingKeys) - (logInfo ("\n" <> displayShow (MissingParameters project template missingKeys (configUserConfigPath config)) <> "\n")) files :: Map FilePath LB.ByteString <- catch (execWriterT $ runConduit $ - yield (T.encodeUtf8 applied) .| + yield (T.encodeUtf8 templateText) .| unpackTemplate receiveMem id ) (\(e :: ProjectTemplateException) -> @@ -208,12 +219,36 @@ unless (any isPkgSpec . M.keys $ files) $ throwM (InvalidTemplate template "Template does not contain a .cabal \ \or package.yaml file") + + -- Apply Mustache templating to a single file within the project + -- template. + let applyMustache bytes + -- Workaround for performance problems with mustache and + -- large files, applies to Yesod templates with large + -- bootstrap CSS files. See + -- https://github.com/commercialhaskell/stack/issues/4133. + | LB.length bytes < 50000 + , Right text <- TLE.decodeUtf8' bytes = do + let etemplateCompiled = Mustache.compileTemplate (T.unpack (templateName template)) $ TL.toStrict text + templateCompiled <- case etemplateCompiled of + Left e -> throwM $ InvalidTemplate template (show e) + Right t -> return t + let (substitutionErrors, applied) = Mustache.checkedSubstitute templateCompiled context + missingKeys = S.fromList $ concatMap onlyMissingKeys substitutionErrors + unless (S.null missingKeys) + (logInfo ("\n" <> displayShow (MissingParameters project template missingKeys (configUserConfigPath config)) <> "\n")) + pure $ LB.fromStrict $ encodeUtf8 applied + + -- Too large or too binary + | otherwise = pure bytes + liftM M.fromList (mapM (\(fp,bytes) -> do path <- parseRelFile fp - return (dir path, bytes)) + bytes' <- applyMustache bytes + return (dir path, bytes')) (M.toList files)) where onlyMissingKeys (Mustache.VariableNotFound ks) = map T.unpack ks @@ -250,71 +285,15 @@ catchAny (proc "git" ["init"] runProcess_) (\_ -> logInfo "git init failed to run, ignoring ...") --- | Display the set of templates accompanied with description if available. -listTemplates :: HasLogFunc env => RIO env () -listTemplates = do - templates <- getTemplates - templateInfo <- getTemplateInfo - if not . M.null $ templateInfo then do - let keySizes = map (T.length . templateName) $ S.toList templates - padWidth = show $ maximum keySizes - outputfmt = "%-" <> padWidth <> "s %s\n" - headerfmt = "%-" <> padWidth <> "s %s\n" - liftIO $ printf headerfmt ("Template"::String) ("Description"::String) - forM_ (S.toList templates) (\x -> do - let name = templateName x - desc = fromMaybe "" $ liftM (mappend "- ") (M.lookup name templateInfo >>= description) - liftIO $ printf outputfmt (T.unpack name) (T.unpack desc)) - else mapM_ (liftIO . T.putStrLn . templateName) (S.toList templates) - --- | Get the set of templates. -getTemplates :: HasLogFunc env => RIO env (Set TemplateName) -getTemplates = do - req <- liftM setGithubHeaders (parseUrlThrow defaultTemplatesList) - resp <- catch (httpJSON req) (throwM . FailedToDownloadTemplates) - case getResponseStatusCode resp of - 200 -> return $ unTemplateSet $ getResponseBody resp - code -> throwM (BadTemplatesResponse code) - -getTemplateInfo :: HasLogFunc env => RIO env (Map Text TemplateInfo) -getTemplateInfo = do - req <- liftM setGithubHeaders (parseUrlThrow defaultTemplateInfoUrl) - resp <- catch (liftM Right $ httpLbs req) (\(ex :: HttpException) -> return . Left $ "Failed to download template info. The HTTP error was: " <> show ex) - case resp >>= is200 of - Left err -> do - logInfo $ fromString err - return M.empty - Right resp' -> - case Yaml.decodeEither (LB.toStrict $ getResponseBody resp') :: Either String Object of - Left err -> - throwM $ BadTemplateInfo err - Right o -> - return (M.mapMaybe (Yaml.parseMaybe Yaml.parseJSON) (M.fromList . HM.toList $ o) :: Map Text TemplateInfo) - where - is200 resp = - case getResponseStatusCode resp of - 200 -> return resp - code -> Left $ "Unexpected status code while retrieving templates info: " <> show code - -newtype TemplateSet = TemplateSet { unTemplateSet :: Set TemplateName } -instance FromJSON TemplateSet where - parseJSON = fmap TemplateSet . parseTemplateSet - --- | Parser the set of templates from the JSON. -parseTemplateSet :: Value -> Parser (Set TemplateName) -parseTemplateSet a = do - xs <- parseJSON a - fmap S.fromList (mapMaybeM parseTemplate xs) - where - parseTemplate v = do - o <- parseJSON v - name <- o .: "name" - if ".hsfiles" `isSuffixOf` name - then case parseTemplateNameFromString name of - Left{} -> - fail ("Unable to parse template name from " <> name) - Right template -> return (Just template) - else return Nothing +-- | Display help for the templates command. +templatesHelp :: HasLogFunc env => RIO env () +templatesHelp = do + let url = defaultTemplatesHelpUrl + req <- liftM setGithubHeaders (parseUrlThrow url) + resp <- httpLbs req `catch` (throwM . FailedToDownloadTemplatesHelp) + case decodeUtf8' $ LB.toStrict $ getResponseBody resp of + Left err -> throwM $ BadTemplatesHelpEncoding url err + Right txt -> logInfo $ display txt -------------------------------------------------------------------------------- -- Defaults @@ -323,20 +302,14 @@ defaultTemplateName :: TemplateName defaultTemplateName = $(mkTemplateName "new-template") --- | Default web root URL to download from. -defaultTemplateUrl :: String -defaultTemplateUrl = - "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master" - --- | Default web URL to get a yaml file containing template metadata. -defaultTemplateInfoUrl :: String -defaultTemplateInfoUrl = - "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master/template-info.yaml" +-- | The default service to use to download templates. +defaultRepoService :: RepoService +defaultRepoService = Github --- | Default web URL to list the repo contents. -defaultTemplatesList :: String -defaultTemplatesList = - "https://api.github.com/repos/commercialhaskell/stack-templates/contents/" +-- | Default web URL to get the `stack templates` help output. +defaultTemplatesHelpUrl :: String +defaultTemplatesHelpUrl = + "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master/STACK_HELP.md" -------------------------------------------------------------------------------- -- Exceptions @@ -347,15 +320,14 @@ !FilePath | FailedToDownloadTemplate !TemplateName !DownloadException - | FailedToDownloadTemplates !HttpException - | BadTemplatesResponse !Int | AlreadyExists !(Path Abs Dir) | MissingParameters !PackageName !TemplateName !(Set String) !(Path Abs File) | InvalidTemplate !TemplateName !String | AttemptedOverwrites [Path Abs File] - | FailedToDownloadTemplateInfo !HttpException - | BadTemplateInfo !String - | BadTemplateInfoResponse !Int + | FailedToDownloadTemplatesHelp !HttpException + | BadTemplatesHelpEncoding + !String -- URL it's downloaded from + !UnicodeException | Can'tUseWiredInName !PackageName deriving (Typeable) @@ -366,20 +338,20 @@ "Failed to load download template " <> T.unpack (templateName name) <> " from " <> path - show (FailedToDownloadTemplate name (RedownloadFailed _ _ resp)) = + show (FailedToDownloadTemplate name (RedownloadInvalidResponse _ _ resp)) = case getResponseStatusCode resp of 404 -> - "That template doesn't exist. Run `stack templates' to see a list of available templates." + "That template doesn't exist. Run `stack templates' to discover available templates." code -> "Failed to download template " <> T.unpack (templateName name) <> ": unknown reason, status code was: " <> show code + + show (FailedToDownloadTemplate name (RedownloadHttpError httpError)) = + "There was an unexpected HTTP error while downloading template " <> + T.unpack (templateName name) <> ": " <> show httpError show (AlreadyExists path) = "Directory " <> toFilePath path <> " already exists. Aborting." - show (FailedToDownloadTemplates ex) = - "Failed to download templates. The HTTP error was: " <> show ex - show (BadTemplatesResponse code) = - "Unexpected status code while retrieving templates list: " <> show code show (MissingParameters name template missingKeys userConfigPath) = intercalate "\n" @@ -413,11 +385,9 @@ "The template would create the following files, but they already exist:\n" <> unlines (map ((" " ++) . toFilePath) fps) <> "Use --force to ignore this, and overwite these files." - show (FailedToDownloadTemplateInfo ex) = - "Failed to download templates info. The HTTP error was: " <> show ex - show (BadTemplateInfo err) = - "Template info couldn't be parsed: " <> err - show (BadTemplateInfoResponse code) = - "Unexpected status code while retrieving templates info: " <> show code + show (FailedToDownloadTemplatesHelp ex) = + "Failed to download `stack templates` help. The HTTP error was: " <> show ex + show (BadTemplatesHelpEncoding url err) = + "UTF-8 decoding error on template info from\n " <> url <> "\n\n" <> show err show (Can'tUseWiredInName name) = "The name \"" <> packageNameString name <> "\" is used by GHC wired-in packages, and so shouldn't be used as a package name" diff --git a/src/Stack/Options/BenchParser.hs b/src/Stack/Options/BenchParser.hs --- a/src/Stack/Options/BenchParser.hs +++ b/src/Stack/Options/BenchParser.hs @@ -19,7 +19,7 @@ help ("Forward BENCH_ARGS to the benchmark suite. " <> "Supports templates from `cabal bench`") <> hide)) - <*> optionalFirst (switch (long "no-run-benchmarks" <> + <*> optionalFirst (flag' True (long "no-run-benchmarks" <> help "Disable running of benchmarks. (Benchmarks will still be built.)" <> hide)) where hide = hideMods hide0 diff --git a/src/Stack/Options/BuildMonoidParser.hs b/src/Stack/Options/BuildMonoidParser.hs --- a/src/Stack/Options/BuildMonoidParser.hs +++ b/src/Stack/Options/BuildMonoidParser.hs @@ -21,7 +21,8 @@ haddockHyperlinkSource <*> copyBins <*> copyCompilerTool <*> preFetch <*> keepGoing <*> keepTmpFiles <*> forceDirty <*> tests <*> testOptsParser hideBool <*> benches <*> - benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> skipComponents + benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> skipComponents <*> + interleavedOutput where hideBool = hide0 /= BuildCmdGlobalOpts hide = @@ -167,3 +168,8 @@ (long "skip" <> help "Skip given component, can be specified multiple times" <> hide))) + interleavedOutput = + firstBoolFlags + "interleaved-output" + "Print concurrent GHC output to the console with a prefix for the package name" + hide diff --git a/src/Stack/Options/Completion.hs b/src/Stack/Options/Completion.hs --- a/src/Stack/Options/Completion.hs +++ b/src/Stack/Options/Completion.hs @@ -21,6 +21,7 @@ import Options.Applicative import Options.Applicative.Builder.Extra import Stack.Config (getLocalPackages) +import Stack.DefaultColorWhen (defaultColorWhen) import Stack.Options.GlobalParser (globalOptsFromMonoid) import Stack.Runners (loadConfigWithOpts) import Stack.Prelude hiding (lift) @@ -57,7 +58,8 @@ -- If it looks like a flag, skip this more costly completion. ('-': _) -> return [] _ -> do - let go = (globalOptsFromMonoid False mempty) + defColorWhen <- liftIO defaultColorWhen + let go = (globalOptsFromMonoid False defColorWhen mempty) { globalLogLevel = LevelOther "silent" } loadConfigWithOpts go $ \lc -> do bconfig <- liftIO $ lcLoadBuildConfig lc (globalCompiler go) diff --git a/src/Stack/Options/ExecParser.hs b/src/Stack/Options/ExecParser.hs --- a/src/Stack/Options/ExecParser.hs +++ b/src/Stack/Options/ExecParser.hs @@ -22,6 +22,7 @@ txt = case mcmd of Nothing -> normalTxt Just ExecCmd{} -> normalTxt + Just ExecRun -> "-- ARGS (e.g. stack run -- file.txt)" Just ExecGhc -> "-- ARGS (e.g. stack runghc -- X.hs -o x)" Just ExecRunGhc -> "-- ARGS (e.g. stack runghc -- X.hs)" normalTxt = "-- ARGS (e.g. stack exec -- ghc-pkg describe base)" diff --git a/src/Stack/Options/GlobalParser.hs b/src/Stack/Options/GlobalParser.hs --- a/src/Stack/Options/GlobalParser.hs +++ b/src/Stack/Options/GlobalParser.hs @@ -38,7 +38,10 @@ (long "color" <> metavar "WHEN" <> completeWith ["always", "never", "auto"] <> - help "Specify when to use color in output; WHEN is 'always', 'never', or 'auto'" <> + help "Specify when to use color in output; WHEN is 'always', 'never', \ + \or 'auto'. On Windows versions before Windows 10, for terminals \ + \that do not support color codes, the default is 'never'; color \ + \may work on terminals that support color codes" <> hide)) <*> optionalFirst (option auto (long "terminal-width" <> @@ -58,8 +61,8 @@ hide0 = kind /= OuterGlobalOpts -- | Create GlobalOpts from GlobalOptsMonoid. -globalOptsFromMonoid :: Bool -> GlobalOptsMonoid -> GlobalOpts -globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = GlobalOpts +globalOptsFromMonoid :: Bool -> ColorWhen -> GlobalOptsMonoid -> GlobalOpts +globalOptsFromMonoid defaultTerminal defaultColorWhen GlobalOptsMonoid{..} = GlobalOpts { globalReExecVersion = getFirst globalMonoidReExecVersion , globalDockerEntrypoint = getFirst globalMonoidDockerEntrypoint , globalLogLevel = fromFirst defaultLogLevel globalMonoidLogLevel @@ -68,7 +71,7 @@ , globalResolver = getFirst globalMonoidResolver , globalCompiler = getFirst globalMonoidCompiler , globalTerminal = fromFirst defaultTerminal globalMonoidTerminal - , globalColorWhen = fromFirst ColorAuto globalMonoidColorWhen + , globalColorWhen = fromFirst defaultColorWhen globalMonoidColorWhen , globalTermWidth = getFirst globalMonoidTermWidth , globalStackYaml = maybe SYLDefault SYLOverride $ getFirst globalMonoidStackYaml } diff --git a/src/Stack/Options/NewParser.hs b/src/Stack/Options/NewParser.hs --- a/src/Stack/Options/NewParser.hs +++ b/src/Stack/Options/NewParser.hs @@ -23,9 +23,12 @@ help "Do not create a subdirectory for the project") <*> optional (templateNameArgument (metavar "TEMPLATE_NAME" <> - help "Name of a template or a local template in a file or a URL.\ - \ For example: foo or foo.hsfiles or ~/foo or\ - \ https://example.com/foo.hsfiles")) <*> + help "Name of a template - can take the form\ + \ [[service:]username/]template with optional service name\ + \ (github, gitlab, or bitbucket) \ + \ and username for the service; or, a local filename such as\ + \ foo.hsfiles or ~/foo; or, a full URL such as\ + \ https://example.com/foo.hsfiles.")) <*> fmap M.fromList (many diff --git a/src/Stack/Options/SDistParser.hs b/src/Stack/Options/SDistParser.hs --- a/src/Stack/Options/SDistParser.hs +++ b/src/Stack/Options/SDistParser.hs @@ -15,13 +15,14 @@ optional pvpBoundsOption <*> ignoreCheckSwitch <*> (if signDefault - then switch (long "no-signature" <> help "Do not sign & upload signatures") + then not <$> switch (long "no-signature" <> help "Do not sign & upload signatures") else switch (long "sign" <> help "Sign & upload signatures")) <*> strOption (long "sig-server" <> metavar "URL" <> showDefault <> value "https://sig.commercialhaskell.org" <> help "URL") <*> - buildPackageOption + buildPackageOption <*> + optional (strOption (long "tar-dir" <> help "If specified, copy all the tar to this dir")) where ignoreCheckSwitch = switch (long "ignore-check" diff --git a/src/Stack/Options/TestParser.hs b/src/Stack/Options/TestParser.hs --- a/src/Stack/Options/TestParser.hs +++ b/src/Stack/Options/TestParser.hs @@ -27,12 +27,12 @@ help "Arguments passed in to the test suite program" <> hide))) <*> optionalFirst - (switch + (flag' True (long "coverage" <> help "Generate a code coverage report" <> hide)) <*> optionalFirst - (switch + (flag' True (long "no-run-tests" <> help "Disable running of tests. (Tests will still be built.)" <> hide)) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -31,7 +30,6 @@ ,buildLogPath ,PackageException (..) ,resolvePackageDescription - ,packageDescTools ,packageDependencies ,cabalFilePackageId ,gpdPackageIdentifier @@ -40,13 +38,14 @@ where import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C8 -import Data.List (isSuffixOf, isPrefixOf) +import qualified Data.ByteString.Lazy.Char8 as CL8 +import Data.List (isPrefixOf, unzip) import Data.Maybe (maybe) import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE import Distribution.Compiler import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as Cabal @@ -57,14 +56,16 @@ import Distribution.PackageDescription.Parsec import qualified Distribution.PackageDescription.Parsec as D import Distribution.Parsec.Common (PWarning (..), showPos) -import Distribution.Simple.Utils +import Distribution.Simple.Glob (matchDirFileGlob) import Distribution.System (OS (..), Arch, Platform (..)) import qualified Distribution.Text as D import qualified Distribution.Types.CondTree as Cabal import qualified Distribution.Types.ExeDependency as Cabal import Distribution.Types.ForeignLib import qualified Distribution.Types.LegacyExeDependency as Cabal +import Distribution.Types.MungedPackageName import qualified Distribution.Types.UnqualComponentName as Cabal +import qualified Distribution.Types.Version as Cabal import qualified Distribution.Verbosity as D import Lens.Micro (lens) import qualified Hpack @@ -93,7 +94,7 @@ import Stack.Types.Runner import Stack.Types.Version import qualified System.Directory as D -import System.FilePath (splitExtensions, replaceExtension) +import System.FilePath (replaceExtension) import qualified System.FilePath as FilePath import System.IO.Error import RIO.Process @@ -262,7 +263,7 @@ , packageLicense = licenseRaw pkg , packageDeps = deps , packageFiles = pkgFiles - , packageTools = packageDescTools pkg + , packageUnknownTools = unknownTools , packageGhcOptions = packageConfigGhcOptions packageConfig , packageFlags = packageConfigFlags packageConfig , packageDefaultFlags = M.fromList @@ -275,10 +276,9 @@ Just lib in case mlib of - Nothing - | null extraLibNames -> NoLibraries - | otherwise -> error "Package has buildable sublibraries but no buildable libraries, I'm giving up" + Nothing -> NoLibraries Just _ -> HasLibraries foreignLibNames + , packageInternalLibraries = subLibNames , packageTests = M.fromList [(T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t) | t <- testSuites pkgNoMod @@ -299,8 +299,13 @@ , packageOpts = GetPackageOpts $ \sourceMap installedMap omitPkgs addPkgs cabalfp -> do (componentsModules,componentFiles,_,_) <- getPackageFiles pkgFiles cabalfp + let internals = S.toList $ internalLibComponents $ M.keysSet componentsModules + excludedInternals <- mapM parsePackageName internals + mungedInternals <- mapM (parsePackageName . toInternalPackageMungedName) internals componentsOpts <- - generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componentFiles + generatePkgDescOpts sourceMap installedMap + (excludedInternals ++ omitPkgs) (mungedInternals ++ addPkgs) + cabalfp pkg componentFiles return (componentsModules,componentFiles,componentsOpts) , packageHasExposedModules = maybe False @@ -325,6 +330,10 @@ $ filter (buildable . foreignLibBuildInfo) $ foreignLibs pkg + toInternalPackageMungedName + = T.pack . unMungedPackageName . computeCompatPackageName (pkgName pkgId) + . Just . Cabal.mkUnqualComponentName . T.unpack + -- Gets all of the modules, files, build files, and data files that -- constitute the package. This is primarily used for dirtiness -- checking during build, as well as use by "stack ghci" @@ -354,18 +363,28 @@ return (componentModules, componentFiles, buildFiles <> dataFiles', warnings) pkgId = package pkg name = fromCabalPackageName (pkgName pkgId) - deps = M.filterWithKey (const . not . isMe) (M.union - (packageDependencies packageConfig pkg) + + (unknownTools, knownTools) = packageDescTools pkg + + deps = M.filterWithKey (const . not . isMe) (M.unionsWith (<>) + [ asLibrary <$> packageDependencies packageConfig pkg -- We include all custom-setup deps - if present - in the -- package deps themselves. Stack always works with the -- invariant that there will be a single installed package -- relating to a package name, and this applies at the setup -- dependency level as well. - (fromMaybe M.empty msetupDeps)) + , asLibrary <$> fromMaybe M.empty msetupDeps + , knownTools + ]) msetupDeps = fmap (M.fromList . map (depName &&& depRange) . setupDepends) (setupBuildInfo pkg) + asLibrary range = DepValue + { dvVersionRange = range + , dvType = AsLibrary + } + -- Is the package dependency mentioned here me: either the package -- name itself, or the name of one of the sub libraries isMe name' = name' == name || packageNameText name' `S.member` extraLibNames @@ -411,6 +430,12 @@ [] (return . generate CLib . libBuildInfo) (library pkg) + , mapMaybe + (\sublib -> do + let maybeLib = CInternalLib . T.pack . Cabal.unUnqualComponentName <$> libName sublib + flip generate (libBuildInfo sublib) <$> maybeLib + ) + (subLibraries pkg) , fmap (\exe -> generate @@ -662,18 +687,68 @@ -- -- This uses both the new 'buildToolDepends' and old 'buildTools' -- information. -packageDescTools :: PackageDescription -> Map ExeName VersionRange -packageDescTools = - M.fromList . concatMap tools . allBuildInfo' +packageDescTools + :: PackageDescription + -> (Set ExeName, Map PackageName DepValue) +packageDescTools pd = + (S.fromList $ concat unknowns, M.fromListWith (<>) $ concat knowns) where - tools bi = map go1 (buildTools bi) ++ map go2 (buildToolDepends bi) + (unknowns, knowns) = unzip $ map perBI $ allBuildInfo' pd - go1 :: Cabal.LegacyExeDependency -> (ExeName, VersionRange) - go1 (Cabal.LegacyExeDependency name range) = (ExeName $ T.pack name, range) + perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)]) + perBI bi = + (unknownTools, tools) + where + (unknownTools, knownTools) = partitionEithers $ map go1 (buildTools bi) - go2 :: Cabal.ExeDependency -> (ExeName, VersionRange) - go2 (Cabal.ExeDependency _pkg name range) = (ExeName $ T.pack $ Cabal.unUnqualComponentName name, range) + tools = mapMaybe go2 (knownTools ++ buildToolDepends bi) + -- This is similar to desugarBuildTool from Cabal, however it + -- uses our own hard-coded map which drops tools shipped with + -- GHC (like hsc2hs), and includes some tools from Stackage. + go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency + go1 (Cabal.LegacyExeDependency name range) = + case M.lookup name hardCodedMap of + Just pkgName -> Right $ Cabal.ExeDependency pkgName (Cabal.mkUnqualComponentName name) range + Nothing -> Left $ ExeName $ T.pack name + + go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue) + go2 (Cabal.ExeDependency pkg _name range) + | pkg `S.member` preInstalledPackages = Nothing + | otherwise = Just + ( fromCabalPackageName pkg + , DepValue + { dvVersionRange = range + , dvType = AsBuildTool + } + ) + +-- | A hard-coded map for tool dependencies +hardCodedMap :: Map String D.PackageName +hardCodedMap = M.fromList + [ ("alex", Distribution.Package.mkPackageName "alex") + , ("happy", Distribution.Package.mkPackageName "happy") + , ("cpphs", Distribution.Package.mkPackageName "cpphs") + , ("greencard", Distribution.Package.mkPackageName "greencard") + , ("c2hs", Distribution.Package.mkPackageName "c2hs") + , ("hscolour", Distribution.Package.mkPackageName "hscolour") + , ("hspec-discover", Distribution.Package.mkPackageName "hspec-discover") + , ("hsx2hs", Distribution.Package.mkPackageName "hsx2hs") + , ("gtk2hsC2hs", Distribution.Package.mkPackageName "gtk2hs-buildtools") + , ("gtk2hsHookGenerator", Distribution.Package.mkPackageName "gtk2hs-buildtools") + , ("gtk2hsTypeGen", Distribution.Package.mkPackageName "gtk2hs-buildtools") + ] + +-- | Executable-only packages which come pre-installed with GHC and do +-- not need to be built. Without this exception, we would either end +-- up unnecessarily rebuilding these packages, or failing because the +-- packages do not appear in the Stackage snapshot. +preInstalledPackages :: Set D.PackageName +preInstalledPackages = S.fromList + [ D.mkPackageName "hsc2hs" + , D.mkPackageName "haddock" + ] + -- | Variant of 'allBuildInfo' from Cabal that, like versions before -- 2.2, only includes buildable components. allBuildInfo' :: PackageDescription -> [BuildInfo] @@ -698,7 +773,7 @@ :: PackageDescription -> RIO Ctx (Map NamedComponent (Map ModuleName (Path Abs File)), Map NamedComponent (Set DotCabalPath), Set (Path Abs File), [PackageWarning]) packageDescModulesAndFiles pkg = do - (libraryMods,libDotCabalFiles,libWarnings) <- -- FIXME add in sub libraries + (libraryMods,libDotCabalFiles,libWarnings) <- maybe (return (M.empty, M.empty, [])) (asModuleAndFileMap libComponent libraryFiles) @@ -725,7 +800,7 @@ (mapM (asModuleAndFileMap benchComponent benchmarkFiles) (benchmarks pkg)) - dfiles <- resolveGlobFiles + dfiles <- resolveGlobFiles (specVersion pkg) (extraSrcFiles pkg ++ map (dataDir pkg FilePath.) (dataFiles pkg)) let modules = libraryMods <> subLibrariesMods <> executableMods <> testMods <> benchModules @@ -746,8 +821,11 @@ foldTuples = foldl' (<>) (M.empty, M.empty, []) -- | Resolve globbing of files (e.g. data files) to absolute paths. -resolveGlobFiles :: [String] -> RIO Ctx (Set (Path Abs File)) -resolveGlobFiles = +resolveGlobFiles + :: Cabal.Version -- ^ cabal file version + -> [String] + -> RIO Ctx (Set (Path Abs File)) +resolveGlobFiles cabalFileVersion = liftM (S.fromList . catMaybes . concat) . mapM resolve where @@ -764,7 +842,7 @@ mapM resolveFileOrWarn names matchDirFileGlob' dir glob = catch - (matchDirFileGlob_ dir glob) + (liftIO (matchDirFileGlob minBound cabalFileVersion dir glob)) (\(e :: IOException) -> if isUserError e then do @@ -777,48 +855,6 @@ return [] else throwIO e) --- | This is a copy/paste of the Cabal library function, but with --- --- @ext == ext'@ --- --- Changed to --- --- @isSuffixOf ext ext'@ --- --- So that this will work: --- --- @ --- λ> matchDirFileGlob_ "." "test/package-dump/*.txt" --- ["test/package-dump/ghc-7.8.txt","test/package-dump/ghc-7.10.txt"] --- @ --- -matchDirFileGlob_ :: HasRunner env => String -> String -> RIO env [String] -matchDirFileGlob_ dir filepath = case parseFileGlob filepath of - Nothing -> liftIO $ throwString $ - "invalid file glob '" ++ filepath - ++ "'. Wildcards '*' are only allowed in place of the file" - ++ " name, not in the directory name or file extension." - ++ " If a wildcard is used it must be with an file extension." - Just (NoGlob filepath') -> return [filepath'] - Just (FileGlob dir' ext) -> do - efiles <- liftIO $ try $ D.getDirectoryContents (dir FilePath. dir') - let matches = - case efiles of - Left (_ :: IOException) -> [] - Right files -> - [ dir' FilePath. file - | file <- files - , let (name, ext') = splitExtensions file - , not (null name) && isSuffixOf ext ext' - ] - when (null matches) $ - prettyWarnL - [ flow "filepath wildcard" - , "'" <> styleFile (fromString filepath) <> "'" - , flow "does not match any files." - ] - return matches - -- | Get all files referenced by the benchmark. benchmarkFiles :: NamedComponent @@ -1196,24 +1232,24 @@ :: FilePath -> RIO Ctx (Set ModuleName, [Path Abs File]) parseDumpHI dumpHIPath = do dir <- asks (parent . ctxFile) - dumpHI <- liftIO $ fmap C8.lines (C8.readFile dumpHIPath) + dumpHI <- liftIO $ filterDumpHi <$> fmap CL8.lines (CL8.readFile dumpHIPath) let startModuleDeps = - dropWhile (not . ("module dependencies:" `C8.isPrefixOf`)) dumpHI + dropWhile (not . ("module dependencies:" `CL8.isPrefixOf`)) dumpHI moduleDeps = S.fromList $ - mapMaybe (D.simpleParse . T.unpack . decodeUtf8) $ - C8.words $ - C8.concat $ - C8.dropWhile (/= ' ') (fromMaybe "" $ listToMaybe startModuleDeps) : - takeWhile (" " `C8.isPrefixOf`) (drop 1 startModuleDeps) + mapMaybe (D.simpleParse . TL.unpack . TLE.decodeUtf8) $ + CL8.words $ + CL8.concat $ + CL8.dropWhile (/= ' ') (fromMaybe "" $ listToMaybe startModuleDeps) : + takeWhile (" " `CL8.isPrefixOf`) (drop 1 startModuleDeps) thDeps = -- The dependent file path is surrounded by quotes but is not escaped. -- It can be an absolute or relative path. mapMaybe - (fmap T.unpack . - (T.stripSuffix "\"" <=< T.stripPrefix "\"") . - T.dropWhileEnd (== '\r') . decodeUtf8 . C8.dropWhile (/= '"')) $ - filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI + (fmap TL.unpack . + (TL.stripSuffix "\"" <=< TL.stripPrefix "\"") . + TL.dropWhileEnd (== '\r') . TLE.decodeUtf8 . CL8.dropWhile (/= '"')) $ + filter ("addDependentFile \"" `CL8.isPrefixOf`) dumpHI thDepsResolved <- liftM catMaybes $ forM thDeps $ \x -> do mresolved <- liftIO (forgivingAbsence (resolveFile dir x)) >>= rejectMissingFile when (isNothing mresolved) $ @@ -1225,7 +1261,23 @@ ] return mresolved return (moduleDeps, thDepsResolved) + where + -- | Filtering step fixing RAM usage upon a big dump-hi file. See + -- https://github.com/commercialhaskell/stack/issues/4027 It is + -- an optional step from a functionality stand-point. + filterDumpHi dumpHI = + let dl x xs = x ++ xs + isLineInteresting (acc, moduleDepsStarted) l + | moduleDepsStarted && " " `CL8.isPrefixOf` l = + (acc . dl [l], True) + | "module dependencies:" `CL8.isPrefixOf` l = + (acc . dl [l], True) + | "addDependentFile \"" `CL8.isPrefixOf` l = + (acc . dl [l], False) + | otherwise = (acc, False) + in fst (foldl' isLineInteresting (dl [], False) dumpHI) [] + -- | Try to resolve the list of base names in the given directory by -- looking for unique instances of base names applied with the given -- extensions. @@ -1392,13 +1444,7 @@ config <- view configL case configOverrideHpack config of HpackBundled -> do -#if MIN_VERSION_hpack(0,26,0) - r <- liftIO $ Hpack.hpackResult $ Hpack.setTarget (toFilePath hpackFile) Hpack.defaultOptions -#elif MIN_VERSION_hpack(0,23,0) - r <- liftIO $ Hpack.hpackResult Hpack.defaultRunOptions {Hpack.runOptionsConfigDir = Just (toFilePath pkgDir)} Hpack.NoForce -#else - r <- liftIO $ Hpack.hpackResult (Just $ toFilePath pkgDir) Hpack.NoForce -#endif + r <- liftIO $ Hpack.hpackResult $ Hpack.setProgramName "stack" $ Hpack.setTarget (toFilePath hpackFile) Hpack.defaultOptions forM_ (Hpack.resultWarnings r) prettyWarnS let cabalFile = styleFile . fromString . Hpack.resultCabalFile $ r case Hpack.resultStatus r of diff --git a/src/Stack/PackageIndex.hs b/src/Stack/PackageIndex.hs --- a/src/Stack/PackageIndex.hs +++ b/src/Stack/PackageIndex.hs @@ -39,7 +39,6 @@ import Data.Conduit.Zlib (ungzip) import qualified Data.List.NonEmpty as NE import qualified Data.HashMap.Strict as HashMap -import qualified Data.Set as Set import Data.Store.Version import Data.Store.VersionTagged import qualified Data.Text as T @@ -51,7 +50,7 @@ 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.StackClient (getGlobalManager) import Network.HTTP.Download import Network.URI (parseURI) import Path (toFilePath, parseAbsFile, mkRelDir, mkRelFile, (), parseRelDir) @@ -380,12 +379,17 @@ -- | Get the known versions for a given package from the package caches. -- -- See 'getPackageCaches' for performance notes. -getPackageVersions :: HasCabalLoader env => PackageName -> RIO env (Set Version) +getPackageVersions :: HasCabalLoader env => PackageName -> RIO env (HashMap Version (Maybe CabalHash)) getPackageVersions pkgName = lookupPackageVersions pkgName <$> getPackageCaches -lookupPackageVersions :: PackageName -> PackageCache index -> Set Version +lookupPackageVersions :: PackageName -> PackageCache index -> HashMap Version (Maybe CabalHash) lookupPackageVersions pkgName (PackageCache m) = - maybe Set.empty (Set.fromList . HashMap.keys) $ HashMap.lookup pkgName m + maybe HashMap.empty (HashMap.map extractOrigRevHash) $ HashMap.lookup pkgName m + where + -- Extract the original cabal file hash (the first element of the one or two + -- element list currently representing the cabal file hashes). + extractOrigRevHash (_,_, neRevHashesAndOffsets) = + listToMaybe $ fst (NE.last neRevHashesAndOffsets) -- | Load the package caches, or create the caches if necessary. -- @@ -401,7 +405,9 @@ result <- liftM mconcat $ forM (clIndices cl) $ \index -> do fp <- configPackageIndexCache (indexName index) PackageCache pis <- -#if MIN_VERSION_template_haskell(2,13,0) +#if MIN_VERSION_template_haskell(2,14,0) + $(versionedDecodeOrLoad (storeVersionConfig "pkg-v5" "35_zXZ4b4CIWfrLXtjWteR4nb6o=" +#elif MIN_VERSION_template_haskell(2,13,0) $(versionedDecodeOrLoad (storeVersionConfig "pkg-v5" "LLL6OCcimOqRm3r0JmsSlLHcaLE=" #else $(versionedDecodeOrLoad (storeVersionConfig "pkg-v5" "A607WaDwhg5VVvZTxNgU9g52DO8=" diff --git a/src/Stack/PackageLocation.hs b/src/Stack/PackageLocation.hs --- a/src/Stack/PackageLocation.hs +++ b/src/Stack/PackageLocation.hs @@ -28,7 +28,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Distribution.PackageDescription (GenericPackageDescription) -import Network.HTTP.Client (parseUrlThrow) +import Network.HTTP.StackClient (parseUrlThrow) import Network.HTTP.Download.Verified import Path import Path.Extra diff --git a/src/Stack/Prelude.hs b/src/Stack/Prelude.hs --- a/src/Stack/Prelude.hs +++ b/src/Stack/Prelude.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -13,6 +14,10 @@ , readProcessNull , withProcessContext , stripCR + , hIsTerminalDeviceOrMinTTY + , prompt + , promptPassword + , promptBool , module X ) where @@ -28,17 +33,23 @@ import qualified System.IO as IO import qualified System.Directory as Dir import qualified System.FilePath as FP +import System.IO.Echo (withoutInputEcho) import System.IO.Error (isDoesNotExistError) +#ifdef WINDOWS +import System.Win32 (isMinTTYHandle, withHandleToHANDLE) +#endif + import Data.Conduit.Binary (sourceHandle, sinkHandle) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Conduit.Process.Typed (withLoggedProcess_, createSource) -import RIO.Process (HasProcessContext (..), ProcessContext, setStdin, closed, getStderr, getStdout, proc, withProcess_, setStdout, setStderr, ProcessConfig, readProcessStdout_, workingDirL) +import RIO.Process (HasProcessContext (..), ProcessContext, setStdin, closed, getStderr, getStdout, proc, withProcess_, setStdout, setStderr, ProcessConfig, readProcess_, workingDirL) import Data.Store as X (Store) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) +import qualified Data.Text.IO as T import qualified RIO.Text as T -- | Get a source for a file. Unlike @sourceFile@, doesn't require @@ -86,7 +97,7 @@ -- -- Throws a 'ReadProcessException' if unsuccessful in launching, or 'ProcessExitedUnsuccessfully' if the process itself fails. sinkProcessStderrStdout - :: forall e o env. (HasProcessContext env, HasLogFunc env) + :: forall e o env. (HasProcessContext env, HasLogFunc env, HasCallStack) => String -- ^ Command -> [String] -- ^ Command line arguments -> ConduitM ByteString Void (RIO env) e -- ^ Sink for stderr @@ -108,7 +119,7 @@ -- -- Throws a 'ReadProcessException' if unsuccessful. sinkProcessStdout - :: (HasProcessContext env, HasLogFunc env) + :: (HasProcessContext env, HasLogFunc env, HasCallStack) => String -- ^ Command -> [String] -- ^ Command line arguments -> ConduitM ByteString Void (RIO env) a -- ^ Sink for stdout @@ -132,13 +143,13 @@ -- | Read from the process, ignoring any output. -- -- Throws a 'ReadProcessException' exception if the process fails. -readProcessNull :: (HasProcessContext env, HasLogFunc env) +readProcessNull :: (HasProcessContext env, HasLogFunc env, HasCallStack) => String -- ^ Command -> [String] -- ^ Command line arguments -> RIO env () readProcessNull name args = -- We want the output to appear in any exceptions, so we capture and drop it - void $ proc name args readProcessStdout_ + void $ proc name args readProcess_ -- | Use the new 'ProcessContext', but retain the working directory -- from the parent environment. @@ -151,3 +162,54 @@ -- | Remove a trailing carriage return if present stripCR :: Text -> Text stripCR = T.dropSuffix "\r" + +-- | hIsTerminaDevice does not recognise handles to mintty terminals as terminal +-- devices, but isMinTTYHandle does. +hIsTerminalDeviceOrMinTTY :: MonadIO m => Handle -> m Bool +#ifdef WINDOWS +hIsTerminalDeviceOrMinTTY h = do + isTD <- hIsTerminalDevice h + if isTD + then return True + else liftIO $ withHandleToHANDLE h isMinTTYHandle +#else +hIsTerminalDeviceOrMinTTY = hIsTerminalDevice +#endif + +-- | Prompt the user by sending text to stdout, and taking a line of +-- input from stdin. +prompt :: MonadIO m => Text -> m Text +prompt txt = liftIO $ do + T.putStr txt + hFlush stdout + T.getLine + +-- | Prompt the user by sending text to stdout, and collecting a line +-- of input from stdin. While taking input from stdin, input echoing is +-- disabled, to hide passwords. +-- +-- Based on code from cabal-install, Distribution.Client.Upload +promptPassword :: MonadIO m => Text -> m Text +promptPassword txt = liftIO $ do + T.putStr txt + hFlush stdout + -- Save/restore the terminal echoing status (no echoing for entering + -- the password). + password <- withoutInputEcho T.getLine + -- Since the user's newline is not echoed, one needs to be inserted. + T.putStrLn "" + return password + +-- | Prompt the user by sending text to stdout, and collecting a line of +-- input from stdin. If something other than "y" or "n" is entered, then +-- print a message indicating that "y" or "n" is expected, and ask +-- again. +promptBool :: MonadIO m => Text -> m Bool +promptBool txt = liftIO $ do + input <- prompt txt + case input of + "y" -> return True + "n" -> return False + _ -> do + T.putStrLn "Please press either 'y' or 'n', and then enter." + promptBool txt diff --git a/src/Stack/PrettyPrint.hs b/src/Stack/PrettyPrint.hs --- a/src/Stack/PrettyPrint.hs +++ b/src/Stack/PrettyPrint.hs @@ -83,7 +83,7 @@ indentAfterLabel . f) prettyWarnNoIndentWith f = prettyWith LevelWarn ((line <>) . (styleWarning "Warning:" <+>) . f) -prettyErrorNoIndentWith f = prettyWith LevelWarn +prettyErrorNoIndentWith f = prettyWith LevelError ((line <>) . (styleError "Error:" <+>) . f) prettyDebug, prettyInfo, prettyNote, prettyWarn, prettyError, prettyWarnNoIndent, prettyErrorNoIndent @@ -154,6 +154,8 @@ output $ "Finished in" <+> displayMilliseconds diff <> ":" <+> msg return x +-- The following syles do not affect the colour of the background. + -- | Style an 'AnsiDoc' as an error. Should be used sparingly, not to style -- entire long messages. For example, it's used to style the "Error:" -- label for an error message, not the entire message. @@ -164,7 +166,7 @@ -- entire long messages. For example, it's used to style the "Warning:" -- label for an error message, not the entire message. styleWarning :: AnsiDoc -> AnsiDoc -styleWarning = yellow +styleWarning = dullyellow -- | Style an 'AnsiDoc' in a way to emphasize that it is a particularly good -- thing. @@ -178,7 +180,7 @@ -- | Style an 'AnsiDoc' as a filename. See 'styleDir' for directories. styleFile :: AnsiDoc -> AnsiDoc -styleFile = bold . white +styleFile = dullcyan -- | Style an 'AsciDoc' as a URL. For now using the same style as files. styleUrl :: AnsiDoc -> AnsiDoc @@ -196,7 +198,7 @@ -- a current thing. For example, could be used when talking about the -- current package we're processing when outputting the name of it. styleCurrent :: AnsiDoc -> AnsiDoc -styleCurrent = yellow +styleCurrent = dullyellow -- TODO: figure out how to describe this styleTarget :: AnsiDoc -> AnsiDoc diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -84,6 +84,8 @@ -- ^ The URL of the signature server , sdoptsBuildTarball :: Bool -- ^ Whether to build the tarball + , sdoptsTarPath :: Maybe FilePath + -- ^ Where to copy the tarball } newtype CheckException @@ -330,7 +332,7 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals [] [] [] -- provide empty list of globals. This is a hack around custom Setup.hs files $ \ee -> - withSingleContext ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _console _mlogFile -> do + withSingleContext ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _outputType -> do let outFile = toFilePath tmpdir FP. "source-files-list" cabal KeepTHLoading ["sdist", "--list-sources", outFile] contents <- liftIO (S.readFile outFile) @@ -422,7 +424,7 @@ case Check.checkPackage gdesc Nothing of [] -> Check.checkPackage gdesc (Just pkgDesc) x -> x - fileChecks <- liftIO $ Check.checkPackageFiles pkgDesc (toFilePath pkgDir) + fileChecks <- liftIO $ Check.checkPackageFiles minBound pkgDesc (toFilePath pkgDir) let checks = pkgChecks ++ fileChecks (errors, warnings) = let criticalIssue (Check.PackageBuildImpossible _) = True diff --git a/src/Stack/Script.hs b/src/Stack/Script.hs --- a/src/Stack/Script.hs +++ b/src/Stack/Script.hs @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} module Stack.Script ( scriptCmd ) where @@ -211,7 +212,7 @@ $ map (\(pn, lpi) -> ModuleInfo $ Map.fromList - $ map (\mn -> (mn, Set.singleton pn)) + $ map (, Set.singleton pn) $ Set.toList $ lpiExposedModules lpi) $ filter (\(pn, lpi) -> diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -64,13 +64,13 @@ import qualified Distribution.System as Cabal import Distribution.Text (simpleParse) import Lens.Micro (set) -import Network.HTTP.Simple (getResponseBody, getResponseStatusCode) +import Network.HTTP.StackClient (getResponseBody, getResponseStatusCode) import Network.HTTP.Download import Path import Path.CheckInstall (warnInstallSearchPathIssues) import Path.Extra (toFilePathNoTrailingSep) import Path.IO hiding (findExecutable, withSystemTempDir) -import Prelude (getLine, putStr, putStrLn, until) +import Prelude (until) import qualified RIO import Stack.Build (build) import Stack.Config (loadConfig) @@ -94,7 +94,6 @@ import qualified System.Directory as D import System.Environment (getExecutablePath, lookupEnv) import System.Exit (ExitCode (..), exitFailure) -import System.IO (stdout) import System.IO.Error (isPermissionError) import System.FilePath (searchPathSeparator) import qualified System.FilePath as FP @@ -578,7 +577,7 @@ eldconfigOut <- withModifyEnvVars sbinEnv $ proc "ldconfig" ["-p"] - $ tryAny . readProcessStdout_ + $ tryAny . fmap fst . readProcess_ let firstWords = case eldconfigOut of Right ldconfigOut -> mapMaybe (listToMaybe . T.words) $ T.lines $ T.decodeUtf8With T.lenientDecode @@ -685,7 +684,8 @@ -> UpgradeTo -> RIO env () upgradeCabal wc upgradeTo = do - logInfo "Manipulating the global Cabal is only for debugging purposes" + logWarn "Using deprecated --upgrade-cabal feature, this is not recommended" + logWarn "Manipulating the global Cabal is only for debugging purposes" let name = $(mkPackageName "Cabal") rmap <- resolvePackages Nothing mempty (Set.singleton name) installed <- getCabalPkgVer wc @@ -718,6 +718,10 @@ -> Version -> RIO env () doCabalInstall wc installed wantedVersion = do + when (wantedVersion >= $(mkVersion "2.2")) $ do + logWarn "--upgrade-cabal will almost certainly fail for Cabal 2.2 or later" + logWarn "See: https://github.com/commercialhaskell/stack/issues/4070" + logWarn "Valiantly attempting to build it anyway, but I know this is doomed" withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do logInfo $ "Installing Cabal-" <> @@ -765,7 +769,7 @@ exists <- doesExecutableExist exeName if exists then do - eres <- proc exeName ["--info"] $ tryAny . readProcessStdout_ + eres <- proc exeName ["--info"] $ tryAny . fmap fst . readProcess_ let minfo = do Right lbs <- Just eres pairs_ <- readMaybe $ BL8.unpack lbs :: Maybe [(String, String)] @@ -1354,10 +1358,10 @@ getCabalInstallVersion :: (HasProcessContext env, HasLogFunc env) => RIO env (Maybe Version) getCabalInstallVersion = do - ebs <- proc "cabal" ["--numeric-version"] $ tryAny . readProcessStdout_ + ebs <- tryAny $ proc "cabal" ["--numeric-version"] readProcess_ case ebs of Left _ -> return Nothing - Right bs -> Just <$> parseVersion (T.dropWhileEnd isSpace (T.decodeUtf8 (LBS.toStrict bs))) + Right (bs, _) -> Just <$> parseVersion (T.dropWhileEnd isSpace (T.decodeUtf8 (LBS.toStrict bs))) -- | Check if given processes appear to be present, throwing an exception if -- missing. @@ -1647,7 +1651,7 @@ eres <- withWorkingDir (toFilePath dir) $ proc exeName [ fp , "-no-user-package-db" - ] $ try . readProcessStdout_ + ] $ try . readProcess_ case eres of Left e -> throwIO $ GHCSanityCheckCompileFailed e ghc Right _ -> return () -- TODO check that the output of running the command is correct @@ -1703,7 +1707,7 @@ Map.empty else do -- Get a list of known locales by running @locale -a@. - elocales <- tryAny $ proc "locale" ["-a"] readProcessStdout_ + elocales <- tryAny $ fmap fst $ proc "locale" ["-a"] readProcess_ let -- Filter the list to only include locales with UTF-8 encoding. utf8Locales = @@ -1989,7 +1993,7 @@ | isPermissionError e -> do logWarn $ "Permission error when trying to copy: " <> displayShow e logWarn "Should I try to perform the file copy using sudo? This may fail" - toSudo <- prompt "Try using sudo? (y/n) " + toSudo <- promptBool "Try using sudo? (y/n) " when toSudo $ do let run cmd args = do ec <- proc cmd args runProcess @@ -2019,19 +2023,6 @@ logInfo "" logInfo "sudo file copy worked!" | otherwise -> throwM e - -prompt :: MonadIO m => String -> m Bool -prompt str = - liftIO go - where - go = do - putStr str - hFlush stdout - l <- getLine - case l of - 'y':_ -> return True - 'n':_ -> return False - _ -> putStrLn "Invalid entry, try again" >> go getDownloadVersion :: StackReleaseInfo -> Maybe Version getDownloadVersion (StackReleaseInfo val) = do diff --git a/src/Stack/Setup/Installed.hs b/src/Stack/Setup/Installed.hs --- a/src/Stack/Setup/Installed.hs +++ b/src/Stack/Setup/Installed.hs @@ -55,7 +55,7 @@ toolNameString ToolGhcjs{} = "ghcjs" parseToolText :: Text -> Maybe Tool -parseToolText (parseCompilerVersion -> Just (cv@GhcjsVersion{})) = Just (ToolGhcjs cv) +parseToolText (parseCompilerVersion -> Just cv@GhcjsVersion{}) = Just (ToolGhcjs cv) parseToolText (parsePackageIdentifierFromString . T.unpack -> Just pkgId) = Just (Tool pkgId) parseToolText _ = Nothing @@ -88,6 +88,16 @@ x <- T.stripSuffix ".installed" $ T.pack $ toFilePath $ filename fp parseToolText x +-- | See https://github.com/commercialhaskell/stack/issues/4086. +warnAboutGHCJS :: HasLogFunc env => RIO env () +warnAboutGHCJS = + logWarn $ "Building a GHCJS project. " <> fromString ghcjsWarning + +ghcjsWarning :: String +ghcjsWarning = unwords + [ "Note that GHCJS support in Stack is EXPERIMENTAL" + ] + getCompilerVersion :: (HasProcessContext env, HasLogFunc env) => WhichCompiler @@ -96,17 +106,18 @@ case wc of Ghc -> do logDebug "Asking GHC for its version" - bs <- proc "ghc" ["--numeric-version"] readProcessStdout_ + bs <- fst <$> proc "ghc" ["--numeric-version"] readProcess_ let (_, ghcVersion) = versionFromEnd $ BL.toStrict bs x <- GhcVersion <$> parseVersion (T.decodeUtf8 ghcVersion) logDebug $ "GHC version is: " <> display x return x Ghcjs -> do + warnAboutGHCJS logDebug "Asking GHCJS for its version" -- Output looks like -- -- The Glorious Glasgow Haskell Compilation System for JavaScript, version 0.1.0 (GHC 7.10.2) - bs <- proc "ghcjs" ["--version"] readProcessStdout_ + bs <- fst <$> proc "ghcjs" ["--version"] readProcess_ let (rest, ghcVersion) = T.decodeUtf8 <$> versionFromEnd (BL.toStrict bs) (_, ghcjsVersion) = T.decodeUtf8 <$> versionFromEnd rest GhcjsVersion <$> parseVersion ghcjsVersion <*> parseVersion ghcVersion diff --git a/src/Stack/SetupCmd.hs b/src/Stack/SetupCmd.hs --- a/src/Stack/SetupCmd.hs +++ b/src/Stack/SetupCmd.hs @@ -63,7 +63,7 @@ <> OA.help "Install a specific version of Cabal" ) latestParser = OA.flag' Latest ( OA.long "upgrade-cabal" - <> OA.help "Install latest version of Cabal globally" ) + <> OA.help "DEPRECATED Install latest version of Cabal globally" ) setupParser :: OA.Parser SetupCmdOpts setupParser = SetupCmdOpts diff --git a/src/Stack/Sig/Sign.hs b/src/Stack/Sig/Sign.hs --- a/src/Stack/Sig/Sign.hs +++ b/src/Stack/Sig/Sign.hs @@ -21,10 +21,8 @@ import Stack.Prelude import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as L -import Network.HTTP.Client (RequestBody (RequestBodyBS)) import Network.HTTP.Download -import Network.HTTP.Simple (setRequestMethod, setRequestBody, getResponseStatusCode) -import Network.HTTP.Types (methodPut) +import Network.HTTP.StackClient (RequestBody (RequestBodyBS), setRequestMethod, setRequestBody, getResponseStatusCode, methodPut) import Path import Stack.Package import Stack.Sig.GPG diff --git a/src/Stack/Snapshot.hs b/src/Stack/Snapshot.hs --- a/src/Stack/Snapshot.hs +++ b/src/Stack/Snapshot.hs @@ -39,11 +39,10 @@ import Distribution.InstalledPackageInfo (PError) import Distribution.PackageDescription (GenericPackageDescription) import qualified Distribution.PackageDescription as C -import qualified Distribution.Types.UnqualComponentName as C import Distribution.System (Platform) import Distribution.Text (display) import qualified Distribution.Version as C -import Network.HTTP.Client (Request) +import Network.HTTP.StackClient (Request) import Network.HTTP.Download import qualified RIO import Network.URI (isURI) @@ -579,8 +578,6 @@ , lpiFlags = Map.empty , lpiGhcOptions = [] , lpiPackageDeps = Map.empty - , lpiProvidedExes = Set.empty - , lpiNeededExes = Map.empty , lpiExposedModules = Set.empty , lpiHide = False } @@ -654,8 +651,6 @@ , lpiFlags = Map.empty , lpiGhcOptions = [] , lpiPackageDeps = Map.unions $ map goDep $ dpDepends dp - , lpiProvidedExes = Set.empty - , lpiNeededExes = Map.empty , lpiExposedModules = Set.fromList $ map (ModuleName . encodeUtf8) $ dpExposedModules dp , lpiHide = not $ dpIsExposed dp } @@ -819,12 +814,6 @@ , lpiPackageDeps = Map.map fromVersionRange $ Map.filterWithKey (const . (/= name)) $ packageDependencies pconfig pd - , lpiProvidedExes = - Set.fromList - $ map (ExeName . T.pack . C.unUnqualComponentName . C.exeName) - $ C.executables pd - , lpiNeededExes = Map.map fromVersionRange - $ packageDescTools pd , lpiExposedModules = maybe Set.empty (Set.fromList . map fromCabalModuleName . C.exposedModules) diff --git a/src/Stack/Solver.hs b/src/Stack/Solver.hs --- a/src/Stack/Solver.hs +++ b/src/Stack/Solver.hs @@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} module Stack.Solver ( cabalPackagesCheck @@ -112,11 +113,11 @@ fmap toFilePath cabalfps try ( withWorkingDir (toFilePath tmpdir) - $ proc "cabal" args readProcessStdout_ + $ proc "cabal" args readProcess_ ) >>= either (parseCabalErrors . eceStderr) - (parseCabalOutput . BL.toStrict) + (parseCabalOutput . BL.toStrict . fst) where errCheck = T.isInfixOf "Could not resolve dependencies" @@ -343,7 +344,7 @@ -- combine entry in both maps (\_ v f -> Just (v, f)) -- convert entry in first map only - (fmap (flip (,) Map.empty)) + (fmap (, Map.empty)) -- convert entry in second map only (\m -> if Map.null m then Map.empty else error "Bug: An entry in flag map must have a corresponding \ diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} @@ -671,11 +672,13 @@ instance NFData ConfigureOpts -- | Information on a compiled package: the library conf file (if relevant), --- and all of the executable paths. +-- the sublibraries (if present) and all of the executable paths. data PrecompiledCache = PrecompiledCache -- Use FilePath instead of Path Abs File for Binary instances { pcLibrary :: !(Maybe FilePath) -- ^ .conf file inside the package database + , pcSubLibs :: ![FilePath] + -- ^ .conf file inside the package database, for each of the sublibraries , pcExes :: ![FilePath] -- ^ Full paths to executables } @@ -684,4 +687,8 @@ instance NFData PrecompiledCache precompiledCacheVC :: VersionConfig PrecompiledCache -precompiledCacheVC = storeVersionConfig "precompiled-v1" "eMzSOwaHJMamA5iNKs1A025frlQ=" +#if MIN_VERSION_template_haskell(2,14,0) +precompiledCacheVC = storeVersionConfig "precompiled-v2" "1Q08F5_iKDGDMPCuBG0-Av9nEKk=" +#else +precompiledCacheVC = storeVersionConfig "precompiled-v2" "55vMMtbIlS4UukKnSmjs1SrI01o=" +#endif diff --git a/src/Stack/Types/BuildPlan.hs b/src/Stack/Types/BuildPlan.hs --- a/src/Stack/Types/BuildPlan.hs +++ b/src/Stack/Types/BuildPlan.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} @@ -43,7 +44,7 @@ import Data.Text.Encoding (encodeUtf8) import qualified Distribution.ModuleName as C import qualified Distribution.Version as C -import Network.HTTP.Client (parseRequest) +import Network.HTTP.StackClient (parseRequest) import Stack.Prelude import Stack.Types.Compiler import Stack.Types.FlagName @@ -102,7 +103,11 @@ instance NFData SnapshotDef snapshotDefVC :: VersionConfig SnapshotDef +#if MIN_VERSION_template_haskell(2,14,0) +snapshotDefVC = storeVersionConfig "sd-v1" "u-V-7pmU0YA-nXZFI0UBIST3JdY=" +#else snapshotDefVC = storeVersionConfig "sd-v1" "CKo7nln8EXkw07Gq-4ATxszNZiE=" +#endif -- | A relative file path including a unique string for the given -- snapshot. @@ -310,7 +315,11 @@ instance NFData LoadedSnapshot loadedSnapshotVC :: VersionConfig LoadedSnapshot -loadedSnapshotVC = storeVersionConfig "ls-v4" "a_ljrJRo8hA_-gcIDP9c6NXJ2pE=" +#if MIN_VERSION_template_haskell(2,14,0) +loadedSnapshotVC = storeVersionConfig "ls-v5" "Rl-3KjZ1LqhIyGy-o0HCC-I6cRc=" +#else +loadedSnapshotVC = storeVersionConfig "ls-v5" "CeSRWh1VU8v0__kwA__msbe6WlU=" +#endif -- | Information on a single package for the 'LoadedSnapshot' which -- can be installed. @@ -340,11 +349,6 @@ , lpiPackageDeps :: !(Map PackageName VersionIntervals) -- ^ All packages which must be built/copied/registered before -- this package. - , lpiProvidedExes :: !(Set ExeName) - -- ^ The names of executables provided by this package, for - -- performing build tool lookups. - , lpiNeededExes :: !(Map ExeName VersionIntervals) - -- ^ Executables needed by this package. , lpiExposedModules :: !(Set ModuleName) -- ^ Modules exposed by this package's library , lpiHide :: !Bool diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -182,11 +182,14 @@ import Data.Attoparsec.Args (parseArgs, EscapingMode (Escaping)) import qualified Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16)) import qualified Data.ByteString.Char8 as S8 +import Data.Coerce (coerce) import Data.List (stripPrefix) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map import qualified Data.Map.Strict as M +import qualified Data.Monoid as Monoid +import Data.Monoid.Map (MonoidMap(..)) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -335,6 +338,8 @@ -- command disallows this. ,configSaveHackageCreds :: !Bool -- ^ Should we save Hackage credentials to a file? + ,configHackageBaseUrl :: !Text + -- ^ Hackage base URL used when uploading packages ,configRunner :: !Runner ,configCabalLoader :: !CabalLoader } @@ -401,6 +406,7 @@ data SpecialExecCmd = ExecCmd String + | ExecRun | ExecGhc | ExecRunGhc deriving (Show, Eq) @@ -738,10 +744,14 @@ -- ^ Template parameters. ,configMonoidScmInit :: !(First SCM) -- ^ Initialize SCM (e.g. git init) when making new projects? - ,configMonoidGhcOptionsByName :: !(Map PackageName [Text]) - -- ^ See 'configGhcOptionsByName' - ,configMonoidGhcOptionsByCat :: !(Map ApplyGhcOptions [Text]) - -- ^ See 'configGhcOptionsAll' + ,configMonoidGhcOptionsByName :: !(MonoidMap PackageName (Monoid.Dual [Text])) + -- ^ See 'configGhcOptionsByName'. Uses 'Monoid.Dual' so that + -- options from the configs on the right come first, so that they + -- can be overridden. + ,configMonoidGhcOptionsByCat :: !(MonoidMap ApplyGhcOptions (Monoid.Dual [Text])) + -- ^ See 'configGhcOptionsAll'. Uses 'Monoid.Dual' so that options + -- from the configs on the right come first, so that they can be + -- overridden. ,configMonoidExtraPath :: ![Path Abs Dir] -- ^ Additional paths to search for executables in ,configMonoidSetupInfoLocations :: ![SetupInfoLocation] @@ -770,6 +780,8 @@ -- ^ See 'configDumpLogs' , configMonoidSaveHackageCreds :: !(First Bool) -- ^ See 'configSaveHackageCreds' + , configMonoidHackageBaseUrl :: !(First Text) + -- ^ See 'configHackageBaseUrl' , configMonoidIgnoreRevisionMismatch :: !(First Bool) -- ^ See 'configIgnoreRevisionMismatch' } @@ -842,13 +854,13 @@ return x (Nothing, Nothing) -> return [] - let configMonoidGhcOptionsByCat = Map.fromList + let configMonoidGhcOptionsByCat = coerce $ Map.fromList [ (AGOEverything, optionsEverything) , (AGOLocals, Map.findWithDefault [] GOKLocals options) , (AGOTargets, Map.findWithDefault [] GOKTargets options) ] - configMonoidGhcOptionsByName = Map.fromList + configMonoidGhcOptionsByName = coerce $ Map.fromList [(name, opts) | (GOKPackage name, opts) <- Map.toList options] configMonoidExtraPath <- obj ..:? configMonoidExtraPathName ..!= [] @@ -867,6 +879,7 @@ configMonoidAllowDifferentUser <- First <$> obj ..:? configMonoidAllowDifferentUserName configMonoidDumpLogs <- First <$> obj ..:? configMonoidDumpLogsName configMonoidSaveHackageCreds <- First <$> obj ..:? configMonoidSaveHackageCredsName + configMonoidHackageBaseUrl <- First <$> obj ..:? configMonoidHackageBaseUrlName configMonoidIgnoreRevisionMismatch <- First <$> obj ..:? configMonoidIgnoreRevisionMismatchName return ConfigMonoid {..} @@ -1006,6 +1019,9 @@ configMonoidSaveHackageCredsName :: Text configMonoidSaveHackageCredsName = "save-hackage-creds" + +configMonoidHackageBaseUrlName :: Text +configMonoidHackageBaseUrlName = "hackage-base-url" configMonoidIgnoreRevisionMismatchName :: Text configMonoidIgnoreRevisionMismatchName = "ignore-revision-mismatch" diff --git a/src/Stack/Types/Config/Build.hs b/src/Stack/Types/Config/Build.hs --- a/src/Stack/Types/Config/Build.hs +++ b/src/Stack/Types/Config/Build.hs @@ -88,6 +88,9 @@ -- ^ Whether to enable split-objs. ,boptsSkipComponents :: ![Text] -- ^ Which components to skip when building + ,boptsInterleavedOutput :: !Bool + -- ^ Should we use the interleaved GHC output when building + -- multiple packages? } deriving (Show) @@ -117,6 +120,7 @@ , boptsCabalVerbose = False , boptsSplitObjs = False , boptsSkipComponents = [] + , boptsInterleavedOutput = False } defaultBuildOptsCLI ::BuildOptsCLI @@ -185,6 +189,7 @@ , buildMonoidCabalVerbose :: !(First Bool) , buildMonoidSplitObjs :: !(First Bool) , buildMonoidSkipComponents :: ![Text] + , buildMonoidInterleavedOutput :: !(First Bool) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings BuildOptsMonoid) where @@ -216,6 +221,7 @@ buildMonoidCabalVerbose <- First <$> o ..:? buildMonoidCabalVerboseArgName buildMonoidSplitObjs <- First <$> o ..:? buildMonoidSplitObjsName buildMonoidSkipComponents <- o ..:? buildMonoidSkipComponentsName ..!= mempty + buildMonoidInterleavedOutput <- First <$> o ..:? buildMonoidInterleavedOutputName return BuildOptsMonoid{..}) buildMonoidLibProfileArgName :: Text @@ -289,6 +295,9 @@ buildMonoidSkipComponentsName :: Text buildMonoidSkipComponentsName = "skip-components" + +buildMonoidInterleavedOutputName :: Text +buildMonoidInterleavedOutputName = "interleaved-output" instance Semigroup BuildOptsMonoid where (<>) = mappenddefault diff --git a/src/Stack/Types/NamedComponent.hs b/src/Stack/Types/NamedComponent.hs --- a/src/Stack/Types/NamedComponent.hs +++ b/src/Stack/Types/NamedComponent.hs @@ -8,7 +8,9 @@ , exeComponents , testComponents , benchComponents + , internalLibComponents , isCLib + , isCInternalLib , isCExe , isCTest , isCBench @@ -59,9 +61,19 @@ mBenchName (CBench name) = Just name mBenchName _ = Nothing +internalLibComponents :: Set NamedComponent -> Set Text +internalLibComponents = Set.fromList . mapMaybe mInternalName . Set.toList + where + mInternalName (CInternalLib name) = Just name + mInternalName _ = Nothing + isCLib :: NamedComponent -> Bool isCLib CLib{} = True isCLib _ = False + +isCInternalLib :: NamedComponent -> Bool +isCInternalLib CInternalLib{} = True +isCInternalLib _ = False isCExe :: NamedComponent -> Bool isCExe CExe{} = True diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -122,13 +122,14 @@ ,packageVersion :: !Version -- ^ Version of the package ,packageLicense :: !(Either SPDX.License License) -- ^ The license the package was released under. ,packageFiles :: !GetPackageFiles -- ^ Get all files of the package. - ,packageDeps :: !(Map PackageName VersionRange) -- ^ Packages that the package depends on. - ,packageTools :: !(Map ExeName VersionRange) -- ^ A build tool name. + ,packageDeps :: !(Map PackageName DepValue) -- ^ Packages that the package depends on, both as libraries and build tools. + ,packageUnknownTools :: !(Set ExeName) -- ^ Build tools specified in the legacy manner (build-tools:) that failed the hard-coded lookup. ,packageAllDeps :: !(Set PackageName) -- ^ Original dependencies (not sieved). ,packageGhcOptions :: ![Text] -- ^ Ghc options used on package. ,packageFlags :: !(Map FlagName Bool) -- ^ Flags used on package. ,packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags. ,packageLibraries :: !PackageLibraries -- ^ does the package have a buildable library stanza? + ,packageInternalLibraries :: !(Set Text) -- ^ names of internal libraries ,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites ,packageBenchmarks :: !(Set Text) -- ^ names of benchmarks ,packageExes :: !(Set Text) -- ^ names of executables @@ -139,6 +140,27 @@ -- ^ If present: custom-setup dependencies } deriving (Show,Typeable) + +-- | The value for a map from dependency name. This contains both the +-- version range and the type of dependency, and provides a semigroup +-- instance. +data DepValue = DepValue + { dvVersionRange :: !VersionRange + , dvType :: !DepType + } + deriving (Show,Typeable) +instance Semigroup DepValue where + DepValue a x <> DepValue b y = DepValue (intersectVersionRanges a b) (x <> y) + +-- | Is this package being used as a library, or just as a build tool? +-- If the former, we need to ensure that a library actually +-- exists. See +-- +data DepType = AsLibrary | AsBuildTool + deriving (Show, Eq) +instance Semigroup DepType where + AsLibrary <> _ = AsLibrary + AsBuildTool <> x = x packageIdentifier :: Package -> PackageIdentifier packageIdentifier pkg = diff --git a/src/Stack/Types/PackageIdentifier.hs b/src/Stack/Types/PackageIdentifier.hs --- a/src/Stack/Types/PackageIdentifier.hs +++ b/src/Stack/Types/PackageIdentifier.hs @@ -209,8 +209,7 @@ packageIdentifierParser = do name <- packageNameParser char '-' - version <- versionParser - return (PackageIdentifier name version) + PackageIdentifier name <$> versionParser -- | Convenient way to parse a package identifier from a 'Text'. parsePackageIdentifier :: MonadThrow m => Text -> m PackageIdentifier diff --git a/src/Stack/Types/PackageIndex.hs b/src/Stack/Types/PackageIndex.hs --- a/src/Stack/Types/PackageIndex.hs +++ b/src/Stack/Types/PackageIndex.hs @@ -42,6 +42,17 @@ -- file revision indicates the hash of the contents of the cabal file, -- and the offset into the index tarball. -- +-- The reason for each 'Version' mapping to a two element list of +-- 'CabalHash'es is because some older Stackage snapshots have CRs in +-- their cabal files. For compatibility with these older snapshots, +-- both hashes are stored: the first element of the two element list +-- being the original hash, and the (potential) second element with +-- the CRs stripped. [Note: This is was initially stored as a two +-- element list, and cannot be easily packed into more explict ADT or +-- newtype because of some template-haskell that would need to be +-- modified as well: the 'versionedDecodeOrLoad' function call found +-- in the 'getPackageCaches' function in 'Stack.PackageIndex'.] +-- -- It's assumed that cabal files appear in the index tarball in the -- correct revision order. newtype PackageCache index = PackageCache diff --git a/src/Stack/Types/Resolver.hs b/src/Stack/Types/Resolver.hs --- a/src/Stack/Types/Resolver.hs +++ b/src/Stack/Types/Resolver.hs @@ -49,7 +49,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.Text.Read (decimal) import Data.Time (Day) -import Network.HTTP.Client (Request, parseUrlThrow) +import Network.HTTP.StackClient (Request, parseUrlThrow) import Options.Applicative (ReadM) import qualified Options.Applicative.Types as OA import Path diff --git a/src/Stack/Types/Runner.hs b/src/Stack/Types/Runner.hs --- a/src/Stack/Types/Runner.hs +++ b/src/Stack/Types/Runner.hs @@ -116,4 +116,4 @@ | otherwise = w data ColorWhen = ColorNever | ColorAlways | ColorAuto - deriving (Show, Generic) + deriving (Eq, Show, Generic) diff --git a/src/Stack/Types/TemplateName.hs b/src/Stack/Types/TemplateName.hs --- a/src/Stack/Types/TemplateName.hs +++ b/src/Stack/Types/TemplateName.hs @@ -6,14 +6,24 @@ -- | Template name handling. -module Stack.Types.TemplateName where +module Stack.Types.TemplateName + ( TemplateName + , RepoTemplatePath (..) + , RepoService (..) + , TemplatePath (..) + , mkTemplateName + , templateName + , templatePath + , parseTemplateNameFromString + , parseRepoPathWithService + , templateNameArgument + , templateParamArgument + ) where -import Data.Aeson.Extended (FromJSON, withText, parseJSON) -import Data.Aeson.Types (typeMismatch) +import Data.Aeson (FromJSON (..), withText) import qualified Data.Text as T -import Data.Yaml (Value(Object), (.:?)) import Language.Haskell.TH -import Network.HTTP.Client (parseRequest) +import Network.HTTP.StackClient (parseRequest) import qualified Options.Applicative as O import Path import Path.Internal @@ -30,21 +40,25 @@ -- the template repository | UrlPath String -- ^ a full URL + | RepoPath RepoTemplatePath deriving (Eq, Ord, Show) +-- | Details for how to access a template from a remote repo. +data RepoTemplatePath = RepoTemplatePath + { rtpService :: RepoService + , rtpUser :: Text + , rtpTemplate :: Text + } + deriving (Eq, Ord, Show) + +-- | Services from which templates can be retrieved from a repository. +data RepoService = Github | Gitlab | Bitbucket + deriving (Eq, Ord, Show) + instance FromJSON TemplateName where parseJSON = withText "TemplateName" $ either fail return . parseTemplateNameFromString . T.unpack -data TemplateInfo = TemplateInfo - { author :: Maybe Text - , description :: Maybe Text } - deriving (Eq, Ord, Show) - -instance FromJSON TemplateInfo where - parseJSON (Object v) = TemplateInfo <$> v .:? "author" <*> v .:? "description" - parseJSON invalid = typeMismatch "Template Info" invalid - -- | An argument which accepts a template name of the format -- @foo.hsfiles@ or @foo@, ultimately normalized to @foo@. templateNameArgument :: O.Mod O.ArgumentFields TemplateName @@ -79,12 +93,13 @@ $ asum (validParses prefix hsf orig) validParses prefix hsf orig = -- NOTE: order is important - [ TemplateName (T.pack orig) . UrlPath <$> (parseRequest orig *> Just orig) + [ TemplateName prefix . RepoPath <$> parseRepoPath hsf + , TemplateName (T.pack orig) . UrlPath <$> (parseRequest orig *> Just orig) , TemplateName prefix . AbsPath <$> parseAbsFile hsf , TemplateName prefix . RelPath <$> parseRelFile hsf ] expected = "Expected a template like: foo or foo.hsfiles or\ - \ https://example.com/foo.hsfiles" + \ https://example.com/foo.hsfiles or github:user/foo" -- | Make a template name. mkTemplateName :: String -> Q Exp @@ -98,6 +113,11 @@ AbsPath (Path fp) -> [|AbsPath (Path fp)|] RelPath (Path fp) -> [|RelPath (Path fp)|] UrlPath fp -> [|UrlPath fp|] + RepoPath (RepoTemplatePath sv u t) -> + case sv of + Github -> [|RepoPath $ RepoTemplatePath Github u t|] + Gitlab -> [|RepoPath $ RepoTemplatePath Gitlab u t|] + Bitbucket -> [|RepoPath $ RepoTemplatePath Bitbucket u t|] -- | Get a text representation of the template name. templateName :: TemplateName -> Text @@ -106,3 +126,27 @@ -- | Get the path of the template. templatePath :: TemplateName -> TemplatePath templatePath (TemplateName _ fp) = fp + +defaultRepoUserForService :: RepoService -> Maybe Text +defaultRepoUserForService Github = Just "commercialhaskell" +defaultRepoUserForService _ = Nothing + +-- | Parses a template path of the form @github:user/template@. +parseRepoPath :: String -> Maybe RepoTemplatePath +parseRepoPath s = + case T.splitOn ":" (T.pack s) of + ["github" , rest] -> parseRepoPathWithService Github rest + ["gitlab" , rest] -> parseRepoPathWithService Gitlab rest + ["bitbucket" , rest] -> parseRepoPathWithService Bitbucket rest + _ -> Nothing + +-- | Parses a template path of the form @user/template@, given a service +parseRepoPathWithService :: RepoService -> Text -> Maybe RepoTemplatePath +parseRepoPathWithService service path = + case T.splitOn "/" path of + [user, name] -> Just $ RepoTemplatePath service user name + [name] -> do + repoUser <- defaultRepoUserForService service + Just $ RepoTemplatePath service repoUser name + _ -> Nothing + diff --git a/src/Stack/Upgrade.hs b/src/Stack/Upgrade.hs --- a/src/Stack/Upgrade.hs +++ b/src/Stack/Upgrade.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} @@ -24,6 +24,10 @@ import qualified Paths_stack as Paths import Stack.Build import Stack.Config +-- Following import is redundant on non-Windows operating systems +#ifdef WINDOWS +import Stack.DefaultColorWhen (defaultColorWhen) +#endif import Stack.Fetch import Stack.PackageIndex import Stack.PrettyPrint @@ -212,6 +216,13 @@ -- --git" not working for earlier versions. let args = [ "clone", repo , "stack", "--depth", "1", "--recursive", "--branch", branch] withWorkingDir (toFilePath tmp) $ proc "git" args runProcess_ +#ifdef WINDOWS + -- On Windows 10, an upstream issue with the `git clone` command + -- means that command clears, but does not then restore, the + -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. + -- The folowing hack re-enables the lost ANSI-capability. + _ <- liftIO defaultColorWhen +#endif return $ Just $ tmp $(mkRelDir "stack") Nothing -> do updateAllIndices diff --git a/src/Stack/Upload.hs b/src/Stack/Upload.hs --- a/src/Stack/Upload.hs +++ b/src/Stack/Upload.hs @@ -25,18 +25,12 @@ import qualified Data.Conduit.Binary as CB import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) -import qualified Data.Text.IO as TIO -import Network.HTTP.Client (Response, - RequestBody(RequestBodyLBS), - Request) -import Network.HTTP.StackClient (withResponse, httpNoBody) -import Network.HTTP.Simple (getResponseStatusCode, +import Network.HTTP.StackClient (Request, RequestBody(RequestBodyLBS), Response, withResponse, httpNoBody, getGlobalManager, getResponseStatusCode, getResponseBody, setRequestHeader, - parseRequest) -import Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody, - partBS, partLBS) -import Network.HTTP.Client.TLS (getGlobalManager, + parseRequest, + formDataBody, partFileRequestBody, + partBS, partLBS, applyDigestAuth, displayDigestAuthException) import Stack.Types.Config @@ -46,8 +40,7 @@ import System.Directory (createDirectoryIfMissing, removeFile) import System.FilePath ((), takeFileName) -import System.IO (stdout, putStrLn, putStr, getLine, print) -- TODO remove putStrLn, use logInfo -import System.IO.Echo (withoutInputEcho) +import System.IO (stdout, putStrLn, putStr, print) -- TODO remove putStrLn, use logInfo -- | Username and password to log into Hackage. -- @@ -87,10 +80,8 @@ return $ mkCreds fp where fromPrompt fp = do - putStr "Hackage username: " - hFlush stdout - username <- TIO.getLine - password <- promptPassword + username <- prompt "Hackage username: " + password <- promptPassword "Hackage password: " let hc = HackageCreds { hcUsername = username , hcPassword = password @@ -98,46 +89,22 @@ } when (configSaveHackageCreds config) $ do - let prompt = "Save hackage credentials to file at " ++ fp ++ " [y/n]? " - putStr prompt - input <- loopPrompt prompt + shouldSave <- promptBool $ T.pack $ + "Save hackage credentials to file at " ++ fp ++ " [y/n]? " putStrLn "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false" - hFlush stdout - case input of - "y" -> do - L.writeFile fp (encode hc) - putStrLn "Saved!" - hFlush stdout - _ -> return () + when shouldSave $ do + L.writeFile fp (encode hc) + putStrLn "Saved!" + hFlush stdout return hc - loopPrompt :: String -> IO String - loopPrompt p = do - input <- TIO.getLine - case input of - "y" -> return "y" - "n" -> return "n" - _ -> do - putStr p - loopPrompt p - credsFile :: Config -> IO FilePath credsFile config = do let dir = toFilePath (view stackRootL config) "upload" createDirectoryIfMissing True dir return $ dir "credentials.json" --- | Lifted from cabal-install, Distribution.Client.Upload -promptPassword :: IO Text -promptPassword = do - putStr "Hackage password: " - hFlush stdout - -- save/restore the terminal echoing status (no echoing for entering the password) - passwd <- withoutInputEcho $ fmap T.pack getLine - putStrLn "" - return passwd - applyCreds :: HackageCreds -> Request -> IO Request applyCreds creds req0 = do manager <- getGlobalManager @@ -159,13 +126,14 @@ -- sending a file like 'upload', this sends a lazy bytestring. -- -- Since 0.1.2.1 -uploadBytes :: HackageCreds +uploadBytes :: String -- ^ Hackage base URL + -> HackageCreds -> String -- ^ tar file name -> L.ByteString -- ^ tar file contents -> IO () -uploadBytes creds tarName bytes = do +uploadBytes baseUrl creds tarName bytes = do let req1 = setRequestHeader "Accept" ["text/plain"] - "https://hackage.haskell.org/packages/" + (fromString $ baseUrl <> "packages/") formData = [partFileRequestBody "package" tarName (RequestBodyLBS bytes)] req2 <- formDataBody formData req1 req3 <- applyCreds creds req2 @@ -199,16 +167,21 @@ -- | Upload a single tarball with the given @Uploader@. -- -- Since 0.1.0.0 -upload :: HackageCreds -> FilePath -> IO () -upload creds fp = uploadBytes creds (takeFileName fp) =<< L.readFile fp +upload :: String -- ^ Hackage base URL + -> HackageCreds + -> FilePath + -> IO () +upload baseUrl creds fp = uploadBytes baseUrl creds (takeFileName fp) =<< L.readFile fp -uploadRevision :: HackageCreds +uploadRevision :: String -- ^ Hackage base URL + -> HackageCreds -> PackageIdentifier -> L.ByteString -> IO () -uploadRevision creds ident cabalFile = do +uploadRevision baseUrl creds ident cabalFile = do req0 <- parseRequest $ concat - [ "https://hackage.haskell.org/package/" + [ baseUrl + , "package/" , packageIdentifierString ident , "/" , packageNameString $ packageIdentifierName ident diff --git a/src/main/Main.hs b/src/main/Main.hs --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -28,11 +28,12 @@ import Data.IORef.RunOnce (runOnce) import Data.List import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Data.Text as T import Data.Version (showVersion) import RIO.Process #ifdef USE_GIT_INFO -import Development.GitRev (gitCommitCount, gitHash) +import GitHash (giCommitCount, giHash, tGitInfoCwd) #endif import Distribution.System (buildArch) import qualified Distribution.Text as Cabal (display) @@ -56,6 +57,7 @@ import Stack.Constants import Stack.Constants.Config import Stack.Coverage +import Stack.DefaultColorWhen (defaultColorWhen) import qualified Stack.Docker as Docker import Stack.Dot import Stack.GhcPkg (findGhcPkgField) @@ -97,6 +99,7 @@ import Stack.Types.Version import Stack.Types.Config import Stack.Types.Compiler +import Stack.Types.NamedComponent import Stack.Types.Nix import Stack.Upgrade import qualified Stack.Upload as Upload @@ -104,6 +107,7 @@ import System.Environment (getProgName, getArgs, withArgs) import System.Exit import System.FilePath (isValid, pathSeparator) +import qualified System.FilePath as FP import System.IO (stderr, stdin, stdout, BufferMode(..), hPutStrLn, hPrint, hGetEncoding, hSetEncoding) -- | Change the character encoding of the given Handle to transliterate @@ -124,13 +128,12 @@ [ [$(simpleVersion Meta.version)] -- Leave out number of commits for --depth=1 clone -- See https://github.com/commercialhaskell/stack/issues/792 - , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) && - commitCount /= ("UNKNOWN" :: String)] + , [" (" ++ show commitCount ++ " commits)" | commitCount /= 1] , [" ", Cabal.display buildArch] , [depsString, warningString] ] where - commitCount = $gitCommitCount + commitCount = giCommitCount $$tGitInfoCwd #else versionString' = showVersion Meta.version @@ -167,7 +170,11 @@ hSetTranslit stderr args <- getArgs progName <- getProgName - isTerminal <- hIsTerminalDevice stdout + isTerminal <- hIsTerminalDeviceOrMinTTY stdout + -- On Windows, where applicable, defaultColorWhen has the side effect of + -- enabling ANSI for ANSI-capable native (ConHost) terminals, if not already + -- ANSI-enabled. + defColorWhen <- defaultColorWhen execExtraHelp args Docker.dockerHelpOptName (dockerOptsParser False) @@ -183,7 +190,7 @@ Left (exitCode :: ExitCode) -> throwIO exitCode Right (globalMonoid,run) -> do - let global = globalOptsFromMonoid isTerminal globalMonoid + let global = globalOptsFromMonoid isTerminal defColorWhen globalMonoid when (globalLogLevel global == LevelDebug) $ hPutStrLn stderr versionString' case globalReExecVersion global of Just expectVersion -> do @@ -357,6 +364,10 @@ "Execute a command" execCmd (execOptsParser Nothing) + addCommand' "run" + "Build and run an executable. Defaults to the first available executable if none is provided as the first argument." + execCmd + (execOptsParser $ Just ExecRun) addGhciCommand' "ghci" "Run ghci in the context of package(s) (experimental)" ghciCmd @@ -667,7 +678,7 @@ upgrade (globalConfigMonoid go) (globalResolver go) #ifdef USE_GIT_INFO - (find (/= "UNKNOWN") [$gitHash]) + (Just (giHash $$tGitInfoCwd)) #else Nothing #endif @@ -675,7 +686,7 @@ -- | Upload to Hackage uploadCmd :: SDistOpts -> GlobalOpts -> IO () -uploadCmd (SDistOpts [] _ _ _ _ _) go = +uploadCmd (SDistOpts [] _ _ _ _ _ _) go = withConfigAndLock go . prettyErrorL $ [ flow "To upload the current package, please run" , styleShell "stack upload ." @@ -706,6 +717,7 @@ ] liftIO exitFailure config <- view configL + let hackageUrl = T.unpack $ configHackageBaseUrl config getCreds <- liftIO (runOnce (Upload.loadCreds config)) mapM_ (resolveFile' >=> checkSDistTarball sdistOpts) files forM_ @@ -714,7 +726,7 @@ do tarFile <- resolveFile' file liftIO $ do creds <- getCreds - Upload.upload creds (toFilePath tarFile) + Upload.upload hackageUrl creds (toFilePath tarFile) when (sdoptsSign sdistOpts) (void $ @@ -728,8 +740,8 @@ checkSDistTarball' sdistOpts tarName tarBytes liftIO $ do creds <- getCreds - Upload.uploadBytes creds tarName tarBytes - forM_ mcabalRevision $ uncurry $ Upload.uploadRevision creds + Upload.uploadBytes hackageUrl creds tarName tarBytes + forM_ mcabalRevision $ uncurry $ Upload.uploadRevision hackageUrl creds tarPath <- parseRelFile tarName when (sdoptsSign sdistOpts) @@ -764,19 +776,21 @@ tarPath <- (distDir ) <$> parseRelFile tarName ensureDir (parent tarPath) liftIO $ L.writeFile (toFilePath tarPath) tarBytes - checkSDistTarball sdistOpts tarPath prettyInfoL [flow "Wrote sdist tarball to", display tarPath] + checkSDistTarball sdistOpts tarPath + forM_ (sdoptsTarPath sdistOpts) $ copyTarToTarPath tarPath tarName when (sdoptsSign sdistOpts) (void $ Sig.sign (sdoptsSignServerUrl sdistOpts) tarPath) + where + copyTarToTarPath tarPath tarName targetDir = liftIO $ do + let targetTarPath = targetDir FP. tarName + D.createDirectoryIfMissing True $ FP.takeDirectory targetTarPath + D.copyFile (toFilePath tarPath) targetTarPath -- | Execute a command. execCmd :: ExecOpts -> GlobalOpts -> IO () execCmd ExecOpts {..} go@GlobalOpts{..} = 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) loadConfigWithOpts go $ \lc -> withUserFileLock go (view stackRootL lc) $ \lk -> do let getCompilerVersion = loadCompilerVersion go lc @@ -785,14 +799,17 @@ (lcProjectRoot lc) -- Unlock before transferring control away, whether using docker or not: (Just $ munlockFile lk) - (runRIO (lcConfig lc) $ do + (withBuildConfigAndLock go $ \buildLock -> do config <- view configL menv <- liftIO $ configProcessContextSettings config plainEnvSettings - withProcessContext menv $ Nix.reexecWithOptionalShell - (lcProjectRoot lc) - getCompilerVersion - (runRIO (lcConfig lc) $ - exec cmd args)) + withProcessContext menv $ do + (cmd, args) <- case (eoCmd, eoArgs) of + (ExecCmd cmd, args) -> return (cmd, args) + (ExecRun, args) -> getRunCmd args + (ExecGhc, args) -> return ("ghc", args) + (ExecRunGhc, args) -> return ("runghc", args) + munlockFile buildLock + Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (runRIO (lcConfig lc) $ exec cmd args)) Nothing Nothing -- Unlocked already above. ExecOptsEmbellished {..} -> @@ -812,9 +829,10 @@ else args ++ ["+RTS"] ++ eoRtsOptions ++ ["-RTS"] (cmd, args) <- case (eoCmd, argsWithRts eoArgs) of (ExecCmd cmd, args) -> return (cmd, args) + (ExecRun, args) -> getRunCmd args (ExecGhc, args) -> getGhcCmd "" eoPackages args - -- NOTE: this won't currently work for GHCJS, because it doesn't have - -- a runghcjs binary. It probably will someday, though. + -- NOTE: This doesn't work for GHCJS, because it doesn't have + -- a runghcjs binary. (ExecRunGhc, args) -> getGhcCmd "run" eoPackages args munlockFile lk -- Unlock before transferring control away. @@ -834,6 +852,24 @@ getPkgOpts wc pkgs = map ("-package-id=" ++) <$> mapM (getPkgId wc) pkgs + getRunCmd args = do + pkgComponents <- liftM (map lpvComponents . Map.elems . lpProject) getLocalPackages + let executables = filter isCExe $ concatMap Set.toList pkgComponents + let (exe, args') = case args of + [] -> (firstExe, args) + x:xs -> case find (\y -> y == (CExe $ T.pack x)) executables of + Nothing -> (firstExe, args) + argExe -> (argExe, xs) + where + firstExe = listToMaybe executables + case exe of + Just (CExe exe') -> do + Stack.Build.build (const (return ())) Nothing defaultBuildOptsCLI{boptsCLITargets = [T.cons ':' exe']} + return (T.unpack exe', args') + _ -> do + logError "No executables found." + liftIO exitFailure + getGhcCmd prefix pkgs args = do wc <- view $ actualCompilerVersionL.whichCompilerL pkgopts <- getPkgOpts wc pkgs @@ -946,7 +982,7 @@ -- | List the available templates. templatesCmd :: () -> GlobalOpts -> IO () -templatesCmd _ go@GlobalOpts{..} = withConfigAndLock go listTemplates +templatesCmd _ go@GlobalOpts{..} = withConfigAndLock go templatesHelp -- | Fix up extra-deps for a project solverCmd :: Bool -- ^ modify stack.yaml automatically? diff --git a/src/test/Network/HTTP/Download/VerifiedSpec.hs b/src/test/Network/HTTP/Download/VerifiedSpec.hs --- a/src/test/Network/HTTP/Download/VerifiedSpec.hs +++ b/src/test/Network/HTTP/Download/VerifiedSpec.hs @@ -3,7 +3,7 @@ import Control.Retry (limitRetries) import Crypto.Hash -import Network.HTTP.Client.Conduit +import Network.HTTP.StackClient import Network.HTTP.Download.Verified import Path import Path.IO hiding (withSystemTempDir) diff --git a/src/test/Stack/ConfigSpec.hs b/src/test/Stack/ConfigSpec.hs --- a/src/test/Stack/ConfigSpec.hs +++ b/src/test/Stack/ConfigSpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} module Stack.ConfigSpec where +import Control.Arrow import Data.Aeson.Extended import Data.Yaml import Path @@ -165,7 +166,7 @@ it "is parseable" $ \_ -> do curDir <- getCurrentDir let parsed :: Either String (Either String (WithJSONWarnings ConfigMonoid)) - parsed = parseEither (parseConfigMonoid curDir) <$> decodeEither defaultConfigYaml + parsed = parseEither (parseConfigMonoid curDir) <$> left show (decodeEither' defaultConfigYaml) case parsed of Right (Right _) -> return () :: IO () _ -> fail "Failed to parse default config yaml" diff --git a/src/test/Stack/StoreSpec.hs b/src/test/Stack/StoreSpec.hs --- a/src/test/Stack/StoreSpec.hs +++ b/src/test/Stack/StoreSpec.hs @@ -51,12 +51,6 @@ (if (minBound :: a) `notElem` xs then [minBound] else []) ++ (if (maxBound :: a) `notElem` xs && (maxBound :: a) /= minBound then maxBound : xs else xs) -$(do let ns = [ ''Int64, ''Word64, ''Word8 - ] - f n = [d| instance Monad m => Serial m $(conT n) where - series = generate (\_ -> addMinAndMaxBounds [0, 1]) |] - concat <$> mapM f ns) - $(do let tys = [ ''InstalledCacheInner -- FIXME , ''PackageCache -- FIXME , ''LoadedSnapshot diff --git a/src/test/Stack/Types/BuildPlanSpec.hs b/src/test/Stack/Types/BuildPlanSpec.hs --- a/src/test/Stack/Types/BuildPlanSpec.hs +++ b/src/test/Stack/Types/BuildPlanSpec.hs @@ -5,7 +5,7 @@ import Data.Aeson.Extended (WithJSONWarnings(..)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 -import Data.Yaml (decode) +import Data.Yaml (decodeThrow) import Stack.Types.BuildPlan import Test.Hspec @@ -15,7 +15,7 @@ describe "Archive" $ do describe "github" $ do let decode' :: ByteString -> Maybe (WithJSONWarnings (PackageLocation Subdirs)) - decode' = decode + decode' = decodeThrow it "'github' and 'commit' keys" $ do let contents :: ByteString diff --git a/src/test/Stack/Types/TemplateNameSpec.hs b/src/test/Stack/Types/TemplateNameSpec.hs new file mode 100644 --- /dev/null +++ b/src/test/Stack/Types/TemplateNameSpec.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Stack.Types.TemplateNameSpec where + +import Stack.Types.TemplateName +import Path.Internal +import System.Info (os) +import Test.Hspec + +spec :: Spec +spec = + describe "TemplateName" $ do + describe "parseTemplateNameFromString" $ do + let pathOf s = either error templatePath (parseTemplateNameFromString s) + + it "parses out the TemplatePath" $ do + pathOf "github:user/name" `shouldBe` (RepoPath $ RepoTemplatePath Github "user" "name.hsfiles") + pathOf "bitbucket:user/name" `shouldBe` (RepoPath $ RepoTemplatePath Bitbucket "user" "name.hsfiles") + pathOf "gitlab:user/name" `shouldBe` (RepoPath $ RepoTemplatePath Gitlab "user" "name.hsfiles") + + pathOf "http://www.com/file" `shouldBe` UrlPath "http://www.com/file" + pathOf "https://www.com/file" `shouldBe` UrlPath "https://www.com/file" + + pathOf "name" `shouldBe` (RelPath $ Path "name.hsfiles") + pathOf "name.hsfile" `shouldBe` (RelPath $ Path "name.hsfile.hsfiles") + pathOf "name.hsfiles" `shouldBe` (RelPath $ Path "name.hsfiles") + pathOf "" `shouldBe` (RelPath $ Path ".hsfiles") + + if os == "mingw32" + then do + pathOf "//home/file" `shouldBe` (AbsPath $ Path "\\\\home\\file.hsfiles") + pathOf "/home/file" `shouldBe` (RelPath $ Path "\\home\\file.hsfiles") + pathOf "/home/file.hsfiles" `shouldBe` (RelPath $ Path "\\home\\file.hsfiles") + + pathOf "c:\\home\\file" `shouldBe` (AbsPath $ Path "C:\\home\\file.hsfiles") + pathOf "with/slash" `shouldBe` (RelPath $ Path "with\\slash.hsfiles") + + let colonAction = + do + return $! pathOf "with:colon" + colonAction `shouldThrow` anyErrorCall + + else do + pathOf "//home/file" `shouldBe` (AbsPath $ Path "/home/file.hsfiles") + pathOf "/home/file" `shouldBe` (AbsPath $ Path "/home/file.hsfiles") + pathOf "/home/file.hsfiles" `shouldBe` (AbsPath $ Path "/home/file.hsfiles") + + pathOf "c:\\home\\file" `shouldBe` (RelPath $ Path "c:\\home\\file.hsfiles") + pathOf "with/slash" `shouldBe` (RelPath $ Path "with/slash.hsfiles") + pathOf "with:colon" `shouldBe` (RelPath $ Path "with:colon.hsfiles") + diff --git a/src/unix/Stack/DefaultColorWhen.hs b/src/unix/Stack/DefaultColorWhen.hs new file mode 100644 --- /dev/null +++ b/src/unix/Stack/DefaultColorWhen.hs @@ -0,0 +1,11 @@ +{- | This version of the module is only for non-Windows (eg unix-like) +operating systems. +-} +module Stack.DefaultColorWhen + ( defaultColorWhen + ) where + +import Stack.Types.Runner (ColorWhen (ColorAuto)) + +defaultColorWhen :: IO ColorWhen +defaultColorWhen = return ColorAuto diff --git a/src/windows/Stack/DefaultColorWhen.hs b/src/windows/Stack/DefaultColorWhen.hs new file mode 100644 --- /dev/null +++ b/src/windows/Stack/DefaultColorWhen.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE CPP #-} + +{- | This version of the module is only for Windows operating systems. +-} +module Stack.DefaultColorWhen + ( defaultColorWhen + ) where + +-- The Win32 package provides CPP macro WINDOWS_CCONV. +#include "windows_cconv.h" + +import Stack.Prelude (stdout) +import Stack.Types.Runner (ColorWhen (ColorAuto, ColorNever)) + +import Data.Bits ((.|.), (.&.)) +import Foreign.Marshal (alloca) +import Foreign.Ptr (Ptr) +import Foreign.Storable (peek) +import System.Win32.Types (BOOL, DWORD, HANDLE, iNVALID_HANDLE_VALUE, + nullHANDLE, withHandleToHANDLE) + +defaultColorWhen :: IO ColorWhen +defaultColorWhen = withHandleToHANDLE stdout aNSISupport + +-- The following is based on extracts from the modules +-- System.Console.ANSI.Windows.Foreign and System.Console.ANSI.Windows.Detect +-- from the ansi-terminal package, simplified. + +-- | This function first checks if the Windows handle is valid and yields +-- 'never' if it is not. It then tries to get a ConHost console mode for that +-- handle. If it can not, it assumes that the handle is ANSI-enabled. If virtual +-- termimal (VT) processing is already enabled, the handle supports 'auto'. +-- Otherwise, it trys to enable processing. If it can, the handle supports +-- 'auto'. If it can not, the function yields 'never'. +aNSISupport :: HANDLE -> IO ColorWhen +aNSISupport h = + if h == iNVALID_HANDLE_VALUE || h == nullHANDLE + then return ColorNever -- Invalid handle or no handle + else do + tryMode <- getConsoleMode h + case tryMode of + Nothing -> return ColorAuto -- No ConHost mode + Just mode -> if mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0 + then return ColorAuto -- VT processing already enabled + else do + let mode' = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING + succeeded <- cSetConsoleMode h mode' + if succeeded + then return ColorAuto -- VT processing enabled + else return ColorNever -- Can't enable VT processing + where + eNABLE_VIRTUAL_TERMINAL_PROCESSING = 4 + +foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode" + cGetConsoleMode :: HANDLE -> Ptr DWORD -> IO BOOL + +foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleMode" + cSetConsoleMode :: HANDLE -> DWORD -> IO BOOL + +getConsoleMode :: HANDLE -> IO (Maybe DWORD) +getConsoleMode handle = alloca $ \ptr_mode -> do + succeeded <- cGetConsoleMode handle ptr_mode + if succeeded + then Just <$> peek ptr_mode + else pure Nothing diff --git a/stack.cabal b/stack.cabal --- a/stack.cabal +++ b/stack.cabal @@ -1,11 +1,13 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.24 + +-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- --- hash: 5b3e8d70c3e492d9cc4473a5919b80ee0fc2f59d6eb81b898d2bb507a83159e1 +-- hash: c1123498f6d6ebc3a0fc03b968146f349da538acc9bfa189e0f65c5cd447aca6 name: stack -version: 1.7.1 +version: 1.9.1 synopsis: The Haskell Tool Stack description: Please see the README.md for usage information, and the wiki on Github for more details. Also, note that the API for the library is not currently stable, and may change significantly, even between minor releases. It is currently only intended for use by the executable. category: Development @@ -16,10 +18,10 @@ license: BSD3 license-file: LICENSE build-type: Custom -cabal-version: >= 1.24 extra-source-files: - ChangeLog.md CONTRIBUTING.md + ChangeLog.md + README.md doc/architecture.md doc/build_command.md doc/ChangeLog.md @@ -33,7 +35,6 @@ doc/ghcjs.md doc/GUIDE.md doc/install_and_upgrade.md - doc/MAINTAINER_GUIDE.md doc/nix_integration.md doc/nonstandard_project_init.md doc/README.md @@ -42,7 +43,6 @@ doc/stack_yaml_vs_cabal_package_file.md doc/travis_ci.md doc/yaml_configuration.md - README.md src/setup-shim/StackSetupShim.hs stack.yaml test/package-dump/ghc-7.10.txt @@ -92,6 +92,7 @@ Data.Attoparsec.Combinators Data.Attoparsec.Interpreter Data.IORef.RunOnce + Data.Monoid.Map Data.Store.VersionTagged Network.HTTP.Download Network.HTTP.Download.Verified @@ -122,6 +123,7 @@ Stack.Constants Stack.Constants.Config Stack.Coverage + Stack.DefaultColorWhen Stack.Docker Stack.Docker.GlobalDB Stack.Dot @@ -214,7 +216,7 @@ Hackage.Security.Client.Repository.HttpLib.HttpClient hs-source-dirs: src/ - ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-identities + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -fwarn-identities build-depends: Cabal , aeson @@ -226,7 +228,7 @@ , base64-bytestring , bytestring , conduit - , conduit-extra >=1.2.3.1 + , conduit-extra , containers , cryptonite , cryptonite-conduit @@ -287,10 +289,10 @@ , time , tls , transformers - , typed-process >=0.2.1.0 + , typed-process , unicode-transforms , unix-compat - , unliftio >=0.2.4.0 + , unliftio , unordered-containers , vector , yaml @@ -301,11 +303,11 @@ build-depends: Win32 else + build-tools: + hsc2hs build-depends: bindings-uname , unix - build-tools: - hsc2hs if os(windows) hs-source-dirs: src/windows/ @@ -322,7 +324,7 @@ Paths_stack hs-source-dirs: src/main - ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded -rtsopts + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -threaded -rtsopts build-depends: Cabal , aeson @@ -334,7 +336,7 @@ , base64-bytestring , bytestring , conduit - , conduit-extra >=1.2.3.1 + , conduit-extra , containers , cryptonite , cryptonite-conduit @@ -396,10 +398,10 @@ , time , tls , transformers - , typed-process >=0.2.1.0 + , typed-process , unicode-transforms , unix-compat - , unliftio >=0.2.4.0 + , unliftio , unordered-containers , vector , yaml @@ -410,17 +412,17 @@ build-depends: Win32 else + build-tools: + hsc2hs build-depends: bindings-uname , unix - build-tools: - hsc2hs if flag(static) ld-options: -static -pthread if !(flag(disable-git-info)) cpp-options: -DUSE_GIT_INFO build-depends: - gitrev + githash , optparse-simple if flag(hide-dependency-versions) cpp-options: -DHIDE_DEP_VERSIONS @@ -440,7 +442,7 @@ hs-source-dirs: test/integration test/integration/lib - ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N build-depends: Cabal , aeson @@ -452,7 +454,7 @@ , base64-bytestring , bytestring , conduit - , conduit-extra >=1.2.3.1 + , conduit-extra , containers , cryptonite , cryptonite-conduit @@ -514,10 +516,10 @@ , time , tls , transformers - , typed-process >=0.2.1.0 + , typed-process , unicode-transforms , unix-compat - , unliftio >=0.2.4.0 + , unliftio , unordered-containers , vector , yaml @@ -528,11 +530,11 @@ build-depends: Win32 else + build-tools: + hsc2hs build-depends: bindings-uname , unix - build-tools: - hsc2hs if !(flag(integration-tests)) buildable: False default-language: Haskell2010 @@ -557,11 +559,12 @@ Stack.StaticBytesSpec Stack.StoreSpec Stack.Types.BuildPlanSpec + Stack.Types.TemplateNameSpec Stack.Untar.UntarSpec Paths_stack hs-source-dirs: src/test - ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path -threaded build-depends: Cabal , QuickCheck @@ -574,7 +577,7 @@ , base64-bytestring , bytestring , conduit - , conduit-extra >=1.2.3.1 + , conduit-extra , containers , cryptonite , cryptonite-conduit @@ -638,10 +641,10 @@ , time , tls , transformers - , typed-process >=0.2.1.0 + , typed-process , unicode-transforms , unix-compat - , unliftio >=0.2.4.0 + , unliftio , unordered-containers , vector , yaml @@ -652,9 +655,9 @@ build-depends: Win32 else + build-tools: + hsc2hs build-depends: bindings-uname , unix - build-tools: - hsc2hs default-language: Haskell2010 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-11.6 +resolver: lts-11.22 # docker: # enable: true @@ -9,7 +9,6 @@ # name: "fpco/stack-test" nix: # --nix on the command-line to enable. - enable: false packages: - zlib - unzip @@ -18,16 +17,28 @@ hide-dependency-versions: true supported-build: true extra-deps: -- rio-0.1.1.0@rev:0 -- Cabal-2.2.0.1@rev:0 -- hpack-0.28.2 -- http-api-data-0.3.8.1@rev:0 +- Cabal-2.4.0.1@rev:0 +- cabal-install-2.4.0.0@rev:1 +- resolv-0.1.1.1@rev:0 +- infer-license-0.2.0@rev:0 #for hpack-0.31 +- hpack-0.31.0@rev:0 +- http-api-data-0.3.8.1@rev:1 +- githash-0.1.1.0@rev:0 +- yaml-0.10.4.0@rev:0 #for hpack-0.31 +- windns-0.1.0.0@rev:0 +- hackage-security-0.5.3.0@rev:2 +- cabal-doctest-1.0.6@rev:2 -# Avoid https://github.com/commercialhaskell/stack/issues/3922 +# Avoid https://github.com/commercialhaskell/stack/issues/4125 # (triggered because later versions of persistent transitively depends # on haskell-src-exts, which needs the 'happy' build tool) +# THIS IS FIXED AS OF STACK 1.8, but keep these here until next major +# version to maintain the ability to build stack with older versions. - persistent-2.7.1@rev:0 - persistent-sqlite-2.6.4@rev:0 - resourcet-1.1.11@rev:0 -- conduit-1.2.13@rev:0 +- conduit-1.2.13.1@rev:0 - conduit-extra-1.2.3.2@rev:0 + +ghc-options: + "$locals": -fhide-source-paths diff --git a/test/integration/IntegrationSpec.hs b/test/integration/IntegrationSpec.hs --- a/test/integration/IntegrationSpec.hs +++ b/test/integration/IntegrationSpec.hs @@ -97,8 +97,8 @@ (ClosedStream, outSrc, errSrc, sph) <- streamingProcess cp (out, err, ec) <- runConcurrently $ (,,) - <$> Concurrently (outSrc $$ sinkLbs) - <*> Concurrently (errSrc $$ sinkLbs) + <$> Concurrently (outSrc `connect` sinkLbs) + <*> Concurrently (errSrc `connect` sinkLbs) <*> Concurrently (waitForStreamingProcess sph) when (ec /= ExitSuccess) $ throwIO $ TestFailure out err ec where @@ -120,7 +120,7 @@ copyTree :: (FilePath -> Bool) -> FilePath -> FilePath -> IO () copyTree toCopy src dst = - runResourceT (sourceDirectoryDeep False src $$ CL.mapM_ go) + runResourceT (sourceDirectoryDeep False src `connect` CL.mapM_ go) `catch` \(_ :: IOException) -> return () where go srcfp = when (toCopy srcfp) $ liftIO $ do diff --git a/test/integration/lib/StackTest.hs b/test/integration/lib/StackTest.hs --- a/test/integration/lib/StackTest.hs +++ b/test/integration/lib/StackTest.hs @@ -208,7 +208,7 @@ -- the main @stack.yaml@. -- defaultResolverArg :: String -defaultResolverArg = "--resolver=lts-11.6" +defaultResolverArg = "--resolver=lts-11.19" -- | Remove a file and ignore any warnings about missing files. removeFileIgnore :: FilePath -> IO ()